module Dodge.Debug.Picture where

import Control.Lens
import Data.Foldable
import qualified Data.Graph.Inductive as FGL
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Creature.Picture.Awareness
import Dodge.Data.Universe

import Dodge.GameRoom
import Dodge.Graph
import Dodge.Path
import Dodge.Picture.SizeInvariant
import Dodge.Render.InfoBox
import Dodge.Render.List
import Dodge.ShortShow
import Dodge.SoundLogic.LoadSound
import Dodge.Viewpoints
import Dodge.Zoning
import Dodge.Zoning.Base
import Geometry
import Geometry.ConvexPoly
import qualified IntMapHelp as IM
import Padding
import Picture
import SDL (MouseButton (..))
import ShortShow
import Sound.Data
import qualified Data.Set as S
import Dodge.Render.Label
import Dodge.WorldEvent.ThingsHit

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 :: Configuration -> Camera -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
  where
    scRot = rotateV (w ^. camRot)
    scZoom p
        | (w ^. camZoom) /= 0 = (1 / (w ^. camZoom)) *.* p
        | otherwise = error "Trying to set screen zoom to zero"
    scTran p = p +.+ (w ^. camCenter)
    tr = f 3 3
    tl = f (-3) 3
    br = f 3 (-3)
    bl = f (-3) (-3)
    f a b = scTran $ scRot $ scZoom $ V2 (a * halfWidth cfig) (b * halfHeight cfig)

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

drawWallFace :: Configuration -> World -> Wall -> Picture
drawWallFace cfig w wall
    | isRHS sightFrom x y || not (wlIsOpaque wall) = blank
    | otherwise = setDepth (-1) . color (withAlpha 0 black) . polygon $ points
  where
    (x, y) = _wlLine wall
    points = extendConeToScreenEdge cfig w sightFrom (x, y)
    sightFrom = w ^. wCam . camViewFrom

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

-- 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 :: Configuration -> World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen cfig w a b =
    listToMaybe
        . mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
        . loopPairs
        $ screenPolygon cfig (w ^. wCam)

drawCollisionTest :: World -> Picture
drawCollisionTest w = fromMaybe mempty $ do
--    let f = fmap (screenToWorldPos (w ^. wCam))
    a <- w ^. input . clickWorldPos . at ButtonLeft
    b <- w ^. input . clickWorldPos . at ButtonRight
    return $
        setLayer DebugLayer (color orange $ line [a, b])
            <> foldMap (drawCross . fst) (crHit a b w)
            <> foldMap (drawCross . _crPos) (crsNearSeg a b w)
            <> foldMap (drawZoneCol green crZoneSize . zoneOfPoint crZoneSize) (xIntercepts crZoneSize a b)
            <> foldMap (drawZoneCol yellow crZoneSize . zoneOfPoint crZoneSize) (yIntercepts' crZoneSize a b)
            <> foldMap (drawLabCrossCol blue) (xIntercepts crZoneSize a b)

drawZoneCol :: Color -> Float -> V2 Int -> Picture
drawZoneCol col s (V2 x y) = setLayer DebugLayer . color col $ thickLine 2 (p : ps ++ [p])
  where
    (p : ps) =
        zipWith (+.+) (square 1) $
            map ((s *.*) . (each %~ fromIntegral)) [V2 x y, V2 (x + 1) y, V2 (x + 1) (y + 1), V2 x (y + 1)]

debugDraw :: Configuration -> World -> Picture
{-# INLINE debugDraw #-}
debugDraw cfig w
    | Enable_debug `S.member` _debug_booleans cfig =
        pic
            <> setLayer FixedCoordLayer (listPicturesAt (0.5 * halfWidth cfig) 0 cfig $ map text ts)
    | otherwise = mempty
  where
    pic = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
    ts = map show (S.toList $ _debug_booleans cfig)

debugDraw' :: Configuration -> World -> DebugBool -> Picture
{-# INLINE debugDraw' #-}
debugDraw' cfig w bl = case bl of
    Enable_debug -> mempty
    Noclip -> mempty
    Remove_LOS -> mempty
    Cull_more_lights -> mempty
    Close_shape_culling -> mempty
    Bound_box_screen -> mempty
    Show_ms_frame -> mempty
    View_boundaries -> viewBoundaries w
    Show_bound_box -> drawBoundingBox w
    Show_wall_search_rays -> drawWallSearchRays w
    Show_dda_test -> drawDDATest w
    Show_far_wall_detect -> drawFarWallDetect w
    Show_walls_near_point_cursor -> drawWallsNearCursor w
    Show_walls_near_point_you -> drawWallsNearYou w
    Show_zone_near_point_cursor -> drawZoneNearPointCursor w
    Inspect_wall -> drawInspectWalls w
    Cr_awareness -> drawCreatureDisplayTexts w
    Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
    Cr_status -> drawCrInfo cfig w
    Mouse_position -> drawMousePosition w
    Walls_info -> drawWlIDs w
    Pathing -> drawPathing cfig w
    Show_nodes_near_select -> undefined --drawNodesNearSelect w
    Show_path_between -> drawPathBetween w
    Collision_test -> mempty
    Pacify_enemies -> mempty

drawCreatureDisplayTexts :: World -> Picture
drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures)

drawPathBetween :: World -> Picture
drawPathBetween w = fromMaybe mempty $ do
    sp <- w ^. input . clickPos . at ButtonLeft
    ep <- w ^. input . clickPos . at ButtonRight
    let nodepos = (`getNodePos` w)
        nodelist = makePathBetween sp ep w
    return . setLayer DebugLayer $
        color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist)
            <> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp)
            <> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep)
            <> foldMap (color orange . arrow sp) (pointTowardsImpulse sp ep w)

drawWallsNearYou :: World -> Picture
drawWallsNearYou w = fromMaybe mempty $ do
    p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
    return $ setLayer DebugLayer $ foldMap f $ wlsNearPoint p w
  where
    f wl = color violet $ thickLine 3 [a, b]
      where
        (a, b) = _wlLine wl

drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
    setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w
  where
    f wl = color rose $ thickLine 3 [a, b]
      where
        (a, b) = _wlLine wl

drawInspectWalls :: World -> Picture
drawInspectWalls w = fromMaybe mempty $ do
    a <- w ^. input . clickPos . at ButtonLeft
    b <- w ^. input . heldPos . at ButtonLeft
    return $
        setLayer DebugLayer (color orange $ line [a, b])
            <> foldMap
                (drawInspectWall w)
                ( filter (isJust . uncurry (intersectSegSeg a b) . _wlLine) $
                    IM.elems $ w ^. cWorld . lWorld . walls
                )

drawInspectWall :: World -> Wall -> Picture
drawInspectWall w wl =
    setLayer DebugLayer $
        color rose (thickLine 3 [a, b])
            <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor)
  where
    (a, b) = _wlLine wl

drawDoorPaths :: World -> Int -> Picture
drawDoorPaths w drid = fromMaybe mempty $ do
    paths <- w ^? cWorld . lWorld . doors . ix drid . drObstructs
    return $ foldMap' (drawPathEdge . (^. penPathEdge)) paths

drawPathEdge :: PathEdge -> Picture
drawPathEdge pe =
    setLayer DebugLayer $
        multiArrow (_peStart pe) (_peEnd pe) green (S.map obstacleColor (_peObstacles pe))

obstacleColor :: EdgeObstacle -> Color
obstacleColor eo = case eo of
    WallObstacle -> cyan
    DoorObstacle -> red
    AutoDoorObstacle -> yellow
    BlockObstacle -> blue

drawFarWallDetect :: World -> Picture
drawFarWallDetect w =
    setLayer DebugLayer
        . color yellow
        . foldMap
            ( \q ->
                line
                    [ p
                    , fst $ collidePoint p q $ filter wlIsOpaque $ wlsNearSeg p q w
                    ]
            )
        $ getViewpoints p (_cWorld w)
  where
    p = w ^. wCam . camViewFrom

drawZoneNearPointCursor :: World -> Picture
drawZoneNearPointCursor w =
    foldMap (drawZoneCol orange 50) ps
  where
    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
    ps = [zoneOfPoint 50 mwp]

drawDDATest :: World -> Picture
drawDDATest w =
    foldMap (drawZoneCol orange 50) ps
        <> setLayer DebugLayer (color yellow (line [cvf, mwp]))
  where
    cvf = w ^. wCam . camViewFrom
    mwp = mouseWorldPos (w ^. input) (w ^. wCam)
    ps = zoneOfSeg 50 cvf mwp

drawWallSearchRays :: World -> Picture
drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
  where
    f p =
        setLayer DebugLayer $
            color yellow $
                uncurryV translate p (circle 5)
                    <> line [w ^. wCam . camViewFrom, p]

viewBoundaries :: World -> Picture
viewBoundaries w =
    setLayer DebugLayer $
        color green (foldMap (polygonWire . _grBound) grs)
            <> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p (_cWorld w))
  where
    p = w ^. wCam . camViewFrom
    grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w)

viewClipBounds :: Configuration -> World -> Picture
viewClipBounds cfig w
    | _debug_view_clip_bounds cfig == AllRoomClipBoundaries =
        setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_cwgRoomClipping $ _cwGen (_cWorld w))
    | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries =
        setLayer DebugLayer $ f (_cwgRoomClipping $ _cwGen (_cWorld w))
    | otherwise = mempty
  where
    f (x : xs) = g x xs <> f xs
    f [] = mempty
    g x (y : ys)
        | convexPolysOverlap x y =
            color green (polygonWire $ _cpPoints x)
                <> color yellow (polygonWire $ _cpPoints y)
                <> g x ys
        | otherwise = g x ys
    g _ [] = mempty

drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
  where
    (x : xs) = w ^. wCam . camBoundBox

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

drawMousePosition :: World -> Picture
drawMousePosition w =
    setLayer FixedCoordLayer
        . uncurryV translate (w ^. input . mousePos)
        . scale 0.1 0.1
        . text
        $ shortPoint2 mwp
  where
    mwp = mouseWorldPos (w ^. input) (w ^. wCam)

drawWlIDs :: World -> Picture
drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
  where
    f wl
        | dist (_crPos $ you w) (fst (_wlLine wl)) > 200 = mempty -- this should be improved with a better "on screen test"
        | otherwise =
            uncurryV translate p
                . scale 0.1 0.1
                . text
                $ show $ _wlID wl
      where
        p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)


drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w =
    setLayer FixedCoordLayer $
        renderInfoListsAt (2 * hw - 400) 0 cfig cam $
            mapMaybe crDisplayInfo $ IM.elems $ w ^. cWorld . lWorld . creatures
  where
    cam = w ^. wCam
--    drawPathing :: Configuration -> World -> Picture
--    drawPathing cfig w =
--        setLayer DebugLayer $
--            foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
--                <> foldMap dispInc (graphToIncidence gr)
--      where
--        dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
--        gr = w ^. cWorld . pathGraph

    crDisplayInfo :: Creature -> Maybe (Point2, [String])
    crDisplayInfo cr
        | _crID cr == 0 = Nothing
        | crOnScreen =
            Just
                ( _crPos cr
                , catMaybes
                    --        [fmap show $ ap ^? crGoal
                    [ fpreShow "crHP" $ cr ^? crHP
                    , fpreShow "crStrategy" $ ap ^? apStrategy
                    , fmap (("crPos....." ++) . shortShow) $ cr ^? crPos
                    , fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
                    , --        , fmap show $ cr ^? crOldPos
                      fpreShow "crAction" $ ap ^? apAction
                    , fpreShow "crImpulse" $ ap ^? apImpulse
                    ]
                )
        | otherwise = Nothing
      where
        ap = _crActionPlan cr
        crOnScreen = pointIsOnScreen cfig cam $ _crPos cr

    fpreShow :: (Show a, Functor f) => String -> f a -> f String
    fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
    hw = halfWidth cfig

drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
    setLayer DebugLayer $
        foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
            <> foldMap dispInc (graphToIncidence gr)
  where
    dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
    gr = w ^. cWorld . pathGraph

edgeToPic :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe
    | not (pointInPolygon sp poly) && not (pointInPolygon ep poly) = mempty
    | otherwise = drawPathEdge pe
  where
    sp = _peStart pe
    ep = _peEnd pe