Make analyser into one machine

src/Dodge/Placement/Instance/Analyser.hs

@@ -34,6 +34,47 @@ import Data.Maybe
 --import Control.Monad.State
 --import System.Random
 
+
+initMCUpdate
+    :: (Machine -> World -> World)
+    -> (Machine -> World -> World)
+    -> Machine -> World -> World
+initMCUpdate initup f mc 
+    = (machines . ix (_mcID mc) . mcUpdate .~ f)
+    . initup mc
+
+analyser' 
+    :: [String] -- | initial text
+    -> String   -- | succeed text
+    -> String   -- | fail text
+    -> [String] -- | after text
+    -> (Machine -> World -> World)
+    -> PlacementSpot
+    -> PlacementSpot
+    -> Placement
+analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
+    Just $ updatebuttonname $ plSpot .~ psmc $ putTerminal' aquamarine (termupdate tp)
+  where
+    termupdate tp btid = initMCUpdate
+        (\mc -> buttons . ix btid . btTerminalParams .~
+            TerminalParams
+                { _termDisplayedLines   = []
+                , _termFutureLines      = map simpleline starts 
+                    ++ [testline' (_mcID mc)]
+                    ++ map simpleline afters
+                , _termMaxLines = 7
+                , _termTitle = "ANALYSER"
+                }
+        )
+        (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_mcSensorToggle mc))
+        )
+    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)
+    updatebuttonname = plType . putButton . btText .~ "ANALYSER"
+
 analyser 
     :: [String] -- | initial text
     -> String   -- | succeed text
@@ -52,12 +93,13 @@ analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp
         }
     ) $ \anmc -> Just
     $ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc)
-    $ putTerminal $ const $ TerminalParams
+    $ updatebuttontext $ putTerminal $ const $ TerminalParams
         { _termDisplayedLines   = []
         , _termFutureLines      = map simpleline starts 
             ++ [testline' (fromJust $ _plMID anmc)]
             ++ map simpleline afters
         , _termMaxLines = 7
+        , _termTitle = "ANALYSER"
         }
   where
     simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)}
@@ -65,6 +107,7 @@ analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp
     testline mcid w = case w ^? machines . ix mcid . mcSensorToggle of
         Just True -> (sucs,green)
         _ -> (fails,red)
+    updatebuttontext = plType . putButton . btText .~ "ANALYSER"
 
 testYourHealth :: Int -> Machine -> World -> World
 testYourHealth hp mc w

src/Dodge/Placement/Instance/Terminal.hs

@@ -1,6 +1,7 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Placement.Instance.Terminal 
     ( putTerminal
+    , putTerminal'
     , simpleTermMessage
     , genTermMessage
     ) where
@@ -19,10 +20,33 @@ import Sound.Data
 
 import Data.Maybe
 
+putTerminal' 
+    :: Color
+    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
+    -> Placement
+putTerminal' col mcf = ps0PushPS (PutButton thebutton)
+    $ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
+    { _mcDraw = noPic . colorSH col . terminalShape
+    , _mcHP = 100
+    , _mcUpdate = mcf (fromJust $ _plMID pl)
+    })
+    $ const Nothing
+  where
+    thebutton = Button
+        { _btPict = const mempty
+        , _btPos = 0
+        , _btRot = 0
+        , _btEvent = displayTerminalMessage . _btID
+        , _btID = 0
+        , _btText = "TERMINAL"
+        , _btState = BtOff
+        , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
+        }
+
 putTerminal :: (GenParams -> TerminalParams) -> Placement
 putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
     $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
-    { _mcDraw = drawTerminal
+    { _mcDraw = noPic . colorSH terminalColor . terminalShape
     , _mcHP = 100
     , _mcUpdate = machineAddSound fridgeHumS 
         $ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
@@ -31,7 +55,7 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
     $ const Nothing
   where
     g gp pl = (gp, 
-        pl  & plType . pstPutButton . btTerminalParams .~ f gp
+        pl  & plType . putButton . btTerminalParams .~ f gp
             & plGenUpdate .~ Nothing
         )
     thebutton = Button
@@ -42,14 +66,14 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
         , _btID = 0
         , _btText = "TERMINAL"
         , _btState = BtOff
-        , _btTerminalParams = TerminalParams [] [] 10
+        , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
         }
 
 terminalColor :: Color
 terminalColor = dark magenta
 
-drawTerminal :: Machine -> SPic
-drawTerminal _ = noPic $ colorSH terminalColor $ upperPrismPoly 15 $ square 10
+terminalShape :: Machine -> Shape
+terminalShape _ = upperPrismPoly 15 $ square 10
 
 displayTerminalMessage :: Int -> World -> World
 displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
@@ -63,6 +87,7 @@ simpleTermMessage ss = const $ TerminalParams
     ,_termFutureLines = TerminalLineEffect 0 termsound
         : map totermline (topflush ++ ss)
     ,_termMaxLines = 7
+    ,_termTitle = "TERMINAL"
     }
   where
     topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
@@ -77,6 +102,7 @@ genTermMessage f = \gp -> TerminalParams
     ,_termFutureLines = termSoundLine computerBeepingS
         : map totermline (topflush (f gp) ++ f gp)
     ,_termMaxLines = 7
+    ,_termTitle = "TERMINAL"
     }
   where
     topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]