From f9d9e332eb310aad2ecbcd3aaf07662774149ec4 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Fri, 2 Dec 2022 20:53:45 -0800 Subject: [PATCH] add some level selection --- app/Main.hs | 92 +++++++++++++++++++++++++++++++++++++++++++++--- app/Model.hs | 6 ++-- app/Rendering.hs | 38 +++++++++++++++----- 3 files changed, 120 insertions(+), 16 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ed18fe9..110e2c5 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,12 +5,16 @@ 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 { @@ -154,10 +158,12 @@ world0 = World { main :: IO () main = - bracket (mkVty =<< userConfig) shutdown \vty -> - do - loop vty (pure clone11) - pure () + 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) = @@ -170,6 +176,7 @@ loop vty (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 @@ -177,6 +184,14 @@ loop vty (world :| history) = _ -> 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 @@ -221,6 +236,8 @@ smallWorld = (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' + Set.empty + (Location 'b' 0 0) center8 :: World center8 = @@ -266,6 +283,8 @@ center8 = (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' + Set.empty + (Location 'a' 3 2) center13 :: World center13 = @@ -311,6 +330,8 @@ center13 = (Original (solid 9)) (withForeColor defAttr red)) ]) 'b' + Set.empty + (Location 'a' 2 0) clone11 :: World @@ -341,4 +362,65 @@ clone11 = (Location 'a' 0 (-2)) (Original (solid 9)) (withForeColor defAttr red)) - ]) 'b' + ]) + '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) diff --git a/app/Model.hs b/app/Model.hs index 8662b0a..f65d47a 100644 --- a/app/Model.hs +++ b/app/Model.hs @@ -7,7 +7,7 @@ import Graphics.Vty import Control.Monad import Data.Maybe import Data.Set qualified as Set -import Debug.Trace +import Data.Set (Set) type Coord = (Int, Int) @@ -34,7 +34,9 @@ data Location = Location Char Int Int data World = World { worldBoxes :: Map Char Box, - worldMe :: Char + worldMe :: Char, + worldButtons :: Set Location, + worldHome :: Location } deriving (Show, Read, Eq) diff --git a/app/Rendering.hs b/app/Rendering.hs index ef9bf53..f17d809 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -12,25 +12,45 @@ unit :: Attr -> Int -> Char -> Image unit a scale x = vertCat (replicate scale (string a (replicate (2*scale) x))) +button :: Attr -> Int -> Image +button a 1 = string a "[]" +button a n = vertCat $ + string a ('┌' : replicate (2*n-2) '─' ++ "┐") : + replicate (n-2) (string a ('│' : replicate (2*n-2) '░' ++ "│")) ++ + [string a ('└' : replicate (2*n-2) '─' ++ "┘")] + +home :: Attr -> Int -> Image +home a 1 = string a "<>" +home a n = vertCat $ + string a ('╔' : replicate (2*n-2) '═' ++ "╗") : + replicate (n-2) (string a ('║' : replicate (2*n-2) '░' ++ "║")) ++ + [string a ('╚' : replicate (2*n-2) '═' ++ "╝")] + + + renderCell :: World -> Map Location Char -> Char -> Box -> Int -> Int -> Int -> Image renderCell world locMap name box y x scale = if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar else case Map.lookup (Location name' y x) locMap of - Nothing -> unit (boxColor box) scale '░' Just n -> if scale == 1 then unit (boxColor (worldBoxes world Map.! n)) scale n else renderBox world locMap (worldBoxes world Map.! n) n (scale `div` boxSize world box) + Nothing + | Set.member loc (worldButtons world) -> button (boxColor box) scale + | loc == worldHome world -> home (boxColor box) scale + | otherwise -> unit (boxColor box) scale '░' where - name' = - case boxType box of - Original{} -> name - Link c -> c - wallChar = - case boxType box of - Original{} -> '▓' - Link{} -> '▒' + loc = Location name' y x + name' = + case boxType box of + Original{} -> name + Link c -> c + wallChar = + case boxType box of + Original{} -> '▓' + Link{} -> '▒' renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image renderBox world locMap box name scale =