built framework for abacus widget

This commit is contained in:
Jonathan Lamothe 2024-08-21 19:33:50 -04:00
parent 4ebb0bf393
commit 3130cef356
4 changed files with 131 additions and 2 deletions

View File

@ -22,6 +22,8 @@ library
Abacus Abacus
Abacus.App Abacus.App
Abacus.App.Types Abacus.App.Types
Abacus.App.Widgets
Abacus.App.Widgets.Internal
Abacus.Internal Abacus.Internal
other-modules: other-modules:
Paths_abacus Paths_abacus

View File

@ -32,13 +32,14 @@ import Brick
, EventM , EventM
, Widget , Widget
, attrMap , attrMap
, emptyWidget
, halt , halt
, neverShowCursor , neverShowCursor
, style , style
) )
import Brick.Widgets.Center (center)
import Abacus.App.Types import Abacus.App.Types
import Abacus.App.Widgets
-- | Main application -- | Main application
mainApp :: App AppState () () mainApp :: App AppState () ()
@ -51,7 +52,7 @@ mainApp = App
} }
drawFunc :: AppState -> [Widget ()] drawFunc :: AppState -> [Widget ()]
drawFunc = const [emptyWidget] drawFunc s = [center $ abacusW s]
eventHandler :: BrickEvent () () -> EventM () AppState () eventHandler :: BrickEvent () () -> EventM () AppState ()
eventHandler = const halt eventHandler = const halt

75
src/Abacus/App/Widgets.hs Normal file
View File

@ -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
<https://www.gnu.org/licenses/>.
-}
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

View File

@ -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
<https://www.gnu.org/licenses/>.
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