Implement terminals

src/Dodge/Room/SensorDoor.hs

@@ -1,13 +1,14 @@
 module Dodge.Room.SensorDoor 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.Procedural
 import Dodge.Room.Room
---import Dodge.Room.Corridor
+import Dodge.Room.Corridor
 import Dodge.Room.Link
 --import Dodge.Room.Procedural
 import Dodge.Room.Foreground
@@ -22,11 +23,13 @@ import Geometry
 --import Padding
 import Color
 import Shape
+--import Lorem
 import LensHelp
 import Dodge.RandomHelp
 
---import qualified Data.Set as S
+import qualified Data.Set as S
 import Data.Maybe
+import Data.Char
 --import Data.Tree
 import Control.Monad.State
 import System.Random
@@ -38,6 +41,16 @@ sensorRoom senseType n = do
     let doorroom = triggerDoorRoom n
     return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
 
+sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
+sensorRoomRunPast dt n = do
+    t <- sensorRoom dt n
+    return $ applyToSubforest [0] (++
+        [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
+            & rmName .~ "test"
+        ] (UseLabel 0 corridor)]
+        ) t
+        --[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
+
 sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
 sensAboveDoor sensetype wth ps = extTrigLitPos 
     (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
@@ -48,9 +61,35 @@ sensAboveDoor sensetype wth ps = extTrigLitPos
 
 sensInsideDoor :: DamageType -> Int -> Room -> Room
 sensInsideDoor senseType outplid rm = rm 
-    & rmPmnts .:~ psPt atFstLnkOut 
-        (PutShape $ colorSH yellow $
-        thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
-        <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
-        <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+    & rmName .++~ take 4 (show senseType)
+    & rmPmnts .++~ 
+        [ psPt atFstLnkOut 
+            (PutShape $ colorSH yellow $
+            thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
+            <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
+            <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
+        , putTerminal messagef 
+            & plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
+        ]
     & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
+  where
+    mtoup = map toUpper
+    horline = "-----------------"
+    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]]
+    messagef gp = 
+        let Just (pc,ds) = gp ^? sensorCoding . ix senseType
+            themessage =
+                topflush ++
+                [horline
+                ,"SENSOR ATTRIBUTES"
+                ,horline
+                ,mtoup $ show senseType
+                ,"COLOR:"++ mtoup (show pc)
+                ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
+                ,horline
+                ]
+        in TerminalParams
+            {_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
+            ,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white
+            ,_termMaxLines = 7
+            }