fix into

app/Main.hs

@@ -60,23 +60,25 @@ renderBox' world locMap box boxName ((ylo,xlo),(yhi,xhi)) scale
   [
     horizCat
     [
-      if not (inRange (bounds (boxWalls box)) (y,x)) then unit defAttr '?' else
+      drawAt boxName box y x | x <- [xlo .. xhi]
-      if boxWalls box ! (y,x) then unit myAttr '▓'
-      else case Map.lookup (Location boxName y x) locMap of
-        Nothing -> unit myAttr '░'
-        Just n -> renderBox' world locMap box' n (bounds (boxWalls box')) (scale `div` boxSize box)
-          where
-            box' = worldBoxes world Map.! n
-      | x <- [xlo .. xhi]
     ]
-
+    | y <- [ylo .. yhi]
-    | let myAttr = boxColor box
-    , y <- [ylo .. yhi]
   ]
   where
     unit a x =
       vertCat (replicate scale (string a (replicate (2*scale) x)))
-      
+    drawAt boxName box y x
+      | let goodCoord = inRange (bounds (boxWalls box))
+      , not (goodCoord (y,x))
+      = unit defAttr '?'
+      | otherwise
+      , let myAttr = boxColor box =
+        if boxWalls box ! (y,x) then unit myAttr '▓'
+        else case Map.lookup (Location boxName y x) locMap of
+          Nothing -> unit myAttr '░'
+          Just n -> renderBox' world locMap box' n (bounds (boxWalls box')) (scale `div` boxSize box)
+            where
+              box' = worldBoxes world Map.! n
 
 makeWalls :: [String] -> Array Coord Bool
 makeWalls rows = listArray ((ylo,xlo),(yhi,xhi)) (map (' '/=) (concat rows))
@@ -153,7 +155,32 @@ world0 = World {
         "▓     ▓",
         "▓▓▓ ▓▓▓"
       ]
-        
+    }),
+    ('3', Box {
+      boxColor = withForeColor defAttr blue,
+      boxLocation = Location '2' 1 1,
+      boxWalls = makeWalls [
+        "▓▓   ▓▓",
+        "▓  ▓  ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓▓▓ ▓▓▓"
+      ]
+    }),
+        ('4', Box {
+      boxColor = withForeColor defAttr black,
+      boxLocation = Location '3' (-3) 0,
+      boxWalls = makeWalls [
+        "▓▓   ▓▓",
+        "▓  ▓  ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓     ▓",
+        "▓▓▓ ▓▓▓"
+      ]
     }),
     ('b', Box {
         boxColor = withForeColor defAttr red,
@@ -214,9 +241,9 @@ loop vty (world :| history) =
       EvKey key _modifier ->
         case key of
           KUp    -> loop vty (move world (-1,0) :| world : history)
-          KDown  -> 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)
+          KRight -> loop vty (move world (0,1)  :| world : history)
           KChar 'z'
             | Just worlds <- NonEmpty.nonEmpty history ->
               loop vty worlds
@@ -250,24 +277,22 @@ moveBlock world visited loc dir =
     -- moving a box
     (name,box):_ ->
      do loc' <- nextLoc world loc dir
+        guard (not (isWall loc' world))
         moveBlock' world visited loc loc' dir name box
 
 moveBlock' world visited loc loc' dir name box =
         msum [moveTo loc', moveInto loc', moveToEat loc']
       where
         moveTo loc' =
-         do guard (not (isWall loc' world))
+         do moveBlock world (addVisited loc loc' visited) loc' dir
-            moveBlock world (addVisited loc loc' visited) loc' dir
 
         moveInto loc' =
-         do guard (not (isWall loc' world))
+         do (n,b) <- boxAt world loc'
-            (n,b) <- boxAt world loc'
             let locI = enterLoc n b dir
-            moveBlock world (addVisited loc locI visited) locI dir
+            moveBlock' world visited loc locI dir name box -- beware epsilon!
         
         moveToEat loc' =
-         do guard (not (isWall loc' world))
+         do let dir' = invert dir
-            let dir' = invert dir
             let locE = enterLoc name box dir'
             (name', box') <- boxAt world loc' 
             moveBlock' world (addVisited loc loc' visited) loc' locE dir' name' box'