Add sounds, move data types out into separate folders

This commit is contained in:
2022-07-16 17:06:51 +01:00
parent f8f4766012
commit e4a4766ddf
48 changed files with 658 additions and 496 deletions
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
Binary file not shown.
+1 -1
View File
@@ -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
+5 -1
View File
@@ -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
+6
View File
@@ -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
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+2 -1
View File
@@ -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
+1 -1
View File
@@ -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))
+14 -130
View File
@@ -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
+23
View File
@@ -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
+36
View File
@@ -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
+20
View File
@@ -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
+1 -1
View File
@@ -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)
+44
View File
@@ -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
+29
View File
@@ -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
+1 -1
View File
@@ -19,7 +19,7 @@ data Wall = Wall
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlUnshadowed :: Bool
, _wlUnshadowed :: Bool
, _wlRotateTo :: Bool
, _wlStructure :: WallStructure
, _wlHeight :: Float
+2 -5
View File
@@ -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
+2 -2
View File
@@ -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"
+1 -3
View File
@@ -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
+3 -4
View File
@@ -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
+5 -5
View File
@@ -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]
+1 -1
View File
@@ -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
+13 -19
View File
@@ -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
-21
View File
@@ -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]
+81
View File
@@ -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
+26
View File
@@ -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]
+11 -9
View File
@@ -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
+1 -1
View File
@@ -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
+1 -3
View File
@@ -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
+1 -2
View File
@@ -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
+22 -37
View File
@@ -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)
+2 -16
View File
@@ -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)))]
+297 -227
View File
@@ -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
+2 -2
View File
@@ -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
}
+2 -1
View File
@@ -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