generate bounds and tidy up

bearlibterminal-hs.cabal → bearlibterminal.cabal

@@ -1,5 +1,5 @@
 cabal-version: 3.6
-name:          bearlibterminal-hs
+name:          bearlibterminal
 version:       0.0.1.0
 synopsis:      Low-level Haskell bindings to the bearlibterminal graphics library.
 description:   Low-level Haskell bindings to the bearlibterminal graphics library.
@@ -19,11 +19,12 @@ source-repository head
 
 common common-options
   build-depends:
-    base >= 4.17.2 && < 5
-    , text
-    , bytestring
-    , mtl
-    , unliftio
+      base >= 4.17.2 && < 5
+    , text >= 2.1.1 && < 2.2
+    , bytestring >= 0.12.1 && < 0.13
+    , mtl >= 2.3.1 && < 2.4
+    , unliftio >= 0.2.25 && < 0.3
+
   ghc-options:
     -Wall -Wcompat -Widentities -Wredundant-constraints
     -Wno-unused-packages -Wno-deprecations -fhide-source-paths
@@ -47,15 +48,14 @@ library
     cbits
 
 executable omni
-  import:          common-options
+  import: common-options
   hs-source-dirs:  omni
   main-is: Main.hs
   other-modules:
     Omni.Speed
   build-depends:
-    bearlibterminal-hs,
-    random,
-    word8,
-    bytestring,
-    vector,
-    time
+    bearlibterminal
+    , time >= 1.12.2 && < 1.13
+    , random >= 1.2.1 && < 1.3
+    , vector >= 0.13.1 && < 0.14
+    , word8 >= 0.1.3 && < 0.2

omni/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import BearLibTerminalExtras
+import BearLibTerminal
 import BearLibTerminal.Raw
 import Control.Monad
 import Control.Exception
@@ -69,6 +69,7 @@ alignRight = 2
 
 resetTerminal :: IO ()
 resetTerminal = do
+  -- TODO: I moved all the actual helper stuff to roguefunctor..
   -- todo: font:default, input filter to keyboard
-  void $ terminalSet defaultWindowOptions { title = Just "Omni: menu" }
+  --void $ terminalSetText "" defaultWindowOptions { title = Just "Omni: menu" }
   terminalColorNameText "white"

omni/Omni/Speed.hs

@@ -25,7 +25,7 @@ data Color a = Color !a !a !a
 shiftColor :: Int -> Color Word8
 shiftColor s =
   let (f :: Float) = fromIntegral (s `mod` 80) / 80.0
-      (Color r g b) = if
+      (Color r _g _b) = if
             | f < 0.33
                 -> Color (255 * ((0.33-f)/0.33)) (255 * ((f-0.0)/0.33)) 0
             | f < 0.66
@@ -83,7 +83,7 @@ runLoop (i, c) s s2 v = do
       -- terminal_color(color_from_another(100, shifted_b[(shift_f2+y-x)%80]));
       terminalPut x y 0x2588
       let (d :: Float) = abs $ 40.0 - fromIntegral (s `mod` 80)
-      terminalColorUInt (fromByteString $ B.pack [ min 255 (fromIntegral $ round ((128.0*d)/40.0)), 255, 255, 255 ])
+      terminalColorUInt (fromByteString $ B.pack [ min 255 (fromIntegral @Int $ round ((128.0*d)/40.0)), 255, 255, 255 ])
       -- int d = (int)std::fabs(40-(int)((shift_f)%80));
                         -- terminal_color(color_from_argb((int)(d/40.0f*128.0f), 255, 255, 255));
       terminalPut x y (fromEnum '0'))

src/BearLibTerminal.hs

@@ -1,121 +1,19 @@
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+
 module BearLibTerminal
   ( module BearLibTerminal.Raw
-  , BearLibConfigString(..)
-  , WindowOptions(..)
   , Event(..)
   , Keycode(..)
-  , BlockingMode(..)
   , WindowEvent(..)
-  , handleEvents
   , terminalRead
-  , initWindow
-  , withWindow
-  , defaultWindowOptions
   ) where
 
 import BearLibTerminal.Raw
-import Data.Text ( Text )
 import GHC.Generics
-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 qualified Data.Text.Lazy.Encoding as LT
-import qualified Data.ByteString as BS
-import qualified Data.Text.Lazy as TL
 import UnliftIO
 import Data.Function ((&))
 
-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
-
-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
-  , title :: Maybe Text
-  , icon :: Maybe FilePath
-  , resizeable :: Maybe Bool
-  , fullscreen :: Maybe Bool
-  } deriving stock (Show, Eq, Ord)
-
-defaultWindowOptions :: WindowOptions
-defaultWindowOptions = WindowOptions
-  { size = Just (80, 25)
-  , cellsize = Just Auto
-  , title = Just "BearLibTerminalExtras"
-  , 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 ';'
-
-initWindow :: MonadIO m => WindowOptions -> m ()
-initWindow opts = do
-  void $ terminalOpen
-  void $ terminalSet opts
-
-withWindow :: MonadUnliftIO m => WindowOptions -> m a -> (a -> m b) -> m c -> m b
-withWindow opts initialise loop exit = bracket
-  (initWindow opts >> initialise)
-  (const $ exit >> terminalClose)
-  loop
-
-data BlockingMode = Blocking | NotBlocking
-  deriving stock (Eq, Ord, Generic, Show, Bounded, Enum)
-
 data Event =
   Keypress Keycode
   | WindowEvent WindowEvent
@@ -129,11 +27,15 @@ data Keycode =
   | TkN | TkO | TkP | TkQ | TkR | TkS | TkT | TkU | TkV | TkW | TkX | TkY | TkZ
   | Tk1 | Tk2 | Tk3 | Tk4 | Tk5 | Tk6 | Tk7 | Tk8 | Tk9 | Tk0
   | TkEnter | TkEsc | TkBackspace | TkTab | TkSpace | TkMinus | TkEquals | TkLeftBracket
-  | TkRightBracket | TkBackslash | TkSemicolon | TkApostrophe | TkGrave | TkComma | TkPeriod
-  | TkSlash | Tk0x39 | TkF1 | TkF2 | TkF3 | TkF4 | TkF5 | TkF6 | TkF7 | TkF8 | TkF9 | TkF10
+  | TkRightBracket | TkBackslash | TkSemicolon | TkApostrophe | TkGrave | TkComma | TkPeriod | TkSlash
+  | Tk0x39 -- this seems to be missing from BLT, but adding it as a dummy makes the enum instance easier
+  | TkF1 | TkF2 | TkF3 | TkF4 | TkF5 | TkF6 | TkF7 | TkF8 | TkF9 | TkF10
   | TkF11 | TkF12 | Tk0x46 | Tk0x47 | TkPause | TkInsert | TkHome | TkPageUp | TkDelete | TkPageDown
-  | TkRight | TkLeft | TkDown | TkUp | Tk0x53 | TkKPDivide | TkKPMultiply | TkKPMinus | TkKPPlus
+  | TkRight | TkLeft | TkDown | TkUp
+  | Tk0x53 -- see also, Tk0x39
+  | TkKPDivide | TkKPMultiply | TkKPMinus | TkKPPlus
   | TkKPEnter | TkKP1 | TkKP2 | TkKP3 | TkKP4 | TkKP5 | TkKP6 | TkKP7 | TkKP8 | TkKP9 | TkKP0
+  -- there's a gap of 7 here
   | TkKPPeriod | TkShift | TkControl | TkAlt
   deriving stock (Eq, Ord, Generic, Show, Bounded, Enum)
 
@@ -159,19 +61,3 @@ terminalRead = do
     225 -> WindowEvent Resize
     224 -> WindowEvent WindowClose
     ikc -> Keypress . intToKeycode $ ikc
-
-handleEvents :: MonadIO m => BlockingMode -> (Event -> m a) -> m [a]
-handleEvents bm f = do
-  let allEvents :: MonadIO m => m [Event]
-      allEvents = go True
-        where
-          go isEmptySoFar = do
-            i <- terminalHasInput
-            if i || (bm == Blocking && isEmptySoFar)
-            then do
-              r <- terminalRead
-              (r :) <$> go False
-            else
-              pure []
-  ev <- allEvents
-  mapM f ev