module Main where import Data.Map qualified as Map import Graphics.Vty import Control.Exception ( bracket ) import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty qualified as NonEmpty import Data.Set qualified as Set import System.Environment ( getArgs ) import Model import Rendering ( render ) data Game = Game { gameWorlds :: NonEmpty World, gameFlat :: Bool } main :: IO () main = do args <- getArgs case args of x:_ | Just w <- Map.lookup x worldList -> bracket (mkVty =<< userConfig) shutdown \vty -> loop vty Game { gameWorlds = pure w, gameFlat = True } _ -> do putStrLn "Usage: parabox " putStrLn "" putStrLn "Available worlds:" mapM_ putStrLn (Map.keys worldList) loop :: Vty -> Game -> IO () loop vty game = do let world = NonEmpty.head (gameWorlds game) update vty (render (gameFlat game) (NonEmpty.head (gameWorlds game))) ev <- nextEvent vty case ev of EvKey key _modifier -> case key of KUp -> loop vty game{ gameWorlds = NonEmpty.cons (move world (-1,0)) (gameWorlds game) } KDown -> loop vty game{ gameWorlds = NonEmpty.cons (move world (1,0) ) (gameWorlds game) } KLeft -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,-1)) (gameWorlds game) } KRight -> loop vty game{ gameWorlds = NonEmpty.cons (move world (0,1) ) (gameWorlds game) } KChar 'r' -> loop vty game{ gameWorlds = pure (NonEmpty.last (gameWorlds game)) } KChar 'z' | Just worlds <- NonEmpty.nonEmpty (NonEmpty.tail (gameWorlds game)) -> loop vty game{ gameWorlds = worlds } KEsc -> pure () KChar 'f' -> loop vty game{ gameFlat = not (gameFlat game) } _ -> loop vty game _ -> loop vty game worldList :: Map.Map String World worldList = Map.fromList [ ("world0", world0) , ("small", smallWorld) , ("center8", center8) , ("center13", center13) , ("clone11", clone11) , ("transfer14", transfer14) , ("open4", open4) ] 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) open4 :: World open4 = World (Map.fromList [('a', Box (Location 'a' 0 (-1)) (Original (makeWalls [ "▓▓▓▓▓▓▓▓▓", "▓▓ ▓▓▓▓", "▓▓ ▓", "▓ ▓", "▓▓ ▓", "▓▓ ▓", "▓▓ ▓", "▓▓ ▓", "▓▓ ▓" ])) (withForeColor defAttr cyan)), ('g', Box (Location 'a' 2 (-1)) (Original (makeWalls [ "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓", "▓▓▓▓ ▓▓▓▓" ])) (withForeColor defAttr green)), ('y', Box (Location 'a' 2 1) (Original (makeWalls [ "▓▓▓▓▓▓ ▓▓", "▓▓▓▓▓▓ ▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓", "▓▓▓▓▓▓▓▓▓" ])) (withForeColor defAttr yellow)), ('b', Box (Location 'a' 0 1) (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' Set.empty (Location 'y' (-3) 2) 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' }) ] }