From b176155b8a6554b815c58881657b5acbbac7585a Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 14 Dec 2020 01:11:33 +0100 Subject: [PATCH] move stuff around --- pituicat.cabal | 1 - src/Texture.hs | 71 -------------------------------------------- src/Types/Texture.hs | 63 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 63 insertions(+), 72 deletions(-) delete mode 100644 src/Texture.hs diff --git a/pituicat.cabal b/pituicat.cabal index c5a35f1..665f029 100644 --- a/pituicat.cabal +++ b/pituicat.cabal @@ -37,7 +37,6 @@ executable pituicat , Scenes.Test , Map , StateMachine - , Texture , Renderer -- other-extensions: build-depends: base >=4.13.0.0 diff --git a/src/Texture.hs b/src/Texture.hs deleted file mode 100644 index 052ab4c..0000000 --- a/src/Texture.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Texture where - -import Data.Vector.Storable as VS - -import qualified Graphics.Rendering.OpenGL as GL - -import SDL (($=), get) - -import Codec.Picture -import Codec.Picture.Extra - -import Linear - -import Foreign -import Foreign.Ptr - --- internal imports - -import Classes.Graphics.Bindable -import Types.Texture - -newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture) -newTexture fp slot = do - - -- read in image from filesystem - img <- flipVertically <$> convertRGBA8 <$> - either (error $ "reading image file " <> fp <> " failed!") id <$> - readImage fp - - -- extract the raw pointer from vector - unsafeWith (imageData img) $ \ptr -> do - -- create texture object - tex <- Texture - <$> GL.genObjectName - <*> (pure $ GL.TextureUnit slot) - -- <*> (pure fp) - let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img) - -- <*> (pure $ componentCount (VS.head $ imageData img)) - data_ = castPtr ptr - - -- bind texture - bind tex - - -- set texture parameters - GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') - GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp) - GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) - - -- put data into GPU memory - loadTexture tex dimensions data_ - - -- unbind texture - unbind tex - - -- -- throw away the data on the CPU side - -- free (texData tex) - - -- pass texture object out - return (fmap fromIntegral dimensions, tex) - -loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO () -loadTexture tex dimensions data_ = - let (V2 w h) = dimensions - in GL.texImage2D - GL.Texture2D - GL.NoProxy - 0 - GL.RGBA' - (GL.TextureSize2D w h) - 0 - (GL.PixelData GL.RGBA GL.UnsignedByte data_) diff --git a/src/Types/Texture.hs b/src/Types/Texture.hs index e819acc..65ffe6a 100644 --- a/src/Types/Texture.hs +++ b/src/Types/Texture.hs @@ -4,6 +4,18 @@ import SDL (($=), get) import qualified Graphics.Rendering.OpenGL as GL +import SDL (($=), get) + +import Codec.Picture +import Codec.Picture.Extra + +import Data.Vector.Storable (unsafeWith) + +import Linear + +import Foreign +import Foreign.Ptr + -- internal imports import Classes.Graphics.Bindable @@ -21,3 +33,54 @@ instance Bindable Texture where GL.textureBinding GL.Texture2D $= Just (textureId t) unbind t = GL.textureBinding GL.Texture2D $= Nothing + +newTexture :: FilePath -> GL.GLuint -> IO (V2 Word, Texture) +newTexture fp slot = do + + -- read in image from filesystem + img <- flipVertically <$> convertRGBA8 <$> + either + (\err -> error $ "reading image file " <> fp <> " failed: " <> err) + id + <$> + readImage fp + + -- extract the raw pointer from vector + unsafeWith (imageData img) $ \ptr -> do + -- create texture object + tex <- Texture + <$> GL.genObjectName + <*> (pure $ GL.TextureUnit slot) + -- <*> (pure fp) + let dimensions = fromIntegral <$> V2 (imageWidth img) (imageHeight img) + -- <*> (pure $ componentCount (VS.head $ imageData img)) + data_ = castPtr ptr + + -- bind texture + bind tex + + -- set texture parameters + GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') + GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp) + GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) + + -- put data into GPU memory + loadTexture tex dimensions data_ + + -- unbind texture + unbind tex + + -- pass texture object out + return (fmap fromIntegral dimensions, tex) + +loadTexture :: Texture -> V2 GL.GLsizei -> Ptr () -> IO () +loadTexture tex dimensions data_ = + let (V2 w h) = dimensions + in GL.texImage2D + GL.Texture2D + GL.NoProxy + 0 + GL.RGBA' + (GL.TextureSize2D w h) + 0 + (GL.PixelData GL.RGBA GL.UnsignedByte data_)