loop/src/Dodge/Update/Scroll.hs

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.InputFocus
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
        | rbDown -> 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 (yourItem w ^? _Just . itUse . heldScroll, _rbOptions w) of
            (_, EquipOptions{}) -> w & rbOptions . opSel %~ scrollRBOption yi rbscrollmax
            (Nothing, _) -> closeObjScrollDir y w
            (Just f, _) -> doHeldScroll f y (you w) w
        | lbDown -> w & wCam . camZoom +~ y
        | invKeyDown -> changeSwapSel yi w
        | otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
    DisplayInventory{_subInventory = ExamineInventory mi}
        | invKeyDown && rbDown -> w & moveTweakSel yi
        | invKeyDown -> stopSoundFrom (CrReloadSound 0) $ 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 . inInventory . ispItem
        esite <- you w ^? crInv . ix invid . itUse . equipEffect . eeSite
        return $ length $ equipSiteToPositions esite
    y = fromIntegral yi
    numLocs = (fst . IM.findMax $ (w ^. cWorld . lWorld . seenLocations)) + 1
    rbDown = ButtonRight `M.member` _mouseButtons (_input w)
    lbDown = ButtonLeft `M.member` _mouseButtons (_input w)
    invKeyDown = ScancodeCapsLock `M.member` _pressedKeys (_input w)

moveCombineSel :: Int -> World -> World
moveCombineSel yi =
    ( hud . hudElement . subInventory . ciSections
        %~ scrollSelectionSections yi
    )
        . (worldEventFlags . at CombineInventoryChange ?~ ())

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 && inTermFocus w =
        guardDisconnectedID tmid w $
            w
                & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
    | inTermFocus w =
        guardDisconnectedID tmid w $
            w
                & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
    | otherwise = w
  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 yourItem 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 . inInventory . ispItem
    paramid <- mi
    params <- yourItem 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