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 Data.Set qualified as Set import System.Environment import Model import Rendering world0 :: World world0 = World { worldButtons = Set.empty, worldHome = Location '2' 0 0, 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 = do args <- getArgs case args of x:_ | Just w <- Map.lookup x worldList -> bracket (mkVty =<< userConfig) shutdown \vty -> loop vty (pure w) _ -> do putStrLn "Usage: parabox " putStrLn "" putStrLn "Available worlds:" mapM_ putStrLn (Map.keys worldList) 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 'r' -> loop vty (pure (NonEmpty.last (world :| history))) KChar 'z' | Just worlds <- NonEmpty.nonEmpty history -> loop vty worlds KEsc -> pure () _ -> loop vty (world :| history) _ -> loop vty (world :| history) worldList :: Map.Map String World worldList = Map.fromList [ ("world0", world0) , ("small", smallWorld) , ("center8", center8) , ("center13", center13) , ("clone11", clone11) , ("transfer14", transfer14) ] 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' Set.empty (Location 'b' 0 0) center8 :: World center8 = World (Map.fromList [('a', Box (Location 'a' 3 (-3)) (Original (makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓ ▓▓", "▓▓ ▓▓", "▓ ▓▓", "▓ ▓▓", "▓▓▓▓ ▓▓▓▓", "▓ ▓▓ ▓▓", "▓▓▓▓▓▓▓▓▓" ])) (withForeColor defAttr black)), ('1', Box (Location 'a' 0 0) (Original (makeWalls [ " ▓▓", " ▓▓▓▓▓", " ", " ", " ", " ", " ", " ", " " ])) (withForeColor defAttr green)), ('2', Box (Location '1' (-4) 0) (Original (solid 9)) (withForeColor defAttr yellow)), ('b', Box (Location 'a' (-1) 0) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' Set.empty (Location 'a' 3 2) center13 :: World center13 = World (Map.fromList [('a', Box (Location 'a' 3 (-3)) (Original (makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓", "▓ ▓▓▓ ▓▓", "▓ ▓ ▓ ▓▓", "▓ ▓▓ ▓", "▓▓▓▓▓▓▓▓▓" ])) (withForeColor defAttr cyan)), ('1', Box (Location 'a' (-1) 1) (Original (makeWalls [ " ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " ▓▓▓▓▓▓▓ ", " " ])) (withForeColor defAttr green)), ('2', Box (Location 'a' (-1) (-1)) (Original (solid 9)) (withForeColor defAttr yellow)), ('b', Box (Location 'a' (-3) 0) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' Set.empty (Location 'a' 2 0) clone11 :: World clone11 = World (Map.fromList [('a', Box (Location 'a' (-2) 2) (Original (makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓ ▓ ▓", "▓ ▓ ▓", "▓ ▓ ▓", " ▓ ", "▓ ▓ ▓", "▓ ▓ ▓", "▓▓▓ ▓▓▓", "▓▓▓▓▓▓▓▓▓" ])) (withForeColor defAttr green)), ('A', Box (Location 'a' 0 2) (Link 'a') (withForeColor defAttr green)), ('b', Box (Location 'a' 0 (-2)) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' (Set.fromList [Location 'a' (-1) (-3), Location 'a' (-2) (-3)]) (Location 'a' (-3) (-3)) transfer14 :: World transfer14 = World (Map.fromList [('a', Box (Location 'a' 1 1) (Original (makeWalls [ " ", " ", " ", " ", " ▓ ", " ", " ", " ", " " ])) (withForeColor defAttr cyan)), ('g', Box (Location 'a' (-1) (-1)) (Original (makeWalls [ " ▓▓▓ ", " ▓ ▓ ", " ", " ▓ ", "▓▓ ▓ ▓▓", " ▓ ", " ", " ", " ▓ " ])) (withForeColor defAttr green)), ('x', Box (Location 'g' 3 (-3)) (Original (makeWalls [ " ", " ", " ", " ", " ", " ", " ", " ", " " ])) (withForeColor defAttr magenta)), ('b', Box (Location 'a' 1 (-1)) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' (Set.fromList [Location 'g' (-2) 0]) (Location 'g' (-3) 0)