Cleanup
This commit is contained in:
+7
-6
@@ -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'
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 ::
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -19,7 +19,7 @@ optionListDisplayParams =
|
||||
, _ldpPosY = 50
|
||||
, _ldpScale = 2
|
||||
, _ldpVerticalGap = 30
|
||||
, _ldpWidth = FixedSelectionWidth 50
|
||||
, _ldpWidth = FixedSelectionWidth 25
|
||||
, _ldpCursorType = BorderCursor [North, South, West]
|
||||
}
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user