gemstone 0.2.1 → 0.3

raw patch · 8 files changed

+95/−14 lines, 8 files

Files

• Gemstone/Color.hs +3/−0
• Gemstone/GL.hs +18/−1
• Gemstone/Loop.hs +18/−0
• Gemstone/Main.hs +17/−4
• Gemstone/Particles.hs +1/−1
• Gemstone/Sprite.hs +3/−7
• Gemstone/Util.hs +33/−0
• gemstone.cabal +2/−1

@@ -27,6 +27,9 @@ grassGreen = Color3 0 255 63 stoneGray = Color3 127 127 127 +hotPink :: RGB+hotPink = Color3 255 105 180+ -- | Vary a color by a given amount, using the provide random number --   generator. varyColor :: GLubyte -> StdGen -> RGB -> (StdGen, RGB)

@@ -2,7 +2,7 @@  import Control.Monad import Graphics.Rendering.OpenGL-import Graphics.UI.SDL+import Graphics.UI.SDL (glSwapBuffers)  checkErrors :: IO () checkErrors = do@@ -36,3 +36,20 @@ resizeViewport w h     | w > h     = viewport $= (Position ((w-3*h) `div` 2) (-h), Size (2*h) (2*h))     | otherwise = viewport $= (Position (-w) ((h-3*w) `div` 2), Size (2*w) (2*w))++-- | Turn on alpha blending.+enableBlending :: IO ()+enableBlending = do+    blend $= Enabled+    blendFunc $= (SrcAlpha, OneMinusSrcAlpha)++-- | Set some initial GL state that should be set once and only once.+--+--   It doesn't hurt to call this action multiple times.+prepareGLState :: IO ()+prepareGLState = do+    putStrLn "Preparing GL state..."+    checkErrors+    enableBlending+    putStrLn "Finished preparing GL state!"+    checkErrors

@@ -53,3 +53,21 @@     zoom _2 $ handler event     -- Continue until all events have been handled.     when (event /= NoEvent) $ handleEvents handler++updateTimers :: Loop a+updateTimers = do+    ticks <- lift getTicks+    gems . gTimers %= updateTimestamp ticks++gemstoneLoop :: Loop a -> Loop a -> Loop a -> Loop a+gemstoneLoop pre draw post = do+    updateTimers+    pre+    draw+    post+    q <- use $ gems . gQuitFlag+    unless q $ gemstoneLoop pre draw post++simpleLoop :: Loop a -> Loop a+simpleLoop draw = gemstoneLoop pre draw (return ())+    where pre = handleEvents (\_ -> return ())

@@ -7,8 +7,21 @@ import Gemstone.GL import Gemstone.Loop -gemstoneMain :: a -> Loop a -> IO ()-gemstoneMain globals loop = withInit [InitEverything] $ do-    initial <- getInitialGems+-- | Main entrypoint for Gemstone.+--+--   Note that SDL state (and, by extension, GL state) doesn't exist outside+--   of this function. However, SDL will be started before the globals are+--   populated, so it is possible to run SDL and/or GL actions in the setup.+--+--   >>> main = gemstoneMain makeGlobals (setupState >> mainLoop)+gemstoneMain :: IO a -> Loop a -> IO ()+gemstoneMain setup loop = withInit [InitEverything] $ do+    -- Order of operations matters, doesn't it...+    -- First, grab the gem state. This gets us the surface and enables GL.+    initialGems <- getInitialGems+    -- Now we can check GL extensions and set up our GL state.     checkExtensions-    void $ runStateT loop (initial, globals)+    prepareGLState+    -- And now the app-specific state can be created.+    initialState <- setup+    void $ runStateT loop (initialGems, initialState)

@@ -52,4 +52,4 @@     newParticle = makeParticle (x, y) life c' & _1 . aSprite . sMaterial %~ f     f material = case material of         Colored c'' _ -> Colored c'' . Just . fst $ random g-        x -> x+        mat -> mat

@@ -24,13 +24,8 @@ drawSprite (Sprite material b) = case material of     Colored c malpha -> do         case malpha of-            Just alpha -> do-                blend $= Enabled-                blendFunc $= (SrcAlpha, OneMinusSrcAlpha)-                color $ addAlpha alpha c-            Nothing -> do-                blend $= Disabled-                color c+            Just alpha -> color $ addAlpha alpha c+            Nothing -> color c         renderPrimitive Quads $ do             vertex (Vertex2 x y)             vertex (Vertex2 x' y)@@ -41,6 +36,7 @@         activeTexture $= TextureUnit 0         textureBinding Texture2D $= Just texobj         textureFunction $= Replace+        color hotPink         renderPrimitive Quads $ do             texCoord (TexCoord2 r s)             vertex (Vertex2 x y)

@@ -0,0 +1,33 @@+module Gemstone.Util where++import Data.Word+import Foreign++import Graphics.Rendering.OpenGL++checkerboard :: [Word8]+checkerboard = map (* 255) [ (x + y) `mod` 2 | x <- [0..7], y <- [0..7] ]++withWord8Ptr :: [Word8] -> (Ptr Word8 -> IO b) -> IO b+withWord8Ptr bytes action = let+    len = length bytes+    indexed = zip [0..] bytes+    in allocaBytes len $ \ptr -> do+        mapM_ (uncurry $ pokeElemOff ptr) indexed+        action ptr++-- | Pack a finite list of Word8s into a texture.+word8ToTexture :: Int -> Int -> [Word8] -> IO TextureObject+word8ToTexture width height bytes = do+    [texobj] <- genObjectNames 1+    textureBinding Texture2D $= Just texobj+    textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+    withWord8Ptr bytes $ \ptr -> let+        pd = PixelData Luminance UnsignedByte ptr+        size = TextureSize2D (fromIntegral width) (fromIntegral height)+        in texImage2D Nothing NoProxy 0 Luminance' size 0 pd+    textureBinding Texture2D $= Nothing+    return texobj++checkerboardTexture :: IO TextureObject+checkerboardTexture = word8ToTexture 8 8 checkerboard

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.2.1+Version:             0.3  -- A short (one-line) description of the package. Synopsis:            A simple library of helpers for SDL+GL games.@@ -69,6 +69,7 @@                    , Gemstone.Random                    , Gemstone.Sprite                    , Gemstone.Timers+                   , Gemstone.Util      -- Packages needed in order to build this package.   Build-depends:     base >= 4 && < 5