{-# LANGUAGE LambdaCase #-}

module Dodge.Debug (debugEvents,drawDebug) where

import qualified SDL
import System.Hclip
import Control.Lens
import Control.Monad
import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Linear
import Padding
import Picture.Base
import ShortShow

debugEvents :: Universe -> Universe
debugEvents u = case dbools ^. at Display_debug of
    Nothing -> u & uvDebug .~ mempty
    Just () -> S.foldr debugEvent (u & uvDebug .~ mempty) dbools
        & overDebugEvent
  where
    dbools = u ^. uvConfig . debug_booleans

overDebugEvent :: Universe -> Universe
overDebugEvent u = fromMaybe u $ do
    OverDebug db i <- u ^? uvWorld . input . mouseContext
    f <- u ^? uvDebug . ix db . ix i . debugFunction
    return $ f u

debugEvent :: DebugBool -> Universe -> Universe
debugEvent db u = u & uvDebug . at db .~ debugItem db u

debugItem :: DebugBool -> Universe -> Maybe [DebugItem]
debugItem = \case
    Collision_test -> mempty
    Circ_collision_test -> mempty
    Show_walls_near_point_cursor -> mempty
    Show_walls_near_segment -> mempty
    Display_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 -> mempty
    Show_bound_box -> mempty
    Show_wall_search_rays -> mempty
    Show_dda_test -> mempty
    Show_far_wall_detect -> mempty
    Show_walls_near_point_you -> mempty
    Show_zone_near_point_cursor -> mempty
    Show_zone_circ -> mempty
    Inspect_wall -> mempty
    Cr_awareness -> mempty
    Show_sound -> mempty
    Cr_status -> drawCrInfo'
    Mouse_position -> mempty
    Walls_info -> mempty
    Pathing -> mempty
    Show_path_between -> mempty

drawCrInfo' :: Universe -> Maybe [DebugItem]
drawCrInfo' u = case drawCrInfo u of
    [] -> Nothing
    xs -> Just xs

drawCrInfo :: Universe -> [DebugItem]
drawCrInfo u = foldMap f . IM.elems $ w ^. cWorld . lWorld . creatures
  where
    w = u ^. uvWorld
    g h ls x = do
        rs <- h <$> x
        return $ DebugItem ((rightPad 7 '.' ls ++ "...") ++ rs) (setclip rs)
    f cr = fromMaybe [] $ do
        guard $
            pointIsOnScreen (u ^. uvConfig) (w ^. wCam) (cr ^. crPos . _xy)
                && cr ^. crID /= 0
        Just $ catMaybes
                    [ g show "crID" $ cr ^? crID
                    , g show "crHP" $ cr ^? crHP . _HP
                    , g show "crStrategy" $ cr ^? crActionPlan . apStrategy
                    , g shortShow "crPos" $ cr ^? crPos . _xy
                    , g show "cpVigilance" $ cr ^? crPerception . cpVigilance
                    , g show "crAction" $ cr ^? crActionPlan . apAction
                    , g show "crImpulse" $ cr ^? crActionPlan . apImpulse
                    , g show "crName" $ cr ^? crName
                    ]
    setclip s u'' = fromMaybe u'' $ do
        guard (SDL.ButtonLeft `M.member` (u'' ^. uvWorld . input . mouseButtons))
        return $ u'' & uvIOEffects %~ (\m u' -> setClipboard s >> m u')

--closestCreatureID :: Universe -> Maybe Int
--closestCreatureID u =
--    fmap (_crID . snd) . listToMaybe
--        . sortOn (Down . dist mwp . fst)
--        . crsHitRadial mwp 100
--        $ _uvWorld u
--  where
--    mwp = mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)

drawDebug :: Universe -> DebugBool -> Picture
drawDebug u = \case
    Collision_test -> drawCollisionTest $ _uvWorld u
    Circ_collision_test -> drawCircCollisionTest $ _uvWorld u
    Show_walls_near_point_cursor -> drawWallsNearCursor $ _uvWorld u
    Show_walls_near_segment -> drawWallsNearSegment $ _uvWorld u
    Display_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 $ _uvWorld u
    Show_bound_box -> drawBoundingBox $ _uvWorld u
    Show_wall_search_rays -> drawWallSearchRays $ _uvWorld u
    Show_dda_test ->  drawDDATest $ _uvWorld u
    Show_far_wall_detect ->  drawFarWallDetect $ _uvWorld u
    Show_walls_near_point_you ->  drawWallsNearYou $ _uvWorld u
    Show_zone_near_point_cursor ->  drawZoneNearPointCursor $ _uvWorld u
    Show_zone_circ ->  drawZoneCirc $ _uvWorld u
    Inspect_wall ->  drawInspectWalls $ _uvWorld u
    Cr_awareness ->  drawCreatureDisplayTexts $ _uvWorld u
    Show_sound -> fold 
        $ M.map (soundPic (u ^. uvConfig) (u ^. uvWorld)) $ u ^. uvWorld . playingSounds
    Cr_status -> mempty
    Mouse_position ->  drawMousePosition $ _uvWorld u
    Walls_info ->  drawWlIDs $ _uvWorld u
    Pathing -> drawPathing (u ^. uvConfig) (u ^. uvWorld)
    Show_path_between ->  drawPathBetween $ _uvWorld u