SimpleGL 0.9.1 → 0.9.2

raw patch · 3 files changed

+28/−18 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• SimpleGL.cabal +4/−3
• src/SimpleH/GL.hs +14/−9
• src/SimpleH/GL/Texture.hs +10/−6

@@ -1,6 +1,6 @@  name:                SimpleGL-version:             0.9.1+version:             0.9.2 synopsis:            A Simple Graphics Library from the SimpleH framework. description:    synopsis: A Simple Graphics Library from the SimpleH framework.         @@ -17,8 +17,9 @@   other-modules: SimpleH.GL.Base          build-depends:       base ==4.6.*, SimpleH ==1.0.*, GLFW ==0.5.*, OpenGL ==2.8.*, JuicyPixels ==3.1.*, vector ==0.10.*   hs-source-dirs:      src-  extensions:  RebindableSyntax, NoMonomorphismRestriction-  ghc-options:  -W+  extensions: RebindableSyntax, NoMonomorphismRestriction+  ghc-options: -W+ source-repository head   type: git   location: git://github.com/lih/SimpleGL.git

@@ -16,7 +16,7 @@   Widget(..),Transform(..),   Shape(..),ShapeProp(..),   Vertex(..),VertexProp(..),-  clearScreen,drawScene,GLFW.swapBuffers,+  drawScene,      -- ** Basic types   Coord,@@ -102,17 +102,22 @@   ev <- sink (relative<$>Reactive (Size 1 1) _size<|*>_mousePos) _button   -- GLFW doesn't handle multithreading nicely, so we have to   -- manually interleave polling events and rendering within-  -- the main thread (and since waiting for events may block-  -- while the rendering might occur, we have to poll regularly)-  for_ (ev^.._mapping _future._event) $ \(t,x) ->-    fix $ \polling -> do-      c <- GLFW.pollEvents >> currentTime -      if t <= pure (c+milli 10) then x else waitTill (c+milli 10) >> polling+  -- the main thread. And since waiting for events may block+  -- while the rendering might occur, we have to poll regularly.+  -- I chose a 10ms polling period because it was both reactive+  -- enough for keyboard and mouse events and not too heavy on+  -- the CPU. +  let period = ms 10+  for_ ((ev+(const<$>Reactive unit ev<|*>_size))^.._mapping _future._event)+    $ \(t,x) -> fix $ \poll -> do+    c <- GLFW.pollEvents >> currentTime +    if t <= pure (c+period) then when (t > pure (c-period)) x+      else waitTill (c+period) >> poll    GLFW.closeWindow   GLFW.terminate -milli = (/1000)+ms = (/1000)  clearScreen = GL.clear [GL.ColorBuffer,GL.DepthBuffer] @@ -159,7 +164,7 @@   ma <* (matrix Nothing $= (old :: GL.GLmatrix Coord))  drawScene :: Scene Coord -> IO ()-drawScene = traverse_ draw+drawScene = between clearScreen GLFW.swapBuffers . traverse_ draw  instance Functor Vector3 where   map f (Vector3 x y z) = Vector3 (f x) (f y) (f z)

@@ -7,11 +7,11 @@ import SimpleH import Codec.Picture import qualified Graphics.Rendering.OpenGL as GL-import Data.Vector.Storable (Vector,unsafeWith)+import Data.Vector.Storable (unsafeWith) import SimpleH.GL.Base-import Data.Word -data Texture = Texture GL.TextureObject (Vector Word8)+-- |The abstract Texture type+data Texture = Texture GL.TextureObject              deriving Show  data TextureFormat = RGB | RGBA | Greyscale | GreyscaleA@@ -21,8 +21,10 @@ pixelFormats Greyscale = (GL.SLuminance8,GL.Luminance) pixelFormats GreyscaleA = (GL.SLuminance8Alpha8,GL.LuminanceAlpha) +-- |Read a texture from a file. readTexture name = at' _eitherT $ (readImage name)^._eitherT                    >>= at _eitherT<$>imageTexture+-- |Try to convert a JuicyPixels image to a texture. imageTexture i = at' _eitherT $ do   ((f,f'),w,h,d) <- at _eitherT $ pure $ case i of     ImageRGB8 (Image w h d)  -> pure (pixelFormats RGB,w,h,d)@@ -38,12 +40,14 @@       . GL.PixelData f' GL.UnsignedByte     GL.textureFilter  GL.Texture2D GL.$= ((GL.Linear', Just GL.Nearest), GL.Linear')     GL.textureFunction GL.$= GL.Modulate-    -- GL.textureBinding GL.Texture2D GL.$= Nothing-    return (Texture tex d)+    return (Texture tex) +-- |Try to read a structure of files into a structure of textures. readTextures = map sequence . traverse readTexture+-- |Read a structure of files into a structure of textures, raising an error+-- if it fails. readTextures' = map2 (error<|>id) readTextures  instance Graphics Texture where-  draw (Texture t _) = GL.textureBinding GL.Texture2D GL.$= Just t+  draw (Texture t) = GL.textureBinding GL.Texture2D GL.$= Just t