I want to write a program that displays the word "MEGALASER" on my terminal screen, adding a marquee effect to make it scroll left.
To be more concrete, on running the program the terminal window should show:
|\\ //|/========= /======== //====\\ || //====\\ //========/=========||=======\
||\\ //|||| // |/ \||| |/ \||| || || ||
|| \\// ||====== || ====\||======|||| ||======||\\======||====== ||=======/
|| |||| \\ |||| |||| || || |||| || \\
|| ||\========= \========|| ||\\========|| ||========//\=========|| \\Additionally, every tenth of a second, I want one column of characters to disappear into the left boundary of my screen.
After one second, or ten tenths of a second, the image on the screen should change to:
/========= /======== //====\\ || //====\\ //========/=========||=======\
|| // |/ \||| |/ \||| || || ||
====== || ====\||======|||| ||======||\\======||====== ||=======/
|| \\ |||| |||| || || |||| || \\
\========= \========|| ||\\========|| ||========//\=========|| \\When there are no more character columns left, the program should end and take me back to the prompt.
As far as tools go, I'd like to use the Haskell package brick to achieve the objective.
cabal-install 3.0.0.0The executable stanza of this project's Cabal file looks like
-- megalaser.cabal
executable megalaser
main-is: Megalaser.hs
build-depends: base >= 4.11.1 && < 4.12
, brick >= 0.52 && < 0.53
, vty >= 5.27 && < 5.28
default-language: Haskell2010
ghc-options: -O -threaded -Wallbrick needs the -threaded under ghc-options. Please don't omit it!
The -O and -Wall are optional, yet helpful.
brick, Real QuickThroughout this section, keep in mind that brick is a model-view-controller framework.
Your application's main will generally call one of the three functions with result type IO a that brick provides.
simpleMain, which does not allow event handling of any kind. It's just a static user interface.
simpleMain
:: Ord n
=> Widget n -- the user interface to be rendered on-screen
-> IO ()defaultMain, which allows you to specify an initial state, as well as event handlers which will change the state in response to key presses and mouse movements. Custom events, including time-based events, are out of scope.
defaultMain
:: Ord n
=> App s e n {- a bundle of values used to update the
-- application's state in response to events
-}
-> s -- the application's initial state
-> IO scustomMain, which allows you to define custom events in addition to everything you can do with defaultMain.
customMain
:: Ord n
=> Vty -- initial Vty handle
-> IO Vty {- an IO action to build a Vty handle, used when
-- the terminal needs to be reinitialized
-}
-> Maybe (BChan e) {- a stack to which user defined events can be
-- added, and from which they can be removed
-}
-> App s e n {- a bundle of values used to update the
-- application's state in response to events
-}
-> s -- the application's initial state
-> IO sTo use these functions in a Haskell program, you need to know how to create values that belong to the types Widget n, App s e n, Vty, and BChan e.
VtyA value of type Vty can be created using functions from the vty package.
Consider the function
Graphics.Vty.mkVty
:: Graphics.Vty.Config.Config {- a configuration value to change the
-- behavior of the Vty handle
-}
-> IO Graphics.Vty.VtyGraphics.Vty.Config.defaultConfig provides a ready-made configuration.
If that isn't good enough, look at the other options in the Graphics.Vty.Config module.
Widget nThe brick package has functions to create values of the type Widget n.
There's Brick.Widgets.Core.str :: String -> Brick.Types.Widget n, which renders a string in the terminal as-is.
The Brick.Widgets.Core module has many more options, but this project will use str exclusively.
It's worth mentioning that values belonging to Widget n can be packed vertically, using Brick.Widgets.Core.(<+>), and also horizontally, using Brick.Widgets.Core.(<=>).
BChan eYou can create values of type BChan e using the function
Brick.BChan.newBChan
:: Int -- maximum capacity of the channel
-> IO (Brick.Types.BChan a)To add an element of type e to a BChan e, use
Brick.BChan.writeBChan :: Brick.Types.BChan a -> a -> IO ()Generally events are automatically removed from a channel by customMain.
App s e nThe type App s e n appears often in the type signature above.
Brick.Main.App
s -- the application state type
e -- the application event type
n -- values of this type can be assigned as names to resources
{ appDraw
:: s -- the state to render
-> [Widget n] -- how the state should look when rendered
, appChooseCursor
:: s -- application's state
-> [CursorLocation n] {- a list of cursor locations
-- requested by various widgets
-}
-> Maybe (CursorLocation n) -- the definitive cursor location
, appHandleEvent
:: s -- application's state
-> BrickEvent n e {- the event to handle, it could be
-- a custom or default event
-}
-> EventM n (Next s) -- how to handle the event
, appStartEvent
:: s -- application's state
-> EventM n s -- how to handle the start of the application
, appAttrMap
:: s -- application's state
-> AttrMap {- a mapping between attribute names and attributes,
-- where attributes are basically color schemes
-}
}CursorLocation nBrick.Types.CursorLocation n has just one constructor
Brick.Types.CursorLocation
:: Brick.Types.Location -- a wrapper around a row, column pair
-> Maybe n {- the name of the Widget to which this
-- location belongs
-}
-> Brick.Types.CursorLocation nBrick.Types.Location also has just one constructor
Brick.Types.Location
:: (Int, Int) -- the row and column of the location
-> Brick.Types.LocationBrickEvent n eA value of this type doesn't need to be supplied, it has to be decomposed.
Check the documentation for the Brick.Types module for information about BrickEvent's different constructors - there's one for default Vty events, one for user defined events, and finally two for mouse events.
EventM n sThe Brick.Main module provides functions that can generate values belonging to Brick.Types.EventM n s. Here are two such functions.
Brick.Main.continue
:: s -- the application's new state
-> Brick.Types.EventM n (Next s)Brick.Main.halt
:: s -- the application's final state
-> Brick.Types.EventM n (Next s)There are other functions as well, but this project doesn't use them.
AttrMapThe easiest way to create a value of type AttrMap is to use the function
Brick.AttrMap.forceAttrMap
:: Graphics.Vty.Attributes.Attr -- defines color and style of characters
-> Brick.AttrMap.AttrMapA value of type Graphics.Vty.Attributes.Attr can be obtained from Graphics.Vty.Attributes.defAttr.
Lots more customization is possible, but it just isn't relevant to this project.
I want the application's state type, in other words the s in App s e n, to be:
newtype MegalaserState = MS
{ unMS :: [String] -- a list of lines to print to the screen
}This way, if I want to write just the letter "M" to the window, I need to define the following state.
_m :: MegalaserState
_m = (MS
[ "|\\\\ //|"
, "||\\\\ //||"
, "|| \\\\// ||"
, "|| ||"
, "|| ||"
])It will also be easy to "concatenate" two states and make a new state. The first lines of each state need to be concatenated, then the second lines, and so on, to yield a new list of lines.
instance Semigroup MegalaserState where
a <> b = MS (zipWith (++) (unMS a) (unMS b))
instance Monoid MegalaserState where
mempty = MS (repeat "")Here's how someone might combine states using (<>), illustrated in GHCi.
λ> (putStr . unlines . unMS) (_m <> _m)
|\\ //||\\ //|
||\\ //||||\\ //||
|| \\// |||| \\// ||
|| |||| ||
|| |||| ||appDrawI need to supply a function with type MegalaserState -> [Widget n] to the App constructor.
appDraw' :: MegalaserState -> [Widget Int]
appDraw' s = [(Brick.Core.Widget.str . unlines . unMS) s]The application needs to handle timed events.
This tetris project on GitHub creates a custom event type Tick to achieve this. I want to do the same.
data Tick = TickI'll need to create a bounded channel in my program's main function to hold events of type Tick.
-- newBChan is from Brick.BChan
main :: IO ()
main = do
{- code -}
tickChan <- newBChan 10
{- code -}A Tick event will be fed to tickChan every tenth of a second by a separate thread.
-- newBChan and writeBChan are from Brick.BChan
-- forkIO and threadDelay are from Control.Concurrent
-- forever is from Control.Monad
main :: IO ()
main = do
{- code -}
tickChan <- newBChan 10
_ <- forkIO (forever (do
threadDelay 100000 -- 10^5 microseconds = 0.1 second
writeBChan tickChan Tick))
{- code -}Tick events will need to be handled. I plan to use:
appHandleEvent'
:: MegalaserState
-> BrickEvent Int Tick
-> EventM Int (Next MegalaserState)
appHandleEvent' s _ = case (removeFirstColumn s) of
(Just s') -> continue s'
_ -> halt s
where
removeFirstColumn s = case (unMS s) of
[] -> Nothing
msgLns -> case (maximum (map length msgLns)) of
0 -> Nothing
_ -> Just (MS (map tail msgLns))module Main where
import Brick.AttrMap
import Brick.BChan
import Brick.Main
import Brick.Types
import Brick.Widgets.Core
import Control.Concurrent
import Control.Monad
import Graphics.Vty
data Tick = Tick
newtype MegalaserState = MS {unMS :: [String]}
instance Semigroup MegalaserState where
s1 <> s2 = MS (zipWith (++) (unMS s1) (unMS s2))
instance Monoid MegalaserState where
mempty = MS (repeat "")
removeFirstColumn :: MegalaserState -> Maybe MegalaserState
removeFirstColumn s = case (unMS s) of
[] -> Nothing
msgLns -> case (maximum (map length msgLns)) of
0 -> Nothing
_ -> Just (MS (map tail msgLns))
main :: IO ()
main = do
vty <- mkVty defaultConfig
tickChan <- newBChan 10
_ <- forkIO (forever (do
threadDelay 100000
writeBChan tickChan Tick))
_ <- customMain
vty
(mkVty defaultConfig)
(Just tickChan)
(App
appDraw'
appChooseCursor'
appHandleEvent'
appStartEvent'
appAttrMap')
(mconcat [_m, _e, _g, _a, _l, _a, _s, _e, _r])
return ()
appDraw' :: MegalaserState -> [Widget Int]
appDraw' s = [(str . unlines . unMS) s]
appChooseCursor'
:: MegalaserState
-> [CursorLocation Int]
-> Maybe (CursorLocation Int)
appChooseCursor' _ _ = Nothing
appHandleEvent'
:: MegalaserState
-> BrickEvent Int Tick
-> EventM Int (Next MegalaserState)
appHandleEvent' s _ = case (removeFirstColumn s) of
(Just s') -> continue s'
_ -> halt s
appStartEvent' :: MegalaserState -> EventM Int MegalaserState
appStartEvent' s = return s
appAttrMap' :: MegalaserState -> AttrMap
appAttrMap' _ = forceAttrMap defAttr
_m :: MegalaserState
_m = MS
[ "|\\\\ //|"
, "||\\\\ //||"
, "|| \\\\// ||"
, "|| ||"
, "|| ||"
]
_e :: MegalaserState
_e = MS
[ "/========="
, "|| "
, "====== "
, "|| "
, "\\========="
]
_g :: MegalaserState
_g = MS
[ " /========"
, "// "
, "|| ====\\"
, "\\\\ ||"
, " \\========"
]
_a :: MegalaserState
_a = MS
[ " //====\\\\ "
, "|/ \\|"
, "||======||"
, "|| ||"
, "|| ||"
]
_l :: MegalaserState
_l = MS
[ "|| "
, "|| "
, "|| "
, "|| "
, "\\\\========"
]
_s :: MegalaserState
_s = MS
[ "//========"
, "|| "
, "\\\\======||"
, " ||"
, "========//"
]
_r :: MegalaserState
_r = MS
[ "||=======\\"
, "|| ||"
, "||=======/"
, "|| \\\\ "
, "|| \\\\"
]