module Dodge.Prop.Moving 
    ( drawMovingShape
    , drawMovingShapeCol
    , fallSmallBounceDamage
    , fallSmallBounce
    ) where
--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)
--
fallSmallBounceDamage :: Prop -> World -> World
fallSmallBounceDamage pr w = w 
    & dodamage
    & props . ix (_pjID pr) %~ fallSmallBounce' w
  where
    p = _prPos pr
    v = _pjVel pr
    dodamage
        | _pjPosZ pr < 25 = creatures %~ fmap dodamage'
        | otherwise = id
    dodamage' cr
        | dist (_crPos cr) p < _crRad cr + 5 = cr & crState . csDamage 
            .:~ Damage CRUSHING (floor . (*10) . max 0 . subtract 5 . abs $ _pjVelZ pr) (p -.- v) p (p +.+ v) NoDamageEffect
        | otherwise = cr

fallSmallBounce :: Prop -> World -> World
fallSmallBounce pr w = w 
    & props . ix (_pjID pr) %~ fallSmallBounce' w

fallSmallBounce' :: World -> Prop -> Prop
fallSmallBounce' w pr
    | newposz < 0 && velz < (-2) = pr 
        & pjVelZ %~ ((*0.5) . negate)
--        & pjPos +~ (0.5*.* vel)
        & updateWithVel (0.5 *.* vel)
        & pjVel %~ (0.5 *.*)
--        & pjPos +~ (0.5*.* vel)
    | newposz < 0 = pr & pjUpdate .~ const id
        & pjZ .~ 0
--        & pjQuat *~ (_pjQuatSpin pr)
    | otherwise = pr
        & pjVelZ -~ 1
        & pjPosZ +~ velz
        & updateWithVel vel
        & pjQuat *~ _pjQuatSpin pr
  where
    newposz = _pjPosZ pr + velz
    velz = _pjVelZ pr
    vel  = _pjVel pr
    pos  = _prPos pr
    updateWithVel v = case bouncePoint (const True) 0.5 pos (pos + v) w of
        Nothing -> prPos +~ v
        Just (p,v') -> (prPos .~ p) . (pjVel .~ v')

drawMovingShape :: Prop -> Shape -> SPic
drawMovingShape pr = noPic
    . translateSHz (_pjPosZ pr)
    . uncurryV translateSHf (_prPos pr) 
    . overPosSH (Q.rotate (_pjQuat pr))

drawMovingShapeCol :: Prop -> Shape -> SPic
drawMovingShapeCol pr = noPic
    . translateSHz (_pjPosZ pr)
    . uncurryV translateSHf (_prPos pr) 
    . overPosSH (Q.rotate (_pjQuat pr))
    . colorSH (_pjColor pr)
