63 lines
2.0 KiB
Haskell
63 lines
2.0 KiB
Haskell
{- | Splits a line into many four cornered blocks. -}
|
|
module Dodge.LevelGen.LineBlock
|
|
( putLineBlock
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.LevelGen.Pathing
|
|
--import Picture
|
|
import Geometry
|
|
import qualified IntMapHelp as IM
|
|
|
|
import Control.Lens
|
|
|
|
putLineBlock
|
|
:: Wall -- ^ Base pane
|
|
-> Float -- ^ Block width
|
|
-> Float -- ^ Block depth
|
|
-> Point2 -- ^ Start point (symmetric)
|
|
-> Point2 -- ^ End point (symmetric)
|
|
-> World
|
|
-> World
|
|
putLineBlock basePane blockWidth depth a b w = removePathsCrossing a b $ foldr insertBlock w listBlocks
|
|
where
|
|
d = dist a b
|
|
rot = argV (b -.- a)
|
|
psOnLine = divideLineOddNumPoints blockWidth a b
|
|
halfBlockWidth = d / fromIntegral (length psOnLine - 1)
|
|
blockCenPs = snd $ evenOddSplit psOnLine
|
|
numBlocks = length blockCenPs
|
|
is = [0.. numBlocks - 1]
|
|
cornerPoints =
|
|
[(-halfBlockWidth,-depth) -- goes anticlockwise around the block
|
|
,(-halfBlockWidth, depth)
|
|
,( halfBlockWidth, depth)
|
|
,( halfBlockWidth,-depth)
|
|
]
|
|
cornersAt p = fmap ( (p +.+) . rotateV rot) cornerPoints
|
|
linesAt p = makeLoopPairs $ cornersAt p
|
|
k = IM.newKey $ _walls w
|
|
ksAtI i = map ( + (k + i*4) ) [0,1,2,3]
|
|
visibilityAt i
|
|
| i == 0 = [ True,True,False,True]
|
|
| i == numBlocks - 1 = [False,True, True,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)
|
|
makeBlockAt :: Point2 -> Int -> [Wall]
|
|
makeBlockAt p i = zipWith3 (makePane i) (visibilityAt i) (ksAtI i) (linesAt p)
|
|
makePane i visStatus k' ps = basePane
|
|
{_wlID = k'
|
|
,_wlLine = ps
|
|
,_blIDs = ksAtI i
|
|
,_blShadows = shadowsAt i
|
|
,_blVisible = visStatus
|
|
}
|
|
listBlocks = concat $ zipWith makeBlockAt blockCenPs is
|
|
insertBlock :: Wall -> World -> World
|
|
insertBlock wl = over walls $ IM.insert (_wlID wl) wl
|
|
|