justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor event/input

Browse Source
This commit is contained in:
jgk
2021-03-26 14:52:25 +01:00
parent 420cf7fc4b
commit 07d84cc1c6
14 changed files with 91 additions and 63 deletions
Download Patch File Download Diff File Expand all files Collapse all files
app/Main.hs
+3 -3
View File
@@ -5,7 +5,7 @@ import Shader
import Shapes
import LoadConfig
import Dodge.Prototypes
import Dodge.Default
import Dodge.Data
import Dodge.Initialisation
import Dodge.Rooms
@@ -52,12 +52,12 @@ main = do
clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w)
(_cameraPos w)
(_cameraCenter w)
(_windowX w,_windowY w)
(wallsPointsAndCols w)
(wallsWindows w)
(lightsForGloom' w)
(_cameraCenter w)
(_cameraViewFrom w)
(worldPictures w)
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w)
src/Dodge/AIs.hs
+1 -1
View File
@@ -1871,7 +1871,7 @@ splitCritCorpse x = color (greyN 0.2) $ circleSolid x
spCrRadFac = 8^2
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr = ( (mouseActionsWorld (_mouseButtons w) . f, g)
yourControl w (f,g) cr = ( (f, g)
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
)
where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
src/Dodge/Base.hs
+6 -6
View File
@@ -312,7 +312,7 @@ zoneOfScreen :: World -> [(Int,Int)]
zoneOfScreen w = [(a,b) | a <- [x - n .. x + n]
, b <- [y - n .. y + n]
]
where (x,y) = zoneOfPoint $ _cameraPos w
where (x,y) = zoneOfPoint $ _cameraCenter w
n = ceiling $ wh / (_cameraZoom w * zoneSize)
wh = max (_windowX w) (_windowY w)
@@ -320,7 +320,7 @@ zoneOfDoubleScreen :: World -> [(Int,Int)]
zoneOfDoubleScreen w = [(a,b) | a <- [x - n .. x + n]
, b <- [y - n .. y + n]
]
where (x,y) = zoneOfPoint $ _cameraPos w
where (x,y) = zoneOfPoint $ _cameraCenter w
n = (ceiling $ wh / (_cameraZoom w * zoneSize)) * 2
wh = max (_windowX w) (_windowY w)
@@ -334,7 +334,7 @@ screenPolygon :: World -> [Point2]
screenPolygon w = [tr,tl,bl,br]
where scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scTran p = p +.+ _cameraPos w
scTran p = p +.+ _cameraCenter w
tr = scTran $ scRot $ scZoom ( halfWidth w, halfHeight w)
tl = scTran $ scRot $ scZoom (-halfWidth w, halfHeight w)
br = scTran $ scRot $ scZoom ( halfWidth w,-halfHeight w)
@@ -731,7 +731,7 @@ levLayer MenuLayer = 90
worldPosToScreen :: World -> Point2 -> Point2
worldPosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _cameraPos w
doTranslate p = p -.- _cameraCenter w
doZoom p = _cameraZoom w *.* p
doRotate p = rotateV (0 - _cameraRot w) p
doWindowScale (x,y) = ( x * 2 / _windowX w
@@ -743,13 +743,13 @@ cartePosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _carteCenter w
doZoom p = _carteZoom w *.* p
doRotate p = rotateV (0 - _cameraRot w) p
doRotate p = rotateV (0 - _carteRot w) p
doWindowScale (x,y) = ( x * 2 / _windowX w
, y * 2 / _windowY w
)
mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraPos w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
mouseCartePos :: World -> Point2
mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w)
src/Dodge/CreatureAction.hs
+1 -1
View File
@@ -225,7 +225,7 @@ blinkAction n w = soundOnce teleSound $ set (creatures . ix n . crPos) p3
$ blinkShockwave p3
$ inverseShockwaveAt cp 40 2 2 2
w
where p1 = _cameraPos w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
where p1 = _cameraCenter w +.+ (1 / _cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
cp = _crPos $ _creatures w IM.! n
p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n)
src/Dodge/Data.hs
+2 -2
View File
@@ -38,7 +38,7 @@ import qualified Data.DList as DL
data World = World
{ _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton)
, _cameraPos :: !Point2
, _cameraCenter :: !Point2
, _cameraAimTime :: Int
, _cameraRot :: !Float
, _cameraZoom :: !Float
@@ -65,7 +65,7 @@ data World = World
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float)
, _clickMousePos :: (Float,Float)
, _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)]
src/Dodge/Default.hs
+2 -2
View File
@@ -179,7 +179,7 @@ defaultPP = PressPlate
defaultWorld = World
{ _keys = S.empty
, _mouseButtons = S.empty
, _cameraPos = (0,0)
, _cameraCenter = (0,0)
, _cameraAimTime = 0
, _cameraRot = 0
, _cameraZoom = 1
@@ -209,7 +209,7 @@ defaultWorld = World
, _storedLevel = Nothing
, _menuState = LevelMenu 1
, _worldState = M.empty
, _lbClickMousePos = (0,0)
, _clickMousePos = (0,0)
, _lbRotation = 0
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pathGraph' = []
src/Dodge/Event.hs
+30 -32
View File
@@ -15,6 +15,13 @@ import Data.Function (on)
import qualified Data.Set as S
import qualified Data.IntMap.Strict as IM
import SDL
-- Deals with direct events
-- This includes individual key/mouse presses, but /not/ continuous held down input
-- We cannot handle multiple keys held down at once here,
-- (eg left mouse button + right mouse button)
-- because these are separate events
-- Instead we store the events in a set, and deal with the combinations in
-- Update
handleEvent :: Event -> World -> Maybe World
handleEvent e = case eventPayload e of
@@ -52,37 +59,42 @@ handleResizeEvent sev = Just . set windowX (fromIntegral x)
where V2 x y = windowSizeChangedEventSize sev
handlePressedMouseButton :: MouseButton -> World -> Maybe World
handlePressedMouseButton ButtonMiddle w = Just $ set lbClickMousePos (_mousePos w) w
handlePressedMouseButton but w
| (but == ButtonRight && _carteDisplay w) || (but == ButtonMiddle && not (_carteDisplay w))
= Just $ w & clickMousePos .~ _mousePos w
handlePressedMouseButton _ w = Just w
wheelUpEvent :: World -> World
wheelUpEvent w = case _carteDisplay w of
True -> w & carteZoom .~ min 0.5 (z+(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollUp w)
True | rbDown -> w & carteZoom .~ min 0.75 (z+(0.1*z))
| otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i - 1)
_ | rbDown -> fromMaybe (closeObjScrollUp w)
$ (yourItem w ^? itScrollUp)
<*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1}
| otherwise -> upInvPos w
| lbDown -> w & cameraZoom +~ 0.1
| otherwise -> upInvPos w
where
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
rbDown = ButtonRight `S.member` _mouseButtons w
lbDown = ButtonLeft `S.member` _mouseButtons w
z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
wheelDownEvent :: World -> World
wheelDownEvent w = case _carteDisplay w of
True -> w & carteZoom .~ max 0.05 (z-(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollDown w)
$ (yourItem w ^? itScrollDown)
<*> pure (_crInvSel (you w))
<*> pure w
| lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
True | rbDown -> w & carteZoom .~ max 0.05 (z-(0.1*z))
| otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i + 1)
False | rbDown -> fromMaybe (closeObjScrollDown w)
$ (yourItem w ^? itScrollDown)
<*> pure (_crInvSel (you w))
<*> pure w
| lbDown -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
where
lbPressed = ButtonLeft `S.member` mbs
rbPressed = ButtonRight `S.member` mbs
mbs = _mouseButtons w
rbDown = ButtonRight `S.member` _mouseButtons w
lbDown = ButtonLeft `S.member` _mouseButtons w
z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w
@@ -110,17 +122,3 @@ mouseActionsCr keys cr
where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mouseActionsWorld :: S.Set MouseButton -> World -> World
mouseActionsWorld keys w
| lbPressed && rbPressed
= useItem (_yourID w) w
| mbPressed
= set lbClickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w
| otherwise
= w
where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
rotation = angleBetween (_mousePos w) (_lbClickMousePos w)
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -25,7 +25,7 @@ firstWorld = return $ generateFromTree lev1 $ initialWorld
initialWorld :: World
initialWorld = defaultWorld
{ _keys = S.empty
, _cameraPos = (0,0)
, _cameraCenter = (0,0)
, _cameraRot = 0
, _cameraZoom = 1
, _creatures = IM.fromList [(0,startCr)]
src/Dodge/Item/Weapon.hs
+1 -1
View File
@@ -1461,7 +1461,7 @@ throwRemoteBomb n w = setLocation $ removePict $ resetFire
, _ptUpdate = moveRemoteBomb itid 50 i
}
i = newProjectileKey w
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraPos w -.- yourPos)
-- fireDist = zoom *.* (rotateV (_cameraRot w) (_mousePos w) +.+ _cameraCenter w -.- yourPos)
d = argV $ _mousePos w
--(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w)
--(a, g) = randomR (-grenadeAccA,grenadeAccA) (_randGen w)
src/Dodge/Rendering.hs
+3 -3
View File
@@ -101,7 +101,7 @@ outsideScreenPolygon :: World -> [Point2]
outsideScreenPolygon w = [tr,tl,bl,br]
where scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scTran p = p +.+ _cameraPos w
scTran p = p +.+ _cameraCenter w
tr = scTran $ scRot $ scZoom ( 3*halfWidth w , 3* halfHeight w)
tl = scTran $ scRot $ scZoom (- (3*halfWidth w), 3* halfHeight w)
br = scTran $ scRot $ scZoom ( 3*halfWidth w ,- (3* halfHeight w))
@@ -165,7 +165,7 @@ drawItem flIt = uncurry translate (_flItPos flIt)
ffToDraw :: World -> [ForceField]
ffToDraw w = filter (lineOnScreen w . _ffLine) $
IM.elems $ fmap (over ffLine (map (\p->p -.- _cameraPos w))) $
IM.elems $ fmap (over ffLine (map (\p->p -.- _cameraCenter w))) $
_forceFields w
drawFF :: ForceField -> Picture
@@ -187,7 +187,7 @@ drawFFShadow w ff
| otherwise = (x1:y1:[])
fCol = color (_ffColor ff)
col = _ffColor ff
ypShift = yp -.- _cameraPos w
ypShift = yp -.- _cameraCenter w
youOnFF = circOnLine' x' y' ypShift (_crRad $ you w)
pane j = color (withAlpha 0.1 col)
$ polygon
src/Dodge/Rendering/HUD.hs
+7 -8
View File
@@ -28,12 +28,12 @@ hudDrawings w = setLayer 1 . setDepth (-0.5) . pictures $
drawInventory :: World -> [Picture]
drawInventory w =
[ closeObjectTexts w
, scaler $ drawItemSelectCursor (itCol (yourItem w)) w
, drawListCursor (itCol (yourItem w)) iPos w
]
++ displayInv 0 w
where
itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
scaler = scale (2 / _windowX w) (2 / _windowY w)
iPos = _crInvSel $ _creatures w IM.! _yourID w
displayListTopLeft :: [(String,Color)] -> World -> [Picture]
displayListTopLeft scols w =
@@ -61,7 +61,9 @@ drawLocations :: World -> [Picture]
drawLocations w = displayListTopLeft locs w
++ zipWith bFunc (displayListEndCoords w locTexts) locPoss
++ mapOverlay w
++ [drawListCursor white iPos w]
where
iPos = _selLocation w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
zoom = _carteZoom w
@@ -155,17 +157,14 @@ dShadCol c p = pictures $
, color c p
]
drawItemSelectCursor :: Color -> World -> Picture
drawItemSelectCursor c w = setLayer 1
$ translate (105-halfWidth w)
(halfHeight w - (20* (fromIntegral iPos)) - 20
)
drawListCursor :: Color -> Int -> World -> Picture
drawListCursor c iPos w = scale (2 / _windowX w) (2 / _windowY w)
. translate (105-halfWidth w) (halfHeight w - (20* (fromIntegral iPos)) - 20)
$ lineCol [(( 100,12.5) ,withAlpha 0 c)
,((-100,12.5) ,c)
,((-100,-7.5) ,c)
,(( 100,-7.5) ,withAlpha 0 c)
]
where iPos = _crInvSel $ _creatures w IM.! _yourID w
displayHP :: Int -> World -> Picture
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
src/Dodge/Update.hs
+3 -1
View File
@@ -5,6 +5,7 @@ import Dodge.Base
import Dodge.WallCreatureCollisions
import Dodge.LevelGen.Block
import Dodge.Update.Camera
import Dodge.Update.UsingInput
import Dodge.SoundLogic
import Dodge.Inventory
@@ -34,6 +35,7 @@ update w
. updateBlocks -- . zoning
. updateSeenWalls
. updateSoundQueue
. updateUsingInput
$ updateCloseObjects w
in checkEndGame . ppEvents
. updateCamera
@@ -172,4 +174,4 @@ collidePointFindWalls p1 p2 ws
in ys ++ tf zs
where tf (x:_) = [x]
tf _ = []
src/Dodge/Update/Camera.hs
+2 -2
View File
@@ -24,7 +24,7 @@ updateAimTime w
| otherwise = w & cameraAimTime %~ \t -> max (t-1) 0
moveCamera :: World -> World
moveCamera w = w & cameraPos .~ idealPos
moveCamera w = w & cameraCenter .~ idealPos
& cameraViewFrom .~ sightFrom
where aimRangeFactor | _cameraZoom w == 0 = 0
| otherwise = (fromMaybe 0 $ yourItem w ^? itAimingRange) / _cameraZoom w
@@ -36,7 +36,7 @@ moveCamera w = w & cameraPos .~ idealPos
currentOffset = currentPos -.- camCenter
idealPos = camCenter +.+ rotateV (_cameraRot w)
(aimRangeFactor * aimingMult *.* _mousePos w)
currentPos = _cameraPos w
currentPos = _cameraCenter w
camCenter = ypos +.+ scope
isCam :: Bool
isCam = fromMaybe False $ yourItem w ^? itAttachment . _Just . scopeIsCamera
src/Dodge/Update/UsingInput.hs
+29
View File
@@ -0,0 +1,29 @@
module Dodge.Update.UsingInput
where
import Dodge.Data
import Dodge.CreatureAction.UseItem
import Geometry
import SDL
import qualified Data.Set as S
import Control.Lens
updateUsingInput :: World -> World
updateUsingInput w = updatePressedButtons (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons keys w
| lbPressed && rbPressed
= useItem (_yourID w) w
| mbPressed
= set clickMousePos (_mousePos w) $ over cameraRot (\r-> r - rotation) w
| otherwise
= w
where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `S.member` keys
mbPressed = ButtonMiddle `S.member` keys
rotation = angleBetween (_mousePos w) (_clickMousePos w)