module Dodge.Update.Scroll (
    updateWheelEvent,
) where

import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base
import Dodge.Data.Universe
--import Dodge.HeldScroll
import Dodge.Inventory
import Dodge.SelectionSections
--import Dodge.SoundLogic
import Dodge.Terminal
--import Dodge.Tweak
import qualified IntMapHelp as IM
import LensHelp
import SDL

updateWheelEvent :: Int -> World -> World
updateWheelEvent yi w = case w ^. hud . hudElement of
    DisplayCarte
        | bdown ButtonRight -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
        | otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
    DisplayInventory{_subInventory = NoSubInventory{}}
        -- functions that modify the inventory should be centralised so that
        -- this lock can be sensibly applied, perhaps
        | w ^?! cWorld . lWorld . creatures . ix 0 . crInvLock -> w
--        | rbDown -> case  (yourScrollAttachment w, _rbOptions w) of
--            (_,EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
--            (Nothing, _) -> w
--            (Just (invid,hs), _) -> doHeldScroll invid hs y w
        | bdown ButtonRight -> case   _rbOptions w of
            EquipOptions{} -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
            NoRightButtonOptions -> w
        | bdown ButtonLeft -> w & wCam . camZoom +~ y
        | invKeyDown -> changeSwapSel yi $ w-- & hud . hudElement . diSelectionExtra .~ mempty
        | otherwise -> scrollAugInvSel yi $ w-- & hud . hudElement . diSelectionExtra .~ mempty
    DisplayInventory{_subInventory = ExamineInventory}
        | invKeyDown -> scrollAugInvSel yi w
        | otherwise -> w
--        | invKeyDown && rbDown -> w & moveTweakSel yi
--        | invKeyDown -> scrollAugInvSel yi w
--        | rbDown -> w & changeTweakParam mi yi
--        | otherwise -> w & moveTweakSel yi
    DisplayInventory{_subInventory = CombineInventory{}} -> w & moveCombineSel yi
    DisplayInventory{_subInventory = DisplayTerminal tmid} -> terminalWheelEvent yi tmid w
    _ -> w
  where
    rbscrollmax = fromMaybe 1 $ do
        invid <- you w ^? crManipulation . manObject . imSelectedItem
        esite <- you w ^? crInv . ix invid . itUse . uequipEffect . eeSite
        return $ length $ equipSiteToPositions esite
    y = fromIntegral yi
    numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
    bdown b = b `M.member` _mouseButtons (_input w)
    invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)

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

--moveSubSel :: Int -> Int -> World -> World
--moveSubSel yi maxyi =
--    hud . hudElement . subInventory . subInvMSel . _Just
--        %~ ((`mod` maxyi) . subtract yi)

guardDisconnectedID :: Int -> World -> World -> World
guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid . tmStatus of
    Just TerminalReady -> w'
    _ -> w

terminalWheelEvent :: Int -> Int -> World -> World
terminalWheelEvent yi tmid w
    | rbDown =
        guardDisconnectedID tmid w $
            w
                & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
    | otherwise =
        guardDisconnectedID tmid w $
            w
                & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
  where
    rbDown = ButtonRight `M.member` _mouseButtons (_input w)
    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)
            & tmInput . 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

--moveTweakSel :: Int -> World -> World
--moveTweakSel i w = case yourSelectedItem w ^? _Just . itTweaks . tweakParams of
--    Just l -> moveSubSel i (length l) w
--    _ -> w

--changeTweakParam :: Maybe Int -> Int -> World -> World
--changeTweakParam mi i w = fromMaybe w $ do
--    curpos <- you w ^? crManipulation . manObject . imSelectedItem
--    paramid <- mi
--    params <- yourSelectedItem w ^? _Just . itTweaks . tweakParams . ix paramid
--    let x = (_tweakVal params + i) `mod` _tweakMax params
--    return $
--        w & cWorld . lWorld . creatures . ix 0 . crInv . ix curpos
--            %~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
--                    . doTweak (_tweakType params) x
--               )

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