Tweak pause camera movement

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