36 lines
1.1 KiB
Haskell
36 lines
1.1 KiB
Haskell
module Dodge.Debug.LinkDecoration (
|
|
addRoomLinkDecorations,
|
|
addRoomPolyDecorations,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Dodge.Data.GenWorld
|
|
import Dodge.RoomLink
|
|
import Geometry.Data
|
|
import Geometry.Vector
|
|
import qualified IntMapHelp as IM
|
|
import Picture
|
|
|
|
addRoomPolyDecorations :: [Room] -> World -> World
|
|
addRoomPolyDecorations rms w =
|
|
w & cWorld . lWorld . decorations
|
|
%~ IM.insertWithNewKeys (map roomPolyDecorations rms)
|
|
|
|
addRoomLinkDecorations :: [Room] -> World -> World
|
|
addRoomLinkDecorations rms w =
|
|
w & cWorld . lWorld . decorations
|
|
%~ IM.insertWithNewKeys (map roomLinkDecorations rms)
|
|
|
|
roomLinkDecorations :: Room -> Picture
|
|
roomLinkDecorations rm = foldMap (linkDecoration . lnkPosDir) $ _rmLinks rm
|
|
|
|
linkDecoration :: (Point2, Float) -> Picture
|
|
linkDecoration (p, a) = setLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi / 2)]
|
|
|
|
roomPolyDecorations :: Room -> Picture
|
|
roomPolyDecorations rm = foldMap polyWireFrame $ _rmPolys rm
|
|
|
|
polyWireFrame :: [Point2] -> Picture
|
|
polyWireFrame (x : xs) = setLayer DebugLayer . setDepth 50 . color green $ line $ (x : xs) ++ [x]
|
|
polyWireFrame _ = undefined
|