get a texture to show up correctly

res/shaders/frag.shader

@@ -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);
 }

src/Main.hs

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

src/Map.hs

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

src/Scenes/Test.hs

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

src/StateMachine.hs

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

src/Types/Texture.hs

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