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
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 #-}
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
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
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'
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
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
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
src/Dodge/Data.hs
+5 -5
View File
@@ -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
src/Dodge/Data/DamageType.hs
+13 -13
View File
@@ -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)
src/Dodge/Floor.hs
+2 -1
View File
@@ -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]
src/Dodge/Item/Weapon/BatteryGuns.hs
+1 -1
View File
@@ -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
src/Dodge/LevelGen/LevelStructure.hs
+9 -9
View File
@@ -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
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 =
[(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])
src/Dodge/Particle/Damage.hs
+16 -20
View File
@@ -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
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)
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
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 = damageSensor Lasering
lightSensor = damageSensor LASERING
sensorUpdate :: DamageType -> Machine -> World -> World
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.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)
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 . 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
src/Dodge/Placement/TopDecoration.hs
+4 -4
View File
@@ -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
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -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
src/Dodge/Room/SensorDoor.hs
+4 -15
View File
@@ -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
]
src/Dodge/Room/Warning.hs
+22 -18
View File
@@ -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
src/Dodge/Terminal.hs
+49
View File
@@ -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"
]
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 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
src/Dodge/Wall/DamageEffect.hs
+12 -13
View File
@@ -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
src/Dodge/WorldEvent/Shockwave.hs
+3 -3
View File
@@ -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
src/Dodge/WorldEvent/SpawnParticle.hs
+5 -5
View File
@@ -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