simple-firewire 0.1.3.3 → 0.1.3.4
raw patch · 3 files changed
+226/−26 lines, 3 filesdep ~CV
Dependency ranges changed: CV
Files
- Examples/Example1.hs +1/−1
- System/Camera/Firewire/Simple.hs +223/−23
- simple-firewire.cabal +2/−2
Examples/Example1.hs view
@@ -57,7 +57,7 @@ print ("Trying camera", e) cam <- cameraFromID dc e-- c'dc1394_camera_new dc guid print ("Camera can do oneshots", oneShotCapable cam)- setISOSpeed cam ISO_400+ setISOSpeed cam ISO_800 setVideoMode cam Mode_640x480_RGB8 setFrameRate cam Rate_7_5 setupCamera cam 4 (defaultFlags)
System/Camera/Firewire/Simple.hs view
@@ -1,4 +1,4 @@-{-#LANGUAGE ScopedTypeVariables#-}+{-#LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds#-} module System.Camera.Firewire.Simple ( -- * Basic types Camera@@ -17,7 +17,8 @@ , cameraFromID , setFrameRate , setISOSpeed - , setVideoMode + , setOperationMode+ , withVideoMode , setupCamera -- * Setting up the context, cameras and the transmission@@ -29,7 +30,36 @@ -- * Camera properties , oneShotCapable - + + -- * Controlling cameras+ , resetCamera + , resetBus+ , avtReset+ , setPower+ , setGain+ , setBrightness + , setExposure + , setSharpness + , setHue + , setSaturation + , setGamma + , setShutter + , setGain + , setIris + , setFocus + , setTrigger + , setTriggerDelay +-- , setWhiteBalance +-- , setTemperature +-- , setWhiteShading + , setFeatureFrameRate+ , setZoom + , setPan + , setTilt + , setOpticalFilter + , setCaptureSize + , setCaptureQuality + -- * Getting images , getFrame , flushBuffer@@ -37,6 +67,7 @@ , DCResult(..) , Framerate(..) , ISOSpeed(..)+ , OperationMode(..) , VideoMode(..) @@ -49,6 +80,7 @@ import Control.Exception import Control.Monad import Data.Bits+import Data.Word import Foreign.C.Types import Foreign.Concurrent import Foreign.ForeignPtr hiding (newForeignPtr)@@ -57,6 +89,7 @@ import Foreign.Ptr import Foreign.Storable import System.IO.Unsafe+import Unsafe.Coerce getIds :: C'dc1394camera_list_t -> IO [C'dc1394camera_id_t] getIds camList = peekArray (fromIntegral $ c'dc1394camera_list_t'num camList)@@ -77,28 +110,89 @@ -- | Poll frames until the camera buffer is empty. Notice that you -- have to restart the transmission after this call-flushBuffer :: Camera -> IO ()+flushBuffer :: Camera a -> IO () flushBuffer cam = alloca $ \(framePtrPtr :: Ptr (Ptr C'dc1394video_frame_t)) -> do withCameraPtr cam $ flushLoop framePtrPtr where flushLoop framePtrPtr cam = do c'dc1394_capture_dequeue cam c'DC1394_CAPTURE_POLICY_POLL framePtrPtr- print "Flush!"+-- print "Flush!" framePtr :: Ptr C'dc1394video_frame_t <- peek framePtrPtr - putStrLn $ show (framePtr,framePtrPtr)+-- putStrLn $ show (framePtr,framePtrPtr) when (framePtr /= nullPtr) $ c'dc1394_capture_enqueue cam framePtr >> flushLoop framePtrPtr cam +class GetFrame a where+ type ResultImageOf a :: *+ getFrame :: Camera a -> IO (Maybe (ResultImageOf a)) --- | Grab a frame from the camera. Currently does only 640x480 RGB D8 Images.-getFrame :: Camera -> IO (Maybe (Image RGB D8))-getFrame camera' = alloca $ \(framePtr :: Ptr (Ptr C'dc1394video_frame_t)) ->++-- | Grab a frame from the camera. +--getFrame :: Camera -> IO (Maybe (Image RGB D8))+instance GetFrame Mode_640x480_RGB8 where+ type ResultImageOf Mode_640x480_RGB8 = Image RGB D8+ getFrame camera' = getPrimalFrame camera' Mode_640x480_RGB8 convertToCVRGB ++instance GetFrame Mode_800x600_RGB8 where+ type ResultImageOf Mode_800x600_RGB8 = Image RGB D8+ getFrame camera' = getPrimalFrame camera' Mode_800x600_RGB8 convertToCVRGB ++instance GetFrame Mode_1024x768_RGB8 where+ type ResultImageOf Mode_1024x768_RGB8 = Image RGB D8+ getFrame camera' = getPrimalFrame camera' Mode_1024x768_RGB8 convertToCVRGB ++instance GetFrame Mode_1280x960_RGB8 where+ type ResultImageOf Mode_1280x960_RGB8 = Image RGB D8+ getFrame camera' = getPrimalFrame camera' Mode_1280x960_RGB8 convertToCVRGB ++instance GetFrame Mode_640x480_MONO8 where+ type ResultImageOf Mode_640x480_MONO8 = Image GrayScale D8+ getFrame camera' = getPrimalFrame camera' Mode_640x480_MONO8 convertToCVMONO8 ++instance GetFrame Mode_800x600_MONO8 where+ type ResultImageOf Mode_800x600_MONO8 = Image GrayScale D8+ getFrame camera' = getPrimalFrame camera' Mode_800x600_MONO8 convertToCVMONO8 ++instance GetFrame Mode_1024x768_MONO8 where+ type ResultImageOf Mode_1024x768_MONO8 = Image GrayScale D8+ getFrame camera' = getPrimalFrame camera' Mode_1024x768_MONO8 convertToCVMONO8++instance GetFrame Mode_1280x960_MONO8 where+ type ResultImageOf Mode_1280x960_MONO8 = Image GrayScale D8+ getFrame camera' = getPrimalFrame camera' Mode_1280x960_MONO8 convertToCVMONO8 ++-- | Perform operations with a given video-mode. The idea is that each camera outside the+-- `withVideoMode` is represented with an UnsetMode with which you can't grab frames.+-- This is done regardless of the actual device mode. +class WithVideoMode a where+ withVideoMode :: Camera UnsetMode -> (Camera a -> IO b) -> IO b++instance WithVideoMode Mode_640x480_RGB8 where+ withVideoMode cam op = withCameraPtr cam $ \camera -> + (checking $ c'dc1394_video_set_mode camera (toVideoMode Mode_640x480_RGB8)) + >> op (unsafeCoerce cam)++instance WithVideoMode Mode_640x480_MONO8 where+ withVideoMode cam op = withCameraPtr cam $ \camera -> + (checking $ c'dc1394_video_set_mode camera (toVideoMode Mode_640x480_MONO8)) + >> op (unsafeCoerce cam)++instance WithVideoMode Mode_800x600_RGB8 where+ withVideoMode cam op = withCameraPtr cam $ \camera -> + (checking $ c'dc1394_video_set_mode camera (toVideoMode Mode_800x600_RGB8)) + >> op (unsafeCoerce cam)++instance WithVideoMode Mode_1280x960_RGB8 where+ withVideoMode cam op = withCameraPtr cam $ \camera -> + (checking $ c'dc1394_video_set_mode camera (toVideoMode Mode_1280x960_RGB8)) + >> op (unsafeCoerce cam)++getPrimalFrame camera' assumedMode conv = alloca $ \(framePtr :: Ptr (Ptr C'dc1394video_frame_t)) -> withCameraPtr camera' $ \camera -> do mode <- getMode camera- when (mode /= c'DC1394_VIDEO_MODE_640x480_RGB8) $ error "Unsupported mode. Use 640x480 RGB8 for now"-+ when (mode /= fromVideoMode assumedMode) $ error "Mode sync error!" c'dc1394_capture_dequeue camera c'DC1394_CAPTURE_POLICY_WAIT framePtr frameP :: Ptr C'dc1394video_frame_t <- peek framePtr @@ -111,13 +205,42 @@ case corrupt of 0 -> do -- Yay! A frame! dataPtr <- c'dc1394video_frame_t'image <$> (peek framePtr >>= peek)- r <- unsafe8UC3FromPtr (640,480) dataPtr+ r <- conv assumedMode dataPtr c'dc1394_capture_enqueue camera frameP return . Just $ r _ -> c'dc1394_capture_enqueue camera frameP >> return Nothing +convertToCVRGB mode dataPtr = case mode of+ Mode_640x480_RGB8 -> unsafe8UC_BGRFromPtr (640,480) dataPtr+ Mode_800x600_RGB8 -> unsafe8UC_BGRFromPtr (800,600) dataPtr+ Mode_1024x768_RGB8 -> unsafe8UC_BGRFromPtr (1024,768) dataPtr+ Mode_1280x960_RGB8 -> unsafe8UC_BGRFromPtr (1280,960) dataPtr + Mode_1600x1200_RGB8 -> unsafe8UC_BGRFromPtr (1600,1200) dataPtr +convertToCVMONO8 mode dataPtr = case mode of+ Mode_640x480_MONO8 -> unsafe8UC_MONOFromPtr (640,480) dataPtr+ Mode_800x600_MONO8 -> unsafe8UC_MONOFromPtr (800,600) dataPtr+ Mode_1024x768_MONO8 -> unsafe8UC_MONOFromPtr (1024,768) dataPtr+ Mode_1280x960_MONO8 -> unsafe8UC_MONOFromPtr (1280,960) dataPtr+ Mode_1600x1200_MONO8 -> unsafe8UC_MONOFromPtr (1600,1200) dataPtr +convertToCVMONO16 mode dataPtr = case mode of+ Mode_640x480_MONO16 -> error "Unsupported video mode"+ Mode_800x600_MONO16 -> error "Unsupported video mode"+ Mode_1024x768_MONO16 -> error "Unsupported video mode"+ Mode_1280x960_MONO16 -> error "Unsupported video mode"+ Mode_1600x1200_MONO16 -> error "Unsupported video mode"++convertToCVYUV mode dataPtr = case mode of+ Mode_160x120_YUV444 -> error "Unsupported video mode"+ Mode_320x240_YUV422 -> error "Unsupported video mode" + Mode_640x480_YUV411 -> error "Unsupported video mode" + Mode_640x480_YUV422 -> error "Unsupported video mode"+ Mode_800x600_YUV422 -> error "Unsupported video mode"+ Mode_1024x768_YUV422 -> error "Unsupported video mode"+ Mode_1280x960_YUV422 -> error "Unsupported video mode"+ Mode_1600x1200_YUV422 -> error "Unsupported video mode"+ getMode :: Ptr C'dc1394camera_t -> IO CInt getMode camera = alloca $ \(mode :: Ptr CInt) -> do c'dc1394_video_get_mode camera mode@@ -129,11 +252,12 @@ -- | Abstract type for cameras-data Camera = Camera (ForeignPtr C'dc1394camera_t)+data Camera (mode :: VideoMode) = Camera (ForeignPtr C'dc1394camera_t)+--type Camera = Camera' Mode_640x480_RGB8 -- | Create Camera from ID. Although the camera type is memory managed, the user is required -- to stop data transfer and reset appropriate settings. Finalizers are not quaranteed to run.-cameraFromID :: DC1394 -> CameraId -> IO Camera+cameraFromID :: DC1394 -> CameraId -> IO (Camera UnsetMode) cameraFromID dc e = do let guid = c'dc1394camera_id_t'guid e camera <- withDCPtr dc $ \c_dc -> c'dc1394_camera_new c_dc guid@@ -159,19 +283,19 @@ withDCPtr (DC1394 ptr) op = op ptr -- | Set the video transmission on-startVideoTransmission :: Camera -> IO ()+startVideoTransmission :: Camera a -> IO () startVideoTransmission c = withCameraPtr c $ \camera -> checking $ c'dc1394_video_set_transmission camera c'DC1394_ON -- | Set the video transmission off. Call this when you are done with the camera-stopVideoTransmission :: Camera -> IO ()+stopVideoTransmission :: Camera a -> IO () stopVideoTransmission c = withCameraPtr c $ \camera -> checking $ c'dc1394_video_set_transmission camera c'DC1394_OFF -- | Stop capturing. Call this when you are done with the camera.-stopCapture :: Camera -> IO ()+stopCapture :: Camera a -> IO () stopCapture c = withCameraPtr c $ \camera -> checking $ c'dc1394_capture_stop camera -- | Does the camera have one-shot functionality?-oneShotCapable :: Camera -> Bool+oneShotCapable :: Camera a -> Bool oneShotCapable camera = unsafePerformIO $ withCamera camera (return . itob . c'dc1394camera_t'one_shot_capable) -- | Type for capture flags@@ -188,27 +312,102 @@ (&+) :: CaptureFlag -> CaptureFlag -> CaptureFlag CF a &+ CF b = CF (a .&. b) +-- | Set power. True = On, False = Off+setPower :: Camera a -> Bool -> IO ()+setPower c state = withCameraPtr c $ \camera -> + checking $ c'dc1394_camera_set_power camera $+ case state of+ True -> c'DC1394_ON+ False -> c'DC1394_OFF+ -- | Set ISO speed-setISOSpeed :: Camera -> ISOSpeed -> IO ()+setISOSpeed :: Camera a -> ISOSpeed -> IO () setISOSpeed c iso = withCameraPtr c $ \camera -> checking $ c'dc1394_video_set_iso_speed camera (fromISO iso) --- | Set the video mode-setVideoMode :: Camera -> VideoMode -> IO ()+-- | Set operation mode+data OperationMode = Legacy | B deriving (Eq,Ord,Show)++setOperationMode :: Camera a -> OperationMode -> IO ()+setOperationMode c mode = withCameraPtr c $ \camera -> + checking $ c'dc1394_video_set_operation_mode camera $+ case mode of+ Legacy -> c'DC1394_OPERATION_MODE_LEGACY+ B -> c'DC1394_OPERATION_MODE_1394B++getOperationMode :: Camera a -> IO OperationMode+getOperationMode c = withCameraPtr c $ \camera -> + alloca $ \modeOut -> do+ checking $ c'dc1394_video_get_operation_mode camera modeOut+ r <- peek modeOut+ if r == c'DC1394_OPERATION_MODE_LEGACY + then return Legacy + else return B -- TODO: Make this more secure by adding 'other' case+ +-- | Reset the camera+resetCamera :: Camera a -> IO ()+resetCamera c = withCameraPtr c $ \camera -> + checking $ c'dc1394_camera_reset camera+-- | Reset the bus+resetBus :: Camera a -> IO ()+resetBus c = withCameraPtr c $ \camera -> + checking $ c'dc1394_reset_bus camera++-- | AVT Reset +avtReset :: Camera a -> IO ()+avtReset c = withCameraPtr c $ \camera -> + checking $ c'dc1394_avt_reset camera++-- | Set the video mode, type-UNSAFE at current point..+setVideoMode :: Camera a -> VideoMode -> IO () setVideoMode c mode = withCameraPtr c $ \camera -> checking $ c'dc1394_video_set_mode camera (toVideoMode mode) -- | Set the frame rate-setFrameRate :: Camera -> Framerate -> IO ()+setFrameRate :: Camera a -> Framerate -> IO () setFrameRate c rate = withCameraPtr c $ \camera -> checking $ c'dc1394_video_set_framerate camera (toFramerate rate) -- | Setup the camera for capturing-setupCamera :: Camera -> Int -> CaptureFlag -> IO ()+setupCamera :: Camera a -> Int -> CaptureFlag -> IO () setupCamera c dmaBuffers cf = withCameraPtr c $ \camera -> checking $ c'dc1394_capture_setup camera (fromIntegral dmaBuffers) (fromCF cf) +-- | Set camera shutter speed++setFeature :: CUInt -> Camera a -> Word32 -> IO ()+setFeature f c speed = withCameraPtr c $ \camera -> + checking $ c'dc1394_feature_set_value+ camera+ f+ (fromIntegral speed)++setBrightness = setFeature c'DC1394_FEATURE_BRIGHTNESS+setExposure = setFeature c'DC1394_FEATURE_EXPOSURE+setSharpness = setFeature c'DC1394_FEATURE_SHARPNESS+setHue = setFeature c'DC1394_FEATURE_HUE+setSaturation = setFeature c'DC1394_FEATURE_SATURATION+setGamma = setFeature c'DC1394_FEATURE_GAMMA+setShutter = setFeature c'DC1394_FEATURE_SHUTTER+setGain = setFeature c'DC1394_FEATURE_GAIN+setIris = setFeature c'DC1394_FEATURE_IRIS+setFocus = setFeature c'DC1394_FEATURE_FOCUS+setTrigger = setFeature c'DC1394_FEATURE_TRIGGER+setTriggerDelay = setFeature c'DC1394_FEATURE_TRIGGER_DELAY+setFeatureFrameRate = setFeature c'DC1394_FEATURE_FRAME_RATE+setZoom = setFeature c'DC1394_FEATURE_ZOOM+setPan = setFeature c'DC1394_FEATURE_PAN+setTilt = setFeature c'DC1394_FEATURE_TILT+setOpticalFilter = setFeature c'DC1394_FEATURE_OPTICAL_FILTER+setCaptureSize = setFeature c'DC1394_FEATURE_CAPTURE_SIZE+setCaptureQuality = setFeature c'DC1394_FEATURE_CAPTURE_QUALITY+-- These are multiple valued and cannot be set as features+-- setWhiteBalance = setFeature c'DC1394_FEATURE_WHITE_BALANCE+-- setWhiteShading = setFeature c'DC1394_FEATURE_WHITE_SHADING+-- setTemperature = setFeature c'DC1394_FEATURE_TEMPERATURE+ + -- | Execute a libdc1394 function and check for the error code. Currently raises the error as -- UserError, but in future might provide a more reasonable error hierarchy. checking :: IO CInt -> IO ()@@ -402,6 +601,7 @@ | Mode_FORMAT7_5 | Mode_FORMAT7_6 | Mode_FORMAT7_7 + | UnsetMode deriving (Show,Eq) fromVideoMode Mode_160x120_YUV444 = c'DC1394_VIDEO_MODE_160x120_YUV444
simple-firewire.cabal view
@@ -1,5 +1,5 @@ Name: simple-firewire-Version: 0.1.3.3+Version: 0.1.3.4 Synopsis: Simplified interface for firewire cameras Description: A simplified interface for firewire cameras based on libdc1394 <http://damien.douxchamps.net/ieee1394/libdc1394/> .@@ -26,7 +26,7 @@ Build-depends: base > 4 && < 5, bindings-dc1394 >= 0.2 && < 1,- CV >= 0.3.1.2 && < 0.4+ CV >= 0.3.1.3 && < 0.4.5 -- Other-modules: -- Build-tools: