initial commit

1 files changed, 39 insertions, 0 deletions

diff --git a/Graphics/Glyph/Textures.hs b/Graphics/Glyph/Textures.hs
new file mode 100644
index 0000000..7e86d2a
--- /dev/null
+++ b/Graphics/Glyph/Textures.hs
@@ -0,0 +1,39 @@
+module Graphics.Glyph.Textures where
+
+import Data.Array.Storable
+import Data.Word
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Graphics.Rendering.OpenGL
+import Control.Monad
+
+data Pixels =
+    PixelsRGB  (Int,Int) (StorableArray Int Word8) |
+    PixelsRGBA (Int,Int) (StorableArray Int Word8)
+
+pixelsArray :: Pixels -> StorableArray Int Word8
+pixelsArray (PixelsRGB  _ a) = a
+pixelsArray (PixelsRGBA _ a) = a
+-- construct a new 2d array of pixels
+makePixelsRGB :: (Int, Int) -> IO Pixels
+makePixelsRGB a@(w,h) = liftM (PixelsRGB a) (newArray_ (0,w*h-1))
+
+-- convert a list of rgb values to an array
+newPixelsFromListRGB :: (Int, Int) -> [(Word8,Word8,Word8)] -> IO Pixels
+newPixelsFromListRGB a@(w,h) lst = liftM (PixelsRGB a) $ (newListArray (0,w*h*3) .
+                                                    concatMap (\(x,y,z)->[x,y,z])) lst
+
+newPixelsFromListRGBA :: (Int, Int) -> [(Word8,Word8,Word8,Word8)] -> IO Pixels
+newPixelsFromListRGBA a@(w,h) lst = liftM (PixelsRGBA a) $ newListArray (0,w*h*4)
+                                                    (concatMap (\(x,y,z,q)->[x,y,z,q]) lst)
+
+attachPixelsToTexture :: Pixels -> TextureObject -> IO ()
+attachPixelsToTexture pixels tex =
+    withStorableArray (pixelsArray pixels) $ \ptr -> do
+        textureBinding Texture2D $= Just tex
+        case pixels of
+            PixelsRGB  (w,h) _ -> glTexImage2D gl_TEXTURE_2D 0 3 (f w) (f h) 0 gl_RGB gl_UNSIGNED_BYTE ptr
+            PixelsRGBA (w,h) _ -> glTexImage2D gl_TEXTURE_2D 0 4 (f w) (f h) 0 gl_RGBA gl_UNSIGNED_BYTE ptr
+        where f = fromIntegral
+
+