Implement moving mounted lights

This commit is contained in:
2022-03-10 14:43:41 +00:00
parent c583d33b57
commit 907cca0ef0
8 changed files with 80 additions and 21 deletions
+17 -6
View File
@@ -22,11 +22,13 @@ import Dodge.LightSource
import Picture
import Geometry
import LensHelp
--import Shape
import qualified Data.Set as S
import Data.Tree
import System.Random
import Control.Monad.State
import Data.Maybe
--import Data.Tree
import qualified Data.IntMap as IM
@@ -44,8 +46,8 @@ twinSlowDoorRoom w h x = defaultRoom
, _rmPath = []
, _rmPmnts =
[ pContID (PS (V2 0 (h-5)) pi) ( PutButton $ makeButton col id)
$ \btid -> jsps0J (PutSlideDr False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
$ ps0 (PutSlideDr False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \btid -> jsps0J (PutSlideDr False col (cond' btid) 1 (V2 x 1) (V2 x h) wlSpeed)
$ ps0 (PutSlideDr False col (cond' btid) 1 (V2 (-x) 1) (V2 (-x) h) wlSpeed)
$ \did -> jps0 (PutLS (lsColPos (V3 0.75 0 0) (V3 0 (h-1) lampHeight)))
$ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
]
@@ -117,8 +119,18 @@ addButtonSlowDoor x h rm = do
belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40
butDoor _ _ = putLitButOnPos col butPosCond
$ \btid -> Just $ putDoubleDoorThen False col (cond' btid) (V2 0 h) (V2 x h) 2
$ \dr1 dr2 -> Nothing
$ \btid -> Just $ putDoubleDoorThen False col (cond' btid) 30 (V2 0 h) (V2 x h) 2
$ \dr1 dr2 -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1))
(V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2))
(V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr2))
(V3 15 50 88) (aShape (V2 15 0) (V3 15 50 90))
$ \_ _ -> Just $ moveLSThen (getdoorpos (fromJust $ _plMID dr1))
(V3 15 (-50) 88) (aShape (V2 15 0) (V3 15 (-50) 90))
$ \_ _ ->Nothing
getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
in (b, argV (a-.-b))
butPosCond (UnusedLink (V2 x' y') a' _) _ | y' < 0.5 * h
= Just (PS (V2 x' y') a' , UsedSpot (V2 x' y') a' (S.singleton RoomPosExLink))
butPosCond _ _ = Nothing
@@ -139,10 +151,9 @@ slowDoorRoom = do
xs' <- replicateM 5 $ state $ randomR (10,x-10)
ys' <- replicateM 5 $ state $ randomR (h+20,y)
let crits = zipWith (\p r -> sPS p r randC1) ps rs
lsources = [sPS (V2 (x/2) 30) 0 putLamp, sPS (V2 (x/2) (y-30)) 0 putLamp]
barrels = zipWith (\x' y' -> sPS (V2 x' y') 0 $ PutCrit explosiveBarrel) xs' ys'
proom <- southPillarsRoom x y h
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels ++ lsources)))
addButtonSlowDoor x h (proom & rmPmnts %~ (++ (crits ++ barrels)))
slowDoorRoomRunPast :: RandomGen g => State g (SubCompTree Room)
slowDoorRoomRunPast = do