nek0/vulkan-tutorial
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

fix strange scrolling behaviour

Browse source
This commit is contained in:
nek0 2017-03-24 21:58:53 +01:00
parent 538f5c0f7e
commit b3f4b871ea
1 changed files with 24 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
examples/example04.hs
View file

@ -36,7 +36,7 @@ data UserData = UserData
, foreground :: G.GeglBuffer , foreground :: G.GeglBuffer
, updateActors :: [Actor String] , updateActors :: [Actor String]
, keyDown :: Maybe SDL.Keycode , keyDown :: Maybe SDL.Keycode
, cameraX :: Int , cameraX :: Double
} }
load :: IO UserData load :: IO UserData
@ -145,9 +145,9 @@ draw = do
{ updateActors = [] { updateActors = []
} }
process (nodeGraph M.! "sink") process (nodeGraph M.! "sink")
present (GeglRectangle cameraX 0 800 600) foreground True present (GeglRectangle (round cameraX) 0 800 600) foreground True
render render
(Just $ G.GeglRectangle cameraX 0 800 600) (Just $ G.GeglRectangle (round cameraX) 0 800 600)
Nothing Nothing
update :: Double -> Affection UserData () update :: Double -> Affection UserData ()
@ -160,49 +160,40 @@ update dt = do
maybe (return ()) (\code -> do maybe (return ()) (\code -> do
let vel = 400 -- velocity in Pixels per second let vel = 400 -- velocity in Pixels per second
leg = floor (vel * dt) leg = vel * dt
(G.PropertyDouble xpos) <- (G.PropertyDouble xpos) <-
return $ apValue $ fromJust $ L.find (\a -> "x" == apName a) $ return $ apValue $ fromJust $ L.find (\a -> "x" == apName a) $
actorProperties $ actors ud M.! "rect" actorProperties $ actors ud M.! "rect"
nmap <- return $ M.adjust nmap <- return $ M.adjust
(updateProperties $ props $ prop "x" $ (updateProperties $ props $ prop "x" $ xpos +
case code of case code of
SDL.KeycodeLeft -> SDL.KeycodeLeft ->
if xpos > 0 if xpos - leg > 0
then xpos - fromIntegral leg then (- leg)
else xpos else 0
SDL.KeycodeRight -> SDL.KeycodeRight ->
if xpos < 3269 if xpos + leg < 3269
then xpos + fromIntegral leg then leg
else xpos else 0
_ -> xpos _ -> 0
) )
"rect" "rect"
(actors ud) (actors ud)
let {
offset | xpos - cameraX ud > 750 && cameraX ud + leg < 2489 =
case code of
SDL.KeycodeRight -> leg
_ -> 0
| xpos - cameraX ud < 50 && cameraX ud - leg > 0 =
case code of
SDL.KeycodeLeft -> (-leg)
_ -> 0
| otherwise = 0
}
putAffection ud putAffection ud
{ actors = nmap { actors = nmap
, updateActors = (nmap M.! "rect") : updateActors ud , updateActors = (nmap M.! "rect") : updateActors ud
} , cameraX = cameraX ud + offset
ud2 <- getAffection
(G.PropertyDouble xpos2) <-
return $ apValue $ fromJust $ L.find (\a -> "x" == apName a) $
actorProperties $ actors ud M.! "rect"
ncx <-
if xpos2 - fromIntegral (cameraX ud2) > 750
then return $
if cameraX ud2 + leg > 2489 && code == SDL.KeycodeRight
then cameraX ud2
else cameraX ud2 + leg
else
if xpos2 - fromIntegral (cameraX ud2) < 50
then return $
if cameraX ud2 - leg < 0 && code == SDL.KeycodeLeft
then cameraX ud2
else cameraX ud2 - leg
else
return $ cameraX ud2
putAffection ud2
{ cameraX = ncx
} }
) (keyDown ud) ) (keyDown ud)