Make analyser into one machine

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)]]