120 lines
4.8 KiB
Haskell
120 lines
4.8 KiB
Haskell
module Dodge.Update.Scroll where
|
|
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import qualified Data.Text as T
|
|
import Dodge.Base
|
|
import Dodge.Combine
|
|
import Dodge.Data.Universe
|
|
import Dodge.Event.Keyboard
|
|
import Dodge.HeldScroll
|
|
import Dodge.InputFocus
|
|
import Dodge.Inventory
|
|
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 ^. cWorld . lWorld . hud . hudElement of
|
|
DisplayCarte
|
|
| rbDown -> w & cWorld . lWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *)
|
|
| otherwise -> w & cWorld . lWorld . selLocation %~ (`mod` numLocs) . (+ yi)
|
|
DisplayInventory 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{}) -> scrollRBOption y w
|
|
(Nothing, _) -> closeObjScrollDir y w
|
|
(Just f, _) -> doHeldScroll f y (you w) w
|
|
| lbDown -> w & cWorld . lWorld . camPos . camZoom +~ y
|
|
| invKeyDown -> changeSwapInvSel yi w
|
|
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
|
|
DisplayInventory (TweakInventory mi)
|
|
| invKeyDown && rbDown -> w & moveTweakSel yi
|
|
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
|
|
| rbDown -> w & changeTweakParam mi yi
|
|
| otherwise -> w & moveTweakSel yi
|
|
DisplayInventory CombineInventory{} ->
|
|
w
|
|
& cWorld . lWorld . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
|
|
DisplayInventory (DisplayTerminal tmid)
|
|
| rbDown && inTermFocus w ->
|
|
guardDisconnectedID tmid w $
|
|
w
|
|
& cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
|
|
| inTermFocus w ->
|
|
w
|
|
& cWorld . lWorld . terminals . ix tmid %~ updatetermsel
|
|
_ -> w
|
|
where
|
|
updatetermsel tm = case tm ^? tmInput . tiSel of
|
|
Nothing -> tm & tmInput . tiSel .~ (0, 0)
|
|
Just (i, _) ->
|
|
let newi = (i - yi) `mod` length (scrollCommands tm)
|
|
in tm & setInput newi 0 w
|
|
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 w
|
|
setInput i j w' tm =
|
|
tm
|
|
& tmInput . tiSel .~ (i, j)
|
|
& tmInput . tiText .~ T.pack (_tcString tc ++ " " ++ arg)
|
|
where
|
|
tc = scrollCommands tm !! i
|
|
arg = getArguments' tc tm w' !! j
|
|
numcombs = length $ combineItemListYou w
|
|
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 `S.member` _keys (_input w)
|
|
|
|
scrollRBOption :: Float -> World -> World
|
|
scrollRBOption y w
|
|
| y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w)) -1) . (+ 1))
|
|
| y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
|
|
| otherwise = w
|
|
|
|
moveTweakSel :: Int -> World -> World
|
|
moveTweakSel i w = case yourItem w ^? _Just . itTweaks . tweakParams of
|
|
Just l -> w & cWorld . lWorld . hud . hudElement . subInventory . tweakInvSel . _Just %~ (`mod` length l) . subtract i
|
|
_ -> w
|
|
|
|
changeTweakParam :: Maybe Int -> Int -> World -> World
|
|
changeTweakParam mi i w = fromMaybe w $ do
|
|
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 (crSel (you w))
|
|
%~ ( (itTweaks . tweakParams . ix paramid . tweakVal .~ x)
|
|
. doTweak (_tweakType params) x
|
|
)
|
|
|
|
scrollCommands :: Terminal -> [TerminalCommand]
|
|
scrollCommands = (nullCommand :) . _tmScrollCommands
|
|
|
|
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 -> M.keys m
|