module Dodge.Prop.Draw
    where
import Geometry.Polygon
import Geometry.Data
import Dodge.Data.Prop
import ShapePicture
import Shape
import Picture
import qualified Quaternion as Q

drawProp' :: Prop -> SPic
drawProp' pr = drawProp (_prDraw pr) pr

drawProp :: PropDraw -> Prop -> SPic
drawProp pd = case pd of
    PropDrawSPic spic -> const spic
    PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (fst $ drawProp pd' pr)
    PropDrawMovingShapeCol sh -> \pr -> drawMovingShapeCol pr sh
    PropDoubleLampCover h -> drawDoubleLampCover h
    PropVerticalLampCover h -> drawVerticalLampCover h
    PropLampCover h -> drawLampCover h
    PropDrawToggle pd' -> propDrawToggle pd'
    PropDrawGib x -> noPic . drawGib x
    PropDrawFlatTranslate x -> \pr 
        -> uncurryV translateSPf (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr

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 (_prColor pr)
        . translateSH (V3 1 1 (1 - x))
        $ upperPrismPoly (2*x) $ square x

propDrawToggle :: PropDraw -> Prop -> SPic
propDrawToggle pd pr
    | not (_prToggle pr) = mempty
    | otherwise = drawProp pd pr

drawLampCover :: Float -> Prop -> SPic
drawLampCover h pr = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
    $ rotateSH (_prRot pr) $ mconcat
    [ translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 2    (-1) 3 
    , translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2    3 
    , translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 2    (-1) 3 
    , translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2    3 
    , upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
    ]
    , mempty
    )

drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
    ( translateSHz h . uncurryV translateSHf (_prPos pr) 
        $ rotateSHx (_prRot pr) $ mconcat
        [ 
        translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
        ]
    , mempty
    )

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

drawMovingShapeCol :: Prop -> Shape -> SPic
drawMovingShapeCol pr = noPic
    . translateSHz (_prPosZ pr)
    . uncurryV translateSHf (_prPos pr) 
    . overPosSH (Q.rotate (_prQuat pr))
    . colorSH (_prColor pr)

drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr =
    ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr) 
        $ rotateSH (_prRot pr) $ mconcat
        [ upperPrismPoly 5 $ reverse $ rectNSWE 6 5       (-6) 6
        , upperPrismPoly 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
        , upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
        , upperPrismPoly 1 [V2 0   1 ,V2 (-6) (-5),V2 6 (-5)]
        ]
    , mempty
    )