--{-# LANGUAGE TupleSections #-}
module Dodge.Update.Scroll (
    updateWheelEvent,
) where

import NewInt
import Control.Applicative
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import Dodge.Data.Terminal.Status
import Dodge.Data.EquipType
import Padding
import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Data.Universe
import Dodge.Inventory
import Dodge.SelectionSections
import Dodge.Terminal
import Geometry
import LensHelp
import SDL

-- yi should be nonzero
updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . subInventory of
    NoSubInventory -> updateBaseWheelEvent yi w
    ExamineInventory -> updateBaseWheelEvent yi w
    MapperInventory{} -> updateBaseWheelEvent yi w
    CombineInventory{} -> moveCombineSel yi w
    DisplayTerminal tmid -> terminalWheelEvent yi tmid w

-- yi should be nonzero
updateBaseWheelEvent :: Int -> World -> World
updateBaseWheelEvent yi w
--    | Just True <- w ^? cWorld . lWorld . creatures . ix 0 . crInvLock = w
    | Just True <- w ^? cWorld . lWorld . lInvLock = w
    | bdown ButtonRight = case _rbOptions w of
        EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
        NoRightButtonOptions -> fromMaybe w (selectedItemScroll yi w)
    | bdown ButtonLeft = w & wCam . camZoom +~ fromIntegral yi
    | ScancodeCapsLock `M.member` _pressedKeys (_input w) = changeSwapSel yi w
    | otherwise = scrollAugInvSel yi w
  where
    bdown b = w & has (input . mouseButtons . ix b)
    rbscrollmax = fromMaybe 1 $ do
        invid <- you w ^? crManipulation . manObject . imSelectedItem
        esite <- you w ^? crInv . ix invid >>= \k -> w ^? cWorld . lWorld . items . ix k >>= equipType -- . itUse . uequipEffect . eeType
        return . length $ eqSiteToPositions esite

selectedItemScroll :: Int -> World -> Maybe World
selectedItemScroll yi w = do
    i <- you w ^? crManipulation . manObject . imSelectedItem
    itm <- you w ^? crInv . ix i >>= \k -> w ^? cWorld . lWorld . items . ix k
    return $ itemScroll yi itm w

itemScroll :: Int -> Item -> World -> World
itemScroll yi itm w
    | Just xs <- itm ^? itUse . uaParams . apProjectiles = w
        & itmlens . itUse . uaParams . apProjectiles .~ rotateList yi xs
    | ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom (itm ^. itID) w
    | HELD ALTERIFLE <- itm ^. itType
      , yi /= 0 =
        w
            & itmlens . itParams . alteRifleSwitch
                %~ ((`mod` 2) . (+ 1))
    | isJust $ itm ^? itScroll . itsInt = w & itmlens . itScroll . itsInt +~ yi
    | Just y <- itm ^? itScroll . itsMax = w & itmlens . itScroll . itsRangeInt 
        %~ ((`mod` y) . (+ yi))
    | otherwise = w
  where
    --itmlens = cWorld . lWorld . creatures . ix 0 . crInv . ix invid
    itmlens = cWorld . lWorld . items . ix (itm ^. itID . unNInt)

-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
updateScopeZoom :: NewInt ItmInt -> World -> World
updateScopeZoom itid w
    | Just 0 <- w ^. input . mouseButtons . at SDL.ButtonRight =
        w
            & wppointer %~ resetscope
    | Just _ <- w ^. input . mouseButtons . at SDL.ButtonRight =
        w & wppointer %~ doScopeZoom (w ^. input . smoothScrollAmount) (w ^. input . mousePos)
    | otherwise = w & wppointer %~ resetscope
  where
    wppointer = cWorld . lWorld . items . ix (_unNInt itid) . itUse . uScope
    resetscope (OpticScope _ _ defz) = OpticScope (V2 0 0) defz defz

doScopeZoom :: Int -> Point2 -> Scope -> Scope
doScopeZoom scrollamount mp sc = case scrollamount of
    x
        | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc
        | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc
        | x > 0 -> zoomInLongGun mp sc
        | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc
        | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc
        | x < 0 -> zoomOutLongGun sc
        | otherwise -> sc

zoomSpeed :: Float
zoomSpeed = 39 / 40

zoomInLongGun :: Point2 -> Scope -> Scope
zoomInLongGun mousep sc = fromMaybe sc $ do
    curzoom <- sc ^? opticZoom
    guard $ curzoom < 8
    return $
        sc & opticPos .+.+~ (1 - zoomSpeed) * zoomSpeed / curzoom *.* mousep
            & opticZoom %~ (/ zoomSpeed)

zoomOutLongGun :: Scope -> Scope
zoomOutLongGun sc = fromMaybe sc $ do
    curzoom <- sc ^? opticZoom
    guard $ curzoom > 0.5
    return $
        sc & opticPos %~ (\p -> p +.+ (zoomSpeed - 1) / curzoom *.* p)
            & opticZoom *~ zoomSpeed

moveCombineSel :: Int -> World -> World
moveCombineSel yi =
    ( hud . subInventory %~ doscroll
    )
        . (worldEventFlags . at CombineInventoryChange ?~ ())
  where
    doscroll ci = fromMaybe ci $ do
        sss <- ci ^? ciSections
        return $ ci & ciSelection %~ scrollSelectionSections yi sss

terminalWheelEvent :: Int -> Int -> World -> World
terminalWheelEvent yi tmid w
    | w & has (input . mouseButtons . ix ButtonRight)
      , Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
        w & cWorld . lWorld . terminals . ix tmid %~ g
    | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
        w & cWorld . lWorld . terminals . ix tmid %~ f
    | otherwise = w
  where
    dowrap = if yi > 0 then wrapup else wrapdown
    wrapup s coms = PTE.findSuccessor s coms <|> PTE.findMin coms
    wrapdown s coms = PTE.findPredecessor s coms <|> PTE.findMax coms
    f tm = fromMaybe tm $ do
        let coms = getCommands w tm
        x <- tm ^? tmStatus . tiText 
        let s = fromMaybe "" $ x ^? to words . ix 0
        (s',_) <- dowrap s coms
        return $ tm & tmStatus . tiText .~ s'
    g tm = fromMaybe tm $ do
        let coms = getCommands w tm
        x <- tm ^? tmStatus . tiText
        let s = fromMaybe "" $ x ^? to words . ix 0
            y = fromMaybe "" $ x ^? to words . ix 1
--        (s',m) <- fmap (s,) (PTE.lookup s coms) <|> dowrap s coms
--        (arg,_) <- dowrap y m
        (s',arg,_) <- if yi > 0 then doubleFindSucc s y coms <|> doubleFindMin coms
            else doubleFindPred s y coms <|> doubleFindMax coms
        return $ tm & tmStatus . tiText .~ s' ++ " " ++ arg
    --case tm ^? tmInput . tiSel of
--        Nothing -> tm & tmInput . tiSel .~ (0, 0)
--        Just (i, _) ->
--            let newi = (i - yi) `mod` length (scrollCommandStrings w tm)
--             in tm & setInput newi 0
--    updatetermsubsel tm = case tm ^? tmInput . tiSel of
--        Nothing -> tm & tmInput . tiSel .~ (0, 0)
--        Just (i, j) ->
--            let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
--             in tm & setInput i newj
--    setInput i j tm =
--        tm
--            & tmInput . tiSel .~ (i, j)
--            & tmStatus . tiText .~ comstr ++ arg
--      where
--        comstr = scrollCommandStrings w tm !! i
--        tc = scrollCommands tm !! i
--        arg = getArguments' tc tm w !! j

doubleFindMin :: (Enum a,Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
doubleFindMin m = do
    (x,n) <- PTE.findMin m
    case PTE.findMin n of
        Just (y,z) -> Just (x,y,z)
        Nothing -> Nothing

doubleFindSucc :: (Enum a,Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
doubleFindSucc xs ys m = case PTE.lookup xs m of
    Just m' -> case PTE.findSuccessor ys m' of
        Just (ys',z) -> Just (xs,ys',z)
        Nothing -> dfs xs m
    Nothing -> dfs xs m
  where
    dfs xs' m' = case PTE.findSuccessor xs' m' of
        Just (xs'',n) -> case PTE.findMin n of
            Just (ys',z) -> Just (xs'',ys',z)
            Nothing -> dfs xs'' m'
        Nothing -> Nothing

-- there are edge cases where this doesn't behave as might be expected
doubleFindMax :: (Enum a,Enum b) => PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
doubleFindMax m = do
    (x,n) <- PTE.findMax m
    case PTE.findMax n of
        Just (y,z) -> Just (x,y,z)
        Nothing -> Nothing

doubleFindPred :: (Enum a,Enum b) => [a] -> [b] -> PTE.TrieMap a (PTE.TrieMap b c) -> Maybe ([a],[b],c)
doubleFindPred xs ys m = case PTE.lookup xs m of
    Just m' -> case PTE.findPredecessor ys m' of
        Just (ys',z) -> Just (xs,ys',z)
        Nothing -> dfs xs m
    Nothing -> dfs xs m
  where
    dfs xs' m' = case PTE.findPredecessor xs' m' of
        Just (xs'',n) -> case PTE.findMax n of
            Just (ys',z) -> Just (xs'',ys',z)
            Nothing -> dfs xs'' m'
        Nothing -> Nothing

scrollRBOption :: Int -> Int -> Int -> Int
scrollRBOption dy ymax
    | dy < 0 = min (ymax -1) . subtract dy
    | dy > 0 = max 0 . subtract dy
    | otherwise = id