aboutsummaryrefslogtreecommitdiff
path: root/hsm-cam
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-cam')
-rw-r--r--hsm-cam/Hsm/Cam.hs24
-rw-r--r--hsm-cam/Hsm/Cam/FFI.hs64
-rw-r--r--hsm-cam/Hsm/Cam/FFI.hsc82
-rw-r--r--hsm-cam/Test/Cam.hs11
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 6ee648d..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 unsafe "Cam.hpp value FRAME_WIDTH" frameWidth :: Int
-
-foreign import capi unsafe "Cam.hpp value FRAME_HEIGHT" frameHeight :: Int
-
-foreign import ccall unsafe "wrapper" makeLogger :: Logger -> IO (FunPtr Logger)
-
-foreign import ccall safe "Cam.hpp register_logger" registerLogger :: FunPtr Logger -> IO ()
-
-foreign import ccall unsafe "wrapper" makeRequestCallback :: RequestCallback -> IO (FunPtr RequestCallback)
-
-foreign import ccall safe "Cam.hpp register_request_callback" registerRequestCallback :: FunPtr RequestCallback -> IO ()
-
-foreign import ccall safe "Cam.hpp start_camera_manager" startCameraManager :: IO Int
-
-foreign import ccall safe "Cam.hpp stop_camera_manager" stopCameraManager :: IO ()
-
-foreign import ccall safe "Cam.hpp acquire_camera" acquireCamera :: IO Int
-
-foreign import ccall safe "Cam.hpp release_camera" releaseCamera :: IO ()
-
-foreign import ccall safe "Cam.hpp allocate_frame_buffer" allocateFrameBuffer :: IO Int
-
-foreign import ccall safe "Cam.hpp free_frame_buffer" freeFrameBuffer :: IO ()
-
-foreign import ccall safe "Cam.hpp start_camera" startCamera :: IO Int
-
-foreign import ccall safe "Cam.hpp stop_camera" stopCamera :: IO ()
-
-foreign import ccall safe "Cam.hpp create_request" createRequest :: IO Int
-
-foreign import ccall safe "Cam.hpp get_dma_buffer_fd" getDmaBufferFd :: IO Fd
-
-foreign import ccall 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
powered by cgit v1.2.1, back to main portfolio site