58 lines
2.1 KiB
Haskell
58 lines
2.1 KiB
Haskell
module Dodge.LevelGen.LineBlock
|
|
(putLineBlock
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Dodge.LevelGen.Pathing
|
|
|
|
import Picture
|
|
import Geometry
|
|
|
|
import Control.Lens
|
|
|
|
import qualified Data.IntMap as IM
|
|
|
|
-- taken from online, splits a list into its even and odd elements
|
|
evenOddSplit = foldr f ([],[])
|
|
where f a (ls,rs) = (rs, a : ls)
|
|
|
|
putLineBlock :: Wall -> Float -> Float -> Point2 -> Point2 -> 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 = map (\(a,b) -> [a,b]) $ makeLoopPairs $ cornersAt p
|
|
k = 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
|
|
|