diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index a07cb3b31..eabf76b9d 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -16,10 +16,10 @@ module Dodge.Event ( ) where import Dodge.Concurrent -import LensHelp import Dodge.Data.Universe import Dodge.Event.Input import Dodge.PreloadData +import LensHelp import SDL handleEvent :: Event -> Universe -> Universe @@ -40,7 +40,8 @@ handleEvent e u = case eventPayload e of -- | Sets window position in config. handleWindowMoveEvent :: WindowMovedEventData -> Universe -> Universe -handleWindowMoveEvent mev = (uvConfig . windowPosX .~ fromIntegral x) +handleWindowMoveEvent mev = + (uvConfig . windowPosX .~ fromIntegral x) . (uvConfig . windowPosY .~ fromIntegral y) where P (V2 x y) = windowMovedEventPosition mev @@ -51,10 +52,10 @@ handleWindowMoveEvent mev = (uvConfig . windowPosX .~ fromIntegral x) -- later may be a good idea handleResizeEvent :: WindowSizeChangedEventData -> Universe -> Universe handleResizeEvent sev u = - u - & uvConfig . windowX .~ fromIntegral x - & uvConfig . windowY .~ fromIntegral y - & uvIOEffects %~ sideEffectUpdatePreload divRes x y + u + & uvConfig . windowX .~ fromIntegral x + & uvConfig . windowY .~ fromIntegral y + & uvIOEffects %~ sideEffectUpdatePreload divRes x y where x = fromIntegral x' y = fromIntegral y' diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 839a7f411..0a630eab1 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -31,13 +31,14 @@ handleKeyboardEvent kev = case keyboardEventKeyMotion kev of handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input handleMouseMotionEvent mmev cfig = - (mousePos - .~ V2 - (fromIntegral x - 0.5 * _windowX cfig) - (0.5 * _windowY cfig - fromIntegral y) - ) . (mouseMoving .~ True) + set mousePos themousepos + . set mouseMoving True where P (V2 x y) = mouseMotionEventPos mmev + themousepos = + V2 + (fromIntegral x - 0.5 * _windowX cfig) + (0.5 * _windowY cfig - fromIntegral y) handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y @@ -46,7 +47,7 @@ handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of - Released -> mouseButtons . at thebutton .~ Nothing - Pressed -> mouseButtons . at thebutton ?~ False + Released -> pointtothebutton .~ Nothing + Pressed -> pointtothebutton ?~ False where - thebutton = mouseButtonEventButton mbev + pointtothebutton = mouseButtons . at (mouseButtonEventButton mbev) diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 874a16421..72d2a05f3 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -502,10 +502,9 @@ crAtMuzPos f it cr = f it (cr & crPos +.+.~ (aimingMuzzlePos cr it *.* unitVecto - rotation amount given by inaccuracy in itParams -} applyInaccuracy :: ChainEffect -applyInaccuracy f it cr w = f it (cr & crDir +~ a) $ set randGen g w +applyInaccuracy f it = withRandomDirI acc f it where acc = _brlInaccuracy . _gunBarrels $ _itParams it - (a, g) = randomR (- acc, acc) $ _randGen w -- | Applies the effect to a randomly rotated creature. withRandomDirI :: diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 2072a9bd7..96216b719 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -4,7 +4,9 @@ module Dodge.Menu ( splashMenu, ) where +import qualified Data.Aeson.Encode.Pretty as AEP import Control.Monad +import Data.ByteString.Lazy.Char8 (unpack) --import SDL import Data.Maybe @@ -41,6 +43,7 @@ splashMenuOptions = , Toggle (pushScreen $ seedStartMenu "START FROM SEED") (opText "NEW WITH SPECIFIC SEED") , Toggle (pushScreen optionMenu) (opText "OPTIONS") , Toggle (pushScreen displayControls) (opText "VIEW CONTROLS") + , Toggle (pushScreen displayConfig) (opText "VIEW CONFIG") , Toggle id (displaywhenseed "VIEW LAST SEED") , Toggle hardQuit (opText "QUIT") ] @@ -200,6 +203,13 @@ gameOverMenu u = unpause :: Universe -> Universe unpause w = resumeSound $ w & uvScreenLayers .~ [] +-- note that this won't update after it is first loaded +displayConfig :: Universe -> ScreenLayer +displayConfig u = titleOptionsNoWrite "CONFIG" (map (Toggle id . const . MODString) $ listConfig u) u + +listConfig :: Universe -> [String] +listConfig u = lines $ unpack $ AEP.encodePretty' (AEP.Config (AEP.Spaces 2) compare AEP.Generic False) $ u ^. uvConfig + displayControls :: Universe -> ScreenLayer --displayControls = const $ ColumnsScreen "CONTROLS" listControls displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncurry MODStringOption) listControls diff --git a/src/Dodge/Menu/Option.hs b/src/Dodge/Menu/Option.hs index b81597712..9eaf8f7b9 100644 --- a/src/Dodge/Menu/Option.hs +++ b/src/Dodge/Menu/Option.hs @@ -19,7 +19,7 @@ optionListDisplayParams = , _ldpPosY = 50 , _ldpScale = 2 , _ldpVerticalGap = 30 - , _ldpWidth = FixedSelectionWidth 50 + , _ldpWidth = FixedSelectionWidth 25 , _ldpCursorType = BorderCursor [North, South, West] } diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 8009a040f..f6ecc949d 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -81,7 +81,7 @@ invDisplayParams w = _ -> False inventoryDisplay :: World -> Configuration -> SelectionList () -> Picture -inventoryDisplay w = drawSelectionList (invDisplayParams w) +inventoryDisplay = drawSelectionList . invDisplayParams drawSubInventory :: SubInventory -> Configuration -> World -> Picture drawSubInventory subinv cfig w = case subinv of diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index ddaab35a4..93f8c5977 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -15,7 +15,7 @@ drawMenuScreen :: Configuration -> ScreenLayer -> Picture drawMenuScreen cfig screen = case screen of OptionScreen{_scTitle = titf, _scSelectionList = selpos, _scListDisplayParams = ldps} -> drawOptions ldps cfig titf selpos - (InputScreen inputstr help) -> drawInputMenu cfig ('>' : T.unpack inputstr) help + InputScreen inputstr help -> drawInputMenu cfig ('>' : T.unpack inputstr) help drawInputMenu :: Configuration -> diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 5fa743a32..0a2b79451 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -103,7 +103,9 @@ mouseClickOptionsList screen u = fromMaybe u $ do mouseOverSelectionList :: ListDisplayParams -> SelectionList (Universe -> Universe) -> Universe -> Universe mouseOverSelectionList ldps sl u - | x > xl && x < xr && ylower == yupper && mmoving + | x > xl && x < xr + && ylower == yupper + && mmoving && ylower >= 0 && ylower < ymax && isselectable = @@ -118,7 +120,8 @@ mouseOverSelectionList ldps sl u ylower = ceiling $ (hh - (75 + y + _ldpPosY ldps)) / 50 yupper = floor $ (hh - (15 + y + _ldpPosY ldps)) / 50 xl = _ldpPosX ldps - hw - xr = xl + _ldpScale ldps * 15 * 9 + --xr = xl + _ldpScale ldps * 15 * 9 + xr = xl + _ldpScale ldps * 26 * 9 V2 x y = u ^. uvWorld . input . mousePos cfig = u ^. uvConfig hh = halfHeight cfig