diff options
| author | Josh Rahm <joshuarahm@gmail.com> | 2022-12-03 17:37:59 -0700 |
|---|---|---|
| committer | Josh Rahm <joshuarahm@gmail.com> | 2022-12-03 17:37:59 -0700 |
| commit | ba59711a51b4fee34009b1fe6afdce9ef8e60ae0 (patch) | |
| tree | 7274bd2c9007abe08c8db7cea9e55babfd041125 /Graphics/Glyph/Textures.hs | |
| parent | 601f77922490888c3ae9986674e332a5192008ec (diff) | |
| download | terralloc-ba59711a51b4fee34009b1fe6afdce9ef8e60ae0.tar.gz terralloc-ba59711a51b4fee34009b1fe6afdce9ef8e60ae0.tar.bz2 terralloc-ba59711a51b4fee34009b1fe6afdce9ef8e60ae0.zip | |
Diffstat (limited to 'Graphics/Glyph/Textures.hs')
| -rw-r--r-- | Graphics/Glyph/Textures.hs | 47 |
1 files changed, 27 insertions, 20 deletions
diff --git a/Graphics/Glyph/Textures.hs b/Graphics/Glyph/Textures.hs index ec3e12f..538c87a 100644 --- a/Graphics/Glyph/Textures.hs +++ b/Graphics/Glyph/Textures.hs @@ -6,33 +6,40 @@ import Data.Word import Graphics.GL.Compatibility30 import Graphics.Rendering.OpenGL -data Pixels = - PixelsRGB (Int,Int) (StorableArray Int Word8) | - PixelsRGBA (Int,Int) (StorableArray Int Word8) +data Pixels + = PixelsRGB (Int, Int) (StorableArray Int Word8) + | PixelsRGBA (Int, Int) (StorableArray Int Word8) pixelsArray :: Pixels -> StorableArray Int Word8 -pixelsArray (PixelsRGB _ a) = a +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)) +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) +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 - - + 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 |