Partially successful change of terminals to external entities

src/Dodge/Placement/Instance/Analyser.hs

@@ -52,7 +52,7 @@ analyser
 analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
     Just $ plSpot .~ psmc $ putTerminal' aquamarine tparams (termupdate tp)
   where
-    tparams = const $ defaultTermParams & termFutureLines ++.~ 
+    tparams = const $ defaultTermParams & tmFutureLines ++.~ 
         (map makeTermLine starts ++ [makeTermLine sucs] ++ map makeTermLine afters)
     termupdate tp btid = 
         (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))

src/Dodge/Placement/Instance/Terminal.hs

@@ -25,7 +25,7 @@ import Data.Maybe
 
 putTerminal''
     :: Machine
-    -> (World -> TerminalParams)
+    -> (World -> Terminal)
     -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
     -> Placement
 putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
@@ -46,11 +46,11 @@ putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
         tmid = fromJust (_plMID tmpl)
         btid = fromJust (_plMID btpl)
         mcid = fromJust (_plMID mcpl)
-    theterminal = defaultTerminal & tmProgram .~ const f
+    theterminal = defaultTerminal & tmProgram .~ (\_ w -> _tmFutureLines (f w))
 
 putTerminal' 
     :: Color
-    -> (World -> TerminalParams)
+    -> (World -> Terminal)
     -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
     -> Placement
 putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col)
@@ -59,7 +59,7 @@ putTerminal' col = putTerminal'' (defaultMachine & mcColor .~ col)
     , _mcSensor = SensorCloseToggle NotClose False
     }
 
-putTerminal :: Color -> (World -> TerminalParams) -> Placement
+putTerminal :: Color -> (World -> Terminal) -> Placement
 putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id)
   where
     mc = defaultMachine
@@ -73,7 +73,7 @@ termButton = Button
     { _btPict = const mempty
     , _btPos = 0
     , _btRot = 0
-    , _btEvent = displayTerminalMessage . _btTermMID
+    , _btEvent = bootTerminal . _btTermMID
     , _btID = 0
     , _btText = "TERMINAL"
     , _btState = BtOff
@@ -100,19 +100,16 @@ terminalShape mc = colorSH col (prismPoly
   where
     col = _mcColor mc
 
-displayTerminalMessage :: Maybe Int -> World -> World
-displayTerminalMessage mtmid w = case mtmid of
+bootTerminal :: Maybe Int -> World -> World
+bootTerminal mtmid w = case mtmid of
     Nothing -> w
-    Just tmid -> w & hud . hudElement .~ DisplayInventory DisplayTerminal
-        { _termID = tmid
-        , _termParams = message tmid
-        }
-  where
-    message tmid = fromMaybe NoTerminalParams $ do
-        tm      <- w ^? terminals . ix tmid
-        return $ _tmProgram tm tm w
+    Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid False)
+        & terminals . ix tmid . tmFutureLines ++.~ _tmProgram tm tm w
+        & terminals . ix tmid . tmStatus .~ Connected
+      where
+        tm = w ^?! terminals . ix tmid
 
-simpleTermMessage :: [String] -> World -> TerminalParams
+simpleTermMessage :: [String] -> World -> Terminal
 simpleTermMessage = genTermMessage . const
 --simpleTermMessage ss = const $ TerminalParams
 --    {_termDisplayedLines = []
@@ -135,5 +132,5 @@ topFlushStrings = topFlush . maximum . map length
 topFlush :: Int -> [String]
 topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]
 
-genTermMessage :: (World -> [String]) -> World -> TerminalParams
-genTermMessage f w = defaultTermParams & termFutureLines ++.~ map makeTermLine (f w)
+genTermMessage :: (World -> [String]) -> World -> Terminal
+genTermMessage f w = defaultTermParams & tmFutureLines ++.~ map makeTermLine (f w)