{- | 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.Default.Weapon import Dodge.Data import Dodge.SoundLogic import Dodge.Picture.Layer import Dodge.Wall.Delete 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 = yourDefaultStrideLength } , _crVocalization = Mute , _crActionPlan = ActionPlan [] [] WatchAndWait [LiveLongAndProsper] , _crPerception = defaultPerceptionState , _crMemory = defaultCreatureMemory , _crMeleeCooldown = 0 , _crFaction = NoFaction , _crIntention = defaultIntention , _crGroup = LoneWolf , _crMvType = defaultAimMvType } 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 = \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 } yourDefaultSpeed :: Float yourDefaultSpeed = 4 yourDefaultStrideLength :: Int yourDefaultStrideLength = 40 defaultState :: CreatureState defaultState = CrSt { _crDamage = [] , _crPastDamage = V.fromList $ replicate 20 [] , _crSpState = GenCr , _crDropsOnDeath = DropAll } defaultEquipment :: Item defaultEquipment = Equipment { _itIdentity = Generic , _itCurseStatus = Uncursed , _itName = "genericEquipment" , _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 , _itDimension = defaultItemDimension } defaultItZoom :: ItZoom defaultItZoom = ItZoom 20 0.2 1 defaultConsumable :: Item defaultConsumable = Consumable { _itIdentity = Generic , _itCurseStatus = Uncursed , _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 , _itDimension = defaultItemDimension } 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 , _itDimension = defaultItemDimension , _itCurseStatus = Uncursed , _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 = mempty , _mcUpdate = defaultMachineUpdate , _mcDraw = const mempty , _mcPos = V2 0 0 , _mcDir = 0 , _mcHP = 1000 , _mcSensor = 0 , _mcDamage = [] , _mcLSs = [] , _mcType = StaticMachine } 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 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" } defaultLS :: LightSource defaultLS = LS { _lsID = 0 , _lsPos = V3 0 0 50 , _lsDir = 0 , _lsRad = 700 , _lsIntensity = 0.6 , _lsPict = defLSPic } defLSPic :: LightSource -> Picture defLSPic ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4 where col = V4 r g b 2 V3 r g b = _lsIntensity ls 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