parabox/app/Rendering.hs

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