loop/src/Dodge/Update/Scroll.hs

module Dodge.Update.Scroll (
    updateWheelEvent,
) where

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 . hudElement . 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 >>= 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
    return $ itemScroll yi i itm w

itemScroll :: Int -> Int -> Item -> World -> World
itemScroll yi invid itm w
--    | isJust $ itm ^? itUse . uInt = w & itmlens . itUse . uInt +~ yi
    | Just xs <- itm ^? itUse . uaParams . apProjectiles = w
        & itmlens . itUse . uaParams . apProjectiles .~ rotateList yi xs
    | ATTACH ZOOMSCOPE <- itm ^. itType = updateScopeZoom invid 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

-- note that your _crInvLock does not apply to this TODO check that this is what
-- is wanted
updateScopeZoom :: Int -> World -> World
updateScopeZoom i 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 . creatures . ix 0 . crInv . ix i . 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 . hudElement . 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 %~ updatetermsubsel
    | Just TerminalTextInput{} <- w ^? cWorld . lWorld . terminals . ix tmid . tmStatus =
        w & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
    | otherwise = w
  where
    updatetermsel tm = 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

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

scrollCommands :: Terminal -> [TerminalCommand]
scrollCommands = (nullCommand :) . _tmScrollCommands

scrollCommandStrings :: World -> Terminal -> [String]
scrollCommandStrings w tm = case tm ^? tmPartialCommand . _Just of
    Nothing -> map _tcString $ scrollCommands tm
    Just tc -> "" : map tail (getArguments tc tm w)

getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm

nullCommand :: TerminalCommand
nullCommand =
    TerminalCommand
        { _tcString = ""
        , _tcAlias = []
        , _tcHelp = ""
        , _tcEffect = TerminalCommandEffectNone -- \_ _ -> NoArguments []
        }

getArguments :: TerminalCommand -> Terminal -> World -> [String]
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
    NoArguments{} -> []
    OneArgument _ m -> map (' ' :) $ M.keys m