Add source files, commit before reverting pictures to lists

src/Picture/Preload.hs

@@ -0,0 +1,156 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE Strict #-}
+module Picture.Preload
+    where
+
+import Codec.Picture
+import Graphics.Rendering.OpenGL hiding (Point (..),translate,scale,imageHeight,imageWidth)
+import qualified Graphics.Rendering.OpenGL as GL
+
+import qualified Data.Vector.Storable as V
+
+import Control.Lens
+
+import Foreign
+
+import Shaders
+
+data PreloadData = PreloadData
+    { _charMap :: Image PixelRGBA8
+--    , _textures :: [Image PixelRGBA8]
+    , _basicShader :: Program
+    , _textShader :: Program
+    , _fadeCircleShader :: Program
+    , _basicVAO :: VertexArrayObject
+    , _textVAO  :: VertexArrayObject
+    , _posVBO :: BufferObject
+    , _colVBO :: BufferObject
+    , _texVBO :: BufferObject
+    , _ptrPosVBO :: Ptr Float
+    , _ptrColVBO :: Ptr Float
+    , _ptrTexVBO :: Ptr Float
+    }
+
+makeLenses ''PreloadData
+
+
+loadTextures :: IO [Image PixelRGBA8]
+loadTextures = do
+--    echarMap <- readImage "data/texture/smudgedDirt.png"
+    echarMap <- readImage "data/texture/charMap.png"
+    case echarMap of
+        Left err -> do 
+            putStrLn err
+            return []
+        Right charMap -> 
+            return [convertRGBA8 charMap]
+
+bufferOffset :: Integral a => a -> Ptr b
+bufferOffset = plusPtr nullPtr . fromIntegral
+
+doPreload' :: IO PreloadData
+doPreload' = do
+-- compile shader programs
+    bs <- makeBasicShader
+    ts <- makeTextureShader
+    fcs <- makeFadeShader
+
+--setup vbos
+--need to be bound before assigning the vertex attribute pointers
+    posVBO <- genObjectName
+    colVBO <- genObjectName
+    texVBO <- genObjectName
+
+-- 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
+    let texData = V.toList $ imageData tex
+        wtex = fromIntegral $ imageWidth  tex
+        htex = fromIntegral $ imageHeight tex
+    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)
+
+    let vertexSize = sizeOf (0.5 :: GLfloat)
+        firstIndex = 0
+
+-- setup VAOs: basic vao
+    basicVAO <- genObjectName
+    bindVertexArrayObject $= Just basicVAO
+
+--    let posAttrib = AttribLocation 0
+--        colAttrib = AttribLocation 1
+    bindBuffer ArrayBuffer $= Just posVBO
+    vertexAttribPointer (AttribLocation 0) $=
+        ( ToFloat
+        , VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 3) 
+                                            (bufferOffset (firstIndex * vertexSize))
+        )
+    vertexAttribArray (AttribLocation 0) $= Enabled
+
+    bindBuffer ArrayBuffer $= Just colVBO
+    vertexAttribPointer (AttribLocation 1) $=
+        ( ToFloat
+        , VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 4) 
+                                            (bufferOffset (firstIndex * vertexSize) )
+        )
+    vertexAttribArray (AttribLocation 1) $= Enabled
+
+-- setup second vao
+    textVAO <- genObjectName
+    bindVertexArrayObject $= Just textVAO
+
+    bindBuffer ArrayBuffer $= Just posVBO
+    vertexAttribPointer (AttribLocation 0) $=
+        ( ToFloat
+        , VertexArrayDescriptor 3 Float (fromIntegral $ vertexSize * 3) 
+                                            (bufferOffset (firstIndex * vertexSize))
+        )
+    vertexAttribArray (AttribLocation 0) $= Enabled
+
+    bindBuffer ArrayBuffer $= Just colVBO
+    vertexAttribPointer (AttribLocation 1) $=
+        ( ToFloat
+        , VertexArrayDescriptor 4 Float (fromIntegral $ vertexSize * 4) 
+                                            (bufferOffset (firstIndex * vertexSize) )
+        )
+    vertexAttribArray (AttribLocation 1) $= Enabled
+
+    bindBuffer ArrayBuffer $= Just texVBO
+    vertexAttribPointer (AttribLocation 2) $=
+        ( ToFloat
+        , VertexArrayDescriptor 2 Float (fromIntegral $ vertexSize * 2) 
+                                            (bufferOffset (firstIndex * vertexSize) )
+        )
+    vertexAttribArray (AttribLocation 2) $= Enabled
+
+-- allocate memory for vertex attributes
+    ptrPosVBO <- mallocArray (3*3*5000)
+    ptrColVBO <- mallocArray (3*4*5000)
+    ptrTexVBO <- mallocArray (3*2*5000)
+
+    return $ PreloadData
+        { _charMap      = convertRGBA8 cmap
+        , _basicShader  = bs
+        , _textShader   = ts
+        , _fadeCircleShader = fcs
+        , _basicVAO = basicVAO
+        , _textVAO  = textVAO
+        , _posVBO = posVBO
+        , _colVBO = colVBO
+        , _texVBO = texVBO
+        , _ptrPosVBO = ptrPosVBO
+        , _ptrColVBO = ptrColVBO
+        , _ptrTexVBO = ptrTexVBO
+        }
+
+cleanUpPreload :: PreloadData -> IO ()
+cleanUpPreload pd = do
+    free (_ptrPosVBO pd)
+    free (_ptrColVBO pd)
+    free (_ptrTexVBO pd)