fix strange scrolling behaviour

examples/example04.hs

@@ -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)