-- GENERATED by C->Haskell Compiler, version 0.16.3 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./CV/HighGUI.chs" #-}{-#LANGUAGE ForeignFunctionInterface, ScopedTypeVariables#-}
module CV.HighGUI where
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr

import CV.Image
import CV.Image
{-# LINE 10 "./CV/HighGUI.chs" #-}
import CV.ImageOp

-- Functions for easy operation

-- TODO: "__TMP__" should be a gensym
display image = do
        makeWindow "__TMP__"
        showImage "__TMP__" image
        --threadDelay 2000000
        waitKey 0
        destroyWindow "__TMP__"

--- Lower level interface
mkWin :: String -> Int -> IO ()
mkWin a1 a2 =
  withCString a1 $ \a1' -> 
  let {a2' = fromIntegral a2} in 
  mkWin'_ a1' a2' >>= \res ->
  return ()
{-# LINE 24 "./CV/HighGUI.chs" #-}

makeWindow name = mkWin name 1

destroyWindow n = withCString n $ \name -> do
                cvDestroyWindow name

foreign import ccall "wrapper"
  trackbarCallback :: (CInt -> IO ()) -> IO (FunPtr (CInt -> IO ()))

mkTrackbar mx initial name window callback = do
        cb <- trackbarCallback callback
        withCString name $ \cname ->
         withCString window $ \cwindow ->
          cvCreateTrackbar cname cwindow nullPtr (fromIntegral mx) cb
    
waitKey delay = cvWaitKey delay

showImage :: String -> Image c d -> IO ()
showImage a1 a2 =
  withCString a1 $ \a1' -> 
  withGenImage a2 $ \a2' -> 
  showImage'_ a1' a2' >>= \res ->
  return ()
{-# LINE 43 "./CV/HighGUI.chs" #-}

foreign import ccall safe "CV/HighGUI.chs.h cvNamedWindow"
  mkWin'_ :: ((Ptr CChar) -> (CInt -> (IO CInt)))

foreign import ccall safe "CV/HighGUI.chs.h cvDestroyWindow"
  cvDestroyWindow :: ((Ptr CChar) -> (IO ()))

foreign import ccall safe "CV/HighGUI.chs.h cvCreateTrackbar"
  cvCreateTrackbar :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CInt) -> (CInt -> ((FunPtr (CInt -> (IO ()))) -> (IO CInt))))))

foreign import ccall safe "CV/HighGUI.chs.h cvWaitKey"
  cvWaitKey :: (CInt -> (IO CInt))

foreign import ccall safe "CV/HighGUI.chs.h cvShowImage"
  showImage'_ :: ((Ptr CChar) -> ((Ptr ()) -> (IO ())))