{-# LANGUAGE LambdaCase #-}
module Dodge.Prop.Draw (
    propSPic,
) where

import Control.Lens
import Dodge.Data.Prop
import Geometry.Data
import Geometry.Polygon
import Picture
import qualified Quaternion as Q
import Shape
import ShapePicture

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

drawProp :: PropDraw -> Prop -> SPic
drawProp = \case
    PropDrawSPic spic -> const spic
    PropDrawMovingShape pd' -> \pr -> drawMovingShape pr (drawProp pd' pr)
    PropDrawMovingShapeCol sh -> (`drawMovingShapeCol` 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 translateSPxy (_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) (baseCube & each . sfShadowImportance .~ Superfluous)
    skin =
        colorSH (_prColor pr) $
            translateSH (V3 1 1 (1 - x)) baseCube
    baseCube = upperPrismPoly Small Typical (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 =
    noPic
        ( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
            rotateSH (_prRot pr) $
                mconcat
                    [ aface 1 2 (-1)
                    , aface 1 (-1) 2
                    , aface 2 2 (-1)
                    , aface 2 (-1) 2
                    , upperPrismPoly Small Essential 1 [V2 2 2, V2 (-1) 2, V2 2 (-1)]
                    ]
        )
  where
    aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1 $ rectNSWE 3 s w 3

drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
    noPic
        ( translateSHz h . uncurryV translateSHxy (_prPos pr)
            . rotateSHx (_prRot pr)
            . translateSHz (-3)
            . upperPrismPoly Small Essential 1
            $ rectNSWE 2 (-2) (-5) 5
        )

drawMovingShape :: Prop -> SPic -> SPic
drawMovingShape pr =
    translateSPz (_prPosZ pr)
        . uncurryV translateSPxy (_prPos pr)
        . overPosSP (Q.rotate (_prQuat pr))

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

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