justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Improve terminal color possibilities

Browse Source
This commit is contained in:
justin
2024-11-07 18:51:18 +00:00
parent bfd4649e1b
commit ccc966d652
13 changed files with 207 additions and 149 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/CharacterEnums.hs
+12
View File
@@ -0,0 +1,12 @@
module Dodge.CharacterEnums (
cFilledRect,
cWireRect,
) where
cFilledRect :: Char
{-# INLINE cFilledRect #-}
cFilledRect = toEnum 219
cWireRect :: Char
{-# INLINE cWireRect #-}
cWireRect = toEnum 128
src/Dodge/Data/Terminal.hs
+2
View File
@@ -35,6 +35,8 @@ data Terminal = Terminal
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
, _tmExternalColor :: Color
, _tmScreenColor :: Color
, _tmDisplayedLines :: [(String, Color)]
, _tmFutureLines :: [TerminalLine]
, _tmTitle :: String
src/Dodge/Default/Terminal.hs
+3
View File
@@ -2,6 +2,7 @@ module Dodge.Default.Terminal
( defaultTerminal
) where
import Color
import Dodge.Data.Terminal
import Dodge.Data.WorldEffect
@@ -25,6 +26,8 @@ defaultTerminal =
, _tmToggles = mempty
, _tmPartialCommand = Nothing
, _tmType = DefaultTerminal
, _tmExternalColor = dark magenta
, _tmScreenColor = green
}
defaultTerminalInput :: TerminalInput
src/Dodge/Machine/Draw.hs
+37 -29
View File
@@ -1,8 +1,10 @@
module Dodge.Machine.Draw
( drawMachine
) where
module Dodge.Machine.Draw (
drawMachine,
) where
import Dodge.Data.Machine
import Control.Lens
import Data.Maybe
import Dodge.Data.LWorld
import Dodge.Item.Draw.SPic
import Dodge.Item.HeldOffset
import Dodge.Placement.TopDecoration
@@ -11,10 +13,10 @@ import Picture
import Shape
import ShapePicture
drawMachine :: Machine -> SPic
drawMachine mc = case _mcType mc of
drawMachine :: LWorld -> Machine -> SPic
drawMachine lw mc = case _mcType mc of
McStatic -> mempty
McTerminal -> terminalSPic mc
McTerminal -> terminalSPic lw mc
McTurret tu -> drawBaseMachine 20 mc <> drawTurret tu mc
McSensor se -> drawBaseMachine 25 mc <> drawSensor se mc
@@ -23,31 +25,37 @@ drawSensor sens = case sens of
DamageSensor{_sensDraw = pcds} -> sensorSPic pcds
ProximitySensor{} -> const mempty
terminalSPic :: Machine -> SPic
terminalSPic = noPic . terminalShape
terminalSPic :: LWorld -> Machine -> SPic
terminalSPic lw = noPic . terminalShape lw
terminalShape :: Machine -> Shape
terminalShape mc =
colorSH
col
( prismBox
Medium
Typical
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
(addZ 0 `map` rectWH 10 10)
)
<> colorSH
black
terminalShape :: LWorld -> Machine -> Shape
terminalShape lw mc = fromMaybe mempty $ do
tid <- mc ^? mcMounts . ix ObTerminal
term <- lw ^? terminals . ix tid
return $
colorSH
(_tmExternalColor term)
( prismBox
Small
Superfluous
[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]
Medium
Typical
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
(addZ 0 `map` rectWH 10 10)
)
where
col = _mcColor mc
<> colorSH
(getTermScreenColor term)
( prismBox
Small
Superfluous
[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 =
src/Dodge/Placement/Instance/Analyser.hs
+1 -1
View File
@@ -17,7 +17,7 @@ analyser ::
analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
Just $
plSpot .~ psmc $
putTerminal
putTerminal (dark magenta)
(themachine & mcMounts . at ObTrigger .~ _plMID tp)
tparams -- (linksensortotrigger tp)
where
src/Dodge/Placement/Instance/Terminal.hs
+4 -4
View File
@@ -13,9 +13,9 @@ import Dodge.SoundLogic
import Geometry
import LensHelp
putTerminal :: Machine -> Terminal -> Placement
putTerminal mc tm =
ps0PushPS (PutTerminal tm) $
putTerminal :: Color -> Machine -> Terminal -> Placement
putTerminal col mc tm =
ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
\tmpl -> Just $
ps0PushPS (PutButton termButton) $
\btpl -> Just $
@@ -42,7 +42,7 @@ putTerminal mc tm =
putMessageTerminal :: Color -> Terminal -> Placement
putMessageTerminal col =
putTerminal $
putTerminal col $
defaultMachine
& mcColor .~ col
& mcType .~ McTerminal
src/Dodge/Render/HUD.hs
+6 -4
View File
@@ -145,7 +145,7 @@ drawSubInventory subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
NoSubInventory{} -> drawRBOptions cfig w
ExamineInventory -> drawExamineInventory cfig w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
DisplayTerminal tid -> drawTerminalDisplay tid cfig (w ^. cWorld . lWorld)
CombineInventory{_ciSections = sss} -> drawCombineInventory cfig sss w
drawCombineInventory ::
@@ -343,12 +343,14 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
sss'
(Just (0, i))
displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
tm <- w ^? terminals . ix tid
return $
invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
<> drawSelectionList secondColumnParams cfig (thesellist tm)
<> color (withAlpha 0.5 green) (drawSelectionListBackground secondColumnParams cfig 15)
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
where
toselitm (str, col) = SelectionItem [str] 1 True col 0 ()
thesellist tm = defaultSelectionList & slItems .~ thelist tm
@@ -382,7 +384,7 @@ lnkMidPosInvSelsCol cfig w i col = fromMaybe mempty . foldMap f
invHead :: Configuration -> String -> Picture
invHead cfig =
translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 80))
translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
. dShadCol white
. scale 0.4 0.4
. textJustifyLeft
src/Dodge/Render/List.hs
+17
View File
@@ -3,6 +3,7 @@ module Dodge.Render.List (
renderListAt,
drawList,
drawSelectionList,
drawSelectionListBackground,
drawListYgapScaleYoff,
drawListElement,
selSecDrawCursor,
@@ -12,8 +13,10 @@ module Dodge.Render.List (
toTopLeft,
listCursorChooseBorderScale,
selSecDrawCursorAt,
drawTitleBackground, -- should be renamed, made sensible
) where
import Dodge.ListDisplayParams
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import Dodge.Base.Window
@@ -41,6 +44,20 @@ drawSelectionList ldps cfig sl =
ldps
(BoundaryCursor [North, South])
drawTitleBackground :: Configuration -> Picture
drawTitleBackground cfig =
translateScreenPos cfig (fromTopLeft (V2 (subInvX - 5) 75))
. polygon . reverse $ rectNSWE 70 0 0 560
drawSelectionListBackground :: ListDisplayParams -> Configuration ->
Int -- list length
-> Picture
drawSelectionListBackground ldp cfig l = translateScreenPos cfig (ldp ^. ldpPos) .
polygon . reverse $ rectNSWE 5 s (-5) e
where
s = - (5 + fromIntegral l * (20 * ldp ^. ldpScale + ldp ^. ldpVerticalGap))
e = 555 -- HACK
makeSelectionListPictures :: SelectionList a -> [Picture]
makeSelectionListPictures = concatMap f . _slItems
where
src/Dodge/Render/ShapePicture.hs
+4 -4
View File
@@ -31,7 +31,7 @@ worldSPic cfig u =
<> foldup drawCreature (filtOn _crPos _creatures)
<> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems))
<> foldup btSPic (filtOn _btPos _buttons)
<> foldup mcSPic (filtOn _mcPos _machines)
<> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
where
w = _uvWorld u
foldup = foldMap'
@@ -128,7 +128,7 @@ btSPic bt =
uncurryV translateSPxy (_btPos bt) $
rotateSP (_btRot bt) (drawButton (_btPict bt) bt)
mcSPic :: Machine -> SPic
mcSPic mc =
mcSPic :: LWorld -> Machine -> SPic
mcSPic lw mc =
uncurryV translateSPxy (_mcPos mc) $
rotateSP (_mcDir mc) (drawMachine mc)
rotateSP (_mcDir mc) (drawMachine lw mc)
src/Dodge/Terminal/Type.hs
+12
View File
@@ -0,0 +1,12 @@
module Dodge.Terminal.Type (
getPromptTM,
getMaxLinesTM,
) where
import Dodge.Data.Terminal
getPromptTM :: TerminalType -> String
getPromptTM _ = "> "
getMaxLinesTM :: TerminalType -> Int
getMaxLinesTM _ = 14