gloss-game (empty) → 0.3.0.0
raw patch · 16 files changed
+584/−0 lines, 16 filesdep +basedep +glossdep +gloss-juicysetup-changedbinary-added
Dependencies added: base, gloss, gloss-juicy
Files
- Graphics/Gloss/Game.hs +253/−0
- LICENSE +27/−0
- Setup.hs +2/−0
- examples/bounce/Creeper.bmp binary
- examples/bounce/Main.hs +72/−0
- examples/bounce/Platform.bmp binary
- examples/bouncy-slime/Main.hs +122/−0
- examples/bouncy-slime/Platform.bmp binary
- examples/bouncy-slime/Slime.bmp binary
- examples/bouncy-slime/Slime2.bmp binary
- examples/bouncy-slime/Slime3.bmp binary
- examples/bouncy-slime/Slime4.bmp binary
- examples/slime/Main.hs +50/−0
- examples/slime/Slime.bmp binary
- examples/slime/SlimeBall.bmp binary
- gloss-game.cabal +58/−0
+ Graphics/Gloss/Game.hs view
@@ -0,0 +1,253 @@+-- |+-- Module : Main+-- Copyright : [2013] Manuel M T Chakravarty+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Portability : haskell2011++module Graphics.Gloss.Game (++ -- * Reexport some basic Gloss datatypes+ module Graphics.Gloss.Data.Color,+ module Graphics.Gloss.Data.Display,+ module Graphics.Gloss.Data.Picture,+ module Graphics.Gloss.Interface.Pure.Game,+ + -- * Geometry+ Size, Rect,++ -- * Load sprites into pictures+ bmp, png, jpg,+ + -- * Query pictures+ boundingBox,+ + -- * More convenient game play+ play, playInScene,+ + -- * Game scenes+ Animation, animation, noAnimation,+ Scene, picture, picturing, animating, translating, rotating, scaling, scenes,+ drawScene,+) where++ -- standard libraries+import Data.IORef+import System.IO.Unsafe (unsafePerformIO)++ -- packages+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture hiding (Picture(..))+import Graphics.Gloss.Data.Picture (Picture) -- keep 'Picture' abstract+import Graphics.Gloss.Interface.Pure.Game (Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..))+import Graphics.Gloss.Juicy+import qualified Graphics.Gloss as G+import qualified Graphics.Gloss.Interface.IO.Game as G+++-- Geometry+-- --------++type Size = (Float, Float) -- ^width & height++type Rect = (Point, Size) -- ^origin & extent, where the origin is at the centre+++-- On-the-fly image loading+-- ------------------------++-- |Turn a bitmap file into a picture.+--+-- NB: Define loaded pictures on the toplevel to avoid reloading.+--+bmp :: FilePath -> Picture+bmp fname = unsafePerformIO $ loadBMP fname++-- |Turn a PNG file into a picture.+--+-- NB: Define loaded pictures on the toplevel to avoid reloading.+--+png :: FilePath -> Picture+png fname = maybe (text "PNG ERROR") id (unsafePerformIO $ loadJuicyPNG fname)++-- |Turn a JPEG file into a picture.+--+-- NB: Define loaded pictures on the toplevel to avoid reloading.+--+jpg :: FilePath -> Picture+jpg fname = maybe (text "JPEG ERROR") id (unsafePerformIO $ loadJuicyJPG fname)+++-- Query pictures+-- --------------++-- |Determine the bounding box of a picture.+--+-- FIXME: Current implementation is incomplete!+--+boundingBox :: Picture -> Rect+boundingBox G.Blank = ((0, 0), (0, 0))+boundingBox (G.Polygon _) = error "Graphics.Gloss.Game.boundingbox: Polygon not implemented yet"+boundingBox (G.Line _) = error "Graphics.Gloss.Game.boundingbox: Line not implemented yet"+boundingBox (G.Circle r) = ((0, 0), (2 * r, 2 * r))+boundingBox (G.ThickCircle t r) = ((0, 0), (2 * r + t, 2 * r + t))+boundingBox (G.Arc _ _ _) = error "Graphics.Gloss.Game.boundingbox: Arc not implemented yet"+boundingBox (G.ThickArc _ _ _ _) = error "Graphics.Gloss.Game.boundingbox: ThickArc not implemented yet"+boundingBox (G.Text _) = error "Graphics.Gloss.Game.boundingbox: Text not implemented yet"+boundingBox (G.Bitmap w h _ _) = ((0, 0), (fromIntegral w, fromIntegral h))+boundingBox (G.Color _ p) = boundingBox p+boundingBox (G.Translate dx dy p) = let ((x, y), size) = boundingBox p in ((x + dx, y + dy), size)+boundingBox (G.Rotate _ang _p) = error "Graphics.Gloss.Game.boundingbox: Rotate not implemented yet"+boundingBox (G.Scale xf yf p) = let (origin, (w, h)) = boundingBox p in (origin, (w * xf, h * yf))+boundingBox (G.Pictures _ps) = error "Graphics.Gloss.Game.boundingbox: Pictures not implemented yet"+++-- Extended play function+-- ----------------------++-- |Play a game.+--+play :: Display -- ^Display mode+ -> Color -- ^Background color+ -> Int -- ^Number of simulation steps to take for each second of real time+ -> world -- ^The initial world state+ -> (world -> Picture) -- ^A function to convert the world to a picture+ -> (Event -> world -> world) -- ^A function to handle individual input events+ -> [Float -> world -> world] -- ^Set of functions invoked once per iteration —+ -- first argument is the period of time (in seconds) needing to be advanced+ -> IO ()+play display bg fps world draw handler steppers+ = G.play display bg fps world draw handler (perform steppers)+ where+ perform [] _time world = world+ perform (stepper:steppers) time world = perform steppers time (stepper time world)++-- Global variable to keep track of the time since we started playing (there can only always be one game anyway).+--+currentTime :: IORef Float+{-# NOINLINE currentTime #-}+currentTime = unsafePerformIO $ newIORef 0++-- |Play a game in a scene.+--+playInScene :: Display -- ^Display mode+ -> Color -- ^Background color+ -> Int -- ^Number of simulation steps to take for each second of real time+ -> world -- ^The initial world state+ -> Scene world -- ^A scene parameterised by the world+ -> (Float -> Event -> world -> world) -- ^A function to handle individual input events+ -- * first argument is the absolute time (in seconds)+ -> [Float -> Float -> world -> world] -- ^Set of functions invoked once per iteration —+ -- * first argument is the absolute time (in seconds)+ -- * second argument is the period of time needing to be advanced+ -> IO ()+playInScene display bg fps world scene handler steppers+ = G.playIO display bg fps world drawSceneNow performHandler (advanceTimeAndPerform steppers)+ where+ drawSceneNow world+ = do+ { now <- readIORef currentTime+ ; return $ drawScene scene now world+ }+ + performHandler event world + = do+ { now <- readIORef currentTime+ ; return $ handler now event world+ }++ advanceTimeAndPerform steppers deltaT world+ = do + { now <- readIORef currentTime+ ; let future = now + deltaT+ ; writeIORef currentTime future+ ; perform steppers future deltaT world+ }++ perform [] _now _deltaT world = return world+ perform (stepper:steppers) now deltaT world = perform steppers now deltaT (stepper now deltaT world)+++-- Scenes are parameterised pictures+-- ---------------------------------++-- |An abstract representation of an animation.+--+data Animation = Animation [Picture] Float Float++-- |Construct a new animation with a list of pictures for the animation, the time between animation frames, and a given+-- (absolute) start time.+--+animation :: [Picture] -> Float -> Float -> Animation+animation = Animation++-- |An empty animation.+--+noAnimation :: Animation+noAnimation = animation [] 1 0++-- |A scene describes the rendering of a world state — i.e., which picture should be draw depending on the current time+-- and of the state of the world.+--+data Scene world+ = Picturing (Float -> world -> Picture)+ | Translating ( world -> Point) (Scene world)+ | Rotating ( world -> Float) (Scene world)+ | Scaling ( world -> (Float, Float)) (Scene world)+ | Scenes [Scene world]++-- |Turn a static picture into a scene.+--+picture :: Picture -> Scene world+picture p = picturing (const p)++-- |Turn a world-dependent picture into a scene.+--+picturing :: (world -> Picture) -> Scene world+picturing worldToPic = Picturing (const worldToPic)++-- |Animate a world-dependent animation. The default picture is displayed while no animation is running.+--+animating :: (world -> Animation) -> Picture -> Scene world+animating anim defaultPic+ = Picturing (\currentTime world -> pickPicture currentTime (anim world))+ where+ pickPicture now (Animation pics delay start)+ | start > now = defaultPic+ | i >= length pics = defaultPic+ | otherwise = pics !! i+ where+ i = round ((now - start) / delay)++-- |Move a scene in dependences on a world-dependent location.+--+translating :: (world -> Point) -> Scene world -> Scene world+translating = Translating++-- |Rotate a scene in dependences on a world-dependent angle.+--+rotating :: (world -> Float) -> Scene world -> Scene world+rotating = Rotating++-- |Scale a scene in dependences on world-dependent scaling factors.+--+scaling :: (world -> (Float, Float)) -> Scene world -> Scene world+scaling = Scaling++-- |Compose a scene from a list of scenes.+--+scenes :: [Scene world] -> Scene world+scenes = Scenes++-- |Render a scene on the basis of time since playing started and the specific world state.+--+drawScene :: Scene world -> Float -> world -> Picture+drawScene scene time world = drawS scene+ where+ drawS (Picturing draw) = draw time world+ drawS (Translating movement scene) = let (x, y) = movement world in translate x y (drawS scene)+ drawS (Rotating rotation scene) = rotate (rotation world) (drawS scene)+ drawS (Scaling scaling scene) = let (xf, yf) = scaling world in scale xf yf (drawS scene)+ drawS (Scenes scenes) = pictures $ map drawS scenes
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013, Manuel M T Chakravarty+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice, this+ list of conditions and the following disclaimer in the documentation and/or+ other materials provided with the distribution.++* Neither the name of the {organization} nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/bounce/Creeper.bmp view
binary file changed (absent → 122934 bytes)
+ examples/bounce/Main.hs view
@@ -0,0 +1,72 @@+-- Very simple example of bouncing and jumping character.++import Data.Maybe+import Graphics.Gloss.Game++creeperSprite :: Picture+creeperSprite = bmp "Creeper.bmp"++platformSprite :: Picture+platformSprite = bmp "Platform.bmp"++gravitationalConstant :: Float+gravitationalConstant = -0.5++creeperWidth, creeperHeight :: Float+(_, (creeperWidth, creeperHeight)) = boundingBox (scale 0.5 0.5 creeperSprite)++platformPos :: Point+platformPos = (-200, -150)++platformWidth, platformHeight :: Float+(_, (platformWidth, platformHeight)) = boundingBox (scale 0.5 0.5 platformSprite)+++data World = World {creeperPos :: Point, creeperVelocity :: Float}++initialWorld :: World+initialWorld = World {creeperPos = (-200, 0), creeperVelocity = 0}++main = play (InWindow "Bouncy Creeper" (600, 400) (50, 50)) white 30 initialWorld draw handle [applyVelocity, applyGravity]+ where+ draw (World {creeperPos = (x, y)}) + = pictures [ translate x y (scale 0.5 0.5 creeperSprite)+ , translate (fst platformPos) (snd platformPos) (scale 0.5 0.5 platformSprite)+ ]+ + handle (EventKey (Char 'a') Down _ _) world = world {creeperPos = moveX (creeperPos world) (-10)}+ handle (EventKey (Char 'd') Down _ _) world = world {creeperPos = moveX (creeperPos world) 10}+ handle (EventKey (SpecialKey KeySpace) Down _ _) world = world {creeperVelocity = 10}+ handle _event world = world+ + applyVelocity _ world+ = world {creeperPos = moveY (creeperPos world) (creeperVelocity world)}+ + applyGravity _ world+ | onTheFloor world+ || onThePlatform world = world {creeperVelocity = creeperVelocity world * (-0.5)}+ | otherwise = world {creeperVelocity = creeperVelocity world + gravitationalConstant}+ + onTheFloor world = snd (creeperPos world) <= (-200) + creeperHeight / 2+ + onThePlatform world = snd (creeperPos world) <= snd platformPos + creeperHeight / 2 + platformHeight / 2+ && fst (creeperPos world) + creeperWidth / 2 > fst platformPos - platformWidth / 2+ && fst (creeperPos world) - creeperWidth / 2 < fst platformPos + platformWidth / 2+ +moveX :: Point -> Float -> Point+moveX (x, y) offset = if x + offset > 300 - creeperWidth / 2+ then (300 - creeperWidth / 2, y)+ else if x + offset < (-300) + creeperWidth / 2+ then ((-300) + creeperWidth / 2, y)+ else (x + offset, y)++moveY :: Point -> Float -> Point+moveY (x, y) offset = if y + offset > 200 - creeperHeight / 2+ then (x, 200 - creeperHeight / 2)+ else if y + offset < (-200) + creeperHeight / 2+ then (x, (-200) + creeperHeight / 2)+ else if y + offset < snd platformPos + creeperHeight / 2 + platformHeight / 2 + && x + creeperWidth / 2 > fst platformPos - platformWidth / 2+ && x - creeperWidth / 2 < fst platformPos + platformWidth / 2+ then (x, snd platformPos + creeperHeight / 2 + platformHeight / 2)+ else (x, y + offset)
+ examples/bounce/Platform.bmp view
binary file changed (absent → 38966 bytes)
+ examples/bouncy-slime/Main.hs view
@@ -0,0 +1,122 @@+-- Very simple example of bouncing and jumping character.++import Data.Maybe+import Graphics.Gloss.Game+++-- Constants+-- ---------++width, height :: Float+width = 600+height = 400++slimeSprite :: Picture+slimeSprite = bmp "Slime.bmp"++slimeBounceSprites :: [Picture]+slimeBounceSprites + = [ scale 0.5 0.5 $ bmp "Slime2.bmp"+ , scale 0.5 0.5 $ bmp "Slime3.bmp"+ , scale 0.5 0.5 $ bmp "Slime4.bmp"+ , scale 0.5 0.5 $ bmp "Slime2.bmp"+ ]++platformSprite :: Picture+platformSprite = bmp "Platform.bmp"++gravitationalConstant :: Float+gravitationalConstant = -0.5++slimeWidth, slimeHeight :: Float+(_, (slimeWidth, slimeHeight)) = boundingBox (scale 0.5 0.5 slimeSprite)++platformPos :: Point+platformPos = (-200, -150)++platformWidth, platformHeight :: Float+(_, (platformWidth, platformHeight)) = boundingBox (scale 0.5 0.5 platformSprite)+++-- Game world state+-- ----------------++data World + = World+ { pressedKeys :: [Char]+ , slimePos :: Point+ , slimeVelocity :: Float+ , slimeAnim :: Animation+ }++initialWorld :: World+initialWorld + = World + { pressedKeys = []+ , slimePos = (-200, 0)+ , slimeVelocity = 0+ , slimeAnim = noAnimation+ }+++-- Game play+-- ---------++main+ = playInScene (InWindow "Bouncy Slime" (round width, round height) (50, 50)) white 30 initialWorld level handle+ [applyMovement, applyVelocity, applyGravity]+ where+ handle _now (EventKey (Char c) Down _ _) world = world {pressedKeys = c : pressedKeys world}+ handle _now (EventKey (Char c) Up _ _) world = world {pressedKeys = filter (/= c) (pressedKeys world)}+ handle _now (EventKey (SpecialKey KeySpace) Down _ _) world = world {slimeVelocity = 10}+ handle _now _event world = world++ applyMovement _ _ world | 'a' `elem` pressedKeys world = world {slimePos = moveX (slimePos world) (-10)}+ | 'd' `elem` pressedKeys world = world {slimePos = moveX (slimePos world) 10}+ | otherwise = world + + applyVelocity _ _ world+ = world {slimePos = moveY (slimePos world) (slimeVelocity world)}+ + applyGravity now _ world+ | onTheFloor world+ || onThePlatform world = world { slimeVelocity = slimeVelocity world * (-0.5)+ , slimeAnim = if slimeVelocity world < -5+ then animation slimeBounceSprites 0.15 now+ else noAnimation}+ | otherwise = world {slimeVelocity = slimeVelocity world + gravitationalConstant}+ + onTheFloor world = snd (slimePos world) <= (-height / 2) + slimeHeight / 2+ + onThePlatform world = snd (slimePos world) <= snd platformPos + slimeHeight / 2 + platformHeight / 2+ && fst (slimePos world) + slimeWidth / 2 > fst platformPos - platformWidth / 2+ && fst (slimePos world) - slimeWidth / 2 < fst platformPos + platformWidth / 2+ +moveX :: Point -> Float -> Point+moveX (x, y) offset + | x + offset > width / 2 - slimeWidth / 2 = (width / 2 - slimeWidth / 2, y)+ | x + offset < (-width / 2) + slimeWidth / 2 = ((-width / 2) + slimeWidth / 2, y)+ | otherwise = (x + offset, y)++moveY :: Point -> Float -> Point+moveY (x, y) offset + | y + offset > height / 2 - slimeHeight / 2 + = (x, height / 2 - slimeHeight / 2)+ | y + offset < (-height / 2) + slimeHeight / 2 + = (x, (-height / 2) + slimeHeight / 2)+ | y + offset < snd platformPos + slimeHeight / 2 + platformHeight / 2 + && x + slimeWidth / 2 > fst platformPos - platformWidth / 2+ && x - slimeWidth / 2 < fst platformPos + platformWidth / 2+ = (x, snd platformPos + slimeHeight / 2 + platformHeight / 2)+ | otherwise+ = (x, y + offset)+++-- Level design+-- ------------++level :: Scene World+level = scenes+ [ translating slimePos $ animating slimeAnim (scale 0.5 0.5 slimeSprite)+ , picture $ (translate (fst platformPos) (snd platformPos) (scale 0.5 0.5 platformSprite))+ ]
+ examples/bouncy-slime/Platform.bmp view
binary file changed (absent → 38966 bytes)
+ examples/bouncy-slime/Slime.bmp view
binary file changed (absent → 43318 bytes)
+ examples/bouncy-slime/Slime2.bmp view
binary file changed (absent → 43318 bytes)
+ examples/bouncy-slime/Slime3.bmp view
binary file changed (absent → 43318 bytes)
+ examples/bouncy-slime/Slime4.bmp view
binary file changed (absent → 43318 bytes)
+ examples/slime/Main.hs view
@@ -0,0 +1,50 @@+-- Very simple example of moving a character and shooting a projectile.++import Data.Maybe+import Graphics.Gloss.Game++slimeSprite :: Picture+slimeSprite = bmp "Slime.bmp"++slimeBallSprite :: Picture+slimeBallSprite = bmp "SlimeBall.bmp"++data World = World {slimePos :: Point, ballPos :: Maybe Point }++initialWorld :: World+initialWorld = World {slimePos = (0, 0), ballPos = Nothing}++main = play (InWindow "Slime" (600, 400) (50, 50)) white 30 initialWorld draw handle [boxInSlime, moveBall]+ where+ draw (World {slimePos = (x, y), ballPos = ballPos}) + = pictures [ translate x y (scale 0.5 0.5 slimeSprite)+ , maybeDrawBall ballPos+ ]+ + maybeDrawBall Nothing = blank+ maybeDrawBall (Just (x, y)) = translate x y (scale 0.5 0.5 slimeBallSprite)+ + handle (EventKey (Char 'a') Down _ _) world = world {slimePos = moveX (slimePos world) (-10)}+ handle (EventKey (Char 'd') Down _ _) world = world {slimePos = moveX (slimePos world) 10}+ handle (EventKey (Char 's') Down _ _) world = world {slimePos = moveY (slimePos world) (-10)}+ handle (EventKey (Char 'w') Down _ _) world = world {slimePos = moveY (slimePos world) 10}+ handle (EventKey (SpecialKey KeySpace) Down _ _) world = if isNothing (ballPos world)+ then world {ballPos = Just (slimePos world)}+ else world+ handle _event world = world+ + boxInSlime _ world = let (x, y) = slimePos world+ in + world { slimePos = ((x `max` (-300)) `min` 300, + (y `max` (-200)) `min` 200) }+ + moveBall _ world@(World {ballPos = Nothing}) = world+ moveBall _ world@(World {ballPos = Just (x, y)}) = if x > 300+ then world {ballPos = Nothing}+ else world {ballPos = Just (x + 8, y)}++moveX :: Point -> Float -> Point+moveX (x, y) offset = (x + offset, y)++moveY :: Point -> Float -> Point+moveY (x, y) offset = (x, y + offset)
+ examples/slime/Slime.bmp view
binary file changed (absent → 32502 bytes)
+ examples/slime/SlimeBall.bmp view
binary file changed (absent → 7734 bytes)
+ gloss-game.cabal view
@@ -0,0 +1,58 @@+Name: gloss-game+Version: 0.3.0.0+Cabal-version: >= 1.6+Tested-with: GHC >= 7.6+Build-type: Simple++Synopsis: Gloss wrapper that simplifies writing games+Description:+ The game interface of the basic Gloss library combines frame-based rendering with user input into a simple 2D game API.+ Gloss.Game improves that API to make common tasks in game programming, such as, on demand image loading, animations, and+ event handler chains more convenient.++License: BSD3+License-file: LICENSE+Author: Manuel M T Chakravarty+Maintainer: Manuel M T Chakravarty <chak@cse.unsw.edu.au>+Bug-reports: https://github.com/mchakravarty/gloss-game/issues+Homepage: https://github.com/mchakravarty/gloss-game++Category: Graphics, Game+Stability: Experimental++Extra-source-files: examples/slime/Main.hs+ examples/slime/Slime.bmp+ examples/slime/SlimeBall.bmp+ examples/bounce/Main.hs+ examples/bounce/Creeper.bmp+ examples/bounce/Platform.bmp+ examples/bouncy-slime/Main.hs+ examples/bouncy-slime/Slime.bmp+ examples/bouncy-slime/Slime2.bmp+ examples/bouncy-slime/Slime3.bmp+ examples/bouncy-slime/Slime4.bmp+ examples/bouncy-slime/Platform.bmp+ +Library+ Build-depends: base >= 4 && < 5,+ gloss >= 1.8,+ gloss-juicy >= 0.1.2++ Exposed-modules: Graphics.Gloss.Game++ ghc-options: -O2+ -Wall+ -fwarn-tabs+ -fno-warn-name-shadowing++ ghc-prof-options: -auto-all++ -- Don't add the extensions list here. Instead, place individual LANGUAGE+ -- pragmas in the files that require a specific extension. This means the+ -- project loads in GHCi, and avoids extension clashes.+ --+ -- Extensions:++source-repository head+ type: git+ location: https://github.com/mchakravarty/gloss-game