diff --git a/src/Color.hs b/src/Color.hs index e9c229710..4387de70b 100644 --- a/src/Color.hs +++ b/src/Color.hs @@ -138,8 +138,8 @@ numColor 11 = toV4 (1, 0.5, 0, 1) numColor 12 = toV4 (1, 1, 1, 1) numColor _ = toV4 (1, 1, 1, 1) -light4 :: Color -> Color -light4 = light . light . light . light +lightx4 :: Color -> Color +lightx4 = light . light . light . light toColor8 :: Color -> Color8 toColor8 = over each floor . (255 *) . normalizeColor diff --git a/src/Dodge/Camera.hs b/src/Dodge/Camera.hs index 2fba2c309..55eecc1c8 100644 --- a/src/Dodge/Camera.hs +++ b/src/Dodge/Camera.hs @@ -4,10 +4,9 @@ import Dodge.Data.Universe import Control.Lens useNormalCamera :: Universe -> Universe -useNormalCamera = uvWorld . wCam . camControl .~ CamInGame +useNormalCamera = (uvWorld . wCam . camControl .~ CamInGame) + . (uvWorld . timeFlow .~ NormalTimeFlow) pauseAndFloatCam :: Universe -> Universe -pauseAndFloatCam = uvWorld . wCam . camControl .~ CamFloat - -pauseAndPanCam :: Universe -> Universe -pauseAndPanCam = uvWorld . wCam . camControl .~ CamPan +pauseAndFloatCam = (uvWorld . wCam . camControl .~ CamFloat) + . (uvWorld . timeFlow .~ CameraScrollTimeFlow 0 0 []) diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 63d62a11d..17bcf1dd8 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -55,13 +55,13 @@ spawnerCrit = defaultCreature & crHP .~ 300 & crInv .~ IM.empty - & crType . skinUpper .~ light4 blue + & crType . skinUpper .~ lightx4 blue miniGunCrit :: Creature miniGunCrit = defaultCreature & crInv .~ IM.fromList [(0, miniGunX 3)] - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red & crType . humanoidAI .~ MiniGunAI longCrit :: Creature @@ -76,13 +76,13 @@ longCrit = } & crInv .~ IM.fromList [(0, sniperRifle), (1, medkit 100)] & crType . humanoidAI .~ LongAI - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red multGunCrit :: Creature multGunCrit = defaultCreature & crInv .~ IM.fromList [(0, volleyGun 4), (1, medkit 100)] - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red & crType . humanoidAI .~ MultGunAI addArmour :: Creature -> Creature @@ -107,7 +107,7 @@ startCr = & crCorpse .~ MakeDefaultCorpse & crFaction .~ PlayerFaction & crMvType .~ MvWalking yourDefaultSpeed - & crType . skinUpper .~ light4 black + & crType . skinUpper .~ lightx4 black & crType . humanoidAI .~ YourAI -- | Items you start with. diff --git a/src/Dodge/Creature/AutoCrit.hs b/src/Dodge/Creature/AutoCrit.hs index a1a40aa85..64579a36b 100644 --- a/src/Dodge/Creature/AutoCrit.hs +++ b/src/Dodge/Creature/AutoCrit.hs @@ -18,5 +18,5 @@ autoCrit = , _crHP = 300 , _crMvType = defaultAimMvType } - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red & crType . humanoidAI .~ AutoAI diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index f8ea54893..dbd328849 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -38,7 +38,13 @@ chaseCrit = , _crInv = IM.fromList [(0, medkit 200)] , _crMeleeCooldown = 0 , _crFaction = ColorFaction green - , _crVocalization = + , _crVocalization = chaseCritVocalization + , _crMvType = defaultChaseMvType + } + & crType . humanoidAI .~ ChaseAI + +chaseCritVocalization :: Vocalization +chaseCritVocalization = Vocalization seagullChatterS [ seagullBarkS @@ -52,6 +58,3 @@ chaseCrit = ] 50 0 - , _crMvType = defaultChaseMvType - } --- & crType . humanoidAI .~ ChaseAI diff --git a/src/Dodge/Creature/LauncherCrit.hs b/src/Dodge/Creature/LauncherCrit.hs index 605ccb711..d9bead9f6 100644 --- a/src/Dodge/Creature/LauncherCrit.hs +++ b/src/Dodge/Creature/LauncherCrit.hs @@ -17,5 +17,5 @@ launcherCrit = , _crState = defaultState , _crHP = 300 } - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red & crType . humanoidAI .~ LauncherAI diff --git a/src/Dodge/Creature/LtAutoCrit.hs b/src/Dodge/Creature/LtAutoCrit.hs index 167aff4ed..3f6e6b886 100644 --- a/src/Dodge/Creature/LtAutoCrit.hs +++ b/src/Dodge/Creature/LtAutoCrit.hs @@ -18,4 +18,4 @@ ltAutoCrit = , _crHP = 500 } & crType . humanoidAI .~ LtAutoAI - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red diff --git a/src/Dodge/Creature/PistolCrit.hs b/src/Dodge/Creature/PistolCrit.hs index 9aa8c25b0..b0961c968 100644 --- a/src/Dodge/Creature/PistolCrit.hs +++ b/src/Dodge/Creature/PistolCrit.hs @@ -18,4 +18,4 @@ pistolCrit = , _crHP = 500 } & crType . humanoidAI .~ PistolAI - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red diff --git a/src/Dodge/Creature/SpreadGunCrit.hs b/src/Dodge/Creature/SpreadGunCrit.hs index 113924e8f..cc14f7dc2 100644 --- a/src/Dodge/Creature/SpreadGunCrit.hs +++ b/src/Dodge/Creature/SpreadGunCrit.hs @@ -18,4 +18,4 @@ spreadGunCrit = , _crHP = 500 } & crType . humanoidAI .~ SpreadGunAI - & crType . skinUpper .~ light4 red + & crType . skinUpper .~ lightx4 red diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index df2594684..4befe4332 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -53,13 +53,12 @@ foldCr xs cr w = foldl' f w xs stateUpdate :: (Creature -> World -> World) -> Creature -> World -> World stateUpdate f = foldCr - [ doDamage -- these three - , checkDeath -- must be in - , clearDamage -- this order 24/7/22 - , internalUpdate + [ doDamage -- these two + , checkDeath -- must be in this order 24/7/22 + , internalHammerUpdate , f , movementSideEff - , upInv -- upInv must be called before invSideEff 22.05.23 + , updateInv -- upInv must be called before invSideEff 22.05.23 , invSideEff , equipmentEffects , heldAimEffects @@ -76,6 +75,7 @@ heldAimEffects cr = fromMaybe id $ do checkDeath :: Creature -> World -> World checkDeath cr w | _crHP cr > 0 = w + & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ [] | otherwise = w -- & creatures . at (_crID cr) .~ Nothing @@ -139,8 +139,8 @@ bloodPuddleAt p w = where (q, g) = randInCirc 10 & runState $ _randGen w -internalUpdate :: Creature -> World -> World -internalUpdate cr = +internalHammerUpdate :: Creature -> World -> World +internalHammerUpdate cr = cWorld . lWorld . creatures . ix (_crID cr) %~ ( (crHammerPosition %~ moveHammerUp) . stepReloading @@ -156,11 +156,6 @@ dropByState cr w = foldr (dropItem cr) w $ case cr ^. crState . csDropsOnDeath o DropSpecific xs -> xs DropAmount n -> take n $ evalState (shuffle $ IM.keys $ _crInv cr) (_randGen w) -clearDamage :: Creature -> World -> World -clearDamage cr w = - w - & cWorld . lWorld . creatures . ix (_crID cr) . crState . csDamage .~ [] - doDamage :: Creature -> World -> World doDamage cr w = w @@ -225,8 +220,8 @@ useEquipment cr i = useE (_eeUse (_equipEffect $ _itUse itm)) itm cr itm = _crInv cr IM.! i -- a map updating all inventory items -upInv :: Creature -> World -> World -upInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) +updateInv :: Creature -> World -> World +updateInv cr = cWorld . lWorld . creatures . ix (_crID cr) . crInv %~ IM.mapWithKey (itemUpdate cr) -- a loop going over equipped items equipmentEffects :: Creature -> World -> World diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index 8175c5d1a..c06ec874b 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -17,7 +17,7 @@ swarmCrit = , _crFaction = ColorFaction yellow , _crMeleeCooldown = 0 } - & crType . skinUpper .~ light4 yellow + & crType . skinUpper .~ lightx4 yellow & crType . humanoidAI .~ SwarmAI --swarmCritMoveFunc :: Creature -> Point2 -> Creature -> Point2 diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 4dd2646ad..72df48211 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -45,6 +45,11 @@ crWeaponReady cr = fromMaybe False $ do crCanSeeCr :: Creature -> (World, Creature) -> Bool crCanSeeCr tcr (w, cr) = hasLOS (_crPos cr) (_crPos tcr) w +--crCanSeeCrid :: Int -> (World, Creature) -> Bool +--crCanSeeCrid tcid (w, cr) = fromMaybe False $ do +-- tcr <- w ^? cWorld . lWorld . creatures . ix tcid +-- return $ hasLOS (_crPos cr) (_crPos tcr) w + crIsAiming :: Creature -> Bool crIsAiming cr = _posture (_crStance cr) == Aiming diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 7e5556c29..57cd3264a 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -2,9 +2,9 @@ module Dodge.Creature.YourControl ( yourControl, ) where +import Dodge.WASD import Dodge.Base.You import Dodge.Creature.Impulse.UseItem -import Data.Foldable import qualified Data.Map.Strict as M import Data.Maybe import Dodge.Base.Coordinate @@ -74,7 +74,7 @@ wasdWithAiming w speed cr | movDir == V2 0 0 = id | otherwise = crMvForward speed theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr' - movDir = wasdDir w + movDir = wasdDir (w ^. input) dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir) movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir isAiming = _posture (_crStance cr) == Aiming @@ -92,16 +92,6 @@ aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr itRef <- cr ^? crManipulation . manObject . inInventory . ispItem cr ^? crInv . ix itRef . itUse . heldAim . aimTurnSpeed -wasdM :: SDL.Scancode -> Point2 -wasdM scancode = case scancode of - SDL.ScancodeW -> V2 0 1 - SDL.ScancodeS -> V2 0 (-1) - SDL.ScancodeD -> V2 1 0 - SDL.ScancodeA -> V2 (-1) 0 - _ -> V2 0 0 - -wasdDir :: World -> Point2 -wasdDir = foldl' (flip $ (+.+) . wasdM) (V2 0 0) . M.keys . _pressedKeys . _input -- | Set posture according to mouse presses. mouseActionsCr :: M.Map SDL.MouseButton Int -> Creature -> Creature @@ -128,5 +118,6 @@ pressedMBEffectsTopInventory pkeys w _ -> False isDown but = but `M.member` pkeys theinput = w ^. input - rotation = fromMaybe 0 - $ angleBetween (theinput ^. mousePos) <$> (theinput ^. heldPos . at SDL.ButtonMiddle) + rotation = maybe 0 + (angleBetween (theinput ^. mousePos)) + (theinput ^. heldPos . at SDL.ButtonMiddle) diff --git a/src/Dodge/Data/Camera.hs b/src/Dodge/Data/Camera.hs index cffffb725..c38cbd680 100644 --- a/src/Dodge/Data/Camera.hs +++ b/src/Dodge/Data/Camera.hs @@ -12,7 +12,6 @@ import Geometry.Data data CamControl = CamInGame | CamFloat - | CamPan deriving (Eq,Show,Read,Enum,Bounded) data Camera = Camera diff --git a/src/Dodge/Data/Config.hs b/src/Dodge/Data/Config.hs index 1b52f1516..0db3d386f 100644 --- a/src/Dodge/Data/Config.hs +++ b/src/Dodge/Data/Config.hs @@ -89,6 +89,7 @@ data DebugBool | Inspect_wall | Show_nodes_near_select | Show_path_between + | Pacify_enemies deriving (Eq, Ord, Bounded, Enum, Show) data ResFactor = DoubleRes | FullRes | HalfRes | QuarterRes | EighthRes | SixteenthRes diff --git a/src/Dodge/Data/World.hs b/src/Dodge/Data/World.hs index 472fbe46e..e74dfc470 100644 --- a/src/Dodge/Data/World.hs +++ b/src/Dodge/Data/World.hs @@ -58,12 +58,17 @@ data TimeFlowStatus = DeathTime {_deathDelay :: Int} | NormalTimeFlow - | ScrollTimeFlow + | ItemScrollTimeFlow { _scrollSmoothing :: Int , _reverseAmount :: Int , _futureWorlds :: [LWorld] , _scrollItemLocation :: Int } + | CameraScrollTimeFlow + { _scrollSmoothing :: Int + , _reverseAmount :: Int + , _futureWorlds :: [LWorld] + } | RewindLeftClick { _reverseAmount :: Int , _scrollItemLocation :: Int diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 892aba579..148630628 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -158,6 +158,7 @@ debugDraw' cfig w bl = case bl of Show_nodes_near_select -> undefined --drawNodesNearSelect w Show_path_between -> drawPathBetween w Collision_test -> mempty + Pacify_enemies -> mempty drawCreatureDisplayTexts :: World -> Picture drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (w ^. cWorld . lWorld . creatures) diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 928b6e316..3899b0696 100644 --- a/src/Dodge/Default/Creature.hs +++ b/src/Dodge/Default/Creature.hs @@ -62,7 +62,7 @@ defaultCreatureTargeting :: CreatureTargeting defaultCreatureTargeting = CreatureTargeting Nothing Nothing Nothing False defaultCreatureSkin :: CreatureType -defaultCreatureSkin = Humanoid (greyN 0.9) (light4 green) (greyN 0.3) InanimateAI +defaultCreatureSkin = Humanoid (greyN 0.9) (lightx4 green) (greyN 0.3) InanimateAI defaultInanimate :: Creature defaultInanimate = defaultCreature & crActionPlan .~ Inanimate @@ -112,7 +112,7 @@ defaultChaseMvType :: CrMvType defaultChaseMvType = CrMvType { _mvSpeed = 2 - , _mvTurnRad = FloatAbsCheckGreaterLess (pi / 4) 0.2 0.05 --f + , _mvTurnRad = FloatAbsCheckGreaterLess (pi / 4) 0.2 0.05 , _mvTurnJit = 0.2 , _mvAimSpeed = FloatAbsCheckGreaterLess (pi / 8) 0.2 0.01 } @@ -139,7 +139,6 @@ defaultState :: CreatureState defaultState = CrSt { _csDamage = [] - , -- , _crPastDamage = V.fromList $ replicate 20 [] - _csSpState = GenCr + , _csSpState = GenCr , _csDropsOnDeath = DropAll } diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index a9d1ab41b..1991609ae 100644 --- a/src/Dodge/Event/Input.hs +++ b/src/Dodge/Event/Input.hs @@ -57,8 +57,7 @@ handleMouseMotionEvent mmev cfig = (0.5 * windowYFloat cfig - fromIntegral y) handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input -handleMouseWheelEvent mwev = - (scrollAmount +~ fromIntegral y) +handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y where V2 _ y = mouseWheelEventPos mwev diff --git a/src/Dodge/Luse.hs b/src/Dodge/Luse.hs index bbdba904d..88e29f3af 100644 --- a/src/Dodge/Luse.hs +++ b/src/Dodge/Luse.hs @@ -30,7 +30,7 @@ useStopWatch itm _ w = w useTimeScrollGun :: Item -> Creature -> World -> World -useTimeScrollGun itm _ w = w & timeFlow .~ ScrollTimeFlow +useTimeScrollGun itm _ w = w & timeFlow .~ ItemScrollTimeFlow { _scrollSmoothing = 0 , _reverseAmount = itm ^?! itUse . leftConsumption . wpCharge , _futureWorlds = [] diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index c22498376..99872bb41 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -233,7 +233,7 @@ listControls = , ("q|e", "ROTATE CAMERA") , ("", "USE NORMAL CAMERA") , ("", "PAUSE AND FLOAT CAMERA") - , ("", "PAUSE AND PAN CAMERA") +-- , ("", "PAUSE AND PAN CAMERA") , ("", "QUICKSAVE") , ("", "QUICKLOAD") ] diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 775959c30..f0c2a08e1 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -228,11 +228,9 @@ doDrawing' win pdata u = do glBindTextureUnit 0 (pdata ^. fboBloom . _2 . unTO) glDisable GL_BLEND drawShader (_bloomBlurShader pdata) 4 - if cfig ^. graphics_bloom - then do + when (cfig ^. graphics_bloom) $ do replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) glEnable GL_BLEND - else return () setViewport _graphics_world_resolution cfig --draw clouds onto cloud buffer glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata))) diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 7e6121671..84b39d022 100644 --- a/src/Dodge/Save.hs +++ b/src/Dodge/Save.hs @@ -10,6 +10,7 @@ module Dodge.Save ( ) where +import Control.Monad import Data.Maybe import Dodge.WorldLoad import Dodge.Path.Translate @@ -44,8 +45,7 @@ writeSaveSlot ss u = do readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe) readSaveSlot ss = do fExists <- doesFileExist $ saveSlotPath ss - if not fExists then error "Tried to read non-existant save file" - else return () + when (not fExists) $ error "Tried to read non-existant save file" mcw <- decodeFileStrict $ saveSlotPath ss flip (maybe (error "Tried to read incorrectly encoded save file")) mcw $ \cw -> return $ \uv -> Just diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index feaeded2e..63e96d892 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -46,7 +46,8 @@ showTimeFlow :: TimeFlowStatus -> String showTimeFlow tfs = case tfs of DeathTime i -> "DeathTime"++show i NormalTimeFlow -> "NormalTimeFlow" - ScrollTimeFlow {_reverseAmount = ra } -> "ScrollTimeFlow" ++ show ra + ItemScrollTimeFlow {_reverseAmount = ra } -> "ItemScrollTimeFlow" ++ show ra + CameraScrollTimeFlow {_reverseAmount = ra } -> "CameraScrollTimeFlow" ++ show ra RewindLeftClick {_reverseAmount = ra } -> "RewindLeftClick" ++ show ra PausedTimeFlow {_timeFlowCharge = ra } -> "PausedTimeFlow" ++ show ra -- [ show $ u ^? uvScreenLayers . _head . scOffset diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 14e240f56..a5ea67406 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -143,15 +143,14 @@ updateUniverseMid u = case _uvScreenLayers u of timeFlowUpdate :: Universe -> Universe timeFlowUpdate u = case u ^. uvWorld . timeFlow of - _ | debugcamera -> u +-- _ | debugcamera -> u NormalTimeFlow -> functionalUpdate u - ScrollTimeFlow smoothing _ _ _ -> over uvWorld (doTimeScroll smoothing) u + ItemScrollTimeFlow smoothing _ _ _ -> over uvWorld (doItemTimeScroll smoothing) u + CameraScrollTimeFlow smoothing _ _ -> over uvWorld (doTimeScroll smoothing) u RewindLeftClick 0 _ -> u & uvWorld . timeFlow .~ NormalTimeFlow RewindLeftClick _ _ -> over uvWorld scrollTimeBack u -- & uvWorld . cWorld . timeFlow .~ NormalTimeFlow DeathTime{} -> u PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u - where - debugcamera = CamInGame /= (u ^. uvWorld . wCam . camControl) pauseTime :: Int -> World -> World pauseTime itmloc w @@ -162,13 +161,13 @@ pauseTime itmloc w outofcharge = maybe True (== 0) charge charge = w ^? pointerToItemLocation (w ^?! cWorld . lWorld . itemLocations . ix itmloc) . itUse . leftConsumption . wpCharge -doTimeScroll :: Int -> World -> World -doTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of +doItemTimeScroll :: Int -> World -> World +doItemTimeScroll smoothing w = case w ^? input . mouseButtons . ix ButtonLeft of Just 1 -> w & timeFlow .~ NormalTimeFlow - _ -> doTimeScroll' smoothing w + _ -> doTimeScroll smoothing w -doTimeScroll' :: Int -> World -> World -doTimeScroll' smoothing w = case w ^. input . scrollAmount of +doTimeScroll :: Int -> World -> World +doTimeScroll smoothing w = case w ^. input . scrollAmount of x | x > 1 -> w & scrollTimeBack & timeFlow . scrollSmoothing .~ 20 x | x > 0 -> w & scrollTimeBack & timeFlow . scrollSmoothing %~ max 0 x | x < (-1) -> w & scrollTimeForward & timeFlow . scrollSmoothing .~ negate 20 diff --git a/src/Dodge/Update/Camera.hs b/src/Dodge/Update/Camera.hs index 8881580b3..b9a89f1c2 100644 --- a/src/Dodge/Update/Camera.hs +++ b/src/Dodge/Update/Camera.hs @@ -5,6 +5,7 @@ module Dodge.Update.Camera ( updateCamera, ) where +import Dodge.WASD import Dodge.SmoothScroll import SDL (MouseButton (..)) import Dodge.Base.Coordinate @@ -32,13 +33,13 @@ updateCamera :: Configuration -> World -> World updateCamera cfig w = case w ^. wCam . camControl of CamInGame -> updateInGameCamera cfig w CamFloat -> updateFloatingCamera cfig w - CamPan -> w updateFloatingCamera :: Configuration -> World -> World updateFloatingCamera cfig w = w & updateBounds cfig & wCam %~ setViewDistance cfig & wCam %~ translateFloatingCamera theinput + & wCam %~ translateFloatingCameraKeys theinput & wCam %~ zoomFloatingCamera theinput where theinput = w ^. input @@ -55,17 +56,23 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do return $ cam & camCenter +~ thetran & camViewFrom +~ thetran +translateFloatingCameraKeys :: Input -> Camera -> Camera +translateFloatingCameraKeys theinput = (camCenter -~ thetran) + . (camViewFrom -~ thetran) + where + thetran = 10 *.* wasdDir theinput + zoomFloatingCamera :: Input -> Camera -> Camera -zoomFloatingCamera theinput cam = cam - & camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput)) - -- & camZoom *~ (zoomSpeed ^^ negate (theinput ^. smoothScrollAmount)) - +zoomFloatingCamera theinput cam + | ButtonRight `M.member` (theinput ^. mouseButtons) = cam + & camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput)) + | otherwise = cam updateInGameCamera :: Configuration -> World -> World updateInGameCamera cfig w = w & updateBounds cfig - & over (wCam) (setViewDistance cfig) + & over wCam (setViewDistance cfig) & wCam %~ moveZoomCamera cfig (w ^. input) (you w) & updateScopeZoom & rotateCamera cfig @@ -140,12 +147,12 @@ updateScopeZoom' i w doScopeZoom :: Int -> Point2 -> Scope -> Scope doScopeZoom scrollamount mp sc = case scrollamount of x - | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) $ sc - | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) $ sc - | x > 0 -> zoomInLongGun mp $ sc - | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) $ sc - | x < -5 -> (zoomOutLongGun . zoomOutLongGun) $ sc - | x < 0 -> zoomOutLongGun $ sc + | x > 10 -> (zoomInLongGun mp . zoomInLongGun mp . zoomInLongGun mp) sc + | x > 5 -> (zoomInLongGun mp . zoomInLongGun mp) sc + | x > 0 -> zoomInLongGun mp sc + | x < -10 -> (zoomOutLongGun . zoomOutLongGun . zoomOutLongGun) sc + | x < -5 -> (zoomOutLongGun . zoomOutLongGun) sc + | x < 0 -> zoomOutLongGun sc | otherwise -> sc zoomSpeed :: Float @@ -220,8 +227,8 @@ rotateCameraBy x w = rotateCamera :: Configuration -> World -> World rotateCamera cfig w | keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w - | keydown SDL.ScancodeQ = (rotateCameraBy 0.025) w - | keydown SDL.ScancodeE = (rotateCameraBy (-0.025)) w + | keydown SDL.ScancodeQ = rotateCameraBy 0.025 w + | keydown SDL.ScancodeE = rotateCameraBy (-0.025) w | otherwise = ifConfigWallRotate cfig w where keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus w) diff --git a/src/Dodge/Update/Input/InGame.hs b/src/Dodge/Update/Input/InGame.hs index ddc8b3728..e8f0031d5 100644 --- a/src/Dodge/Update/Input/InGame.hs +++ b/src/Dodge/Update/Input/InGame.hs @@ -78,7 +78,7 @@ updatePressedButtonsCarte' pkeys w where isDown but = but `M.member` pkeys mbutpos but = theinput ^. heldPos . at but - rot = fromMaybe 0 $ angleBetween (_mousePos (_input w)) <$> mbutpos SDL.ButtonLeft + rot = maybe 0 (angleBetween (_mousePos (_input w))) $ mbutpos SDL.ButtonLeft czoom = fromMaybe 1 $ do p <- mbutpos SDL.ButtonLeft return $ magV (_mousePos theinput) / magV p @@ -110,7 +110,7 @@ updateInitialPressInGame :: Universe -> Scancode -> Universe updateInitialPressInGame uv sc = case sc of ScancodeF1 -> useNormalCamera uv ScancodeF2 -> pauseAndFloatCam uv - ScancodeF3 -> pauseAndPanCam uv +-- ScancodeF3 -> pauseAndPanCam uv ScancodeF5 -> doQuicksave uv ScancodeF9 -> doQuickload uv ScancodeEscape -> pauseGame uv @@ -152,7 +152,7 @@ doRegexInput u i sss any ((== Just InitialPress) . (`M.lookup` pkeys)) [ScancodeReturn, ScancodeSlash] - endmouse = maybe False (==1) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft + endmouse = (Just 1 == ) $ u ^? uvWorld . input . mouseButtons . ix ButtonLeft backspacetonothing = sss ^? sssExtra . sssFilters . ix i . _Just == Just "" && ScancodeBackspace `M.lookup` pkeys == Just InitialPress diff --git a/src/Dodge/WorldLoad.hs b/src/Dodge/WorldLoad.hs index 4dc3c91b6..14f0698aa 100644 --- a/src/Dodge/WorldLoad.hs +++ b/src/Dodge/WorldLoad.hs @@ -9,7 +9,7 @@ import Shader.Data import Shader.Poke.Floor postUniverseLoadSideEffect :: Universe -> Universe -postUniverseLoadSideEffect = (uvIOEffects %~ (\f uv -> (uvWorld . cWorld) (postWorldLoad (uv ^. preloadData . renderData)) uv >>= f)) +postUniverseLoadSideEffect = uvIOEffects %~ (\f uv -> (uvWorld . cWorld) (postWorldLoad (uv ^. preloadData . renderData)) uv >>= f) postWorldLoad :: RenderData -> CWorld -> IO CWorld postWorldLoad rdata cw = do diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index edd55624f..14666768c 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -32,25 +32,6 @@ preloadRender = do putStrLn "Number cores available:" getNumCapabilities >>= print - forM_ [0, 1, 2] $ \i -> do - putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_COUNT " ++ show i - alloca $ \ptr -> do - glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_COUNT i ptr - x <- peek ptr - putStrLn $ show x - - forM_ [0, 1, 2] $ \i -> do - putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_SIZE " ++ show i - alloca $ \ptr -> do - glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_SIZE i ptr - x <- peek ptr - putStrLn $ show x - putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS" - alloca $ \ptr -> do - glGetIntegerv GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS ptr - x <- peek ptr - putStrLn $ show x - -- set up uniform buffer object putStrLn "Setup UBO" theUBO <- mglCreate glCreateBuffers diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 74155d273..749e49db8 100644 --- a/src/Shader/Compile.hs +++ b/src/Shader/Compile.hs @@ -46,7 +46,7 @@ makeShaderVBO :: IO (Shader, VBO) makeShaderVBO s shaderlist sizes pm = do prog <- makeSourcedShader s shaderlist - (vao, vbo) <- setupVBOVAO (sizes) + (vao, vbo) <- setupVBOVAO sizes return ( Shader { _shaderUINT = prog diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 6a7e38ff1..7c8870883 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -277,7 +277,7 @@ boxSurfaces size = memoBoxSurfaces :: V.Vector [[Int]] {-# INLINE memoBoxSurfaces #-} -memoBoxSurfaces = V.generate 10 $ boxSurfaces +memoBoxSurfaces = V.generate 10 boxSurfaces boxSurfacesIndices :: Int -> [[Int]] {-# INLINE boxSurfacesIndices #-}