Changed starting code to a better example

- Modified starting code to package bmp files in Assets

FirstGameHS.cabal

@@ -12,13 +12,13 @@ category:               Game
 build-type:             Simple
 cabal-version:          >=1.10
 extra-source-files:     README.md
-data-dir:               Assets
-data-files:             *.bmp
+data-files:             Assets/*.bmp
 
 executable FirstGameHS
   hs-source-dirs:       src
   main-is:              Main.hs
   default-language:     Haskell2010
   build-depends:        base >= 4.7 && < 5
                         , sdl2
+                        , pretty-simple
   other-modules:        Paths_FirstGameHS

src/Main.hs

@@ -1,19 +1,84 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 module Main where
 
 import Control.Monad
 import Foreign.C.Types
 import SDL.Vect
 import SDL (($=))
 import qualified SDL
+import Data.List (foldl')
+import SDL.Raw.Timer as SDL hiding (delay)
+import Text.Pretty.Simple
 
 import Paths_FirstGameHS(getDataFileName)
 
 screenWidth, screenHeight :: CInt
 (screenWidth, screenHeight) = (640, 480)
 
-loadBMP :: FilePath -> IO SDL.Surface
-loadBMP path = getDataFileName path >>= SDL.loadBMP
+frameLimit :: Int
+frameLimit = 60
+
+-- This is our game world. It only consists of one lonely guy
+-- who has a position and a velocity
+data World
+    = Guy
+    { position :: Point V2 CDouble
+    , velocity :: V2 CDouble
+    } deriving (Show, Eq)
+
+-- Our initial world starts out with the guy roughly in the middle
+initialGuy :: World
+initialGuy =
+    Guy
+    { position = P $ V2 (fromIntegral screenWidth / 2) (fromIntegral $ screenHeight - 100)
+    , velocity = V2 0 0
+    }
+
+jumpVelocity :: V2 CDouble
+jumpVelocity = V2 0 (-2)
+
+walkingSpeed :: V2 CDouble
+walkingSpeed = V2 1 0
+
+gravity :: V2 CDouble
+gravity = V2 0 0.7
+
+
+-- These simplify matching on a specific key code
+pattern KeyPressed a <- (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Pressed False (SDL.Keysym _ a _)))
+pattern KeyReleased a <- (SDL.KeyboardEvent (SDL.KeyboardEventData _ SDL.Released _ (SDL.Keysym _ a _)))
+
+
+-- This processed input and modifies velocities of things in our world accordingly
+-- and then returns the new world
+processInput :: World -> SDL.EventPayload -> World
+processInput world@(Guy _ curVel) (KeyPressed SDL.KeycodeUp) =
+    world { velocity = curVel * V2 1 0 + jumpVelocity}
+processInput world@(Guy _ curVel) (KeyPressed SDL.KeycodeLeft) =
+    world { velocity = negate walkingSpeed + curVel  }
+processInput world@(Guy _ curVel) (KeyPressed SDL.KeycodeRight) =
+    world { velocity = walkingSpeed + curVel  }
+
+processInput world@(Guy _ curVel) (KeyReleased SDL.KeycodeUp) =
+    world { velocity = curVel - jumpVelocity }
+processInput world@(Guy _ curVel) (KeyReleased SDL.KeycodeLeft) =
+    world { velocity = curVel - negate walkingSpeed  }
+processInput world@(Guy _ curVel) (KeyReleased SDL.KeycodeRight) =
+    world { velocity = curVel - walkingSpeed  }
+processInput w _ = w
+
+
+-- This function takes cares of applying things like our entities' velocities
+-- to their positions, as well as
+updateWorld :: CDouble -> World -> World
+updateWorld delta (Guy (P pos) vel) =
+    let (V2 newPosX newPosY) = pos + (gravity + vel) * V2 delta delta
+        -- Ensure that we stay within bounds
+        fixedX = max 0 $ min newPosX (fromIntegral screenWidth - 50)
+        fixedY = max 0 $ min (fromIntegral screenHeight - 100) newPosY
+    in Guy (P $ V2 fixedX fixedY) vel
+
 
 main :: IO ()
 main = do
@@ -22,7 +87,7 @@ main = do
   SDL.initialize [SDL.InitVideo]
 
   -- Create a window with the correct screensize and make it appear
-  window <- SDL.createWindow "SDL Tutorial"
+  window <- SDL.createWindow "FirstGameHS"
     SDL.defaultWindow { SDL.windowInitialSize = V2 screenWidth screenHeight }
   SDL.showWindow window
 
@@ -39,25 +104,46 @@ main = do
   SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound
 
   -- Make a surface from file
-  xOutSurface <- getDataFileName "foo.bmp" >>= SDL.loadBMP
+  xOutSurface <- getDataFileName "Assets/foo.bmp" >>= SDL.loadBMP
   texture <- SDL.createTextureFromSurface renderer xOutSurface
 
   -- Free the surface as we have a texture now
   SDL.freeSurface xOutSurface
 
-  let loop = do
+
+  let loop last world = do
         events <- SDL.pollEvents
 
-        let quit = elem SDL.QuitEvent $ map SDL.eventPayload events
+        -- Need to calculate the time delta
+        now <- SDL.getPerformanceCounter
+        freq <- SDL.getPerformanceFrequency
+
+        let delta = (fromIntegral now - fromIntegral last) * 1000 / fromIntegral freq
+            payloads = map SDL.eventPayload events
+            quit = SDL.QuitEvent `elem` payloads
+
+        -- Update functions
+        let worldAfterInput = foldl' processInput world payloads
+            newWorld        = updateWorld delta worldAfterInput
 
         SDL.clear renderer
-        SDL.copy renderer texture Nothing (Just $ SDL.Rectangle (P $ V2 0 0) (V2 200 200))
-        SDL.present renderer
 
-        unless quit loop
+        -- Render functions
+        SDL.copy renderer texture Nothing Nothing
+        -- Draw our world(guy) as a white rectangle
+        let drawColor = SDL.rendererDrawColor renderer
+        drawColor $= V4 255 255 255 0
+        SDL.fillRect renderer . Just $ SDL.Rectangle (truncate <$> position newWorld) (V2 50 100)
+
+        -- My attempt at an FPS limit. I don't write games so it is possible this is incorrect
+        let frameDelay = 1000 / fromIntegral frameLimit
+        when (delta < frameDelay) $ SDL.delay (truncate $ frameDelay - delta)
 
-  loop
+        SDL.present renderer
+        unless quit $ loop now newWorld
 
+  now <- SDL.getPerformanceCounter
+  loop now initialGuy
 
   SDL.destroyWindow window
   SDL.quit