This commit is contained in:
2022-12-28 01:12:10 +00:00
parent c71af99ff7
commit 2d4a55dee0
8 changed files with 35 additions and 21 deletions
+7 -6
View File
@@ -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'
+9 -8
View File
@@ -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)
+1 -2
View File
@@ -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 ::
+10
View File
@@ -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
+1 -1
View File
@@ -19,7 +19,7 @@ optionListDisplayParams =
, _ldpPosY = 50
, _ldpScale = 2
, _ldpVerticalGap = 30
, _ldpWidth = FixedSelectionWidth 50
, _ldpWidth = FixedSelectionWidth 25
, _ldpCursorType = BorderCursor [North, South, West]
}
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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 ->
+5 -2
View File
@@ -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