From 84f74366bb45cb9d8d2e41fe6de47cc43fa77c28 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Wed, 7 Dec 2022 13:37:02 -0800 Subject: [PATCH] handle blocks having undefined location --- app/Main.hs | 55 ++++++++++----------- app/Model.hs | 98 +++++++++++++++++++++----------------- app/Parser.hs | 6 +-- app/Rendering.hs | 55 +++++++++++---------- levels/infiniteEnter11.txt | 18 ++++--- levels/infiniteEnter6.txt | 82 +++++++++++-------------------- levels/infiniteExit16.txt | 44 ++++------------- levels/player19.txt | 17 +++++++ levels/transfer14.txt | 5 +- 9 files changed, 177 insertions(+), 203 deletions(-) create mode 100644 levels/player19.txt diff --git a/app/Main.hs b/app/Main.hs index 0dbdbf5..97beb91 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,10 +1,10 @@ module Main (main) where import Control.Exception ( bracket ) -import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty (NonEmpty(..), (<|)) import Data.List.NonEmpty qualified as NonEmpty import Data.Char (toUpper) -import Data.List (intersperse) +import Data.List (intersperse, sort) import Data.Map (Map) import Data.Map qualified as Map import Graphics.Vty @@ -29,7 +29,7 @@ data GameMode getWorldList :: IO (Map String FilePath) getWorldList = - do paths <- listDirectory "levels" + do paths <- sort <$> listDirectory "levels" pure (Map.fromList [(takeBaseName path, "levels" path) | path <- paths]) main :: IO () @@ -57,17 +57,18 @@ loop vty game = case gameMode game of MenuMode -> do worldList <- getWorldList - let (a,b) = Map.splitAt (gameSelect game) worldList bnds <- displayBounds (outputIface vty) - update vty (picForImage (renderMenu bnds a b)) + update vty (picForImage (renderMenu (gameSelect game) worldList bnds)) ev <- nextEvent vty case ev of EvKey key _modifier -> case key of KEsc -> pure () - KUp | gameSelect game > 0 -> loop vty game{ gameSelect = gameSelect game - 1 } - KDown | gameSelect game + 1 < Map.size worldList -> loop vty game{ gameSelect = gameSelect game + 1 } - KEnter | Just (path,_) <- Map.minView b -> + KUp | gameSelect game > 0 -> + loop vty game{ gameSelect = gameSelect game - 1 } + KDown | gameSelect game + 1 < Map.size worldList -> + loop vty game{ gameSelect = gameSelect game + 1 } + KEnter | (_, path) <- Map.elemAt (gameSelect game) worldList -> do world <- parse <$> readFile path loop vty game{ gameMode = PlayMode (pure world) } _ -> loop vty game @@ -79,11 +80,12 @@ loop vty game = ev <- nextEvent vty case ev of EvKey key _modifier -> + let doMove m = game{ gameMode = PlayMode (move world m <| worlds) } in case key of - KUp -> loop vty game{ gameMode = PlayMode (NonEmpty.cons (move world (-1,0)) worlds) } - KDown -> loop vty game{ gameMode = PlayMode (NonEmpty.cons (move world (1,0) ) worlds) } - KLeft -> loop vty game{ gameMode = PlayMode (NonEmpty.cons (move world (0,-1)) worlds) } - KRight -> loop vty game{ gameMode = PlayMode (NonEmpty.cons (move world (0,1) ) worlds) } + KUp -> loop vty (doMove (-1, 0)) + KDown -> loop vty (doMove ( 1, 0)) + KLeft -> loop vty (doMove ( 0,-1)) + KRight -> loop vty (doMove ( 0, 1)) KChar 'm' -> loop vty game { gameMode = MenuMode } KChar 'r' -> loop vty game{ gameMode = PlayMode (pure (NonEmpty.last worlds)) } KChar 'z' @@ -95,25 +97,20 @@ loop vty game = _ -> loop vty game -renderMenu :: DisplayRegion -> Map String a -> Map String a -> Image -renderMenu (w,h) before after = - pad ((w - imageWidth menu) `div` 2) 0 0 0 menu +renderMenu :: Int -> Map String a -> DisplayRegion -> Image +renderMenu sel list (w,h) + | hpad >= 0 = pad wpad hpad 0 0 menu + | otherwise = pad wpad 0 0 0 (cropTop (imageHeight menu + hpad) menu) where + hpad = h`div`2 - sel*6 + wpad = max 0 (w - imageWidth menu) `div` 2 menu = - case Map.minViewWithKey after of - Nothing -> bigString defAttr "empty menu" - Just ((k,_),after') -> - let len1 = (h-1)`div`2 `div` 6 in - pad 0 (max 0 (6 * (len1 - Map.size before))) 0 0 $ - vertCat $ - intersperse (char defAttr ' ') $ - [ bigString defAttr x - | x <- drop (Map.size before - len1) (Map.keys before) - ] ++ - [bigString (defAttr `withBackColor` cyan `withForeColor` white) k] ++ - [ bigString defAttr x - | x <- drop (Map.size after' - h`div`2) (Map.keys after') - ] + vertCat $ + intersperse (char defAttr ' ') $ + [ bigString (if sel == i then defAttr `withBackColor` cyan `withForeColor` white + else defAttr) k + | (i,k) <- zip [0..] (Map.keys list) + ] bigString :: Attr -> String -> Image bigString a = vertCat . map (string a) . bigText . map toUpper diff --git a/app/Model.hs b/app/Model.hs index 65fcc61..42358eb 100644 --- a/app/Model.hs +++ b/app/Model.hs @@ -12,7 +12,7 @@ import Data.Set (Set) type Coord = (Int, Int) data Box = Box { - boxLocation :: Location, + boxLocation :: Maybe Location, boxType :: BoxType, boxColor :: Attr, boxBoring :: Bool @@ -50,9 +50,9 @@ data World = World { winCondition :: World -> Bool winCondition world = Set.isSubsetOf (worldButtons world) coverage && - worldHome world == boxLocation (worldBoxes world Map.! worldMe world) + Just (worldHome world) == boxLocation (worldBoxes world Map.! worldMe world) where - coverage = Set.fromList $ map boxLocation $ Map.elems (worldBoxes world) + coverage = Set.fromList $ mapMaybe boxLocation $ Map.elems (worldBoxes world) boxSize :: World -> Box -> Int @@ -62,13 +62,16 @@ boxSize world box = yhi-ylo+1 move :: World -> (Int,Int) -> World move world dir = - case moveBlock world Map.empty (myLocation world) dir 0 of + case myLocation world of Nothing -> world - Just changes -> - let f box = box { boxLocation = Map.findWithDefault (boxLocation box) (boxLocation box) changes } in - world { worldBoxes = fmap f (worldBoxes world)} + Just loc -> + case moveBlock world Map.empty loc dir 0 of + Nothing -> world + Just changes -> + let f box change = box { boxLocation = change } in + world { worldBoxes = Map.mergeWithKey (\_ a b -> Just (f a b)) id (const Map.empty) (worldBoxes world) changes} -myLocation :: World -> Location +myLocation :: World -> Maybe Location myLocation world = boxLocation (worldBoxes world Map.! worldMe world) @@ -82,11 +85,11 @@ type Movement = (Int, Int) moveBlock :: World -> - Map Location (Int, Location) -> + Map Location (Int, Char, Maybe Location) -> Location -> Movement -> Rational {- ^ offset -} -> - Maybe (Map Location Location) + Maybe (Map Char (Maybe Location)) -- moving into a wall, not possible moveBlock world _ loc _ _ @@ -94,54 +97,58 @@ moveBlock world _ loc _ _ -- move introduced a loop, trim off the tail and report success moveBlock _ visited loc _ _ - | Just (n,_) <- Map.lookup loc visited - = Just (fmap snd (Map.filter (\(a,_)->a >= n) visited)) + | Just (n,_,_) <- Map.lookup loc visited + = Just (Map.fromList [(c,l) | (a,c,l) <- Map.elems visited, a >= n]) moveBlock world visited loc dir offset = - case [(n,box) | (n,box) <- Map.assocs (worldBoxes world), boxLocation box == loc] of + case [(n,box) | (n,box) <- Map.assocs (worldBoxes world), boxLocation box == Just loc] of -- moving an empty space, so we're done - [] -> Just (fmap snd visited) + [] -> Just (Map.fromList [(c,l) | (_,c,l) <- Map.elems visited]) -- moving a box (name,box):_ -> - do (loc', offset') <- nextLoc world dir loc offset - --traceM (show "Next loc " ++ show loc' ++ " offset " ++ show offset') - guard (not (isWall world loc')) - moveBlock' world visited loc loc' dir name box Set.empty offset' + case nextLoc world dir loc offset of + Nothing -> Just (Map.fromList ((name, Nothing) : [(c,l) | (_,c,l) <- Map.elems visited])) + Just (loc', offset') -> + do guard (not (isWall world loc')) + moveBlock' world visited loc loc' dir name box Set.empty offset' moveBlock' :: - World -> - Map Location (Int, Location) -> - Location -> - Location -> - Movement -> - Char -> + World -> + Map Location (Int, Char, Maybe Location) -> + Location -> + Location -> + Movement -> + Char -> Box -> Set Location -> Rational {- ^ offset -} -> - Maybe (Map Location Location) + Maybe (Map Char (Maybe Location)) moveBlock' world visited loc loc' dir name box enters offset = msum [moveTo, moveInto, moveToEat] where moveTo = - do moveBlock world (addVisited loc loc' visited) loc' dir 0 + do moveBlock world (addVisited name loc (Just loc') visited) loc' dir 0 moveInto = do (n,b) <- boxAt world loc' (locI, offset') <- enterLoc world n b dir offset - if Set.member locI enters then do - epsilon <- findEpsilon world (locName loc') - let eBox = worldBoxes world Map.! epsilon - (locI, offset') <- enterLoc world epsilon eBox dir offset - moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset' + if Set.member locI enters then + moveEpsilon else moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset' + moveEpsilon = + do epsilon <- findEpsilon world (locName loc') + let eBox = worldBoxes world Map.! epsilon + (locI, offset') <- enterLoc world epsilon eBox dir offset + moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset' + moveToEat = do let dir' = invert dir (locE, _) <- enterLoc world name box dir' 0 - (name', box') <- boxAt world loc' - moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' Set.empty 0 + (name', box') <- boxAt world loc' + moveBlock' world (addVisited name loc (Just loc') visited) loc' locE dir' name' box' Set.empty 0 enterLoc :: World -> Char -> Box -> Movement -> Rational -> Maybe (Location, Rational) enterLoc world name box dir@(dy,dx) offset = @@ -156,7 +163,7 @@ enterLoc world name box dir@(dy,dx) offset = (Location name' y x, fromIntegral(boxSize world box) * offset - fromIntegral ((abs dy *x + abs dx*y))) - + ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box) case dir of @@ -168,7 +175,7 @@ enterLoc world name box dir@(dy,dx) offset = boxAt :: World -> Location -> Maybe (Char, Box) boxAt world loc = - listToMaybe [(n,b) | (n,b) <- Map.assocs (worldBoxes world), boxLocation b == loc] + listToMaybe [(n,b) | (n,b) <- Map.assocs (worldBoxes world), boxLocation b == Just loc] invert :: Movement -> Movement invert (dy,dx) = (-dy, -dx) @@ -177,11 +184,12 @@ midpoint :: Int -> Int -> Rational -> Int midpoint lo hi offset = round (offset * fromIntegral (hi-lo+1)) addVisited :: + Char {- ^ name -} -> Location {- ^ start -} -> - Location {- ^ end -} -> - Map Location (Int, Location) -> - Map Location (Int, Location) -addVisited k v m = Map.insert k (Map.size m, v) m + Maybe Location {- ^ end -} -> + Map Location (Int, Char, Maybe Location) -> + Map Location (Int, Char, Maybe Location) +addVisited name k v m = Map.insert k (Map.size m, name, v) m nextLoc :: World -> Movement -> Location -> Rational -> Maybe (Location, Rational) nextLoc world (dy, dx) = go Set.empty @@ -191,11 +199,12 @@ nextLoc world (dy, dx) = go Set.empty | Just box <- Map.lookup b (worldBoxes world) , inRange (bounds (boxWalls world box)) (y+dy, x+dx) = Just (Location b (y+dy) (x+dx), offset) - + go visited (Location b y x) offset | Just box <- Map.lookup b (worldBoxes world) , Set.notMember b visited - = go (Set.insert b visited) (boxLocation box) + , Just boxLoc <- boxLocation box + = go (Set.insert b visited) boxLoc $ (offset + fromIntegral (abs dy*x+abs dx*y)) / fromIntegral (boxSize world box) @@ -208,9 +217,10 @@ nextLoc world (dy, dx) = go Set.empty findInfinity :: World -> Char -> Maybe Char findInfinity world b = - listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world), Infinity i <- [boxType box], i == b] - + listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world) + , Infinity i <- [boxType box], i == b] findEpsilon :: World -> Char -> Maybe Char findEpsilon world b = - listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world), Epsilon i _ <- [boxType box], i == b] \ No newline at end of file + listToMaybe [b' | (b', box) <- Map.assocs (worldBoxes world) + , Epsilon i _ <- [boxType box], i == b] diff --git a/app/Parser.hs b/app/Parser.hs index fb1044c..f9c0d94 100644 --- a/app/Parser.hs +++ b/app/Parser.hs @@ -18,14 +18,14 @@ parse str = do let m = Map.fromListWith (++) [(k,[v]) | (_,_,kvs) <- bs, (k,v) <- kvs] World (Map.fromList [ - (n, b { boxLocation = head (m Map.! n)}) + (n, b { boxLocation = fmap head (Map.lookup n m)}) | (n,b,_) <- bs ]) p (Set.fromList (Map.findWithDefault [] '-' m)) (head (m Map.! '=')) h w - + parseHeader :: ReadP (Char,Int,Int) parseHeader = do "player" <- token @@ -61,7 +61,7 @@ parseBlock = _ <- char '\n' xs1 <- parseWalls let locs = findLocs name xs1 - let b = Box undefined (Original (walls xs1)) color boring + let b = Box Nothing (Original (walls xs1)) color boring pure (name, b, locs) "link" -> do [name] <- token diff --git a/app/Rendering.hs b/app/Rendering.hs index 7f0eba1..0703be1 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -1,6 +1,7 @@ module Rendering where import Data.Array +import Data.Maybe import Data.Map (Map) import Data.Map qualified as Map import Data.Set qualified as Set @@ -46,7 +47,7 @@ renderCell world locMap name box y x h w = Just n -> let box' = worldBoxes world Map.! n in if h < boxSize world box' - then unit (boxColor box') h w n + then unit (boxColor box') h w n else renderBox world locMap box' n h w Nothing @@ -78,13 +79,13 @@ contentName world name box = Epsilon{} -> name renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Int -> Image -renderBox world locMap box name h w = +renderBox world locMap box name boxh boxw = vertCat [ horizCat [ - renderCell world locMap name box y x h w - | (x,w) <- zip [xlo .. xhi] (divisions boxWidth w) + renderCell world locMap name box y x cellh cellw + | (x,cellw) <- zip [xlo .. xhi] (divisions boxWidth boxw) ] - | (y,h) <- zip [ylo .. yhi] (divisions boxHeight h) + | (y,cellh) <- zip [ylo .. yhi] (divisions boxHeight boxh) ] where ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box) @@ -107,7 +108,7 @@ render flat world = picForLayers $ (if flat then renderFlat locMap world else []) ++ [drawNestedWorld locMap world] where - locMap = Map.fromList [(boxLocation loc, n) | (n, loc) <- Map.toList (worldBoxes world)] + locMap = Map.fromList [(loc, n) | (n, box) <- Map.toList (worldBoxes world), loc <- maybeToList (boxLocation box)] renderFlat :: Map Location Char -> World -> [Image] renderFlat locMap world = @@ -137,22 +138,29 @@ drawNestedWorld locMap world = horizCat $ intersperse (char defAttr ' ') [ - case stackedLoc world locMap (Location name1 y_ x_) of - Nothing -> unit (withForeColor defAttr black) h w '?' - Just (Location n y x) -> - let box = worldBoxes world Map.! n in - renderCell world locMap n box y x h w - | x_ <- [x1-1 .. x1+1] + case myLocation world of + Nothing + | dx==0 && dy==0 -> renderBox world locMap (worldBoxes world Map.! worldMe world) (worldMe world) h w + | otherwise -> infinityImage + Just (Location name0 _ _) -> + case boxLocation (worldBoxes world Map.! name0) of + Nothing + | dx==0 && dy==0 -> renderBox world locMap (worldBoxes world Map.! name0) name0 h w + | otherwise -> infinityImage + Just (Location name1 y1 x1) -> + case stackedLoc world locMap (Location name1 (y1+dy) (x1+dx)) of + Nothing -> infinityImage + Just (Location n y x) -> + let box = worldBoxes world Map.! n in + renderCell world locMap n box y x h w + | dx <- [-1 .. 1] ] - | y_ <- [y1-1 .. y1+1] + | dy <- [-1 .. 1] ] where + infinityImage = unit (withForeColor defAttr black) h w '?' h = worldHeight world w = worldWidth world - -- name1 is the box the player is standing in - Location name0 _ _ = myLocation world - Location name1 y1 x1 = boxLocation (worldBoxes world Map.! name0) - stackedLoc :: World -> Map Location Char -> Location -> Maybe Location stackedLoc world locMap = go Set.empty @@ -167,12 +175,11 @@ stackedLoc world locMap = go Set.empty let bnds@((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box) if inRange bnds (y, x) then Just loc - else - let dx = overflow (xlo,xhi) x + else + do let dx = overflow (xlo,xhi) x dy = overflow (ylo,yhi) y - Location parent py px = boxLocation box - in fixup world locMap dy dx y x <$> go (Set.insert loc visited) (Location parent (py+dy) (px+dx)) - + Location parent py px <- boxLocation box + fixup world locMap dy dx y x <$> go (Set.insert loc visited) (Location parent (py+dy) (px+dx)) overflow :: (Int, Int) -> Int -> Int overflow (lo,hi) x @@ -208,7 +215,7 @@ divisions divs size = (fromIntegral i + 1 / 2) / fromIntegral size * fromIntegral divs - - 1/2 - ) + - 1/2 :: Rational + ) :: Int | i <- [0 ..size-1] ] diff --git a/levels/infiniteEnter11.txt b/levels/infiniteEnter11.txt index 66872fb..7319117 100644 --- a/levels/infiniteEnter11.txt +++ b/levels/infiniteEnter11.txt @@ -1,4 +1,4 @@ -player p +player p height 98 width 196 block t white boring ▓▓▓▓▓ ▓▓▓▓▓ @@ -6,15 +6,13 @@ block t white boring ▓▓▓▓▓ ▓▓▓▓▓ block w white interesting -▓▓▓▓▓▓▓▓▓ -▓▓ ▓▓ -▓▓ g G ▓▓ -▓▓ ▓▓ -▓▓ = p ▓▓ -▓▓ ▓▓ -▓▓▓▓▓▓ ▓▓ -▓▓▓ε▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓ ▓ +▓ g G ▓ +▓ ▓ +▓ = p ▓ +▓ ▓ +▓▓▓▓▓ ▓ +▓▓ε▓▓▓▓ link G g green link H g green block g green interesting diff --git a/levels/infiniteEnter6.txt b/levels/infiniteEnter6.txt index 190ec82..259fc5b 100644 --- a/levels/infiniteEnter6.txt +++ b/levels/infiniteEnter6.txt @@ -1,63 +1,35 @@ player p -block t black boring -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓t▓▓▓w▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓ε▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ block w white interesting -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓ p ▓▓ -▓▓ G H ▓▓ -▓▓ = ▓▓ -▓▓ -▓▓ -▓▓▓▓g▓=▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓▓▓▓▓▓▓ +▓ p ▓ +▓ G H ▓ +▓ ▓ +▓ -▓ +▓▓▓g▓=▓ +▓▓▓▓▓▓▓ link G g green link H g green block g green interesting - ▓ - ▓▓ - - - - - - - + ▓ + ▓▓ + + + epsilon ε g green - b - - - - ▓ - - - - + b + + + + ▓ + + block p magenta boring -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓ ▓▓▓ ▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓▓▓▓▓ +▓ ▓ ▓ +▓▓▓▓▓ +▓▓▓▓▓ +▓▓▓▓▓ block b blue interesting -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ - ▓▓▓ - ▓▓▓ - ▓▓▓ -▓▓▓ ▓▓▓ -▓▓▓ ▓▓▓ -▓▓▓ ▓▓▓ +▓▓▓ + ▓ +▓ ▓ diff --git a/levels/infiniteExit16.txt b/levels/infiniteExit16.txt index 9b81ca0..3154af4 100644 --- a/levels/infiniteExit16.txt +++ b/levels/infiniteExit16.txt @@ -10,15 +10,9 @@ block t white boring ▓▓▓▓▓▓▓▓▓ ▓▓▓▓▓▓▓▓▓ block a white interesting -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓p ▓▓▓ -▓▓▓ ∞▓▓▓ -▓▓▓ P▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +p + ∞ + P▓ link P p magenta infinity ∞ p magenta block p magenta interesting @@ -32,32 +26,10 @@ block p magenta interesting ▓ c block c green interesting -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ - ▓▓▓ - = ▓▓▓ - ▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓▓▓ + =▓ +▓▓▓ block 1 blue boring -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓ block 2 blue boring -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ -▓▓▓▓▓▓▓▓▓ +▓ diff --git a/levels/player19.txt b/levels/player19.txt new file mode 100644 index 0000000..19457b0 --- /dev/null +++ b/levels/player19.txt @@ -0,0 +1,17 @@ +player p +block p magenta interesting + + + p ▓ + + 1 2 + +c +block c green interesting +▓▓▓ + =▓ +▓▓▓ +block 1 blue boring +▓ +block 2 blue boring +▓ diff --git a/levels/transfer14.txt b/levels/transfer14.txt index 19bbce8..f3d0346 100644 --- a/levels/transfer14.txt +++ b/levels/transfer14.txt @@ -17,14 +17,15 @@ block g green interesting ▓ block y yellow interesting ▓ ▓ -▓ ▓ -▓ ▓ + + ▓ ▓ block p magenta boring ▓▓▓▓▓ ▓ ▓ ▓ ▓▓▓▓▓ ▓▓▓▓▓ +▓▓▓▓▓