{- |
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.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.Map.Strict as M
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
    , _crTwist  = 0
    , _crID     = 1
    , _crPict   = \_ _ _ -> mempty
    , _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 = 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
    }
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 = \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 = Item
    { _itCurseStatus = Uncursed
    , _itType = NOTDEFINED
    , _itName = "genericEquipment"
--    ,_itIdentity = Generic
    , _itEquipPict = \_ _ -> (,) emptySH blank
    , _itEffect = NoItEffect
    , _itID = Nothing
    , _itInvColor = yellow
    , _itInvDisplay = \it -> [_itName it]
    , _itInvSize = 1
    , _itDimension = defItDimCol yellow
    , _itConsumption = NoConsumption
    , _itUse = EquipUse {_eqUse = \_ _ -> id}
    , _itScroll = \ _ _ -> id
    , _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
    , _itInvColor = blue
    , _itInvDisplay = \it -> [_itName it ++ " x" ++ show (_itAmount $ _itConsumption it)]
    , _itEffect = NoItEffect
    , _itScroll = \_ _ -> id
    , _itAttachment = NoItAttachment
    , _itType = NoCombineType
    , _itParams = NoParams
    , _itDimension = defItDimCol blue
    , _itTweaks = NoTweaks
    , _itModules = M.empty 
    , _itScope = NoScope
    , _itTargeting = NoTargeting
    , _itValue = defaultItemValue
    }
defaultApplyDamage :: [Damage] -> 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 Damage{_dmType=PoisonDam} = True
    isPoison _ = False
    poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
    doPoisonDam = over crHP (\hp -> hp - poisonDam)

applyDamageEffect :: Damage -> DamageEffect -> Creature -> Creature
applyDamageEffect dm de cr = case de of
    NoDamageEffect -> cr
    PushDamage push pushexp pushRad -> cr 
        & crPos %~ (+.+ (pushAmount *.* squashNormalizeV (_crPos cr -.- fromDir))) 
      where
        pushAmount
            | dist (_crPos cr) fromDir == 0 = 0
            | otherwise = min 5 $ (push*5*pushRad / (dist (_crPos cr) fromDir * _crMass cr))**pushexp
    PushBackDamage pback -> cr
        & crPos %~ (+.+ ((1/_crMass cr) *.* pback ))
    TorqueDamage rot -> cr & crDir +~ rot
  where
    fromDir = _dmFrom dm

applyIndividualDamage :: Damage -> Creature -> (World -> World, Creature)
applyIndividualDamage dm cr = ( id
    , cr
      & crHP -~ _dmAmount dm
      & applyDamageEffect dm (_dmEffect dm)
    )

defaultFlIt :: FloorItem
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultConsumable, _flItPos = V2 0 0, _flItID = 0}
defaultMachine :: Machine
defaultMachine = Machine
    { _mcID = 0
    , _mcWallIDs = mempty
    , _mcUpdate = defaultMachineUpdate
    , _mcDraw = const mempty
    , _mcPos = V2 0 0
    , _mcDir = 0
    , _mcHP = 1000
    , _mcSensorAmount = 0
    , _mcSensorToggle = False
    , _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
    , _btTerminalParams = NoTerminalParams
    }
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
    , _lsParam = LSParam
        { _lsPos = V3 0 0 50
        , _lsRad = 700
        , _lsCol = 0.6
        }
    , _lsDir = 0
    , _lsPict = defLSPic 
    }
defLSPic :: LightSource -> Picture
defLSPic ls = setLayer 1 . 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