Files
loop/src/Dodge/Default.hs
T

274 lines
7.2 KiB
Haskell

{- |
Module : Dodge.Default
Description : Instances of data structures
This module contains prototypical data structures.
-}
module Dodge.Default
( module Dodge.Default
, module Dodge.Default.Item
, module Dodge.Default.LightSource
) where
import Dodge.Default.Weapon
import Dodge.Default.LightSource
import Dodge.Default.Item
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.Text as T
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
, _crType = defaultCreatureSkin
, _crUpdate = const id
, _crRad = 10
, _crMass = 10
, _crHP = 100
, _crMaxHP = 150
, _crInv = IM.empty
, _crInvSel = InvSel 0 NoInvSelAction
, _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 [] [] (StrategyActions WatchAndWait [StartSentinelPost]) [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 :: CreatureType
defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3)
defaultInanimate :: Creature
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate
defaultCreatureMemory :: Memory
defaultCreatureMemory = Memory
{ _soundsToInvestigate = []
, _nodesSearched = []
}
defaultInvSize :: Int
defaultInvSize = 20
defaultPerceptionState :: Perception
defaultPerceptionState = Perception
{ _cpVigilance = Lethargic
, _cpAttention = AttentiveTo IM.empty
, _cpAwareness = IM.empty
, _cpVision = defaultVision
, _cpAudition = 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
{ _csDamage = []
-- , _crPastDamage = V.fromList $ replicate 20 []
, _csSpState = GenCr
, _csDropsOnDeath = DropAll
}
defaultEquipment :: Item
defaultEquipment = defaultItem
{ _itInvColor = yellow
, _itUse = EquipUse defaultEquip
, _itAttachment = NoItAttachment
}
defaultItZoom :: ItZoom
defaultItZoom = ItZoom 20 0.2 1
defaultConsumable :: Item
defaultConsumable = defaultItem
{ _itConsumption = ItemItselfConsumable {_icAmount = 1}
, _itInvColor = blue
}
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 = const id
, _mcApplyDamage = \_ _ -> id
, _mcDraw = const mempty
, _mcColor = white
, _mcPos = V2 0 0
, _mcDir = 0
, _mcHP = 1000
, _mcSensor = NoSensor
, _mcDamage = []
, _mcLSs = []
, _mcType = StaticMachine
, _mcName = ""
, _mcTermMID = Nothing
}
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 = reverse $ rectNSWE 10 (-1) (-width) width
| otherwise = reverse $ rectNSWE 2 (-1) (-width) width
width = 8
defaultTerminal :: Terminal
defaultTerminal = Terminal
{ _tmID = 0
, _tmProgram = \_ _ -> []
, _tmButtonID = 0
, _tmMachineID = 0
, _tmName = "TESTTERMINAL"
, _tmDisplayedLines = []
, _tmFutureLines = []
, _tmMaxLines = 14
, _tmTitle = "TERMINAL IN LOCATION"
, _tmInput = defaultTerminalInput
, _tmScrollCommands = []
, _tmWriteCommands = []
, _tmDeathEffect = const id
, _tmStatus = TerminalOff
, _tmCommandHistory = []
, _tmToggles = M.empty
}
defaultTerminalInput :: TerminalInput
defaultTerminalInput = TerminalInput
{ _tiText = T.pack ""
, _tiFocus = True
, _tiSel = (0,0)
}
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
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
}
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"
}
upHammer :: HammerType
upHammer = HasHammer HammerUp
defaultProximitySensor :: Sensor
defaultProximitySensor = ProximitySensor
{ _proxStatus = NotClose
, _proxDist = 40
, _proxRequirement = RequireImpossible
, _sensToggle = False
}