275 lines
7.8 KiB
Haskell
275 lines
7.8 KiB
Haskell
{- |
|
|
Module : Dodge.Default
|
|
Description : Instances of data structures
|
|
|
|
This module contains prototypical data structures.
|
|
-}
|
|
module Dodge.Default where
|
|
import Dodge.Item.Weapon.ExtraEffect
|
|
import Dodge.Data
|
|
import Dodge.Data.DamageType
|
|
import Dodge.Data.SoundOrigin
|
|
import Dodge.Item.Data
|
|
import Dodge.Creature.Stance.Data
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.Perception.Data
|
|
import Dodge.Creature.Memory.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.SoundLogic.LoadSound
|
|
import Dodge.Picture.Layer
|
|
import Geometry
|
|
import Picture
|
|
import ShapePicture
|
|
import Shape
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Vector as V
|
|
import Data.List
|
|
import Data.Monoid
|
|
defaultCreature :: Creature
|
|
defaultCreature = Creature
|
|
{ _crPos = V2 0 0
|
|
, _crOldPos = V2 0 0
|
|
, _crVel = V2 0 0
|
|
, _crDir = 0
|
|
, _crOldDir = 0
|
|
, _crMvDir = 0
|
|
, _crID = 1
|
|
, _crPict = \_ _ -> (,) mempty blank
|
|
, _crUpdate = \cr _ -> (Endo id , Just cr)
|
|
, _crRad = 10
|
|
, _crMass = 10
|
|
, _crHP = 100
|
|
, _crMaxHP = 150
|
|
, _crInv = IM.empty
|
|
, _crInvSel = 0
|
|
, _crLeftInvSel = Nothing
|
|
, _crState = defaultState
|
|
, _crCorpse = setLayer 0 $ onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
|
|
, _crApplyDamage = defaultApplyDamage
|
|
, _crStance = Stance
|
|
{_carriage=Walking 0 WasLeftForward
|
|
,_posture=AtEase
|
|
,_strideLength = 40
|
|
}
|
|
, _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
|
|
, _crPerception = defaultPerceptionState
|
|
, _crMemory = defaultCreatureMemory
|
|
, _crMeleeCooldown = 0
|
|
, _crFaction = NoFaction
|
|
, _crIntention = defaultIntention
|
|
, _crGroup = LoneWolf
|
|
, _crMvType = defaultAimMvType
|
|
}
|
|
|
|
defaultCreatureMemory :: MemoryState
|
|
defaultCreatureMemory = MemoryState
|
|
{ _soundsToInvestigate = []
|
|
}
|
|
|
|
defaultPerceptionState :: PerceptionState
|
|
defaultPerceptionState = PerceptionState
|
|
{ _crAwakeLevel = Lethargic
|
|
, _crAttentionDir = AttentiveTo IM.empty
|
|
, _crAwarenessLevel = IM.empty
|
|
, _crVision = defaultVision
|
|
, _crAudition = defaultAudition
|
|
}
|
|
defaultVision :: Vision
|
|
defaultVision = Eyes
|
|
{ _viFOV = f
|
|
, _viDist = g
|
|
}
|
|
where
|
|
f x | abs x < 0.5 * pi = 1
|
|
| otherwise = 0
|
|
g x | x > 500 = 0
|
|
| otherwise = 1
|
|
defaultAudition :: Audition
|
|
defaultAudition = Ears
|
|
{ _auDist = \x -> x * x
|
|
}
|
|
defaultIntention :: Intention
|
|
defaultIntention = Intention
|
|
{ _targetCr = Nothing
|
|
, _mvToPoint = Nothing
|
|
, _viewPoint = Nothing
|
|
}
|
|
defaultChaseMvType :: CrMvType
|
|
defaultChaseMvType = ChaseMvType
|
|
{ _mvSpeed = 3
|
|
, _mvTurnRad = f
|
|
, _mvTurnJit = 0.2
|
|
}
|
|
where
|
|
f x | x > pi / 4 = 0.2
|
|
| otherwise = 0.05
|
|
defaultAimMvType :: CrMvType
|
|
defaultAimMvType = AimMvType
|
|
{ _mvSpeed = 3
|
|
, _mvTurnRad = const 0.2
|
|
, _mvTurnJit = 0.05
|
|
, _mvAimSpeed = f
|
|
}
|
|
where
|
|
f x | x > pi/8 = 0.2
|
|
| otherwise = 0.01
|
|
defaultAimingCrit :: Creature
|
|
defaultAimingCrit = defaultCreature { _crMvType = defaultAimMvType }
|
|
|
|
defaultState :: CreatureState
|
|
defaultState = CrSt
|
|
{ _crDamage = []
|
|
, _crPastDamage = V.fromList $ replicate 20 []
|
|
, _crSpState = GenCr
|
|
, _crDropsOnDeath = DropAll
|
|
}
|
|
defaultEquipment :: Item
|
|
defaultEquipment = Equipment
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericEquipment"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = \_ -> (,) emptySH $ setLayer 0 $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = defaultItZoom
|
|
, _itAimZoom = defaultItZoom
|
|
, _itInvColor = yellow
|
|
, _itInvDisplay = _itName
|
|
, _itAimStance = LeaveHolstered
|
|
}
|
|
defaultItZoom :: ItZoom
|
|
defaultItZoom = ItZoom 20 0.2 1
|
|
defaultConsumable :: Item
|
|
defaultConsumable = Consumable
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericConsumable"
|
|
, _itMaxStack = 9
|
|
, _itAmount = 1
|
|
, _cnEffect = \_ _ -> Nothing
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ color blue $ circleSolid 3
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itID = Nothing
|
|
, _itInvColor = blue
|
|
, _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
|
|
, _itEffect = wpRecock
|
|
, _itHammer = HammerUp
|
|
, _itAimStance = LeaveHolstered
|
|
}
|
|
defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
|
|
defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds')
|
|
where
|
|
(ps,ds') = partition isPoison ds
|
|
isPoison PoisonDam{} = True
|
|
isPoison _ = False
|
|
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
|
|
doPoisonDam = over crHP (\hp -> hp - poisonDam)
|
|
|
|
applyIndividualDamage :: DamageType -> Creature -> (World -> World, Creature)
|
|
applyIndividualDamage (Concussive amount fromDir push pushexp pushRad) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount)
|
|
$ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- fromDir)))
|
|
cr
|
|
)
|
|
where
|
|
pushAmount
|
|
| dist (_crPos cr) fromDir == 0 = 0
|
|
| otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
|
|
applyIndividualDamage (TorqueDam amount rot) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount) $ over crDir (+ rot) cr)
|
|
applyIndividualDamage (PushDam amount pback) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount) $ over crPos (+.+ ((1/_crMass cr) *.* pback )) cr
|
|
)
|
|
applyIndividualDamage dt cr
|
|
= ( id , over crHP (\hp -> hp - _dmAmount dt) cr )
|
|
defaultFlIt :: FloorItem
|
|
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = V2 0 0, _flItID = 0}
|
|
defaultIt :: Item
|
|
defaultIt = Consumable
|
|
{ _itIdentity = Medkit25
|
|
, _itName = "defaultIt"
|
|
, _itMaxStack = 3
|
|
, _itAmount = 2
|
|
, _cnEffect = const return
|
|
, _itFloorPict = \_ -> (,) emptySH $ onLayer FlItLayer $ polygon $ square 3
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itID = Nothing
|
|
, _itInvDisplay = _itName
|
|
, _itInvColor = blue
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
, _itAimStance = LeaveHolstered
|
|
}
|
|
defaultMachine :: Machine
|
|
defaultMachine = Machine
|
|
{ _mcID = 0
|
|
, _mcWallIDs = []
|
|
, _mcUpdate = const id
|
|
, _mcDraw = const mempty
|
|
, _mcPos = V2 0 0
|
|
, _mcDir = 0
|
|
, _mcHP = 100
|
|
, _mcSensor = 0
|
|
}
|
|
|
|
defaultDrawButton :: Color -> Button -> SPic
|
|
defaultDrawButton col bt =
|
|
( translateSHz 15 . colorSH col $ upperPrismPoly 5 buttonGeometry
|
|
, mempty
|
|
)
|
|
where
|
|
buttonGeometry
|
|
| _btState bt == BtOff = rectWH width 5
|
|
| otherwise = rectNSEW (-3) (-5) width (-width)
|
|
width = 8
|
|
defaultButton :: Button
|
|
defaultButton = Button
|
|
{ _btPict = defaultDrawButton (dark red)
|
|
, _btPos = V2 0 0
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> set (buttons . ix (_btID b) . btState) BtNoLabel
|
|
. soundStart (LeverSound 0) (_btPos b) click1S Nothing $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
defaultPT :: Prop
|
|
defaultPT = Projectile
|
|
{ _pjPos = V2 0 0
|
|
, _pjStartPos = V2 0 0
|
|
, _pjVel = V2 0 0
|
|
, _prDraw = const mempty
|
|
, _pjID = 0
|
|
, _pjUpdate = const id
|
|
}
|
|
defaultPP :: PressPlate
|
|
defaultPP = PressPlate
|
|
{ _ppPict = onLayer PressPlateLayer . color (dim . dim $ bright blue) $ circleSolid 5
|
|
, _ppPos = V2 0 0
|
|
, _ppRot = 0
|
|
, _ppEvent = const id
|
|
, _ppID = -1
|
|
, _ppText = "Pressure plate"
|
|
}
|
|
defaultTLS :: TempLightSource
|
|
defaultTLS = TLS
|
|
{ _tlsPos = 0
|
|
, _tlsRad = 0
|
|
, _tlsIntensity = 0.5
|
|
, _tlsUpdate = f
|
|
, _tlsTime = 1
|
|
}
|
|
where
|
|
f _ t
|
|
| _tlsTime t <= 0 = Nothing
|
|
| otherwise = Just $ t & tlsTime -~ 1
|