138 lines
3.5 KiB
Haskell
138 lines
3.5 KiB
Haskell
module Main where
|
|
|
|
import Data.Map qualified as Map
|
|
import Graphics.Vty
|
|
import Control.Exception
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
|
import Data.List.NonEmpty qualified as NonEmpty
|
|
|
|
import Model
|
|
import Rendering
|
|
|
|
world0 :: World
|
|
world0 = World {
|
|
worldMe = 'b',
|
|
worldBoxes = Map.fromList
|
|
[('1', Box {
|
|
boxColor = withForeColor defAttr green,
|
|
boxLocation = Location '1' (-1) 0,
|
|
boxWalls = makeWalls [
|
|
"▓▓ ▓▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓ ▓"
|
|
]
|
|
}),
|
|
('2', Box {
|
|
boxColor = withForeColor defAttr cyan,
|
|
boxLocation = Location '1' 1 1,
|
|
boxWalls = makeWalls [
|
|
"▓ ▓ ▓ ▓",
|
|
" ",
|
|
"▓ ▓",
|
|
" ",
|
|
"▓ ▓",
|
|
" ",
|
|
"▓ ▓ ▓ ▓"
|
|
]
|
|
}),
|
|
('3', Box {
|
|
boxColor = withForeColor defAttr blue,
|
|
boxLocation = Location '2' 1 1,
|
|
boxWalls = makeWalls [
|
|
"▓▓ ▓▓",
|
|
"▓ ▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓▓▓ ▓▓▓"
|
|
]
|
|
}),
|
|
('4', Box {
|
|
boxColor = withForeColor defAttr black,
|
|
boxLocation = Location '3' (-3) 0,
|
|
boxWalls = makeWalls [
|
|
"▓▓ ▓▓",
|
|
"▓ ▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓ ▓",
|
|
"▓▓▓ ▓▓▓"
|
|
]
|
|
}),
|
|
('b', Box {
|
|
boxColor = withForeColor defAttr red,
|
|
boxLocation = Location '1' 0 1,
|
|
boxWalls = makeWalls [
|
|
"▓▓▓▓▓▓▓",
|
|
"▓ ▓",
|
|
"▓ ▓ ▓ ▓",
|
|
" ",
|
|
"▓ ▓▓",
|
|
"▓ ▓",
|
|
"▓▓▓▓▓▓▓"
|
|
]
|
|
}),
|
|
('x', Box {
|
|
boxColor = withForeColor defAttr yellow,
|
|
boxLocation = Location '1' 0 (-1),
|
|
boxWalls = solid 7
|
|
}),
|
|
('y', Box {
|
|
boxColor = withForeColor defAttr magenta,
|
|
boxLocation = Location '1' 0 (-2),
|
|
boxWalls = solid 7
|
|
}),
|
|
('i', Box {
|
|
boxColor = withForeColor defAttr black,
|
|
boxLocation = Location 'b' 0 (-2),
|
|
boxWalls = solid 7
|
|
}),
|
|
('j', Box {
|
|
boxColor = withForeColor defAttr black,
|
|
boxLocation = Location 'b' 0 (-1),
|
|
boxWalls = solid 7
|
|
}),
|
|
('k', Box {
|
|
boxColor = withForeColor defAttr black,
|
|
boxLocation = Location 'b' 0 0,
|
|
boxWalls = solid 7
|
|
}),
|
|
('l', Box {
|
|
boxColor = withForeColor defAttr black,
|
|
boxLocation = Location 'b' 0 1,
|
|
boxWalls = solid 7
|
|
})
|
|
]
|
|
}
|
|
|
|
main :: IO ()
|
|
main =
|
|
bracket (mkVty =<< userConfig) shutdown \vty ->
|
|
do
|
|
loop vty (pure world0)
|
|
pure ()
|
|
|
|
loop :: Vty -> NonEmpty World -> IO ()
|
|
loop vty (world :| history) =
|
|
do update vty (picForImage (drawNestedWorld world))
|
|
ev <- nextEvent vty
|
|
case ev of
|
|
EvKey key _modifier ->
|
|
case key of
|
|
KUp -> loop vty (move world (-1,0) :| world : history)
|
|
KDown -> loop vty (move world (1,0) :| world : history)
|
|
KLeft -> loop vty (move world (0,-1) :| world : history)
|
|
KRight -> loop vty (move world (0,1) :| world : history)
|
|
KChar 'z'
|
|
| Just worlds <- NonEmpty.nonEmpty history ->
|
|
loop vty worlds
|
|
KEsc -> pure ()
|
|
_ -> loop vty (world :| history)
|
|
_ -> loop vty (world :| history)
|