loop/src/Dodge/Creature/Inanimate.hs

--{-# LANGUAGE TupleSections #-}
{-
Inanimate objects such as lamps, barrels, etc
-}
module Dodge.Creature.Inanimate
    ( lamp
    , colorLamp
    , barrel
    , explosiveBarrel
    ) where
import Dodge.Data
import Dodge.WorldEvent.Explosion
import Dodge.Creature.Picture
--import Dodge.Creature.Stance.Data
import Dodge.Picture.Layer
import Dodge.Default
import Dodge.Creature.State
import Dodge.LightSource
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.Sound
import Dodge.Creature.Update
import Picture
import qualified IntMapHelp as IM
import Geometry
--import Geometry.Data
--import Geometry.Vector3D
import Polyhedra
import Shape
import Dodge.WorldEvent
import Dodge.SoundLogic

import System.Random
import Data.List
import Control.Lens
import Data.Monoid

defaultInanimate :: Creature
defaultInanimate = defaultCreature & crActionPlan .~ Inanimate

colorLamp 
    :: Point3   -- color of lamp
    -> Float    -- height of lamp
    -> Creature
colorLamp col h = defaultInanimate
    { _crUpdate = initialiseColorLamp col h
    , _crHP = 100
    , _crPict = picAtCrPosNoRot (lampCrPic h)
    , _crRad = 3
    , _crMass = 3
    }

lamp :: Float -> Creature
lamp h = defaultInanimate
    { _crUpdate = initialiseLamp h
    , _crHP = 100
    , _crPict = picAtCrPosNoRot (lampCrPic h)
    , _crRad = 3
    , _crMass = 3
    }
-- it is not clear that any of the attempts with Foldl help at all here
lampCrPic :: Float -> Picture
lampCrPic h = pictures 
    [ setLayer 1 (setDepth h . color white $ circleSolid 3)
    , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
    ]
  where
    f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] 0 polyNum

--lTriFold :: a -> a -> L.Fold a [a]
--lTriFold s x = L.Fold (f s) (x,[]) snd
--  where
--    f s' (x1,l) x2 = (x2,s':x1:x2:l)
--
--preTriFold :: (a -> b) -> [a] -> [b]
--preTriFold f (s:x:xs) = L.fold (L.premap f $ lTriFold (f s) (f x)) xs
--preTriFold _ _ = []
--
--polyToTriFold :: [a] -> [a]
--polyToTriFold (s:x:xs) = L.fold (lTriFold s x) xs
--polyToTriFold _ = []

initialiseLamp :: Float -> CRUpdate
initialiseLamp = initialiseColorLamp 0.75

initialiseColorLamp :: Point3 -> Float -> CRUpdate
initialiseColorLamp col h cr _ = ( Endo addLS , Just $ cr & crUpdate .~ updateLamp h i)
  where
    i = _crID cr
    addLS w = w
        & lightSources %~ IM.insert lsid (lsColPosID col (V3 x y h) lsid)
        & creatures . ix i . crUpdate .~ updateLamp h lsid
      where
        lsid = IM.newKey $ _lightSources w
    (V2 x y) = _crPos cr

updateLamp :: Float -> Int -> CRUpdate
updateLamp h i = unrandUpdate handleLS internalUpdate
  where
    handleLS cr w 
        | _crHP cr < 0 = explosionFlashAt cPos 
                        $ mkSoundBreakGlass cPos w & lightSources %~ IM.delete i
        | otherwise    = w & lightSources . ix i . lsParam . lsPos .~ f cPos
      where
        cPos = _crPos cr
        f (V2 x y) = V3 x y h
    internalUpdate cr 
        | _crHP cr < 0 = Nothing
        | otherwise    = Just $ doDamage cr

barrel :: Creature
barrel = defaultInanimate
    { _crUpdate = updateBarrel
    , _crHP = 500
    , _crPict = picAtCrPos $ onLayer CrLayer $ pictures 
        [ color orange $ circleSolid 10
        , setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
        , color (greyN 0.5) $ circleSolid 8
        ]
    , _crState = defaultState 
        {_crSpState = Barrel []
        }
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    }

explosiveBarrel :: Creature
explosiveBarrel = defaultInanimate
    { _crUpdate = updateExpBarrel
    , _crHP = 400
    , _crPict = shapeAtCrPos
        . colorSH orange
        . upperPrismPoly 20
        $ polyCirc 4 10
    , _crState = defaultState 
        {_crSpState = Barrel []
        }
    , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
    ,_crApplyDamage = \_ c -> (id, c)
    }
updateBarrel 
    :: Creature 
    -> World
    -> (Endo World, Maybe Creature)
updateBarrel cr _
    | _crHP cr > 0 = (Endo id, newCr)
    | otherwise    = (Endo id, Nothing)
  where 
    newCr = Just $ doDamage cr

-- should generate the sparks externally using new random generators
updateExpBarrel 
    :: Creature 
    -> World
    -> (Endo World, Maybe Creature)
updateExpBarrel cr w 
    | _crHP cr > 0 = (Endo $ foldr (.) id pierceSparks . hiss, newCr)
    | otherwise    = (Endo $ makeExplosionAt (_crPos cr) . stopSounds , Nothing)
  where 
    g = _randGen w
    damages = _crDamage $ _crState cr
    pierceSparks :: [World -> World]
    pierceSparks 
      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
                            poss as times colids
    as =  randomRs (-0.7,0.7) g
    colids = randomRs (0,11) g
    times = randomRs (2,5) g
    poss = _piercedPoints $ _crSpState $ _crState cr
    --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages
    newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr
    --perforate :: DamageType -> Creature -> Creature
    --perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints)
    --                                                  ((:) $ int -.- _crPos cr) cr
    --perforate _ cr = cr
    applyFuseDamage cr' = cr' & crHP %~ 
        subtract (length . _piercedPoints . _crSpState $ _crState cr')
    hiss | null poss = id
         | otherwise  = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] (_crPos cr) foamSprayLoopS (Just 1)
    stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1)

damToExpBarrel :: [DamageType] -> Creature -> Creature
damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam
  where 
    (pierceDam,otherDam) = partition isPierce ds
    isPierce Piercing{} = True
    isPierce _             = False

damToExpBarrel' :: DamageType -> Creature -> Creature
damToExpBarrel' (Piercing amount _ int _) cr 
    = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) 
        $ over crHP (\hp -> hp - div amount 200) cr
damToExpBarrel' PoisonDam {} cr = cr
damToExpBarrel' SparkDam {}  cr = cr
damToExpBarrel' PushDam{_dmPushBack = v} cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v)
damToExpBarrel' dt             cr = cr Control.Lens.& crHP -~ _dmAmount dt