{-# LANGUAGE LambdaCase #-}
module Dodge.Render.Picture (
    fixedCoordPictures,
) where

import Control.Lens
import Data.Maybe
import Dodge.Base.Coordinate
import Dodge.Base.Window
import Dodge.Data.Universe
import Dodge.Render.HUD
import Dodge.Render.List
import Dodge.Render.MenuScreen
import Geometry
import HelpNum
import Picture

fixedCoordPictures :: Universe -> Picture
fixedCoordPictures u =
    aimDelaySweep u
        <> drawMenuOrHUD cfig u
        <> drawConcurrentMessage u
        <> ttl (translate (hw - 100) 0 $ drawList (map text (_uvTestString u u)))
        <> ttl
            ( translate (0.5 * hw) (- hh)
                . drawList
                . map text
                $ show (u ^. uvWorld . cWorld . lWorld . lTestInt) :
                (u ^. uvWorld . cWorld . lWorld . lTestString)
            )
        <> displayFrameTicks u
        <> drawMouseCursor u
        <> ( toTopLeft cfig . translate (1.3 * halfWidth cfig) 0
                . drawList
                . take 50
                . drop (u ^. uvDebugMessageOffset)
                . map text
                $ foldMap (`_debugMessage` u) (_uvDebug u) -- other debug pics in extraPics
           )
  where
    cfig = _uvConfig u
    hw = halfWidth cfig
    hh = halfHeight cfig
    ttl = toTopLeft cfig

displayFrameTicks :: Universe -> Picture
displayFrameTicks u
    | debugOn Show_ms_frame $ _uvConfig u =
        translate (-10) (- halfHeight (_uvConfig u) + 6)
            . scale 0.2 0.2
            $ fpsText (u ^. uvFrameTicks - u ^. uvLastFrameTicks)
    | otherwise = mempty

fpsText :: (Show a, Ord a, Num a) => a -> Picture
fpsText x = color col . text $ "ms/frame " ++ show x
  where
    col
        | x < 22 = blue
        | x < 30 = green
        | x < 40 = yellow
        | x < 50 = orange
        | otherwise = red

drawMenuOrHUD :: Configuration -> Universe -> Picture
drawMenuOrHUD cfig u = case u ^. uvScreenLayers of
    [] -> drawHUD (u ^. uvConfig) (u ^. uvWorld)
    (x : _) -> drawMenuScreen cfig (u ^? uvWorld . input . mouseContext . mcoMenuClick) x

drawConcurrentMessage :: Universe -> Picture
drawConcurrentMessage u =
    translate 0 (50 - halfHeight cfig)
        . stackPicturesAt
        . map (centerText . f)
        $ u ^.. uvSideEffects . each
  where
    cfig = _uvConfig u
    f (RunningSideEffect ce) = ce ++ " IN PROGRESS"
    f x = _ceString x ++ " QUEUED"

drawMouseCursor :: Universe -> Picture
drawMouseCursor u =
    uncurryV translate (u ^. uvWorld . input . mousePos)
        . color white
        . setDepth 1
        $ mouseCursorType u

mouseCursorType :: Universe -> Picture
mouseCursorType u = case u ^. uvWorld . input . mouseContext of
    NoMouseContext -> drawEmptySet 5
    MouseAiming -> rotate a (drawPlus 5)
    MouseMenuClick{} -> drawMenuClick 5
    MouseMenuCursor -> drawMenuCursor 5
    MouseInGame -> drawPlus 5
    OverInvDrag 0 (Just (3, _)) _ _ -> drawDragDrop 5
    OverInvDrag 0 Nothing _ _ -> drawDragDrop 5
    OverInvDrag 0 (Just (0, _)) _ _ -> drawDrag 5
    OverInvDrag 0 _ _ _ -> drawEmptySet 5
    OverInvDrag 3 (Just (3, _)) _ _ -> drawDrag 5
    OverInvDrag 3 (Just (0, _)) _ _ -> drawDragPickup 5
    OverInvDrag 3 (Just (1, _)) _ _ -> drawDragPickup 5
    OverInvDrag 3 Nothing _ _ -> drawDragPickup 5
    OverInvDrag 3 _ _ _ -> drawEmptySet 5
    OverInvDrag{} -> drawEmptySet 5
    OverInvDragSelect{} -> drawDragSelect 5
    OverInvSelect (-1, _) | selsec == Just (-1) -> drawJumpDown 5
    OverInvSelect (2, _) | selsec == Just 2 -> drawJumpDown 5
    OverInvSelect{} -> drawSelect 5
    OverCombFiltInv{} -> drawCombFilter 5
    OverCombSelect{} -> drawSelect 5
    OverCombFilter{} -> drawJumpDown 5
    OverCombCombine{} -> drawGapPlus 5
    OverCombEscape -> rotate (pi / 4) $ drawPlus 5
    OverTerminal _ ts -> drawCursorByTerminalStatus ts
    OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
    MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
  where
    w = u ^. uvWorld
    selsec = u ^? uvWorld . hud . hudElement . diSelection . _Just . _1
    a = fromMaybe 0 $ do
        cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
        return . toClosestMultiple (pi / 32) $
            argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
                - w ^. wCam . camRot

drawCursorByTerminalStatus :: TerminalStatus -> Picture
drawCursorByTerminalStatus = \case
    TerminalPressTo "QUIT" -> drawQuitTerminal 5
    TerminalPressTo _ -> drawArrowDown 5
    TerminalTextInput "QUIT" -> drawQuitTerminal 5
    TerminalTextInput{} -> drawReturn 5
    _ -> drawEmptySet 5

drawQuitTerminal :: Float -> Picture
drawQuitTerminal x = fold 
        [ line [V2 x x, V2 (- x) (- x)]
        , line [V2 x (-x), V2 (- x) x]
        , polygonWire (square x)
        ]

drawEmptySet :: Float -> Picture
drawEmptySet x =
    fold
        [ line [V2 x x, V2 (- x) (- x)]
        , circle x
        ]

drawReturn :: Float -> Picture
drawReturn x =
    fold
        [ line [V2 0 0, V2 y y]
        , line [V2 0 0, V2 y (- y)]
        , line [V2 0 0, V2 (2 * y) 0]
        , line [V2 (2 * y) 0, V2 (2 * y) (2 * x)]
        ]
  where
    y = 0.7 * x

--drawReturn = scale 0.1 0.1 . translate (-50) (-100) $ text [toEnum 153]

drawPlus :: Float -> Picture
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]

drawMenuClick :: Float -> Picture
drawMenuClick z =
    fold
        [ line [V2 y 0, V2 x 0]
        , line [V2 ny 0, V2 nx 0]
        , line [V2 0 ny, V2 0 nx]
        , line [V2 0 y, V2 0 x]
        ]
  where
    x = 0.5 * z
    y = x + z
    ny = - y
    nx = - x

drawMenuCursor :: Float -> Picture
drawMenuCursor z =
    fold
        [ line [V2 y 0, V2 x 0]
        , line [V2 ny 0, V2 nx 0]
        , line [V2 0 ny, V2 0 nx]
        , line [V2 0 y, V2 0 x]
        ]
  where
    x = z
    y = x + z
    ny = - y
    nx = - x

drawJumpDown :: Float -> Picture
drawJumpDown x =
    rotate (0.25 * pi) $
        fold [line [V2 0 0, V2 x 0], line [V2 0 0, V2 0 x]]

drawDragSelect :: Float -> Picture
drawDragSelect x = polygonWire $ rectWH (0.5 * x) x

drawDrag :: Float -> Picture
drawDrag x =
    line [V2 0 y, V2 0 z]
        <> line [V2 0 (- y), V2 0 (- z)]
        <> line [V2 (- w) (z - w), V2 0 z, V2 w (z - w)]
        <> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
        <> drawSelect 5
  where
    z = 1.5 * x
    y = 0.5 * x
    w = 0.3 * x

drawVerticalDoubleArrow :: Float -> Picture
drawVerticalDoubleArrow x =
    line [V2 0 z, V2 0 (- z)]
        <> line [V2 (- w) (z - w), V2 0 z, V2 w (z - w)]
        <> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
  where
    z = 1.5 * x
    w = 0.6 * x

drawArrowDown :: Float -> Picture
drawArrowDown x =
    line [V2 0 z, V2 0 (- z)]
        <> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
  where
    z = 1 * x
    w = 0.6 * x

drawDragDrop :: Float -> Picture
drawDragDrop x =
    line (fmap (+ V2 z (- x)) [V2 (- x) x, V2 0 x, V2 0 (- x)])
        <> line (fmap (+ V2 z (- x)) [V2 (- y) (y - x), V2 0 (- x), V2 y (y - x)])
        <> drawSelect 5
  where
    z = 1.5 * x
    y = 0.7 * x

drawDragPickup :: Float -> Picture
drawDragPickup x =
    line [V2 (-0.5 * x) 0, V2 (- z) 0, V2 (- z) z]
        <> line [V2 (- (z + y)) (z - y), V2 (- z) z, V2 (y - z) (z - y)]
        <> drawSelect 5
  where
    z = 1.5 * x
    y = 0.7 * x

--drawFiltDrag :: Float -> Picture
--drawFiltDrag x = polygonWire
--    [ V2 0 y
--    , V2 x y
--    , V2 0 (-y)
--    , V2 (-x) (-y)
--    ]
--  where
--    y = 0.5 * x

drawSelect :: Float -> Picture
drawSelect x = polygonWire $ rectWH (0.5 * x) (0.5 * x)

--    line [V2 (-x) 0, V2 0 0]
--drawSelect x = line
--    [ V2 x x
--    , V2 0 x
--    , V2 0 (-x)
--    , V2 x (-x)
--    ] <>
--    line [V2 (-x) 0, V2 0 0]

drawCombFilter :: Float -> Picture
drawCombFilter x =
    rotate (0.25 * pi) $
        fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 0]]

--drawDoublePlus :: Float -> Picture
--drawDoublePlus x = fold [line [V2 (- (1.5*x)) 0, V2 (1.5*x) 0]
--    , line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
--    , line [V2 (negate 0.5 * x) (- x), V2 (negate 0.5 * x) x]
--    ]

drawGapPlus :: Float -> Picture
drawGapPlus x =
    fold
        [ line [V2 (-1.5 * x) 0, V2 (-0.5 * x) 0]
        , line [V2 (0.5 * x) 0, V2 (1.5 * x) 0]
        , line [V2 (0.5 * x) (- x), V2 (0.5 * x) x]
        , line [V2 (-0.5 * x) (- x), V2 (-0.5 * x) x]
        ]

aimDelaySweep :: Universe -> Picture
aimDelaySweep u = fold $ do
    let w = u ^. uvWorld
    cr <- w ^? cWorld . lWorld . creatures . ix 0
    Aiming{} <- cr ^? crStance . posture
    return $ drawAimSweep cr w

drawAimSweep :: Creature -> World -> Picture
drawAimSweep cr w = fold $ do
    a <- safeArgV (mwp -.- p)
    return $
        uncurryV translate (worldPosToScreen campos p) $
            arcFull (a - rot) 10 white (a + diffAngles cdir a - rot) 1 white (5 + dist mwp p * campos ^. camZoom) white
  where
    cdir = _crDir cr
    rot = campos ^. camRot
    p = _crPos cr
    campos = w ^. wCam
    mwp = w ^. cWorld . lWorld . lAimPos