Commit before making terminals there own entities

src/Dodge/Placement/Instance/Terminal.hs

@@ -28,15 +28,24 @@ putTerminal''
     -> (World -> TerminalParams)
     -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
     -> Placement
-putTerminal'' mc f mcf = ps0PushPSw (PutTerminal theterminal) $ \_ tmpl -> Just $
-    ps0PushPS (PutButton $ termButton & btTerminal .~ _plMID tmpl)
-    $ \pl -> Just $ pt0 (PutMachine (reverse $ square 10)
-        (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID pl))
-            & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) . fd mc')
+putTerminal'' mc f mcf = ps0PushPS (PutTerminal theterminal) $ \tmpl -> Just $
+    ps0PushPS (PutButton $ termButton)
+    $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
+        (mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl))
+            & mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
         )
     )
-    $ const Nothing
+    $ \mcpl -> Just $ sps0 $ PutWorldUpdate (const $ setids tmpl btpl mcpl) 
   where
+    setids tmpl btpl mcpl w = w
+        & terminals . ix tmid . tmButtonID .~ btid
+        & terminals . ix tmid . tmMachineID .~ mcid
+        & machines  . ix mcid . mcTermMID ?~ tmid
+        & buttons   . ix btid . btTermMID ?~ tmid
+      where
+        tmid = fromJust (_plMID tmpl)
+        btid = fromJust (_plMID btpl)
+        mcid = fromJust (_plMID mcpl)
     theterminal = defaultTerminal & tmProgram .~ const f
 
 putTerminal' 
@@ -58,29 +67,17 @@ putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpd
         , _mcHP = 100
         , _mcDeath = makeExplosionAt . _mcPos
         }
---  ps0PushPSw (PutTerminal theterminal) $ \_ tmpl -> Just $
---     ps0PushPS (PutButton $ termButton & btTerminal .~ _plMID tmpl)
---    $ \pl -> Just $ pt0 (PutMachine (reverse $ square 10) (defaultMachine & mcColor .~ col)
---    { _mcDraw = noPic . terminalShape
---    , _mcHP = 100
---    , _mcUpdate = basicMachineUpdate $ machineAddSound fridgeHumS (const id)
---    , _mcDeath = \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
---        . makeExplosionAt (_mcPos mc)
---    })
---    $ const Nothing
---  where
---    theterminal = defaultTerminal & tmProgram .~ const f
 
 termButton :: Button
 termButton = Button
     { _btPict = const mempty
     , _btPos = 0
     , _btRot = 0
-    , _btEvent = displayTerminalMessage . _btTerminal
+    , _btEvent = displayTerminalMessage . _btTermMID
     , _btID = 0
     , _btText = "TERMINAL"
     , _btState = BtOff
-    , _btTerminal = Nothing
+    , _btTermMID = Nothing
     , _btName = ""
     }