justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Various improvements, metal debris

Browse Source
This commit is contained in:
justin
2022-06-23 18:53:26 +01:00
parent e3d5c4eb4b
commit 8d266a6770
18 changed files with 147 additions and 82 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Door.hs
+18 -18
View File
@@ -6,7 +6,6 @@ module Dodge.Placement.Instance.Door
) where
import Dodge.Data
import Dodge.Default.Door
--import Dodge.Base
import Color
import Geometry
import Dodge.LevelGen.Data
@@ -16,47 +15,48 @@ import Dodge.LevelGen.Switch
import Control.Lens
import qualified Data.IntMap.Strict as IM
putDoubleDoor :: Bool -> Color -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor pathing col cond a b speed
= putDoubleDoorThen pathing col cond 1 a b speed (const $ const Nothing)
putDoubleDoor :: Wall -> (World -> Bool) -> Point2 -> Point2 -> Float -> Placement
putDoubleDoor wl cond a b speed
= putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
putDoubleDoorThen :: Bool -> Color -> (World -> Bool)
putDoubleDoorThen :: Wall -> (World -> Bool)
-> Float -> Point2 -> Point2 -> Float
-> (Placement -> Placement -> Maybe Placement)
-> Placement
putDoubleDoorThen pathing col cond soff a b speed cont
= doorBetween pathing col cond soff a half speed
$ \pl1 -> Just $ doorBetween pathing col cond soff b half speed
putDoubleDoorThen wl cond soff a b speed cont
= doorBetween wl cond soff a half speed
$ \pl1 -> Just $ doorBetween wl cond soff b half speed
$ \pl2 -> cont pl1 pl2
where
half = 0.5 *.* (a +.+ b)
doorBetween :: Bool -> Color -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
doorBetween :: Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
(Placement -> Maybe Placement) -> Placement
doorBetween pathing col cond soff pa pb speed g = case divideLine 40 pa pb of
[x,y] -> ptCont (PutSlideDr pathing col adoor soff x y) g
(x:y:zs) -> divideDoorPane Nothing pathing col cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
[x,y] -> ptCont (PutSlideDr adoor wl soff x y) g
(x:y:zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
_ -> undefined
where
adoor = defaultDoor
& drTrigger .~ cond
& drSpeed .~ speed
divideDoorPane :: Maybe Int -> Bool -> Color -> (World -> Bool) -> Float -> Float
divideDoorPane :: Maybe Int -> Wall -> (World -> Bool) -> Float -> Float
-> [(Point2,Point2)] -> (Placement -> Maybe Placement) -> Placement
divideDoorPane mid pathing col cond soff speed ppairs g = case ppairs of
divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
[p] -> ptCont (adoor p) g
(p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) pathing col cond soff speed ps g
(p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
_ -> undefined
where
adoor (x,y) = PutSlideDr pathing col thedoor soff x y
adoor (x,y) = PutSlideDr thedoor wl soff x y
thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
& drPushedBy .~ maybe PushesItself PushedBy mid
putAutoDoor :: Point2 -> Point2 -> Placement
putAutoDoor a b = PlacementUsingPos (addZ 0 a)
$ \az -> PlacementUsingPos (addZ 0 b)
$ \bz -> putDoubleDoor True (dim yellow) (cond az bz) a b 3
$ \bz -> putDoubleDoor defaultAutoWall
(cond az bz) a b 3
where
--cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures
cond az bz = any (crNearPoint 40 (0.5 *.* (stripZ az +.+ stripZ bz)))
@@ -67,7 +67,7 @@ switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeS
$ \btid -> jsps0J (doorbetween btid dra drc)
$ sps0 (doorbetween btid drb drc)
where
doorbetween btid a b = PutSlideDr False col thedoor 1 a b
doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 1 a b
where
thedoor = defaultDoor
& drTrigger .~ cond btid