diff options
Diffstat (limited to 'hsm-cam')
-rw-r--r-- | hsm-cam/Hsm/Cam.hs | 24 | ||||
-rw-r--r-- | hsm-cam/Hsm/Cam/FFI.hs | 64 | ||||
-rw-r--r-- | hsm-cam/Hsm/Cam/FFI.hsc | 82 | ||||
-rw-r--r-- | hsm-cam/Test/Cam.hs | 11 |
4 files changed, 103 insertions, 78 deletions
diff --git a/hsm-cam/Hsm/Cam.hs b/hsm-cam/Hsm/Cam.hs index e5b30c2..d1f9cd2 100644 --- a/hsm-cam/Hsm/Cam.hs +++ b/hsm-cam/Hsm/Cam.hs @@ -6,9 +6,10 @@ module Hsm.Cam ( Cam , capturePng , runCam - ) where + ) +where -import Codec.Picture (Image(Image), encodePng) +import Codec.Picture (Image (Image), encodePng) import Codec.Picture.Types (PixelRGB8) import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar, takeMVar) import Control.Exception (mask_) @@ -19,11 +20,11 @@ import Data.ByteString.Lazy (ByteString) import Data.List ((!?)) import Data.Primitive.Ptr (readOffPtr) import Data.Vector.Storable (generateM) -import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>), liftIO) -import Effectful.Dispatch.Static (SideEffects(WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) +import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>)) +import Effectful.Dispatch.Static (SideEffects (WithSideEffects), StaticRep, evalStaticRep, getStaticRep, unsafeEff_) import Effectful.Exception (bracket, bracket_) import Foreign.C.String (peekCString) -import Foreign.C.Types (CSize(CSize)) +import Foreign.C.Types (CSize (CSize)) import Foreign.Ptr (Ptr, castPtr, freeHaskellFunPtr, nullPtr) import Hsm.Cam.FFI ( acquireCamera @@ -45,11 +46,11 @@ import Hsm.Cam.FFI , stopCameraManager ) import Hsm.Core.Bracket (bracketConst, bracketLiftIO_) -import Hsm.Log (Log, Severity(Attention, Info, Trace), getLevel, logMsg, makeLoggerIO) +import Hsm.Log (Log, Severity (Attention, Info, Trace), getLevel, logMsg, makeLoggerIO) import MMAP (mapShared, mkMmapFlags, mmap, munmap, protRead) import System.Directory (doesFileExist, removeFile) import System.Environment (setEnv) -import System.IO (IOMode(ReadWriteMode), hGetLine, withFile) +import System.IO (IOMode (ReadWriteMode), hGetLine, withFile) import System.Posix.Files (createNamedPipe, ownerReadMode, ownerWriteMode) import Text.Read (readMaybe) @@ -62,8 +63,8 @@ data Rep = Rep , dmaBuffer :: Ptr () } -newtype instance StaticRep Cam = - Cam Rep +newtype instance StaticRep Cam + = Cam Rep -- RGB888 configuration for ov5647 sensor (Raspberry Pi Camera Module) -- The following constants must be updated if either: @@ -80,7 +81,7 @@ frameBufferLength = frameStride * frameHeight + 3072 capturePng :: (Log "cam" :> es, Cam :> es) => Eff es ByteString capturePng = do - Cam Rep {..} <- getStaticRep + Cam Rep{..} <- getStaticRep logMsg Trace "Requesting frame" unsafeEff_ . mask_ $ requestFrame >> takeMVar requestCallbackMVar logMsg Trace "Processing frame data" @@ -130,7 +131,8 @@ runCam action = do . bracketLiftIO_ allocateFrameBuffer freeFrameBuffer . bracketLiftIO_ startCamera stopCamera . bracketLiftIO_ createRequest (return ()) - . bracket mapDmaBuffer unmapDmaBuffer $ \dmaBuffer -> evalStaticRep (Cam Rep {..}) action + . bracket mapDmaBuffer unmapDmaBuffer + $ \dmaBuffer -> evalStaticRep (Cam Rep{..}) action where loggerAlloc = do logMsg @"cam" Info "Registering FFI logger" diff --git a/hsm-cam/Hsm/Cam/FFI.hs b/hsm-cam/Hsm/Cam/FFI.hs deleted file mode 100644 index 50acf10..0000000 --- a/hsm-cam/Hsm/Cam/FFI.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE CApiFFI #-} - -module Hsm.Cam.FFI - ( frameWidth - , frameHeight - , makeLogger - , registerLogger - , makeRequestCallback - , registerRequestCallback - , startCameraManager - , stopCameraManager - , acquireCamera - , releaseCamera - , allocateFrameBuffer - , freeFrameBuffer - , startCamera - , stopCamera - , createRequest - , getDmaBufferFd - , requestFrame - ) where - -import Foreign.C.String (CString) -import Foreign.C.Types (CInt(CInt)) -import Foreign.Ptr (FunPtr) -import System.Posix.Types (Fd(Fd)) - -type Logger = Int -> CString -> IO () - -type RequestCallback = IO () - -foreign import capi safe "Cam.hpp value FRAME_WIDTH" frameWidth :: Int - -foreign import capi safe "Cam.hpp value FRAME_HEIGHT" frameHeight :: Int - -foreign import ccall safe "wrapper" makeLogger :: Logger -> IO (FunPtr Logger) - -foreign import capi safe "Cam.hpp register_logger" registerLogger :: FunPtr Logger -> IO () - -foreign import ccall safe "wrapper" makeRequestCallback :: RequestCallback -> IO (FunPtr RequestCallback) - -foreign import capi safe "Cam.hpp register_request_callback" registerRequestCallback :: FunPtr RequestCallback -> IO () - -foreign import capi safe "Cam.hpp start_camera_manager" startCameraManager :: IO () - -foreign import capi safe "Cam.hpp stop_camera_manager" stopCameraManager :: IO () - -foreign import capi safe "Cam.hpp acquire_camera" acquireCamera :: IO () - -foreign import capi safe "Cam.hpp release_camera" releaseCamera :: IO () - -foreign import capi safe "Cam.hpp allocate_frame_buffer" allocateFrameBuffer :: IO () - -foreign import capi safe "Cam.hpp free_frame_buffer" freeFrameBuffer :: IO () - -foreign import capi safe "Cam.hpp start_camera" startCamera :: IO () - -foreign import capi safe "Cam.hpp stop_camera" stopCamera :: IO () - -foreign import capi safe "Cam.hpp create_request" createRequest :: IO () - -foreign import capi safe "Cam.hpp get_dma_buffer_fd" getDmaBufferFd :: IO Fd - -foreign import capi safe "Cam.hpp request_frame" requestFrame :: IO () diff --git a/hsm-cam/Hsm/Cam/FFI.hsc b/hsm-cam/Hsm/Cam/FFI.hsc new file mode 100644 index 0000000..6c5dd3d --- /dev/null +++ b/hsm-cam/Hsm/Cam/FFI.hsc @@ -0,0 +1,82 @@ +{-# LANGUAGE CApiFFI #-} + +module Hsm.Cam.FFI + ( frameWidth + , frameHeight + , makeLogger + , registerLogger + , makeRequestCallback + , registerRequestCallback + , startCameraManager + , stopCameraManager + , acquireCamera + , releaseCamera + , allocateFrameBuffer + , freeFrameBuffer + , startCamera + , stopCamera + , createRequest + , getDmaBufferFd + , requestFrame + ) +where + +import Foreign.C.String (CString) +import Foreign.C.Types (CInt (CInt)) +import Foreign.Ptr (FunPtr) +import System.Posix.Types (Fd (Fd)) + +type Logger = Int -> CString -> IO () + +type RequestCallback = IO () + +foreign import capi safe "Cam.hpp value FRAME_WIDTH" + frameWidth :: Int + +foreign import capi safe "Cam.hpp value FRAME_HEIGHT" + frameHeight :: Int + +foreign import ccall safe "wrapper" + makeLogger :: Logger -> IO (FunPtr Logger) + +foreign import capi safe "Cam.hpp register_logger" + registerLogger :: FunPtr Logger -> IO () + +foreign import ccall safe "wrapper" + makeRequestCallback :: RequestCallback -> IO (FunPtr RequestCallback) + +foreign import capi safe "Cam.hpp register_request_callback" + registerRequestCallback :: FunPtr RequestCallback -> IO () + +foreign import capi safe "Cam.hpp start_camera_manager" + startCameraManager :: IO () + +foreign import capi safe "Cam.hpp stop_camera_manager" + stopCameraManager :: IO () + +foreign import capi safe "Cam.hpp acquire_camera" + acquireCamera :: IO () + +foreign import capi safe "Cam.hpp release_camera" + releaseCamera :: IO () + +foreign import capi safe "Cam.hpp allocate_frame_buffer" + allocateFrameBuffer :: IO () + +foreign import capi safe "Cam.hpp free_frame_buffer" + freeFrameBuffer :: IO () + +foreign import capi safe "Cam.hpp start_camera" + startCamera :: IO () + +foreign import capi safe "Cam.hpp stop_camera" + stopCamera :: IO () + +foreign import capi safe "Cam.hpp create_request" + createRequest :: IO () + +foreign import capi safe "Cam.hpp get_dma_buffer_fd" + getDmaBufferFd :: IO Fd + +foreign import capi safe "Cam.hpp request_frame" + requestFrame :: IO () diff --git a/hsm-cam/Test/Cam.hs b/hsm-cam/Test/Cam.hs index 5c8daf5..94d3b73 100644 --- a/hsm-cam/Test/Cam.hs +++ b/hsm-cam/Test/Cam.hs @@ -1,12 +1,17 @@ import Control.Monad (forM_) +import Data.Function ((&)) import Effectful (runEff) import Effectful.FileSystem (runFileSystem) import Effectful.FileSystem.IO.ByteString.Lazy (writeFile) import Hsm.Cam (capturePng, runCam) -import Hsm.Log (Severity(Info, Trace), runLog) +import Hsm.Log (Severity (Info, Trace), runLog) import Prelude hiding (writeFile) main :: IO () main = - runEff . runFileSystem . runLog @"cam" Trace . runLog @"libcamera" Info . runCam . forM_ [0 .. 31] $ \index -> - capturePng >>= writeFile ("/tmp/hsm-cam-test" <> show @Int index <> ".png") + forM_ [0 .. 31] (\index -> capturePng >>= writeFile ("/tmp/hsm-cam-test" <> show @Int index <> ".png")) + & runCam + & runLog @"cam" Trace + & runLog @"libcamera" Info + & runFileSystem + & runEff |