aboutsummaryrefslogtreecommitdiff
path: root/hsm-cam
diff options
context:
space:
mode:
Diffstat (limited to 'hsm-cam')
-rw-r--r--hsm-cam/FFI/Cam.cpp85
-rw-r--r--hsm-cam/FFI/Cam.hpp25
-rw-r--r--hsm-cam/Hsm/Cam.hs87
-rw-r--r--hsm-cam/Hsm/Cam/FFI.hsc40
-rw-r--r--hsm-cam/Test/Cam.hs8
-rw-r--r--hsm-cam/hsm-cam.cabal64
6 files changed, 309 insertions, 0 deletions
diff --git a/hsm-cam/FFI/Cam.cpp b/hsm-cam/FFI/Cam.cpp
new file mode 100644
index 0000000..5f2ca1f
--- /dev/null
+++ b/hsm-cam/FFI/Cam.cpp
@@ -0,0 +1,85 @@
+#include <format>
+
+#include <libcamera/libcamera.h>
+
+#include "Cam.hpp"
+
+using namespace libcamera;
+using namespace std;
+
+HsLogger g_logger;
+HsCallback g_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 request_complete(Request *request) {
+ logMsg(Trace, "Completed request");
+ g_callback(request->buffers().begin()->second->planes()[0].fd.get());
+}
+
+extern "C" void register_logger(HsLogger hs_logger) {
+ g_logger = hs_logger;
+ logMsg(Info, "Registered FFI logger");
+}
+
+extern "C" void register_callback(HsCallback hs_callback) {
+ g_callback = hs_callback;
+ logMsg(Info, "Registered FFI callback");
+}
+
+extern "C" void initialize_ffi() {
+ logMsg(Info, "Starting camera manager");
+ g_manager = make_unique<CameraManager>();
+ g_manager->start();
+
+ logMsg(Info, "Acquiring camera");
+ g_camera = g_manager->cameras()[0];
+ g_camera->acquire();
+
+ logMsg(Info, "Generating still capture configuration");
+ g_config = g_camera->generateConfiguration({StreamRole::StillCapture});
+ g_camera->configure(g_config.get());
+
+ logMsg(Info, "Allocating buffer");
+ g_allocator = make_unique<FrameBufferAllocator>(g_camera);
+ g_allocator->allocate((*g_config)[0].stream());
+
+ logMsg(Info, "Registering request complete callback");
+ g_camera->requestCompleted.connect(request_complete);
+
+ logMsg(Info, "Starting camera");
+ g_camera->start();
+}
+
+extern "C" void shutdown_ffi() {
+ logMsg(Info, "Stopping camera");
+ g_camera->stop();
+
+ logMsg(Info, "Freeing frame buffer allocator");
+ g_allocator->free((*g_config)[0].stream());
+ g_allocator.reset();
+
+ logMsg(Info, "Releasing camera");
+ g_camera->release();
+ g_camera.reset();
+
+ logMsg(Info, "Stopping camera manager");
+ g_manager->stop();
+}
+
+extern "C" void request_capture() {
+ logMsg(Trace, "Requesting still capture");
+
+ Stream *stream = (*g_config)[0].stream();
+ g_request = g_camera->createRequest();
+ g_request->addBuffer(stream, g_allocator->buffers(stream)[0].get());
+ g_camera->queueRequest(g_request.get());
+}
diff --git a/hsm-cam/FFI/Cam.hpp b/hsm-cam/FFI/Cam.hpp
new file mode 100644
index 0000000..e59fa1d
--- /dev/null
+++ b/hsm-cam/FFI/Cam.hpp
@@ -0,0 +1,25 @@
+#ifndef CAM_HPP
+#define CAM_HPP
+
+enum Severity {
+ Attention = 0,
+ Info = 1,
+ Trace = 2,
+};
+
+typedef void (*HsLogger)(enum Severity, const char *);
+typedef void (*HsCallback)(int fd);
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+ void register_logger(HsLogger hs_logger);
+ void register_callback(HsCallback hs_callback);
+ void initialize_ffi();
+ void shutdown_ffi();
+ void request_capture();
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/hsm-cam/Hsm/Cam.hs b/hsm-cam/Hsm/Cam.hs
new file mode 100644
index 0000000..9857557
--- /dev/null
+++ b/hsm-cam/Hsm/Cam.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Hsm.Cam
+ ( Cam
+ , stillCapture
+ , runCam
+ )
+where
+
+import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)
+import Control.Monad (void)
+import Effectful (Dispatch (Static), DispatchOf, Eff, IOE, liftIO, (:>))
+import Effectful.Dispatch.Static
+ ( SideEffects (WithSideEffects)
+ , StaticRep
+ , evalStaticRep
+ , getStaticRep
+ , unsafeEff_
+ )
+import Effectful.Resource (Resource, allocateEff, allocateEff_)
+import Foreign.C.String (peekCString)
+import Foreign.Ptr (freeHaskellFunPtr)
+import Hsm.Cam.FFI
+ ( initializeFFI
+ , makeCallback
+ , makeLogger
+ , registerCallback
+ , registerLogger
+ , requestCapture
+ , shutdownFFI
+ )
+import Hsm.Log (Log, Severity (Info, Trace), getLoggerIO, logMsg)
+
+data Cam (a :: * -> *) (b :: *)
+
+type instance DispatchOf Cam = Static WithSideEffects
+
+newtype instance StaticRep Cam
+ = Cam (MVar Int)
+
+stillCapture :: (Log "cam" :> es, Cam :> es) => Eff es ()
+stillCapture = do
+ Cam fdVar <- getStaticRep
+ logMsg Trace "Requesting still capture"
+ fd <- unsafeEff_ $ requestCapture >> takeMVar fdVar
+ logMsg Trace $ "Still capture data available in FD " <> show fd
+
+runCam
+ :: (IOE :> es, Log "cam" :> es, Resource :> es)
+ => Eff (Cam : es) a
+ -> Eff es a
+runCam action = do
+ fdVar <- liftIO newEmptyMVar
+ void loggerBracket
+ void $ requestCallbackBracket fdVar
+ void ffiBracket
+ evalStaticRep (Cam fdVar) action
+ where
+ loggerBracket = allocateEff loggerAlloc loggerDealloc
+ where
+ loggerAlloc = do
+ logMsg Info "Registering FFI logger"
+ loggerIO <- getLoggerIO
+ loggerFFI <-
+ liftIO . makeLogger $ \severity message ->
+ peekCString message >>= loggerIO (toEnum severity)
+ liftIO $ registerLogger loggerFFI
+ return loggerFFI
+ loggerDealloc loggerFFI = do
+ logMsg Info "Unregistering FFI logger"
+ liftIO $ freeHaskellFunPtr loggerFFI
+ requestCallbackBracket fdVar =
+ allocateEff requestCallbackAlloc requestCallbackDealloc
+ where
+ requestCallbackAlloc = do
+ logMsg Info "Registering FFI callback"
+ requestCallbackFFI <- liftIO . makeCallback $ putMVar fdVar
+ liftIO $ registerCallback requestCallbackFFI
+ return requestCallbackFFI
+ requestCallbackDealloc requestCallbackFFI = do
+ logMsg Info "Unregistering FFI callback"
+ liftIO $ freeHaskellFunPtr requestCallbackFFI
+ ffiBracket = allocateEff_ ffiAlloc ffiDealloc
+ where
+ ffiAlloc = liftIO initializeFFI
+ ffiDealloc = liftIO shutdownFFI
diff --git a/hsm-cam/Hsm/Cam/FFI.hsc b/hsm-cam/Hsm/Cam/FFI.hsc
new file mode 100644
index 0000000..44f3f4b
--- /dev/null
+++ b/hsm-cam/Hsm/Cam/FFI.hsc
@@ -0,0 +1,40 @@
+{-# LANGUAGE CApiFFI #-}
+
+module Hsm.Cam.FFI
+ ( makeLogger
+ , registerLogger
+ , makeCallback
+ , registerCallback
+ , initializeFFI
+ , shutdownFFI
+ , requestCapture
+ )
+where
+
+import Foreign.C.String (CString)
+import Foreign.Ptr (FunPtr)
+
+type Logger = Int -> CString -> IO ()
+
+type Callback = Int -> IO ()
+
+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"
+ makeCallback :: Callback -> IO (FunPtr Callback)
+
+foreign import capi safe "Cam.hpp register_callback"
+ registerCallback :: FunPtr Callback -> IO ()
+
+foreign import capi safe "Cam.hpp initialize_ffi"
+ initializeFFI :: IO ()
+
+foreign import capi safe "Cam.hpp shutdown_ffi"
+ shutdownFFI :: IO ()
+
+foreign import capi safe "Cam.hpp request_capture"
+ requestCapture :: IO ()
diff --git a/hsm-cam/Test/Cam.hs b/hsm-cam/Test/Cam.hs
new file mode 100644
index 0000000..4cf9e7f
--- /dev/null
+++ b/hsm-cam/Test/Cam.hs
@@ -0,0 +1,8 @@
+import Data.Function ((&))
+import Effectful (runEff)
+import Effectful.Resource (runResource)
+import Hsm.Cam (runCam, stillCapture)
+import Hsm.Log (Severity (Trace), runLog)
+
+main :: IO ()
+main = stillCapture & runCam & runLog @"cam" Trace & runResource & runEff
diff --git a/hsm-cam/hsm-cam.cabal b/hsm-cam/hsm-cam.cabal
new file mode 100644
index 0000000..a4aa467
--- /dev/null
+++ b/hsm-cam/hsm-cam.cabal
@@ -0,0 +1,64 @@
+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
+ , effectful-core
+ , effectful-plugin
+ , hsm-log
+ , resourcet-effectful
+
+ cxx-options:
+ -O3 -Wall -Wextra -Werror -std=c++20 -I/usr/include/libcamera
+
+ 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
+ other-modules: Hsm.Cam.FFI
+
+executable test-cam
+ build-depends:
+ , base
+ , effectful-core
+ , effectful-plugin
+ , hsm-log
+ , resourcet-effectful
+
+ cxx-options:
+ -O3 -Wall -Wextra -Werror -std=c++20 -I/usr/include/libcamera
+
+ 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
+ main-is: Test/Cam.hs
+ other-modules:
+ Hsm.Cam
+ Hsm.Cam.FFI
powered by cgit v1.2.1, back to main portfolio site