diff --git a/app/Main.hs b/app/Main.hs index 173beca..ae8f84d 100644 --- a/app/Main.hs +++ b/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 - 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] + drawAt boxName box y x | x <- [xlo .. xhi] ] - - | let myAttr = boxColor box - , y <- [ylo .. yhi] + | 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)) - moveBlock world (addVisited loc loc' visited) loc' dir + do moveBlock world (addVisited loc loc' visited) loc' dir moveInto loc' = - do guard (not (isWall loc' world)) - (n,b) <- boxAt world loc' + do (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)) - let dir' = invert dir + do 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'