module Dodge.Prop.Gib where
import Dodge.Prop.Moving
--import Dodge.Zone
import Dodge.Base
import Dodge.Data
import Dodge.Damage
--import ShapePicture
import Shape
import Geometry
import Color
import LensHelp
import RandomHelp
--import Dodge.Base.NewID

import qualified Quaternion as Q
import Data.List (zip4)
import Data.Foldable

aGib :: Prop
aGib = PropZ
    {_prPos = 0
    ,_pjStartPos = 0
    ,_pjVel = 0
    ,_prDraw = \pr -> drawMovingShape pr (drawGib 3 pr)
    ,_pjID = 0
    ,_pjUpdate = fallSmallBounce
    ,_pjPosZ = 10
    ,_pjVelZ = 5
    ,_pjTimer = 20
    ,_pjQuat = Q.axisAngle (V3 1 0 0) 0
    ,_pjQuatSpin = Q.axisAngle (V3 1 1 0) 0.1
    ,_pjColor = white
    }
drawGib :: Float -> Prop -> Shape
drawGib x pr = flesh <> skin
  where
    flesh = colorSH (dark $ dark red)
        . translateSHz (negate x)
        $ upperPrismPoly (2*x) $ square x
    skin = colorSH (_pjColor pr)
        . translateSH (V3 1 1 (1 - x))
        $ upperPrismPoly (2*x) $ square x


addCrGibs :: Creature -> World -> World
addCrGibs cr w = case damageDirection $ _csDamage $ _crState cr of
    Nothing -> w
        & addGibAt 25 (_skinHead skin) cpos
        & addGibsAt 3 7 (_skinLower skin) cpos
        & addGibsAt 13 20 (_skinUpper skin) cpos
    Just d -> w
        & addGibsAtDir d 3 7 (_skinLower skin) cpos
        & addGibsAtDir d 13 20 (_skinUpper skin) cpos
        & addGibAtDir d 25 (_skinHead skin) cpos
  where
    skin = _crSkin cr
    cpos = _crPos cr

addGibsAt :: Float -> Float -> Color -> Point2 -> World -> World
addGibsAt minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels zspeeds quats hs)
    & randGen .~ newg
  where
    (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
    hs = replicateM 4 (state (randomR (minh,maxh))) & evalState $ _randGen w
    dirs = unitVectorAtAngle <$> (randsOnCirc 4 & evalState $ _randGen w)
    vels = zipWith (*.*) speeds dirs
    zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
    quats :: [Q.Quaternion Float]
    quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w

-- this is ugly because it is mostly copy-paste from addGibsAt
addGibsAtDir :: Float -> Float -> Float -> Color -> Point2 -> World -> World
addGibsAtDir dir minh maxh col p w = foldl' (flip $ addGib4 p col) w (zip4 vels zspeeds quats hs)
    & randGen .~ newg
  where
    (speeds,newg) = replicateM 4 (state (randomR (1,4))) & runState $ _randGen w
    hs = replicateM 4 (state (randomR (minh,maxh))) & evalState $ _randGen w
    dirs = unitVectorAtAngle <$> (randsSpread (dir-pi/4,dir+pi/4) 4 & evalState $ _randGen w)
    vels = zipWith (*.*) speeds dirs
    zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
    quats :: [Q.Quaternion Float]
    quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
  
addGib4 :: Point2 -> Color -> (Point2, Float, Q.Quaternion Float, Float)
    -> World -> World
addGib4 p col (v,zs,q,h) = plNew props pjID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
    & pjColor .~ col
    & pjVel .~ v
    & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
    & pjQuat .~ q
    & pjVelZ .~ zs
    & pjPosZ .~ h
    )

addGibAt :: Float -> Color -> Point2 -> World -> World
addGibAt h col p w = w
    & plNew props pjID gib
    & randGen .~ newg
  where
    (gib,newg) = runState f $ _randGen w
    f = do
        s   <- state $ randomR (1,4)
        dir <- unitVectorAtAngle <$> state (randomR (0,2*pi))
        zs  <- state $ randomR (-8,8)
        q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
        let v = s *.* dir
        return $ aGib
            & prPos .~ p
            & pjColor .~ col
            & pjVel .~ v
            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
            & pjQuat .~ q
            & pjVelZ .~ zs
            & pjPosZ .~ h

addGibAtDir :: Float -> Float -> Color -> Point2 -> World -> World
addGibAtDir dir h col p w = w
    & plNew props pjID gib
    & randGen .~ newg
  where
    (gib,newg) = runState f $ _randGen w
    f = do
        s   <- state $ randomR (1,4)
        zs  <- state $ randomR (-8,8)
        q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
        let v = s *.* unitVectorAtAngle dir
        return $ aGib
            & prPos .~ p
            & pjColor .~ col
            & pjVel .~ v
            & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
            & pjQuat .~ q
            & pjVelZ .~ zs
            & pjPosZ .~ h
