90 lines
2.6 KiB
Haskell
90 lines
2.6 KiB
Haskell
module Dodge.LevelGen.DoorPane
|
|
( linearPane
|
|
, mkDoubleDoor
|
|
, mkSingleDoor
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.LevelGen.MoveDoor
|
|
import Picture
|
|
import qualified DoubleStack as DS
|
|
import Geometry.Vector
|
|
|
|
-- | A door pane that moves linearly between open and closed positions using a
|
|
-- boolean trigger.
|
|
linearPane
|
|
:: Color
|
|
-> Bool -- ^ Pathable flag
|
|
-> (World -> Bool) -- ^ Opening condition
|
|
-> Int -- ^ Wall id
|
|
-> (Point2,Point2) -- ^ Closed position
|
|
-> (Point2,Point2) -- ^ Open position
|
|
-> Wall
|
|
linearPane c isPathable cond n closedPos openPos = Door
|
|
{ _wlLine = closedPos
|
|
, _wlID = n
|
|
, _doorMech = dm
|
|
, _wlColor = c
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
, _doorPathable = isPathable
|
|
, _drPositions = DS.singleton closedPos
|
|
}
|
|
where
|
|
dm = doorMechan n (zoneps closedPos) openDoor closeDoor cond
|
|
openDoor = moveDoorToward openPos
|
|
closeDoor = moveDoorToward closedPos
|
|
|
|
mkSingleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
|
|
mkSingleDoor c isPathable cond pl hw is
|
|
= addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)
|
|
is
|
|
leftDoor
|
|
(map shiftLeft leftDoor)
|
|
where
|
|
leftDoor =
|
|
[ (pld +.+ perp,hwd)
|
|
, (hwd, hwu)
|
|
, (hwu, plu +.+ perp)
|
|
, (plu +.+ perp,pld +.+ perp)
|
|
]
|
|
shiftLeft = h (+.+ (pl -.- hw))
|
|
h func (x,y) = (func x,func y)
|
|
norm = 9 *.* normalizeV ( vNormal (hw -.- pl))
|
|
perp = 5 *.* normalizeV (pl -.- hw)
|
|
plu = pl +.+ norm
|
|
pld = pl -.- norm
|
|
hwu = hw +.+ norm
|
|
hwd = hw -.- norm
|
|
|
|
mkDoubleDoor :: Color -> Bool -> (World -> Bool) -> Point2 -> Point2 -> [Int] -> [Wall]
|
|
mkDoubleDoor c isPathable cond pl pr is
|
|
= addSoundToDoor (head is) pld hwd $ zipWith3 (linearPane c isPathable cond)
|
|
is
|
|
(leftDoor ++ rightDoor)
|
|
(map shiftLeft leftDoor ++ map shiftRight rightDoor)
|
|
where
|
|
leftDoor =
|
|
[ (pld +.+ perp,hwd)
|
|
, (hwd, hwu)
|
|
, (hwu, plu +.+ perp)
|
|
, (plu +.+ perp,pld +.+ perp)
|
|
]
|
|
rightDoor =
|
|
[ (pru -.- perp,hwu)
|
|
, (hwu, hwd)
|
|
, (hwd, prd -.- perp)
|
|
, (prd -.- perp,pru -.- perp)
|
|
]
|
|
shiftRight = h (+.+ (0.5 *.* (pr -.- pl)))
|
|
shiftLeft = h (+.+ (0.5 *.* (pl -.- pr)))
|
|
h func (x,y) = (func x,func y)
|
|
norm = 9 *.* normalizeV ( vNormal (pr -.- pl))
|
|
hw = 0.5 *.* (pl +.+ pr)
|
|
perp = 5 *.* normalizeV (pl -.- pr)
|
|
plu = pl +.+ norm
|
|
pld = pl -.- norm
|
|
pru = pr +.+ norm
|
|
prd = pr -.- norm
|
|
hwu = hw +.+ norm
|
|
hwd = hw -.- norm
|