Permalink
Browse files

Initial

  • Loading branch information...
0 parents commit c42664da8132b0c8ed6e26887d1b04585d0c5a6f @Detegr committed May 3, 2012
Showing with 92 additions and 0 deletions.
  1. BIN img/dude.png
  2. +92 −0 sdl.hs
BIN img/dude.png
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
92 sdl.hs
@@ -0,0 +1,92 @@
+import Graphics.UI.SDL.Image
+import Graphics.UI.SDL
+import Control.Monad
+
+data Player = Player
+ {
+ x :: Int,
+ y :: Int
+ }
+zeroPlr :: Player
+zeroPlr = Player 0 0
+
+data GameState = GameState
+ {
+ player :: Player,
+ keys :: KeyState,
+ notRunning :: Bool
+ }
+mkSt :: Player -> KeyState -> GameState
+mkSt player keystate = GameState player keystate False
+
+data KeyState = KeyState
+ {
+ keyUp :: Bool,
+ keyDown :: Bool,
+ keyLeft :: Bool,
+ keyRight :: Bool
+ }
+zeroKeys :: KeyState
+zeroKeys = KeyState False False False False
+
+data GameData = GameData
+ {
+ screen :: Surface,
+ sprite :: Surface
+ }
+zeroState :: GameState
+zeroState = GameState zeroPlr zeroKeys False
+
+loadImage :: String -> IO Surface
+loadImage f = load f >>= displayFormat
+
+applySurface :: Int -> Int -> Surface -> Surface -> IO Bool
+applySurface x y src dst = blitSurface src Nothing dst offset
+ where offset = Just (Rect x y 0 0)
+
+loop :: GameData -> GameState -> IO ()
+loop g s = do state <- pollEvents s
+ let (Player x y) = player s
+ applySurface x y (sprite g) (screen g)
+ Graphics.UI.SDL.flip (screen g)
+ unless (notRunning state) (loop g state)
+
+pollEvents :: GameState -> IO GameState
+pollEvents g = pollEvent >>= \e ->
+ case e of Quit -> return (GameState (player g) zeroKeys True)
+ KeyDown k -> setKey k True g
+ KeyUp k -> setKey k False g
+ _ -> tick g
+
+setKey :: Keysym -> Bool -> GameState -> IO GameState
+setKey (Keysym k _ _) b g = case k of SDLK_UP -> return $ mkSt (player g) (KeyState b d l r)
+ SDLK_DOWN -> return $ mkSt (player g) (KeyState u b l r)
+ SDLK_LEFT -> return $ mkSt (player g) (KeyState u d b r)
+ SDLK_RIGHT -> return $ mkSt (player g) (KeyState u d l b)
+ _ -> return g
+ where (KeyState u d l r) = keys g
+
+movePlayer :: KeyState -> Player -> Player
+movePlayer (KeyState u d l r) (Player x y)
+ | u && l = Player (x-1) (y-1)
+ | u && r = Player (x+1) (y-1)
+ | u = Player x (y-1)
+ | d && l = Player (x-1) (y+1)
+ | d && r = Player (x+1) (y+1)
+ | d = Player x (y+1)
+ | l = Player (x-1) y
+ | r = Player (x+1) y
+ | otherwise = Player x y
+
+tick :: GameState -> IO GameState
+tick g = return $ GameState (movePlayer (keys g) (player g)) (keys g) False
+
+initData :: IO GameData
+initData = do screen <- setVideoMode 800 600 32 [SWSurface]
+ setCaption "test" []
+ image <- loadImage "img/dude.png"
+ return $ GameData screen image
+
+main = withInit [InitEverything] $ do
+ gdata <- initData
+ loop gdata zeroState

0 comments on commit c42664d

Please sign in to comment.