cellularAutomata/src/BrickStuff.hs

71 строка
1.8 KiB
Haskell
Исходник Обычный вид История

2021-04-20 18:45:00 -04:00
{-# LANGUAGE OverloadedStrings #-}
module BrickStuff where
import Automata
import Spaces.Space2
import System.Random
import Brick
import Brick.BChan (newBChan, writeBChan)
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.Border.Style as BS
import qualified Brick.Widgets.Center as C
import qualified Graphics.Vty as V
-----------------
-- brick stuff --
-----------------
data Tick = Tick
type Name = ()
-- App definition
app :: Int -> Int -> App (Space2 CellState) Tick Name
app h w = App { appDraw = drawUI h w
, appChooseCursor = neverShowCursor
, appHandleEvent = handleEvent
, appStartEvent = return
, appAttrMap = const theMap
}
-- Handling events
theMap :: AttrMap
theMap = attrMap V.defAttr
[ (rockAttr, V.red `on` V.blue)
, (scissorsAttr, V.green `on` V.red)
, (paperAttr, V.blue `on` V.green)
]
handleEvent :: (Space2 CellState) -> BrickEvent Name Tick -> EventM Name (Next (Space2 CellState))
handleEvent g (AppEvent Tick) = continue $ step rps g
handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g
handleEvent g _ = continue g
drawUI :: Int -> Int -> Space2 CellState -> [Widget Name]
drawUI h w g = [ C.center $ drawGrid h w g ]
drawGrid :: Int -> Int -> Space2 CellState -> Widget Name
drawGrid h w g = vBox rows
where
bw = mat2 g
rows = [ hBox $ cellsInRow r | r <- bw ]
cellsInRow y = map drawCell y
drawCell :: CellState -> Widget Name
drawCell Paper = withAttr paperAttr $ str " "
drawCell Scissors = withAttr scissorsAttr $ str " "
drawCell Rock = withAttr rockAttr $ str " "
rockAttr, scissorsAttr, paperAttr :: AttrName
rockAttr = "rockAttr"
paperAttr = "paperAttr"
scissorsAttr = "scissorsAttr"
initGame :: IO (Space2 CellState)
initGame = do
rng <- getStdGen
return $ createRandSpace2 rng