{- |
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