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:
justin
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 Shapes
import LoadConfig import LoadConfig
import Dodge.Prototypes import Dodge.Default
import Dodge.Data import Dodge.Data
import Dodge.Initialisation import Dodge.Initialisation
import Dodge.Rooms import Dodge.Rooms
@@ -52,12 +52,12 @@ main = do
clear [ColorBuffer,DepthBuffer] clear [ColorBuffer,DepthBuffer]
(lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData) (lightTicks,timeSpentPoking) <- renderPicture' (_renderData preData)
(_cameraRot w) (_cameraZoom w) (_cameraRot w) (_cameraZoom w)
(_cameraPos w) (_cameraCenter w)
(_windowX w,_windowY w) (_windowX w,_windowY w)
(wallsPointsAndCols w) (wallsPointsAndCols w)
(wallsWindows w) (wallsWindows w)
(lightsForGloom' w) (lightsForGloom' w)
(_cameraCenter w) (_cameraViewFrom w)
(worldPictures w) (worldPictures w)
blendFunc $= (SrcAlpha,OneMinusSrcAlpha) blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable (_renderData preData) (picToLTree Nothing $ fixedCoordPictures w) 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 spCrRadFac = 8^2
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) 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 , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
) )
where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) 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] zoneOfScreen w = [(a,b) | a <- [x - n .. x + n]
, b <- [y - n .. y + n] , b <- [y - n .. y + n]
] ]
where (x,y) = zoneOfPoint $ _cameraPos w where (x,y) = zoneOfPoint $ _cameraCenter w
n = ceiling $ wh / (_cameraZoom w * zoneSize) n = ceiling $ wh / (_cameraZoom w * zoneSize)
wh = max (_windowX w) (_windowY w) wh = max (_windowX w) (_windowY w)
@@ -320,7 +320,7 @@ zoneOfDoubleScreen :: World -> [(Int,Int)]
zoneOfDoubleScreen w = [(a,b) | a <- [x - n .. x + n] zoneOfDoubleScreen w = [(a,b) | a <- [x - n .. x + n]
, b <- [y - n .. y + 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 n = (ceiling $ wh / (_cameraZoom w * zoneSize)) * 2
wh = max (_windowX w) (_windowY w) wh = max (_windowX w) (_windowY w)
@@ -334,7 +334,7 @@ screenPolygon :: World -> [Point2]
screenPolygon w = [tr,tl,bl,br] screenPolygon w = [tr,tl,bl,br]
where scRot = rotateV (_cameraRot w) where scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p 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) tr = scTran $ scRot $ scZoom ( halfWidth w, halfHeight w)
tl = scTran $ scRot $ scZoom (-halfWidth w, halfHeight w) tl = scTran $ scRot $ scZoom (-halfWidth w, halfHeight w)
br = 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 :: World -> Point2 -> Point2
worldPosToScreen w = doWindowScale . doRotate . doZoom . doTranslate worldPosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
where where
doTranslate p = p -.- _cameraPos w doTranslate p = p -.- _cameraCenter w
doZoom p = _cameraZoom w *.* p doZoom p = _cameraZoom w *.* p
doRotate p = rotateV (0 - _cameraRot w) p doRotate p = rotateV (0 - _cameraRot w) p
doWindowScale (x,y) = ( x * 2 / _windowX w doWindowScale (x,y) = ( x * 2 / _windowX w
@@ -743,13 +743,13 @@ cartePosToScreen w = doWindowScale . doRotate . doZoom . doTranslate
where where
doTranslate p = p -.- _carteCenter w doTranslate p = p -.- _carteCenter w
doZoom p = _carteZoom w *.* p 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 doWindowScale (x,y) = ( x * 2 / _windowX w
, y * 2 / _windowY w , y * 2 / _windowY w
) )
mouseWorldPos :: World -> Point2 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 :: World -> Point2
mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w) 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 $ blinkShockwave p3
$ inverseShockwaveAt cp 40 2 2 2 $ inverseShockwaveAt cp 40 2 2 2
w 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 cp = _crPos $ _creatures w IM.! n
p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w p2 = collidePointWalls cp p1 $ wallsAlongLine cp p1 w
r = 1.5 * _crRad (_creatures w IM.! n) 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 data World = World
{ _keys :: !(S.Set Scancode) { _keys :: !(S.Set Scancode)
, _mouseButtons :: !(S.Set MouseButton) , _mouseButtons :: !(S.Set MouseButton)
, _cameraPos :: !Point2 , _cameraCenter :: !Point2
, _cameraAimTime :: Int , _cameraAimTime :: Int
, _cameraRot :: !Float , _cameraRot :: !Float
, _cameraZoom :: !Float , _cameraZoom :: !Float
@@ -65,7 +65,7 @@ data World = World
, _sounds :: M.Map SoundOrigin Sound , _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Picture , _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse]) , _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float) , _clickMousePos :: (Float,Float)
, _lbRotation :: Float , _lbRotation :: Float
, _pathGraph :: ~(Gr Point2 Float) , _pathGraph :: ~(Gr Point2 Float)
, _pathGraph' :: ~[(Point2,Point2)] , _pathGraph' :: ~[(Point2,Point2)]
src/Dodge/Default.hs
+2 -2
View File
@@ -179,7 +179,7 @@ defaultPP = PressPlate
defaultWorld = World defaultWorld = World
{ _keys = S.empty { _keys = S.empty
, _mouseButtons = S.empty , _mouseButtons = S.empty
, _cameraPos = (0,0) , _cameraCenter = (0,0)
, _cameraAimTime = 0 , _cameraAimTime = 0
, _cameraRot = 0 , _cameraRot = 0
, _cameraZoom = 1 , _cameraZoom = 1
@@ -209,7 +209,7 @@ defaultWorld = World
, _storedLevel = Nothing , _storedLevel = Nothing
, _menuState = LevelMenu 1 , _menuState = LevelMenu 1
, _worldState = M.empty , _worldState = M.empty
, _lbClickMousePos = (0,0) , _clickMousePos = (0,0)
, _lbRotation = 0 , _lbRotation = 0
, _pathGraph = Data.Graph.Inductive.Graph.empty , _pathGraph = Data.Graph.Inductive.Graph.empty
, _pathGraph' = [] , _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.Set as S
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import SDL 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 :: Event -> World -> Maybe World
handleEvent e = case eventPayload e of handleEvent e = case eventPayload e of
@@ -52,37 +59,42 @@ handleResizeEvent sev = Just . set windowX (fromIntegral x)
where V2 x y = windowSizeChangedEventSize sev where V2 x y = windowSizeChangedEventSize sev
handlePressedMouseButton :: MouseButton -> World -> Maybe World 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 handlePressedMouseButton _ w = Just w
wheelUpEvent :: World -> World wheelUpEvent :: World -> World
wheelUpEvent w = case _carteDisplay w of wheelUpEvent w = case _carteDisplay w of
True -> w & carteZoom .~ min 0.5 (z+(0.1*z)) True | rbDown -> w & carteZoom .~ min 0.75 (z+(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollUp w) | otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i - 1)
_ | rbDown -> fromMaybe (closeObjScrollUp w)
$ (yourItem w ^? itScrollUp) $ (yourItem w ^? itScrollUp)
<*> pure (_crInvSel (you w)) <*> pure (_crInvSel (you w))
<*> pure w <*> pure w
| lbPressed -> w {_cameraZoom = _cameraZoom w + 0.1} | lbDown -> w & cameraZoom +~ 0.1
| otherwise -> upInvPos w | otherwise -> upInvPos w
where where
lbPressed = ButtonLeft `S.member` mbs rbDown = ButtonRight `S.member` _mouseButtons w
rbPressed = ButtonRight `S.member` mbs lbDown = ButtonLeft `S.member` _mouseButtons w
mbs = _mouseButtons w
z = _carteZoom w z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
wheelDownEvent :: World -> World wheelDownEvent :: World -> World
wheelDownEvent w = case _carteDisplay w of wheelDownEvent w = case _carteDisplay w of
True -> w & carteZoom .~ max 0.05 (z-(0.1*z)) True | rbDown -> w & carteZoom .~ max 0.05 (z-(0.1*z))
_ | rbPressed -> fromMaybe (closeObjScrollDown w) | otherwise -> w & selLocation %~ (`mod` numLocs) . (\i -> i + 1)
$ (yourItem w ^? itScrollDown) False | rbDown -> fromMaybe (closeObjScrollDown w)
<*> pure (_crInvSel (you w)) $ (yourItem w ^? itScrollDown)
<*> pure w <*> pure (_crInvSel (you w))
| lbPressed -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01} <*> pure w
| otherwise -> downInvPos w | lbDown -> w {_cameraZoom = max (_cameraZoom w - 0.1) 0.01}
| otherwise -> downInvPos w
where where
lbPressed = ButtonLeft `S.member` mbs rbDown = ButtonRight `S.member` _mouseButtons w
rbPressed = ButtonRight `S.member` mbs lbDown = ButtonLeft `S.member` _mouseButtons w
mbs = _mouseButtons w
z = _carteZoom w z = _carteZoom w
numLocs = (fst . IM.findMax $ _seenLocations w) + 1
upInvPos :: World -> World upInvPos :: World -> World
upInvPos w = stopSoundFrom (CrReloadSound 0) $ set (creatures . ix (_yourID w) . crInvSel) x w 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 where lbPressed = ButtonLeft `S.member` keys
rbPressed = ButtonRight `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 :: World
initialWorld = defaultWorld initialWorld = defaultWorld
{ _keys = S.empty { _keys = S.empty
, _cameraPos = (0,0) , _cameraCenter = (0,0)
, _cameraRot = 0 , _cameraRot = 0
, _cameraZoom = 1 , _cameraZoom = 1
, _creatures = IM.fromList [(0,startCr)] , _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 , _ptUpdate = moveRemoteBomb itid 50 i
} }
i = newProjectileKey w 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 d = argV $ _mousePos w
--(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w) --(l, _) = randomR (1 - grenadeAccL,1+grenadeAccL) (_randGen w)
--(a, g) = randomR (-grenadeAccA,grenadeAccA) (_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] outsideScreenPolygon w = [tr,tl,bl,br]
where scRot = rotateV (_cameraRot w) where scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p 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) tr = scTran $ scRot $ scZoom ( 3*halfWidth w , 3* halfHeight w)
tl = 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)) br = scTran $ scRot $ scZoom ( 3*halfWidth w ,- (3* halfHeight w))
@@ -165,7 +165,7 @@ drawItem flIt = uncurry translate (_flItPos flIt)
ffToDraw :: World -> [ForceField] ffToDraw :: World -> [ForceField]
ffToDraw w = filter (lineOnScreen w . _ffLine) $ 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 _forceFields w
drawFF :: ForceField -> Picture drawFF :: ForceField -> Picture
@@ -187,7 +187,7 @@ drawFFShadow w ff
| otherwise = (x1:y1:[]) | otherwise = (x1:y1:[])
fCol = color (_ffColor ff) fCol = color (_ffColor ff)
col = _ffColor ff col = _ffColor ff
ypShift = yp -.- _cameraPos w ypShift = yp -.- _cameraCenter w
youOnFF = circOnLine' x' y' ypShift (_crRad $ you w) youOnFF = circOnLine' x' y' ypShift (_crRad $ you w)
pane j = color (withAlpha 0.1 col) pane j = color (withAlpha 0.1 col)
$ polygon $ 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 :: World -> [Picture]
drawInventory w = drawInventory w =
[ closeObjectTexts w [ closeObjectTexts w
, scaler $ drawItemSelectCursor (itCol (yourItem w)) w , drawListCursor (itCol (yourItem w)) iPos w
] ]
++ displayInv 0 w ++ displayInv 0 w
where where
itCol = fromMaybe (greyN 0.5) . (^? itInvColor) 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 :: [(String,Color)] -> World -> [Picture]
displayListTopLeft scols w = displayListTopLeft scols w =
@@ -61,7 +61,9 @@ drawLocations :: World -> [Picture]
drawLocations w = displayListTopLeft locs w drawLocations w = displayListTopLeft locs w
++ zipWith bFunc (displayListEndCoords w locTexts) locPoss ++ zipWith bFunc (displayListEndCoords w locTexts) locPoss
++ mapOverlay w ++ mapOverlay w
++ [drawListCursor white iPos w]
where where
iPos = _selLocation w
locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w locs = map (\(_,s) -> (s,white)) . IM.elems . _seenLocations $ w
locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w locPoss = map (cartePosToScreen w . ($ w) . fst) . IM.elems . _seenLocations $ w
zoom = _carteZoom w zoom = _carteZoom w
@@ -155,17 +157,14 @@ dShadCol c p = pictures $
, color c p , color c p
] ]
drawItemSelectCursor :: Color -> World -> Picture drawListCursor :: Color -> Int -> World -> Picture
drawItemSelectCursor c w = setLayer 1 drawListCursor c iPos w = scale (2 / _windowX w) (2 / _windowY w)
$ translate (105-halfWidth w) . translate (105-halfWidth w) (halfHeight w - (20* (fromIntegral iPos)) - 20)
(halfHeight w - (20* (fromIntegral iPos)) - 20
)
$ lineCol [(( 100,12.5) ,withAlpha 0 c) $ lineCol [(( 100,12.5) ,withAlpha 0 c)
,((-100,12.5) ,c) ,((-100,12.5) ,c)
,((-100,-7.5) ,c) ,((-100,-7.5) ,c)
,(( 100,-7.5) ,withAlpha 0 c) ,(( 100,-7.5) ,withAlpha 0 c)
] ]
where iPos = _crInvSel $ _creatures w IM.! _yourID w
displayHP :: Int -> World -> Picture displayHP :: Int -> World -> Picture
displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $ 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.WallCreatureCollisions
import Dodge.LevelGen.Block import Dodge.LevelGen.Block
import Dodge.Update.Camera import Dodge.Update.Camera
import Dodge.Update.UsingInput
import Dodge.SoundLogic import Dodge.SoundLogic
import Dodge.Inventory import Dodge.Inventory
@@ -34,6 +35,7 @@ update w
. updateBlocks -- . zoning . updateBlocks -- . zoning
. updateSeenWalls . updateSeenWalls
. updateSoundQueue . updateSoundQueue
. updateUsingInput
$ updateCloseObjects w $ updateCloseObjects w
in checkEndGame . ppEvents in checkEndGame . ppEvents
. updateCamera . updateCamera
@@ -172,4 +174,4 @@ collidePointFindWalls p1 p2 ws
in ys ++ tf zs in ys ++ tf zs
where tf (x:_) = [x] where tf (x:_) = [x]
tf _ = [] tf _ = []
src/Dodge/Update/Camera.hs
+2 -2
View File
@@ -24,7 +24,7 @@ updateAimTime w
| otherwise = w & cameraAimTime %~ \t -> max (t-1) 0 | otherwise = w & cameraAimTime %~ \t -> max (t-1) 0
moveCamera :: World -> World moveCamera :: World -> World
moveCamera w = w & cameraPos .~ idealPos moveCamera w = w & cameraCenter .~ idealPos
& cameraViewFrom .~ sightFrom & cameraViewFrom .~ sightFrom
where aimRangeFactor | _cameraZoom w == 0 = 0 where aimRangeFactor | _cameraZoom w == 0 = 0
| otherwise = (fromMaybe 0 $ yourItem w ^? itAimingRange) / _cameraZoom w | otherwise = (fromMaybe 0 $ yourItem w ^? itAimingRange) / _cameraZoom w
@@ -36,7 +36,7 @@ moveCamera w = w & cameraPos .~ idealPos
currentOffset = currentPos -.- camCenter currentOffset = currentPos -.- camCenter
idealPos = camCenter +.+ rotateV (_cameraRot w) idealPos = camCenter +.+ rotateV (_cameraRot w)
(aimRangeFactor * aimingMult *.* _mousePos w) (aimRangeFactor * aimingMult *.* _mousePos w)
currentPos = _cameraPos w currentPos = _cameraCenter w
camCenter = ypos +.+ scope camCenter = ypos +.+ scope
isCam :: Bool isCam :: Bool
isCam = fromMaybe False $ yourItem w ^? itAttachment . _Just . scopeIsCamera 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)