--{-# LANGUAGE LambdaCase #-}
module Dodge.Render.ShapePicture (worldSPic) where

import Dodge.Debug
import Control.Lens
import Data.Foldable
import Data.Strict.Tuple
import Dodge.Creature.Picture
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Dodge.Draw
import Dodge.Item.Draw.SPic
import Dodge.RadarBlip
import Dodge.Render.Picture
import Geometry
import qualified IntMapHelp as IM
import Linear.V3
import Picture
import Shape
import ShapePicture

worldSPic :: Config -> Universe -> SPic
worldSPic cfig u =
    (mempty :!: extraPics cfig u)
        <> foldup propSPic (filtOn _prPos _props)
        <> foldMap' debrisSPic (filtOn' (xyV3 . _dbPos) _debris)
        <> foldup drawProjectile (filtOn (^. pjPos . _xy) _projectiles)
        <> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
        -- <> foldup (shiftDraw _blPos _blDir (const $ drawBlock . _blDraw)) 
        <> foldup (shiftDraw _blPos _blDir (const $ noPic . _blDraw)) 
                (filtOn _blPos _blocks)
        <> foldMap' (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _foreShapes)
        <> foldup (drawCreature (lw ^. items)) (filtOn (^. crPos . _xy) _creatures)
        <> foldup
            (Prelude.uncurry floorItemSPic)
            ( IM.intersectionWith
                (,)
                (lw ^. items)
                (filtOn _flItPos _floorItems)
            )
        <> foldup btSPic (filtOn _btPos _buttons)
        <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
        <> foldMap' drawChasm (w ^. cWorld . chasms)
        <> w ^. cWorld . lWorld . tempSPic
  where
    w = u ^. uvWorld
    lw = w ^. cWorld . lWorld
    foldup = foldMap'
    filtOn f g = IM.filter (pointIsClose . f) (g lw)
    filtOn' f g = filter (pointIsClose . f) (g lw)
    pointIsClose = cullPoint cfig w

drawChasm :: [Point2] -> SPic
drawChasm = foldMap (Prelude.uncurry drawCliff) . loopPairs

drawCliff :: Point2 -> Point2 -> SPic
drawCliff x y =
    noPic
        . translateSHz (-500.01)
        . colorSH (dark orange)
        $ upperPrismPoly Large Important 500 
            [x, 0.5 * (x + y) + normalizeV (vNormal (y - x)), y]

drawPulseBall :: PulseBall -> SPic
drawPulseBall pb =
    translateSPz 20
        . uncurryV translateSPxy (pb ^. pbPos)
        . noShape
        . setLayer BloomLayer
        $ circleSolidCol green white 10

drawCreature :: IM.IntMap Item -> Creature -> SPic
drawCreature m cr = translateSP (_crPos cr) . rotateSP (_crDir cr) $
    case cr ^. crType of
        _ | CrIsCorpse sp <- cr ^. crHP -> sp
        _ | null (cr ^? crHP . _HP) -> mempty
        BarrelCrit{} -> barrelShape
        LampCrit{_lampHeight = h} -> lampCrSPic h
        _ -> basicCrPict m cr

barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)
  where
    ps = polyCirc 3 10

lampCrSPic :: Float -> SPic
lampCrSPic h =
    colorSH blue (upperBox Small Typical h $ rectWH 5 5)
        :!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)

shiftDraw :: (a -> Point2) -> (a -> Float) -> (a -> a -> SPic) -> a -> SPic
shiftDraw fpos fdir fdraw x =
    uncurryV translateSPxy (fpos x)
        . rotateSP (fdir x)
        $ fdraw x x

cullPoint :: Config -> World -> Point2 -> Bool
cullPoint cfig w p
    | debugOn Close_shape_culling cfig = pointInPoly p (w ^. wCam . camBoundBox)
    | otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance)

extraPics :: Config -> Universe -> Picture
extraPics cfig u =
    setLayer FixedCoordLayer (fixedCoordPictures u)
        <> foldMap drawTractorBeam (_tractorBeams lw)
        <> foldMap drawLinearShockwave (_linearShockwaves lw)
        <> foldMap drawShockwave (_shockwaves lw)
        <> foldMap drawTeslaArc (_teslaArcs lw)
        <> foldMap drawRadarSweep (_radarSweeps lw)
        <> foldMap drawFlame (_flames lw)
        <> foldMap drawEnergyBall (_energyBalls lw)
        <> foldMap drawSpark (_sparks lw)
        <> foldMap drawBullet (_bullets lw)
        <> foldMap drawBlip (_radarBlips lw)
        <> _flares lw
        <> foldMap drawLightSource (_lightSources lw)
        <> viewClipBounds cfig w
        <> foldMap (drawDebug u) (u ^. uvConfig . debug_booleans)
  where
    w = u ^. uvWorld
    lw = w ^. cWorld . lWorld

floorItemSPic :: Item -> FloorItem -> SPic
floorItemSPic itm flit =
    uncurryV translateSPxy (_flItPos flit) $
        rotateSP
            (_flItRot flit)
            (itemSPic itm)

btSPic :: Button -> SPic
btSPic bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton bt)

mcSPic :: CWorld -> Machine -> SPic
mcSPic cw mc = uncurryV translateSPxy (_mcPos mc) $ rotateSP (_mcDir mc) (drawMachine cw mc)

drawBullet :: Bullet -> Picture
drawBullet pt =
    setLayer BloomLayer
        . setDepth 20
        . color (V4 200 200 200 2)
        $ thickLine 2 [_buOldPos pt, _buPos pt]