module Rendering where import Data.Array import Data.Map (Map) import Data.Map qualified as Map import Data.Set qualified as Set import Graphics.Vty import Data.List (intersperse) import Model renderBox :: World -> Map Location Char -> Box -> Char -> Image renderBox world locMap box boxName = vertCat [ horizCat [ if boxWalls box ! (y,x) then unit myAttr '▓' else case Map.lookup (Location boxName y x) locMap of Nothing -> unit myAttr '░' Just n -> unit (boxColor (worldBoxes world Map.! n)) n | x <- [xlo .. xhi] ] | let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box) , let myAttr = boxColor box , y <- [ylo .. yhi] , let unit a x = string a [x,x] ] renderBox' :: World -> Map Location Char -> Box -> Char -> Int -> Image renderBox' world locMap box boxName scale | scale == 1 = renderBox world locMap box boxName | otherwise = vertCat [ horizCat [ 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 (scale `div` boxSize box) where box' = worldBoxes world Map.! n | x <- [xlo .. xhi] ] | let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box) , let myAttr = boxColor box , y <- [ylo .. yhi] ] where unit a x = vertCat (replicate scale (string a (replicate (2*scale) x))) drawNestedWorld :: World -> Image drawNestedWorld world = -- (3*49) + 49 + (3*49) cropTop (49 + 2*border) $ cropLeft (2*(49 + 2*border)) $ cropBottom (2*49 + border) $ cropRight (2*(2*49 + border)) $ vertCat [ horizCat [ case stackedLoc world (Location name1 y x) of Nothing -> unit (withForeColor defAttr black) '?' Just (Location n y x) -> let box = worldBoxes world Map.! n myAttr = boxColor box in if boxWalls box ! (y,x) then unit myAttr '▓' else case Map.lookup (Location n y x) locMap of Nothing -> unit myAttr '░' Just n -> renderBox' world locMap box' n (49 `div` boxSize box) where box' = worldBoxes world Map.! n | x <- [x1-1 .. x1+1] ] | y <- [y1-1 .. y1+1] ] where border = 20 unit a x = vertCat (replicate 49 (string a (replicate (2*49) x))) locMap = Map.fromList [(boxLocation loc, n) | (n, loc) <- Map.toList (worldBoxes world)] -- name1 is the box the player is standing in Location name0 _ _ = boxLocation (worldBoxes world Map.! worldMe world) Location name1 y1 x1 = boxLocation (worldBoxes world Map.! name0) drawWorld :: World -> Image drawWorld world = horizCat $ intersperse (char defAttr ' ') [ renderBox world locMap box boxName | (boxName, box) <- Map.toList (worldBoxes world) ] where locMap = Map.fromList [(boxLocation loc, n) | (n, loc) <- Map.toList (worldBoxes world)] stackedLoc :: World -> Location -> Maybe Location stackedLoc world = go Set.empty where go visited loc | Set.member loc visited = Nothing go visited loc@(Location b y x) = do box <- Map.lookup b (worldBoxes world) let bnds@((ylo,xlo),(yhi,xhi)) = bounds (boxWalls box) if inRange bnds (y, x) then Just loc else let dx = overflow (xlo,xhi) x dy = overflow (ylo,yhi) y Location parent py px = boxLocation box in go (Set.insert loc visited) (Location parent (py+dy) (px+dx)) overflow :: (Int, Int) -> Int -> Int overflow (lo,hi) x | x < lo = x - lo | x > hi = x - hi | otherwise = 0