Implement background texture

app/Main.hs

@@ -51,7 +51,9 @@ main = do
         (initializeWorld $ generateFromTree lev1 $ initWorld)
         (-- \((bs:fs:ts:_),tes) w -> --do render setparams w egFade
          \preData w -> --do render setparams w egFade
-                      renderPicture' preData (_cameraZoom w) (_windowX w,_windowY w) (draw blank w)
+                      renderPicture' preData (_cameraRot w) (_cameraZoom w) 
+                                             (_cameraPos w)
+                                             (_windowX w,_windowY w) (draw blank w)
                       --renderPicture' preData (_windowX w,_windowY w) (Circle 5)
 --            renderPicture' preData 
 --                          (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)]

shader/background.geom

@@ -5,22 +5,32 @@ in vec4 vParams [];
 in vec2 vWinSize [];
 out vec2 gTexPos;
 
+vec2 rotBy( float rot, vec2 v)
+{
+  return vec2 ( v.x * cos(rot) - v.y * sin(rot)
+              , v.x * sin(rot) + v.y * cos(rot)
+              );
+        
+}
+
 void main()
 {
   vec2 cPos = vec2(vParams[0].x / 250 , vParams[0].y /250 );
   float zoom = vParams[0].w;
-  float xoff = vWinSize[0].x / (500*zoom) ;
+  float rot  = 0 - vParams[0].z;
-  float yoff = vWinSize[0].y / (500*zoom) ;
+      
-  gTexPos = vec2 (cPos.x + xoff,cPos.y + yoff);
+  float x = vWinSize[0].x / (500*zoom) ;
+  float y = vWinSize[0].y / (500*zoom) ;
+  gTexPos = cPos + rotBy(-rot , vec2(x,y));
   gl_Position = vec4 (1,1,0.9,1);
   EmitVertex();
-  gTexPos = vec2 (cPos.x + xoff,cPos.y - yoff);
+  gTexPos = cPos + rotBy(-rot , vec2(x,-y));
   gl_Position = vec4 (1,-1,0.9,1);
   EmitVertex();
-  gTexPos = vec2 (cPos.x - xoff,cPos.y + yoff);
+  gTexPos = cPos + rotBy(-rot , vec2(-x,y));
   gl_Position = vec4 (-1,1,0.9,1);
   EmitVertex();
-  gTexPos = vec2 (cPos.x - xoff,cPos.y - yoff);
+  gTexPos = cPos + rotBy(-rot , vec2(-x,-y));
   gl_Position = vec4 (-1,-1,0.9,1);
   EmitVertex();
 

src/Picture/Preload.hs

@@ -17,18 +17,20 @@ import Foreign
 import Shaders
 
 data PreloadData = PreloadData
-    { _charMap :: Image PixelRGBA8
+    { --_charMap :: Image PixelRGBA8
---    , _textures :: [Image PixelRGBA8]
+      _textures :: [TextureObject]
     , _basicShader :: Program
     , _textShader :: Program
     , _circShader :: Program
     , _arcShader  :: Program
     , _fadeCircleShader :: Program
+    , _backShader :: Program
     , _triVAO :: VAO
     , _lineVAO :: VAO
     , _textVAO :: VAO
     , _circVAO :: VAO
     , _arcVAO  :: VAO
+    , _backVAO :: VAO
     , _posVBO :: BufferObject
     , _colVBO :: BufferObject
     , _texVBO :: BufferObject
@@ -36,6 +38,8 @@ data PreloadData = PreloadData
     , _csZoomUni :: UniformLocation
     , _asWinUni :: UniformLocation
     , _asZoomUni :: UniformLocation
+    , _dummyVBO :: BufferObject
+    , _dummyPtr :: Ptr Float
     }
 data VAO = VAO
     { _vao :: VertexArrayObject
@@ -47,24 +51,8 @@ makeLenses ''VAO
 
 floatSize = sizeOf (0.5 :: GLfloat)
 
-setupVAO :: [(BufferObject,GLuint,Int)] -> IO VertexArrayObject
+setupVAO :: [(BufferObject,GLuint,Int)] -> IO VAO
 setupVAO ps = do
-    theVAO <- genObjectName
-    bindVertexArrayObject $= Just theVAO
-    forM_ ps $ \(vbo,aloc,i) -> do
-        bindBuffer ArrayBuffer $= Just vbo
-        vertexAttribPointer (AttribLocation aloc) $=
-            ( ToFloat
-            , VertexArrayDescriptor (fromIntegral i) 
-                                    Float 
-                                    (fromIntegral $ floatSize * i) 
-                                    (bufferOffset 0)
-            )
-        vertexAttribArray (AttribLocation aloc) $= Enabled
-    return theVAO
-
-setupVAO' :: [(BufferObject,GLuint,Int)] -> IO VAO
-setupVAO' ps = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
     forM_ ps setupArrayBuffer
@@ -114,6 +102,7 @@ doPreload' = do
     cs <- makeCircleShader
     as <- makeArcShader
     fcs <- makeFadeShader
+    bgs <- makeBackgroundShader
 
     winSizeUni <- GL.uniformLocation cs "winSize"
     zoomUni    <- GL.uniformLocation cs "zoom"
@@ -127,12 +116,19 @@ doPreload' = do
     colVBO <- genObjectName
     texVBO <- genObjectName
 
+--the following vbo is set up to contain one fixed vertex
+    dummyvbo <- genObjectName
+    dummyptr <- malloc
+    poke dummyptr 0
+    bindBuffer ArrayBuffer$= Just dummyvbo
+    bufferData ArrayBuffer$= (fromIntegral floatSize, dummyptr, StaticDraw)
+
 -- load charmap as texture
 --    Right cmap <- readImage "data/texture/smudgedDirt.png"
     Right cmap <- readImage "data/texture/charMap.png"
     let tex = convertRGBA8 cmap
-    texo <- genObjectName
+    chartex <- genObjectName
-    textureBinding Texture2D $= Just texo
+    textureBinding Texture2D $= Just chartex
     let texData = V.toList $ imageData tex
         wtex = fromIntegral $ imageWidth  tex
         htex = fromIntegral $ imageHeight tex
@@ -142,27 +138,48 @@ doPreload' = do
     generateMipmap' Texture2D
     textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
 
-    trivao  <- setupVAO' [(posVBO,0,3),(colVBO,1,4)]
+    Right cmap' <- readImage "data/texture/smudgedDirt.png"
-    linevao  <- setupVAO' [(posVBO,0,3),(colVBO,1,4)]
+    let dirt = convertRGBA8 cmap'
-    textvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
+    dirttex <- genObjectName
-    circvao <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
+    textureBinding Texture2D $= Just dirttex
-    arcvao  <- setupVAO' [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
+    let texData' = V.toList $ imageData dirt
+        wtex' = fromIntegral $ imageWidth  dirt
+        htex' = fromIntegral $ imageHeight dirt
+    withArray texData' $ \ptr -> do
+        texImage2D Texture2D NoProxy 0 RGBA8 (TextureSize2D wtex' htex') 0 
+                        (PixelData RGBA UnsignedByte ptr)
+    generateMipmap' Texture2D
+    textureFilter Texture2D $= ((Linear',Just Linear') , Nearest)
+
+    --textureBinding Texture2D $= Just chartex
+
+    trivao  <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
+    linevao <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
+    textvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
+    circvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
+    arcvao  <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
+    backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
     
     return $ PreloadData
-        { _charMap      = convertRGBA8 cmap
+        { -- _charMap      = convertRGBA8 cmap
+         _textures = [chartex,dirttex]
         ,_basicShader  = bs
         , _textShader   = ts
         , _circShader = cs
         , _arcShader = as
         , _fadeCircleShader = fcs
+        , _backShader = bgs
         , _triVAO  = trivao
         , _textVAO = textvao
         , _circVAO = circvao
         , _arcVAO  = arcvao
         , _lineVAO = linevao
+        , _backVAO = backgroundvao
         , _posVBO = posVBO
         , _colVBO = colVBO
         , _texVBO = texVBO
+        , _dummyVBO = dummyvbo
+        , _dummyPtr = dummyptr
         , _uniWinSize = winSizeUni
         , _csZoomUni  = zoomUni
         , _asWinUni = asWinSizeUniLoc
@@ -179,3 +196,4 @@ cleanUpPreload pd = do
     mapM_ free $ vaoPointers $ _circVAO pd
     mapM_ free $ vaoPointers $ _arcVAO  pd
     mapM_ free $ vaoPointers $ _lineVAO pd
+    free $ _dummyPtr pd

src/Picture/Render.hs

@@ -247,8 +247,8 @@ threePtrsVAO :: VAO -> (Ptr Float, Ptr Float,Ptr Float)
 threePtrsVAO vao = case (\(_,ps,_) -> ps) $ unzip3 $ _vaoBufferTargets vao of
     (a:b:c:_) -> (a,b,c)
 
-renderPicture' :: PreloadData -> Float -> (Float,Float) -> Picture -> IO ()
+renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO ()
-renderPicture' pdata zoom (winx,winy) pic = do
+renderPicture' pdata rot zoom (tranx,trany) (winx,winy) pic = do
     let firstIndex = 0
 
     (nTriVs,nTextVs,numCircVs,nLineVs,nArcVs) 
@@ -261,6 +261,18 @@ renderPicture' pdata zoom (winx,winy) pic = do
                    ) $ picToFTree pic
 
     depthFunc $= Just Less
+    
+    currentProgram $= Just (_backShader pdata)
+    bindVertexArrayObject $= Just (_vao $ _backVAO pdata)
+    let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _backVAO pdata
+        backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
+    pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
+    pokeTwoOff backPtr2 0  (winx,winy)
+    bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
+    textureBinding Texture2D $= Just (_textures pdata !! 1)
+    drawArrays Points (fromIntegral 0) (fromIntegral 1)
+    
+
 -- draw triangles
     currentProgram $= Just (_basicShader pdata)
     bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
@@ -289,6 +301,7 @@ renderPicture' pdata zoom (winx,winy) pic = do
     currentProgram $= Just (_textShader pdata)
     bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
     bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
+    textureBinding Texture2D $= Just (_textures pdata !! 0)
     drawArrays Points (fromIntegral firstIndex) (fromIntegral $ nTextVs)
 
 bufferOffset :: Integral a => a -> Ptr b

src/Shaders.hs

@@ -8,6 +8,7 @@ module Shaders
     ,makeFadeShader
     ,makeCircleShader
     ,makeArcShader
+    ,makeBackgroundShader
     )
     where
 import Graphics.Rendering.OpenGL
@@ -64,6 +65,16 @@ makeFadeShader = do
     gsSource <- BS.readFile "shader/fadeCircle.geom"
     fsSource <- BS.readFile "shader/fadeCircle.frag"
 
+    makeShaderProgram [(VertexShader,   vsSource )
+                      ,(GeometryShader, gsSource )
+                      ,(FragmentShader, fsSource )
+                      ]
+makeBackgroundShader :: IO Program
+makeBackgroundShader = do
+    vsSource <- BS.readFile "shader/background.vert"
+    gsSource <- BS.readFile "shader/background.geom"
+    fsSource <- BS.readFile "shader/background.frag"
+
     makeShaderProgram [(VertexShader,   vsSource )
                       ,(GeometryShader, gsSource )
                       ,(FragmentShader, fsSource )