module Dodge.Render.ShapePicture
    ( worldSPic
    )
    where
import Dodge.Config.Data
--import Dodge.Debug.Picture
import Dodge.Picture.SizeInvariant
import Dodge.Data
import Dodge.Base
import Dodge.Base.Window
import Dodge.SoundLogic.LoadSound
import Dodge.Graph
import Dodge.GameRoom
import Dodge.Update.Camera
--import Dodge.Zone
import Geometry
import ShapePicture
import Shape
import Picture
import Sound.Data

import qualified Data.IntMap.Strict as IM -- Lazy?
import qualified Data.Map.Strict as M
--import Control.Lens
--import Data.Maybe

worldSPic :: World -> SPic
worldSPic w = 
    (extraShapes w, extraPics w)
    <> foldMap (dbArg _prDraw) (filtOn _pjPos _props)
    <> foldMap (($ w) . dbArg _crPict) (filtOn _crPos _creatures)
    <> foldMap floorItemSPic (filtOn _flItPos _floorItems)
    <> foldMap btSPic (filtOn _btPos _buttons)
    <> foldMap mcSPic (filtOn _mcPos _machines)
  where
    filtOn f g = IM.filter (pointIsClose . f) (g w)
    pointIsClose p = dist camCen p < winSize
    winSize = 30 + max (getWindowX w) (getWindowY w)
    camCen = _cameraCenter w

extraShapes :: World -> Shape
extraShapes = _foregroundShape

extraPics :: World -> Picture
extraPics w = pictures (_decorations w)
    <> concatMapPic (dbArg _ptDraw) (_particles    w)
    <> concatMapPic (dbArg _lsPict) (_lightSources w)
    <> testPic w
    <> concatMapPic clDraw (_clouds w      )
    <> concatMapPic ppDraw (_pressPlates w )
    <> soundPics w
    <> viewBoundaries w
    <> drawPathing w

-- TODO remove duplicate!
testPic :: World -> Picture
testPic _ = []
clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (_clPict c c)
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)

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

btSPic :: Button -> SPic
btSPic bt = uncurryV translateSPf (_btPos bt)
    $ rotateSP (_btRot bt) (_btPict bt bt)
mcSPic :: Machine -> SPic
mcSPic bt = uncurryV translateSPf (_mcPos bt)
    $ rotateSP (_mcDir bt) (_mcDraw bt bt)

soundPics :: World -> Picture
soundPics w 
    | _show_sound (_config w) = pictures $ M.map (soundPic w) $ _playingSounds w
    | otherwise = []

soundPic :: World -> Sound -> Picture
soundPic w s = fixedSizePicClampArrow 50 50 thePic p w
  where
    p = _soundPos s
    thePic 
        = rotate (_cameraRot w) 
        . scale theScale theScale 
        . centerText 
        . soundToOnomato 
        $ _soundChunkID s
    theScale = 0.15 * f (_soundVolume s * 0.0001)
    f x = 1 - 0.5 * (1 - x)

drawPathing :: World -> Picture
drawPathing w
    | _debug_pathing (_config w) 
        = -- setLayer 5 $ 
        (color green . pictures . map (flip thickLine 5 . tflat2) $ graphToEdges gr)
        <> concatMap dispInc (graphToIncidence gr)
    | otherwise = []
  where
    dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
    gr = _pathGraph w
viewBoundaries :: World -> Picture
viewBoundaries w
    | _debug_view_boundaries (_config w) 
        = setLayer 5 $ color green (concatMap (polygonWire . _grBound) grs)
        <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
    | otherwise = []
  where
    p = _crPos $ you w
    grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)

--wallFloorsToDraw :: World -> [Wall]
--wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
--  where 
--    onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall
--    isVisible wl 
--        | wl ^? wlDraw == Just False = False
--        | otherwise = onScreen wl
--
--lineOnScreen :: World -> Point2 -> Point2 -> Bool
--lineOnScreen w p1 p2 = pointInPolygon p1 sp 
--    || pointInPolygon p2 sp 
--    || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
--  where 
--    sp = screenPolygon w
--    sps = zip sp (tail sp ++ [head sp])
--
--drawWallFloor :: Wall -> Picture
--drawWallFloor wl = if _wlOpacity wl == SeeThrough
--    then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]
--    else blank
--  where 
--    (x,y) = _wlLine wl
--    c = _wlColor wl
--    n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x)
--
--errorNormalizeVDR :: Point2 -> Point2
--errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
--errorNormalizeVDR p = normalizeV p
