{-# LANGUAGE LambdaCase #-}

module Dodge.Debug (debugEvents, drawDebug) where

import Dodge.Base.Coordinate
import Dodge.Zoning.Creature
import Dodge.Creature.Radius
import Geometry.Data
import Dodge.Render.Label
import Dodge.HeldUse
import Dodge.DoubleTree
import Dodge.Item.Grammar
import NewInt
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
import Data.List (sortOn)

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
    & debugEvent' db

-- possibly don't want this running when the game is paused/not running normally
-- note this happens before functionalUpdate
debugEvent' :: DebugBool -> Universe -> Universe
debugEvent' = \case
    Collision_test -> id
    Circ_collision_test -> id
    Show_walls_near_point_cursor -> id
    Show_walls_near_segment -> id
    Display_debug -> id
    Noclip -> id
    Remove_LOS -> id
    Cull_more_lights -> id
    Close_shape_culling -> id
    Bound_box_screen -> id
    Show_ms_frame -> id
    View_gr_boundaries -> id
    View_rm_boundaries -> id
    Show_bound_box -> id
    Show_wall_search_rays -> id
    Show_dda_test -> id
    Show_far_wall_detect -> id
    Show_walls_near_you -> id
    Show_zone_near_point_cursor -> id
    Show_zone_circ -> id
    Inspect_wall -> id
    Cr_awareness -> id
    Show_sound -> id
    Cr_status -> id
    Mouse_position -> id
    Walls_info -> id
    Pathing -> id
    Show_path_between -> id
    Show_writable_values -> id
    Show_mouse_click_pos -> id
    Debug_get -> id
    Debug_put -> id
    Muzzle_positions -> id
    Show_cr_hitboxes -> id
    Clipboard_cr -> clipboardCr

clipboardCr :: Universe -> Universe
clipboardCr u = fromMaybe u $ do
    guard (u ^. uvWorld . input . mouseButtons . at SDL.ButtonLeft == Just 0)
    return $ u & uvIOEffects %~ (\m u' -> setClipboard s >> m u')
  where
    s = unlines . prettyShort $ closestCrToMouse $ u ^. uvWorld

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_gr_boundaries -> mempty
    View_rm_boundaries -> mempty
    Show_bound_box -> mempty
    Show_wall_search_rays -> mempty
    Show_dda_test -> mempty
    Show_far_wall_detect -> mempty
    Show_walls_near_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
    Muzzle_positions -> mempty
    Show_cr_hitboxes -> mempty
    Clipboard_cr -> mempty

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_gr_boundaries -> viewGameRoomBoundaries $ _uvWorld u
    View_rm_boundaries -> viewRoomBoundaries $ _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_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
    Muzzle_positions -> showMuzzlePositions u
    Show_cr_hitboxes -> foldMap drawCreatureRad (u ^. uvWorld . cWorld . lWorld . creatures)
    Clipboard_cr -> foldMap drawCreatureRad (closestCrToMouse $ u^.uvWorld)

closestCrToMouse :: World -> Maybe Creature
closestCrToMouse w = listToMaybe . sortOn (distance mwp . (^. crPos . _xy))
        $ crsNearPoint mwp w
  where
    mwp = mouseWorldPos (w^.input) (w^.wCam)

drawCreatureRad :: Creature -> Picture
drawCreatureRad cr = setLayer DebugLayer
    . translate3 (cr ^. crPos)
    . color orange
    $ circle (crRad (cr ^. crType))

showMuzzlePositions :: Universe -> Picture
showMuzzlePositions  u = fold $ do
    cr <- u ^? uvWorld . cWorld . lWorld . creatures . ix 0
    invid <- u ^?uvWorld.hud . manObject . imRootSelectedItem . unNInt
--revise1    invid <- cr ^? crManipulation . manObject . imRootSelectedItem . unNInt
    loc <- invIndents ((\k -> u ^?! uvWorld . cWorld . lWorld . items . ix k) <$> _crInv cr) 
        ^? ix invid . _2
    return . color red $ setLayer DebugLayer $ reduceLocDT (f cr) loc
  where
    f cr loc = foldMap (g . muzzlePos (u^.uvWorld) loc cr)  (itemMuzzles loc)
      where
        g :: Point3Q -> Picture
        g pq = translate3 (pq ^. _1) $ crossPic 5