{-# LANGUAGE LambdaCase #-}
module Dodge.Debug (debugEvents) where

import Data.Aeson.Types
import AesonHelp
import Control.Lens
import Data.List (sortOn)
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.Set as S
import Dodge.Base.Coordinate
import Dodge.Data.Universe
import Dodge.Debug.Picture
import Dodge.WorldEvent.ThingsHit
import Geometry.Vector
import qualified SDL
import Data.Ord
import Data.Foldable (fold)

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

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

debugItem :: DebugBool -> Universe -> Maybe DebugItem
debugItem = \case
    Collision_test -> constDPic (drawCollisionTest . _uvWorld)
    Circ_collision_test -> constDPic (drawCircCollisionTest . _uvWorld)
    Select_creature -> Just . selectCreatureDebugItem
    Show_walls_near_point_cursor -> constDPic (drawWallsNearCursor . _uvWorld)
    Show_walls_near_segment -> constDPic (drawWallsNearSegment . _uvWorld)
    Enable_debug -> const Nothing
    Noclip -> const Nothing
    Remove_LOS -> const Nothing
    Cull_more_lights -> const Nothing
    Close_shape_culling -> const Nothing
    Bound_box_screen -> const Nothing
    Show_ms_frame -> const Nothing
    View_boundaries -> constDPic (viewBoundaries . _uvWorld)
    Show_bound_box -> constDPic (drawBoundingBox . _uvWorld)
    Show_wall_search_rays -> constDPic $ drawWallSearchRays . _uvWorld
    Show_dda_test -> constDPic $ drawDDATest . _uvWorld
    Show_far_wall_detect -> constDPic $ drawFarWallDetect . _uvWorld
    Show_walls_near_point_you -> constDPic $ drawWallsNearYou . _uvWorld
    Show_zone_near_point_cursor -> constDPic $ drawZoneNearPointCursor . _uvWorld
    Show_zone_circ -> constDPic $ drawZoneCirc . _uvWorld
    Inspect_wall -> constDPic $ drawInspectWalls . _uvWorld
    Cr_awareness -> constDPic $ drawCreatureDisplayTexts . _uvWorld
    Show_sound ->  constDPic $ \u -> 
        fold (M.map (soundPic (u ^. uvConfig) (u ^. uvWorld)) $ u ^. uvWorld . playingSounds)
    Cr_status -> constDPic $ \u -> drawCrInfo (u ^. uvConfig) (u ^. uvWorld)
    Mouse_position -> constDPic $ drawMousePosition . _uvWorld
    Walls_info -> constDPic $ drawWlIDs . _uvWorld
    Pathing -> constDPic $ \u ->  drawPathing (u ^. uvConfig) (u ^. uvWorld)
    Show_path_between -> constDPic $ drawPathBetween . _uvWorld

constDPic :: (Universe -> Picture) -> Universe -> Maybe DebugItem
constDPic p u = Just $ DebugItem (p u) mempty NoDebugInfo

selectCreatureDebugItem :: Universe -> DebugItem
selectCreatureDebugItem u =
    DebugItem
        { _debugPic = mempty
        , _debugMessage = debugSelectCreatureMessage u
        , _debugInfo = scrollDebugInfoInt (length $ debugSelectCreatureList 0 u) u $ clickGetCreature u
        }

scrollDebugInfoInt :: Int -> Universe -> DebugInfo -> DebugInfo
scrollDebugInfoInt i u
    | SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =
        debugInt %~ ((`mod` i) . (+ (u ^. uvWorld . input . scrollAmount)))
    | otherwise = id

debugSelectCreatureMessage :: Universe -> [String]
debugSelectCreatureMessage u = fromMaybe
    [show (u ^? uvDebug . ix Select_creature . debugInfo . debugInt)]
    $ do
        cid <- u ^? uvDebug . ix Select_creature . debugInfo . debugMInt . _Just
        i <- u ^? uvDebug . ix Select_creature . debugInfo . debugInt
        cap <- debugSelectCreatureList cid u !! i
        return $ show cid : cap

debugSelectCreatureList :: Int -> Universe -> [Maybe [String]]
debugSelectCreatureList cid u =
    [ debugList "ActionPlan"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan)
    , debugList "Perception"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crPerception)
    , debugList "Intention"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crIntention)
    , debugList "Memory"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crMemory)
    , debugList "Strategy"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crActionPlan . apStrategy)
    , debugList "Vocalization"
        (u ^? uvWorld . cWorld . lWorld . creatures . ix cid . crVocalization)
    ]


debugList :: (Functor f, ToJSON a) => String -> f a -> f [String]
debugList str = fmap (([str] ++) . prettyShort )


clickGetCreature :: Universe -> DebugInfo
clickGetCreature u
    | SDL.ButtonLeft `M.member` (u ^. uvWorld . input . mouseButtons)
        && SDL.ScancodeRShift `M.member` (u ^. uvWorld . input . pressedKeys) =
        DebugIntMInt 0 (closestCreatureID u)
    | otherwise =
        fromMaybe (DebugIntMInt 0 Nothing) $
            u ^? uvDebug . ix Select_creature . debugInfo

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)