diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index eaa87ce7a..9f352e5d6 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -92,15 +92,10 @@ handleResizeEvent sev u = handleMouseWheelEvent :: MouseWheelEventData -> Universe -> Maybe Universe handleMouseWheelEvent mwev w = case _uvScreenLayers w of [] -> case mouseWheelEventPos mwev of - V2 _ y -> Just $ w & uvWorld %~ wheelEvent (fromIntegral y) + V2 _ y -> Just $ w -- & uvWorld %~ wheelEvent (fromIntegral y) & uvWorld . scrollAmount +~ fromIntegral y _ -> Just w ---wheelEvent' :: Int -> World -> World ---wheelEvent' y w = case w ^. timeFlow of --- ScrollTimeFlow -> wheelTimeEvent y w --- _ -> wheelEvent y w - wheelEvent :: Float -> World -> World wheelEvent y w = case _hudElement $ _hud (_cWorld w) of DisplayCarte diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index e5c94f276..1466dafc7 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -9,9 +9,11 @@ module Dodge.Update (updateUniverse) where import Color --import Dodge.Zone +import Dodge.Update.Scroll import Control.Applicative import Data.List import qualified Data.Map.Strict as M +import qualified Data.Set as S import Data.Maybe import Dodge.Base import Dodge.Beam @@ -61,6 +63,7 @@ import LensHelp import SDL import Sound.Data import StrictHelp +import qualified Data.Text as T updateUniverse :: Universe -> Universe updateUniverse = updateUniverseLast . updateUniverseFirst @@ -198,8 +201,15 @@ functionalUpdate w = . over uvWorld updateRBList . updateBounds -- where should this go? next to update camera? . over uvWorld updateCloseObjects + . over uvWorld updateWheelEvents $ over uvWorld updatePastWorlds w +updateWheelEvents :: World -> World +updateWheelEvents w = foldr ($) w (replicate (abs y) (updateWheelEvent (signum y))) + where + y = w ^. scrollAmount + + advanceScrollAmount :: Universe -> Universe advanceScrollAmount u = u diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs new file mode 100644 index 000000000..430cf6897 --- /dev/null +++ b/src/Dodge/Update/Scroll.hs @@ -0,0 +1,160 @@ +module Dodge.Update.Scroll where +import Dodge.Terminal +import Dodge.Tweak +import Dodge.Combine +import Dodge.Event.Keyboard +import Control.Applicative +import Data.List +import qualified Data.Map.Strict as M +import qualified Data.Set as S +import Data.Maybe +import Dodge.Base +import Dodge.Beam +import Dodge.InputFocus +import Dodge.Bullet +import Dodge.HeldScroll +import Dodge.CrGroupUpdate +import Dodge.Creature.Update +import Dodge.CullBox +import Dodge.Data.Universe +import Dodge.Distortion +import Dodge.DrWdWd +import Dodge.EnergyBall +import Dodge.Flame +import Dodge.Flare +import Dodge.Hammer +import Dodge.Inventory +import Dodge.Item.Location +import Dodge.Laser.Update +import Dodge.LightSource.Update +import Dodge.LinearShockwave.Update +import Dodge.Machine.Update +import Dodge.Magnet.Update +import Dodge.Menu +import Dodge.ModificationEffect +import Dodge.PosEvent +import Dodge.PressPlate +import Dodge.Projectile.Update +import Dodge.Prop.Update +import Dodge.RadarBlip +import Dodge.RadarSweep +import Dodge.Shockwave.Update +import Dodge.SoundLogic +import Dodge.Spark +import Dodge.Tesla.Arc +import Dodge.TmTm +import Dodge.TractorBeam.Update +import Dodge.Update.Camera +import Dodge.Update.Cloud +import Dodge.Update.WallDamage +import Dodge.WallCreatureCollisions +import Dodge.WorldEffect +import Dodge.Zoning.Cloud +import Dodge.Zoning.Creature +import Geometry +import qualified IntMapHelp as IM +import LensHelp +--import MaybeHelp +import SDL +import Sound.Data +import StrictHelp +import qualified Data.Text as T + +updateWheelEvent :: Int -> World -> World +updateWheelEvent yi w = case w ^. cWorld . hud . hudElement of + DisplayCarte + | rbDown -> w & cWorld . hud . carteZoom %~ min 0.75 . max 0.05 . ((1 + y * 0.1) *) + | otherwise -> w & cWorld . selLocation %~ (`mod` numLocs) . (+ yi) + DisplayInventory NoSubInventory + -- functions that modify the inventory should be centralised so that + -- this lock can be sensibly applied, perhaps + | _crInvLock (_creatures (_cWorld w) IM.! _yourID (_cWorld w)) -> 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 . cwCam . cwcZoom +~ 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 . hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) + DisplayInventory (DisplayTerminal tmid) + | rbDown && inTermFocus w -> + guardDisconnectedID tmid w $ + w + & cWorld . terminals . ix tmid %~ updatetermsubsel + | inTermFocus w -> + w + & cWorld . 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 $ _seenLocations (_cWorld w)) + 1 + rbDown = ButtonRight `M.member` _mouseButtons w + lbDown = ButtonLeft `M.member` _mouseButtons w + invKeyDown = ScancodeCapsLock `S.member` _keys 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 . 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 . creatures . ix (_yourID (_cWorld w)) . 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