--{-# LANGUAGE TupleSections #-}
module Dodge.Render.Picture
  where
import Dodge.Data
import Dodge.Base
import Dodge.Base.Window
import Dodge.Zone
import Dodge.Picture
import Dodge.Picture.SizeInvariant
import Dodge.Picture.Layer
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Dodge.SoundLogic.LoadSound
import Sound.Data
import Geometry
import Picture
import ShapePicture

import Control.Lens
import Data.Maybe
import Data.List (partition)
import qualified Data.IntMap.Lazy as IM
import qualified Data.Map as M

worldPictures :: World -> Picture
worldPictures w = pictures
    [pictures (_decorations w)
    ,concatMapPic (dbArg _pjDraw)  $ _projectiles w
    ,concatMapPic (crDraw w) . IM.filter crIsClose $ _creatures w
    ,concatMapPic (dbArg _ptDraw) $ _particles w
    ,testPic w
    ,concatMapPic drawItem $ _floorItems w
    ,concatMapPic (crDraw w) $ _creatures w
    ,concatMapPic clDraw $ _clouds w      
    ,concatMapPic ppDraw $ _pressPlates w
    ,concatMapPic btDraw $ _buttons w
    ,concatMapPic drawWallFloor $ wallFloorsToDraw w
    ]
  where
    crIsClose cr = dist (_crPos cr) camCen < winSize
    winSize = 30 + max (getWindowX w) (getWindowY w)
    camCen = _cameraCenter w
    
fixedCoordPictures :: World -> Picture
fixedCoordPictures w = case _menuLayers w of 
    [] -> pictures
        [ hudDrawings w
        , customMouseCursor w
        ]
    (lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay
  where 
    scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w)

customMouseCursor :: World -> Picture
customMouseCursor w = 
    scale (2 /getWindowX w) (2/ getWindowY w) 
    . uncurryV translate (_mousePos w)
    . color white
    $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ]

testPic :: World -> Picture
testPic w = pictures 
    [ soundPics w
--    , fixedSizePicClampArrow 10 50 thepic (mouseWorldPos w) w
    ]
--  where
--    thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5)
--testPic _ = blank
--testPic w = color green . pictures . map (flip thickLine 5 . tflat2) . graphToEdges $ _pathGraph w

soundPics :: World -> Picture
soundPics w = pictures $ M.map (soundPic w) $ _playingSounds w

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)

crDraw :: World -> Creature -> Picture
crDraw w c = _spPicture $ _crPict c c w
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture
btDraw c = uncurryV translate (_btPos c) $ rotate (_btRot c) (_btPict c)

clDraw :: Cloud -> Picture
clDraw c = translate3 (_clPos c) (_clPict c c)

wallFloorsToDraw :: World -> [Wall]
wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
  where 
    onScreen wall = uncurry (lineOnScreen w) $ _wlLine wall
    isVisible wl 
        | wl ^? blVisible == Just False = False
        | otherwise = onScreen wl

drawWallFloor :: Wall -> Picture
drawWallFloor wl = if _wlIsSeeThrough wl
    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

printPoint :: Point2 -> Picture
printPoint p = color white $ uncurryV translate p $ pictures [circle 3 ,scale 0.05 0.05 $ text (show p)]

printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p = color white 
    . uncurryV translate p 
    $ pictures [circle 3 , rotate (negate r) $ scale 0.1 0.1 $ text (show p)]

outsideScreenPolygon :: World -> [Point2]
outsideScreenPolygon w = [tr,tl,bl,br]
  where 
    scRot  = rotateV (_cameraRot w)
    scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
             | otherwise = error "Trying to set screen zoom to zero"
    scTran p = p +.+ _cameraCenter w
    tr = scTran $ scRot $ scZoom $ V2 (  3*halfWidth w  ) ( 3* halfHeight w) 
    tl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) ( 3* halfHeight w) 
    br = scTran $ scRot $ scZoom $ V2 (   3*halfWidth w ) (- (3* halfHeight w))
    bl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) (- (3* halfHeight w))

wallShadowsToDraw :: World -> [Wall]
wallShadowsToDraw w 
    = filter (fromMaybe True . (^? blVisible)) 
    . IM.elems
    $ wallsNearZones (zoneOfSight w) w

-- cannot only test if walls are on screen, but also if they are on the cone
-- towards the center of sight
lineOnScreenCone :: World -> Point2 -> Point2 -> Bool
lineOnScreenCone w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
  where 
    sp' = screenPolygon w
    vp = _cameraViewFrom w
    sp | pointInPolygon vp sp' = sp'
       | otherwise = orderPolygon (_cameraViewFrom w : sp')
    sps = zip sp (tail sp ++ [head sp])


lineOnScreen :: World -> Point2 -> Point2 -> Bool
lineOnScreen w p1 p2 = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9 p2 sp 
                                                || any (isJust . uncurry (intersectSegSeg p1 p2)) sps
  where 
    sp = screenPolygon w
    sps = zip sp (tail sp ++ [head sp])

drawWallFace :: World -> Wall -> Picture
drawWallFace w wall
    | isRHS sightFrom x y || _wlIsSeeThrough wall = blank
    | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
  where 
    (x,y) = _wlLine wall 
    points = extendConeToScreenEdge w sightFrom (x,y)
    sightFrom = _cameraViewFrom w

-- the following assumes that the point a is inside the screen
-- it still works otherwise, but it might intersect two points:
-- it is not obvious which will be returned
intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen w a b = listToMaybe 
    . mapMaybe (\(x,y) -> intersectSegLineFrom' x y b (b +.+ b -.- a))
    . makeLoopPairs 
    $ screenPolygon w

extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
  where 
    borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
    cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
    wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg y ((2*.*y) -.- x)) 
                              . makeLoopPairs $ screenPolygon w

rectangleSolid :: Float -> Float -> Picture
rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]

drawItem :: FloorItem -> Picture
drawItem flit = uncurryV translate (_flItPos flit) 
                    $ rotate (_flItRot flit)  (_spPicture $ _itFloorPict (_flIt flit))


ffToDraw :: World -> [ForceField]
ffToDraw _ = []
--    filter (lineOnScreen w . _ffLine) $
--                IM.elems $ over ffLine (map ( -.- _cameraCenter w)) <$> 
--                _forceFields w

drawFF :: ForceField -> Picture
drawFF FF{_ffLine = l, _ffColor = col} = pictures 
    [color white $ line l
    , color col $ lineOfThickness 6 l 
    ]

drawFFShadow :: World -> ForceField -> [Picture]
drawFFShadow w ff
    | youOnFF   = []
    | otherwise = map (rotate ( _cameraRot w) . pane) [0,0.05..0.25]
  where 
    x = rotateV (-_cameraRot w) x'
    y = rotateV (-_cameraRot w) y'
    yp = _crPos $ you w
    (x1:y1:_) = _ffLine ff
    (x':y':_) | isRHS x1 y1 yp = [y1,x1]
              | otherwise      = [x1,y1]
    col = _ffColor ff
    ypShift = yp -.- _cameraCenter w
    youOnFF = circOnSeg x' y' ypShift (_crRad $ you w)
    pane j = color (withAlpha 0.1 col) 
              $ polygon
                [ x
                , x +.+ ((0.1 + j) *.* (x -.- ypShift))
                , y +.+ ((0.1 + j) *.* (y -.- ypShift))
                , y]
wallsAndWindows
    :: World
    -> ( [((Point2,Point2),Point4)]  ,[((Point2,Point2),Point4)] )
wallsAndWindows w
    = (map f wls, map f $ filter (fromMaybe True . (^? blVisible)) wins)
  where
    f wl = (_wlLine wl, _wlColor wl)
    (wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w

wallsToList :: [((Point2,Point2),Point4)] -> [Float]
wallsToList = concatMap (\((V2 a b,V2 c d),V4 e f g h) -> [a,b,c,d,e,f,g,h])

lightsForGloom :: World -> [(Point3,Float,Point3)]
lightsForGloom w = mapMaybe getLS (IM.elems $ _lightSources w) ++ mapMaybe getTLS (_tempLightSources w)
  where 
    getLS ls  
        | dist campos (fst2 $ _lsPos ls) > 1000 = Nothing
        | otherwise = Just ( _lsPos ls,  _lsRad ls^(2::Int) , _lsIntensity ls)
    getTLS ls 
        | dist campos (fst2 $ _tlsPos ls) > 1000 = Nothing
        | otherwise = Just ( _tlsPos ls, _tlsRad ls^(2::Int), _tlsIntensity ls)
    campos = _cameraCenter w
    fst2 (V3 a b _) = V2 a b