Start simplifying Prop

src/Dodge/Data/Prop.hs

@@ -39,14 +39,10 @@ data Debris = DebrisChunk
 --data PropType = FallingBlock Material
 
 data PropDraw
-    = PropDrawSPic SPic
-    | --    | PropDrawMovingShapeCol Shape
-      --    | PropDrawMovingShape PropDraw
-      PropDrawFlatTranslate PropDraw
+    = PropDrawFlatTranslate SPic
     | PropDoubleLampCover Float
     | PropVerticalLampCover Float
     | PropLampCover Float
-    | PropDrawToggle PropDraw
 
 --    | PropDrawGib Float
 --deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Default/Prop.hs

@@ -7,7 +7,7 @@ defaultProp :: Prop
 defaultProp =
     ShapeProp
         { _prPos = V2 0 0
-        , _prDraw = PropDrawSPic mempty
+        , _prDraw = PropDrawFlatTranslate mempty
         , _prID = 0
         , _prUpdate = PropUpdateId
         , _prToggle = True

src/Dodge/Placement/Instance/LightSource.hs

@@ -49,7 +49,6 @@ moveLSThen ::
     Placement
 moveLSThen posf off sh = propLSThen (PropUpdatePosition posf) (PrWdLsSetPosition posf off) thels theprop
   where
-    --lsupdate _ w = lsParam . lsPos .~ addZ 0 (fst (posf w)) +.+.+ rotate3z (snd (posf w)) off
     thels = LS 0 $ LSParam 0 200 0.6
     theprop =
         ShapeProp
@@ -58,7 +57,7 @@ moveLSThen posf off sh = propLSThen (PropUpdatePosition posf) (PrWdLsSetPosition
             , _prRot = 0
             , _prUpdate = PropUpdateId
             , --, _prDraw = PropDrawSPic $ noPic $ uncurryV translateSHf (_prPos pr) $ rotateSH (_pjRot pr) sh
-              _prDraw = PropDrawFlatTranslate $ PropDrawSPic $ noPic sh
+              _prDraw = PropDrawFlatTranslate $ noPic sh
             , _prToggle = True
             }
 

src/Dodge/Prop/Draw.hs

@@ -25,16 +25,11 @@ debrisSPic db = translateSP (_dbPos db) . overPosSP (Q.rotate (_dbRot db)) $
 
 drawProp :: PropDraw -> Prop -> SPic
 drawProp = \case
-    PropDrawSPic spic -> const spic
---    PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (drawProp pd' pr)
---    PropDrawMovingShapeCol sh -> (`drawMovingShapeCol` sh)
     PropDoubleLampCover h -> drawDoubleLampCover h
     PropVerticalLampCover h -> drawVerticalLampCover h
     PropLampCover h -> drawLampCover h
-    PropDrawToggle pd' -> propDrawToggle pd'
---    PropDrawGib x -> noPic . drawGib x
     PropDrawFlatTranslate x -> \pr ->
-        uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr
+        uncurryV translateSPxy (_prPos pr) $ rotateSP (_prRot pr) x
 
 drawGib :: Float -> Color -> Shape
 drawGib x col = flesh <> skin
@@ -47,11 +42,6 @@ drawGib x col = flesh <> skin
             translateSH (V3 1 1 (1 - x)) baseCube
     baseCube = upperPrismPoly Small Typical (2 * x) $ square x
 
-propDrawToggle :: PropDraw -> Prop -> SPic
-propDrawToggle pd pr
-    | not (_prToggle pr) = mempty
-    | otherwise = drawProp pd pr
-
 drawLampCover :: Float -> Prop -> SPic
 drawLampCover h pr =
     noPic

src/Dodge/Room/LongDoor.hs

@@ -2,6 +2,7 @@
 -- | Rooms containing long doors, probably with a big reveal behind them.
 module Dodge.Room.LongDoor where
 
+import Linear
 import Dodge.Door.PutSlideDoor
 import Dodge.Default.Wall
 import Control.Monad
@@ -77,7 +78,6 @@ twinSlowDoorRoom w h x =
     thedoor btid =
         defaultDoor
             & drUpdate . drLerpSpeed .~ wlSpeed
---            & drTrigger .~ WdBlBtNotOff btid
             & drTrigger .~ WdBlBtOn btid
     col = dim $ dim $ bright red
 
@@ -101,23 +101,19 @@ addSouthPillars x h r = do
 addButtonSlowDoor :: RandomGen g => Float -> Float -> Room -> State g Room
 addButtonSlowDoor x h rm = do
     shuffleLinks $
-        setOutLinksPD aboveH $
-            setInLinksPD belowH $
+        setOutLinksPD (f (> h + 40)) $
+            setInLinksPD (f (< h - 40)) $
                 rm
                     & rmPmnts .++~ [butDoor, theterminal]
                     & rmBound .:~ openDoorBound
   where
+    f g y = g $ y ^. _1 . _y
     theterminal =
         putMessageTerminal terminalColor (simpleTermMessage themessage)
             & plSpot .~ rprBoolShift (isUnusedLnkType InLink) 
                 (shiftByV2 (V2 0 (-10)) <&> (,S.singleton UsedPosLow))
-    themessage =
-        [ "WARNING:"
-        , "LARGE BIOMASS DETECTED"
-        ]
+    themessage = [ "WARNING:" , "LARGE BIOMASS DETECTED" ]
     openDoorBound = reverse $ rectNSWE (h + 5) (h - 5) (3 * x / 2) (- x / 2)
-    belowH y = (sndV2 . fst) y < h - 40
-    aboveH y = (sndV2 . fst) y > h + 40
     amountedlight dr xoff mpl = Just
         . moveLSThen
             (WdP2fDoorPosition (fromJust $ _plMID dr))
@@ -130,10 +126,8 @@ addButtonSlowDoor x h rm = do
     setmount pldr plls plpr =
         cWorld . lWorld . doors . ix (fromJust $ _plMID pldr) . drMounts
             .++~ [MountedLS (fromJust $ _plMID plls), MountedProp (fromJust $ _plMID plpr)]
-    -- TODO make the height of this light source and of other mounted lights
-    -- be taken from a single consistent source
     butDoor = putLitButOnPos
-        col
+         (dim $ light red)
         (rprBool (isUnusedLnkType InLink))
         $ \btplmnt -> Just $
             putDoubleDoorThen
@@ -151,7 +145,6 @@ addButtonSlowDoor x h rm = do
                                     dr2
                                     (-50)
                                     Nothing
-    col = dim $ light red
 
 slowDoorRoom :: RandomGen g => State g Room
 slowDoorRoom = do
@@ -168,7 +161,7 @@ slowDoorRoom = do
     let crits = zipWith (\p r -> sPS p r randC1) ps rs
         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)))
+    addButtonSlowDoor x h (proom & rmPmnts <>~ (crits <> barrels))
 
 slowDoorRoomRunPast :: RandomGen g => State g (MetaTree Room String)
 slowDoorRoomRunPast = do