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 let name = case args of x:_ -> x; [] -> "" bracket (mkVty =<< userConfig) shutdown \vty -> do loop vty (pure (pickWorld name)) 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 '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) pickWorld :: String -> World pickWorld "world0" = world0 pickWorld "small" = smallWorld pickWorld "center8" = center8 pickWorld "center13" = center13 pickWorld "clone11" = clone11 pickWorld _ = 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)