move stuff around

This commit is contained in:
nek0 2020-12-14 01:11:33 +01:00
parent e4bd5198e0
commit b176155b8a
3 changed files with 63 additions and 72 deletions

View file

@ -37,7 +37,6 @@ executable pituicat
, Scenes.Test
, Map
, StateMachine
, Texture
, Renderer
-- other-extensions:
build-depends: base >=4.13.0.0

View file

@ -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_)

View file

@ -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_)