Allow for more changable terminal screen colors

src/Dodge/Data/Input.hs

@@ -19,7 +19,8 @@ data PressType
 data MouseContext
     = NoMouseContext
     | MouseAiming
-    | MouseClick
+    | MouseInGame
+    | MouseMenuClick
     | OverInvSelect { _mcoInvSelect :: (Int,Int)}
     | OverInvFilt { _mcoInvFilt :: (Int,Int)}
     | OverCombSelect { _mcoCombSelect :: (Int,Int)}

src/Dodge/Data/Terminal.hs

@@ -35,7 +35,6 @@ data Terminal = Terminal
     , _tmMachineID :: Int
     , _tmName :: String
     , _tmExternalColor :: Color
-    , _tmScreenColor :: Color
     , _tmDisplayedLines :: [(String, Color)]
     , _tmFutureLines :: [TerminalLine]
     , _tmTitle :: String

src/Dodge/Default/Terminal.hs

@@ -27,7 +27,6 @@ defaultTerminal =
         , _tmPartialCommand = Nothing
         , _tmType = DefaultTerminal
         , _tmExternalColor = dark magenta
-        , _tmScreenColor = green
         }
 
 defaultTerminalInput :: TerminalInput

src/Dodge/Machine/Draw.hs

@@ -2,6 +2,7 @@ module Dodge.Machine.Draw (
     drawMachine,
 ) where
 
+import Dodge.Terminal.Color
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.LWorld
@@ -41,22 +42,18 @@ terminalShape lw mc = fromMaybe mempty $ do
                 [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
                 (addZ 0 `map` rectWH 10 10)
             )
-            <> colorSH
-                (getTermScreenColor term)
+            <> screenbackground (getcol term)
+  where
+    getcol term = fromMaybe black $ termScreenColor term
+    screenbackground col = colorSH
+                col
                 ( prismBox
                     Small
-                    Superfluous
+                    Typical
                     [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
                     [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
-                    --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
-                    --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8)  9, V3 8 (-8)  9]
                 )
 
-getTermScreenColor :: Terminal -> Color
-getTermScreenColor tm = case _tmStatus tm of
-    TerminalOff -> black
-    _ -> _tmScreenColor tm
-
 drawBaseMachine :: Float -> Machine -> SPic
 drawBaseMachine h mc =
     noPic

src/Dodge/Machine/Update.hs

@@ -2,6 +2,7 @@ module Dodge.Machine.Update (
     updateMachine,
 ) where
 
+import Dodge.Terminal.Color
 import Control.Monad
 import Data.List (partition)
 import Data.Maybe
@@ -34,8 +35,7 @@ terminalScreenGlow :: Machine -> World -> World
 terminalScreenGlow mc w = fromMaybe w $ do
     tid <- mc ^? mcMounts . ix ObTerminal
     term <- w ^? cWorld . lWorld . terminals . ix tid
-    guard (_tmStatus term /= TerminalOff)
-    let V4 x y z _ = _tmScreenColor term
+    V4 x y z _ <- termScreenColor term
     return $
         w & cWorld . lWorld . tempLightSources
             .:~ TLS

src/Dodge/Render/Picture.hs

@@ -80,7 +80,8 @@ mouseCursorType :: Universe -> Picture
 mouseCursorType u = case u ^. uvWorld . input . mouseContext of
     NoMouseContext -> drawEmptySet 5
     MouseAiming -> rotate a (drawPlus 5)
-    MouseClick -> drawPlus 5
+    MouseMenuClick -> drawMenuClick 5
+    MouseInGame -> drawPlus 5
     OverInvSelect {} -> drawSelect 5
     OverInvFilt {} -> drawCombFilter 5
     OverCombSelect {} -> drawSelect 5
@@ -117,6 +118,14 @@ drawReturn x = fold
 drawPlus :: Float -> Picture
 drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
 
+drawMenuClick :: Float -> Picture
+drawMenuClick x = line 
+    [ V2 0 0
+    , V2 x (-x)
+    , V2 0 (-x)
+    , V2 0 0
+    ]
+
 drawCombFilterJump :: Float -> Picture
 drawCombFilterJump x = rotate (0.25*pi) 
     $ fold [line [V2 0 0, V2 x 0], line [V2 0 0, V2 0 x]]

src/Dodge/Terminal/Color.hs

@@ -0,0 +1,13 @@
+module Dodge.Terminal.Color (
+    termScreenColor,
+) where
+
+import Dodge.Data.Terminal
+import Color
+import Control.Lens
+
+termScreenColor :: Terminal -> Maybe Color
+termScreenColor tm = case tm ^. tmStatus of
+    TerminalOff -> Nothing
+    TerminalReady -> Just green
+    TerminalBusy -> Just white

src/Dodge/Update.hs

@@ -73,6 +73,7 @@ updateUniverse u =
     updateUniverseLast
         . updateUniverseMid
         . debugEvents
+        . updateMouseContext cfig
         . over uvWorld (updateCamera cfig)
         . updateUniverseFirst
         $ u
@@ -285,7 +286,7 @@ functionalUpdate u =
         . over uvWorld updateCloseObjects
         . over uvWorld updateWheelEvents
         . over uvWorld (updateMouseInventorySelection (u ^. uvConfig))
-        . over uvWorld (updateMouseContext (u ^. uvConfig))
+--        . updateMouseContext (u ^. uvConfig)
         . over uvWorld zoneClouds
         . over uvWorld zoneCreatures
         -- . over uvWorld updateInventorySelectionList
@@ -388,13 +389,17 @@ shiftInvItemsDown (_, i) x w = fromMaybe w $ do
     f w' i' = swapInvItems g i' w'
     g i' m = fst <$> IM.lookupGT i' m
 
-updateMouseContext :: Configuration -> World -> World
-updateMouseContext cfig w =
-    w & input . mouseContext
+updateMouseContext :: Configuration -> Universe -> Universe
+updateMouseContext cfig u =
+    u & uvWorld . input . mouseContext
         .~ fromMaybe
             aimcontext
-            (overinv <|> overcomb <|> overterm)
+            (overmenu <|> overinv <|> overcomb <|> overterm)
   where
+    overmenu = do
+        screenlayer <- u ^? uvScreenLayers . ix 0
+        return MouseMenuClick
+    w = u ^. uvWorld
     aimcontext
         | ButtonRight `M.member` (w ^. input . mouseButtons) = MouseAiming
         | otherwise = NoMouseContext