From 5ff2fb49102cfc48ccf7e6d0f60ffea0241dccd9 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 3 Jun 2022 09:20:03 +0100 Subject: [PATCH] Cleanup terminal display --- src/Color.hs | 34 ++++++++-------- src/Dodge/Creature/Damage.hs | 4 +- src/Dodge/Creature/Impulse.hs | 2 +- src/Dodge/Creature/Inanimate.hs | 12 +++--- src/Dodge/Data.hs | 10 ++--- src/Dodge/Data/DamageType.hs | 26 ++++++------- src/Dodge/Floor.hs | 3 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 2 +- src/Dodge/LevelGen/LevelStructure.hs | 18 ++++----- src/Dodge/LockAndKey.hs | 6 +-- src/Dodge/Particle/Damage.hs | 36 ++++++++--------- src/Dodge/Particle/TeslaArc.hs | 2 +- src/Dodge/Placement/Instance/Sensor.hs | 2 +- src/Dodge/Placement/Instance/Terminal.hs | 36 ++++------------- src/Dodge/Placement/Instance/Turret.hs | 2 +- src/Dodge/Placement/TopDecoration.hs | 8 ++-- src/Dodge/Room/LongDoor.hs | 2 +- src/Dodge/Room/SensorDoor.hs | 19 ++------- src/Dodge/Room/Warning.hs | 40 ++++++++++--------- src/Dodge/Terminal.hs | 49 ++++++++++++++++++++++++ src/Dodge/Wall/Damage.hs | 24 ++++++------ src/Dodge/Wall/DamageEffect.hs | 25 ++++++------ src/Dodge/WorldEvent/Shockwave.hs | 6 +-- src/Dodge/WorldEvent/SpawnParticle.hs | 10 ++--- 24 files changed, 198 insertions(+), 180 deletions(-) diff --git a/src/Color.hs b/src/Color.hs index 9d1fd6ef5..bc6b3c22f 100644 --- a/src/Color.hs +++ b/src/Color.hs @@ -1,9 +1,9 @@ module Color where import Geometry -data PaletteColor = Red | Green | Blue | Yellow | Cyan - | Magenta | Rose | Violet | Azure | Aquamarine | Chartreuse | Orange | White | Black - deriving (Eq,Ord,Enum,Show) +data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN + | MAGENTA | ROSE | VIOLET | AZURE | AQUAMARINE | CHARTREUSE | ORANGE | WHITE | BLACK + deriving (Eq,Ord,Enum,Show,Read) type RGBA = Point4 type Color = Point4 @@ -46,20 +46,20 @@ black = V4 0 0 0 1 paletteToColor :: PaletteColor -> Color {-# INLINE paletteToColor #-} paletteToColor pc = case pc of - Red -> red - Green -> green - Blue -> blue - Yellow -> yellow - Cyan -> cyan - Magenta -> magenta - Rose -> rose - Violet -> violet - Azure -> azure - Aquamarine -> aquamarine - Chartreuse -> chartreuse - Orange -> orange - White -> white - Black -> black + RED -> red + GREEN -> green + BLUE -> blue + YELLOW -> yellow + CYAN -> cyan + MAGENTA -> magenta + ROSE -> rose + VIOLET -> violet + AZURE -> azure + AQUAMARINE -> aquamarine + CHARTREUSE -> chartreuse + ORANGE -> orange + WHITE -> white + BLACK -> black mixColors :: Float -> Float -> Color -> Color -> Color {-# INLINE mixColors #-} diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index 3708a7d15..c013d3bfa 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -19,7 +19,7 @@ defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' & creatures . ix (_crID cr) %~ doPoisonDam where (ps,ds') = partition isPoison ds - isPoison Damage{_dmType=PoisonDam} = True + isPoison Damage{_dmType=POISONDAM} = True isPoison _ = False poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10 doPoisonDam = crHP -~ poisonDam @@ -60,7 +60,7 @@ applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIn applyIndividualDamage' :: Creature -> World -> Damage -> World applyIndividualDamage' cr w dm = case _dmType dm of - Piercing -> applyPiercingDamage cr dm w + PIERCING -> applyPiercingDamage cr dm w _ -> w & damageHP cr (_dmAmount dm) applyPiercingDamage :: Creature -> Damage -> World -> World diff --git a/src/Dodge/Creature/Impulse.hs b/src/Dodge/Creature/Impulse.hs index aa34b1be0..67f86c334 100644 --- a/src/Dodge/Creature/Impulse.hs +++ b/src/Dodge/Creature/Impulse.hs @@ -93,6 +93,6 @@ followImpulse cr w imp = case imp of posFromID cid' = _crPos $ _creatures w IM.! cid' rr a = randomR (-a,a) $ _randGen w hitCr i = (creatures . ix i . crState . crDamage - .:~ Damage Blunt 100 cpos (posFromID i) (posFromID i) NoDamageEffect + .:~ Damage BLUNT 100 cpos (posFromID i) (posFromID i) NoDamageEffect ) . soundStart (CrSound cid) cpos hitS Nothing diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index a7f4ccc8f..fbf747f7a 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -88,16 +88,16 @@ damToExpBarrel :: [Damage] -> Creature -> Creature damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam where (pierceDam,otherDam) = partition isPierce ds - isPierce Damage{_dmType = Piercing{}} = True + isPierce Damage{_dmType = PIERCING{}} = True isPierce _ = False damToExpBarrel' :: Damage -> Creature -> Creature damToExpBarrel' dm cr = case _dmType dm of - Piercing -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) - $ over crHP (\hp -> hp - div amount 200) cr - PoisonDam -> cr - SparkDam -> cr - PushDam -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm)) + PIERCING -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) + $ cr & crHP -~ div amount 200 + POISONDAM -> cr + SPARKING -> cr + PUSHDAM -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm)) _ -> cr LensHelp.& crHP -~ amount where amount = _dmAmount dm diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 614b2f5c8..e7034f7f8 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -148,8 +148,8 @@ data World = World newtype GenParams = GenParams { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) } -data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration | ThreeLineDecoration - deriving (Eq,Ord,Enum,Show) +data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES + deriving (Eq,Ord,Enum,Show,Read) data HUDElement = DisplayInventory {_subInventory :: SubInventory} @@ -1324,13 +1324,13 @@ data Damage = Damage isElectrical :: Damage -> Bool isElectrical dm = case _dmType dm of - Electrical{} -> True + ELECTRICAL -> True _ -> False isMovementDam :: Damage -> Bool isMovementDam dm = case _dmType dm of - TorqueDam{} -> True - PushDam{} -> True + TORQUEDAM -> True + PUSHDAM -> True _ -> False data CreatureState = CrSt diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 8d0624ab6..b3e0f9411 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -5,16 +5,16 @@ creatures. -} module Dodge.Data.DamageType where data DamageType - = Piercing - | Blunt - | Cutting - | SparkDam - | Flaming - | Lasering - | Electrical - | Explosive - | Concussive - | TorqueDam - | PushDam - | PoisonDam - deriving (Eq,Ord,Show) + = PIERCING + | BLUNT + | CUTTING + | SPARKING + | FLAMING + | LASERING + | ELECTRICAL + | EXPLOSIVE + | CONCUSSIVE + | TORQUEDAM + | PUSHDAM + | POISONDAM + deriving (Eq,Ord,Show,Read) diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 0f47c655c..238929304 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -50,7 +50,8 @@ initialAnoTree = padSucWithDoors $ treeFromPost , TreeSubLabelling "chaseCrit+armourChaseCrit rectRoom" Nothing) ] -- , [AnoApplyInt 100 healthTest] - , [PassthroughLockKeyLists 23 [(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] )] itemRooms] + , [PassthroughLockKeyLists 23 + [(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms] , [SpecificRoom ((return . UseAll <$> tanksRoom [] []) <&> (, TreeSubLabelling "empty tanksRoom" Nothing))] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 38a23f3ff..e10e6cadf 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -583,7 +583,7 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows -> Particle -> (World, Maybe Particle) mvLaser phasev pos dir w pt - = ( damThingHitWith (\p1 p2 p3 -> Damage Lasering dam p1 p2 p3 NoDamageEffect) pos xp thHit w + = ( damThingHitWith (\p1 p2 p3 -> Damage LASERING dam p1 p2 p3 NoDamageEffect) pos xp thHit w , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 } ) where diff --git a/src/Dodge/LevelGen/LevelStructure.hs b/src/Dodge/LevelGen/LevelStructure.hs index 1577c3fa1..86d9ffc95 100644 --- a/src/Dodge/LevelGen/LevelStructure.hs +++ b/src/Dodge/LevelGen/LevelStructure.hs @@ -19,16 +19,16 @@ import Control.Monad.State import System.Random worldToGenWorld :: IM.IntMap Room -> World -> World -worldToGenWorld rms w = w & genParams .~ gparams - & genRooms .~ rms --- , _gPlacements = IM.empty --- , _gRooms = rms - where - gparams = evalState generateGenParams (_randGen w) +worldToGenWorld rms w = w + & genParams .~ evalState generateGenParams (_randGen w) + & genRooms .~ rms generateGenParams :: RandomGen g => State g GenParams generateGenParams = do - cols <- shuffle [Red .. Orange] - shps <- shuffle [PlusDecoration ..] - return . GenParams . M.fromList . zip [Flaming,Lasering,Electrical] + cols <- shuffle [RED .. ORANGE] + shps <- shuffle [PLUS ..] + return + . GenParams + . M.fromList + . zip [FLAMING,LASERING,ELECTRICAL] $ zip cols shps diff --git a/src/Dodge/LockAndKey.hs b/src/Dodge/LockAndKey.hs index 65c34101d..e089fe050 100644 --- a/src/Dodge/LockAndKey.hs +++ b/src/Dodge/LockAndKey.hs @@ -23,9 +23,9 @@ bossKeyItems = lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ] lockRoomKeyItems = [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] ) - ,(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] ) - ,(sensorRoomRunPast Flaming, takeOne [FLAMESPITTER, INCENDIARYMODULE] ) - ,(sensorRoomRunPast Lasering, return LASGUN ) + ,(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] ) + ,(sensorRoomRunPast FLAMING, takeOne [FLAMESPITTER, INCENDIARYMODULE] ) + ,(sensorRoomRunPast LASERING, return LASGUN ) ,(const slowDoorRoomRunPast, return MINIGUN) ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) ,(const glassLessonRunPast, takeOne [LASGUN]) diff --git a/src/Dodge/Particle/Damage.hs b/src/Dodge/Particle/Damage.hs index 8a5033e5b..85ca66bd7 100644 --- a/src/Dodge/Particle/Damage.hs +++ b/src/Dodge/Particle/Damage.hs @@ -10,8 +10,8 @@ import Control.Monad.State spawnAtBulDams :: (Point2 -> State StdGen Particle) -> Particle -> Point2 -> [Damage] spawnAtBulDams thespawn bt p = - [ Damage Piercing 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm)) - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + [ Damage PIERCING 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm)) + , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] where sp = head $ _ptTrail bt @@ -19,9 +19,7 @@ spawnAtBulDams thespawn bt p = ep = sp +.+ bulVel simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage] -simpleDam dt amount bt p = - [ Damage dt amount sp p ep NoDamageEffect - ] +simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ] where sp = case bt ^? ptTrail of Nothing -> _ptPos bt @@ -31,8 +29,8 @@ simpleDam dt amount bt p = basicBulDams :: Particle -> Point2 -> [Damage] basicBulDams bt p = - [ Damage Piercing 100 sp p ep NoDamageEffect - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + [ Damage PIERCING 100 sp p ep NoDamageEffect + , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] where sp = head $ _ptTrail bt @@ -40,9 +38,7 @@ basicBulDams bt p = ep = sp +.+ bulVel basicSparkDams :: Particle -> Point2 -> [Damage] -basicSparkDams bt p = - [ Damage SparkDam 1 sp p ep NoDamageEffect - ] +basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ] where sp = head $ _ptTrail bt bulVel = _ptVel bt @@ -50,14 +46,14 @@ basicSparkDams bt p = hvBulDams :: Particle -> Point2 -> [Damage] hvBulDams bt p = - [ Damage Piercing 25 sp p ep NoDamageEffect - , Damage Piercing 25 sp p ep NoDamageEffect - , Damage Piercing 25 sp p ep NoDamageEffect - , Damage Piercing 25 sp p ep NoDamageEffect - , Damage Piercing 25 sp p ep NoDamageEffect - , Damage Piercing 25 sp p ep NoDamageEffect - , Damage TorqueDam 1 sp p ep $ TorqueDamage 0.7 - , Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) + [ Damage PIERCING 25 sp p ep NoDamageEffect + , Damage PIERCING 25 sp p ep NoDamageEffect + , Damage PIERCING 25 sp p ep NoDamageEffect + , Damage PIERCING 25 sp p ep NoDamageEffect + , Damage PIERCING 25 sp p ep NoDamageEffect + , Damage PIERCING 25 sp p ep NoDamageEffect + , Damage TORQUEDAM 1 sp p ep $ TorqueDamage 0.7 + , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) ] where sp = head $ _ptTrail bt @@ -66,8 +62,8 @@ hvBulDams bt p = bounceBulDams :: Particle -> Point2 -> [Damage] bounceBulDams bt p = - [ Damage Piercing 80 sp p ep (BounceBullet bt) - , Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel + [ Damage PIERCING 80 sp p ep (BounceBullet bt) + , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel ] where sp = head $ _ptTrail bt diff --git a/src/Dodge/Particle/TeslaArc.hs b/src/Dodge/Particle/TeslaArc.hs index 61a032f43..62228f703 100644 --- a/src/Dodge/Particle/TeslaArc.hs +++ b/src/Dodge/Particle/TeslaArc.hs @@ -57,6 +57,6 @@ moveTeslaArc thearc w pt ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi) damthings (ArcStep _ _ Nothing) = id damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl - thedamage p dir = Damage Electrical 50 (p -.- q) p (p +.+ q) NoDamageEffect + thedamage p dir = Damage ELECTRICAL 50 (p -.- q) p (p +.+ q) NoDamageEffect where q = 5 *.* unitVectorAtAngle dir diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index c73a7de10..bea4d98d8 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -31,7 +31,7 @@ damageSensor dt wdth upf ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) } lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement -lightSensor = damageSensor Lasering +lightSensor = damageSensor LASERING sensorUpdate :: DamageType -> Machine -> World -> World sensorUpdate damF mc w = w & machines . ix mcid %~ upmc diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 4a0d56c73..97937d235 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -11,13 +11,14 @@ import Dodge.LevelGen.Data import Dodge.Default import Dodge.Machine import Dodge.SoundLogic +import Dodge.Terminal import Dodge.WorldEvent.Explosion import Color import Geometry import ShapePicture import LensHelp import Shape -import Sound.Data +--import Sound.Data import Data.Maybe @@ -34,10 +35,9 @@ putTerminal' col mcf = ps0PushPS (PutButton termButton) }) $ const Nothing -putTerminal :: (GenParams -> World -> TerminalParams) -> Placement -putTerminal f = ps0PushPSw PutNothing $ \w _ -> Just $ - --plGenUpdate ?~ g $ ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w)) - ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w)) +putTerminal :: (World -> TerminalParams) -> Placement +putTerminal f = ps0PushPSw PutNothing $ \_ _ -> Just $ + ps0PushPS (PutButton $ termButton & btTerminalParams .~ f) $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine { _mcDraw = noPic . terminalShape terminalColor , _mcHP = 100 @@ -82,7 +82,7 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display , _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w) } -simpleTermMessage :: [String] -> (GenParams -> World -> TerminalParams) +simpleTermMessage :: [String] -> World -> TerminalParams simpleTermMessage = genTermMessage . const --simpleTermMessage ss = const $ TerminalParams -- {_termDisplayedLines = [] @@ -105,25 +105,5 @@ topFlushStrings = topFlush . maximum . map length topFlush :: Int -> [String] topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]] -genTermMessage :: (GenParams -> [String]) -> (GenParams -> World -> TerminalParams) -genTermMessage f = \gp _ -> TerminalParams - {_termDisplayedLines = [] - ,_termFutureLines = termSoundLine computerBeepingS - : map totermline (topFlushStrings (f gp) ++ f gp) - ,_termMaxLines = 7 - ,_termTitle = "TERMINAL" - ,_termSel = Nothing --- ,_termOptions = [] - ,_termInput = Nothing - ,_termScrollCommands = [] - ,_termWriteCommands = [] - } - where - totermline s = TerminalLineDisplay 0 (const (s,white)) - -termSoundLine :: SoundID -> TerminalLine -termSoundLine sid = TerminalLineEffect 0 termsound - where - termsound subinv w = soundStart TerminalSound tpos sid Nothing w - where - tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos +genTermMessage :: (World -> [String]) -> World -> TerminalParams +genTermMessage f w = defaultTermParams & termFutureLines ++.~ map makeTermLine (f w) diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 94465019d..57b415678 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -83,7 +83,7 @@ updateTurret rotSpeed mc w & creatures . ix cid . crPos .~ mcpos & creatures . ix cid . crDir .~ mcdir dodamage = machines . ix mcid %~ - ( (mcDamage .~ [Damage Electrical (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) + ( (mcDamage .~ [Damage ELECTRICAL (min 2500 $ max 0 (elecDam - 10)) 0 0 0 NoDamageEffect]) . (mcHP -~ dam) ) elecDamBranch diff --git a/src/Dodge/Placement/TopDecoration.hs b/src/Dodge/Placement/TopDecoration.hs index 9a68122d9..17e1a9ca8 100644 --- a/src/Dodge/Placement/TopDecoration.hs +++ b/src/Dodge/Placement/TopDecoration.hs @@ -9,10 +9,10 @@ import Color decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Color -> Shape decorationToShape dec = case dec of - PlusDecoration -> plusDecoration - SquareDecoration -> squareDecoration - CircleDecoration -> circleDecoration - ThreeLineDecoration -> threeLineDecoration + PLUS -> plusDecoration + SQUARE -> squareDecoration + CIRCLE -> circleDecoration + THREELINES -> threeLineDecoration midBarDecoration :: Float -> Float -> Float -> Color -> Color -> Shape midBarDecoration w h z _ c = embossingR diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 7c968ff3f..c74691f6e 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -101,7 +101,7 @@ addButtonSlowDoor x h rm = do themessage = ["WARNING:" ,"LARGE BIOMASS DETECTED" - ] ++ replicate 5 "" + ] openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) belowH y = (sndV2 . fst) y < h - 40 aboveH y = (sndV2 . fst) y > h + 40 diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index 03c126a06..fbec68908 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -3,6 +3,7 @@ module Dodge.Room.SensorDoor where import Dodge.LevelGen.Data import Dodge.PlacementSpot import Dodge.Placement.Instance.Terminal +import Dodge.Terminal import Dodge.Data import Dodge.Tree --import Dodge.RoomLink @@ -30,7 +31,6 @@ import Dodge.RandomHelp import qualified Data.Set as S import Data.Maybe -import Data.Char --import Data.Tree import Control.Monad.State import System.Random @@ -83,20 +83,9 @@ sensInsideDoor senseType outplid rm = rm thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) - , putTerminal (genTermMessage messagef) + , putTerminal (const $ defaultTermParams & addInputLine [damageCodeCommand,quitCommand] + [helpCommand,commandsCommand] + ) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10) ] & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] - where - mtoup = map toUpper - horline = "-----------------" - messagef gp = - let Just (pc,ds) = gp ^? sensorCoding . ix senseType - in [horline - ,"SENSOR ATTRIBUTES" - ,horline - ,mtoup $ show senseType - ,"COLOR:"++ mtoup (show pc) - ,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds) - ,horline - ] diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index bf28709fb..69def9bae 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -53,26 +53,30 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-") where outplace = extTrigLitPos (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) - (Just . set plSpot (rprShift fps) . putTerminal . termMessages) - --termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)) - fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of - Just 0 -> - let rppos = _rpPos rp - rpdir = _rpDir rp - inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5)) - rtpos = inpos +.+ rotateV rpdir (V2 30 0) - ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0) - in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm) - -- the above test may not work properly if the room polys are - -- complicated, it should really use created walls... - then Just (rtpos, rpdir) - else Just (ltpos, rpdir) - _ -> Nothing - termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"]) - ops trid f gw w = f gw w & termFutureLines ++.~ [ TerminalLineInput 0 + (Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal . termMessages) + termMessages trid _ = defaultTermParams & addInputLine [unlockCommand trid,quitCommand] [helpCommand,infoCommand theinfo,commandsCommand] - ] + --termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"]) + --ops trid f gw w = f gw w & termFutureLines ++.~ [ TerminalLineInput 0 + -- [unlockCommand trid,quitCommand,damageCodeCommand] + -- [helpCommand,infoCommand theinfo,commandsCommand] + -- ] unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid) toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True theinfo = "DOOR CONTROLABLE WITH THE \"OPEN\" COMMAND. THIS TERMINAL CANNOT CLOSE THE DOOR." + +moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2,Float) +moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of + Just 0 -> + let rppos = _rpPos rp + rpdir = _rpDir rp + inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5)) + rtpos = inpos +.+ rotateV rpdir (V2 30 0) + ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0) + in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm) + -- the above test may not work properly if the room polys are + -- complicated, it should really use created walls... + then Just (rtpos, rpdir) + else Just (ltpos, rpdir) + _ -> Nothing diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index fa0a346b5..f0a37b13e 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -1,11 +1,17 @@ module Dodge.Terminal where import Dodge.Data +import Dodge.Base +import Dodge.SoundLogic import Color import Justify import LensHelp +import Sound.Data +import Data.Char import Data.Maybe +import qualified Data.Map as M import qualified Data.Text as T +import Text.Read import Data.List (find) quitCommand :: TerminalCommand @@ -22,6 +28,21 @@ disconnectTerminal = hud . hudElement . subInventory . termParams %~ ( (termInput .~ Nothing) . (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] ) ) +damageCodeCommand :: TerminalCommand +damageCodeCommand = TerminalCommand + { _tcString = "DAMAGECODE" + , _tcAlias = ["DCODE","DC"] + , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." + , _tcArgumentType = Just "A DAMAGE TYPE" + , _tcArguments = map (map toUpper . show) . M.keys . _sensorCoding . _genParams + , _tcEffect = f + } + where + f args w = fromMaybe (Left "") $ do + dtype <- safeHead args >>= readMaybe + dinfo <- _sensorCoding (_genParams w) M.!? dtype + return $ Right $ w & infoClearInput [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)] + helpCommand :: TerminalCommand helpCommand = TerminalCommand { _tcString = "HELP" @@ -70,6 +91,12 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col) makeTermLine :: String -> TerminalLine makeTermLine = makeColorTermLine white +termSoundLine :: SoundID -> TerminalLine +termSoundLine sid = TerminalLineEffect 0 termsound + where + termsound subinv w = soundStart TerminalSound tpos sid Nothing w + where + tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos infoCommand :: String -> TerminalCommand infoCommand str = TerminalCommand @@ -136,3 +163,25 @@ doTerminalEffect' s w = fromMaybe (w & badinput) $ do ) ) +addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams +addInputLine searchablecommands hiddencommands = termFutureLines ++.~ + [TerminalLineInput 0 searchablecommands hiddencommands] + +defaultTermParams :: TerminalParams +defaultTermParams = TerminalParams + {_termDisplayedLines = [] + ,_termFutureLines = termSoundLine computerBeepingS + : map makeTermLine connectionBlurb + ,_termMaxLines = 14 + ,_termTitle = "TERMINAL" + ,_termSel = Nothing + ,_termInput = Nothing + ,_termScrollCommands = [] + ,_termWriteCommands = [] + } + +connectionBlurb :: [String] +connectionBlurb = + ["CONNECTING ..." + ,"COMPLETE" + ] diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index f2965e59c..5a770b0df 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -17,18 +17,18 @@ damageWall dt wl = case _wlStructure wl of damageBlockWith :: Damage -> Block -> Block damageBlockWith dm = case _dmType dm of - Piercing -> blHPs %~ reduceHead dam - Blunt -> blHPs %~ reduceHead dam - Cutting -> blHPs %~ reduceHead dam - Explosive -> blHPs %~ reduceHead dam - Concussive -> blHPs %~ reduceHead dam - Lasering {} -> id - SparkDam {} -> id - Flaming {} -> id - Electrical {} -> id - TorqueDam {} -> id - PushDam {} -> id - PoisonDam {} -> id + PIERCING -> blHPs %~ reduceHead dam + BLUNT -> blHPs %~ reduceHead dam + CUTTING -> blHPs %~ reduceHead dam + EXPLOSIVE -> blHPs %~ reduceHead dam + CONCUSSIVE -> blHPs %~ reduceHead dam + LASERING -> id + SPARKING -> id + FLAMING -> id + ELECTRICAL -> id + TORQUEDAM -> id + PUSHDAM -> id + POISONDAM -> id where dam = _dmAmount dm diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index de24ef066..696096aae 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -11,19 +11,18 @@ import Control.Monad.State defaultWallDamage :: Damage -> Wall -> World -> World defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of - Lasering -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl) - Piercing -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) - . wlDustAt wl outTo - Blunt -> wlDustAt wl outTo - Explosive-> id - Cutting -> id - SparkDam -> id - Flaming -> id - Electrical -> id - Concussive -> id - TorqueDam -> id - PushDam -> id - PoisonDam -> id + LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl) + PIERCING -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo + BLUNT -> wlDustAt wl outTo + EXPLOSIVE -> id + CUTTING -> id + SPARKING -> id + FLAMING -> id + ELECTRICAL -> id + CONCUSSIVE -> id + TORQUEDAM -> id + PUSHDAM -> id + POISONDAM -> id where sp = _dmFrom dm p = _dmAt dm diff --git a/src/Dodge/WorldEvent/Shockwave.hs b/src/Dodge/WorldEvent/Shockwave.hs index 7749d39c6..050b3ca6e 100644 --- a/src/Dodge/WorldEvent/Shockwave.hs +++ b/src/Dodge/WorldEvent/Shockwave.hs @@ -62,13 +62,13 @@ mvShockwave is w pt tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt) rad = r - (3/4) * r * tFraction doDams = over creatures (IM.map damCr) - . flip (IM.foldl' (flip $ damageWall (Damage Explosive 10000 p p p NoDamageEffect))) + . flip (IM.foldl' (flip $ damageWall (Damage EXPLOSIVE 10000 p p p NoDamageEffect))) hitBlocks hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w damCr cr | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr | otherwise = cr & crState . crDamage .:~ - Damage PushDam dam cpos cpos cpos + Damage PUSHDAM dam cpos cpos cpos (PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p))) where cpos = _crPos cr @@ -108,7 +108,7 @@ moveInverseShockwave w pt damCr cr | dist (_crPos cr) p >= rad + _crRad cr = cr | otherwise = cr & crState . crDamage .:~ - Damage PushDam 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos)) + Damage PUSHDAM 1 cpos cpos cpos (PushBackDamage $ 25 *.* squashNormalizeV (p -.- cpos)) where cpos = _crPos cr diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index f16db0646..4af08d95e 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -42,7 +42,7 @@ aFlameParticle t pos vel maycid = PtZ , _ptCrIgnore = maycid , _ptWidth = 4 , _ptTimer = t - , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = 20 } drawFlame @@ -126,7 +126,7 @@ incBall p = do , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = 20 } @@ -154,7 +154,7 @@ aStaticBall p = return PtZ , _ptCrIgnore = Nothing , _ptWidth = 3 , _ptTimer = 20 - , _ptHitEff = expireAndDamage $ simpleDam Electrical 20 + , _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20 , _ptZ = 20 } @@ -178,7 +178,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w , _ptCrIgnore = maycid , _ptWidth = size , _ptTimer = time - , _ptHitEff = expireAndDamage $ simpleDam Flaming 20 + , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20 , _ptZ = z } where @@ -307,5 +307,5 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC where damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 - doDam cr = cr & crState . crDamage .:~ Damage PoisonDam 1 clpos clpos clpos NoDamageEffect + doDam cr = cr & crState . crDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect clpos = stripZ $ _clPos c