{-# LANGUAGE LambdaCase #-}

module Dodge.Debug (debugEvents, drawDebug) where

import AesonHelp
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 qualified SDL
import System.Hclip
import Text.Read

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 -> Just . return . debugShowPath
    Show_writable_values -> debugWritableValues
    Show_mouse_click_pos -> debugMouseClickPos
    Debug_get -> doDebugGet
    Debug_put -> debugPutItems

debugGet :: Universe -> [String]
debugGet u = foldMap getPretty $ u ^. uvWorld . cWorld . lWorld . shockwaves


debugPutItems :: Universe -> Maybe [DebugItem]
debugPutItems u = Just $ f <$> [0..debugPutN]
  where
    f i = DebugItem (g i) (doDebugPut i) -- (uvIOEffects %~ doDebugPut i)
    g i = fromMaybe "Not assigned" $ u ^? uvDebugPut . ix i

debugPutN :: Int
debugPutN = 5

doDebugPut :: Int -> Universe -> Universe
doDebugPut i u
    | u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0 = u 
        & uvIOEffects %~ \ f u' -> do 
            s <- getClipboard
            f $ u' & uvDebugPut . at i ?~ s
    | otherwise = u

debugPutDraw :: IM.IntMap String -> Universe -> Picture
debugPutDraw _ _ = mempty

doDebugGet :: Universe -> Maybe [DebugItem]
doDebugGet u =
    Just $ f <$> debugGet u
  where
    f s = DebugItem s (setClip s)


debugShowPath :: Universe -> DebugItem
debugShowPath u =
    DebugItem (u ^. uvDebugPathShowType . to show) f
  where
    f u' = fromMaybe u' $ do
        guard (u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
        return (u' & uvDebugPathShowType %~ succB)

succB :: (Eq a, Bounded a, Enum a) => a -> a
succB x
    | x == maxBound = minBound
    | otherwise = succ x

debugWritableValues :: Universe -> Maybe [DebugItem]
debugWritableValues u =
    Just $
        mapMaybe f
            [ (uvDebugV2_1, uvDebugV2_1)
            , (uvDebugV2_2, uvDebugV2_2)
            ]
  where
    f (gt, st) = do
        s <- u ^? gt
        return $ DebugItem (show s) (applyClip st)

applyClip ::
    Read b =>
    ((a -> Identity b) -> Universe -> Identity Universe) ->
    Universe ->
    Universe
applyClip l u' = fromMaybe u' $ do
    guard (u' ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
    return $ u' & uvIOEffects %~ f
  where
    f g u = do
        s <- getClipboard
        case readMaybe s of
            Just x -> g (u & l .~ x)
            Nothing -> g u

debugMouseClickPos :: Universe -> Maybe [DebugItem]
debugMouseClickPos u =
    Just $
        mapMaybe
            f
            [ uvWorld . input . clickPos . at SDL.ButtonLeft
            , uvWorld . input . clickPos . at SDL.ButtonRight
            , uvWorld . input . heldPos . at SDL.ButtonLeft
            , uvWorld . input . heldPos . at SDL.ButtonRight
            , uvWorld . input . clickWorldPos . at SDL.ButtonLeft
            , uvWorld . input . clickWorldPos . at SDL.ButtonRight
            , uvWorld . input . heldWorldPos . at SDL.ButtonLeft
            , uvWorld . input . heldWorldPos . at SDL.ButtonRight
            ]
  where
    f l = do
        s <- show <$> u ^. l
        return $ DebugItem s (setClip s)

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 ls x = do
        rs <- show <$> 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 "crID" $ cr ^? crID
                , g "crHP" $ cr ^? crHP . _HP
                , g "crStrategy" $ cr ^? crActionPlan . apStrategy
                , g "crPos" $ cr ^? crPos . _xy
                , g "cpVigilance" $ cr ^? crPerception . cpVigilance
                , g "crAction" $ cr ^? crActionPlan . apAction
--                , g "crImpulse" $ cr ^? crActionPlan . apImpulse
                , g "crName" $ cr ^? crName
                , g "crIntention" $ cr ^? crIntention
                ]

setClip :: String -> Universe -> Universe
setClip s u = fromMaybe u $ do
    guard (u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
    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
    Debug_put -> debugPutDraw (u ^. uvDebugPut) u
    Debug_get -> mempty
    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 u
    Show_writable_values -> mempty
    Show_mouse_click_pos -> mempty