Work on more complicated terminals

src/Dodge/Room/Door.hs

@@ -34,6 +34,7 @@ triggerDoorRoom inplid = defaultRoom
     , _rmLinks  = init lnks++ [last lnks]
     , _rmPath   = [(V2 20 35,V2 20 5)]
     , _rmInPmnt = [InPlacement f inplid]
+    , _rmName   = "triggerDoorRoom"
 -- door extends into side walls (for shadows as rendered 12/03/21)
 -- note no bounds
     }

src/Dodge/Room/SensorDoor.hs

@@ -47,7 +47,6 @@ sensorRoomRunPast dt n = do
     t <- sensorRoom dt n
     return (applyToSubforest [0] (++
         [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
-            & rmName .~ "test"
         ] (UseLabel 0 corridor)]
         ) t 
         ,TreeSubLabelling "sensorRoomRunPast" Nothing)

src/Dodge/Room/Warning.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE TupleSections #-}
+module Dodge.Room.Warning where
+import Dodge.LevelGen.Data
+import Dodge.PlacementSpot
+import Dodge.Placement.Instance.Terminal
+import Dodge.Data
+import Dodge.Tree
+--import Dodge.RoomLink
+import Dodge.Room.Door
+import Dodge.Room.Ngon
+import Dodge.Room.Procedural
+--import Dodge.Room.Corridor
+import Dodge.Room.Link
+--import Dodge.Room.Procedural
+--import Dodge.Room.Foreground
+--import Dodge.Room.RoadBlock
+import Dodge.Placement.Instance
+--import Dodge.Default.Room
+--import Dodge.Item.Weapon.BulletGuns
+--import Dodge.Item.Weapon.Utility
+--import Dodge.LevelGen.Data
+--import Geometry.Data
+import Geometry
+--import Padding
+--import Color
+--import Shape
+--import Lorem
+import LensHelp
+import Dodge.RandomHelp
+
+--import qualified Data.Set as S
+import Data.Maybe
+--import Data.Char
+--import Data.Tree
+import Control.Monad.State
+import System.Random
+
+
+warningRooms :: RandomGen g => Int -> State g (LabSubCompTree Room)
+warningRooms n = do
+    rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
+    cenroom <- shuffleLinks $ addWarningTerminal n rm
+    let doorroom = triggerDoorRoom n
+    return ( treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
+        , TreeSubLabelling "warningRooms" Nothing)
+
+addWarningTerminal :: Int -> Room -> Room
+addWarningTerminal outplid = (rmName .++~ "warningTerm-")
+    -- & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
+    . (rmOutPmnt .~ [OutPlacement outplace outplid])
+  where
+    outplace = extTrigLitPos
+        (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
+        (\trid -> Just $ set plSpot (rprShift fps) $ putTerminal $ termMessages trid)
+    --termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))
+    fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of
+        Just 0 -> 
+            let rppos = _rpPos rp
+                rpdir = _rpDir rp
+                inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
+                rtpos = inpos +.+ rotateV rpdir (V2 30 0)
+                ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
+            in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
+                -- the above test may not work properly if the room polys are
+                -- complicated, it should really use created walls...
+                then Just (rtpos, rpdir)
+                else Just (ltpos, rpdir)
+        _ -> Nothing
+    termMessages trid = (genTermMessage $ const ["A","TEST"]) 
+        <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
+    ops trid = [ ("OPEN", triggers . ix (fromJust $ _plMID trid) .~ const True)
+        , ("LEAVE", id)
+        ]
+