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

Cleanup terminal display

Browse Source
This commit is contained in:
justin
2022-06-03 09:20:03 +01:00
parent 28a002eb08
commit 5ff2fb4910
24 changed files with 198 additions and 180 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Color.hs
+17 -17
View File
@@ -1,9 +1,9 @@
module Color where module Color where
import Geometry import Geometry
data PaletteColor = Red | Green | Blue | Yellow | Cyan data PaletteColor = RED | GREEN | BLUE | YELLOW | CYAN
| Magenta | Rose | Violet | Azure | Aquamarine | Chartreuse | Orange | White | Black | MAGENTA | ROSE | VIOLET | AZURE | AQUAMARINE | CHARTREUSE | ORANGE | WHITE | BLACK
deriving (Eq,Ord,Enum,Show) deriving (Eq,Ord,Enum,Show,Read)
type RGBA = Point4 type RGBA = Point4
type Color = Point4 type Color = Point4
@@ -46,20 +46,20 @@ black = V4 0 0 0 1
paletteToColor :: PaletteColor -> Color paletteToColor :: PaletteColor -> Color
{-# INLINE paletteToColor #-} {-# INLINE paletteToColor #-}
paletteToColor pc = case pc of paletteToColor pc = case pc of
Red -> red RED -> red
Green -> green GREEN -> green
Blue -> blue BLUE -> blue
Yellow -> yellow YELLOW -> yellow
Cyan -> cyan CYAN -> cyan
Magenta -> magenta MAGENTA -> magenta
Rose -> rose ROSE -> rose
Violet -> violet VIOLET -> violet
Azure -> azure AZURE -> azure
Aquamarine -> aquamarine AQUAMARINE -> aquamarine
Chartreuse -> chartreuse CHARTREUSE -> chartreuse
Orange -> orange ORANGE -> orange
White -> white WHITE -> white
Black -> black BLACK -> black
mixColors :: Float -> Float -> Color -> Color -> Color mixColors :: Float -> Float -> Color -> Color -> Color
{-# INLINE mixColors #-} {-# INLINE mixColors #-}
src/Dodge/Creature/Damage.hs
+2 -2
View File
@@ -19,7 +19,7 @@ defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds'
& creatures . ix (_crID cr) %~ doPoisonDam & creatures . ix (_crID cr) %~ doPoisonDam
where where
(ps,ds') = partition isPoison ds (ps,ds') = partition isPoison ds
isPoison Damage{_dmType=PoisonDam} = True isPoison Damage{_dmType=POISONDAM} = True
isPoison _ = False isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10 poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = crHP -~ poisonDam doPoisonDam = crHP -~ poisonDam
@@ -60,7 +60,7 @@ applyIndividualDamage cr w dm = applyDamageEffect dm (_dmEffect dm) cr $ applyIn
applyIndividualDamage' :: Creature -> World -> Damage -> World applyIndividualDamage' :: Creature -> World -> Damage -> World
applyIndividualDamage' cr w dm = case _dmType dm of applyIndividualDamage' cr w dm = case _dmType dm of
Piercing -> applyPiercingDamage cr dm w PIERCING -> applyPiercingDamage cr dm w
_ -> w & damageHP cr (_dmAmount dm) _ -> w & damageHP cr (_dmAmount dm)
applyPiercingDamage :: Creature -> Damage -> World -> World applyPiercingDamage :: Creature -> Damage -> World -> World
src/Dodge/Creature/Impulse.hs
+1 -1
View File
@@ -93,6 +93,6 @@ followImpulse cr w imp = case imp of
posFromID cid' = _crPos $ _creatures w IM.! cid' posFromID cid' = _crPos $ _creatures w IM.! cid'
rr a = randomR (-a,a) $ _randGen w rr a = randomR (-a,a) $ _randGen w
hitCr i = (creatures . ix i . crState . crDamage 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 . soundStart (CrSound cid) cpos hitS Nothing
src/Dodge/Creature/Inanimate.hs
+6 -6
View File
@@ -88,16 +88,16 @@ damToExpBarrel :: [Damage] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
where where
(pierceDam,otherDam) = partition isPierce ds (pierceDam,otherDam) = partition isPierce ds
isPierce Damage{_dmType = Piercing{}} = True isPierce Damage{_dmType = PIERCING{}} = True
isPierce _ = False isPierce _ = False
damToExpBarrel' :: Damage -> Creature -> Creature damToExpBarrel' :: Damage -> Creature -> Creature
damToExpBarrel' dm cr = case _dmType dm of damToExpBarrel' dm cr = case _dmType dm of
Piercing -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) PIERCING -> over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr)
$ over crHP (\hp -> hp - div amount 200) cr $ cr & crHP -~ div amount 200
PoisonDam -> cr POISONDAM -> cr
SparkDam -> cr SPARKING -> cr
PushDam -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm)) PUSHDAM -> cr LensHelp.& crPos .+.+~ (1 / _crMass cr *.* _dePushBack (_dmEffect dm))
_ -> cr LensHelp.& crHP -~ amount _ -> cr LensHelp.& crHP -~ amount
where where
amount = _dmAmount dm amount = _dmAmount dm
src/Dodge/Data.hs
+5 -5
View File
@@ -148,8 +148,8 @@ data World = World
newtype GenParams = GenParams newtype GenParams = GenParams
{ _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape) { _sensorCoding :: M.Map DamageType (PaletteColor,DecorationShape)
} }
data DecorationShape = PlusDecoration | SquareDecoration | CircleDecoration | ThreeLineDecoration data DecorationShape = PLUS | SQUARE | CIRCLE | THREELINES
deriving (Eq,Ord,Enum,Show) deriving (Eq,Ord,Enum,Show,Read)
data HUDElement data HUDElement
= DisplayInventory {_subInventory :: SubInventory} = DisplayInventory {_subInventory :: SubInventory}
@@ -1324,13 +1324,13 @@ data Damage = Damage
isElectrical :: Damage -> Bool isElectrical :: Damage -> Bool
isElectrical dm = case _dmType dm of isElectrical dm = case _dmType dm of
Electrical{} -> True ELECTRICAL -> True
_ -> False _ -> False
isMovementDam :: Damage -> Bool isMovementDam :: Damage -> Bool
isMovementDam dm = case _dmType dm of isMovementDam dm = case _dmType dm of
TorqueDam{} -> True TORQUEDAM -> True
PushDam{} -> True PUSHDAM -> True
_ -> False _ -> False
data CreatureState = CrSt data CreatureState = CrSt
src/Dodge/Data/DamageType.hs
+13 -13
View File
@@ -5,16 +5,16 @@ creatures.
-} -}
module Dodge.Data.DamageType where module Dodge.Data.DamageType where
data DamageType data DamageType
= Piercing = PIERCING
| Blunt | BLUNT
| Cutting | CUTTING
| SparkDam | SPARKING
| Flaming | FLAMING
| Lasering | LASERING
| Electrical | ELECTRICAL
| Explosive | EXPLOSIVE
| Concussive | CONCUSSIVE
| TorqueDam | TORQUEDAM
| PushDam | PUSHDAM
| PoisonDam | POISONDAM
deriving (Eq,Ord,Show) deriving (Eq,Ord,Show,Read)
src/Dodge/Floor.hs
+2 -1
View File
@@ -50,7 +50,8 @@ initialAnoTree = padSucWithDoors $ treeFromPost
, TreeSubLabelling "chaseCrit+armourChaseCrit rectRoom" Nothing) , TreeSubLabelling "chaseCrit+armourChaseCrit rectRoom" Nothing)
] ]
-- , [AnoApplyInt 100 healthTest] -- , [AnoApplyInt 100 healthTest]
, [PassthroughLockKeyLists 23 [(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] )] itemRooms] , [PassthroughLockKeyLists 23
[(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )] itemRooms]
, [SpecificRoom ((return . UseAll <$> tanksRoom [] []) , [SpecificRoom ((return . UseAll <$> tanksRoom [] [])
<&> (, TreeSubLabelling "empty tanksRoom" Nothing))] <&> (, TreeSubLabelling "empty tanksRoom" Nothing))]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
src/Dodge/Item/Weapon/BatteryGuns.hs
+1 -1
View File
@@ -583,7 +583,7 @@ mvLaser :: Float -- ^ Phase velocity, controls deflection through windows
-> Particle -> Particle
-> (World, Maybe Particle) -> (World, Maybe Particle)
mvLaser phasev pos dir w pt 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 } , Just pt {_ptDraw = const pic ,_ptUpdate = ptSimpleTime 0 }
) )
where where
src/Dodge/LevelGen/LevelStructure.hs
+8 -8
View File
@@ -19,16 +19,16 @@ import Control.Monad.State
import System.Random import System.Random
worldToGenWorld :: IM.IntMap Room -> World -> World worldToGenWorld :: IM.IntMap Room -> World -> World
worldToGenWorld rms w = w & genParams .~ gparams worldToGenWorld rms w = w
& genParams .~ evalState generateGenParams (_randGen w)
& genRooms .~ rms & genRooms .~ rms
-- , _gPlacements = IM.empty
-- , _gRooms = rms
where
gparams = evalState generateGenParams (_randGen w)
generateGenParams :: RandomGen g => State g GenParams generateGenParams :: RandomGen g => State g GenParams
generateGenParams = do generateGenParams = do
cols <- shuffle [Red .. Orange] cols <- shuffle [RED .. ORANGE]
shps <- shuffle [PlusDecoration ..] shps <- shuffle [PLUS ..]
return . GenParams . M.fromList . zip [Flaming,Lasering,Electrical] return
. GenParams
. M.fromList
. zip [FLAMING,LASERING,ELECTRICAL]
$ zip cols shps $ zip cols shps
src/Dodge/LockAndKey.hs
+3 -3
View File
@@ -23,9 +23,9 @@ bossKeyItems =
lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ] lockRoomKeyItems :: RandomGen g => [ (Int -> State g (LabSubCompTree Room) , State g CombineType ) ]
lockRoomKeyItems = lockRoomKeyItems =
[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] ) [(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD,FORCEFIELDGUN] )
,(sensorRoomRunPast Electrical, takeOne [STATICMODULE,SPARKGUN] ) ,(sensorRoomRunPast ELECTRICAL, takeOne [STATICMODULE,SPARKGUN] )
,(sensorRoomRunPast Flaming, takeOne [FLAMESPITTER, INCENDIARYMODULE] ) ,(sensorRoomRunPast FLAMING, takeOne [FLAMESPITTER, INCENDIARYMODULE] )
,(sensorRoomRunPast Lasering, return LASGUN ) ,(sensorRoomRunPast LASERING, return LASGUN )
,(const slowDoorRoomRunPast, return MINIGUN) ,(const slowDoorRoomRunPast, return MINIGUN)
,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD]) ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
,(const glassLessonRunPast, takeOne [LASGUN]) ,(const glassLessonRunPast, takeOne [LASGUN])
src/Dodge/Particle/Damage.hs
+16 -20
View File
@@ -10,8 +10,8 @@ import Control.Monad.State
spawnAtBulDams :: (Point2 -> State StdGen Particle) spawnAtBulDams :: (Point2 -> State StdGen Particle)
-> Particle -> Point2 -> [Damage] -> Particle -> Point2 -> [Damage]
spawnAtBulDams thespawn bt p = spawnAtBulDams thespawn bt p =
[ Damage Piercing 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm)) [ Damage PIERCING 50 sp p ep (DamageSpawn $ \_ dm -> thespawn (_dmAt dm))
, Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _ptTrail bt sp = head $ _ptTrail bt
@@ -19,9 +19,7 @@ spawnAtBulDams thespawn bt p =
ep = sp +.+ bulVel ep = sp +.+ bulVel
simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage] simpleDam :: DamageType -> Int -> Particle -> Point2 -> [Damage]
simpleDam dt amount bt p = simpleDam dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
[ Damage dt amount sp p ep NoDamageEffect
]
where where
sp = case bt ^? ptTrail of sp = case bt ^? ptTrail of
Nothing -> _ptPos bt Nothing -> _ptPos bt
@@ -31,8 +29,8 @@ simpleDam dt amount bt p =
basicBulDams :: Particle -> Point2 -> [Damage] basicBulDams :: Particle -> Point2 -> [Damage]
basicBulDams bt p = basicBulDams bt p =
[ Damage Piercing 100 sp p ep NoDamageEffect [ Damage PIERCING 100 sp p ep NoDamageEffect
, Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _ptTrail bt sp = head $ _ptTrail bt
@@ -40,9 +38,7 @@ basicBulDams bt p =
ep = sp +.+ bulVel ep = sp +.+ bulVel
basicSparkDams :: Particle -> Point2 -> [Damage] basicSparkDams :: Particle -> Point2 -> [Damage]
basicSparkDams bt p = basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]
[ Damage SparkDam 1 sp p ep NoDamageEffect
]
where where
sp = head $ _ptTrail bt sp = head $ _ptTrail bt
bulVel = _ptVel bt bulVel = _ptVel bt
@@ -50,14 +46,14 @@ basicSparkDams bt p =
hvBulDams :: Particle -> Point2 -> [Damage] hvBulDams :: Particle -> Point2 -> [Damage]
hvBulDams bt p = 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 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 TORQUEDAM 1 sp p ep $ TorqueDamage 0.7
, Damage PushDam 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp) , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 3 *.* (ep -.- sp)
] ]
where where
sp = head $ _ptTrail bt sp = head $ _ptTrail bt
@@ -66,8 +62,8 @@ hvBulDams bt p =
bounceBulDams :: Particle -> Point2 -> [Damage] bounceBulDams :: Particle -> Point2 -> [Damage]
bounceBulDams bt p = bounceBulDams bt p =
[ Damage Piercing 80 sp p ep (BounceBullet bt) [ Damage PIERCING 80 sp p ep (BounceBullet bt)
, Damage PushDam 1 sp p ep . PushBackDamage $ 2 *.* bulVel , Damage PUSHDAM 1 sp p ep . PushBackDamage $ 2 *.* bulVel
] ]
where where
sp = head $ _ptTrail bt sp = head $ _ptTrail bt
src/Dodge/Particle/TeslaArc.hs
+1 -1
View File
@@ -57,6 +57,6 @@ moveTeslaArc thearc w pt
ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi) ArcStep lp' ld' (Just (Right _)) -> (lp' -.- 2 *.* unitVectorAtAngle ld',ld'+pi)
damthings (ArcStep _ _ Nothing) = id damthings (ArcStep _ _ Nothing) = id
damthings (ArcStep p dir (Just crwl)) = damageCrWall (thedamage p dir) crwl 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 where
q = 5 *.* unitVectorAtAngle dir q = 5 *.* unitVectorAtAngle dir
src/Dodge/Placement/Instance/Sensor.hs
+1 -1
View File
@@ -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 :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor Lasering lightSensor = damageSensor LASERING
sensorUpdate :: DamageType -> Machine -> World -> World sensorUpdate :: DamageType -> Machine -> World -> World
sensorUpdate damF mc w = w & machines . ix mcid %~ upmc sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
src/Dodge/Placement/Instance/Terminal.hs
+8 -28
View File
@@ -11,13 +11,14 @@ import Dodge.LevelGen.Data
import Dodge.Default import Dodge.Default
import Dodge.Machine import Dodge.Machine
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Terminal
import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.Explosion
import Color import Color
import Geometry import Geometry
import ShapePicture import ShapePicture
import LensHelp import LensHelp
import Shape import Shape
import Sound.Data --import Sound.Data
import Data.Maybe import Data.Maybe
@@ -34,10 +35,9 @@ putTerminal' col mcf = ps0PushPS (PutButton termButton)
}) })
$ const Nothing $ const Nothing
putTerminal :: (GenParams -> World -> TerminalParams) -> Placement putTerminal :: (World -> TerminalParams) -> Placement
putTerminal f = ps0PushPSw PutNothing $ \w _ -> Just $ putTerminal f = ps0PushPSw PutNothing $ \_ _ -> Just $
--plGenUpdate ?~ g $ ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w)) ps0PushPS (PutButton $ termButton & btTerminalParams .~ f)
ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w))
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . terminalShape terminalColor { _mcDraw = noPic . terminalShape terminalColor
, _mcHP = 100 , _mcHP = 100
@@ -82,7 +82,7 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display
, _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w) , _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w)
} }
simpleTermMessage :: [String] -> (GenParams -> World -> TerminalParams) simpleTermMessage :: [String] -> World -> TerminalParams
simpleTermMessage = genTermMessage . const simpleTermMessage = genTermMessage . const
--simpleTermMessage ss = const $ TerminalParams --simpleTermMessage ss = const $ TerminalParams
-- {_termDisplayedLines = [] -- {_termDisplayedLines = []
@@ -105,25 +105,5 @@ topFlushStrings = topFlush . maximum . map length
topFlush :: Int -> [String] topFlush :: Int -> [String]
topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]] topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]
genTermMessage :: (GenParams -> [String]) -> (GenParams -> World -> TerminalParams) genTermMessage :: (World -> [String]) -> World -> TerminalParams
genTermMessage f = \gp _ -> TerminalParams genTermMessage f w = defaultTermParams & termFutureLines ++.~ map makeTermLine (f w)
{_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
src/Dodge/Placement/Instance/Turret.hs
+1 -1
View File
@@ -83,7 +83,7 @@ updateTurret rotSpeed mc w
& creatures . ix cid . crPos .~ mcpos & creatures . ix cid . crPos .~ mcpos
& creatures . ix cid . crDir .~ mcdir & creatures . ix cid . crDir .~ mcdir
dodamage = machines . ix mcid %~ 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) . (mcHP -~ dam)
) )
elecDamBranch elecDamBranch
src/Dodge/Placement/TopDecoration.hs
+4 -4
View File
@@ -9,10 +9,10 @@ import Color
decorationToShape :: DecorationShape decorationToShape :: DecorationShape
-> Float -> Float -> Float -> Color -> Color -> Shape -> Float -> Float -> Float -> Color -> Color -> Shape
decorationToShape dec = case dec of decorationToShape dec = case dec of
PlusDecoration -> plusDecoration PLUS -> plusDecoration
SquareDecoration -> squareDecoration SQUARE -> squareDecoration
CircleDecoration -> circleDecoration CIRCLE -> circleDecoration
ThreeLineDecoration -> threeLineDecoration THREELINES -> threeLineDecoration
midBarDecoration :: Float -> Float -> Float -> Color -> Color -> Shape midBarDecoration :: Float -> Float -> Float -> Color -> Color -> Shape
midBarDecoration w h z _ c = embossingR midBarDecoration w h z _ c = embossingR
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -101,7 +101,7 @@ addButtonSlowDoor x h rm = do
themessage = themessage =
["WARNING:" ["WARNING:"
,"LARGE BIOMASS DETECTED" ,"LARGE BIOMASS DETECTED"
] ++ replicate 5 "" ]
openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2) openDoorBound = rectNSEW (h + 5) (h - 5) (-x/2) (3*x/2)
belowH y = (sndV2 . fst) y < h - 40 belowH y = (sndV2 . fst) y < h - 40
aboveH y = (sndV2 . fst) y > h + 40 aboveH y = (sndV2 . fst) y > h + 40
src/Dodge/Room/SensorDoor.hs
+4 -15
View File
@@ -3,6 +3,7 @@ module Dodge.Room.SensorDoor where
import Dodge.LevelGen.Data import Dodge.LevelGen.Data
import Dodge.PlacementSpot import Dodge.PlacementSpot
import Dodge.Placement.Instance.Terminal import Dodge.Placement.Instance.Terminal
import Dodge.Terminal
import Dodge.Data import Dodge.Data
import Dodge.Tree import Dodge.Tree
--import Dodge.RoomLink --import Dodge.RoomLink
@@ -30,7 +31,6 @@ import Dodge.RandomHelp
import qualified Data.Set as S import qualified Data.Set as S
import Data.Maybe import Data.Maybe
import Data.Char
--import Data.Tree --import Data.Tree
import Control.Monad.State import Control.Monad.State
import System.Random import System.Random
@@ -83,20 +83,9 @@ sensInsideDoor senseType outplid rm = rm
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100)) thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100)) <> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80)) <> 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) & plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
] ]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] & 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
]
src/Dodge/Room/Warning.hs
+15 -11
View File
@@ -53,9 +53,21 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
where where
outplace = extTrigLitPos outplace = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(Just . set plSpot (rprShift fps) . putTerminal . termMessages) (Just . set plSpot (rprShift moveToSideFirstOutLink) . putTerminal . termMessages)
--termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)) termMessages trid _ = defaultTermParams & addInputLine
fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of [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 -> Just 0 ->
let rppos = _rpPos rp let rppos = _rpPos rp
rpdir = _rpDir rp rpdir = _rpDir rp
@@ -68,11 +80,3 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
then Just (rtpos, rpdir) then Just (rtpos, rpdir)
else Just (ltpos, rpdir) else Just (ltpos, rpdir)
_ -> Nothing _ -> Nothing
termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"])
ops trid f gw w = f gw w & termFutureLines ++.~ [ TerminalLineInput 0
[unlockCommand trid,quitCommand]
[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."
src/Dodge/Terminal.hs
+49
View File
@@ -1,11 +1,17 @@
module Dodge.Terminal where module Dodge.Terminal where
import Dodge.Data import Dodge.Data
import Dodge.Base
import Dodge.SoundLogic
import Color import Color
import Justify import Justify
import LensHelp import LensHelp
import Sound.Data
import Data.Char
import Data.Maybe import Data.Maybe
import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import Text.Read
import Data.List (find) import Data.List (find)
quitCommand :: TerminalCommand quitCommand :: TerminalCommand
@@ -22,6 +28,21 @@ disconnectTerminal = hud . hudElement . subInventory . termParams %~
( (termInput .~ Nothing) ( (termInput .~ Nothing)
. (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] ) . (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
helpCommand = TerminalCommand helpCommand = TerminalCommand
{ _tcString = "HELP" { _tcString = "HELP"
@@ -70,6 +91,12 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
makeTermLine :: String -> TerminalLine makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine white 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 :: String -> TerminalCommand
infoCommand str = 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"
]
src/Dodge/Wall/Damage.hs
+12 -12
View File
@@ -17,18 +17,18 @@ damageWall dt wl = case _wlStructure wl of
damageBlockWith :: Damage -> Block -> Block damageBlockWith :: Damage -> Block -> Block
damageBlockWith dm = case _dmType dm of damageBlockWith dm = case _dmType dm of
Piercing -> blHPs %~ reduceHead dam PIERCING -> blHPs %~ reduceHead dam
Blunt -> blHPs %~ reduceHead dam BLUNT -> blHPs %~ reduceHead dam
Cutting -> blHPs %~ reduceHead dam CUTTING -> blHPs %~ reduceHead dam
Explosive -> blHPs %~ reduceHead dam EXPLOSIVE -> blHPs %~ reduceHead dam
Concussive -> blHPs %~ reduceHead dam CONCUSSIVE -> blHPs %~ reduceHead dam
Lasering {} -> id LASERING -> id
SparkDam {} -> id SPARKING -> id
Flaming {} -> id FLAMING -> id
Electrical {} -> id ELECTRICAL -> id
TorqueDam {} -> id TORQUEDAM -> id
PushDam {} -> id PUSHDAM -> id
PoisonDam {} -> id POISONDAM -> id
where where
dam = _dmAmount dm dam = _dmAmount dm
src/Dodge/Wall/DamageEffect.hs
+12 -13
View File
@@ -11,19 +11,18 @@ import Control.Monad.State
defaultWallDamage :: Damage -> Wall -> World -> World defaultWallDamage :: Damage -> Wall -> World -> World
defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of defaultWallDamage dm wl = wallDamageEffect dm wl . case _dmType dm of
Lasering -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl) LASERING -> colSparkRandDir 0.2 8 lSparkCol outTo (reflDirWall sp p wl)
Piercing -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) PIERCING -> colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo
. wlDustAt wl outTo BLUNT -> wlDustAt wl outTo
Blunt -> wlDustAt wl outTo EXPLOSIVE -> id
Explosive-> id CUTTING -> id
Cutting -> id SPARKING -> id
SparkDam -> id FLAMING -> id
Flaming -> id ELECTRICAL -> id
Electrical -> id CONCUSSIVE -> id
Concussive -> id TORQUEDAM -> id
TorqueDam -> id PUSHDAM -> id
PushDam -> id POISONDAM -> id
PoisonDam -> id
where where
sp = _dmFrom dm sp = _dmFrom dm
p = _dmAt dm p = _dmAt dm
src/Dodge/WorldEvent/Shockwave.hs
+3 -3
View File
@@ -62,13 +62,13 @@ mvShockwave is w pt
tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt) tFraction = fromIntegral t / fromIntegral (_ptMaxTime pt)
rad = r - (3/4) * r * tFraction rad = r - (3/4) * r * tFraction
doDams = over creatures (IM.map damCr) 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
hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w
damCr cr damCr cr
| _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage .:~ | otherwise = cr & crState . crDamage .:~
Damage PushDam dam cpos cpos cpos Damage PUSHDAM dam cpos cpos cpos
(PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p))) (PushBackDamage (25 * push *.* squashNormalizeV (_crPos cr -.- p)))
where where
cpos = _crPos cr cpos = _crPos cr
@@ -108,7 +108,7 @@ moveInverseShockwave w pt
damCr cr damCr cr
| dist (_crPos cr) p >= rad + _crRad cr = cr | dist (_crPos cr) p >= rad + _crRad cr = cr
| otherwise = cr & crState . crDamage .:~ | 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 where
cpos = _crPos cr cpos = _crPos cr
src/Dodge/WorldEvent/SpawnParticle.hs
+5 -5
View File
@@ -42,7 +42,7 @@ aFlameParticle t pos vel maycid = PtZ
, _ptCrIgnore = maycid , _ptCrIgnore = maycid
, _ptWidth = 4 , _ptWidth = 4
, _ptTimer = t , _ptTimer = t
, _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = 20 , _ptZ = 20
} }
drawFlame drawFlame
@@ -126,7 +126,7 @@ incBall p = do
, _ptCrIgnore = Nothing , _ptCrIgnore = Nothing
, _ptWidth = 3 , _ptWidth = 3
, _ptTimer = 20 , _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = 20 , _ptZ = 20
} }
@@ -154,7 +154,7 @@ aStaticBall p = return PtZ
, _ptCrIgnore = Nothing , _ptCrIgnore = Nothing
, _ptWidth = 3 , _ptWidth = 3
, _ptTimer = 20 , _ptTimer = 20
, _ptHitEff = expireAndDamage $ simpleDam Electrical 20 , _ptHitEff = expireAndDamage $ simpleDam ELECTRICAL 20
, _ptZ = 20 , _ptZ = 20
} }
@@ -178,7 +178,7 @@ makeFlamelet (V2 x y) z vel maycid size time w = w
, _ptCrIgnore = maycid , _ptCrIgnore = maycid
, _ptWidth = size , _ptWidth = size
, _ptTimer = time , _ptTimer = time
, _ptHitEff = expireAndDamage $ simpleDam Flaming 20 , _ptHitEff = expireAndDamage $ simpleDam FLAMING 20
, _ptZ = z , _ptZ = z
} }
where where
@@ -307,5 +307,5 @@ cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedC
where where
damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w
f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 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 clpos = stripZ $ _clPos c