working on textures
This commit is contained in:
parent
31a58280ae
commit
ff77587042
|
@ -21,11 +21,16 @@ executable pituicat
|
||||||
, Types.Application
|
, Types.Application
|
||||||
, Types.Subsystems
|
, Types.Subsystems
|
||||||
, Types.GameMap
|
, Types.GameMap
|
||||||
|
, Types.Texture
|
||||||
|
, Classes
|
||||||
|
, Classes.Bindable
|
||||||
, Map
|
, Map
|
||||||
|
, Texture
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: base ^>=4.13.0.0
|
build-depends: base ^>=4.13.0.0
|
||||||
, affection
|
, affection
|
||||||
, stm
|
, stm
|
||||||
|
, OpenGL
|
||||||
, sdl2
|
, sdl2
|
||||||
, containers
|
, containers
|
||||||
, linear
|
, linear
|
||||||
|
@ -33,5 +38,6 @@ executable pituicat
|
||||||
, aeson
|
, aeson
|
||||||
, vector
|
, vector
|
||||||
, JuicyPixels
|
, JuicyPixels
|
||||||
|
, JuicyPixels-extra
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -24,8 +24,8 @@ let
|
||||||
license = stdenv.lib.licenses.lgpl3;
|
license = stdenv.lib.licenses.lgpl3;
|
||||||
}) {};
|
}) {};
|
||||||
|
|
||||||
f = { mkDerivation, aeson, base, containers, JuicyPixels, linear, stdenv
|
f = { mkDerivation, aeson, base, containers, JuicyPixels, JuicyPixels-extra
|
||||||
, sdl2, stm, text, vector}:
|
, linear, OpenGL, stdenv , sdl2, stm, text, vector}:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
pname = "pituicat";
|
pname = "pituicat";
|
||||||
version = "0.0.0.0";
|
version = "0.0.0.0";
|
||||||
|
@ -33,7 +33,7 @@ let
|
||||||
isLibrary = false;
|
isLibrary = false;
|
||||||
isExecutable = true;
|
isExecutable = true;
|
||||||
executableHaskellDepends = [ aeson affection base linear containers
|
executableHaskellDepends = [ aeson affection base linear containers
|
||||||
JuicyPixels sdl2 stm text vector];
|
JuicyPixels JuicyPixels-extra OpenGL sdl2 stm text vector];
|
||||||
license = stdenv.lib.licenses.gpl3;
|
license = stdenv.lib.licenses.gpl3;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,5 @@
|
||||||
|
module Classes
|
||||||
|
( module C
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Classes.Bindable as C
|
|
@ -0,0 +1,10 @@
|
||||||
|
module Classes.Bindable where
|
||||||
|
|
||||||
|
-- | typeclass for bindable objects like buffers, vertex arrays or shaders
|
||||||
|
class Bindable a where
|
||||||
|
|
||||||
|
-- bind the object in context
|
||||||
|
bind :: a -> IO ()
|
||||||
|
|
||||||
|
-- release object from context
|
||||||
|
unbind :: a -> IO ()
|
|
@ -10,6 +10,7 @@ import qualified Data.Vector as V
|
||||||
-- internal imports
|
-- internal imports
|
||||||
|
|
||||||
import Types
|
import Types
|
||||||
|
import Texture
|
||||||
|
|
||||||
testLevelDesc :: LevelDescriptor
|
testLevelDesc :: LevelDescriptor
|
||||||
testLevelDesc = LevelDescriptor
|
testLevelDesc = LevelDescriptor
|
||||||
|
|
|
@ -0,0 +1,71 @@
|
||||||
|
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.Bindable
|
||||||
|
import Types.Texture
|
||||||
|
|
||||||
|
newTexture :: FilePath -> GL.GLuint -> IO 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 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_)
|
|
@ -5,3 +5,4 @@ module Types
|
||||||
import Types.Application as T
|
import Types.Application as T
|
||||||
import Types.Subsystems as T
|
import Types.Subsystems as T
|
||||||
import Types.GameMap as T
|
import Types.GameMap as T
|
||||||
|
import Types.Texture as T
|
||||||
|
|
|
@ -4,6 +4,10 @@ import Data.Vector
|
||||||
|
|
||||||
import Linear
|
import Linear
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Types.Texture
|
||||||
|
|
||||||
data LevelMap = LevelMap
|
data LevelMap = LevelMap
|
||||||
{ mapLayers :: Vector MapLayer -- | Layer stack
|
{ mapLayers :: Vector MapLayer -- | Layer stack
|
||||||
, mapWalkLayer :: Word -- | Collision layer index in stack
|
, mapWalkLayer :: Word -- | Collision layer index in stack
|
||||||
|
@ -32,8 +36,7 @@ data TileType
|
||||||
|
|
||||||
data TileMap = TileMap
|
data TileMap = TileMap
|
||||||
{ tileMapDimensions :: V2 Word -- | Dimensions of tile map image in pixels
|
{ tileMapDimensions :: V2 Word -- | Dimensions of tile map image in pixels
|
||||||
, tileMapPath :: FilePath -- | Filepath to image
|
, tileMapTecture :: Texture -- | Texture object on GPU
|
||||||
, tileMapIndex :: Word -- | Index on GPU
|
|
||||||
}
|
}
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,23 @@
|
||||||
|
module Types.Texture where
|
||||||
|
|
||||||
|
import SDL (($=), get)
|
||||||
|
|
||||||
|
import qualified Graphics.Rendering.OpenGL as GL
|
||||||
|
|
||||||
|
-- internal imports
|
||||||
|
|
||||||
|
import Classes.Bindable
|
||||||
|
|
||||||
|
data Texture = Texture
|
||||||
|
{ textureId :: GL.TextureObject
|
||||||
|
, textureSlot :: GL.TextureUnit
|
||||||
|
}
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance Bindable Texture where
|
||||||
|
|
||||||
|
bind t = do
|
||||||
|
GL.activeTexture $= textureSlot t
|
||||||
|
GL.textureBinding GL.Texture2D $= Just (textureId t)
|
||||||
|
|
||||||
|
unbind t = GL.textureBinding GL.Texture2D $= Nothing
|
Loading…
Reference in New Issue