126 lines
3.7 KiB
Haskell
126 lines
3.7 KiB
Haskell
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
|