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

Fix direction stuttering bug

Browse Source
This commit is contained in:
justin
2021-09-22 19:42:39 +01:00
parent 0295b3dd70
commit 7b6904b51f
10 changed files with 59 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Impulse/Movement.hs
+8 -5
View File
@@ -76,18 +76,21 @@ creatureTurnTo p cr
vToTarg = p -.- _crPos cr
dirToTarget = argV vToTarg
-- the following is perhaps not ideal because it mixes normalizeAngle with
-- angleVV, but it seems to work
creatureTurnTowardDir
:: Float -- ^ Angle
-> Float -- ^ Turn speed
-> Creature
-> Creature
creatureTurnTowardDir a turnSpeed cr
| vToTarg == V2 0 0 = cr -- this should deal with the angleVV error
| errorAngleVV 3 vToTarg (unitVectorAtAngle (_crDir cr)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr) = cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
| normalizeAngle (abs (a - cdir)) <= turnSpeed
= cr & crDir .~ dirToTarget
| isLeftOfA (normalizeAngle dirToTarget) (normalizeAngle $ _crDir cr)
= cr & crDir +~ turnSpeed
| otherwise = cr & crDir -~ turnSpeed
where
cdir = _crDir cr
vToTarg = rotateV a (V2 1 0)
dirToTarget = argV vToTarg
src/Dodge/Creature/State.hs
+12 -21
View File
@@ -100,19 +100,17 @@ bpVector = V.fromList $ 0 : [0 .. 18]
movementSideEff :: Creature -> World -> World
movementSideEff cr w
| hasJetPack
= case cr ^? crStance . carriage of
Just (Boosting v)
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
20
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
Nothing
1
20
$ set randGen g
w
_ -> w
| hasJetPack = case cr ^? crStance . carriage of
Just (Boosting v)
-> makeFlameletTimed
(oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
20
(momentum +.+ 1 *.* rotateV randDir (vInverse v))
Nothing
1
20
$ set randGen g w
_ -> w
| otherwise = footstepSideEffect cr w
where
hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr
@@ -124,9 +122,6 @@ movementSideEff cr w
(randDir,g) = randomR (-0.5,0.5) $ _randGen w
(randAng,_) = randomR (0,2*pi) $ _randGen w
--crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5
invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
where
@@ -165,15 +160,11 @@ isFrictionless cr = case cr ^? crStance . carriage of
stepItemUseCooldown :: Creature -> Creature
stepItemUseCooldown cr = cr & crInv . ix iSel %~
(itUseTime %~ decreaseToZero) . (wpCurWarmUp %~ decreaseToZero)
--( over (crInv . ix iSel . itUseTime) decreaseToZero cr
where
iSel = _crInvSel cr
stepReloading :: Creature -> Creature
stepReloading cr
-- | crIsAiming' cr = cr
-- | otherwise
= over (crInv . ix iSel . wpReloadState) decreaseToZero cr
stepReloading cr = over (crInv . ix iSel . wpReloadState) decreaseToZero cr
where
iSel = _crInvSel cr
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -38,7 +38,7 @@ wasdWithAiming
-> Creature
wasdWithAiming w speed i cr
| isAiming = set crDir mouseDir $ theMovement cr
| otherwise = theTurn $ theMovement cr
| otherwise = theMovement $ theTurn cr
where
theMovement
| movDir == V2 0 0 = id
src/Dodge/Item/Weapon/Bezier.hs
+8 -7
View File
@@ -14,14 +14,12 @@ import Dodge.Particle.Bullet.Spawn
import Dodge.Particle.Bullet.HitEffect
import Dodge.WorldEvent.HitEffect
import Dodge.RandomHelp
import Dodge.Picture.Layer
import Dodge.SoundLogic.LoadSound
import Picture
import Geometry
--import ShapePicture
import ShapePicture
import Shape
--import System.Random
import Data.Maybe
import Control.Lens
import Control.Monad.State
@@ -37,8 +35,8 @@ bezierGun = defaultGun
. withRecoilI 40
. torqueBefore 0.05
]
, _itFloorPict = (,) emptySH $ onLayer FlItLayer bezierGunPic
, _itEquipPict = pictureWeaponOnAim $ (,) emptySH bezierGunPic
, _itFloorPict = bezierGunSPic
, _itEquipPict = pictureWeaponOnAim bezierGunSPic
, _itAttachment = NoItAttachment
, _itScroll = \_ _ -> removeItTarget
, _itHammer = HammerUp
@@ -49,8 +47,11 @@ bezierGun = defaultGun
, _itUseRate = 6
, _itAimStance = TwoHandTwist
}
bezierGunPic :: Picture
bezierGunPic = color red $ polygon $ rectNESW 4 12 (-4) (-12)
bezierGunSPic :: SPic
bezierGunSPic =
( colorSH red $ upperPrismPoly 5 $ rectNESW 4 12 (-4) (-12)
, mempty
)
shootBezier :: Point2 -> Creature -> World -> World
shootBezier targetp cr w = w & particles %~ (theBullet :)
src/Dodge/Render.hs
+6 -8
View File
@@ -42,6 +42,9 @@ doDrawing pdata w = do
viewFrom3d = Vector3 vfx vfy 20
shadV = _pictureShaders pdata
-- bind as much data into vbos as feasible at this point
-- pictures
layerCounts <- UMV.replicate (6*6) 0
pokeBindFoldableLayer shadV layerCounts $ worldPictures w
-- poke wall points and colors
nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
(nShapeVs,nIndices,nSilIndices) <- pokeShape
@@ -83,11 +86,9 @@ doDrawing pdata w = do
if w ^. config . wall_textured
then renderTextureWalls pdata nWalls
else renderBlankWalls pdata nWalls
--draw objects onto base buffer
layerCounts <- UMV.replicate (6*6) 0
pokeBindFoldableLayer shadV layerCounts $ worldPictures w
--draw object pictures onto base buffer
renderLayer 0 shadV layerCounts
--draw object shpaes onto base buffer
let fs = _shapeShader pdata
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
@@ -96,15 +97,13 @@ doDrawing pdata w = do
(fromIntegral nIndices)
GL_UNSIGNED_SHORT
nullPtr
--draw floor onto base buffer
nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs]
drawShader (_textureArrayShader pdata) nTextArrayVs
--draw lightmap for base buffer
--draw lightmap into its own buffer
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
createLightMap pdata lightPoints nWalls nSilIndices nIndices (snd $ snd $ _fboBase pdata)
--createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata)
colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0
--apply lightmap to base buffer
@@ -113,7 +112,6 @@ doDrawing pdata w = do
blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
--draw bloom onto bloom buffer
bindFramebuffer Framebuffer $= fst (_fboBloom pdata)
clear [ColorBuffer]
src/Dodge/Render/HUD.hs
+11 -29
View File
@@ -103,27 +103,15 @@ displayMidList w strs s =
invHead :: World -> String -> Picture
invHead w s = winScale w . translate (-130) (halfHeight w - 40) . dShadCol white . scale 0.4 0.4 $ text s
renderItemMapAt :: Float -> Float -> IM.IntMap Item -> World -> Picture
{-# INLINE renderItemMapAt #-}
renderItemMapAt tx ty scols w =
--concatMapPic (winScale w) $ IM.mapWithKey (listItemAt tx ty w) scols
--concatMapPic (winScale w . uncurry (listItemAt tx ty w)) $ IM.toList scols
concatMapPic (uncurry $ listItemAt' tx ty w) $ IM.toList scols
--renderPairListAt :: Float -> Float -> [(Int,(String,Color))] -> World -> Picture
--renderPairListAt tx ty scols w =
-- concatMapPic (winScale w) $ map (uncurry $ listPairAt tx ty w) scols
renderItemMapAt :: Float -> Float -> World -> IM.IntMap Item -> Picture
--{-# INLINE renderItemMapAt #-}
renderItemMapAt tx ty w = concatMapPic (uncurry $ listItemAt tx ty w) . IM.toList
displayInv :: Int -> World -> Picture
displayInv n w = renderItemMapAt 0 0 items w
displayInv n w = renderItemMapAt 0 0 w items
where
items = _crInv $ _creatures w IM.! n
--itemStringCol :: Item -> (String,Color)
--itemStringCol NoItem = ("----", greyN 0.5)
--itemStringCol itm = (_itInvDisplay itm itm, _itInvColor itm)
drawLocations :: World -> Picture
drawLocations w = pictures $
renderListAt 0 0 w locs
@@ -192,33 +180,27 @@ closeObjectTexts w = pictures $
mainListCursor :: Color -> Int -> World -> Picture
mainListCursor c = openCursorAt 120 c 5 0
listItemAt'
listItemAt
:: Float -- ^ x offset
-> Float -- ^ y offset
-> World
-> Int -- ^ y offset (discrete)
-> Item -- ^ The item
-> Picture
{-# INLINE listItemAt' #-}
listItemAt' xoff yoff w yint item = winScale w . translate (xoff + 15 - halfWidth w) (yoff + halfHeight w - (20 * (fromIntegral yint+1)))
--{-# INLINE listItemAt #-}
listItemAt xoff yoff w yint item
= winScale w
. translate (xoff + 15 - hw) (yoff + hh - (20 * (fromIntegral yint+1)))
. scale 0.1 0.1
. dShadCol col
$ text s
where
hw = halfWidth w
hh = halfHeight w
(s,col) = case item of
NoItem -> ("----", greyN 0.5)
_ -> (_itInvDisplay item item , _itInvColor item)
--listItemAt
-- :: Float -- ^ x offset
-- -> Float -- ^ y offset
-- -> World
-- -> Int -- ^ y offset (discrete)
-- -> Item -- ^ The item
-- -> Picture
--{-# INLINE listItemAt #-}
--listItemAt xoff yoff w yint = listPairAt xoff yoff w yint . itemStringCol
openCursorAt
:: Float -- ^ Width
-> Color
src/Dodge/Render/List.hs
+1
View File
@@ -23,6 +23,7 @@ listPairAt xoff yoff w yint (s,col)
$ text s
{- | Colour picture and add black drop shadow. -}
dShadCol :: Color -> Picture -> Picture
{-# INLINE dShadCol #-}
dShadCol c p = pictures
[ color black $ translate 1.2 (-1.2) p
, color c p
src/Geometry/Vector.hs
+2
View File
@@ -43,6 +43,8 @@ normalizeV :: Point2 -> Point2
normalizeV p = (1 / magV p) *.* p
{- | Angle between two vectors. Always positive. -}
-- TODO fix this: it seems to be unstable when the two vectors are very close to
-- each other
angleVV :: Point2 -> Point2 -> Float
{-# INLINE angleVV #-}
angleVV a b
src/Picture.hs
-2
View File
@@ -180,7 +180,6 @@ scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
scale :: Float -> Float -> Picture -> Picture
{-# INLINE scale #-}
--scale x y = map . second . overPos $ scale3 x y
scale x = map . overPos . scale3 x
rotate :: Float -> Picture -> Picture
@@ -330,7 +329,6 @@ overCol f vx = vx {_vxCol = f (_vxCol vx)}
-- no premature optimisation, consider changing to use texture arrays
stringToList :: String -> [(Point3,Point4,Point2)]
{-# INLINE stringToList #-}
--stringToList s = concat $ zipWith charToTuple [0,0.9*dimText ..] s
stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s
where
dimText = 100
src/Render.hs
+10 -20
View File
@@ -11,15 +11,12 @@ module Render
import Shader
import Shader.ExtraPrimitive
import Shader.Data
--import Shader.Poke
import Data.Preload.Render
import Picture.Data
import Geometry.Data
--import Data.Foldable
import Foreign hiding (rotate)
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
--import qualified SDL
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive
@@ -29,9 +26,6 @@ import Graphics.GL.Core43
divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
--sizeToTexSize :: Size -> TextureSize2D
--sizeToTexSize (Size x y) = TextureSize2D x y
{- | Determine where light is shining in the world. -}
createLightMap
:: RenderData
@@ -42,6 +36,8 @@ createLightMap
-> TextureObject -- ^ the texture object giving positions
-> IO ()
createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
let llsShad = _lightingLineShadowShader pdata
let lcShad = _lightingCapShader pdata
-- we assume that the renderbuffer's depth has been correctly set elsewhere
-- we will not be changing that here
depthMask $= Disabled
@@ -68,35 +64,29 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
$= Vector3 x y z
drawShader (_lightingOccludeShader pdata) nWalls
--draw silhouette shadows
let llss = _lightingLineShadowShader pdata
currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata)
currentProgram $= Just (_shadProg llsShad)
uniform (head $ _shadUnis $ _lightingLineShadowShader pdata)
$= Vector3 x y z
-- drawShader (_lightingLineShadowShader pdata) nSils
bindVertexArrayObject $= Just (_vao $ _shadVAO llss)
bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim llss)
(marshalEPrimitiveMode $ _shadPrim llsShad)
(fromIntegral nSils)
GL_UNSIGNED_SHORT
nullPtr
cullFace $= Just Back
--draw caps on the near plane as required
currentProgram $= Just (_shadProg $ _lightingCapShader pdata)
uniform (head $ _shadUnis $ _lightingCapShader pdata)
currentProgram $= Just (_shadProg $ lcShad)
uniform (head $ _shadUnis $ lcShad)
$= Vector3 x y z
-- TODO clean this up
let fs = _lightingCapShader pdata
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad)
glDrawElements
(marshalEPrimitiveMode $ _shadPrim fs)
(marshalEPrimitiveMode $ _shadPrim lcShad)
(fromIntegral nCaps)
GL_UNSIGNED_SHORT
nullPtr
--drawShader (_lightingCapShader pdata) nCaps
--draw lightmap itself
depthFunc $= Just Always
--cullFace $= Nothing
-- bind world position texture
bindTO toPos
colorMask $= Color4 Enabled Enabled Enabled Enabled
stencilOp $= (OpKeep,OpKeep,OpKeep)