77 lines
2.2 KiB
Haskell
77 lines
2.2 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
module Dodge.LevelGen.MoveDoor
|
|
( doorMechan
|
|
, zoneps
|
|
, moveDoorToward
|
|
, addSoundToDoor
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.Base
|
|
import Dodge.Zone
|
|
import Dodge.Zone.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.Synonyms
|
|
import Geometry
|
|
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Control.Lens
|
|
|
|
-- This deserves a clean up
|
|
mvP :: Float -> Point2 -> Point2 -> Point2
|
|
{-# INLINE mvP #-}
|
|
mvP !speed !ep !p = mvPointTowardAtSpeed speed ep p
|
|
|
|
mvPs :: Float -> (Point2,Point2) -> (Point2,Point2) -> (Point2,Point2)
|
|
{-# INLINE mvPs #-}
|
|
mvPs !speed (!ex,!ey) (!sx,!sy) = (mvP speed ex sx,mvP speed ey sy)
|
|
|
|
moveDoorToward :: Float -> (Point2,Point2) -> Wall -> Wall
|
|
{-# INLINE moveDoorToward #-}
|
|
moveDoorToward speed (ex,ey) wls = wls & wlLine %~ mvPs speed (ex,ey)
|
|
--moveDoorToward !speed !(!ex,!ey) wls = wls & wlLine %~ bimap (f ex) (f ey)
|
|
-- where
|
|
-- f !p = mvPointTowardAtSpeed speed p
|
|
|
|
zoneps :: (Point2, Point2) -> [(Int,Int)]
|
|
{-# INLINE zoneps #-}
|
|
zoneps (a,b)
|
|
| dist a b <= 2 * zoneSize
|
|
= [zoneOfPoint $ pHalf a b]
|
|
| otherwise = map zoneOfPoint $ divideLine zoneSize a b
|
|
|
|
doorMechan
|
|
:: Int
|
|
-> [(Int,Int)]
|
|
-> (Wall -> Wall)
|
|
-> (Wall -> Wall)
|
|
-> (World -> Bool)
|
|
-> World
|
|
-> World
|
|
doorMechan n zonePs openEff closeEff cond w
|
|
| cond w = flip (foldr $ changeZonedWall openEff n) zonePs
|
|
$ over walls (IM.adjust openEff n) w
|
|
| otherwise = flip (foldr $ changeZonedWall closeEff n) zonePs
|
|
$ over walls (IM.adjust closeEff n) w
|
|
|
|
changeZonedWall
|
|
:: (Wall -> Wall)
|
|
-> Int
|
|
-> (Int,Int)
|
|
-> World
|
|
-> World
|
|
changeZonedWall eff n (x,y) = over (wallsZone . znObjects) $ adjustIMZone eff x y n
|
|
|
|
addSoundToDoor :: Int -> Point2 -> Point2 -> [Wall] -> [Wall]
|
|
addSoundToDoor _ _ _ [] = error "When creating door tried to add sound to nothing"
|
|
addSoundToDoor i pld hwd (x:ys) = f x : ys
|
|
where
|
|
f wl = over doorMech g wl
|
|
where
|
|
g dm w
|
|
| dist wp pld > 2 && dist wp hwd > 2
|
|
= soundFrom (WallSound i) wp doorSound (Just 1) $ dm w
|
|
| otherwise = dm w
|
|
where
|
|
wp = fst $ _wlLine (_walls w IM.! i)
|