diff --git a/app/Main.hs b/app/Main.hs index da589dae5..52c6b1b5b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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) diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 9d4ebfb63..85f41cfa9 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -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) diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index a822fa7c3..c37542b2a 100644 --- a/src/Dodge/Base.hs +++ b/src/Dodge/Base.hs @@ -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) diff --git a/src/Dodge/CreatureAction.hs b/src/Dodge/CreatureAction.hs index d3385f015..2057b9a9c 100644 --- a/src/Dodge/CreatureAction.hs +++ b/src/Dodge/CreatureAction.hs @@ -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) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 214a55301..5fc2dcc0e 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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)] diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 8d40002f4..cdf2696d8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -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' = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index bcaa007c7..27142201a 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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) - - diff --git a/src/Dodge/Initialisation.hs b/src/Dodge/Initialisation.hs index f56f8a9f0..3bc24a7f8 100644 --- a/src/Dodge/Initialisation.hs +++ b/src/Dodge/Initialisation.hs @@ -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)] diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 68b8dbe34..8f05a6db4 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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) diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index 32a2c0685..404d606b4 100644 --- a/src/Dodge/Rendering.hs +++ b/src/Dodge/Rendering.hs @@ -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 diff --git a/src/Dodge/Rendering/HUD.hs b/src/Dodge/Rendering/HUD.hs index 0ea21733a..0b70a324f 100644 --- a/src/Dodge/Rendering/HUD.hs +++ b/src/Dodge/Rendering/HUD.hs @@ -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) $ diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 036a694a7..1ca6d8078 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -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 _ = [] - + diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 7066df8cf..c58cbc709 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -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 diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs new file mode 100644 index 000000000..4f66f4f35 --- /dev/null +++ b/src/Dodge/Update/UsingInput.hs @@ -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) +