diff --git a/data/sound/blood1.SPLRT.100.wav b/data/sound/blood1.SPLRT.100.wav new file mode 100644 index 000000000..6d6ad3be9 Binary files /dev/null and b/data/sound/blood1.SPLRT.100.wav differ diff --git a/data/sound/blood2.SPRT.100.wav b/data/sound/blood2.SPRT.100.wav new file mode 100644 index 000000000..d6444e5ef Binary files /dev/null and b/data/sound/blood2.SPRT.100.wav differ diff --git a/data/sound/blood3.KKSQWL.100.wav b/data/sound/blood3.KKSQWL.100.wav new file mode 100644 index 000000000..661c78733 Binary files /dev/null and b/data/sound/blood3.KKSQWL.100.wav differ diff --git a/data/sound/blood4.SKWLL.100.wav b/data/sound/blood4.SKWLL.100.wav new file mode 100644 index 000000000..db846cce6 Binary files /dev/null and b/data/sound/blood4.SKWLL.100.wav differ diff --git a/data/sound/blood5.CLCLH.100.wav b/data/sound/blood5.CLCLH.100.wav new file mode 100644 index 000000000..89289bf44 Binary files /dev/null and b/data/sound/blood5.CLCLH.100.wav differ diff --git a/data/sound/blood6.SKLE.100.wav b/data/sound/blood6.SKLE.100.wav new file mode 100644 index 000000000..93f0311b3 Binary files /dev/null and b/data/sound/blood6.SKLE.100.wav differ diff --git a/data/sound/blood7.SQLEE.100.wav b/data/sound/blood7.SQLEE.100.wav new file mode 100644 index 000000000..d299b7c3a Binary files /dev/null and b/data/sound/blood7.SQLEE.100.wav differ diff --git a/data/sound/blood8.SKWLCH.100.wav b/data/sound/blood8.SKWLCH.100.wav new file mode 100644 index 000000000..9d39fc20a Binary files /dev/null and b/data/sound/blood8.SKWLCH.100.wav differ diff --git a/data/sound/gut1.QWLPH.200.wav b/data/sound/gut1.QWLPH.200.wav new file mode 100644 index 000000000..b7a5de5ea Binary files /dev/null and b/data/sound/gut1.QWLPH.200.wav differ diff --git a/data/sound/gut2.CRNCH.200.wav b/data/sound/gut2.CRNCH.200.wav new file mode 100644 index 000000000..bd9f22da7 Binary files /dev/null and b/data/sound/gut2.CRNCH.200.wav differ diff --git a/data/sound/gut3.SQWCH.200.wav b/data/sound/gut3.SQWCH.200.wav new file mode 100644 index 000000000..7d92f2024 Binary files /dev/null and b/data/sound/gut3.SQWCH.200.wav differ diff --git a/data/sound/gut4.SKREL.200.wav b/data/sound/gut4.SKREL.200.wav new file mode 100644 index 000000000..9f041bc01 Binary files /dev/null and b/data/sound/gut4.SKREL.200.wav differ diff --git a/data/sound/gut5.SQWLTCH.200.wav b/data/sound/gut5.SQWLTCH.200.wav new file mode 100644 index 000000000..386c9e621 Binary files /dev/null and b/data/sound/gut5.SQWLTCH.200.wav differ diff --git a/data/sound/gut6.CRSKRL.200.wav b/data/sound/gut6.CRSKRL.200.wav new file mode 100644 index 000000000..320549758 Binary files /dev/null and b/data/sound/gut6.CRSKRL.200.wav differ diff --git a/src/Dodge/Block.hs b/src/Dodge/Block.hs index 619fda84c..8249f8e32 100644 --- a/src/Dodge/Block.hs +++ b/src/Dodge/Block.hs @@ -1,7 +1,7 @@ module Dodge.Block where import Dodge.Data import Dodge.Base.Collide -import Dodge.Material +import Dodge.Material.Sound import Dodge.Block.Debris import Dodge.Zone import Dodge.LightSource diff --git a/src/Dodge/Block/Debris.hs b/src/Dodge/Block/Debris.hs index ad57dd2b7..8baef8aca 100644 --- a/src/Dodge/Block/Debris.hs +++ b/src/Dodge/Block/Debris.hs @@ -1,5 +1,5 @@ module Dodge.Block.Debris where -import Dodge.Material +import Dodge.Material.Sound import Dodge.Prop.Moving import Dodge.WorldEvent.Sound --import Dodge.Zone @@ -106,6 +106,8 @@ debrisSize mt = case mt of Dirt -> 20 Wood -> 10 Metal -> 10 + Electronics -> 10 + Flesh -> 10 baseDebris :: Material -> State StdGen Prop baseDebris mt = case mt of @@ -118,6 +120,8 @@ baseDebris mt = case mt of sh <- jaggedShape return $ metalDebris & prDraw .~ (`drawMovingShapeCol` sh) + Electronics -> baseDebris Metal + Flesh -> baseDebris Dirt <&> pjColor .~ red stoneDebris :: Prop stoneDebris = PropZ diff --git a/src/Dodge/Creature/Damage.hs b/src/Dodge/Creature/Damage.hs index e9ced9026..3b27e6d68 100644 --- a/src/Dodge/Creature/Damage.hs +++ b/src/Dodge/Creature/Damage.hs @@ -14,6 +14,12 @@ import Data.List applyNoDamage :: [Damage] -> Creature -> World -> World applyNoDamage _ _ = id +applyCreatureDamage :: [Damage] -> Creature -> World -> World +applyCreatureDamage dms cr = case _crMaterial cr of + Flesh -> defaultApplyDamage dms cr + Crystal -> id + _-> defaultApplyDamage dms cr + defaultApplyDamage :: [Damage] -> Creature -> World -> World defaultApplyDamage ds cr w = foldl' (applyIndividualDamage cr) w ds' & creatures . ix (_crID cr) %~ doPoisonDam diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 09c778839..87cf62cdb 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -54,8 +54,8 @@ explosiveBarrel = defaultInanimate {_csSpState = Barrel [] } , _crInv = IM.empty -- IM.fromList [(0,frontArmour)] - ,_crApplyDamage = \_ _ -> id } + & crMaterial .~ Crystal updateBarrel :: Creature -> World -> World updateBarrel cr | _crHP cr > 0 = doDamage cr diff --git a/src/Dodge/Creature/Lamp.hs b/src/Dodge/Creature/Lamp.hs index d02dd0e1f..26dc48819 100644 --- a/src/Dodge/Creature/Lamp.hs +++ b/src/Dodge/Creature/Lamp.hs @@ -3,7 +3,7 @@ module Dodge.Creature.Lamp , colorLamp ) where import Dodge.Data -import Dodge.Material +import Dodge.Material.Sound import Dodge.Default import Dodge.Creature.Picture import Dodge.LightSource diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index f167b18c3..8e8459f8e 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -10,6 +10,7 @@ import Dodge.Prop.Gib import Dodge.Base import Dodge.Creature.State.WalkCycle import Dodge.Creature.Impulse.Movement +import Dodge.Creature.Damage import Dodge.LightSource.Torch import Dodge.SoundLogic import RandomHelp @@ -134,7 +135,7 @@ clearDamage cr w = w doDamage :: Creature -> World -> World doDamage cr w = w & applyPastDamages cr - & _crApplyDamage cr dams cr + & applyCreatureDamage dams cr where dams = _csDamage $ _crState cr diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 525ff19b0..a8b1a92e6 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -19,7 +19,7 @@ import qualified Data.Map.Strict as M {- | The AI equivalent for your control. -} yourControl :: Creature -> World -> World yourControl cr w - | inTermFocus w = w + | inTermFocus w = w & updateUsingInput | otherwise = w & creatures . ix (_crID cr) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons w)) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 76aeb57b3..8b56f32bf 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -10,7 +10,11 @@ circular imports are probably not a good idea. {-# LANGUAGE DerivingStrategies #-} module Dodge.Data ( module Dodge.Data + , module Dodge.Data.RightButtonOptions , module Dodge.Data.Material + , module Dodge.Data.LightSource + , module Dodge.Data.Creature + , module Dodge.Data.Block , module Dodge.Data.Flare , module Dodge.Data.LoadAction , module Dodge.Data.ForegroundShape @@ -18,6 +22,7 @@ module Dodge.Data , module Dodge.Data.Object , module Dodge.Data.Zoning , module Dodge.Data.Bounds + , module Dodge.Data.Sensor , module Dodge.Combine.Data , module Dodge.Distortion.Data , module Dodge.Data.DamageType @@ -38,7 +43,12 @@ module Dodge.Data , module Dodge.Data.PathGraph ) where import Dodge.Data.RadarBlip +import Dodge.Data.RightButtonOptions +import Dodge.Data.LightSource +import Dodge.Data.Creature import Dodge.Data.Room +import Dodge.Data.Block +import Dodge.Data.Sensor import Dodge.Data.Flare import Dodge.Data.PathGraph import Dodge.Data.Object @@ -202,41 +212,6 @@ data HUDElement = DisplayInventory {_subInventory :: SubInventory} | DisplayCarte -- deriving (Eq,Ord,Show) -data RightButtonOptions - = NoRightButtonOptions - | EquipOptions - {_opEquip :: [EquipPosition] - ,_opSel :: Int - ,_opCurInvPos :: Int - ,_opAllocateEquipment :: AllocateEquipment - ,_opActivateEquipment :: ActivateEquipment - } -data ActivateEquipment - = ActivateEquipment {_activateEquipment :: Int } - | DeactivateEquipment {_deactivateEquipment :: Int} - | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} - | NoChangeActivateEquipment -data AllocateEquipment - = DoNotMoveEquipment - | PutOnEquipment - { _allocNewPos :: EquipPosition - } - | MoveEquipment - { _allocNewPos :: EquipPosition - , _allocOldPos :: EquipPosition - } - | SwapEquipment - { _allocNewPos :: EquipPosition - , _allocOldPos :: EquipPosition - , _allocSwapID :: Int - } - | ReplaceEquipment - { _allocNewPos :: EquipPosition - , _allocRemoveID :: Int - } - | RemoveEquipment - { _allocOldPos :: EquipPosition - } data SubInventory = NoSubInventory @@ -342,17 +317,6 @@ data Cloud = Cloud data CloudType = SmokeCloud | GasCloud -data LSParam = LSParam - { _lsPos :: !Point3 - , _lsRad :: !Float - , _lsCol :: !Point3 - } -data LightSource = LS - { _lsID :: !Int - , _lsParam :: LSParam - , _lsDir :: !Float - , _lsPict :: LightSource -> Picture - } data TempLightSource = TLS { _tlsParam :: LSParam , _tlsUpdate :: World -> TempLightSource -> Maybe TempLightSource @@ -389,7 +353,8 @@ data Creature = Creature , _crLeftInvSel :: Maybe Int , _crState :: CreatureState , _crCorpse :: Creature -> Corpse -> SPic - , _crApplyDamage :: [Damage] -> Creature -> World -> World + , _crMaterial :: Material +-- , _crApplyDamage :: [Damage] -> Creature -> World -> World , _crPastDamage :: Int , _crStance :: Stance , _crActionPlan :: ActionPlan @@ -406,37 +371,11 @@ data Creature = Creature , _crStatistics :: CreatureStatistics , _crCamouflage :: CamouflageStatus } -data CamouflageStatus - = FullyVisible - | Invisible - deriving (Eq,Ord,Enum) -data CreatureStatistics = CreatureStatistics - { _strength :: Int - , _dexterity :: Int - , _intelligence :: Int - } -data Vocalization - = Mute - | Vocalization - {_vcSound :: SoundID - ,_vcWarnings :: [SoundID] - ,_vcMaxCoolDown :: Int - ,_vcCoolDown :: Int - } data Intention = Intention { _targetCr :: Maybe Creature , _mvToPoint :: Maybe Point2 , _viewPoint :: Maybe Point2 } -data CrMvType - = NoMvType - | MvWalking { _mvSpeed :: Float } - | CrMvType - { _mvSpeed :: Float - , _mvTurnRad :: Float -> Float - , _mvTurnJit :: Float - , _mvAimSpeed :: Float -> Float - } data Button = Button { _btPict :: Button -> SPic , _btPos :: Point2 @@ -511,10 +450,6 @@ data Equipment = Equipment _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse -data HeldAttachment - = Torch - | NoHeldAttachment - data ItemConsumption = LoadableAmmo { _laAmmoType :: AmmoType @@ -978,19 +913,6 @@ data Prop , _pjTimer :: Int } data Either3 a b c = E3x1 a | E3x2 b | E3x3 c -data Block = Block - { _blID :: Int - , _blWallIDs :: IS.IntSet - , _blHP :: Int - , _blShadows :: [Int] -- a list of blocks/walls? that are not shown when this block exists - , _blFootprint :: [Point2] - , _blPos :: Point2 - , _blDir :: Float - , _blHeight :: Float - , _blMaterial :: Material - , _blDraw :: Block -> SPic - , _blObstructs :: [(Int,Int,PathEdge)] - } data TerminalStatus = TerminalOff | TerminalBusy | TerminalReady deriving (Eq,Ord,Show) data TerminalInput = TerminalInput @@ -1000,7 +922,7 @@ data TerminalInput = TerminalInput } data Terminal = Terminal { _tmID :: Int - , _tmProgram :: Terminal -> World -> [TerminalLine] + , _tmBootProgram :: Terminal -> World -> [TerminalLine] , _tmButtonID :: Int , _tmMachineID :: Int , _tmName :: String @@ -1020,49 +942,22 @@ data TerminalToggle = TerminalToggle { _ttTriggerID :: Int , _ttDeathEffect :: (World -> Bool) -> (World -> Bool) } ---data DamageApplication --- = ApplyNoDamage --- | DefaultApplyDamage - data Machine = Machine { _mcID :: Int , _mcWallIDs :: IS.IntSet --- , _mcUpdate :: Machine -> World -> World , _mcDraw :: Machine -> SPic --- , _mcDamageApplication :: DamageApplication + , _mcMaterial :: Material , _mcPos :: Point2 , _mcDir :: Float , _mcColor :: Color , _mcHP :: Int , _mcSensor :: Sensor , _mcDamage :: [Damage] - , _mcLSs :: [Int] , _mcType :: MachineType , _mcMounts :: M.Map Object Int , _mcName :: String --- , _mcTriggerCond :: Machine -> Bool , _mcCloseSound :: Maybe SoundID --- , _mcTermMID :: Maybe Int } -data Sensor = NoSensor - | SensorToggleAmount - { _sensToggle :: Bool - , _sensAmount :: Int - } - | ProximitySensor - { _proxStatus :: CloseToggle - , _proxDist :: Float - , _proxRequirement :: ProximityRequirement - , _sensToggle :: Bool - } - deriving (Eq,Ord) -data ProximityRequirement - = RequireHealth {_proxReqMinHealth :: Int} - | RequireEquipment {_proxReqEquipment :: ItemBaseType} - | RequireImpossible - deriving (Eq,Ord,Show) -data CloseToggle = NotClose | IsClose - deriving (Eq,Ord,Show) data MachineType = StaticMachine | Turret @@ -1547,7 +1442,6 @@ makeLenses ''DamageEffect makeLenses ''World makeLenses ''Cloud makeLenses ''Creature -makeLenses ''LightSource makeLenses ''TempLightSource makeLenses ''Item makeLenses ''ItemUse @@ -1566,17 +1460,13 @@ makeLenses ''ActionPlan makeLenses ''Impulse makeLenses ''Action makeLenses ''CrGroupParams -makeLenses ''CrMvType makeLenses ''Intention makeLenses ''Door -makeLenses ''Block makeLenses ''Terminal makeLenses ''Machine makeLenses ''MachineType makeLenses ''ItemDimension -makeLenses ''Vocalization makeLenses ''Universe -makeLenses ''LSParam makeLenses ''ItemParams makeLenses ''ItemTweaks makeLenses ''ItemPortage @@ -1592,16 +1482,10 @@ makeLenses ''TerminalLine makeLenses ''ItemValue makeLenses ''Equipment makeLenses ''ScreenLayer -makeLenses ''Sensor -makeLenses ''ProximityRequirement makeLenses ''Beam makeLenses ''BeamType makeLenses ''WorldBeams makeLenses ''ArcStep -makeLenses ''CreatureStatistics -makeLenses ''RightButtonOptions -makeLenses ''AllocateEquipment -makeLenses ''ActivateEquipment makeLenses ''EquipParams makeLenses ''TerminalCommand makeLenses ''TerminalInput diff --git a/src/Dodge/Data/Block.hs b/src/Dodge/Data/Block.hs new file mode 100644 index 000000000..124d666ac --- /dev/null +++ b/src/Dodge/Data/Block.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Block where +import Dodge.Data.Material +import Dodge.Data.PathGraph +import ShapePicture +import Geometry +import Control.Lens +import qualified Data.IntSet as IS +data Block = Block + { _blID :: Int + , _blWallIDs :: IS.IntSet + , _blHP :: Int + , _blShadows :: [Int] -- a list of blocks/walls? that are not shown when this block exists + , _blFootprint :: [Point2] + , _blPos :: Point2 + , _blDir :: Float + , _blHeight :: Float + , _blMaterial :: Material + , _blDraw :: Block -> SPic + , _blObstructs :: [(Int,Int,PathEdge)] + } +makeLenses ''Block diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs new file mode 100644 index 000000000..8e8e33b32 --- /dev/null +++ b/src/Dodge/Data/Creature.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Creature where +import Sound.Data +import Control.Lens +data CamouflageStatus + = FullyVisible + | Invisible + deriving (Eq,Ord,Enum) +data CreatureStatistics = CreatureStatistics + { _strength :: Int + , _dexterity :: Int + , _intelligence :: Int + } + deriving (Eq,Ord,Show) +data Vocalization + = Mute + | Vocalization + {_vcSound :: SoundID + ,_vcWarnings :: [SoundID] + ,_vcMaxCoolDown :: Int + ,_vcCoolDown :: Int + } + deriving (Eq,Ord,Show) +data CrMvType + = NoMvType + | MvWalking { _mvSpeed :: Float } + | CrMvType + { _mvSpeed :: Float + , _mvTurnRad :: Float -> Float + , _mvTurnJit :: Float + , _mvAimSpeed :: Float -> Float + } +makeLenses ''CreatureStatistics +makeLenses ''Vocalization +makeLenses ''CrMvType diff --git a/src/Dodge/Data/LightSource.hs b/src/Dodge/Data/LightSource.hs new file mode 100644 index 000000000..895eab6c0 --- /dev/null +++ b/src/Dodge/Data/LightSource.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.LightSource where +import Geometry +import Picture.Data +import Control.Lens + +data LSParam = LSParam + { _lsPos :: !Point3 + , _lsRad :: !Float + , _lsCol :: !Point3 + } +data LightSource = LS + { _lsID :: !Int + , _lsParam :: LSParam + , _lsDir :: !Float + , _lsPict :: LightSource -> Picture + } +makeLenses ''LSParam +makeLenses ''LightSource diff --git a/src/Dodge/Data/Material.hs b/src/Dodge/Data/Material.hs index 46d5d83c8..111fa89c8 100644 --- a/src/Dodge/Data/Material.hs +++ b/src/Dodge/Data/Material.hs @@ -3,5 +3,5 @@ {-# LANGUAGE FlexibleInstances #-} --{-# LANGUAGE DeriveGeneric #-} module Dodge.Data.Material where -data Material = Wood | Dirt | Stone | Glass | Metal | Crystal +data Material = Wood | Dirt | Stone | Glass | Metal | Crystal | Flesh | Electronics deriving (Eq,Ord,Show,Bounded,Enum) diff --git a/src/Dodge/Data/RightButtonOptions.hs b/src/Dodge/Data/RightButtonOptions.hs new file mode 100644 index 000000000..c14dcd368 --- /dev/null +++ b/src/Dodge/Data/RightButtonOptions.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.RightButtonOptions where +import Dodge.Equipment.Data +import Control.Lens + +data RightButtonOptions + = NoRightButtonOptions + | EquipOptions + {_opEquip :: [EquipPosition] + ,_opSel :: Int + ,_opCurInvPos :: Int + ,_opAllocateEquipment :: AllocateEquipment + ,_opActivateEquipment :: ActivateEquipment + } +data ActivateEquipment + = ActivateEquipment {_activateEquipment :: Int } + | DeactivateEquipment {_deactivateEquipment :: Int} + | ActivateDeactivateEquipment {_activateEquipment :: Int ,_deactivateEquipment :: Int} + | NoChangeActivateEquipment +data AllocateEquipment + = DoNotMoveEquipment + | PutOnEquipment + { _allocNewPos :: EquipPosition + } + | MoveEquipment + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition + } + | SwapEquipment + { _allocNewPos :: EquipPosition + , _allocOldPos :: EquipPosition + , _allocSwapID :: Int + } + | ReplaceEquipment + { _allocNewPos :: EquipPosition + , _allocRemoveID :: Int + } + | RemoveEquipment + { _allocOldPos :: EquipPosition + } +makeLenses ''RightButtonOptions +makeLenses ''AllocateEquipment +makeLenses ''ActivateEquipment diff --git a/src/Dodge/Data/Sensor.hs b/src/Dodge/Data/Sensor.hs new file mode 100644 index 000000000..f7d95643b --- /dev/null +++ b/src/Dodge/Data/Sensor.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Data.Sensor where +import Dodge.Combine.Data +import Dodge.Data.DamageType +import Control.Lens + +data Sensor = NoSensor + | DamageSensor + { _sensToggle :: Bool + , _sensAmount :: Int + , _sensType :: DamageType + } + | ProximitySensor + { _proxStatus :: CloseToggle + , _proxDist :: Float + , _proxRequirement :: ProximityRequirement + , _sensToggle :: Bool + } + deriving (Eq,Ord) +data ProximityRequirement + = RequireHealth {_proxReqMinHealth :: Int} + | RequireEquipment {_proxReqEquipment :: ItemBaseType} + | RequireImpossible + deriving (Eq,Ord,Show) +data CloseToggle = NotClose | IsClose + deriving (Eq,Ord,Show) +makeLenses ''Sensor +makeLenses ''ProximityRequirement diff --git a/src/Dodge/Data/Wall.hs b/src/Dodge/Data/Wall.hs index 66b723f75..d89f7256c 100644 --- a/src/Dodge/Data/Wall.hs +++ b/src/Dodge/Data/Wall.hs @@ -19,7 +19,7 @@ data Wall = Wall , _wlTouchThrough :: Bool , _wlFireThrough :: Bool , _wlReflect :: Bool - , _wlUnshadowed :: Bool + , _wlUnshadowed :: Bool , _wlRotateTo :: Bool , _wlStructure :: WallStructure , _wlHeight :: Float diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index e90122fec..af520dfa4 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -4,9 +4,6 @@ module Dodge.Debug.Terminal import MaybeHelp import Dodge.Inventory.Add import Dodge.Creature -import Dodge.Creature.Damage ---import Dodge.Creature.State ---import Dodge.Creature.YourControl import Dodge.Data import Dodge.Menu.PushPop import Dodge.Item @@ -40,8 +37,8 @@ applyTerminalCommand s = case s of "LT" -> applyTerminalCommand "LOADTEST" ['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x)) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) - "GODON" -> uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage - "GODOFF" -> uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage + "GODON" -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal + "GODOFF" -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh "LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory) . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50) _ -> id diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 301eb118a..96518fd58 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -55,8 +55,8 @@ defaultMachine = Machine , _mcDir = 0 , _mcHP = 1000 , _mcSensor = NoSensor + , _mcMaterial = Electronics , _mcDamage = [] - , _mcLSs = [] , _mcType = StaticMachine , _mcName = "" , _mcMounts = mempty @@ -75,7 +75,7 @@ defaultDrawButton col bt = defaultTerminal :: Terminal defaultTerminal = Terminal { _tmID = 0 - , _tmProgram = \_ _ -> [] + , _tmBootProgram = \_ _ -> [] , _tmButtonID = 0 , _tmMachineID = 0 , _tmName = "TESTTERMINAL" diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index cc8504f44..1637dab42 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -1,7 +1,6 @@ module Dodge.Default.Creature where import Dodge.Data import Dodge.Creature.Picture -import Dodge.Creature.Damage import Geometry.Data import Picture @@ -19,7 +18,6 @@ defaultCreature = Creature , _crMvDir = 0 , _crTwist = 0 , _crID = 1 --- , _crPict = basicCrPict , _crType = defaultCreatureSkin , _crUpdate = const id , _crRad = 10 @@ -34,7 +32,7 @@ defaultCreature = Creature , _crLeftInvSel = Nothing , _crState = defaultState , _crCorpse = basicCrCorpse - , _crApplyDamage = defaultApplyDamage + , _crMaterial = Flesh , _crPastDamage = 0 , _crEquipment = M.empty , _crStance = Stance diff --git a/src/Dodge/Item/Craftable.hs b/src/Dodge/Item/Craftable.hs index 2a6f1f090..09e1c6b96 100644 --- a/src/Dodge/Item/Craftable.hs +++ b/src/Dodge/Item/Craftable.hs @@ -11,10 +11,9 @@ import Control.Lens makeTypeCraftNum :: Int -> CraftType -> Item makeTypeCraftNum i ct = defaultCraftable - { _itInvSize = 0.5 - , _itCurseStatus = Uncursed - , _itConsumption = ItemItselfConsumable $ IcAmount i - } + & itInvSize .~ 0.5 + & itCurseStatus .~ Uncursed + & itConsumption .~ ItemItselfConsumable (IcAmount i) & itType . iyBase .~ CRAFT ct makeTypeCraft :: CraftType -> Item diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index 364138b87..d0e9f91a1 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -11,7 +11,8 @@ import Geometry import Data.Maybe itemSPic :: Item -> SPic -itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. itType . iyBase of +itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) <> case it ^. itType . iyBase of + CRAFT _ -> defSPic HELD ht -> heldItemSPic ht it LEFT lt -> leftItemSPic lt it EQUIP et -> equipItemSPic et it @@ -24,7 +25,6 @@ itemSPic it = foldMap (modulesSPic it) (_iyModules $ _itType it) $ case it ^. it KEYCARD _ -> noShape (setDepth 0 $ translate (-5) (-5) $ rotate (pi/2.5) keyPic) -- MEDKIT _ -> defSPic - CRAFT _ -> flatShieldEquipSPic equipItemSPic :: EquipItemType -> Item -> SPic equipItemSPic et _ = case et of @@ -116,10 +116,10 @@ torchShape = colorSH blue back = upperPrismPoly 3 $ rectXH 1 2 -modulesSPic :: Item -> ItemModuleType -> SPic -> SPic +modulesSPic :: Item -> ItemModuleType -> SPic modulesSPic it imt = case imt of - ATTACHTORCH -> (<> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape)) - _ -> id + ATTACHTORCH -> noPic (overPosSH (+.+.+ _dimAttachPos (_itDimension it)) torchShape) + _ -> mempty baseStickShapeX :: Item -> Int -> Shape baseStickShapeX it i = foldMap f [0..i-1] diff --git a/src/Dodge/LightSource.hs b/src/Dodge/LightSource.hs index 8a8e147f9..94049ac2e 100644 --- a/src/Dodge/LightSource.hs +++ b/src/Dodge/LightSource.hs @@ -19,7 +19,7 @@ import Geometry.Vector3D import Dodge.Default.LightSource import LensHelp import Dodge.WorldEvent.Sound -import Dodge.Material +import Dodge.Material.Sound lsPosRad :: Point3 -> Float -> LightSource lsPosRad = lsColPosRad 0.75 diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index ae6ecafc2..c728ce86b 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -11,13 +11,11 @@ import Dodge.Item.Weapon.BatteryGuns import Dodge.Default import Dodge.Creature.State import Dodge.Creature.Impulse -import Dodge.Creature.Damage import Dodge.Movement.Turn import Geometry import LensHelp import qualified IntMapHelp as IM -import Data.Either import Data.List (partition) import Data.Maybe @@ -68,7 +66,7 @@ updateTurret rotSpeed mc w & crDir .~ mcdir & crUpdate .~ stateUpdate followThenClearImpulses & crStance . posture .~ Aiming - & crApplyDamage .~ applyNoDamage + & crMaterial .~ Crystal Just cid -> w' & creatures . ix cid . crPos .~ mcpos & creatures . ix cid . crDir .~ mcdir @@ -111,7 +109,7 @@ mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal mc = case mc ^. mcSensor of NoSensor -> Nothing s@ProximitySensor{} -> s ^? sensToggle - s@SensorToggleAmount{} -> Just $ _sensAmount s > 900 + s@DamageSensor{} -> Just $ _sensAmount s > 900 mcPlaySound :: Machine -> World -> World mcPlaySound mc w = case _mcCloseSound mc of @@ -131,12 +129,12 @@ mcApplyDamage ds mc = case _mcSensor mc of mcSensorUpdate :: Machine -> World -> World mcSensorUpdate mc w = case _mcSensor mc of NoSensor -> w - SensorToggleAmount{} -> foldr (flip sensorUpdate mc . _dmType) w (_mcDamage mc) + s@DamageSensor{} -> senseDamage (_sensType s) mc w ProximitySensor{} -> mcProximitySensorUpdate mc w mcProximitySensorUpdate :: Machine -> World -> World mcProximitySensorUpdate mc w = case - (_proxStatus sens + ( _proxStatus sens , _sensToggle sens , mcProxTest mc w , dist (_crPos ycr) (_mcPos mc) < _proxDist sens) of @@ -162,21 +160,17 @@ mcProxTest mc w = case mc ^? mcSensor . proxRequirement of where cr = you w - -sensorUpdate :: DamageType -> Machine -> World -> World -sensorUpdate damF mc w = w & machines . ix mcid %~ upmc - & lightSources . ix lsid %~ upls +senseDamage :: DamageType -> Machine -> World -> World +senseDamage dt mc = (machines . ix mcid %~ upmc) + . updatels where - upmc = ( mcSensor . sensAmount %~ \x' -> min 1000 (max 0 (x' - 5 + newSense)) ) - . ( mcHP -~ sum dam ) - . (mcDamage .~ []) - x = _sensAmount $ _mcSensor mc + upmc = mcSensor . sensAmount %~ min 1000 . max 0 . (+ (newsense - 5)) mcid = _mcID mc - lsid = head (_mcLSs mc) - (senseData,dam) = partitionEithers $ map (damageUsing damF) $ _mcDamage mc - newSense = sum senseData - ni = fromIntegral x / 1000 - upls = lsParam . lsCol .~ V3 ni ni ni + newsense = sum . map _dmAmount $ filter ((== dt) . _dmType) (_mcDamage mc) + ni = fromIntegral (_sensAmount $ _mcSensor mc) / 1000 + updatels = fromMaybe id $ do + lsid <- mc ^? mcMounts . ix ObLightSource + return $ lightSources . ix lsid . lsParam . lsCol .~ V3 ni ni ni damageUsing :: DamageType -> Damage -> Either Int Int damageUsing dt dm diff --git a/src/Dodge/Material.hs b/src/Dodge/Material.hs index 307c5ad36..bee5a093c 100644 --- a/src/Dodge/Material.hs +++ b/src/Dodge/Material.hs @@ -1,22 +1 @@ module Dodge.Material where -import Dodge.Data.Material -import Dodge.SoundLogic.ExternallyGeneratedSounds -import Sound.Data - -destroyMatS :: Material -> [SoundID] -destroyMatS mat = case mat of - Glass -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S] - Crystal -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S] - Stone -> [stone1S,stone2S,stone3S,stone4S,stone5S] - Dirt -> [stone1S,stone3S] - Wood -> [stone1S,stone3S] - Metal -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] - -weakenMatS :: Material -> [SoundID] -weakenMatS mat = case mat of - Glass -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S] - Crystal -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S] - Stone -> [stone1S,stone2S,stone3S,stone4S,stone5S] - Dirt -> [stone1S,stone3S] - Wood -> [stone1S,stone3S] - Metal -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] diff --git a/src/Dodge/Material/Damage.hs b/src/Dodge/Material/Damage.hs new file mode 100644 index 000000000..8fc7b5239 --- /dev/null +++ b/src/Dodge/Material/Damage.hs @@ -0,0 +1,81 @@ +module Dodge.Material.Damage where +import Dodge.Data +import Dodge.Particle.Spark +--import Dodge.Particle.Bullet.Spawn +--import Dodge.Base.Wall +--import Dodge.Wall.Dust +--import Dodge.Block +import Geometry +--import LensHelp + +--import Control.Monad.State + +damageMaterial :: Damage -> Material + -> Float -- the angle of the hit surface, in radians + -> World -> (Int, World) +damageMaterial dm mt = case mt of + Stone -> damageStone dm + _ -> defDamageMaterial dm +-- Glass -> damageGlass dm + +defDamageMaterial :: Damage -> Float -> World -> (Int,World) +defDamageMaterial dm _ w = (_dmAmount dm, w) + +damageStone :: Damage -> Float -> World -> (Int,World) +damageStone dm dir = case _dmType dm of + LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (argV $ reflectIn (p -.- sp) v) + PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (argV $ reflectIn (p -.- sp) v) + BLUNT -> a d id + SHATTERING -> a d id + CRUSHING -> a d id + EXPLOSIVE -> a d id + CUTTING -> a d id + SPARKING -> a 0 id + FLAMING -> a 0 id + ELECTRICAL -> a 0 id + CONCUSSIVE -> a d id + TORQUEDAM -> a 0 id + PUSHDAM -> a 0 id + POISONDAM -> a 0 id + ENTERREMENT -> a 0 id + where + v = unitVectorAtAngle dir + a x f w = (x,f w) + d = _dmAmount dm + sp = _dmFrom dm + p = _dmAt dm + outTo = p +.+ squashNormalizeV (sp -.- p) + pSparkCol = V4 5 1 0.5 2 + lSparkCol = V4 20 (-5) 0 1 + +--damageGlass :: Damage -> Float -> World -> (World,Int) +--damageGlass dm dir w = w & case _dmType dm of +-- LASERING -> a 0 $ id +-- PIERCING -> a d $ dosplint . colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo +-- BLUNT -> a d $ dosplint . wlDustAt wl outTo +-- SHATTERING -> a d $ dosplint . muchWlDustAt wl outTo +-- CRUSHING -> a d dosplint +-- EXPLOSIVE -> a d dosplint +-- CUTTING -> a d dosplint +-- SPARKING -> a 0 id +-- FLAMING -> a 0 id +-- ELECTRICAL -> a 0 id +-- CONCUSSIVE -> a 0 dosplint +-- TORQUEDAM -> a 0 id +-- PUSHDAM -> a 0 id +-- POISONDAM -> a 0 id +-- ENTERREMENT -> a 0 id +-- where +-- mbl = do +-- blid <- wl ^? wlStructure . wsBlock +-- w ^? blocks . ix blid +-- d :: Int +-- d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl +-- a :: Int -> (World -> World) -> World -> (World,Int) +-- a x f w' = (f w',x) +-- dosplint = maybe id splinterBlock mbl +-- sp = _dmFrom dm +-- p = _dmAt dm +-- outTo = p +.+ squashNormalizeV (sp -.- p) +-- pSparkCol = V4 5 1 0.5 2 +-- lSparkCol = V4 20 (-5) 0 1 diff --git a/src/Dodge/Material/Sound.hs b/src/Dodge/Material/Sound.hs new file mode 100644 index 000000000..118567be2 --- /dev/null +++ b/src/Dodge/Material/Sound.hs @@ -0,0 +1,26 @@ +module Dodge.Material.Sound where +import Dodge.Data.Material +import Dodge.SoundLogic.ExternallyGeneratedSounds +import Sound.Data + +destroyMatS :: Material -> [SoundID] +destroyMatS mat = case mat of + Glass -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S] + Crystal -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S] + Stone -> [stone1S,stone2S,stone3S,stone4S,stone5S] + Dirt -> [stone1S,stone3S] + Wood -> [stone1S,stone3S] + Metal -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] + Electronics -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] + Flesh -> [gut1S,gut2S,gut3S,gut4S,gut5S,gut6S] + +weakenMatS :: Material -> [SoundID] +weakenMatS mat = case mat of + Glass -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S] + Crystal -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S] + Stone -> [stone1S,stone2S,stone3S,stone4S,stone5S] + Dirt -> [stone1S,stone3S] + Wood -> [stone1S,stone3S] + Metal -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] + Electronics -> [metal1S,metal2S,metal3S,metal4S,metal5S,metal6S,metal7S] + Flesh -> [blood1S,blood2S,blood3S,blood4S,blood5S,blood6S,blood7S,blood8S] diff --git a/src/Dodge/Placement/Instance/Sensor.hs b/src/Dodge/Placement/Instance/Sensor.hs index 315562614..1fc662050 100644 --- a/src/Dodge/Placement/Instance/Sensor.hs +++ b/src/Dodge/Placement/Instance/Sensor.hs @@ -15,28 +15,30 @@ import Shape import qualified Data.Map.Strict as M import Control.Lens -damageSensor - :: DamageType -- Left gets sensed, Right does damage +damageSensor + :: DamageType -> Float -> Maybe Int - -> PlacementSpot -> Placement + -> PlacementSpot + -> Placement damageSensor dt wdth mtrid ps = pContID ps (PutLS $ lsPosCol (V3 0 0 30) 0.1) $ \lsid -> Just $ spNoID ps $ PutUsingGenParams $ \gw -> (,) gw $ PutMachine (reverse $ square wdth) $ defaultMachine & mcColor .~ yellow & mcMounts . at ObTrigger .~ mtrid + & mcMounts . at ObLightSource ?~ lsid & mcDraw .~ sensorSPic wdth (_sensorCoding (_genParams gw) M.! dt) - & mcSensor .~ SensorToggleAmount False 0 - & mcLSs .~ [lsid] + & mcSensor .~ DamageSensor False 0 dt -lightSensor :: Float -- -> (Machine -> World -> World) +lightSensor :: Float -> Maybe Int - -> PlacementSpot -> Placement + -> PlacementSpot + -> Placement lightSensor = damageSensor LASERING sensorSPic :: Float -> (PaletteColor,DecorationShape) -> Machine -> SPic sensorSPic wdth (pc,ds) mc = noPic - $ colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth)) - <> decorationToShape ds wdth wdth 25 col col + $ colorSH (_mcColor mc) (upperPrismPoly 25 (square wdth)) + <> decorationToShape ds wdth wdth 25 col col where col = paletteToColor pc diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 49abbd569..78ed372bd 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -94,7 +94,7 @@ accessTerminal mtmid w = case mtmid of TerminalReady -> tm TerminalBusy -> tm TerminalOff -> tm - & tmFutureLines .~ _tmProgram tm tm w + & tmFutureLines .~ _tmBootProgram tm tm w & tmStatus .~ TerminalBusy simpleTermMessage :: [String] -> Terminal diff --git a/src/Dodge/Placement/Instance/Turret.hs b/src/Dodge/Placement/Instance/Turret.hs index 0e63c4b56..c93b6be3c 100644 --- a/src/Dodge/Placement/Instance/Turret.hs +++ b/src/Dodge/Placement/Instance/Turret.hs @@ -1,9 +1,7 @@ module Dodge.Placement.Instance.Turret where import Color import Dodge.Data ---import Dodge.Reloading import Dodge.Creature.State -import Dodge.Creature.Damage import Dodge.Creature.Impulse import Dodge.LevelGen.Data import Dodge.Default @@ -76,7 +74,7 @@ updateTurret rotSpeed mc w & crDir .~ mcdir & crUpdate .~ stateUpdate followThenClearImpulses & crStance . posture .~ Aiming - & crApplyDamage .~ applyNoDamage + & crMaterial .~ Crystal Just cid -> w' & creatures . ix cid . crPos .~ mcpos & creatures . ix cid . crDir .~ mcdir diff --git a/src/Dodge/Placement/TopDecoration.hs b/src/Dodge/Placement/TopDecoration.hs index 63f5eac4a..f85b203b5 100644 --- a/src/Dodge/Placement/TopDecoration.hs +++ b/src/Dodge/Placement/TopDecoration.hs @@ -6,8 +6,7 @@ import Shape import Geometry import Color -decorationToShape :: DecorationShape - -> Float -> Float -> Float -> Color -> Color -> Shape +decorationToShape :: DecorationShape -> Float -> Float -> Float -> Color -> Color -> Shape decorationToShape dec = case dec of PLUS -> plusDecoration SQUARE -> squareDecoration diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 779d2d083..c15930094 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -1,6 +1,7 @@ module Dodge.Render.ShapePicture ( worldSPic ) where +import Dodge.Item.Draw.SPic import Dodge.Creature.Picture.Awareness import Dodge.Creature.Picture import Dodge.Particle.Draw @@ -14,15 +15,12 @@ import Dodge.Picture.SizeInvariant import Dodge.Data import Dodge.Zone import Dodge.Base ---import Dodge.Base.Window import Dodge.SoundLogic.LoadSound import Dodge.Graph import Dodge.GameRoom import Dodge.Update.Camera -import Dodge.Item.Draw import Dodge.Render.List import Dodge.Path ---import Dodge.Zone import Geometry import Geometry.Zone import ShapePicture @@ -30,13 +28,10 @@ import Picture import Sound.Data import Geometry.ConvexPoly import ShortShow ---import Dodge.Base.Collide import StreamingHelp ---import Data.Foldable import qualified Data.IntMap.Strict as IM -- Lazy? import qualified Data.Map.Strict as M ---import qualified Data.Set as Set import Control.Lens import Data.Maybe import qualified Streaming.Prelude as S @@ -51,19 +46,18 @@ singleSPic = id worldSPic :: Configuration -> World -> SPic worldSPic cfig w = singleSPic (mempty, extraPics cfig w) - <> foldup (dbArg _prDraw) (filtOn' _prPos _props) - <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks) - <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foregroundShapes) - <> foldup (dbArg _cpPict) (filtOn' _cpPos _corpses) - <> foldup drawCreature (filtOn' _crPos _creatures) - <> foldup floorItemSPic (filtOn' _flItPos _floorItems) - <> foldup btSPic (filtOn' _btPos _buttons) - <> foldup mcSPic (filtOn' _mcPos _machines) + <> foldup (dbArg _prDraw) (filtOn _prPos _props) + <> foldup (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks) + <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes) + <> foldup (dbArg _cpPict) (filtOn _cpPos _corpses) + <> foldup drawCreature (filtOn _crPos _creatures) + <> foldup floorItemSPic (filtOn _flItPos _floorItems) + <> foldup btSPic (filtOn _btPos _buttons) + <> foldup mcSPic (filtOn _mcPos _machines) <> singleSPic (anyTargeting cfig w) where foldup = foldMap' - filtOn' f g = IM.filter (pointIsClose . f) (g w) - --filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w) + filtOn f g = IM.filter (pointIsClose . f) (g w) pointIsClose = cullPoint cfig w anyTargeting :: Configuration -> World -> SPic @@ -157,11 +151,9 @@ drawPathBetween w = setLayer DebugLayer ep = _rSelect w drawNodesNearSelect :: World -> Picture -drawNodesNearSelect w = setLayer DebugLayer $ - runIdentity (S.foldMap_ (drawZone pnZoneSize) (zoneAroundPoint pnZoneSize sp)) --- <> color red (foldMap (drawCross . snd) $ nodesNearL sp w) +drawNodesNearSelect w = setLayer DebugLayer + $ runIdentity (S.foldMap_ (drawZoneCol orange pnZoneSize) (zoneAroundPoint pnZoneSize sp)) <> color green (drawCross sp) --- <> color cyan (foldMap (drawCross . snd) $ walkableNodeNear sp w) where sp = _lSelect w @@ -173,10 +165,8 @@ drawInspectWalls w = foldMap (drawInspectWall w) (a,b) = _lLine w drawInspectWall :: World -> Wall -> Picture -drawInspectWall w wl = setLayer DebugLayer $ - color rose (thickLine 3 [a,b]) --- <> foldMap (drawZone wlZoneSize) --- (runIdentity $ S.toList_ $ zoneOfWall wlZoneSize wl) -- this won't work if wlZoneSize is not consistent +drawInspectWall w wl = setLayer DebugLayer + $ color rose (thickLine 3 [a,b]) <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor) where (a,b) = _wlLine wl @@ -217,8 +207,8 @@ drawFarWallDetect w = setLayer DebugLayer p = _cameraViewFrom w drawDDATest :: World -> Picture -drawDDATest w = runIdentity (S.foldMap_ (drawZone 50) ps) - <> runIdentity (S.foldMap_ (drawZone' 50) ps') +drawDDATest w = runIdentity (S.foldMap_ (drawZoneCol orange 50) ps) + <> runIdentity (S.foldMap_ (drawZoneCol green 50) ps') <> runIdentity (S.foldMap_ drawCross qs) <> color blue (runIdentity (S.foldMap_ drawCross qs')) <> setLayer DebugLayer (color yellow (line [cvf,mwp])) @@ -236,15 +226,11 @@ drawCross p = setLayer DebugLayer . color red . uncurryV translate p $ crossPic crossPic :: Float -> Picture crossPic x = line [V2 x x,V2 (-x) (-x)] <> line [V2 (-x) x,V2 x (-x)] -drawZone :: Float -> V2 Int -> Picture -drawZone s (V2 x y) = setLayer DebugLayer . color orange $ thickLine 2 (p:ps ++ [p]) +drawZoneCol :: Color -> Float -> V2 Int -> Picture +drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p:ps ++ [p]) where - (p:ps) = zipWith (+.+) innerSquare $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)] - -drawZone' :: Float -> V2 Int -> Picture -drawZone' s (V2 x y) = setLayer DebugLayer . color green $ line (p:ps ++ [p]) - where - (p:ps) = zipWith (+.+) (map (2*.*) innerSquare) $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)] + (p:ps) = zipWith (+.+) innerSquare + $ map ((s*.*) . (each %~ fromIntegral)) [V2 x y, V2 (x+1) y, V2 (x+1) (y+1), V2 x (y+1)] innerSquare :: [Point2] innerSquare = [V2 1 1, V2 (-1) 1, V2 (-1) (-1), V2 1 (-1)] @@ -267,10 +253,9 @@ clDraw :: Cloud -> Picture clDraw c = translate3 (_clPos c) (_clPict c c) ppDraw :: PressPlate -> Picture ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c) - floorItemSPic :: FloorItem -> SPic -floorItemSPic flit = uncurryV translateSPf (_flItPos flit) - $ rotateSP (_flItRot flit) (itemSPic (_flIt flit)) +floorItemSPic flit = uncurryV translateSPf (_flItPos flit) + $ rotateSP (_flItRot flit) (itemSPic (_flIt flit)) btSPic :: Button -> SPic btSPic bt = uncurryV translateSPf (_btPos bt) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index b40ffc8ad..f8af3a6fe 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -2,31 +2,18 @@ module Dodge.Room.Warning where import Dodge.Cleat import Dodge.Terminal ---import Dodge.LevelGen.Data import Dodge.PlacementSpot import Dodge.Placement.Instance.Terminal import Dodge.Data import Dodge.Tree ---import Dodge.RoomLink import Dodge.Room.Door import Dodge.Room.Ngon import Dodge.Room.Procedural import Dodge.Room.Tanks ---import Dodge.Room.Corridor import Dodge.Room.Link ---import Dodge.Room.Procedural ---import Dodge.Room.Foreground ---import Dodge.Room.RoadBlock import Dodge.Placement.Instance ---import Dodge.Default.Room ---import Dodge.Item.Weapon.Utility ---import Dodge.LevelGen.Data ---import Geometry.Data import Geometry ---import Padding ---import Color ---import Shape ---import Lorem +import Color import LensHelp import RandomHelp @@ -54,8 +41,7 @@ addWarningTerminal str outplid = (rmName .++~ "warningTerm-") (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) (Just . set plSpot (rprShift moveToSideFirstOutLink) . putMessageTerminal terminalColor . termMessages) - termMessages trpl = basicTerminal - & tmFutureLines .~ makeTermPara str + termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str) & tmScrollCommands .:~ toggleCommand & tmToggles .~ M.fromList [("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const (const True)))] diff --git a/src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs b/src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs index 7190df89b..3a1fe8d3d 100644 --- a/src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs +++ b/src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs @@ -1,4 +1,4 @@ --- generated at 2022-06-23 20:14:52.284399733 UTC +-- generated at 2022-07-14 22:58:49.919236742 UTC module Dodge.SoundLogic.ExternallyGeneratedSounds where import Sound.Data soundToVol :: SoundID -> Float @@ -11,85 +11,99 @@ soundToVol v = case _getSoundID v of 5 -> 1000 6 -> 40 7 -> 100 - 8 -> 500 + 8 -> 100 9 -> 500 - 10 -> 300 + 10 -> 200 11 -> 500 - 12 -> 1000 - 13 -> 40 - 14 -> 2000 - 15 -> 50 - 16 -> 50 + 12 -> 300 + 13 -> 100 + 14 -> 500 + 15 -> 1000 + 16 -> 40 17 -> 2000 - 18 -> 200 - 19 -> 40 - 20 -> 300 - 21 -> 500 + 18 -> 100 + 19 -> 50 + 20 -> 200 + 21 -> 50 22 -> 2000 - 23 -> 500 - 24 -> 100 - 25 -> 1000 - 26 -> 100 - 27 -> 1000 - 28 -> 1000 - 29 -> 40 - 30 -> 2000 - 31 -> 50 - 32 -> 2000 - 33 -> 50 + 23 -> 200 + 24 -> 40 + 25 -> 300 + 26 -> 500 + 27 -> 2000 + 28 -> 500 + 29 -> 100 + 30 -> 200 + 31 -> 1000 + 32 -> 100 + 33 -> 100 34 -> 1000 - 35 -> 8000 - 36 -> 2000 + 35 -> 1000 + 36 -> 40 37 -> 2000 - 38 -> 1000 - 39 -> 2000 - 40 -> 100 - 41 -> 40 - 42 -> 40 - 43 -> 2000 - 44 -> 100 - 45 -> 500 - 46 -> 40 - 47 -> 300 - 48 -> 300 - 49 -> 2000 - 50 -> 1000 - 51 -> 1000 - 52 -> 1000 - 53 -> 1000 - 54 -> 1000 - 55 -> 40 - 56 -> 50 - 57 -> 1000 - 58 -> 500 - 59 -> 500 + 38 -> 100 + 39 -> 50 + 40 -> 2000 + 41 -> 50 + 42 -> 1000 + 43 -> 8000 + 44 -> 2000 + 45 -> 2000 + 46 -> 1000 + 47 -> 2000 + 48 -> 100 + 49 -> 40 + 50 -> 40 + 51 -> 2000 + 52 -> 100 + 53 -> 500 + 54 -> 40 + 55 -> 300 + 56 -> 300 + 57 -> 2000 + 58 -> 1000 + 59 -> 1000 60 -> 1000 - 61 -> 20 - 62 -> 500 - 63 -> 300 - 64 -> 500 + 61 -> 1000 + 62 -> 1000 + 63 -> 40 + 64 -> 50 65 -> 1000 - 66 -> 1000 + 66 -> 500 67 -> 500 - 68 -> 1000 - 69 -> 2000 - 70 -> 2000 + 68 -> 100 + 69 -> 1000 + 70 -> 20 71 -> 500 - 72 -> 2000 - 73 -> 100 - 74 -> 300 + 72 -> 300 + 73 -> 200 + 74 -> 500 75 -> 1000 - 76 -> 100 - 77 -> 1000 - 78 -> 2000 + 76 -> 1000 + 77 -> 500 + 78 -> 100 79 -> 1000 - 80 -> 200 - 81 -> 500 - 82 -> 100 + 80 -> 2000 + 81 -> 2000 + 82 -> 500 83 -> 2000 - 84 -> 2000 - 85 -> 2000 - 86 -> 100 + 84 -> 100 + 85 -> 300 + 86 -> 1000 + 87 -> 200 + 88 -> 100 + 89 -> 1000 + 90 -> 2000 + 91 -> 1000 + 92 -> 100 + 93 -> 200 + 94 -> 500 + 95 -> 100 + 96 -> 2000 + 97 -> 2000 + 98 -> 2000 + 99 -> 100 + 100 -> 200 _ -> 50 soundToOnomato :: SoundID -> String soundToOnomato v = case _getSoundID v of @@ -100,86 +114,100 @@ soundToOnomato v = case _getSoundID v of 4 -> "DEDEDA" 5 -> "CRNK" 6 -> "CLNK" - 7 -> "WRR" - 8 -> "TINKLE" - 9 -> "TRINKL" - 10 -> "BWAAH" - 11 -> "DNDNDNDN" - 12 -> "CRMBL" - 13 -> "TIP" - 14 -> "TATATA" - 15 -> "BLIH" - 16 -> "HMM" - 17 -> "PEW" - 18 -> "CRAKLE" - 19 -> "TAP" - 20 -> "DWAAH" - 21 -> "PRUM" - 22 -> "BANGG" - 23 -> "CRTINK" - 24 -> "PHF" - 25 -> "ZHM" - 26 -> "THUD" - 27 -> "TRWNG" - 28 -> "CRASH" - 29 -> "TAPTIP" - 30 -> "CHUGUGUG" - 31 -> "HSSS" - 32 -> "BOOM" - 33 -> "HSS" - 34 -> "TAKH" - 35 -> "RINGGG" - 36 -> "CRH" - 37 -> "UGGAUGGA" - 38 -> "CRUMPLE" - 39 -> "CREUH" - 40 -> "SMACK" - 41 -> "CLICK" - 42 -> "TIPTOP" - 43 -> "CRUH" - 44 -> "CHNKCHNKCHUNK" - 45 -> "CLKCLK" - 46 -> "TIPTAP" - 47 -> "TNKTNKTNK" - 48 -> "CHPCHPCHP" - 49 -> "SCREE" - 50 -> "DHDHL" - 51 -> "BRAP" - 52 -> "CRSK" - 53 -> "CRNKL" - 54 -> "TRNKL" - 55 -> "TAPP" - 56 -> "SHUHP" - 57 -> "CRUMBL" - 58 -> "DEDEDUM" - 59 -> "TAK" - 60 -> "CRISH" - 61 -> "SWSH" - 62 -> "BIPBIPBIP" - 63 -> "BEP" - 64 -> "KRTNKL" - 65 -> "CRSNK" - 66 -> "TTRKL" - 67 -> "DUDURAH" - 68 -> "CRMPL" - 69 -> "CHUGUGUG" - 70 -> "BANG" - 71 -> "DEDA" - 72 -> "WHSSH" - 73 -> "HNH" - 74 -> "BWAH" - 75 -> "CRUNK" - 76 -> "DRR" - 77 -> "TRNKL" - 78 -> "BRAP" - 79 -> "BLPCHCH" - 80 -> "ZMM" - 81 -> "WRRR" - 82 -> "FWUMP" - 83 -> "BRAHCHCH" - 84 -> "BRPBRPBRP" - 85 -> "WE-OH" - 86 -> "FHP" + 7 -> "SKWLCH" + 8 -> "WRR" + 9 -> "TINKLE" + 10 -> "SKREL" + 11 -> "TRINKL" + 12 -> "BWAAH" + 13 -> "SQLEE" + 14 -> "DNDNDNDN" + 15 -> "CRMBL" + 16 -> "TIP" + 17 -> "TATATA" + 18 -> "SPRT" + 19 -> "BLIH" + 20 -> "SQWCH" + 21 -> "HMM" + 22 -> "PEW" + 23 -> "CRAKLE" + 24 -> "TAP" + 25 -> "DWAAH" + 26 -> "PRUM" + 27 -> "BANGG" + 28 -> "CRTINK" + 29 -> "PHF" + 30 -> "CRNCH" + 31 -> "ZHM" + 32 -> "CLCLH" + 33 -> "THUD" + 34 -> "TRWNG" + 35 -> "CRASH" + 36 -> "TAPTIP" + 37 -> "CHUGUGUG" + 38 -> "SKWLL" + 39 -> "HSSS" + 40 -> "BOOM" + 41 -> "HSS" + 42 -> "TAKH" + 43 -> "RINGGG" + 44 -> "CRH" + 45 -> "UGGAUGGA" + 46 -> "CRUMPLE" + 47 -> "CREUH" + 48 -> "SMACK" + 49 -> "CLICK" + 50 -> "TIPTOP" + 51 -> "CRUH" + 52 -> "CHNKCHNKCHUNK" + 53 -> "CLKCLK" + 54 -> "TIPTAP" + 55 -> "TNKTNKTNK" + 56 -> "CHPCHPCHP" + 57 -> "SCREE" + 58 -> "DHDHL" + 59 -> "BRAP" + 60 -> "CRSK" + 61 -> "CRNKL" + 62 -> "TRNKL" + 63 -> "TAPP" + 64 -> "SHUHP" + 65 -> "CRUMBL" + 66 -> "DEDEDUM" + 67 -> "TAK" + 68 -> "SPLRT" + 69 -> "CRISH" + 70 -> "SWSH" + 71 -> "BIPBIPBIP" + 72 -> "BEP" + 73 -> "CRSKRL" + 74 -> "KRTNKL" + 75 -> "CRSNK" + 76 -> "TTRKL" + 77 -> "DUDURAH" + 78 -> "KKSQWL" + 79 -> "CRMPL" + 80 -> "CHUGUGUG" + 81 -> "BANG" + 82 -> "DEDA" + 83 -> "WHSSH" + 84 -> "HNH" + 85 -> "BWAH" + 86 -> "CRUNK" + 87 -> "SQWLTCH" + 88 -> "DRR" + 89 -> "TRNKL" + 90 -> "BRAP" + 91 -> "BLPCHCH" + 92 -> "SKLE" + 93 -> "ZMM" + 94 -> "WRRR" + 95 -> "FWUMP" + 96 -> "BRAHCHCH" + 97 -> "BRPBRPBRP" + 98 -> "WE-OH" + 99 -> "FHP" + 100 -> "QWLPH" _ -> error "unitialised sound" soundPathList :: [String] soundPathList = @@ -190,15 +218,20 @@ soundPathList = , "dededa.DEDEDA.500.wav" , "glassShat3.CRNK.1000.wav" , "tapQuiet.CLNK.40.wav" + , "blood8.SKWLCH.100.wav" , "fire.WRR.100.wav" , "smallGlass4.TINKLE.500.wav" + , "gut4.SKREL.200.wav" , "smallGlass1.TRINKL.500.wav" , "sineRaisePitchTwoSec.BWAAH.300.wav" + , "blood7.SQLEE.100.wav" , "combine.DNDNDNDN.500.wav" , "stone4.CRMBL.1000.wav" , "foot1.TIP.40.wav" , "autoB.TATATA.2000.wav" + , "blood2.SPRT.100.wav" , "heal.BLIH.50.wav" + , "gut3.SQWCH.200.wav" , "fridgeHum.HMM.50.wav" , "seagullWhistle1.PEW.2000.wav" , "elecCrackle.CRAKLE.200.wav" @@ -208,12 +241,15 @@ soundPathList = , "bangEcho.BANGG.2000.wav" , "smallGlass3.CRTINK.500.wav" , "whiteNoiseFadeOut.PHF.100.wav" + , "gut2.CRNCH.200.wav" , "tele.ZHM.1000.wav" + , "blood5.CLCLH.100.wav" , "hit.THUD.100.wav" , "metal7.TRWNG.1000.wav" , "stone1.CRASH.1000.wav" , "twoStep1.TAPTIP.40.wav" , "seagullChatter.CHUGUGUG.2000.wav" + , "blood4.SKWLL.100.wav" , "foamSprayLoop.HSSS.50.wav" , "explosion.BOOM.2000.wav" , "foamSprayFadeOut.HSS.50.wav" @@ -243,14 +279,17 @@ soundPathList = , "stone5.CRUMBL.1000.wav" , "dededum.DEDEDUM.500.wav" , "tap1.TAK.500.wav" + , "blood1.SPLRT.100.wav" , "metal4.CRISH.1000.wav" , "knife.SWSH.20.wav" , "computerBeeping.BIPBIPBIP.500.wav" , "tone440.BEP.300.wav" + , "gut6.CRSKRL.200.wav" , "smallGlass2.KRTNKL.500.wav" , "glassShat1.CRSNK.1000.wav" , "metal5.TTRKL.1000.wav" , "eject.DUDURAH.500.wav" + , "blood3.KKSQWL.100.wav" , "stone2.CRMPL.1000.wav" , "seagullChatter1.CHUGUGUG.2000.wav" , "bang.BANG.2000.wav" @@ -259,10 +298,12 @@ soundPathList = , "grunt.HNH.100.wav" , "sineRaisePitchOneSec.BWAH.300.wav" , "metal2.CRUNK.1000.wav" + , "gut5.SQWLTCH.200.wav" , "slideDoor.DRR.100.wav" , "metal6.TRNKL.1000.wav" , "autoGun.BRAP.2000.wav" , "oldMachineBoot.BLPCHCH.1000.wav" + , "blood6.SKLE.100.wav" , "buzz.ZMM.200.wav" , "fireLoud.WRRR.500.wav" , "tap4.FWUMP.100.wav" @@ -270,6 +311,7 @@ soundPathList = , "mini.BRPBRPBRP.2000.wav" , "seagullWhistle.WE-OH.2000.wav" , "whiteNoiseFadeIn.FHP.100.wav" + , "gut1.QWLPH.200.wav" ] dedumS :: SoundID dedumS = SoundID 0 @@ -285,163 +327,191 @@ glassShat3S :: SoundID glassShat3S = SoundID 5 tapQuietS :: SoundID tapQuietS = SoundID 6 +blood8S :: SoundID +blood8S = SoundID 7 fireS :: SoundID -fireS = SoundID 7 +fireS = SoundID 8 smallGlass4S :: SoundID -smallGlass4S = SoundID 8 +smallGlass4S = SoundID 9 +gut4S :: SoundID +gut4S = SoundID 10 smallGlass1S :: SoundID -smallGlass1S = SoundID 9 +smallGlass1S = SoundID 11 sineRaisePitchTwoSecS :: SoundID -sineRaisePitchTwoSecS = SoundID 10 +sineRaisePitchTwoSecS = SoundID 12 +blood7S :: SoundID +blood7S = SoundID 13 combineS :: SoundID -combineS = SoundID 11 +combineS = SoundID 14 stone4S :: SoundID -stone4S = SoundID 12 +stone4S = SoundID 15 foot1S :: SoundID -foot1S = SoundID 13 +foot1S = SoundID 16 autoBS :: SoundID -autoBS = SoundID 14 +autoBS = SoundID 17 +blood2S :: SoundID +blood2S = SoundID 18 healS :: SoundID -healS = SoundID 15 +healS = SoundID 19 +gut3S :: SoundID +gut3S = SoundID 20 fridgeHumS :: SoundID -fridgeHumS = SoundID 16 +fridgeHumS = SoundID 21 seagullWhistle1S :: SoundID -seagullWhistle1S = SoundID 17 +seagullWhistle1S = SoundID 22 elecCrackleS :: SoundID -elecCrackleS = SoundID 18 +elecCrackleS = SoundID 23 foot2S :: SoundID -foot2S = SoundID 19 +foot2S = SoundID 24 skwareFadeTwoSecS :: SoundID -skwareFadeTwoSecS = SoundID 20 +skwareFadeTwoSecS = SoundID 25 insertOneS :: SoundID -insertOneS = SoundID 21 +insertOneS = SoundID 26 bangEchoS :: SoundID -bangEchoS = SoundID 22 +bangEchoS = SoundID 27 smallGlass3S :: SoundID -smallGlass3S = SoundID 23 +smallGlass3S = SoundID 28 whiteNoiseFadeOutS :: SoundID -whiteNoiseFadeOutS = SoundID 24 +whiteNoiseFadeOutS = SoundID 29 +gut2S :: SoundID +gut2S = SoundID 30 teleS :: SoundID -teleS = SoundID 25 +teleS = SoundID 31 +blood5S :: SoundID +blood5S = SoundID 32 hitS :: SoundID -hitS = SoundID 26 +hitS = SoundID 33 metal7S :: SoundID -metal7S = SoundID 27 +metal7S = SoundID 34 stone1S :: SoundID -stone1S = SoundID 28 +stone1S = SoundID 35 twoStep1S :: SoundID -twoStep1S = SoundID 29 +twoStep1S = SoundID 36 seagullChatterS :: SoundID -seagullChatterS = SoundID 30 +seagullChatterS = SoundID 37 +blood4S :: SoundID +blood4S = SoundID 38 foamSprayLoopS :: SoundID -foamSprayLoopS = SoundID 31 +foamSprayLoopS = SoundID 39 explosionS :: SoundID -explosionS = SoundID 32 +explosionS = SoundID 40 foamSprayFadeOutS :: SoundID -foamSprayFadeOutS = SoundID 33 +foamSprayFadeOutS = SoundID 41 tap2S :: SoundID -tap2S = SoundID 34 +tap2S = SoundID 42 tinitusS :: SoundID -tinitusS = SoundID 35 +tinitusS = SoundID 43 seagullCry1S :: SoundID -seagullCry1S = SoundID 36 +seagullCry1S = SoundID 44 seagullBarkS :: SoundID -seagullBarkS = SoundID 37 +seagullBarkS = SoundID 45 stone3S :: SoundID -stone3S = SoundID 38 +stone3S = SoundID 46 seagullCry2S :: SoundID -seagullCry2S = SoundID 39 +seagullCry2S = SoundID 47 hit1S :: SoundID -hit1S = SoundID 40 +hit1S = SoundID 48 click1S :: SoundID -click1S = SoundID 41 +click1S = SoundID 49 twoStepSlowS :: SoundID -twoStepSlowS = SoundID 42 +twoStepSlowS = SoundID 50 seagullCryS :: SoundID -seagullCryS = SoundID 43 +seagullCryS = SoundID 51 crankSlowS :: SoundID -crankSlowS = SoundID 44 +crankSlowS = SoundID 52 primeS :: SoundID -primeS = SoundID 45 +primeS = SoundID 53 twoStepS :: SoundID -twoStepS = SoundID 46 +twoStepS = SoundID 54 reloadS :: SoundID -reloadS = SoundID 47 +reloadS = SoundID 55 reload1S :: SoundID -reload1S = SoundID 48 +reload1S = SoundID 56 tone440sawtoothS :: SoundID -tone440sawtoothS = SoundID 49 +tone440sawtoothS = SoundID 57 metal3S :: SoundID -metal3S = SoundID 50 +metal3S = SoundID 58 tap3S :: SoundID -tap3S = SoundID 51 +tap3S = SoundID 59 glassShat4S :: SoundID -glassShat4S = SoundID 52 +glassShat4S = SoundID 60 glassShat2S :: SoundID -glassShat2S = SoundID 53 +glassShat2S = SoundID 61 metal1S :: SoundID -metal1S = SoundID 54 +metal1S = SoundID 62 foot3S :: SoundID -foot3S = SoundID 55 +foot3S = SoundID 63 pickUpS :: SoundID -pickUpS = SoundID 56 +pickUpS = SoundID 64 stone5S :: SoundID -stone5S = SoundID 57 +stone5S = SoundID 65 dededumS :: SoundID -dededumS = SoundID 58 +dededumS = SoundID 66 tap1S :: SoundID -tap1S = SoundID 59 +tap1S = SoundID 67 +blood1S :: SoundID +blood1S = SoundID 68 metal4S :: SoundID -metal4S = SoundID 60 +metal4S = SoundID 69 knifeS :: SoundID -knifeS = SoundID 61 +knifeS = SoundID 70 computerBeepingS :: SoundID -computerBeepingS = SoundID 62 +computerBeepingS = SoundID 71 tone440S :: SoundID -tone440S = SoundID 63 +tone440S = SoundID 72 +gut6S :: SoundID +gut6S = SoundID 73 smallGlass2S :: SoundID -smallGlass2S = SoundID 64 +smallGlass2S = SoundID 74 glassShat1S :: SoundID -glassShat1S = SoundID 65 +glassShat1S = SoundID 75 metal5S :: SoundID -metal5S = SoundID 66 +metal5S = SoundID 76 ejectS :: SoundID -ejectS = SoundID 67 +ejectS = SoundID 77 +blood3S :: SoundID +blood3S = SoundID 78 stone2S :: SoundID -stone2S = SoundID 68 +stone2S = SoundID 79 seagullChatter1S :: SoundID -seagullChatter1S = SoundID 69 +seagullChatter1S = SoundID 80 bangS :: SoundID -bangS = SoundID 70 +bangS = SoundID 81 dedaS :: SoundID -dedaS = SoundID 71 +dedaS = SoundID 82 missileLaunchS :: SoundID -missileLaunchS = SoundID 72 +missileLaunchS = SoundID 83 gruntS :: SoundID -gruntS = SoundID 73 +gruntS = SoundID 84 sineRaisePitchOneSecS :: SoundID -sineRaisePitchOneSecS = SoundID 74 +sineRaisePitchOneSecS = SoundID 85 metal2S :: SoundID -metal2S = SoundID 75 +metal2S = SoundID 86 +gut5S :: SoundID +gut5S = SoundID 87 slideDoorS :: SoundID -slideDoorS = SoundID 76 +slideDoorS = SoundID 88 metal6S :: SoundID -metal6S = SoundID 77 +metal6S = SoundID 89 autoGunS :: SoundID -autoGunS = SoundID 78 +autoGunS = SoundID 90 oldMachineBootS :: SoundID -oldMachineBootS = SoundID 79 +oldMachineBootS = SoundID 91 +blood6S :: SoundID +blood6S = SoundID 92 buzzS :: SoundID -buzzS = SoundID 80 +buzzS = SoundID 93 fireLoudS :: SoundID -fireLoudS = SoundID 81 +fireLoudS = SoundID 94 tap4S :: SoundID -tap4S = SoundID 82 +tap4S = SoundID 95 shotgunS :: SoundID -shotgunS = SoundID 83 +shotgunS = SoundID 96 miniS :: SoundID -miniS = SoundID 84 +miniS = SoundID 97 seagullWhistleS :: SoundID -seagullWhistleS = SoundID 85 +seagullWhistleS = SoundID 98 whiteNoiseFadeInS :: SoundID -whiteNoiseFadeInS = SoundID 86 +whiteNoiseFadeInS = SoundID 99 +gut1S :: SoundID +gut1S = SoundID 100 diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index d63a2c6d5..03bdad502 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -229,7 +229,7 @@ basicTerminal = defaultTerminal ,_tmInput = defaultTerminalInput ,_tmScrollCommands = [quitCommand] ,_tmWriteCommands = [helpCommand,commandsCommand] - ,_tmProgram = \_ _ -> connectionBlurb + ,_tmBootProgram = \_ _ -> connectionBlurb , _tmDeathEffect = doDeathTriggers } @@ -242,7 +242,7 @@ lineOutputTerminal tls = defaultTerminal ,_tmInput = defaultTerminalInput ,_tmScrollCommands = [quitCommand] ,_tmWriteCommands = [helpCommand,commandsCommand] - ,_tmProgram = \_ _ -> connectionBlurbLines tls + ,_tmBootProgram = \_ _ -> connectionBlurbLines tls , _tmDeathEffect = doDeathTriggers } diff --git a/src/Dodge/Wall/DamageEffect.hs b/src/Dodge/Wall/DamageEffect.hs index 2a4778297..6522910fb 100644 --- a/src/Dodge/Wall/DamageEffect.hs +++ b/src/Dodge/Wall/DamageEffect.hs @@ -19,11 +19,12 @@ defaultWallDamage dm wl = flip (.) (wallDamageEffect dm wl) $ case _wlMaterial w Crystal -> crystalWallDamage dm wl Metal -> stoneWallDamage dm wl Wood -> stoneWallDamage dm wl + Electronics -> stoneWallDamage dm wl + Flesh -> stoneWallDamage dm wl stoneWallDamage :: Damage -> Wall -> World -> (World,Int) stoneWallDamage dm wl = case _dmType dm of LASERING -> a 0 $ colSparkRandDir 0.2 4 lSparkCol outTo (reflDirWall sp p wl) --- LASERING -> a 0 $ id PIERCING -> a d $ colSparkRandDir 0.2 8 pSparkCol outTo (reflDirWall sp p wl) . wlDustAt wl outTo BLUNT -> a d $ wlDustAt wl outTo SHATTERING -> a d $ muchWlDustAt wl outTo