283 lines
8.2 KiB
Haskell
283 lines
8.2 KiB
Haskell
{-# LANGUAGE BangPatterns #-}
|
|
{- |
|
|
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.Creature.Stance.Data
|
|
import Dodge.Creature.State.Data
|
|
import Dodge.Creature.Rationality.Data
|
|
import Dodge.Creature.AlertLevel.Data
|
|
import Dodge.Data.Menu
|
|
import Dodge.SoundLogic
|
|
import Dodge.Base
|
|
import Dodge.Picture.Layer
|
|
import Dodge.Config.Data
|
|
import Dodge.Config.KeyConfig
|
|
import Geometry
|
|
import Picture
|
|
import qualified DoubleStack as DS
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Data.Graph.Inductive.Graph hiding ((&))
|
|
import Data.List
|
|
{- Indestructible wall. -}
|
|
defaultWall = Wall
|
|
{ _wlLine = ((0,0),(50,0))
|
|
, _wlID = 0
|
|
, _wlColor = greyN 0.6
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
}
|
|
{- Indestructible see-through wall. -}
|
|
defaultCrystalWall = Wall
|
|
{ _wlLine = ((0,0),(50,0))
|
|
, _wlID = 0
|
|
, _wlColor = withAlpha 0.5 aquamarine
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = True
|
|
}
|
|
|
|
{-
|
|
Door that opens on approach.
|
|
Pathable. -}
|
|
defaultAutoDoor = Door
|
|
{ _wlLine = ((0,0),(50,0))
|
|
, _wlID = 0
|
|
, _doorMech = id
|
|
, _wlColor = light $ dim $ dim $ dim $ yellow
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
, _doorPathable = True
|
|
, _drPositions = DS.singleton ((0,0),(50,0))
|
|
}
|
|
{-
|
|
Non-pathable door.
|
|
-}
|
|
defaultDoor = Door
|
|
{ _wlLine = ((0,0),(50,0))
|
|
, _wlID = 0
|
|
, _doorMech = id
|
|
, _wlColor = light $ dim $ dim $ dim $ yellow
|
|
, _wlSeen = False
|
|
, _wlIsSeeThrough = False
|
|
, _doorPathable = False
|
|
, _drPositions = DS.singleton ((0,0),(50,0))
|
|
}
|
|
defaultCreature :: Creature
|
|
defaultCreature = Creature
|
|
{ _crPos = (0,0)
|
|
, _crOldPos = (0,0)
|
|
, _crVel = (0,0)
|
|
, _crDir = 0
|
|
, _crID = 1
|
|
, _crPict = const $ onLayer CrLayer $ circleSolid 10
|
|
, _crUpdate = \ w f cr -> (f , Just cr)
|
|
, _crRad = 10
|
|
, _crMass = 10
|
|
, _crHP = 100
|
|
, _crMaxHP = 150
|
|
, _crInv = IM.empty
|
|
, _crInvSel = 0
|
|
, _crState = defaultState
|
|
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
|
|
, _crApplyDamage = defaultApplyDamage
|
|
, _crStance = Stance {_carriage=Walking 0 0,_posture=AtEase}
|
|
, _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
|
|
, _crMeleeCooldown = Nothing
|
|
, _crAwakeLevel = Vigilant
|
|
, _crAttentionDir = AttentiveTo []
|
|
, _crAwarenessLevel = IM.empty
|
|
, _crFaction = NoFaction
|
|
, _crTarget = Nothing
|
|
}
|
|
defaultState = CrSt
|
|
{ _goals = []
|
|
, _crDamage = []
|
|
, _crPastDamage = []
|
|
, _crSpState = GenCr
|
|
, _crDropsOnDeath = DropAmount 1
|
|
}
|
|
defaultEquipment = Equipment
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericEquipment"
|
|
, _itMaxStack = 1
|
|
, _itAmount = 1
|
|
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \cr _ -> blank
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
, _itID = Nothing
|
|
, _itAimingSpeed = 1
|
|
, _itAimingRange = 0
|
|
, _itZoom = defaultItZoom
|
|
, _itInvColor = yellow
|
|
, _itInvDisplay = _itName
|
|
}
|
|
defaultItZoom = ItZoom 20 0.2 1 20 0.2 1
|
|
defaultConsumable :: Item
|
|
defaultConsumable = Consumable
|
|
{ _itIdentity = Generic
|
|
, _itName = "genericConsumable"
|
|
, _itMaxStack = 9
|
|
, _itAmount = 1
|
|
, _cnEffect = \_ _ -> Nothing
|
|
, _itFloorPict = onLayer FlItLayer $ color blue $ circleSolid 3
|
|
, _itEquipPict = \_ _ -> blank
|
|
, _itID = Nothing
|
|
, _itInvColor = blue
|
|
, _itInvDisplay = \it -> _itName it ++ " x" ++ show (_itAmount it)
|
|
, _itEffect = wpRecock
|
|
, _itHammer = HammerUp
|
|
}
|
|
defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
|
|
defaultApplyDamage ds cr = (id, doPoisonDam $ foldr (\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 from push pushexp pushRad) cr
|
|
= ( id
|
|
, over crHP (\hp -> hp - amount)
|
|
$ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- from)))
|
|
cr
|
|
)
|
|
where pushAmount | dist (_crPos cr) from == 0
|
|
= 0
|
|
| otherwise = min 5 $
|
|
(push*5*pushRad / (dist (_crPos cr) from * _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 = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = (0,0), _flItID = 0}
|
|
defaultIt = Consumable
|
|
{ _itIdentity = Medkit25
|
|
, _itName = "defaultIt"
|
|
, _itMaxStack = 3
|
|
, _itAmount = 2
|
|
, _cnEffect = \ _ -> return
|
|
, _itFloorPict = onLayer FlItLayer $ polygon [(-3,-3),(-3,3),(3,3),(3,-3)]
|
|
, _itEquipPict = \cr _ -> blank
|
|
, _itID = Nothing
|
|
, _itInvDisplay = _itName
|
|
, _itInvColor = blue
|
|
, _itEffect = NoItEffect
|
|
, _itHammer = HammerUp
|
|
}
|
|
defaultButton = Button
|
|
{ _btPict = onLayer WlLayer $ color red $ polygon $ rectNSEW 5 (-5) 10 (-10)
|
|
, _btPos = (0,0)
|
|
, _btRot = 0
|
|
, _btEvent = \b w -> set (buttons . ix (_btID b) . btPict)
|
|
(onLayer WlLayer $ color red $ polygon $ rectNSEW (-4) (-5) 10 (-10))
|
|
. set (buttons . ix (_btID b) . btState) BtNoLabel
|
|
. soundOnce 1 $ w
|
|
, _btID = 0
|
|
, _btText = "Button"
|
|
, _btState = BtOff
|
|
}
|
|
defaultPT = Projectile
|
|
{ _pjPos = (0,0)
|
|
, _pjStartPos = (0,0)
|
|
, _pjVel = (0,0)
|
|
, _pjPict = blank
|
|
, _pjID = 0
|
|
, _pjUpdate = id
|
|
}
|
|
defaultPP = PressPlate
|
|
{ _ppPict = onLayer PressPlateLayer $ color (dim $ dim $ bright $ blue) $ circleSolid 5
|
|
, _ppPos = (0,0)
|
|
, _ppRot = 0
|
|
, _ppEvent = \pp -> id
|
|
, _ppID = -1
|
|
, _ppText = "Pressure plate"
|
|
}
|
|
-- }}}
|
|
|
|
defaultWorld = World
|
|
{ _keys = S.empty
|
|
, _mouseButtons = S.empty
|
|
, _cameraCenter = (0,0)
|
|
, _cameraRot = 0
|
|
, _cameraZoom = 1
|
|
, _cameraViewFrom = (0,0)
|
|
, _creatures = IM.empty
|
|
, _creaturesZone = IM.empty
|
|
, _clouds = IM.empty
|
|
, _cloudsZone = IM.empty
|
|
, _itemPositions = IM.empty
|
|
, _projectiles = IM.empty
|
|
, _particles = []
|
|
, _staticWalls = []
|
|
, _walls = IM.empty
|
|
, _wallsZone = IM.empty
|
|
, _forceFields = IM.empty
|
|
, _floorItems = IM.empty
|
|
, _randGen = mkStdGen 2
|
|
, _mousePos = (0,0)
|
|
, _testString = []
|
|
, _yourID = 0
|
|
, _worldEvents = id
|
|
, _pressPlates = IM.empty
|
|
, _buttons = IM.empty
|
|
, _soundQueue = []
|
|
, _sounds = M.empty
|
|
, _corpses = IM.empty
|
|
, _decorations = IM.empty
|
|
, _storedLevel = Nothing
|
|
, _menuLayers = [LevelMenu 1]
|
|
, _worldState = M.empty
|
|
, _worldTriggers = S.empty
|
|
, _clickMousePos = (0,0)
|
|
, _pathGraph = Data.Graph.Inductive.Graph.empty
|
|
, _pathGraph' = []
|
|
, _pathPoints = IM.empty
|
|
, _pathInc = M.empty
|
|
, _carteDisplay = False
|
|
, _carteCenter = (0,0)
|
|
, _carteZoom = 0.5
|
|
, _carteRot = 0
|
|
, _lightSources = IM.empty
|
|
, _tempLightSources = [youLight]
|
|
, _closeActiveObjects = []
|
|
, _seenLocations = IM.fromList
|
|
[(0, (_crPos . you, "CURRENT POSITION"))
|
|
,(1, (const (0,0) , "START POSITION"))
|
|
]
|
|
, _selLocation = 0
|
|
, _keyConfig = defaultKeyConfigSDL
|
|
, _varMovementSpeedModifier = 3
|
|
, _varMovementStrafeSpeedModifier = 3
|
|
, _debugMode = True
|
|
, _config = defaultConfig
|
|
, _sideEffects = []
|
|
, _doneSideEffects = []
|
|
}
|
|
youLight =
|
|
TLS { _tlsPos = (0,0)
|
|
,_tlsRad = 300
|
|
,_tlsIntensity = 0.1
|
|
,_tlsUpdate = \w _ -> (w, Just (youLight {_tlsPos = _crPos (you w)}))
|
|
}
|
|
|
|
|
|
|