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

Simplify analyser terminal

Browse Source
This commit is contained in:
justin
2025-09-01 23:24:11 +01:00
parent cbcc7e4fd6
commit 8398f0b852
18 changed files with 248 additions and 190 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data/Terminal.hs
-1
View File
@@ -50,7 +50,6 @@ data TCom
= TCInfo String String -- this may not be necessary, to revisit
| TCBase
| TCDamageCommand
| TCSensorInfo
data TmWdWd
= TmWdId
src/Dodge/Data/Terminal/Status.hs
+1
View File
@@ -13,6 +13,7 @@ data TerminalStatus
| TerminalLineRead
| TerminalTextInput {_tiText :: String}
| TerminalPressTo {_tptString :: String}
| TerminalWaiting
deriving (Eq,Show)
makeLenses ''TerminalStatus
src/Dodge/Machine/Update.hs
+29 -17
View File
@@ -1,9 +1,7 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Machine.Update (
updateMachine,
) where
import Dodge.Terminal.Color
module Dodge.Machine.Update (updateMachine) where
import Control.Monad
import Data.List (partition)
import Data.Maybe
@@ -11,9 +9,12 @@ import Dodge.Base.Collide
import Dodge.Base.You
import Dodge.Data.World
import Dodge.HeldUse
import Dodge.Item.Display
import Dodge.Machine.Destroy
import Dodge.Movement.Turn
import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.Terminal.Color
import Geometry
import LensHelp
@@ -40,6 +41,7 @@ terminalScreenGlow mc w = fromMaybe w $ do
return $
w & cWorld . lWorld . lights
.:~ LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
-- w & cWorld . lWorld . tempLightSources
-- .:~ TLS
-- { _tlsParam = LSParam (_mcPos mc `v2z` 20) 30 (V3 x y z)
@@ -140,21 +142,32 @@ mcProximitySensorUpdate mc w = case ( _proxStatus sens
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . sensToggle .~ True
& playsound dedaS
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
& cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal) . tmFutureLines .:~ makeTermLine "SENSOR SUCCESS!"
(NotClose, _, False, True) ->
w & playsound dedumS
& cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ IsClose
(_, _, _, False) -> w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
(_, _, _, False) ->
w & cWorld . lWorld . machines . ix (_mcID mc) . mcType . _McSensor . proxStatus .~ NotClose
& cWorld . lWorld . terminals . ix (mc ^?! mcMounts . ix OTTerminal) . tmFutureLines
.:~ makeTermLine ("SENSOR FAIL: REQUIRES " ++ sensorReqToString (mc ^?! mcType . _McSensor . proxRequirement))
_ -> w
where
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
ycr = you w
sens = mc ^?! mcType . _McSensor
sensorReqToString :: ProximityRequirement -> String
sensorReqToString = \case
RequireHealth x -> "HEALTH ABOVE " ++ show x
RequireEquipment x -> itemBaseName x
mcProxTest :: Machine -> World -> Bool
mcProxTest mc w = case mc ^? mcType . _McSensor . proxRequirement of
Just (RequireHealth x) -> _crHP cr >= x
Just (RequireEquipment ct) -> any (\itm -> _itType itm == ct)
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
Just (RequireEquipment ct) ->
any
(\itm -> _itType itm == ct)
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
_ -> False
where
cr = you w
@@ -179,24 +192,23 @@ senseDamage threshold dt mc =
sensorTypeDamages :: SensorType -> Damage -> Bool
sensorTypeDamages = \case
LaserSensor -> \case
LaserSensor -> \case
Lasering{} -> True
_ -> False
ElectricSensor -> \case
Electrical {} -> True
Electrical{} -> True
_ -> False
ThermalSensor -> \case
Flaming {} -> True
Sparking {} -> True
Explosive {} -> True
Flaming{} -> True
Sparking{} -> True
Explosive{} -> True
_ -> False
PhysicalSensor -> \case
Piercing {} -> True
Blunt {} -> True
Crushing {} -> True
Explosive {} -> True
Piercing{} -> True
Blunt{} -> True
Crushing{} -> True
Explosive{} -> True
_ -> False
--damageUsing :: DamageType -> Damage -> Either Int Int
--damageUsing dt dm
src/Dodge/Placement/Instance/Analyser.hs
+3 -6
View File
@@ -4,7 +4,7 @@ import Color
import Dodge.Data.GenWorld
import Dodge.Default
import Dodge.Placement.Instance
import Dodge.Terminal
--import Dodge.Terminal
import LensHelp
analyser :: ProximityRequirement -> PlacementSpot -> PlacementSpot -> Placement
@@ -13,14 +13,11 @@ analyser proxreq pslight psmc = extTrigLitPos pslight $ \tp ->
plSpot .~ psmc $
putTerminal (dark magenta)
(themachine & mcMounts . at OTTrigger .~ _plMID tp)
tparams -- (linksensortotrigger tp)
tparams
where
tparams = textTerminal & tmCommands .:~ TCSensorInfo
-- linksensortotrigger tp _ mc
-- = triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)
tparams = defaultTerminal & tmStatus .~ TerminalLineRead
themachine =
defaultMachine & mcColor .~ aquamarine
-- & mcUpdate .~ mcProximitySensorUpdate
& mcType .~ McTerminal
& mcHP .~ 100
& mcType .~ McSensor (defaultProximitySensor{_proxRequirement = proxreq})
src/Dodge/Placement/Instance/Terminal.hs
+7 -2
View File
@@ -5,13 +5,13 @@ module Dodge.Placement.Instance.Terminal (
terminalColor,
) where
import Dodge.WorldEffect
import Color
import Data.Maybe
import Dodge.Data.GenWorld
import Dodge.Default
import Dodge.LevelGen.PlacementHelper
import Dodge.SoundLogic
import Dodge.WorldEffect
import Geometry
import LensHelp
@@ -20,7 +20,11 @@ putTerminalImediateAccess = putTerminalFull f
where
f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ accessTerminal (tmpl ^?! plMID . _Just)
putTerminalFull ::(Placement -> Placement -> Placement -> Maybe Placement) -> Color -> Machine -> Terminal ->
putTerminalFull ::
(Placement -> Placement -> Placement -> Maybe Placement) ->
Color ->
Machine ->
Terminal ->
Placement
putTerminalFull f col mc tm =
ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
@@ -31,6 +35,7 @@ putTerminalFull f col mc tm =
( PutMachine
(reverse $ square 10)
( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
& mcMounts . at OTTerminal .~ _plMID tmpl
& mcCloseSound ?~ fridgeHumS
)
defaultSensorWall
src/Dodge/Render/HUD.hs
+1
View File
@@ -380,6 +380,7 @@ drawTerminalDisplay cfig tm =
TerminalOff -> id
TerminalDeactivated -> id
TerminalLineRead -> id
TerminalWaiting -> (++ [("...",white)])
TerminalTextInput s ->
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
TerminalPressTo s ->
src/Dodge/Room/Airlock.hs
+2
View File
@@ -3,6 +3,7 @@
{- Rooms that contain two doors and a switch alternating both. -}
module Dodge.Room.Airlock where
import Dodge.Placement.Instance.Analyser
import Dodge.Annotation.Data
import Dodge.Data.GenWorld
import Dodge.Default.Door
@@ -35,6 +36,7 @@ decontamRoom = do
\_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
, invisibleWall $ rectNSWE 60 40 (-40) (-30)
, spanLightI (V2 (-2) 30) (V2 (-2) 70)
, analyser (RequireHealth 100) (PS 50 0) (PS (V2 70 50) 0)
]
& rmBound .~ [rectNSWE 75 15 0 40, switchcut]
where
src/Dodge/Room/Tutorial.hs
+5 -5
View File
@@ -1,9 +1,9 @@
module Dodge.Room.Tutorial where
import Dodge.Room.Room
import Dodge.Room.Corridor
import Dodge.Room.Airlock
import Dodge.Room.RoadBlock
--import Dodge.Room.Room
import Dodge.Item.Held.Cane
import Dodge.Item.Ammo
import Dodge.Annotation.Data
@@ -45,10 +45,10 @@ tutAnoTree =
OnwardList
[ AnTree $ return $ tToBTree "teststart" $ return $ cleatOnward corridor
, AnTree $ tutDrop
---- , AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
-- , AnTree corDoor
-- , AnTree $ tutRooms
-- , AnTree $ tutDrop
-- [ AnTree $ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
, AnTree corDoor
, AnTree $ tutRooms
, AnTree $ tutDrop
---- , AnTree $ pickupTut
---- , AnTree $ weaponTut
]
src/Dodge/Terminal.hs
-19
View File
@@ -6,7 +6,6 @@ module Dodge.Terminal (
textTerminal,
simpleTermMessage,
damageCodeCommand,
sensorCommand,
makeColorTermLine,
makeTermPara,
terminalReturnEffect,
@@ -16,7 +15,6 @@ module Dodge.Terminal (
tlDoEffect,
) where
import Dodge.Item.Display
import Color
import Data.Char
import qualified Data.List as List
@@ -58,7 +56,6 @@ getCommand w tm = \case
TCInfo x z -> PTE.singleton x (PTE.singleton "" (makeTermPara z))
TCBase -> quitCommand <> toggleCommands tm
TCDamageCommand -> damageCodeCommand w tm
TCSensorInfo -> sensorCommand w tm
damageCodeCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
damageCodeCommand w _
@@ -78,22 +75,6 @@ decodeSensorType st w = fromMaybe [] $ do
x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
return [makeTermLine $ show x]
-- ugly
sensorCommand :: World -> Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
sensorCommand w tm = PTE.singleton "SENSOR" $ fromMaybe mempty $ do
ProximitySensor _ _ r b <- w ^? cWorld . lWorld . machines . ix (tm ^. tmMachineID) . mcType . _McSensor
return $ PTE.fromList
[ ("", makeTermPara $ sensorReqToString r b)
]
sensorReqToString :: ProximityRequirement -> Bool -> String
sensorReqToString pr = \case
True -> "SENSOR TEST PASSED."
False -> "SENSOR REQUIRES: " ++ case pr of
RequireHealth x -> "HEALTH ABOVE " ++ show x
RequireEquipment x -> itemBaseName x
toggleCommands :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
toggleCommands tm
| null ts = mempty
src/Dodge/Terminal/Color.hs
+1
View File
@@ -12,3 +12,4 @@ termScreenColor tm = case tm ^. tmStatus of
TerminalTextInput _ -> Just green
TerminalPressTo{} -> Just green
TerminalLineRead -> Just white
TerminalWaiting -> Just green
src/Dodge/Terminal/Type.hs
+1 -4
View File
@@ -1,7 +1,4 @@
module Dodge.Terminal.Type (
getPromptTM,
getMaxLinesTM,
) where
module Dodge.Terminal.Type ( getPromptTM, getMaxLinesTM) where
getPromptTM :: String
getPromptTM = "> "
src/Dodge/WorldEffect.hs
+1
View File
@@ -62,6 +62,7 @@ accessTerminal tid w = fromMaybe w $ do
TerminalTextInput{} -> tm
TerminalLineRead -> tm
TerminalPressTo{} -> tm
TerminalWaiting{} -> tm
TerminalOff ->
tm
& tmFutureLines .~ _tmBootLines tm