From 50a01efc5f7ec39a92609ecd4f9e77a752d4c3e7 Mon Sep 17 00:00:00 2001 From: Eric Mertens Date: Sun, 4 Dec 2022 15:59:22 -0800 Subject: [PATCH] epsilon working --- app/Main.hs | 555 ++++++++++++++++++++++++++++++++++++++++++++++- app/Model.hs | 77 +++++-- app/Rendering.hs | 17 +- 3 files changed, 616 insertions(+), 33 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a6e801c..25eb5ef 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -19,8 +19,8 @@ data Game = Game { main :: IO () main = do args <- getArgs - case args of - x:_ | Just w <- Map.lookup x worldList -> + case args of + x:_ | Just w <- Map.lookup x worldList -> bracket (mkVty =<< userConfig) shutdown \vty -> loop vty Game { gameWorlds = pure w, @@ -28,13 +28,13 @@ main = } _ -> do putStrLn "Usage: parabox " - putStrLn "" - putStrLn "Available worlds:" + putStrLn "" + putStrLn "Available worlds:" mapM_ putStrLn (Map.keys worldList) loop :: Vty -> Game -> IO () loop vty game = - do let world = NonEmpty.head (gameWorlds game) + do let world = NonEmpty.head (gameWorlds game) update vty (render (gameFlat game) (NonEmpty.head (gameWorlds game))) ev <- nextEvent vty case ev of @@ -67,6 +67,12 @@ worldList = Map.fromList , ("player10", player10) , ("player11", player11) , ("player18", player18) + , ("infiniteExit5", infiniteExit5) + , ("infiniteExit15", infiniteExit15) + , ("infiniteEnter17", infiniteEnter17) + , ("infiniteEnter19", infiniteEnter19) + , ("infiniteEnter20", infiniteEnter20) + , ("multiInfinite8", multiInfinite8) ] smallWorld :: World @@ -491,7 +497,7 @@ world0 = World { ('y', Box { boxColor = withForeColor defAttr magenta, boxLocation = Location '1' 0 (-2), - boxType = Original $ makeWalls [ + boxType = Original $ makeWalls [ "▓▓ ▓ ", " ", "▓▓ ▓▓▓ ", @@ -799,4 +805,539 @@ player18 = ]) 'u' (Set.singleton (Location 'u' (-1) 2)) - (Location 'u' 1 (-2)) \ No newline at end of file + (Location 'u' 1 (-2)) + + +infiniteExit5 :: World +infiniteExit5 = + World + (Map.fromList + [('a', + Box (Location 'a' 3 (-1)) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓ ", + "▓ ", + "▓ ", + "▓ ", + "▓ ", + "▓ ", + "▓ ", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr yellow) + False), + ('∞', + Box + (Location 'a' (-2) (-3)) + (Infinity 'a') + (withForeColor defAttr yellow) + True), + ('p', + Box + (Location 'a' 0 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr magenta) + True) + ]) + 'p' + (Set.singleton (Location 'a' 0 1)) + (Location 'a' (-1) 1) + + +infiniteExit15 :: World +infiniteExit15 = + World + (Map.fromList + [('A', -- extra frame to accomodate the larger level + Box (Location 'F' 3 3) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓ ▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓ ▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr cyan) + True), + ('a', + Box + (Location 'A' 0 0) + (Original (makeWalls [ + "▓▓▓ ▓▓▓▓▓", + " ▓▓▓▓", + " ▓▓ ", + " ▓ ▓", + " ▓▓", + " ▓▓▓▓", + " ▓▓▓▓", + " ▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr cyan) + False), + ('b', + Box + (Location 'a' 1 (-2)) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr magenta) + True), + ('g', + Box + (Location 'a' 0 (-1)) + (Original (makeWalls [ + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " " + ])) + (withForeColor defAttr green) + False), + ('G', + Box + (Location 'a' (-4) (-1)) + (Link 'g') + (withForeColor defAttr green) + True), + ('Γ', + Box + (Location 'a' 2 (-1)) + (Infinity 'g') + (withForeColor defAttr green) + False), + ('p', + Box + (Location 'a' 0 (-3)) + (Original (makeWalls [ + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " " + ])) + (withForeColor defAttr red) + False), + ('P', + Box + (Location 'a' (-2) (-3)) + (Link 'p') + (withForeColor defAttr red) + True), + ('Π', + Box + (Location 'a' 2 (-3)) + (Infinity 'p') + (withForeColor defAttr red) + False) + ]) + 'b' + (Set.fromList [Location 'a' 0 2, Location 'a' (-1) 2, Location 'a' (-1) 3, Location 'a' (-2) 3]) + (Location 'a' (-2) 4) + + +infiniteEnter17 :: World +infiniteEnter17 = + World + (Map.fromList + [('g', + Box (Location 'g' 2 (-2)) + (Original (makeWalls [ + " ▓▓", + " ▓▓", + " ▓▓", + " ▓▓", + " ▓ ▓", + " ▓▓", + " ▓▓▓", + "▓▓▓▓ ▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr green) + False), + ('∞', + Box + (Location 'g' 0 3) + (Infinity 'g') + (withForeColor defAttr green) + False), + ('G', + Box + (Location 'g' 1 2) + (Link 'g') + (withForeColor defAttr green) + True), + ('ε', + Box + (Location 'g' 3 0) + (Epsilon 'g' (makeWalls [ + "▓▓▓▓▓▓ ▓▓", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " "])) + (withForeColor defAttr green) + False), + ('1', + Box + (Location 'ε' 0 0) + (Original (solid 9)) + (withForeColor defAttr blue) + True), + ('p', + Box + (Location 'g' 0 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr magenta) + True) + ]) + 'p' + (Set.fromList [Location 'g' (-2) (-1), Location 'g' (-2) (-2)]) + (Location 'g' (-2) 0) + + +infiniteEnter19 :: World +infiniteEnter19 = + World + (Map.fromList + [('w', + Box (Location 'w' 3 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓", + "▓▓ ▓▓", + "▓▓ ▓▓", + "▓ ▓ ▓ ▓", + "▓ ▓", + "▓ ▓▓▓▓▓ ▓", + "▓ ▓▓ ▓▓ ▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr white) + False), + ('g', + Box (Location 'w' (-3) (-1)) + (Original (makeWalls [ + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ▓ ", + " " + ])) + (withForeColor defAttr green) + False), + ('∞', + Box + (Location 'w' 2 (-3)) + (Infinity 'g') + (withForeColor defAttr green) + False), + ('G', + Box + (Location 'w' (-3) 1) + (Link 'g') + (withForeColor defAttr green) + True), + ('ε', + Box + (Location 'w' 2 3) + (Epsilon 'g' (makeWalls [ + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " "])) + (withForeColor defAttr green) + False), + ('p', + Box + (Location 'w' (-1) 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr magenta) + True) + ]) + 'p' + (Set.fromList [Location 'w' 0 (-3), Location 'w' 0 (3)]) + (Location 'w' 0 0) + +infiniteEnter20 :: World +infiniteEnter20 = + World + (Map.fromList + [('_', Box + (Location '_' 0 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓ ▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓"])) + (withForeColor defAttr white) + True), + ('w', + Box (Location '_' 0 2) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓ ▓▓ ▓", + "▓ ▓▓ ▓", + "▓ ▓▓▓▓", + "▓ ▓ ▓", + "▓▓ ▓▓ ▓", + "▓ ▓", + "▓ ▓▓ ▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr white) + False), + ('r', + Box (Location 'w' 2 0) + (Original (makeWalls [ + " ", + " ", + " ", + " ▓▓▓ ", + " ▓▓▓ ", + " ▓▓▓ ", + " ", + " ", + " " + ])) + (withForeColor defAttr red) + False), + ('a', + Box + (Location 'w' 1 3) + (Link 'r') + (withForeColor defAttr red) + True), + ('b', + Box + (Location 'w' 2 3) + (Link 'r') + (withForeColor defAttr red) + True), + ('ε', + Box + (Location 'w' (-2) 3) + (Epsilon 'r' (makeWalls [ + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " ", + " "])) + (withForeColor defAttr red) + False), + ('1', + Box + (Location 'w' (-3) (-3)) + (Original (solid 9)) + (withForeColor defAttr blue) + True), + ('2', + Box + (Location 'w' (-3) (-1)) + (Original (solid 9)) + (withForeColor defAttr blue) + True), + ('3', + Box + (Location 'w' (-1) (-3)) + (Original (solid 9)) + (withForeColor defAttr blue) + True), + ('4', + Box + (Location 'w' (-1) 0) + (Original (solid 9)) + (withForeColor defAttr blue) + True), + ('5', + Box + (Location 'w' 2 (-3)) + (Original (solid 9)) + (withForeColor defAttr blue) + True) + ]) + 'r' + Set.empty + (Location 'w' (-3) 3) + + +multiInfinite8 :: World +multiInfinite8 = + World + (Map.fromList + [('b', Box + (Location 'b' 3 1) + (Original (makeWalls [ + "▓ ▓", + "▓ ▓ ▓", + "▓▓ ▓", + "▓ ▓", + "▓▓ ▓", + "▓ ▓", + "▓▓ ▓", + "▓ ▓▓▓", + "▓▓▓▓▓▓▓▓▓"])) + (withForeColor defAttr blue) + False), + ('p', + Box + (Location 'b' (-1) 0) + (Original (makeWalls [ + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓ ▓▓▓ ▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓", + "▓▓▓▓▓▓▓▓▓" + ])) + (withForeColor defAttr magenta) + True), + ('A', + Box (Location 'b' (-1) 2) + (Link 'b') + (withForeColor defAttr blue) + True), + ('1', + Box + (Location 'b' (-1) (-3)) + (Epsilon 'b' (makeWalls [ + " ", + " ▓ ", + " ", + " ▓▓", + " ▓ ", + " ▓▓", + " ", + " ", + " "])) + (withForeColor defAttr blue) + False), + ('2', + Box + (Location 'b' 1 (-3)) + (Epsilon '1' (makeWalls [ + " ", + " ", + " ▓ ", + " ▓▓", + " ▓ ", + " ▓▓", + " ", + " ", + " "])) + (withForeColor defAttr blue) + False), + ('3', + Box + (Location 'b' 3 (-3)) + (Epsilon '2' (makeWalls [ + " ", + " ", + " ", + " ▓▓", + " ▓ ", + " ▓▓", + " ", + " ", + " "])) + (withForeColor defAttr blue) + False), + ('x', + Box + (Location '2' 4 1) + (Original (solid 9)) + (withForeColor defAttr yellow) + True), + ('B', + Box + (Location '1' 0 0) + (Link 'b') + (withForeColor defAttr blue) + True), + ('C', + Box + (Location '2' 4 (-1)) + (Link 'b') + (withForeColor defAttr blue) + True) + ]) + 'p' + Set.empty + (Location '3' 0 0) \ No newline at end of file diff --git a/app/Model.hs b/app/Model.hs index 1afa5fc..453bc61 100644 --- a/app/Model.hs +++ b/app/Model.hs @@ -24,13 +24,17 @@ boxWalls world box = case boxType box of Original walls -> walls Link c -> boxWalls world (worldBoxes world Map.! c) + Infinity c -> boxWalls world (worldBoxes world Map.! c) + Epsilon _ walls -> walls data BoxType = Original (Array Coord Bool) - | Link Char + | Link Char + | Infinity Char + | Epsilon Char (Array Coord Bool) deriving (Show, Read, Eq) -data Location = Location Char Int Int +data Location = Location { locName :: Char, locY :: Int, locX :: Int } deriving (Read, Show, Ord, Eq) data World = World { @@ -115,7 +119,7 @@ moveBlock world visited loc dir offset = 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 offset' + moveBlock' world visited loc loc' dir name box Set.empty offset' moveBlock' :: World -> @@ -125,9 +129,10 @@ moveBlock' :: Movement -> Char -> Box -> + Set Location -> Rational {- ^ offset -} -> Maybe (Map Location Location) -moveBlock' world visited loc loc' dir name box offset = +moveBlock' world visited loc loc' dir name box enters offset = msum [moveTo, moveInto, moveToEat] where moveTo = @@ -135,32 +140,43 @@ moveBlock' world visited loc loc' dir name box offset = moveInto = do (n,b) <- boxAt world loc' - let (locI, offset') = enterLoc world n b dir offset - moveBlock' world visited loc locI dir name box offset' -- beware epsilon! - + (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' + else + moveBlock' world visited loc locI dir name box (Set.insert locI enters) offset' + moveToEat = do let dir' = invert dir - let (locE, _) = enterLoc world name box dir' 0 + (locE, _) <- enterLoc world name box dir' 0 (name', box') <- boxAt world loc' - moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' 0 + moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box' Set.empty 0 -enterLoc :: World -> Char -> Box -> Movement -> Rational -> (Location, Rational) +enterLoc :: World -> Char -> Box -> Movement -> Rational -> Maybe (Location, Rational) enterLoc world name box dir@(dy,dx) offset = - case dir of - (-1, 0) -> go yhi (midpoint xlo xhi offset) - ( 1, 0) -> go ylo (midpoint xlo xhi offset) - ( 0,-1) -> go (midpoint ylo yhi offset) xhi - ( 0, 1) -> go (midpoint ylo yhi offset) xlo - _ -> error "enterLoc: bad direction" - where - name' = case boxType box of - Link c -> c - Original{} -> name - ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box) - go y x = (Location name' y x, - fromIntegral(boxSize world box) * offset - - fromIntegral ((abs dy *x + abs dx*y))) + do name' <- + case boxType box of + Link c -> Just c + Original{} -> Just name + Infinity{} -> Nothing + Epsilon {} -> Just name + let go y x = Just + (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 + (-1, 0) -> go yhi (midpoint xlo xhi offset) + ( 1, 0) -> go ylo (midpoint xlo xhi offset) + ( 0,-1) -> go (midpoint ylo yhi offset) xhi + ( 0, 1) -> go (midpoint ylo yhi offset) xlo + _ -> error "enterLoc: bad direction" boxAt :: World -> Location -> Maybe (Char, Box) boxAt world loc = @@ -195,5 +211,18 @@ nextLoc world (dy, dx) = go Set.empty $ (offset + fromIntegral (abs dy*x+abs dx*y)) / fromIntegral (boxSize world box) + go visited (Location b y x) offset + | Set.member b visited + , Just b' <- findInfinity world b + = go visited (Location b' y x) offset + go _ _ _ = Nothing +findInfinity :: World -> Char -> Maybe Char +findInfinity world 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 diff --git a/app/Rendering.hs b/app/Rendering.hs index 7feb490..1b710bb 100644 --- a/app/Rendering.hs +++ b/app/Rendering.hs @@ -49,17 +49,27 @@ renderCell world locMap name box y x scale = Nothing | Set.member loc (worldButtons world) -> button (boxColor box) scale | loc == worldHome world -> home (boxColor box) scale - | otherwise -> unit (boxColor box) scale '░' + | otherwise -> unit (boxColor box) scale floorChar where loc = Location name' y x name' = case boxType box of Original{} -> name Link c -> c + Infinity c -> c + Epsilon{} -> name wallChar = case boxType box of Original{} -> '▓' Link{} -> '▒' + Infinity {} -> '▓' + Epsilon {} -> '▓' + floorChar = + case boxType box of + Original{} -> '░' + Link{} -> '·' + Infinity {} -> '∞' + Epsilon {} -> 'ε' renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image renderBox world locMap box name scale = @@ -137,7 +147,10 @@ drawNestedWorld locMap world = stackedLoc :: World -> Map Location Char -> Location -> Maybe Location stackedLoc world locMap = go Set.empty where - go visited loc | Set.member loc visited = Nothing + go visited loc@(Location b y x) + | Set.member loc visited = + do b' <- findInfinity world b + go visited (Location b' y x) go visited loc@(Location b y x) = do box <- Map.lookup b (worldBoxes world)