aboutsummaryrefslogtreecommitdiff
path: root/hsm-cam
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-cam')
-rw-r--r--hsm-cam/FFI/Cam.cpp145
-rw-r--r--hsm-cam/FFI/Cam.hpp39
-rw-r--r--hsm-cam/Hsm/Cam.hs194
-rw-r--r--hsm-cam/Hsm/Cam/FFI.hsc82
-rw-r--r--hsm-cam/Test/Cam.hs17
-rw-r--r--hsm-cam/hsm-cam.cabal79
6 files changed, 0 insertions, 556 deletions
diff --git a/hsm-cam/FFI/Cam.cpp b/hsm-cam/FFI/Cam.cpp
deleted file mode 100644
index 4c21e7f..0000000
--- a/hsm-cam/FFI/Cam.cpp
+++ /dev/null
@@ -1,145 +0,0 @@
-#include "Cam.hpp"
-
-#include <libcamera/libcamera.h>
-
-#include <format>
-
-using namespace libcamera;
-using namespace std;
-
-HsLogger g_logger;
-HsRequestCallback g_request_callback;
-unique_ptr<CameraManager> g_manager;
-shared_ptr<Camera> g_camera;
-unique_ptr<CameraConfiguration> g_config;
-unique_ptr<FrameBufferAllocator> g_allocator;
-unique_ptr<Request> g_request;
-
-template<class... Args>
-void
-logMsg(Severity severity, const format_string<Args...> fmt, const Args &...args)
-{
- g_logger(severity, vformat(fmt.get(), make_format_args(args...)).c_str());
-}
-
-void
-internal_request_callback(Request *request)
-{
- int sequence = request->buffers().begin()->second->metadata().sequence;
- logMsg(Trace, "Completed request #{}", sequence);
- g_request_callback();
-}
-
-extern "C" void
-register_logger(HsLogger hs_logger)
-{
- g_logger = hs_logger;
- logMsg(Info, "Registered FFI logger");
-}
-
-extern "C" void
-register_request_callback(HsRequestCallback hs_request_callback)
-{
- g_request_callback = hs_request_callback;
- logMsg(Info, "Registered FFI request callback");
-}
-
-extern "C" void
-start_camera_manager()
-{
- logMsg(Info, "Starting camera manager");
- g_manager = make_unique<CameraManager>();
- g_manager->start();
-}
-
-extern "C" void
-stop_camera_manager()
-{
- logMsg(Info, "Stopping camera manager");
- g_manager->stop();
-}
-
-extern "C" void
-acquire_camera()
-{
- logMsg(Info, "Acquiring camera");
- g_camera = g_manager->cameras()[0];
- g_camera->acquire();
- logMsg(Info, "Acquired camera: {}", g_camera->id());
-}
-
-extern "C" void
-release_camera()
-{
- logMsg(Info, "Releasing camera");
- g_camera->release();
- g_camera.reset();
-}
-
-extern "C" void
-allocate_frame_buffer()
-{
- logMsg(Info, "Generating camera configuration");
- g_config = g_camera->generateConfiguration({ StreamRole::StillCapture });
- g_config->at(0).size.width = FRAME_WIDTH;
- g_config->at(0).size.height = FRAME_HEIGHT;
- g_config->at(0).pixelFormat = formats::BGR888;
- logMsg(Info, "Generated camera configuration: {}", g_config->at(0).toString());
- g_camera->configure(g_config.get());
-
- logMsg(Info, "Generating frame buffer allocator");
- g_allocator = make_unique<FrameBufferAllocator>(g_camera);
- g_allocator->allocate(g_config->at(0).stream());
-
- logMsg(Info, "Registering internal request callback");
- g_camera->requestCompleted.connect(internal_request_callback);
-}
-
-extern "C" void
-free_frame_buffer()
-{
- logMsg(Info, "Freeing frame buffer allocator");
- g_allocator->free(g_config->at(0).stream());
- g_allocator.reset();
-}
-
-extern "C" void
-start_camera()
-{
- logMsg(Info, "Starting camera");
- g_camera->start();
-}
-
-extern "C" void
-stop_camera()
-{
- logMsg(Info, "Stopping camera");
- g_camera->stop();
-}
-
-extern "C" void
-create_request()
-{
- logMsg(Info, "Creating request");
- g_request = g_camera->createRequest();
-
- logMsg(Info, "Setting buffer for request");
- Stream *stream = g_config->at(0).stream();
- g_request->addBuffer(stream, g_allocator->buffers(stream)[0].get());
-}
-
-extern "C" int
-get_dma_buffer_fd()
-{
- int fd = g_request->buffers().begin()->second->planes()[0].fd.get();
- logMsg(Info, "DMA buffer available in FD {}", fd);
- return fd;
-}
-
-extern "C" void
-request_frame()
-{
- logMsg(Trace, "Requested frame");
- g_request->reuse(Request::ReuseBuffers);
- g_camera->queueRequest(g_request.get());
-}
diff --git a/hsm-cam/FFI/Cam.hpp b/hsm-cam/FFI/Cam.hpp
deleted file mode 100644
index eeea814..0000000
--- a/hsm-cam/FFI/Cam.hpp
+++ /dev/null
@@ -1,39 +0,0 @@
-#ifndef CAM_HPP
-#define CAM_HPP
-
-#define FRAME_WIDTH (800)
-#define FRAME_HEIGHT (600)
-
-enum Severity
-{
- Attention = 0,
- Info = 1,
- Trace = 2,
-};
-
-typedef void (*HsLogger)(enum Severity, const char *);
-typedef void (*HsRequestCallback)();
-
-#ifdef __cplusplus
-extern "C"
-{
-#endif
- void register_logger(HsLogger hs_logger);
- void register_request_callback(HsRequestCallback hs_request_callback);
- void start_camera_manager();
- void stop_camera_manager();
- void acquire_camera();
- void release_camera();
- void allocate_frame_buffer();
- void free_frame_buffer();
- void start_camera();
- void stop_camera();
- void create_request();
-
- int get_dma_buffer_fd();
- void request_frame();
-#ifdef __cplusplus
-}
-#endif
-
-#endif
diff --git a/hsm-cam/Hsm/Cam.hs b/hsm-cam/Hsm/Cam.hs
deleted file mode 100644
index dfa7425..0000000
--- a/hsm-cam/Hsm/Cam.hs
+++ /dev/null
@@ -1,194 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Hsm.Cam
- ( Cam
- , capturePng
- , runCam
- )
-where
-
-import Codec.Picture (Image (Image), encodePng)
-import Codec.Picture.Types (PixelRGB8)
-import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar, takeMVar)
-import Control.Exception (mask_)
-import Control.Monad.Extra (whenM)
-import Control.Monad.Loops (iterateM_)
-import Data.Bits ((.|.))
-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.Exception (bracket, bracket_)
-import Foreign.C.String (peekCString)
-import Foreign.C.Types (CSize (CSize))
-import Foreign.Ptr (Ptr, castPtr, freeHaskellFunPtr, nullPtr)
-import Hsm.Cam.FFI
- ( acquireCamera
- , allocateFrameBuffer
- , createRequest
- , frameHeight
- , frameWidth
- , freeFrameBuffer
- , getDmaBufferFd
- , makeLogger
- , makeRequestCallback
- , registerLogger
- , registerRequestCallback
- , releaseCamera
- , requestFrame
- , startCamera
- , startCameraManager
- , stopCamera
- , stopCameraManager
- )
-import Hsm.Core.Bracket (bracketConst, bracketLiftIO_)
-import Hsm.Log (Log, Logs, 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.Posix.Files (createNamedPipe, ownerReadMode, ownerWriteMode)
-import Text.Read (readMaybe)
-
-data Cam (a :: * -> *) (b :: *)
-
-type instance DispatchOf Cam = Static WithSideEffects
-
-data Rep = Rep
- { requestCallbackMVar :: MVar ()
- , dmaBuffer :: Ptr ()
- }
-
-newtype instance StaticRep Cam
- = Cam Rep
-
--- RGB888 configuration for ov5647 sensor (Raspberry Pi Camera Module)
--- The following constants must be updated if either:
--- - Pixel format changes (e.g., to BGR, YUV, etc.)
--- - Camera module is replaced
-frameLine :: Int
-frameLine = frameWidth * 3
-
-frameStride :: Int
-frameStride = frameLine + 32
-
-frameBufferLength :: Int
-frameBufferLength = frameStride * frameHeight + 3072
-
-capturePng :: (Log "cam" :> es, Cam :> es) => Eff es ByteString
-capturePng = do
- Cam Rep{..} <- getStaticRep
- logMsg Trace "Requesting frame"
- unsafeEff_ . mask_ $ requestFrame >> takeMVar requestCallbackMVar
- logMsg Trace "Processing frame data"
- pixelVector <- unsafeEff_ . generateM (frameLine * frameHeight) $ mapPixel dmaBuffer
- logMsg Trace "Encoding PNG"
- return . encodePng $ Image @PixelRGB8 frameWidth frameHeight pixelVector
- where
- mapPixel dmaBuffer index = readOffPtr (castPtr dmaBuffer) offset
- where
- yIndex = index `div` frameLine
- xIndex = index `mod` frameLine
- offset = yIndex * frameStride + xIndex
-
--- Bidirectional mapping between libcamera's logging system and application logs.
--- All libcamera warnings and errors are elevated to the application's
--- 'Attention' level to ensure visibility.
-data LibCameraSeverity
- = DEBUG
- | INFO
- | WARN
- | ERROR
- | FATAL
- deriving (Read, Show)
-
-toLibCameraSeverity :: Severity -> LibCameraSeverity
-toLibCameraSeverity =
- \case
- Trace -> DEBUG
- Info -> INFO
- Attention -> WARN
-
-fromLibCameraSeverity :: LibCameraSeverity -> Severity
-fromLibCameraSeverity =
- \case
- DEBUG -> Trace
- INFO -> Info
- _ -> Attention
-
-runCam :: (IOE :> es, Logs '["cam", "libcamera"] es) => Eff (Cam : es) a -> Eff es a
-runCam action = do
- requestCallbackMVar <- liftIO newEmptyMVar
- bracketConst loggerAlloc loggerDealloc
- . bracketConst (requestCallbackAlloc requestCallbackMVar) requestCallbackDealloc
- . bracket_ logCaptureAlloc logCaptureDealloc
- . bracketLiftIO_ startCameraManager stopCameraManager
- . bracketLiftIO_ acquireCamera releaseCamera
- . bracketLiftIO_ allocateFrameBuffer freeFrameBuffer
- . bracketLiftIO_ startCamera stopCamera
- . bracketLiftIO_ createRequest (return ())
- . bracket mapDmaBuffer unmapDmaBuffer
- $ \dmaBuffer -> evalStaticRep (Cam Rep{..}) action
- where
- loggerAlloc = do
- logMsg @"cam" Info "Registering FFI logger"
- loggerIO <- makeLoggerIO @"cam"
- loggerFFI <- liftIO . makeLogger $ \severity message -> peekCString message >>= loggerIO (toEnum severity)
- liftIO $ registerLogger loggerFFI
- return loggerFFI
- loggerDealloc loggerFFI = do
- logMsg @"cam" Info "Unregistering FFI logger"
- liftIO $ freeHaskellFunPtr loggerFFI
- requestCallbackAlloc requestCallbackMVar = do
- logMsg @"cam" Info "Registering FFI request callback"
- requestCallbackFFI <- liftIO . makeRequestCallback $ putMVar requestCallbackMVar ()
- liftIO $ registerRequestCallback requestCallbackFFI
- return requestCallbackFFI
- requestCallbackDealloc requestCallbackFFI = do
- logMsg @"cam" Info "Unregistering FFI request callback"
- liftIO $ freeHaskellFunPtr requestCallbackFFI
- -- We use a named pipe (FIFO) to intercept libcamera's log output. The environment
- -- variables `LIBCAMERA_LOG_FILE` and `LIBCAMERA_LOG_LEVELS` configure libcamera
- -- to write logs to the FIFO with appropriate severity filtering.
- --
- -- A dedicated thread reads from the FIFO, parses log severity levels, and
- -- forwards messages to the application's logger with proper level mapping.
- logCaptureFifo = "/tmp/hsm-cam-libcamera.fifo"
- logCaptureClear = liftIO . whenM (doesFileExist logCaptureFifo) $ removeFile logCaptureFifo
- logCaptureSetEnvVar key value = do
- logMsg @"cam" Info $ "Setting env variable: " <> key <> "=" <> value
- liftIO $ setEnv key value
- logCaptureAlloc = do
- logCaptureClear
- logMsg @"cam" Info $ "Creating libcamera log capture FIFO at: " <> logCaptureFifo
- liftIO . createNamedPipe logCaptureFifo $ ownerReadMode .|. ownerWriteMode
- libCameraSeverity <- toLibCameraSeverity <$> getLevel @"libcamera"
- logCaptureSetEnvVar "LIBCAMERA_LOG_FILE" logCaptureFifo
- logCaptureSetEnvVar "LIBCAMERA_LOG_LEVELS" $ "*:" <> show libCameraSeverity
- loggerIO <- makeLoggerIO @"libcamera"
- logMsg @"cam" Info "Starting libcamera log capture"
- -- Thread handles multiline logs by maintaining severity state between lines.
- -- When a new line doesn't contain a parsable severity level, the previous
- -- line's level is reused to ensure continuous log context.
- liftIO . forkIO . withFile logCaptureFifo ReadWriteMode $ \handle ->
- flip iterateM_ DEBUG $ \previousSeverity -> do
- logLine <- hGetLine handle
- flip (maybe $ return previousSeverity) (words logLine !? 2 >>= readMaybe) $ \severity -> do
- loggerIO (fromLibCameraSeverity severity) logLine
- return severity
- logCaptureDealloc = do
- logMsg @"cam" Info "Removing libcamera log capture FIFO"
- logCaptureClear
- -- Memory maps the camera's DMA buffer for frame access
- mapSize = CSize $ toEnum frameBufferLength
- mapFlags = mkMmapFlags mapShared mempty
- mapDmaBuffer = do
- logMsg @"cam" Info "Mapping DMA buffer"
- liftIO $ getDmaBufferFd >>= \dmaBufferFd -> mmap nullPtr mapSize protRead mapFlags dmaBufferFd 0
- unmapDmaBuffer dmaBuffer = do
- logMsg @"cam" Info "Unmapping DMA buffer"
- liftIO $ munmap dmaBuffer mapSize
diff --git a/hsm-cam/Hsm/Cam/FFI.hsc b/hsm-cam/Hsm/Cam/FFI.hsc
deleted file mode 100644
index 6c5dd3d..0000000
--- a/hsm-cam/Hsm/Cam/FFI.hsc
+++ /dev/null
@@ -1,82 +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/Test/Cam.hs b/hsm-cam/Test/Cam.hs
deleted file mode 100644
index 94d3b73..0000000
--- a/hsm-cam/Test/Cam.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-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 Prelude hiding (writeFile)
-
-main :: IO ()
-main =
- forM_ [0 .. 31] (\index -> capturePng >>= writeFile ("/tmp/hsm-cam-test" <> show @Int index <> ".png"))
- & runCam
- & runLog @"cam" Trace
- & runLog @"libcamera" Info
- & runFileSystem
- & runEff
diff --git a/hsm-cam/hsm-cam.cabal b/hsm-cam/hsm-cam.cabal
deleted file mode 100644
index 7dd0dab..0000000
--- a/hsm-cam/hsm-cam.cabal
+++ /dev/null
@@ -1,79 +0,0 @@
-cabal-version: 3.8
-author: Paul Oliver <contact@pauloliver.dev>
-name: hsm-cam
-version: 0.1.0.0
-extra-source-files:
- FFI/Cam.cpp
- FFI/Cam.hpp
-
-library
- build-depends:
- , base
- , bytestring
- , directory
- , effectful-core
- , effectful-plugin
- , extra
- , hsm-core
- , hsm-log
- , JuicyPixels
- , monad-loops
- , primitive
- , shared-memory
- , unix
- , vector
-
- cxx-options: -O3 -Wall -Wextra -Werror -std=c++20
- cxx-sources: FFI/Cam.cpp
- default-language: GHC2024
- exposed-modules: Hsm.Cam
- extra-libraries:
- camera
- camera-base
- stdc++
-
- ghc-options:
- -O2 -Wall -Werror -Wno-star-is-type -Wunused-packages
- -fplugin=Effectful.Plugin
-
- include-dirs: FFI Hsm/Cam /usr/include/libcamera
- other-modules: Hsm.Cam.FFI
-
-executable test-cam
- build-depends:
- , base
- , bytestring
- , directory
- , effectful
- , effectful-core
- , effectful-plugin
- , extra
- , hsm-core
- , hsm-log
- , JuicyPixels
- , monad-loops
- , primitive
- , shared-memory
- , unix
- , vector
-
- cxx-options: -O3 -Wall -Wextra -Werror -std=c++20
- cxx-sources: FFI/Cam.cpp
- default-language: GHC2024
- extra-libraries:
- camera
- camera-base
- stdc++
-
- ghc-options:
- -O2 -threaded -Wall -Werror -Wno-star-is-type -Wunused-packages
- -fplugin=Effectful.Plugin
-
- if !arch(x86_64)
- ghc-options: -optl=-mno-fix-cortex-a53-835769
-
- include-dirs: FFI Hsm/Cam /usr/include/libcamera
- main-is: Test/Cam.hs
- other-modules:
- Hsm.Cam
- Hsm.Cam.FFI
powered by cgit v1.2.1, back to main portfolio site