Attach terminal to analyser (these should rather be combined)

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