Add more procedural girders

src/Dodge/Placement/Instance/Terminal.hs

@@ -1,6 +1,8 @@
 --{-# LANGUAGE TupleSections #-}
 module Dodge.Placement.Instance.Terminal 
     ( putTerminal
+    , simpleTermMessage
+    , genTermMessage
     ) where
 import Dodge.Data
 import Dodge.LevelGen.Data
@@ -27,8 +29,9 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
     })
     $ const Nothing
   where
-    g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp
-                    & plGenUpdate .~ Nothing
+    g gp pl = (gp, 
+        pl  & plType . pstPutButton . btTerminalParams .~ f gp
+            & plGenUpdate .~ Nothing
         )
     thebutton = Button
         { _btPict = const mempty
@@ -52,3 +55,31 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display
     { _termID = btid
     , _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
     }
+
+simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
+simpleTermMessage ss = const $ TerminalParams
+    {_termDisplayedLines = []
+    ,_termFutureLines = TerminalLineEffect 0 termsound
+        : map totermline (topflush ++ ss)
+    ,_termMaxLines = 7
+    }
+  where
+    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
+    totermline s = TerminalLineDisplay 0 s white
+    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+      where
+        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
+
+genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
+genTermMessage f = \gp -> TerminalParams
+    {_termDisplayedLines = []
+    ,_termFutureLines = TerminalLineEffect 0 termsound
+        : map totermline (topflush (f gp) ++ f gp)
+    ,_termMaxLines = 7
+    }
+  where
+    topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
+    totermline s = TerminalLineDisplay 0 s white
+    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
+      where
+        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos