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 Model unit :: Attr -> Int -> Char -> Image unit a scale x = vertCat (replicate scale (string a (replicate (2*scale) x))) renderCell :: World -> Map Location Char -> Char -> Box -> Int -> Int -> Int -> Image renderCell world locMap name box y x scale = if boxWalls world box ! (y,x) then unit (boxColor box) scale wallChar else case Map.lookup (Location name' y x) locMap of Nothing -> unit (boxColor box) scale '░' Just n -> if scale == 1 then unit (boxColor (worldBoxes world Map.! n)) scale n else renderBox world locMap (worldBoxes world Map.! n) n (scale `div` boxSize world box) where name' = case boxType box of Original{} -> name Link c -> c wallChar = case boxType box of Original{} -> '▓' Link{} -> '▒' renderBox :: World -> Map Location Char -> Box -> Char -> Int -> Image renderBox world locMap box name scale = vertCat [ horizCat [ renderCell world locMap name box y x scale | x <- [xlo .. xhi] ] | let ((ylo,xlo),(yhi,xhi)) = bounds (boxWalls world box) , y <- [ylo .. yhi] ] 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) 49 '?' Just (Location n y x) -> let box = worldBoxes world Map.! n in renderCell world locMap n box y x 49 | x_ <- [x1-1 .. x1+1] ] | y_ <- [y1-1 .. y1+1] ] where border = 20 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) 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 world 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