Tidy up the bindings

bearmonadterminal/bearmonadterminal.cabal

@@ -20,22 +20,27 @@ source-repository head
 common common-options
   build-depends:
     base >= 4.17.2 && < 5
-
+    , text
+    , bytestring
+    , mtl
   ghc-options:
     -Wall -Wcompat -Widentities -Wredundant-constraints
     -Wno-unused-packages -Wno-deprecations -fhide-source-paths
     -Wno-unused-top-binds -Wmissing-deriving-strategies -O2
 
   default-language: GHC2021
   default-extensions:
+    DerivingStrategies
+    OverloadedStrings
 
 library
-  import:          common-options
+  import: common-options
   hs-source-dirs:  src
   other-modules:
     BearMonadTerminal
+    BearMonadTerminal.Raw
   extra-libraries: stdc++ BearLibTerminal
   include-dirs:
-    cbits
+    cbits/
   extra-lib-dirs:
-    cbits
+    cbits/

bearmonadterminal/cbits/BearMonadTerminal.h

@@ -0,0 +1,31 @@
+#ifndef BEARMONADTERMINAL_H
+#define BEARMONADTERMINAL_H
+
+#include "BearLibTerminal.h"
+#include <string.h>
+
+void terminal_print_ptr(int x, int y, const char* s, dimensions_t* dim)
+{
+  dimensions_t d = terminal_print(x, y, s);
+	memcpy(dim, &d, sizeof(*dim));
+}
+
+void terminal_print_ext_ptr(int x, int y, int w, int h, int align, const char* s, dimensions_t* dim)
+{
+	dimensions_t d = terminal_print_ext(x, y, w, h, align, s);
+	memcpy(dim, &d, sizeof(*dim));
+}
+
+void terminal_measure_ptr(const char* s, dimensions_t* dim)
+{
+	dimensions_t d = terminal_measure(s);
+	memcpy(dim, &d, sizeof(*dim));
+}
+
+void terminal_measure_ext_ptr(int w, int h, const char* s, dimensions_t* dim)
+{
+	dimensions_t d = terminal_measure_ext(w, h, s);
+	memcpy(dim, &d, sizeof(*dim));
+}
+
+#endif

bearmonadterminal/src/BearMonadTerminal.hs

@@ -1,62 +1,109 @@
-{-# LANGUAGE CApiFFI #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE RecordWildCards #-}
 module BearMonadTerminal where
 
-import Foreign.C.Types
-import Foreign.C.String
-import Foreign.Ptr
+import BearMonadTerminal.Raw
+import Data.Text ( Text )
+import Control.Monad.IO.Class (MonadIO (..))
+import GHC.Generics
+import Control.Concurrent (runInBoundThread)
+import Foreign.C
+import qualified Data.Text.Lazy.Builder as LT
+import qualified Data.List as L
+import Data.Maybe
+import qualified Data.Text as T
+import Data.Functor (void)
+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
 
-data Dimensions = Dimensions
-  { width :: CInt
-  , height :: CInt
+class BearLibConfigString s where
+  toConfigString :: s -> LT.Builder
+
+data Cellsize = Auto | Size (Int, Int)
+  deriving stock (Eq, Ord, Show, Generic)
+
+instance BearLibConfigString (Int, Int) where
+  toConfigString (x, y) = LT.fromString (show x) <> LT.singleton 'x' <> LT.fromString (show y)
+
+instance BearLibConfigString Cellsize where
+  toConfigString Auto = LT.fromText "auto"
+  toConfigString (Size s) = toConfigString s
+
+instance BearLibConfigString Text where
+  toConfigString s = LT.singleton '"' <> LT.fromText (T.replace "\"" "\"\"" s) <> LT.singleton '"'
+
+instance BearLibConfigString String where
+  toConfigString s = LT.singleton '"' <> LT.fromText (T.replace "\"" "\"\"" $ T.pack s) <> LT.singleton '"'
+
+instance BearLibConfigString Bool where
+  toConfigString True = LT.fromText "true"
+  toConfigString False = LT.fromText "false"
+
+newtype ConfigOption = ConfigOption { unConfig :: (Text, LT.Builder) }
+
+instance BearLibConfigString ConfigOption where
+  toConfigString (ConfigOption (t, v)) = LT.fromText t <> LT.singleton '=' <> v
+
+toByteString :: BearLibConfigString c => c -> BS.ByteString
+toByteString = BS.toStrict . LT.encodeUtf8 . LT.toLazyText . toConfigString
+
+data WindowOptions = WindowOptions
+  { size :: Maybe (Int, Int)
+  , cellsize :: Maybe Cellsize
+  , title :: Maybe Text
+  , icon :: Maybe FilePath
+  , resizeable :: Maybe Bool
+  , fullscreen :: Maybe Bool
+  } deriving stock (Show, Eq, Ord)
+
+defaultWindowOptions :: WindowOptions
+defaultWindowOptions = WindowOptions
+  { size = Just (80, 125)
+  , cellsize = Just Auto
+  , title = Just "BearMonadTerminal"
+  , icon = Nothing
+  , resizeable = Just False
+  , fullscreen = Just False
   }
+instance BearLibConfigString WindowOptions where
+  toConfigString WindowOptions{..} =
+    let f :: Functor f => BearLibConfigString g => Text -> f g -> f ConfigOption
+        f t = fmap (ConfigOption . (t,) . toConfigString)
+        mkOptions = map toConfigString $ catMaybes
+          [ f "size" size
+          , f "cellsize" cellsize
+          , f "title" title
+          -- todo: work out how filepaths should work
+          -- todo: this should probably be done with generics
+          , f "icon" icon
+          , f "resizeable" resizeable
+          , f "fullscreen" fullscreen
+          ]
+    in
+      case mkOptions of
+        [] -> mempty
+        opts -> LT.fromText "window: " <> mconcat (L.intersperse (LT.singleton ',') $ opts) <> LT.singleton ';'
+
+makeWindow :: IO ()
+makeWindow = void $ runInBoundThread $ do
+  void c_terminal_open
+  c_terminal_refresh
+  c_terminal_refresh
+  c_terminal_delay 1000
+  c2 <- newCString "hello, world!🐒"
+  v <- alloca (\p -> c_terminal_print_ptr 14 14 c2 p >> peek @Dimensions p)
+  print v
+  c_terminal_refresh
+  c_terminal_delay 5000
+  c_terminal_close
+  return ()
 
-instance Storable Dimensions where
-  sizeOf _ = 8
-  alignment _ = 4
-  poke p Dimensions{..} = do
-    pokeByteOff p 0 width
-    pokeByteOff p 4 height
-  peek p = do
-    width <- peekByteOff p 0
-    height <- peekByteOff p 4
-    return $ Dimensions width height
-
-foreign import capi unsafe "BearLibTerminal.h terminal_open" c_terminal_open :: IO CInt
-foreign import capi unsafe "BearLibTerminal.h terminal_close" c_terminal_close :: IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_set" c_terminal_set :: CString -> IO CInt
-
-foreign import capi unsafe "BearLibTerminal.h terminal_color" c_terminal_color :: CUInt -> IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_bkcolor" c_terminal_bkcolor :: CUInt -> IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_composition" c_terminal_composition :: CInt -> IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_layer" c_terminal_layer :: CInt -> IO ()
-
-foreign import capi unsafe "BearLibTerminal.h terminal_clear" c_terminal_clear :: IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_clear_area" c_terminal_clear_area :: CInt -> CInt -> CInt -> CInt -> IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_crop" c_terminal_crop :: CInt -> CInt -> CInt -> CInt -> IO ()
-foreign import capi safe "BearLibTerminal.h terminal_refresh" c_terminal_refresh :: IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_put" c_terminal_put :: CInt -> CInt -> CInt -> IO ()
-foreign import capi unsafe "BearLibTerminal.h terminal_pick" c_terminal_pick :: CInt -> CInt -> CInt -> IO CInt
-foreign import capi unsafe "BearLibTerminal.h terminal_pick_color" c_terminal_pick_color :: CInt -> CInt -> CInt -> IO CUInt
-foreign import capi unsafe "BearLibTerminal.h terminal_pick_bkcolor" c_terminal_pick_bkcolor :: CInt -> CInt -> IO CUInt
-foreign import capi unsafe "BearLibTerminal.h terminal_put_ext" c_terminal_put_ext :: CInt -> CInt -> CInt -> CInt -> CInt -> Ptr CUInt -> IO ()
-foreign import capi unsafe "BearMonadTerminal.h terminal_print_ptr" c_terminal_print_ptr :: CInt -> CInt -> CString -> Ptr Dimensions -> IO ()
---foreign import capi unsafe "BearLibTerminal.h terminal_printf" c_terminal_printf :: CInt -> CInt -> CString -> IO CUInt
---foreign import capi unsafe "BearLibTerminal.h terminal_wprint" c_terminal_wprint :: CInt -> CInt -> CString -> IO ()
---foreign import capi unsafe "BearLibTerminal.h terminal_wprintf" c_terminal_wprint :: CInt -> CInt -> CString -> IO ()
---foreign import capi unsafe "BearLibTerminal.h terminal_print_ext" c_terminal_print_ext :: CInt -> CInt -> CInt -> CInt -> CInt -> CString -> IO CUInt
--- also missing f/w options here, and also for measure
---foreign import capi unsafe "BearLibTerminal.h terminal_measure" c_terminal_measure :: CString -> IO CUInt
---foreign import capi unsafe "BearLibTerminal.h terminal_measure_ext" c_terminal_measure_ext :: CInt -> CInt -> CString -> IO CUInt
-
-foreign import capi unsafe "BearLibTerminal.h terminal_state" c_terminal_state :: CInt -> IO CInt
---foreign import capi unsafe "BearLibTerminal.h terminal_check" c_terminal_check :: CInt -> IO CInt
-foreign import capi unsafe "BearLibTerminal.h terminal_has_input" c_terminal_has_input :: IO CInt
-foreign import capi unsafe "BearLibTerminal.h terminal_read" c_terminal_read :: IO CInt
-foreign import capi unsafe "BearLibTerminal.h terminal_peek" c_terminal_peek :: IO CInt
--- also read_wstr
-foreign import capi unsafe "BearLibTerminal.h terminal_read_str" c_read_str :: CInt -> CInt -> Ptr CUChar -> CInt -> IO CUInt
-
--- not bothering with: terminal_delay, color_from_name, color_from_argb
+initWindow :: MonadIO m => m ()
+initWindow = do
+  terminalOpen
+  terminalSet defaultWindowOptions
+  liftIO $ c_terminal_refresh
+  liftIO $ c_terminal_refresh
+  liftIO $ c_terminal_delay 5000

bearmonadterminal/src/BearMonadTerminal/Raw.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE CApiFFI #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module BearMonadTerminal.Raw where
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Ptr
+import Foreign.Storable
+import Control.Monad.IO.Class
+import Data.ByteString
+import qualified Data.ByteString as BS
+
+data Dimensions = Dimensions
+  { width :: Int
+  , height :: Int
+  } deriving stock (Show)
+
+instance Storable Dimensions where
+  sizeOf _ = 8
+  alignment _ = 4
+  poke p Dimensions{..} = do
+    pokeByteOff p 0 width
+    pokeByteOff p 4 height
+  peek p = do
+    width <- peekByteOff p 0
+    height <- peekByteOff p 4
+    return $ Dimensions width height
+
+asBool :: CInt -> Bool
+asBool = (== 1)
+
+foreign import capi safe "BearLibTerminal.h terminal_open" c_terminal_open :: IO CInt
+
+terminalOpen :: MonadIO m => m Bool
+terminalOpen = asBool <$> liftIO c_terminal_open
+
+foreign import capi safe "BearLibTerminal.h terminal_close" c_terminal_close :: IO ()
+
+terminalClose :: MonadIO m => m ()
+terminalClose = liftIO c_terminal_close
+
+foreign import capi safe "BearLibTerminal.h terminal_set" c_terminal_set :: CString -> IO CInt
+
+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
+
+foreign import capi safe "BearLibTerminal.h terminal_color" c_terminal_color :: CUInt -> IO ()
+
+--terminalColorUInt ::
+foreign import capi safe "BearLibTerminal.h terminal_bkcolor" c_terminal_bkcolor :: CUInt -> IO ()
+foreign import capi safe "BearLibTerminal.h terminal_composition" c_terminal_composition :: CInt -> IO ()
+foreign import capi safe "BearLibTerminal.h terminal_layer" c_terminal_layer :: CInt -> IO ()
+
+foreign import capi safe "BearLibTerminal.h terminal_clear" c_terminal_clear :: IO ()
+foreign import capi safe "BearLibTerminal.h terminal_clear_area" c_terminal_clear_area :: CInt -> CInt -> CInt -> CInt -> IO ()
+foreign import capi safe "BearLibTerminal.h terminal_crop" c_terminal_crop :: CInt -> CInt -> CInt -> CInt -> IO ()
+foreign import capi safe "BearLibTerminal.h terminal_refresh" c_terminal_refresh :: IO ()
+foreign import capi safe "BearLibTerminal.h terminal_put" c_terminal_put :: CInt -> CInt -> CInt -> IO ()
+foreign import capi unsafe "BearLibTerminal.h terminal_pick" c_terminal_pick :: CInt -> CInt -> CInt -> IO CInt
+foreign import capi unsafe "BearLibTerminal.h terminal_pick_color" c_terminal_pick_color :: CInt -> CInt -> CInt -> IO CUInt
+foreign import capi unsafe "BearLibTerminal.h terminal_pick_bkcolor" c_terminal_pick_bkcolor :: CInt -> CInt -> IO CUInt
+foreign import capi safe "BearLibTerminal.h terminal_put_ext" c_terminal_put_ext :: CInt -> CInt -> CInt -> CInt -> CInt -> Ptr CUInt -> IO ()
+foreign import capi safe "BearMonadTerminal.h terminal_print_ptr" c_terminal_print_ptr :: CInt -> CInt -> CString -> Ptr Dimensions -> IO ()
+foreign import capi safe "BearMonadTerminal.h terminal_print_ext_ptr" c_terminal_print_ext_ptr :: CInt -> CInt -> CInt -> CInt -> CInt -> CString -> Ptr Dimensions -> IO ()
+-- I don't know if wchar is actually useful here.
+-- I don't care enough to try and wrap va_list around the printf variants.
+-- so that's printf, printf_ext, wprint, wprintf, wprint_ext, wprintf_ext
+-- measuref, wmeasure, measuref_ext, wmeasuref_ext
+foreign import capi unsafe "BearMonadTerminal.h terminal_measure_ptr" c_terminal_measure_ptr :: CString -> Ptr Dimensions -> IO ()
+foreign import capi unsafe "BearMonadTerminal.h terminal_measure_ext_ptr" c_terminal_measure_ext_ptr :: CInt -> CInt -> CString -> Ptr Dimensions -> IO ()
+
+foreign import capi safe "BearLibTerminal.h terminal_state" c_terminal_state :: CInt -> IO CInt
+-- unnecessary
+--foreign import capi unsafe "BearLibTerminal.h terminal_check" c_terminal_check :: CInt -> IO CInt
+foreign import capi safe "BearLibTerminal.h terminal_has_input" c_terminal_has_input :: IO CInt
+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_delay" c_terminal_delay :: CInt -> IO ()
+
+-- not bothering with: color_from_name, color_from_argb
+

hie.yaml

@@ -14,5 +14,6 @@ cradle:
 
     - path: "breadcrumbs"
       component: "lib:breadcrumbs"
+
     - path: "bearmonadterminal"
       component: "lib:bearmonadterminal"

yaifl-city/yaifl-city.cabal

@@ -76,7 +76,7 @@ executable yaifl-city
     Yaifl.Gen.Plan
     Yaifl.Gen.City.Building
     Yaifl.Gen.City.ApartmentTower
-    Yaifl.Gen.City.Apartment
+    Yaifl.Gen.City.Apartments
 
   build-depends:
     , effectful-th