311 lines
8.2 KiB
Haskell
311 lines
8.2 KiB
Haskell
{- |
|
|
Module : Dodge.Default
|
|
Description : Instances of data structures
|
|
|
|
This module contains prototypical data structures.
|
|
-}
|
|
module Dodge.Default where
|
|
import Dodge.Default.Weapon
|
|
import Dodge.Data
|
|
import Dodge.SoundLogic
|
|
import Dodge.Wall.Delete
|
|
import Dodge.Creature.Damage
|
|
import Dodge.Creature.Picture
|
|
import Geometry
|
|
import Picture
|
|
import ShapePicture
|
|
import Shape
|
|
|
|
import Control.Lens
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map.Strict as M
|
|
--import qualified Data.Vector as V
|
|
--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
|
|
, _crTwist = 0
|
|
, _crID = 1
|
|
, _crPict = basicCrPict
|
|
, _crSkin = defaultCreatureSkin
|
|
, _crUpdate = const id
|
|
, _crRad = 10
|
|
, _crMass = 10
|
|
, _crHP = 100
|
|
, _crMaxHP = 150
|
|
, _crInv = IM.empty
|
|
, _crInvSel = 0
|
|
, _crInvCapacity = 25
|
|
, _crInvLock = False
|
|
, _crInvEquipped = mempty
|
|
, _crLeftInvSel = Nothing
|
|
, _crState = defaultState
|
|
, _crCorpse = basicCrCorpse
|
|
, _crApplyDamage = defaultApplyDamage
|
|
, _crPastDamage = 0
|
|
, _crEquipment = M.empty
|
|
, _crStance = Stance
|
|
{_carriage=Walking 0 WasLeftForward
|
|
,_posture=AtEase
|
|
,_strideLength = yourDefaultStrideLength
|
|
}
|
|
, _crVocalization = Mute
|
|
, _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper]
|
|
, _crPerception = defaultPerceptionState
|
|
, _crMemory = defaultCreatureMemory
|
|
, _crMeleeCooldown = 0
|
|
, _crFaction = NoFaction
|
|
, _crIntention = defaultIntention
|
|
, _crGroup = LoneWolf
|
|
, _crMvType = defaultAimMvType
|
|
, _crHammerPosition = HammerUp
|
|
, _crName = "DEFAULTCRNAME"
|
|
, _crStatistics = CreatureStatistics 10 10 10
|
|
, _crCamouflage = FullyVisible
|
|
}
|
|
defaultCreatureSkin :: CreatureSkin
|
|
defaultCreatureSkin = CreatureSkin (greyN 0.9) (light4 green) (greyN 0.3)
|
|
|
|
defaultInanimate :: Creature
|
|
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
|
|
|
|
defaultCreatureMemory :: MemoryState
|
|
defaultCreatureMemory = MemoryState
|
|
{ _soundsToInvestigate = []
|
|
}
|
|
|
|
defaultInvSize :: Int
|
|
defaultInvSize = 20
|
|
|
|
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 = id
|
|
}
|
|
defaultIntention :: Intention
|
|
defaultIntention = Intention
|
|
{ _targetCr = Nothing
|
|
, _mvToPoint = Nothing
|
|
, _viewPoint = Nothing
|
|
}
|
|
defaultChaseMvType :: CrMvType
|
|
defaultChaseMvType = CrMvType
|
|
{ _mvSpeed = 2
|
|
, _mvTurnRad = f
|
|
, _mvTurnJit = 0.2
|
|
, _mvAimSpeed = g
|
|
}
|
|
where
|
|
g x | x > pi/8 = 0.2
|
|
| otherwise = 0.01
|
|
f x | x > pi / 4 = 0.2
|
|
| otherwise = 0.05
|
|
defaultAimMvType :: CrMvType
|
|
defaultAimMvType = CrMvType
|
|
{ _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 }
|
|
|
|
yourDefaultSpeed :: Float
|
|
yourDefaultSpeed = 3
|
|
|
|
yourDefaultStrideLength :: Int
|
|
yourDefaultStrideLength = 40
|
|
|
|
defaultState :: CreatureState
|
|
defaultState = CrSt
|
|
{ _crDamage = []
|
|
-- , _crPastDamage = V.fromList $ replicate 20 []
|
|
, _crSpState = GenCr
|
|
, _crDropsOnDeath = DropAll
|
|
}
|
|
defaultEquipment :: Item
|
|
defaultEquipment = Item
|
|
{ _itCurseStatus = Uncursed
|
|
, _itType = NOTDEFINED
|
|
, _itName = "genericEquipment"
|
|
-- ,_itIdentity = Generic
|
|
, _itEquipPict = \_ _ -> (,) emptySH blank
|
|
, _itEffect = NoItEffect
|
|
, _itID = Nothing
|
|
, _itIsHeld = False
|
|
, _itInvColor = yellow
|
|
, _itInvDisplay = \it -> [_itName it]
|
|
, _itInvSize = 1
|
|
, _itInvPos = Nothing
|
|
, _itDimension = defItDimCol yellow
|
|
, _itConsumption = NoConsumption
|
|
, _itUse = EquipUse defaultEquip
|
|
, _itAttachment = NoItAttachment
|
|
, _itParams = NoParams
|
|
, _itTweaks = NoTweaks
|
|
, _itModules = M.empty
|
|
, _itScope = NoScope
|
|
, _itTargeting = NoTargeting
|
|
, _itValue = defaultItemValue
|
|
}
|
|
defaultItZoom :: ItZoom
|
|
defaultItZoom = ItZoom 20 0.2 1
|
|
defaultConsumable :: Item
|
|
defaultConsumable = Item
|
|
{ _itUse = NoUse
|
|
-- , _itIdentity = Generic
|
|
, _itInvSize = 1
|
|
, _itCurseStatus = Uncursed
|
|
, _itName = "genericConsumable"
|
|
, _itConsumption = ItemItselfConsumable {_itAmount = 1}
|
|
, _itEquipPict = \_ _ -> mempty
|
|
, _itID = Nothing
|
|
, _itInvPos = Nothing
|
|
, _itIsHeld = False
|
|
, _itInvColor = blue
|
|
, _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)]
|
|
, _itEffect = NoItEffect
|
|
, _itAttachment = NoItAttachment
|
|
, _itType = NoCombineType
|
|
, _itParams = NoParams
|
|
, _itDimension = defItDimCol blue
|
|
, _itTweaks = NoTweaks
|
|
, _itModules = M.empty
|
|
, _itScope = NoScope
|
|
, _itTargeting = NoTargeting
|
|
, _itValue = defaultItemValue
|
|
}
|
|
|
|
defaultFlIt :: FloorItem
|
|
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
|
|
defaultMachine :: Machine
|
|
defaultMachine = Machine
|
|
{ _mcID = 0
|
|
, _mcWallIDs = mempty
|
|
, _mcUpdate = defaultMachineUpdate
|
|
, _mcDeath = \_ -> id
|
|
, _mcApplyDamage = \_ _ -> id
|
|
, _mcDraw = const mempty
|
|
, _mcColor = white
|
|
, _mcPos = V2 0 0
|
|
, _mcDir = 0
|
|
, _mcHP = 1000
|
|
, _mcSensor = NoSensor
|
|
, _mcDamage = []
|
|
, _mcLSs = []
|
|
, _mcType = StaticMachine
|
|
, _mcName = ""
|
|
}
|
|
defaultMachineUpdate :: Machine -> World -> World
|
|
defaultMachineUpdate mc
|
|
| _mcHP mc < 1 = (machines %~ IM.delete mcid)
|
|
. deleteWallIDs (_mcWallIDs mc)
|
|
| otherwise = machines . ix mcid %~ ( (mcDamage .~ []) . (mcHP -~ dams) )
|
|
where
|
|
dams = sum $ map _dmAmount $ _mcDamage mc
|
|
mcid = _mcID mc
|
|
|
|
defaultDrawButton :: Color -> Button -> SPic
|
|
defaultDrawButton col bt =
|
|
( translateSHz 15 . colorSH col $ upperPrismPoly 5 buttonGeometry
|
|
, mempty
|
|
)
|
|
where
|
|
buttonGeometry
|
|
| _btState bt == BtOff = rectNSEW 10 (-1) width (-width)
|
|
| otherwise = rectNSEW 2 (-1) width (-width)
|
|
width = 8
|
|
defaultTerminal :: Terminal
|
|
defaultTerminal = Terminal 0 (\_ _ -> NoTerminalParams) 0 0 "TESTTERMINAL"
|
|
|
|
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
|
|
, _btTerminal = Nothing
|
|
, _btName = ""
|
|
}
|
|
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 = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
|
|
, _ppPos = V2 0 0
|
|
, _ppRot = 0
|
|
, _ppEvent = const id
|
|
, _ppID = -1
|
|
, _ppText = "Pressure plate"
|
|
}
|
|
defaultLS :: LightSource
|
|
defaultLS = LS
|
|
{ _lsID = 0
|
|
, _lsParam = LSParam
|
|
{ _lsPos = V3 0 0 50
|
|
, _lsRad = 700
|
|
, _lsCol = 0.6
|
|
}
|
|
, _lsDir = 0
|
|
, _lsPict = defLSPic
|
|
}
|
|
defLSPic :: LightSource -> Picture
|
|
defLSPic ls = setLayer BloomNoZWrite . translate3 (_lsPos $ _lsParam ls) . color col $ circleSolid 4
|
|
where
|
|
col = V4 r g b 2
|
|
V3 r g b = _lsCol $ _lsParam ls
|
|
defaultTLS :: TempLightSource
|
|
defaultTLS = TLS
|
|
{ _tlsParam = LSParam
|
|
{ _lsPos = 0
|
|
, _lsRad = 0
|
|
, _lsCol = 0.5
|
|
}
|
|
, _tlsUpdate = f
|
|
, _tlsTime = 1
|
|
}
|
|
where
|
|
f _ t
|
|
| _tlsTime t <= 0 = Nothing
|
|
| otherwise = Just $ t & tlsTime -~ 1
|
|
|
|
upHammer :: HammerType
|
|
upHammer = HasHammer HammerUp
|
|
|