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
+1 -1
View File
@@ -28,7 +28,7 @@ airlock0 = defaultRoom
, _rmPath = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20 5) ]
, _rmPmnts =
[pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
$ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) 1 (V2 (-1) 20) (V2 41 20) 2
$ \_ _ -> Just $ putDoubleDoor False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2
,spanLightI (V2 (-2) 30) (V2 (-2) 70)
,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
+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
+2 -2
View File
@@ -254,7 +254,7 @@ centerVaultRoom w h d = do
col = dim $ dim $ bright red
theDoor =
[ pContID (PS (V2 35 (d+4)) 0) (PutButton $ makeSwitch col red id id)
$ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
$ sPS (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) (V2 21 0) (V2 0 0) 2)
$ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) 1 (V2 (-21) 0) (V2 0 0) 2)
$ sPS (V2 0 (d-10)) 0 (PutSlideDr False col (cond' btid) 1 (V2 21 0) (V2 0 0) 2)
]
cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn