From aec73ec7936d085687030c466c24439ae8f12867 Mon Sep 17 00:00:00 2001 From: avery Date: Tue, 21 May 2024 16:21:41 +0200 Subject: [PATCH] DO some more binding --- bearmonadterminal/bearmonadterminal.cabal | 2 +- bearmonadterminal/cbits/BearMonadTerminal.h | 5 ++++ .../src/BearLibTerminal/Color.hs | 0 .../Raw.hs | 20 ++++++++++++---- bearmonadterminal/src/BearMonadTerminal.hs | 23 +++++++++++++++---- 5 files changed, 40 insertions(+), 10 deletions(-) create mode 100644 bearmonadterminal/src/BearLibTerminal/Color.hs rename bearmonadterminal/src/{BearMonadTerminal => BearLibTerminal}/Raw.hs (86%) diff --git a/bearmonadterminal/bearmonadterminal.cabal b/bearmonadterminal/bearmonadterminal.cabal index 8ab853a..9012ed0 100644 --- a/bearmonadterminal/bearmonadterminal.cabal +++ b/bearmonadterminal/bearmonadterminal.cabal @@ -38,7 +38,7 @@ library hs-source-dirs: src other-modules: BearMonadTerminal - BearMonadTerminal.Raw + BearLibTerminal.Raw extra-libraries: stdc++ BearLibTerminal include-dirs: cbits/ diff --git a/bearmonadterminal/cbits/BearMonadTerminal.h b/bearmonadterminal/cbits/BearMonadTerminal.h index 6ed5c94..7bd0b19 100644 --- a/bearmonadterminal/cbits/BearMonadTerminal.h +++ b/bearmonadterminal/cbits/BearMonadTerminal.h @@ -4,6 +4,11 @@ #include "BearLibTerminal.h" #include +void terminal_color_from_name(const char* name) +{ + terminal_color(color_from_name(name)); +} + void terminal_print_ptr(int x, int y, const char* s, dimensions_t* dim) { dimensions_t d = terminal_print(x, y, s); diff --git a/bearmonadterminal/src/BearLibTerminal/Color.hs b/bearmonadterminal/src/BearLibTerminal/Color.hs new file mode 100644 index 0000000..e69de29 diff --git a/bearmonadterminal/src/BearMonadTerminal/Raw.hs b/bearmonadterminal/src/BearLibTerminal/Raw.hs similarity index 86% rename from bearmonadterminal/src/BearMonadTerminal/Raw.hs rename to bearmonadterminal/src/BearLibTerminal/Raw.hs index f1452c0..74fbb6a 100644 --- a/bearmonadterminal/src/BearMonadTerminal/Raw.hs +++ b/bearmonadterminal/src/BearLibTerminal/Raw.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CApiFFI #-} {-# LANGUAGE RecordWildCards #-} -module BearMonadTerminal.Raw where +module BearLibTerminal.Raw where import Foreign.C.Types import Foreign.C.String @@ -10,6 +10,8 @@ import Foreign.Storable import Control.Monad.IO.Class import Data.ByteString import qualified Data.ByteString as BS +import Data.Text (Text) +import qualified Data.Text.Foreign as TF data Dimensions = Dimensions { width :: Int @@ -42,13 +44,23 @@ terminalClose = liftIO c_terminal_close foreign import capi safe "BearLibTerminal.h terminal_set" c_terminal_set :: CString -> IO CInt +bsToCString :: MonadIO m => (CString -> IO Bool) -> ByteString -> m Bool +bsToCString f = liftIO . flip BS.useAsCString f + +textToCString :: MonadIO m => (CString -> IO Bool) -> Text -> m Bool +textToCString f = liftIO . flip TF.withCString f + terminalSetCString :: MonadIO m => CString -> m Bool terminalSetCString = liftIO . (fmap asBool . c_terminal_set) terminalSetBS :: MonadIO m => ByteString -> m Bool -terminalSetBS = liftIO . flip BS.useAsCString terminalSetCString +terminalSetBS = bsToCString terminalSetCString + +terminalSetText :: MonadIO m => Text -> m Bool +terminalSetText = textToCString terminalSetCString -foreign import capi safe "BearLibTerminal.h terminal_color" c_terminal_color :: CUInt -> IO () +foreign import capi safe "BearLibTerminal.h terminal_color" c_terminal_color_uint :: CUInt -> IO () +foreign import capi safe "BearLibTerminal.h terminal_color" c_terminal_color_from_name :: CString -> IO () --terminalColorUInt :: foreign import capi safe "BearLibTerminal.h terminal_bkcolor" c_terminal_bkcolor :: CUInt -> IO () @@ -80,7 +92,7 @@ foreign import capi safe "BearLibTerminal.h terminal_has_input" c_terminal_has_i foreign import capi safe "BearLibTerminal.h terminal_read" c_terminal_read :: IO CInt foreign import capi safe "BearLibTerminal.h terminal_peek" c_terminal_peek :: IO CInt -- also read_wstr -foreign import capi safe "BearLibTerminal.h terminal_read_str" c_read_str :: CInt -> CInt -> Ptr CUChar -> CInt -> IO CUInt +foreign import capi safe "BearLibTerminal.h terminal_read_str" c_read_str :: CInt -> CInt -> Ptr CChar -> CInt -> IO CUInt foreign import capi safe "BearLibTerminal.h terminal_delay" c_terminal_delay :: CInt -> IO () -- not bothering with: color_from_name, color_from_argb diff --git a/bearmonadterminal/src/BearMonadTerminal.hs b/bearmonadterminal/src/BearMonadTerminal.hs index 171ecb4..1b280d1 100644 --- a/bearmonadterminal/src/BearMonadTerminal.hs +++ b/bearmonadterminal/src/BearMonadTerminal.hs @@ -16,7 +16,7 @@ import Foreign.Marshal.Alloc import Foreign.Storable import qualified Data.Text.Lazy.Encoding as LT import qualified Data.ByteString as BS -import qualified Data.Text.Internal.StrictBuilder as B +import qualified Data.Text.Lazy as TL class BearLibConfigString s where toConfigString :: s -> LT.Builder @@ -49,6 +49,9 @@ instance BearLibConfigString ConfigOption where toByteString :: BearLibConfigString c => c -> BS.ByteString toByteString = BS.toStrict . LT.encodeUtf8 . LT.toLazyText . toConfigString +terminalSet :: MonadIO m => BearLibConfigString c => c -> m Bool +terminalSet = terminalSetText . TL.toStrict . LT.toLazyText . toConfigString + data WindowOptions = WindowOptions { size :: Maybe (Int, Int) , cellsize :: Maybe Cellsize @@ -100,10 +103,20 @@ makeWindow = void $ runInBoundThread $ do c_terminal_close return () -initWindow :: MonadIO m => m () -initWindow = do +initWindow :: MonadIO m => WindowOptions -> m () +initWindow opts = do terminalOpen - terminalSet defaultWindowOptions + terminalSet opts + return () + + {-} liftIO $ c_terminal_refresh liftIO $ c_terminal_refresh - liftIO $ c_terminal_delay 5000 \ No newline at end of file + liftIO $ c_terminal_delay 5000 + -} + +omniMain :: MonadIO m => m () +omniMain = do + -- todo: font:default, input filter to keyboard + initWindow defaultWindowOptions { title = Just "Omni: menu" } + terminalColor "white"