109 lines
4.0 KiB
Haskell
109 lines
4.0 KiB
Haskell
{- | Creation, update and destruction of destructible walls. -}
|
|
module Dodge.LevelGen.Block
|
|
( placeBlock
|
|
, placeLineBlock
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.LevelGen.Pathing
|
|
import Dodge.Default.Wall
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
import Color
|
|
|
|
import Control.Lens
|
|
import Data.List
|
|
import qualified Data.IntSet as IS
|
|
|
|
addBlock
|
|
:: [Point2] -- ^ Block polygon
|
|
-> Int -- ^ First layer of health
|
|
-> Color
|
|
-> Opacity -- ^ Is the block see through?
|
|
-> [Int] -- ^ Extra layers of health
|
|
-> World
|
|
-> World
|
|
addBlock (p:ps) hp col opacity hps w
|
|
| hp <= 0 && null hps = w
|
|
| hp <= 0 = addBlock (p:ps) (head hps + hp) col opacity (tail hps) w
|
|
| otherwise = w
|
|
& wallsZone . znObjects %~ flip (IM.foldl' $ flip wallInZone) panes
|
|
& walls %~ IM.union panes
|
|
& blocks %~ IM.insert blid (Block {_blID = blid,_blWallIDs = IS.fromList is, _blHPs = hp:hps, _blShadows=[]})
|
|
where
|
|
blid = IM.newKey $ _blocks w
|
|
lns = zip (p:ps) (ps ++ [p])
|
|
i = IM.newKey $ _walls w
|
|
is = [i.. i + length lns-1]
|
|
panes = IM.fromList $ zipWith
|
|
(\j (a,b) -> (,) j defaultWall
|
|
{ _wlLine = (a,b)
|
|
, _wlID = j
|
|
, _wlColor = col
|
|
, _wlOpacity = opacity
|
|
, _wlStructure = BlockPart blid
|
|
, _wlFireThrough = True
|
|
}
|
|
) is lns
|
|
wallInZone wl
|
|
| uncurry dist (_wlLine wl) <= 2*zoneSize
|
|
= insertIMInZone x y wlid wl
|
|
| otherwise = flip (foldl' $ flip (\(a,b) -> insertIMInZone a b wlid wl)) ips
|
|
where
|
|
(x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
|
|
wlid = _wlID wl
|
|
ips = map zoneOfPoint $ uncurry (divideLine (2*zoneSize)) (_wlLine wl)
|
|
addBlock _ _ _ _ _ _ = error "Trying to add a block with incomplete polygon"
|
|
|
|
placeBlock :: [Point2] -> Int -> Color -> Opacity -> [Int] -> World -> (Int,World)
|
|
placeBlock poly i c opac is w = (0, foldr (uncurry removePathsCrossing) wWithBlock pairs)
|
|
where
|
|
pairs = loopPairs poly
|
|
wWithBlock = addBlock poly i c opac is w
|
|
|
|
{- | Splits a line into many four cornered blocks. -}
|
|
placeLineBlock
|
|
:: Wall -- ^ Base pane
|
|
-> Float -- ^ Block width
|
|
-> Float -- ^ Block depth
|
|
-> Point2 -- ^ Start point (symmetric)
|
|
-> Point2 -- ^ End point (symmetric)
|
|
-> World
|
|
-> (Int, World)
|
|
placeLineBlock basePane blockWidth depth a b w = (,) 0
|
|
$ removePathsCrossing a b $ foldr insertWall (insertBlocks w) listWalls
|
|
where
|
|
psOnLine = divideLineOddNumPoints blockWidth 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 w
|
|
blid = IM.newKey $ _blocks w
|
|
insertBlock i = over blocks $ IM.insert (i+blid) Block
|
|
{_blID = i + blid, _blWallIDs = IS.fromList $ ksAtI i, _blHPs = [5,5], _blShadows = shadowsAt i}
|
|
insertBlocks = flip (foldr insertBlock) is
|
|
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
|
|
,_wlDraw = visStatus
|
|
}
|
|
listWalls = concat $ zipWith makeWallAt blockCenPs is
|
|
insertWall wl = over walls $ IM.insert (_wlID wl) wl
|