termbox 1.1.0.2 → 2.0.0

raw patch · 10 files changed

+325/−193 lines, 10 filesdep ~termbox-bindings-hsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: termbox-bindings-hs

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−12
• src/Termbox.hs +15/−8
• src/Termbox/Internal/Cell.hs +0/−106
• src/Termbox/Internal/Color.hs +31/−5
• src/Termbox/Internal/Image.hs +104/−0
• src/Termbox/Internal/Key.hs +1/−1
• src/Termbox/Internal/Pos.hs +8/−1
• src/Termbox/Internal/Scene.hs +35/−51
• src/Termbox/Internal/Style.hs +99/−0
• termbox.cabal +13/−9

@@ -1,17 +1,24 @@-## [1.1.0.2] - 2023-10-15+## [2.0.0] - November 5, 2023 +- Overhaul `Cell`+`Scene` API; now it's `Image`+`Scene`+- Add `Eq` instance for `Color`+- Add `Semigroup`/`Monoid` instances for `Pos`+- Fix bug that left cursor shown when it should be hidden++## [1.1.0.2] - October 15, 2023+ - Support GHC 9.8.1 -## [1.1.0.1] - 2022-12-01+## [1.1.0.1] - December 1, 2022  - Make `char` applied to a wide character result in a space instead of nothing -## [1.1.0] - 2022-11-03+## [1.1.0] - November 3, 2022 -- Split off Elm Architecture wrapper into `termbox-tea` package, and expose `run`/`initialize`/`finalize` instead.+- Split off Elm Architecture wrapper into `termbox-tea` package, and expose `run`/`initialize`/`finalize` instead - Rename `Mouse` to `MouseButton`, rename its constructors, and add `Mouse` type (`MouseButton` + `Pos`) -## [1.0.0] - 2022-10-25+## [1.0.0] - October 25, 2022  - Rework `run`; add `Program` record of callbacks - Add user events to `Event` type@@ -27,7 +34,7 @@ - Support GHC 9.4 - Drop support for GHC < 8.8 -## [0.3.0] - 2020-09-20+## [0.3.0] - September 20, 2020  - Add `Cells` and `Cursor` types - Export `Termbox.Internal` module that roughly corresponds to the C library@@ -43,20 +50,20 @@ - Remove build dependency on `c2hs` - Remove support for GHC < 8.2 -## [0.2.0.1] - 2020-06-27+## [0.2.0.1] - June 27, 2020  - Bump `base` upper bound -## [0.2.0] - 2019-06-21+## [0.2.0] - June 21, 2019  - Add `getCells` function - Add `run` function - Rename `size` to `getSize`-- Rename `main` to `run_` and return errors as an `Either` instead of throwing.-- Make `Attr`'s `Semigroup` instance right-biased instead of left-biased.-- Make `Attr`'s `Num` instance total.+- Rename `main` to `run_` and return errors as an `Either` instead of throwing+- Make `Attr`'s `Semigroup` instance right-biased instead of left-biased+- Make `Attr`'s `Num` instance total - Remove `buffer` function -## [0.1.0] - 2018-07-18+## [0.1.0] - July 18, 2018  - Initial release

@@ -6,8 +6,6 @@ -- -- * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@, a @reactive-banana@ FRP interface. -- * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@, an Elm Architecture interface.------ This module is intended to be imported qualified. module Termbox   ( -- * Main     run,@@ -19,20 +17,29 @@      -- ** Scene     Scene,-    render,-    cell,+    image,     fill,     cursor,+    render, -    -- ** Cell-    Cell,+    -- ** Image+    Image,     char,++    -- *** Color     fg,     bg,++    -- *** Style     bold,     underline,     blink, +    -- *** Translation+    at,+    atRow,+    atCol,+     -- ** Colors     Color, @@ -83,7 +90,6 @@   ) where -import Termbox.Internal.Cell (Cell, bg, blink, bold, char, fg, underline) import Termbox.Internal.Color   ( Color,     blue,@@ -99,6 +105,7 @@     yellow,   ) import Termbox.Internal.Event (Event (..), poll)+import Termbox.Internal.Image (Image, at, atCol, atRow, bg, blink, bold, char, fg, underline) import Termbox.Internal.Key   ( Key (..),     pattern KeyCtrl2,@@ -125,5 +132,5 @@       ),   ) import Termbox.Internal.Pos (Pos (..), posDown, posLeft, posRight, posUp)-import Termbox.Internal.Scene (Scene, cell, cursor, fill, render)+import Termbox.Internal.Scene (Scene, cursor, fill, image, render) import Termbox.Internal.Size (Size (..), getSize)

@@ -1,106 +0,0 @@-module Termbox.Internal.Cell-  ( -- * Cell-    Cell,-    drawCell,-    char,--    -- ** Color-    fg,-    bg,--    -- ** Style-    bold,-    underline,-    blink,-  )-where--import qualified Data.Char as Char-import Data.String (IsString (..))-import Foreign.C.Types (CInt (CInt), CWchar (CWchar))-import qualified Termbox.Bindings.Hs-import Termbox.Internal.Color (Color (Color))---- | A single cell.------ * Create a cell with 'char', or with a string literal.--- * Set a cell's color with 'fg', 'bg'.--- * Style a cell with 'bold', 'underline', 'blink'.-data Cell-  = CellFg-      {-# UNPACK #-} !Char -- invariant: char is width 1-      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg-  | CellFgBlink-      {-# UNPACK #-} !Char -- invariant: char is width 1-      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg-  | CellFgBg-      {-# UNPACK #-} !Char -- invariant: char is width 1-      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- fg-      {-# UNPACK #-} !Termbox.Bindings.Hs.Tb_color -- bg--instance {-# OVERLAPS #-} IsString [Cell] where-  fromString =-    map char--drawCell :: Termbox.Bindings.Hs.Tb_color -> Int -> Int -> Cell -> IO ()-drawCell bg0 col row = \case-  CellFg ch fg_ -> Termbox.Bindings.Hs.tb_change_cell col row ch fg_ bg0-  CellFgBlink ch fg_ -> Termbox.Bindings.Hs.tb_change_cell col row ch fg_ (makeBold bg0) -- bold background = blink-  CellFgBg ch fg_ bg_ -> Termbox.Bindings.Hs.tb_change_cell col row ch fg_ bg_---- | Create a cell from a character.------ If the character is not 1 character wide, it will not be displayed.-char :: Char -> Cell-char ch =-  CellFg (if wcwidth (charToCWchar ch) == 1 then ch else ' ') Termbox.Bindings.Hs.TB_DEFAULT---- | Set the foreground color of a cell.-fg :: Color -> Cell -> Cell-fg (Color color) = \case-  CellFg ch _ -> CellFg ch color-  CellFgBlink ch _ -> CellFgBlink ch color-  CellFgBg ch _ bg_ -> CellFgBg ch color bg_---- | Set the background color of a cell.-bg :: Color -> Cell -> Cell-bg (Color color) = \case-  CellFg ch fg_ -> CellFgBg ch fg_ color-  CellFgBlink ch fg_ -> CellFgBg ch fg_ (makeBold color) -- bold background = blink-  CellFgBg ch fg_ _ -> CellFgBg ch fg_ color---- | Make a cell bold.-bold :: Cell -> Cell-bold = \case-  CellFg ch fg_ -> CellFg ch (makeBold fg_)-  CellFgBlink ch fg_ -> CellFgBlink ch (makeBold fg_)-  CellFgBg ch fg_ bg_ -> CellFgBg ch (makeBold fg_) bg_---- | Make a cell underlined.-underline :: Cell -> Cell-underline = \case-  CellFg ch fg_ -> CellFg ch (makeUnderline fg_)-  CellFgBlink ch fg_ -> CellFgBlink ch (makeUnderline fg_)-  CellFgBg ch fg_ bg_ -> CellFgBg ch (makeUnderline fg_) bg_---- | Make a cell blink.-blink :: Cell -> Cell-blink = \case-  CellFg ch fg_ -> CellFgBlink ch fg_-  CellFgBlink ch fg_ -> CellFgBlink ch fg_-  CellFgBg ch fg_ bg_ -> CellFgBg ch fg_ (makeBold bg_) -- bold background = blink--makeBold :: Termbox.Bindings.Hs.Tb_color -> Termbox.Bindings.Hs.Tb_color-makeBold =-  Termbox.Bindings.Hs.tb_attr Termbox.Bindings.Hs.TB_BOLD--makeUnderline :: Termbox.Bindings.Hs.Tb_color -> Termbox.Bindings.Hs.Tb_color-makeUnderline =-  Termbox.Bindings.Hs.tb_attr Termbox.Bindings.Hs.TB_UNDERLINE--charToCWchar :: Char -> CWchar-charToCWchar =-  fromIntegral @Int @CWchar . Char.ord--foreign import capi unsafe "wchar.h wcwidth"-  wcwidth :: CWchar -> CInt

@@ -1,5 +1,6 @@ module Termbox.Internal.Color-  ( Color (..),+  ( -- * Color+    Color (..),     defaultColor,     red,     green,@@ -11,12 +12,18 @@     bright,     color,     gray,++    -- * MaybeColor+    MaybeColor,+    unMaybeColor,+    nothingColor,+    justColor,   ) where  import Data.Coerce (coerce) import Data.Word (Word16)-import qualified Termbox.Bindings.Hs+import Termbox.Bindings.Hs  -- | A color. --@@ -26,7 +33,8 @@ -- * Miscellaneous colors, such as @'color' 33@. -- * Monochrome colors that range from black (@'gray' 0@) to white (@'gray' 23@). newtype Color-  = Color Termbox.Bindings.Hs.Tb_color+  = Color Tb_color+  deriving newtype (Eq)  defaultColor :: Color defaultColor =@@ -60,12 +68,12 @@ white =   Color 7 --- | Make a basic color brighter.+-- | Make a basic color bright. bright :: Color -> Color bright =   coerce bright_ -bright_ :: Termbox.Bindings.Hs.Tb_color -> Termbox.Bindings.Hs.Tb_color+bright_ :: Tb_color -> Tb_color bright_ c   | c <= 7 = c + 8   | otherwise = c@@ -83,3 +91,21 @@ gray :: Int -> Color gray =   coerce (fromIntegral @Int @Word16 . (+ 232) . max 0 . min 23)++-- This is a more efficient `Maybe Color`; we represent Nothing by WORD_MAX (which isn't a valid termbox color)+newtype MaybeColor+  = MaybeColor Color+  deriving stock (Eq)++unMaybeColor :: MaybeColor -> Tb_color+unMaybeColor (MaybeColor (Color (Tb_color c)))+  | c == maxBound = TB_DEFAULT+  | otherwise = Tb_color c++nothingColor :: MaybeColor+nothingColor =+  MaybeColor (Color (Tb_color maxBound))++justColor :: Color -> MaybeColor+justColor =+  MaybeColor

@@ -0,0 +1,104 @@+module Termbox.Internal.Image+  ( Image (..),+    char,+    at,+    atRow,+    atCol,+    fg,+    bg,+    bold,+    underline,+    blink,+  )+where++import qualified Data.Char as Char+import Foreign.C (CInt (..), CWchar (..))+import Termbox.Bindings.Hs (tb_change_cell)+import Termbox.Internal.Color (Color)+import Termbox.Internal.Pos (Pos (..))+import Termbox.Internal.Style (Style)+import qualified Termbox.Internal.Style as Style++-- | An image.+--+-- * Create an image with 'char'.+-- * Set an image's color with 'fg' \/ 'bg'.+-- * Style an image with 'bold' \/ 'underline' \/ 'blink'.+-- * Translate an image with 'at' \/ 'atRow' \/ 'atCol'.+-- * Overlay an image atop another with @(<>)@.+newtype Image+  = Image (Pos -> Style -> IO ())++instance Monoid Image where+  mempty = Image mempty++instance Semigroup Image where+  Image f <> Image g =+    Image \pos style -> do+      f pos style+      g pos style++-- | Create an image from a character.+--+-- If the character is not 1 character wide, it will not be displayed.+char :: Char -> Image+char ch =+  Image \Pos {row, col} style ->+    tb_change_cell+      col+      row+      (if wcwidth (charToCWchar ch) == 1 then ch else ' ')+      (Style.asForeground style)+      (Style.asBackground style)++-- | Translate an image.+at :: Pos -> Image -> Image+at offset (Image draw) =+  Image \pos -> draw (pos <> offset)++-- | Translate an image by a number of rows.+atRow :: Int -> Image -> Image+atRow row =+  at (Pos row 0)++-- | Translate an image by a number of columns.+atCol :: Int -> Image -> Image+atCol col =+  at (Pos 0 col)++styled :: Style -> Image -> Image+styled overrides (Image draw) =+  Image \pos style -> draw pos (overrides <> style)++-- | Set the foreground color of an image.+fg :: Color -> Image -> Image+fg =+  styled . Style.fg++-- | Set the background color of an image.+bg :: Color -> Image -> Image+bg =+  styled . Style.bg++-- | Make an image bold.+bold :: Image -> Image+bold =+  styled Style.bold++-- | Make an image underlined.+underline :: Image -> Image+underline =+  styled Style.underline++-- | Make an image blink.+blink :: Image -> Image+blink =+  styled Style.blink++charToCWchar :: Char -> CWchar+charToCWchar =+  fromIntegral @Int @CWchar . Char.ord++foreign import capi unsafe "wchar.h wcwidth"+  wcwidth :: CWchar -> CInt

@@ -22,7 +22,7 @@ -- indistinguishable from @Ctrl+M@. Pattern synonyms below are provided for an alternate syntax in these cases, if -- desired. data Key-  = KeyChar Char+  = KeyChar !Char   | KeyArrowDown   | KeyArrowLeft   | KeyArrowRight

@@ -9,12 +9,19 @@  import GHC.Generics (Generic) --- | A terminal position.+-- | A relative terminal position. data Pos = Pos   { row :: {-# UNPACK #-} !Int,     col :: {-# UNPACK #-} !Int   }   deriving stock (Eq, Generic, Ord, Show)++instance Monoid Pos where+  mempty = Pos 0 0++instance Semigroup Pos where+  Pos row1 col1 <> Pos row2 col2 =+    Pos (row1 + row2) (col1 + col2)  -- | Move a position up. posUp :: Int -> Pos -> Pos

@@ -1,71 +1,55 @@ module Termbox.Internal.Scene   ( Scene,     render,-    cell,+    image,     fill,     cursor,   ) where -import qualified Termbox.Bindings.Hs-import Termbox.Internal.Cell (Cell, drawCell)-import Termbox.Internal.Color (Color (Color))+import Termbox.Bindings.Hs hiding (bg)+import Termbox.Internal.Color (Color, MaybeColor, justColor, nothingColor, unMaybeColor)+import Termbox.Internal.Image (Image (..)) import Termbox.Internal.Pos (Pos (..))+import qualified Termbox.Internal.Style as Style --- | A scene.+-- | A scene, which contains an image, an optional background fill color, and an optional cursor. ----- * Set individual cells with 'cell'.--- * Set the background fill color with 'fill'.--- * Set the cursor position with 'cursor'.--- * Combine scenes together with @<>@.+-- * Create a scene with 'image'.+-- * Set a scene\'s background fill color with 'fill'.+-- * Set a scene\'s cursor position with 'cursor'. data Scene = Scene-  { sceneFill :: Maybe Termbox.Bindings.Hs.Tb_color,-    sceneDraw :: Termbox.Bindings.Hs.Tb_color -> IO ()+  { sceneDraw :: !(MaybeColor -> IO ()),+    sceneFill :: {-# UNPACK #-} !MaybeColor   } -instance Monoid Scene where-  mempty =-    Scene-      { sceneFill = Nothing,-        sceneDraw = \_ -> pure ()-      }--instance Semigroup Scene where-  Scene fill0 draw0 <> Scene fill1 draw1 =-    Scene-      { sceneFill =-          case fill1 of-            Nothing -> fill0-            Just _ -> fill1,-        sceneDraw =-          \color -> do-            draw0 color-            draw1 color-      }- -- | Render a scene. render :: Scene -> IO () render Scene {sceneFill, sceneDraw} = do-  let background =-        case sceneFill of-          Nothing -> Termbox.Bindings.Hs.TB_DEFAULT-          Just color -> color-  Termbox.Bindings.Hs.tb_set_clear_attributes Termbox.Bindings.Hs.TB_DEFAULT background-  Termbox.Bindings.Hs.tb_clear-  sceneDraw background-  Termbox.Bindings.Hs.tb_present+  tb_set_cursor Nothing+  tb_set_clear_attributes TB_DEFAULT (unMaybeColor sceneFill)+  tb_clear+  sceneDraw sceneFill+  tb_present --- | Set the background fill color.-fill :: Color -> Scene-fill (Color color) =-  mempty {sceneFill = Just color}+-- | Create a scene from an image.+image :: Image -> Scene+image (Image draw) =+  Scene+    { sceneDraw = draw mempty . Style.maybeFill,+      sceneFill = nothingColor+    } --- | Set a single cell.-cell :: Pos -> Cell -> Scene-cell Pos {col, row} img =-  mempty {sceneDraw = \bg -> drawCell bg col row img}+-- | Set a scene's background fill color.+fill :: Color -> Scene -> Scene+fill color scene =+  scene {sceneFill = justColor color} --- | Set the cursor position.-cursor :: Pos -> Scene-cursor Pos {col, row} =-  mempty {sceneDraw = \_ -> Termbox.Bindings.Hs.tb_set_cursor (Just (col, row))}+-- | Set a scene's cursor position.+cursor :: Pos -> Scene -> Scene+cursor Pos {col, row} scene =+  scene+    { sceneDraw = \background -> do+        sceneDraw scene background+        tb_set_cursor (Just (col, row))+    }

@@ -0,0 +1,99 @@+module Termbox.Internal.Style+  ( Style,+    asForeground,+    asBackground,+    maybeFill,+    fg,+    bg,+    bold,+    underline,+    blink,+  )+where++import Termbox.Bindings.Hs hiding (bg, fg)+import Termbox.Internal.Color (Color, MaybeColor, justColor, nothingColor, unMaybeColor)++data Style = Style+  { foreground :: {-# UNPACK #-} !ColorAndAttr,+    background :: {-# UNPACK #-} !ColorAndAttr+  }++instance Monoid Style where+  mempty =+    Style mempty mempty++-- right-biased+instance Semigroup Style where+  Style a1 b1 <> Style a2 b2 =+    Style (a2 <> a1) (b2 <> b1)++-- Render a style as a foreground `tb_color`.+asForeground :: Style -> Tb_color+asForeground Style {foreground} =+  renderColorAndAttr foreground++-- Render a style as a background `tb_color`.+asBackground :: Style -> Tb_color+asBackground Style {background} =+  renderColorAndAttr background++onlyForeground :: ColorAndAttr -> Style+onlyForeground style =+  mempty {foreground = style}++onlyBackground :: ColorAndAttr -> Style+onlyBackground style =+  mempty {background = style}++maybeFill :: MaybeColor -> Style+maybeFill color =+  onlyBackground ColorAndAttr {color, attr = mempty}++fg :: Color -> Style+fg =+  onlyForeground . onlyColor++bg :: Color -> Style+bg =+  onlyBackground . onlyColor++bold :: Style+bold =+  onlyForeground (onlyAttr TB_BOLD)++underline :: Style+underline =+  onlyForeground (onlyAttr TB_UNDERLINE)++blink :: Style+blink =+  onlyBackground (onlyAttr TB_BOLD)++data ColorAndAttr = ColorAndAttr+  { color :: {-# UNPACK #-} !MaybeColor,+    attr :: {-# UNPACK #-} !Tb_attr+  }++instance Monoid ColorAndAttr where+  mempty =+    ColorAndAttr nothingColor mempty++-- right-biased+instance Semigroup ColorAndAttr where+  ColorAndAttr color1 attr1 <> ColorAndAttr color2 attr2 =+    ColorAndAttr+      (if color2 == nothingColor then color1 else color2)+      (attr1 <> attr2)++renderColorAndAttr :: ColorAndAttr -> Tb_color+renderColorAndAttr ColorAndAttr {color, attr} =+  tb_attr attr (unMaybeColor color)++onlyColor :: Color -> ColorAndAttr+onlyColor color =+  mempty {color = justColor color}++onlyAttr :: Tb_attr -> ColorAndAttr+onlyAttr attr =+  mempty {attr}

@@ -9,12 +9,15 @@   This package provides a high-level wrapper around @termbox@, a simple C   library for writing text-based user interfaces: <https://github.com/termbox/termbox>   .-  See also:+  See also the higher-level interfaces:   .-  * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@ for a @reactive-banana@ FRP interface.-  * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@ for an Elm Architecture interface.-  * @<https://hackage.haskell.org/package/termbox-bindings-hs termbox-bindings-hs>@ for lower-level bindings.-  * @<https://hackage.haskell.org/package/termbox-bindings-c termbox-bindings-c>@ for even lower-level bindings.+  * @<https://hackage.haskell.org/package/termbox-banana termbox-banana>@, a @reactive-banana@ FRP interface.+  * @<https://hackage.haskell.org/package/termbox-tea termbox-tea>@, an Elm Architecture interface.+  .+  And the lower-level interfaces:+  .+  * @<https://hackage.haskell.org/package/termbox-bindings-hs termbox-bindings-hs>@, direct Haskell-flavored bindings.+  * @<https://hackage.haskell.org/package/termbox-bindings-c termbox-bindings-c>@, direct C-flavored bindings. homepage: https://github.com/termbox/termbox-haskell license: BSD-3-Clause license-file: LICENSE@@ -22,9 +25,9 @@ name: termbox synopsis: termbox tested-with: GHC == 9.4.7, GHC == 9.6.3, GHC == 9.8.1-version: 1.1.0.2+version: 2.0.0 -extra-source-files:+extra-doc-files:   CHANGELOG.md  source-repository head@@ -77,16 +80,17 @@   import: component   build-depends:     base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 || ^>= 4.17 || ^>= 4.18 || ^>= 4.19,-    termbox-bindings-hs ^>= 0.1,+    termbox-bindings-hs ^>= 0.1.1,   exposed-modules: Termbox   hs-source-dirs: src   other-modules:-    Termbox.Internal.Cell     Termbox.Internal.Color     Termbox.Internal.Event+    Termbox.Internal.Image     Termbox.Internal.Key     Termbox.Internal.Main     Termbox.Internal.Mouse     Termbox.Internal.Pos     Termbox.Internal.Size     Termbox.Internal.Scene+    Termbox.Internal.Style