module Dodge.Render.ShapePicture (
    worldSPic,
) where

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.RadarBlip
import Dodge.Render.Picture
import Geometry
import qualified IntMapHelp as IM
import NewInt
import Picture
import Shape
import ShapePicture

worldSPic :: Configuration -> Universe -> SPic
worldSPic cfig u =
    (mempty :!: extraPics cfig u)
        <> foldup propSPic (filtOn _prPos _props)
        <> foldup drawProjectile (filtOn _pjPos _projectiles)
        <> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
        <> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
        <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
        <> foldup drawCreature (filtOn _crPos _creatures)
        <> foldup floorItemSPic (filtOn _flItPos (_unNIntMap . _floorItems))
        <> foldup btSPic (filtOn _btPos _buttons)
        <> foldup (mcSPic (u ^. uvWorld . cWorld . lWorld)) (filtOn _mcPos _machines)
  where
    w = _uvWorld u
    foldup = foldMap'
    filtOn f g = IM.filter (pointIsClose . f) (g (_lWorld (_cWorld w)))
    pointIsClose = cullPoint cfig w

drawCreature :: Creature -> SPic
drawCreature cr = uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
    case cr ^. crType of
        BarrelCrit{} -> barrelShape
        LampCrit{_lampHeight = h} -> lampCrSPic h
        _ -> basicCrPict 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

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

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

extraPics :: Configuration -> 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 drawBul (_bullets lw)
        <> foldMap drawBlip (_radarBlips lw)
        <> _flares lw
        <> foldMap drawLightSource (_lightSources lw)
        <> foldMap ppDraw (_pressPlates lw)
        <> viewClipBounds cfig w
        <> debugDraw cfig w
        <> foldMap (`_debugPic` u) (_uvDebug u) -- debug messages are in fixed coord pics
  where
    w = u ^. uvWorld
    lw = w ^. cWorld . lWorld

ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)

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

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

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