106 lines
3.5 KiB
Haskell
106 lines
3.5 KiB
Haskell
{- | Creation, update and destruction of destructible walls. -}
|
|
module Dodge.Placement.PlaceSpot.Block
|
|
( plBlock
|
|
, plLineBlock
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Path
|
|
import Dodge.Base
|
|
--import Dodge.Zone
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Control.Lens
|
|
import Data.List
|
|
import qualified Data.IntSet as IS
|
|
|
|
plBlock
|
|
:: [Point2] -- ^ Block polygon
|
|
-> Block
|
|
-> Wall -- ^ Base Pane
|
|
-> World
|
|
-> (Int,World)
|
|
plBlock [] _ _ _ = error "Trying to add a block with incomplete polygon"
|
|
plBlock (p:ps) bl wl w = (,) blid $ w
|
|
& blocks . at blid ?~ bl
|
|
{ _blID = blid
|
|
, _blWallIDs = IS.fromList is
|
|
, _blShadows = []
|
|
, _blFootprint = p:ps
|
|
}
|
|
& insertWalls blid wls
|
|
where
|
|
blid = IM.newKey $ _blocks w
|
|
lns = zip (p:ps) (ps ++ [p])
|
|
i = IM.newKey $ _walls w
|
|
is = [i.. i + length lns-1]
|
|
wls = zipWith
|
|
(\j ln -> wl & wlLine .~ ln & wlID .~ j & wlStructure .~ BlockPart blid)
|
|
is
|
|
lns
|
|
|
|
{- | Splits a line into many four cornered blocks. -}
|
|
plLineBlock
|
|
:: Wall -- ^ Base pane
|
|
-> Float
|
|
-> Point2 -- ^ Start point (symmetric)
|
|
-> Point2 -- ^ End point (symmetric)
|
|
-> World
|
|
-> (Int, World)
|
|
plLineBlock basePane blwidth a b gw = ( 0
|
|
-- , foldr insertWall (insertBlocks gw) listWalls
|
|
, insertBlocks gw
|
|
)
|
|
where
|
|
depth = blwidth
|
|
psOnLine = divideLineOddNumPoints blwidth a b
|
|
halfBlockWidth = dist a b / fromIntegral (length psOnLine - 1)
|
|
blockCenPs = snd $ evenOddSplit psOnLine
|
|
numBlocks = length blockCenPs
|
|
is = [0.. numBlocks - 1]
|
|
cornerPoints = reverse $ rectWH halfBlockWidth depth -- goes clockwise around the block
|
|
cornersAt p = fmap ( (p +.+) . rotateV (argV (b -.- a)) ) cornerPoints
|
|
linesAt p = loopPairs $ cornersAt p
|
|
wlid = IM.newKey $ _walls gw
|
|
blid = IM.newKey $ _blocks gw
|
|
insertBlock (i,p) =
|
|
insertWalls (i + blid) (makeWallAt p i)
|
|
. over blocks (IM.insert (i+blid) Block
|
|
{ _blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i
|
|
, _blHP = 1000, _blShadows = shadowsAt i
|
|
, _blDir = 0 -- THIS IS NOT SENSIBLE. TODO rethink block positioning
|
|
, _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
|
|
, _blObstructs = []
|
|
, _blMaterial = _wlMaterial basePane
|
|
, _blHeight = 100
|
|
, _blPos = p, _blDraw = BlockDrawMempty }
|
|
)
|
|
insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
|
|
ksAtI i = map ( + (wlid + i*4) ) [0,1,2,3]
|
|
visibilityAt i
|
|
| i == 0 = [False,True,True ,True]
|
|
| i == numBlocks - 1 = [True ,True,False,True]
|
|
| otherwise = [False,True,False,True]
|
|
shadowsAt i
|
|
| i == 0 = ksAtI 1
|
|
| i == numBlocks - 1 = ksAtI $ numBlocks - 2
|
|
| otherwise = ksAtI (i-1) ++ ksAtI (i+1)
|
|
makeWallAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
|
|
makePane i visStatus k ps = basePane
|
|
{_wlID = k
|
|
,_wlStructure = BlockPart $ i + blid
|
|
,_wlLine = ps
|
|
,_wlUnshadowed = visStatus
|
|
}
|
|
|
|
-- | Must be done after inserting the block
|
|
insertWalls :: Int -> [Wall] -> World -> World
|
|
insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
|
|
where
|
|
(w',paths) = mapAccumR (flip insertWall) w wls
|
|
|
|
insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
|
|
insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
|
|
. (walls . at (_wlID wl) ?~ wl)
|