Attach terminal to analyser (these should rather be combined)

src/Dodge/Data.hs

@@ -326,15 +326,14 @@ data Button = Button
     , _btTerminalParams :: TerminalParams
     }
 data TerminalParams = NoTerminalParams | TerminalParams
-    { _termDisplayedLines :: [(String,Color)]
+    { _termDisplayedLines :: [World -> (String,Color)]
     , _termFutureLines :: [TerminalLine]
     , _termMaxLines :: Int
     }
 data TerminalLine
     = TerminalLineDisplay
         {_tlPause :: Int
-        ,_tlString :: String
-        ,_tlColor  :: Color
+        ,_tlString :: World -> (String, Color)
         }
     | TerminalLineEffect
         {_tlPause :: Int

src/Dodge/Floor.hs

@@ -37,7 +37,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g]
 initialAnoTree = padSucWithDoors $ treeFromTrunk 
     [[AnoApplyInt 0 startRoom]
     , [AnoApplyInt 100 healthTest]
-    , [SpecificRoom $ (return . UseAll) <$> tanksRoom [] []]
+    , [SpecificRoom $ return . UseAll <$> tanksRoom [] []]
     , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
     , [SpecificRoom randomChallenges]
     , [AnoApplyInt 1 lasSensorTurretTest]

src/Dodge/Inventory.hs

@@ -136,9 +136,9 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams .
     Nothing -> w
     Just tl | _tlPause tl > 0 -> w 
         & hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1
-    Just (TerminalLineDisplay _ s c) -> w
+    Just (TerminalLineDisplay _ f) -> w
         & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
-        & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ (s,c)
+        & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ f
     Just (TerminalLineEffect _ eff) -> w
         & hud . hudElement . subInventory . termParams . termFutureLines %~ tail
         & eff (_subInventory . _hudElement $ _hud w)

src/Dodge/Placement/Instance/Analyser.hs

@@ -1,20 +1,21 @@
 module Dodge.Placement.Instance.Analyser where
 import Dodge.LevelGen.Data
-import Dodge.PlacementSpot
+--import Dodge.PlacementSpot
 import Dodge.Data
 import Dodge.Base.You
 import Dodge.Default
-import Dodge.Tree
-import Dodge.RoomLink
-import Dodge.Room.Door
-import Dodge.Room.Corridor
-import Dodge.Room.Link
-import Dodge.Room.Ngon
+--import Dodge.Tree
+--import Dodge.RoomLink
+--import Dodge.Room.Door
+--import Dodge.Room.Corridor
+--import Dodge.Room.Link
+--import Dodge.Room.Ngon
 --import Dodge.Room.Procedural
-import Dodge.Room.Foreground
+--import Dodge.Room.Foreground
 --import Dodge.Room.RoadBlock
 import Dodge.Placement.Instance
-import Dodge.Default.Room
+import Dodge.Placement.Shift
+--import Dodge.Default.Room
 --import Dodge.Item.Weapon.BulletGuns
 --import Dodge.Item.Weapon.Utility
 --import Dodge.LevelGen.Data
@@ -25,25 +26,45 @@ import Color
 import Shape
 import ShapePicture
 import LensHelp
-import Dodge.RandomHelp
+--import Dodge.RandomHelp
 
-import qualified Data.Set as S
+--import qualified Data.Set as S
 import Data.Maybe
-import Data.Tree
-import Control.Monad.State
-import System.Random
+--import Data.Tree
+--import Control.Monad.State
+--import System.Random
 
-analyser :: PlacementSpot
-    -> PlacementSpot
+analyser 
+    :: [String] -- | initial text
+    -> String   -- | succeed text
+    -> String   -- | fail text
+    -> [String] -- | after text
     -> (Machine -> World -> World)
+    -> PlacementSpot
+    -> PlacementSpot
     -> Placement
-analyser pslight psmc upf = extTrigLitPos pslight $ \tp ->
-    Just $ spNoID psmc
-    $ PutMachine aquamarine (reverse $ square 10) defaultMachine
-        { _mcDraw = const $ noPic $ colorSH aquamarine (upperPrismPoly 25 (square 10))
+analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
+    Just $ psPtCont psmc
+    (PutMachine aquamarine (reverse $ square 10) defaultMachine
+        { _mcDraw = const . noPic . colorSH aquamarine . upperPrismPoly 25 $ square 10
         , _mcUpdate = \mc -> (triggers . ix (fromJust $ _plMID tp) .~ const (_mcSensorToggle mc))
                         . upf mc
         }
+    ) $ \anmc -> Just
+    $ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc)
+    $ putTerminal $ const $ TerminalParams
+        { _termDisplayedLines   = []
+        , _termFutureLines      = map simpleline starts 
+            ++ [testline' (fromJust $ _plMID anmc)]
+            ++ map simpleline afters
+        , _termMaxLines = 7
+        }
+  where
+    simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)}
+    testline' mcid = TerminalLineDisplay 0 (testline mcid)
+    testline mcid w = case w ^? machines . ix mcid . mcSensorToggle of
+        Just True -> (sucs,green)
+        _ -> (fails,red)
 
 testYourHealth :: Int -> Machine -> World -> World
 testYourHealth hp mc w

src/Dodge/Placement/Instance/Terminal.hs

@@ -15,6 +15,7 @@ import Geometry
 import ShapePicture
 import LensHelp
 import Shape
+import Sound.Data
 
 import Data.Maybe
 
@@ -65,7 +66,7 @@ simpleTermMessage ss = const $ TerminalParams
     }
   where
     topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
-    totermline s = TerminalLineDisplay 0 s white
+    totermline s = TerminalLineDisplay 0 (const (s,white))
     termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
       where
         tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
@@ -73,13 +74,17 @@ simpleTermMessage ss = const $ TerminalParams
 genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
 genTermMessage f = \gp -> TerminalParams
     {_termDisplayedLines = []
-    ,_termFutureLines = TerminalLineEffect 0 termsound
+    ,_termFutureLines = termSoundLine computerBeepingS
         : map totermline (topflush (f gp) ++ f gp)
     ,_termMaxLines = 7
     }
   where
     topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
-    totermline s = TerminalLineDisplay 0 s white
-    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+    totermline s = TerminalLineDisplay 0 (const (s,white))
+
+termSoundLine :: SoundID -> TerminalLine
+termSoundLine sid = TerminalLineEffect 0 termsound
+  where
+    termsound subinv w = soundStart TerminalSound tpos sid Nothing w
       where
-        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
+        tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos

src/Dodge/Placement/Shift.hs

@@ -1,15 +1,19 @@
 module Dodge.Placement.Shift 
     ( shiftPlacement
     , shiftPSBy
+    , shiftRelativeToPS
     ) where
 import Dodge.LevelGen.Data
 import Dodge.ShiftPoint
+import LensHelp
+
 import Geometry
-import Control.Lens
 shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot
 shiftPSBy (pos,rot) ps = ps
     & psPos %~ shiftPointBy (pos,rot)
     & psRot +~ rot
+shiftRelativeToPS :: Point2 -> PlacementSpot -> PlacementSpot
+shiftRelativeToPS p ps = ps & psPos .+.+~ rotateV (_psRot ps) p
 shiftPlacement :: (Point2,Float) -> Placement -> Placement
 shiftPlacement shift plmnt = case plmnt of
 -- slightly messy NoShiftCont, necessary to stop interference with ps0jPushPS

src/Dodge/Render/HUD.hs

@@ -84,7 +84,10 @@ subInventoryDisplay subinv cfig w = case subinv of
         ]
     DisplayTerminal {_termParams = tp} -> pictures
         [ invHead cfig "TERMINAL"
-        , renderListAt subInvX 60 cfig . reverse $ take (_termMaxLines tp) (_termDisplayedLines tp)
+        , renderListAt subInvX 60 cfig 
+            . reverse 
+            . take (_termMaxLines tp) 
+            $ _termDisplayedLines tp <&> ($ w)
         ]
     CombineInventory mi -> pictures
         [ invHead cfig "COMBINE"

src/Dodge/Room/Corridor.hs

@@ -21,7 +21,7 @@ corridor = defaultRoom
     , _rmLinks = lnks'
     , _rmPath  = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
     , _rmPmnts = [ spanLightI (V2 0 39.5) (V2 40 39.5) ]
-    , _rmBound = [ rectNSWE 50 30 0 40 ]
+    , _rmBound = [ rectNSWE 50 30 (-5) 45 ]
     , _rmFloor = Tiled [makeTileFromPoly poly 2]  
     , _rmRandPSs = [psRandRanges (10,30) (30,60) (0,2*pi)]
     , _rmName = "Corridor"

src/Dodge/Room/LasTurret.hs

@@ -14,7 +14,7 @@ import Dodge.Room.Foreground
 import Dodge.Placement.Instance
 import Dodge.Placement.Instance.Analyser
 import Dodge.Default.Room
---import Dodge.Item.Weapon.BulletGuns
+import Dodge.Item.Consumable
 --import Dodge.Item.Weapon.Utility
 --import Dodge.LevelGen.Data
 --import Geometry.Data
@@ -71,7 +71,19 @@ lightSensByDoor outplid rm = rm
     sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a)
 
 healthAnalyserByDoor :: Int -> Room -> Room
-healthAnalyserByDoor outplid rm = rm 
+healthAnalyserByDoor = analyserByDoor 
+    [ replicate 20 '-'
+    , "HEALTH INTEGRITY CHECK"
+    , replicate 20 '-'
+    ] 
+    "PASSED" 
+    "REQUIRES HEALTH AT LEAST 1100" 
+    (replicate 3 "")
+    (testYourHealth 1100)
+
+analyserByDoor :: [String] -> String -> String -> [String]
+    -> (Machine -> World -> World) -> Int -> Room -> Room
+analyserByDoor sa sb sc sd mcf outplid rm = rm 
     & rmPmnts .++~ 
         [ psPt atFstLnkOut $ PutShape $ colorSH yellow 
             $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)
@@ -80,10 +92,10 @@ healthAnalyserByDoor outplid rm = rm
         ]
     & rmOutPmnt .~ 
         [OutPlacement 
-            (analyser
+            (analyser sa sb sc sd
+                mcf
                 (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
                 (atFstLnkOutShiftBy sensorshift)
-                (testYourHealth 1100)
             ) 
         outplid]
   where
@@ -94,7 +106,9 @@ healthTest :: RandomGen g => Int -> State g (SubCompTree Room)
 healthTest n = do
     cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200
     let doorroom = triggerDoorRoom n
-    return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
+    return $ treeFromPost [PassDown door
+        ,PassDown $ corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100))
+        ,PassDown cenroom,PassDown doorroom] (UseAll door)
 
 lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room)
 lasSensorTurretTest n = do

src/Dodge/Room/Pillar.hs

@@ -48,9 +48,9 @@ roomPillars pillarsize w h wn hn = do
 --            : sps (PS (V2 220 (h-20)) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
 --            : sps (PS (V2 120 20) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90))
             replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool
-                    (\rp _ -> and [RoomPosOffPath `S.member` _rpType rp
-                                , _rpPlacementUse rp == 0
-                                , _rpLinkStatus rp == NotLink ] )
+                    (\rp _ -> RoomPosOffPath `S.member` _rpType rp
+                              && _rpPlacementUse rp == 0
+                              && _rpLinkStatus rp == NotLink )
                 )
     addGirderLights $ rm 
         & rmPmnts .~ plmnts

src/Dodge/Room/Room.hs

@@ -254,11 +254,10 @@ weaponBetweenPillars = do
             , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r)
             ]
     ncrits <- state $ randomR (1,3)
-    critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> and 
-            [ RoomPosOnPath `S.member` _rpType rp
-            , _rpPlacementUse rp == 0
-            , all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
-            ]
+    critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> 
+            RoomPosOnPath `S.member` _rpType rp
+            && _rpPlacementUse rp == 0
+            && all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r)
     theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~
             sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots
     return $ singleUseAll theRoom