fix strange scrolling behaviour

This commit is contained in:
nek0 2017-03-24 21:58:53 +01:00
parent 538f5c0f7e
commit b3f4b871ea

View file

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