module Dodge.Render.Picture
  where
import Dodge.Data
import Dodge.Base
import Dodge.Picture
import Dodge.Picture.Layer
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Geometry
import Picture

import Control.Lens
import Data.Maybe
import qualified Data.IntMap.Strict as IM

worldPictures :: World -> Picture
worldPictures w = pictures $ concat 
    [ IM.elems $ _decorations w 
    , map _pjPict  . IM.elems $ _projectiles w
    , map drawItem . IM.elems $ _floorItems w
    , map crDraw   . IM.elems $ _creatures w
    , map clDraw   . IM.elems $ _clouds w
    , map ppDraw    . IM.elems $ _pressPlates w
    , map btDraw (IM.elems (_buttons w))
    , map (\pt -> _ptDraw pt pt) $ _particles w
    , map drawWallFloor (wallFloorsToDraw w)
    , testPic w
    ]

fixedCoordPictures :: World -> Picture
fixedCoordPictures w = case _menuLayers w of 
    [] -> pictures
        [ hudDrawings w
        , customMouseCursor w
        ]
    lays -> scaler . onLayer MenuDepth $ menuScreen (_config w) (halfWidth w) (halfHeight w) lays
  where 
    scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w)

customMouseCursor :: World -> Picture
customMouseCursor w = 
    setDepth (-1)
    . scale (2 /getWindowX w) (2/ getWindowY w) 
    . uncurry translate (_mousePos w)
    $ pictures [ line [(-5,0),(5,0)] , line [(0,-5),(0,5)] ]

testPic :: World -> [Picture]
testPic w = 
    [ setDepth (-1) . translate 0 0.8
        . scale 0.001 0.001 . text . show . length . IM.elems . IM.filter ( (== 3) . _crRad ) $ _creatures w
    ]

crDraw :: Creature -> Picture
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
ppDraw :: PressPlate -> Picture
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture
btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)

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


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

wallsOnScreen :: World -> IM.IntMap Wall
wallsOnScreen w = wallsNearZones (zoneOfScreen w) w

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 (0,0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
errorNormalizeVDR p = normalizeV p

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

printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p = color white 
    . uncurry 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
    scTran p = p +.+ _cameraCenter w
    tr = scTran $ scRot $ scZoom (  3*halfWidth w  , 3* halfHeight w) 
    tl = scTran $ scRot $ scZoom (- (3*halfWidth w), 3* halfHeight w) 
    br = scTran $ scRot $ scZoom (   3*halfWidth w ,- (3* halfHeight w))
    bl = scTran $ scRot $ scZoom (- (3*halfWidth w),- (3* halfHeight w))
    x = halfWidth w + 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] -> 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] -> 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 x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]

drawItem :: FloorItem -> Picture
drawItem flIt = uncurry translate (_flItPos flIt) 
                    $ rotate (_flItRot flIt)  (_itFloorPict (_flIt flIt))


ffToDraw :: World -> [ForceField]
ffToDraw w = 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 
    p = rotateV (-_cameraRot w) ypShift
    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]
    fCol = color (_ffColor ff)
    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]

wallsPointsAndCols :: World -> [((Point2,Point2),Point4)]
wallsPointsAndCols w = map f . filter (not . _wlIsSeeThrough) . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
  where 
    f wl = (_wlLine wl, _wlColor wl)

wallsWindows :: World -> [((Point2,Point2),Point4)]
wallsWindows w = map f . filter (fromMaybe True . (^? blVisible)) .
                     filter _wlIsSeeThrough . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
  where 
    f wl = (_wlLine wl, _wlColor wl)

wallsForShadows :: World -> [(Point2,Point2)]
wallsForShadows w = map _wlLine 
                        . filter (not . _wlIsSeeThrough)
                        . IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w

lightsForGloom' :: World -> [Point4]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
    where getLS ls  = ( fst $ _lsPos ls, snd $ _lsPos ls,  _lsRad ls , _lsIntensity ls)
          getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)