From 3130cef3560473f7e01c3ad97c9cb8f4a9a213a2 Mon Sep 17 00:00:00 2001 From: Jonathan Lamothe Date: Wed, 21 Aug 2024 19:33:50 -0400 Subject: [PATCH] built framework for abacus widget --- abacus.cabal | 2 + src/Abacus/App.hs | 5 +- src/Abacus/App/Widgets.hs | 75 ++++++++++++++++++++++++++++++ src/Abacus/App/Widgets/Internal.hs | 51 ++++++++++++++++++++ 4 files changed, 131 insertions(+), 2 deletions(-) create mode 100644 src/Abacus/App/Widgets.hs create mode 100644 src/Abacus/App/Widgets/Internal.hs diff --git a/abacus.cabal b/abacus.cabal index 3559688..b86b0ba 100644 --- a/abacus.cabal +++ b/abacus.cabal @@ -22,6 +22,8 @@ library Abacus Abacus.App Abacus.App.Types + Abacus.App.Widgets + Abacus.App.Widgets.Internal Abacus.Internal other-modules: Paths_abacus diff --git a/src/Abacus/App.hs b/src/Abacus/App.hs index cda3f48..9d66ff5 100644 --- a/src/Abacus/App.hs +++ b/src/Abacus/App.hs @@ -32,13 +32,14 @@ import Brick , EventM , Widget , attrMap - , emptyWidget , halt , neverShowCursor , style ) +import Brick.Widgets.Center (center) import Abacus.App.Types +import Abacus.App.Widgets -- | Main application mainApp :: App AppState () () @@ -51,7 +52,7 @@ mainApp = App } drawFunc :: AppState -> [Widget ()] -drawFunc = const [emptyWidget] +drawFunc s = [center $ abacusW s] eventHandler :: BrickEvent () () -> EventM () AppState () eventHandler = const halt diff --git a/src/Abacus/App/Widgets.hs b/src/Abacus/App/Widgets.hs new file mode 100644 index 0000000..b321af9 --- /dev/null +++ b/src/Abacus/App/Widgets.hs @@ -0,0 +1,75 @@ +{-| + +Module : Abacus.App.Widgets +Description : Widget constructors +Copyright : (C) Jonathan Lamothe +License : AGPL-3.0-or-later +Maintainer : jonathan@jlamothe.net +Stability : experimental +Portability : POSIX + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU Affero General Public License as +published by the Free Software Foundation, either version 3 of the +License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Affero General Public License for more details. + +You should have received a copy of the GNU Affero General Public +License along with this program. If not, see +. + +-} + +module Abacus.App.Widgets (abacusW) where + +import Brick + ( Widget + , freezeBorders + , hBox + , hLimit + , str + , vBox + , withBorderStyle + ) +import Brick.Widgets.Border (hBorder) +import Brick.Widgets.Border.Style (unicode, unicodeBold) +import Lens.Micro.Platform ((^.)) + +import Abacus +import Abacus.App.Types +import Abacus.App.Widgets.Internal + +-- | Constructs a widget representing an abacus +abacusW :: AppState -> Widget () +abacusW s = hBox + [ abacusLeftW s + , withBorderStyle unicodeBold $ + freezeBorders $ + withBorderStyle unicode $ + beadsW $ s^.abacus + , abacusRightW s + ] + +abacusLeftW :: AppState -> Widget () +abacusLeftW = vBox . map str . abacusLeft + +beadsW :: Abacus -> Widget () +beadsW a = vBox $ map + (rungW $ getNumBeads a) + (beads a) + +abacusRightW :: AppState -> Widget () +abacusRightW = vBox . map str . abacusRight + +rungW :: Int -> (String, String) -> Widget () +rungW n (l, r) = hBox + [ str l + , hLimit n hBorder + , str r + ] + +--jl diff --git a/src/Abacus/App/Widgets/Internal.hs b/src/Abacus/App/Widgets/Internal.hs new file mode 100644 index 0000000..f196b83 --- /dev/null +++ b/src/Abacus/App/Widgets/Internal.hs @@ -0,0 +1,51 @@ +{-| + +Module : Abacus.App.Widgets.Internal +Description : Internal module intended for testing only +Copyright : (C) Jonathan Lamothe +License : AGPL-3.0-or-later +Maintainer : jonathan@jlamothe.net +Stability : experimental +Portability : POSIX + +This program is free software: you can redistribute it and/or modify +it under the terms of the GNU Affero General Public License as +published by the Free Software Foundation, either version 3 of the +License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +Affero General Public License for more details. + +You should have received a copy of the GNU Affero General Public +License along with this program. If not, see +. + +IMPORTANT NOTE + +This module should only be imported directly by the Abacus module and +the testing suite. Anything contained herein should be considered +subject to change without notice. + +-} + +module Abacus.App.Widgets.Internal ( + abacusLeft, + beads, + abacusRight, + ) where + +import Abacus +import Abacus.App.Types + +abacusLeft :: AppState -> [String] +abacusLeft = undefined + +beads :: Abacus -> [(String, String)] +beads = undefined + +abacusRight :: AppState -> [String] +abacusRight = undefined + +--jl