diff --git a/app/Main.hs b/app/Main.hs index 71226c776..65803f433 100644 --- a/app/Main.hs +++ b/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)] diff --git a/shader/.background.geom.swp b/shader/.background.geom.swp deleted file mode 100644 index a5aa6110e..000000000 Binary files a/shader/.background.geom.swp and /dev/null differ diff --git a/shader/background.geom b/shader/background.geom index 51e1fe969..b475c375d 100644 --- a/shader/background.geom +++ b/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 yoff = vWinSize[0].y / (500*zoom) ; - gTexPos = vec2 (cPos.x + xoff,cPos.y + yoff); + float rot = 0 - vParams[0].z; + + 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(); diff --git a/src/Picture/Preload.hs b/src/Picture/Preload.hs index 8a937da2f..91cc7d6c3 100644 --- a/src/Picture/Preload.hs +++ b/src/Picture/Preload.hs @@ -17,18 +17,20 @@ import Foreign import Shaders data PreloadData = PreloadData - { _charMap :: Image PixelRGBA8 --- , _textures :: [Image PixelRGBA8] + { --_charMap :: 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 - textureBinding Texture2D $= Just texo + chartex <- genObjectName + 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)] - 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)] + Right cmap' <- readImage "data/texture/smudgedDirt.png" + let dirt = convertRGBA8 cmap' + dirttex <- genObjectName + textureBinding Texture2D $= Just dirttex + 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 - , _basicShader = bs + { -- _charMap = convertRGBA8 cmap + _textures = [chartex,dirttex] + ,_basicShader = bs , _textShader = ts , _circShader = cs , _arcShader = as , _fadeCircleShader = fcs - , _triVAO = trivao - , _textVAO = textvao - , _circVAO = circvao - , _arcVAO = arcvao - , _lineVAO = linevao + , _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 diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index b1987ce2f..8423ce424 100644 --- a/src/Picture/Render.hs +++ b/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' pdata zoom (winx,winy) pic = do +renderPicture' :: PreloadData -> Float -> Float -> (Float,Float) -> (Float,Float) -> Picture -> IO () +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 diff --git a/src/Shaders.hs b/src/Shaders.hs index 79aa525cc..1cfc7d165 100644 --- a/src/Shaders.hs +++ 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 )