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, boxType = Original $ makeWalls [ "▓▓ ▓▓", "▓ ▓", "▓ ▓", "▓ ▓", " ▓", "▓ ▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓▓▓▓▓ ▓" ] }), ('2', Box { boxColor = withForeColor defAttr cyan, boxLocation = Location '1' 1 1, boxType = Original $ makeWalls [ "▓ ▓▓ ▓▓ ▓", " ", " ▓", " ▓", " ", "▓ ▓", "▓ ▓", " ", "▓ ▓▓ ▓▓ ▓" ] }), ('₂', Box { boxColor = withForeColor defAttr cyan, boxLocation = Location '1' 2 (-1), boxType = Link '2' }), ('3', Box { boxColor = withForeColor defAttr blue, boxLocation = Location '2' 1 1, boxType = Original $ makeWalls [ "▓▓▓▓▓▓▓▓▓", " ", "▓▓▓▓▓▓▓▓ ", "▓▓ ▓▓▓ ", "▓▓ ▓▓▓ ", "▓▓▓▓ ▓▓▓ ", "▓▓ ▓▓▓▓", "▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓" ] }), ('4', Box { boxColor = withForeColor defAttr black, boxLocation = Location 'b' (-3) 0, boxType = Original $ makeWalls [ "▓▓▓ ▓▓▓", "▓ ▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓▓▓▓ ▓▓▓▓" ] }), ('b', Box { boxColor = withForeColor defAttr red, boxLocation = Location '1' 0 1, boxType = Original $ makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓ ▓", "▓ ▓", "▓ ▓ ▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓▓▓▓▓▓▓▓▓" ] }), ('x', Box { boxColor = withForeColor defAttr yellow, boxLocation = Location '1' 0 (-1), boxType = Original $ makeWalls [ "▓▓ ▓ ", " ", " ▓ ▓▓▓ ", " ▓ ", "▓ ▓▓▓▓", " ▓▓▓ ", " ▓ ▓▓▓ ", " ", "▓ ▓ ▓" ] }), ('y', Box { boxColor = withForeColor defAttr magenta, boxLocation = Location '1' 0 (-2), boxType = Original $ makeWalls [ "▓▓ ▓ ", " ", "▓▓ ▓▓▓ ", "▓▓ ", " ▓▓▓▓", "▓▓▓▓ ", "▓▓ ▓▓▓ ", " ", "▓ ▓ ▓" ] }), ('i', Box { boxColor = withForeColor defAttr black, boxLocation = Location 'b' 0 (-2), boxType = Original $ solid 9 }), ('j', Box { boxColor = withForeColor defAttr black, boxLocation = Location 'b' 0 (-1), boxType = Original $ solid 9 }), ('k', Box { boxColor = withForeColor defAttr black, boxLocation = Location 'b' 0 0, boxType = Original $ solid 9 }), ('l', Box { boxColor = withForeColor defAttr black, boxLocation = Location 'b' 0 1, boxType = Original $ solid 9 }), ('₁', Box { boxColor = withForeColor defAttr green, boxLocation = Location '1' 2 1, boxType = Link '1' }) ] } 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) smallWorld :: World smallWorld = World (Map.fromList [('a', Box (Location 'a' 0 0) (Original (makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓ ▓ ▓", "▓ ▓ ▓", "▓▓▓▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓▓▓▓▓▓▓▓▓" ])) (withForeColor defAttr black)), ('1', Box (Location 'a' (-3) (-3)) (Original (makeWalls (replicate 9 (replicate 9 ' ')))) (withForeColor defAttr yellow)), ('2', Box (Location 'a' (-3) (-2)) (Original (makeWalls (replicate 9 (replicate 9 ' ')))) (withForeColor defAttr magenta)), ('3', Box (Location 'a' (-2) (-3)) (Original (makeWalls (replicate 9 (replicate 9 ' ')))) (withForeColor defAttr blue)), ('4', Box (Location 'a' (-2) (-2)) (Original (makeWalls (replicate 9 (replicate 9 ' ')))) (withForeColor defAttr green)), ('b', Box (Location '1' 0 0) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b'