Implement terminals

src/Dodge/Placement/Instance/Terminal.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE TupleSections #-}
+module Dodge.Placement.Instance.Terminal where
+import Dodge.Data
+import Dodge.LevelGen.Data
+import Dodge.Default
+import Color
+import Geometry
+import ShapePicture
+import LensHelp
+import Shape
+
+import Data.Maybe
+
+putTerminal :: (GenParams -> TerminalParams) -> Placement
+putTerminal f = PlacementGenUpdate g $ ps0jPushPS (PutButton $ thebutton)
+    $ pt0 (PutMachine (dark magenta) (reverse $ square 10) defaultMachine
+    { _mcDraw = drawTerminal
+    , _mcHP = 100
+    })
+    $ const Nothing
+  where
+    g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp)
+    thebutton = Button
+        { _btPict = const mempty
+        , _btPos = 0
+        , _btRot = 0
+        , _btEvent = displayTerminalMessage . _btID
+        , _btID = 0
+        , _btText = "TERMINAL"
+        , _btState = BtOff
+        , _btTerminalParams = TerminalParams [] [] 10
+        }
+
+drawTerminal :: Machine -> SPic
+drawTerminal _ = noPic $ colorSH (dark green) $ upperPrismPoly 15 $ square 10
+
+displayTerminalMessage :: Int -> World -> World
+displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
+    { _termID = btid
+    , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
+    }