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 float v_texIndex;
//uniform sampler2D u_textures[2];
uniform sampler2D u_texture;
void main()
{
//vec4 texColor = texture(u_texture, v_texCoord);
//int index = int(v_texIndex);
//color = texture(u_textures[index], v_texCoord);
color = vec4(0.0, 1.0, 0.0, 1.0);
color = texture(u_texture, v_texCoord);
//color = vec4(0.0, 1.0, 0.0, 1.0);
}

View File

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

View File

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

View File

@ -3,9 +3,6 @@ module Scenes.Test where
import Affection
import SDL (($=), get)
import qualified SDL
import qualified Graphics.Rendering.OpenGL as GL
import qualified Data.Vector.Storable as VS
@ -34,6 +31,7 @@ data GLAssets = GLAssets
, glVB :: VertexBuffer
, glIB :: IndexBuffer
, glSP :: Shader
, glTx :: Texture
}
instance Scene Test where
@ -81,6 +79,10 @@ instance Scene Test where
addBuffer (undefined :: Vertex) vertexBuffer
(_, tex) <- newTexture "res/pituicat/pituicat.png" 0
bind tex
shader <- newShader
[ ShaderSource GL.VertexShader "./res/shaders/vert.shader"
, ShaderSource GL.FragmentShader "./res/shaders/frag.shader"
@ -88,15 +90,17 @@ instance Scene Test where
bind shader
setUniform shader "u_mvp" (projection !*! view !*! model)
setUniform shader "u_texture" (0 :: GL.GLint)
unbind vertexArray
unbind vertexBuffer
unbind indexBuffer
unbind tex
unbind shader
atomically $ do
putTMVar (testGraphics level)
(GLAssets vertexArray vertexBuffer indexBuffer shader)
(GLAssets vertexArray vertexBuffer indexBuffer shader tex)
writeTVar (testLoaded level) True
void $ atomically $ do
@ -111,8 +115,9 @@ instance Scene Test where
onEvents _ _ = return ()
render level = liftIO $ do
(GLAssets va vb ib sh) <- atomically (readTMVar $ testGraphics level)
bind vb
(GLAssets va vb ib sh tx) <- atomically (readTMVar $ testGraphics level)
bind va
bind tx
R.draw va ib sh
testLevelDesc :: LevelDescriptor
@ -124,9 +129,25 @@ testLevelDesc = LevelDescriptor
(3, 3)
createQuad :: V2 GL.GLfloat -> Int -> [Vertex]
createQuad pos@(V2 x y) index =
[ newVertex (V3 x y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
, newVertex (V3 (x + 32) y 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
, newVertex (V3 (x + 32) (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
, newVertex (V3 x (y + 32) 0) (V4 0 1 0 1) (V2 0 1) (fromIntegral index)
createQuad (V2 x y) index =
[ newVertex
(V3 x y 0)
(V4 0 0 0 1)
(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 qualified SDL
import Data.Maybe (isNothing, fromJust)
import Data.Maybe (isNothing)
import Control.Monad (void, when)
import Control.Concurrent (forkIO)
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TMVar
-- internal imports
@ -33,7 +27,7 @@ instance StateMachine GameData State where
-- ctx <- liftIO $ atomically $ fromJust <$>
-- (readTVar $ gameLoadContext gd)
ad <- get -- get inner state of engine
let win = ((\(_, y, _) -> y) $ head $ drawWindows ad)
-- let win = ((\(_, y, _) -> y) $ head $ drawWindows ad)
liftIO $
loadScene scene (gameStateLoadProgress gd)
-- SDL.glMakeCurrent win (snd $ head $ glContext ad)

View File

@ -61,8 +61,8 @@ newTexture fp slot = do
-- 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)
GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)
GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)
-- put data into GPU memory
loadTexture tex dimensions data_