75 lines
2.4 KiB
Haskell
75 lines
2.4 KiB
Haskell
module Dodge.Debug where
|
|
import Dodge.Data
|
|
import Dodge.Picture
|
|
import Dodge.Picture.Layer
|
|
import Dodge.Zone
|
|
import Dodge.Base
|
|
import Geometry.Zone
|
|
import Geometry.Data
|
|
import Geometry
|
|
import Picture
|
|
import qualified IntMapHelp as IM
|
|
import qualified Data.IntSet as IS
|
|
|
|
import Control.Lens
|
|
|
|
drawCircleAtFor :: Point2 -> Int -> World -> World
|
|
drawCircleAtFor p t w = w & props %~
|
|
IM.insert k Projectile
|
|
{ _pjPos = p
|
|
, _pjStartPos = p
|
|
, _pjVel = V2 0 0
|
|
, _prDraw = \_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate p $ color white $ circleSolid 20
|
|
, _pjID = k
|
|
, _pjUpdate = \_ -> pjTimerF t k
|
|
}
|
|
where
|
|
k = IM.newKey $ _props w
|
|
drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World
|
|
drawCircleAtForCol p t col w = w & props %~
|
|
IM.insert k Projectile
|
|
{ _pjPos = p
|
|
, _pjStartPos = p
|
|
, _pjVel = V2 0 0
|
|
, _prDraw = \_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate p $ color col $ circleSolid 20
|
|
, _pjID = k
|
|
, _pjUpdate = \_ -> pjTimerF t k
|
|
}
|
|
where
|
|
k = IM.newKey $ _props w
|
|
drawLineForCol :: [Point2] -> Int -> Color -> World -> World
|
|
drawLineForCol ps t col w = w & props %~
|
|
IM.insert k Projectile
|
|
{ _pjPos = head ps
|
|
, _pjStartPos = head ps
|
|
, _pjVel = V2 0 0
|
|
, _prDraw = \_ -> (,) mempty $ onLayer PtLayer $ color col $ lineOfThickness 5 ps
|
|
, _pjID = k
|
|
, _pjUpdate = \_ -> pjTimerF t k
|
|
}
|
|
where
|
|
k = IM.newKey $ _props w
|
|
|
|
pjTimerF :: Int -> Int -> World -> World
|
|
pjTimerF 0 i = props %~ IM.delete i
|
|
pjTimerF time i = props . ix i . pjUpdate .~ (\_ -> pjTimerF (time - 1) i)
|
|
|
|
drawDDA :: IM.IntMap IS.IntSet -> Picture
|
|
drawDDA = setLayer 1 . color (withAlpha 0.5 green) . IM.foldlWithKey' f blank
|
|
where
|
|
f pic x' ys' = concatMapPic (\y -> polygon (rectNSEW (y+50) y (x+50) x)) ys `appendPic` pic
|
|
where
|
|
x = 50 * fromIntegral x'
|
|
ys = map ((50 *) . fromIntegral) $ IS.toList ys'
|
|
|
|
debugWallZoningPic :: World -> Picture
|
|
debugWallZoningPic w = setLayer 1 $ zonesPic `appendPic` wallsPic
|
|
where
|
|
wallsPic = setDepth 25 . color yellow . concatMapPic (drawTheWall . _wlLine) $ IM.elems theWalls
|
|
drawTheWall (a,b) = lineOfThickness 20 [a,b]
|
|
theWalls = wallsAlongLine sp ep w
|
|
zonesPic = setDepth 20 $ drawDDA zones
|
|
zones = ddaExt zoneSize sp ep
|
|
sp = _crPos $ you w
|
|
ep = mouseWorldPos w
|