get a texture to show up correctly

This commit is contained in:
nek0 2020-12-14 03:12:33 +01:00
parent 6523f13cac
commit efbbc49b54
6 changed files with 41 additions and 32 deletions

View File

@ -6,12 +6,12 @@ in vec4 v_color;
in vec2 v_texCoord; in vec2 v_texCoord;
in float v_texIndex; in float v_texIndex;
//uniform sampler2D u_textures[2]; uniform sampler2D u_texture;
void main() void main()
{ {
//vec4 texColor = texture(u_texture, v_texCoord); //vec4 texColor = texture(u_texture, v_texCoord);
//int index = int(v_texIndex); //int index = int(v_texIndex);
//color = texture(u_textures[index], v_texCoord); color = texture(u_texture, v_texCoord);
color = vec4(0.0, 1.0, 0.0, 1.0); //color = vec4(0.0, 1.0, 0.0, 1.0);
} }

View File

@ -3,11 +3,8 @@ module Main where
import Affection import Affection
import qualified Data.Text as T
import SDL (($=), get) import SDL (($=), get)
import qualified SDL import qualified SDL
import qualified SDL.Internal.Numbered as SDL
import qualified SDL.Raw.Video as SDL (glSetAttribute) import qualified SDL.Raw.Video as SDL (glSetAttribute)
import qualified SDL.Raw.Enum as SDL import qualified SDL.Raw.Enum as SDL
@ -21,13 +18,11 @@ import qualified Data.Map.Strict as M
import Data.String (fromString) import Data.String (fromString)
import Data.Maybe (isJust)
import Linear import Linear
-- internal imports -- internal imports
import StateMachine import StateMachine()
import Types import Types
import Classes import Classes
import Scenes.Test import Scenes.Test
@ -93,7 +88,7 @@ draw :: GameData -> Affection ()
draw gd = do draw gd = do
state <- liftIO (atomically $ readTVar $ gameState gd) state <- liftIO (atomically $ readTVar $ gameState gd)
liftIO $ logIO Verbose (fromString $ "now drawing: " <> show state) liftIO $ logIO Verbose (fromString $ "now drawing: " <> show state)
GL.clearColor $= GL.Color4 0 0 1 1 GL.clearColor $= GL.Color4 0 0 0 1
smDraw state gd smDraw state gd
err <- SDL.get GL.errors err <- SDL.get GL.errors
when (not $ null err) (liftIO $ logIO Error ("loop errors: " <> fromString (show err))) when (not $ null err) (liftIO $ logIO Error ("loop errors: " <> fromString (show err)))

View File

@ -14,7 +14,6 @@ import Control.Monad (foldM)
-- internal imports -- internal imports
import Types import Types
import Texture
constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap constructMap :: LevelDescriptor -> GL.GLuint -> IO LevelMap
constructMap desc tilemapSlot = do constructMap desc tilemapSlot = do

View File

@ -3,9 +3,6 @@ module Scenes.Test where
import Affection import Affection
import SDL (($=), get)
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL import qualified Graphics.Rendering.OpenGL as GL
import qualified Data.Vector.Storable as VS import qualified Data.Vector.Storable as VS
@ -34,6 +31,7 @@ data GLAssets = GLAssets
, glVB :: VertexBuffer , glVB :: VertexBuffer
, glIB :: IndexBuffer , glIB :: IndexBuffer
, glSP :: Shader , glSP :: Shader
, glTx :: Texture
} }
instance Scene Test where instance Scene Test where
@ -81,6 +79,10 @@ instance Scene Test where
addBuffer (undefined :: Vertex) vertexBuffer addBuffer (undefined :: Vertex) vertexBuffer
(_, tex) <- newTexture "res/pituicat/pituicat.png" 0
bind tex
shader <- newShader shader <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader" [ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader" , ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
@ -88,15 +90,17 @@ instance Scene Test where
bind shader bind shader
setUniform shader "u_mvp" (projection !*! view !*! model) setUniform shader "u_mvp" (projection !*! view !*! model)
setUniform shader "u_texture" (0 :: GL.GLint)
unbind vertexArray unbind vertexArray
unbind vertexBuffer unbind vertexBuffer
unbind indexBuffer unbind indexBuffer
unbind tex
unbind shader unbind shader
atomically $ do atomically $ do
putTMVar (testGraphics level) putTMVar (testGraphics level)
(GLAssets vertexArray vertexBuffer indexBuffer shader) (GLAssets vertexArray vertexBuffer indexBuffer shader tex)
writeTVar (testLoaded level) True writeTVar (testLoaded level) True
void $ atomically $ do void $ atomically $ do
@ -111,8 +115,9 @@ instance Scene Test where
onEvents _ _ = return () onEvents _ _ = return ()
render level = liftIO $ do render level = liftIO $ do
(GLAssets va vb ib sh) <- atomically (readTMVar $ testGraphics level) (GLAssets va vb ib sh tx) <- atomically (readTMVar $ testGraphics level)
bind vb bind va
bind tx
R.draw va ib sh R.draw va ib sh
testLevelDesc :: LevelDescriptor testLevelDesc :: LevelDescriptor
@ -124,9 +129,25 @@ testLevelDesc = LevelDescriptor
(3, 3) (3, 3)
createQuad :: V2 GL.GLfloat -> Int -> [Vertex] createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
createQuad pos@(V2 x y) index = createQuad (V2 x y) index =
[ newVertex (V3 x y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) [ newVertex
, newVertex (V3 (x + 32) y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) (V3 x y 0)
, newVertex (V3 (x + 32) (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) (V4 0 0 0 1)
, newVertex (V3 x (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index) (V2 0 (1 - (50 / 1024)))
(fromIntegral index)
, newVertex
(V3 (x + 32) y 0)
(V4 0 0 0 1)
(V2 (50 / 1024) (1 - (50/1024)))
(fromIntegral index)
, newVertex
(V3 (x + 32) (y + 32) 0)
(V4 0 0 0 1)
(V2 (50 / 1024) 1)
(fromIntegral index)
, newVertex
(V3 x (y + 32) 0)
(V4 0 0 0 1)
(V2 0 1)
(fromIntegral index)
] ]

View File

@ -4,17 +4,11 @@ module StateMachine where
import Affection import Affection
import qualified SDL import Data.Maybe (isNothing)
import Data.Maybe (isNothing, fromJust)
import Control.Monad (void, when) import Control.Monad (void, when)
import Control.Concurrent (forkIO)
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TMVar
-- internal imports -- internal imports
@ -33,7 +27,7 @@ instance StateMachine GameData State where
-- ctx <- liftIO $ atomically $ fromJust <$> -- ctx <- liftIO $ atomically $ fromJust <$>
-- (readTVar $ gameLoadContext gd) -- (readTVar $ gameLoadContext gd)
ad <- get -- get inner state of engine ad <- get -- get inner state of engine
let win = ((\(_, y, _) -> y) $ head $ drawWindows ad) -- let win = ((\(_, y, _) -> y) $ head $ drawWindows ad)
liftIO $ liftIO $
loadScene scene (gameStateLoadProgress gd) loadScene scene (gameStateLoadProgress gd)
-- SDL.glMakeCurrent win (snd $ head $ glContext ad) -- SDL.glMakeCurrent win (snd $ head $ glContext ad)

View File

@ -61,8 +61,8 @@ newTexture fp slot = do
-- set texture parameters -- set texture parameters
GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear') GL.textureFilter GL.Texture2D $= ((GL.Linear', Nothing), GL.Linear')
GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp) GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp) GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)
-- put data into GPU memory -- put data into GPU memory
loadTexture tex dimensions data_ loadTexture tex dimensions data_