justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Commit with working graphics but slow, will attempt to change text

Browse Source
This commit is contained in:
justin
2021-02-15 12:50:38 +01:00
parent 8447844bcd
commit 9747b5b876
4 changed files with 99 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Data.hs
+30 -9
View File
@@ -1,9 +1,10 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Strict #-}
--{-# LANGUAGE Strict #-}
module Picture.Data
where
import Data.Monoid
import qualified Data.DList as DL
import qualified Data.Vector as V
import Geometry.Data
import Control.Lens
@@ -11,21 +12,41 @@ import Control.Lens
type RGBA = (Float,Float,Float,Float)
type Color = (Float,Float,Float,Float)
--type VerticesContainer a = DL.DList a
--toVC = DL.fromList
--fromVC = DL.toList
type VerticesContainer a = [a]
toVC = id
fromVC = id
mapVC :: (a -> b) -> VerticesContainer a -> VerticesContainer b
mapVC = fmap
data Shape = Shape
{ _shPos :: VerticesContainer Point3
, _shCol :: VerticesContainer RGBA
}
combineShapes :: Shape -> Shape -> Shape
combineShapes sa sb = Shape
{ _shPos = _shPos sa <> _shPos sb
, _shCol = _shCol sa <> _shCol sb
}
data Picture = Scene
{ _scPosTri :: DL.DList Point3
, _scColTri :: DL.DList RGBA
, _scPosChar :: DL.DList Point3
, _scColChar :: DL.DList RGBA
, _scTexChar :: DL.DList Point2
{ _scPosTri :: VerticesContainer Point3
, _scColTri :: VerticesContainer RGBA
, _scPosChar :: VerticesContainer Point3
, _scColChar :: VerticesContainer RGBA
, _scTexChar :: VerticesContainer Point2
}
blank :: Picture
{-# INLINE blank #-}
blank = Scene DL.empty DL.empty DL.empty DL.empty DL.empty
blank = Scene mempty mempty mempty mempty mempty
combineScenes :: Picture -> Picture -> Picture
{-# SCC combineScenes #-}
--{-# INLINE combineScenes #-}
{-# INLINE combineScenes #-}
combineScenes sa sb = Scene
{ _scPosTri = _scPosTri sa <> _scPosTri sb
, _scColTri = _scColTri sa <> _scColTri sb
src/Picture/Preload.hs
+4 -4
View File
@@ -1,5 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Strict #-}
--{-# LANGUAGE Strict #-}
module Picture.Preload
where
@@ -130,9 +130,9 @@ doPreload' = do
vertexAttribArray (AttribLocation 2) $= Enabled
-- allocate memory for vertex attributes
ptrPosVBO <- mallocArray (3*3*5000)
ptrColVBO <- mallocArray (3*4*5000)
ptrTexVBO <- mallocArray (3*2*5000)
ptrPosVBO <- mallocArray (3*3*20000)
ptrColVBO <- mallocArray (3*4*20000)
ptrTexVBO <- mallocArray (3*2*20000)
return $ PreloadData
{ _charMap = convertRGBA8 cmap
src/Picture/Render.hs
+29 -36
View File
@@ -1,4 +1,4 @@
{-# LANGUAGE Strict #-}
--{-# LANGUAGE Strict #-}
module Picture.Render
where
import Control.Lens
@@ -29,63 +29,56 @@ toVec2 (x,y) = Vector2 x y
toVec3 (x,y,z) = Vector3 x y z
toVec4 (x,y,z,w) = Vector4 x y z w
flat2 (x,y) = DL.fromList [x,y]
flat3 (x,y,z) = DL.fromList [x,y,z]
flat4 (x,y,z,w) = DL.fromList [x,y,z,w]
flat2 (x,y) = toVC [x,y]
flat3 (x,y,z) = toVC [x,y,z]
flat4 (x,y,z,w) = toVC [x,y,z,w]
mapFlat :: (NFData b) => (a -> DL.DList b) -> DL.DList a -> [b]
mapFlat f = force . DL.toList . foldMap f
mapFlat :: (NFData b) => (a -> VerticesContainer b) -> VerticesContainer a -> [b]
mapFlat f = fromVC . foldMap f
--marshallVs = V.unsafeWith . V.fromList
--marshallVs = withArray
renderPicture' :: PreloadData -> Picture -> IO ()
renderPicture' pdata (Scene posTri' colTri' posChar' colChar' texChar') = do
let posTri = DL.toList posTri'
colTri = DL.toList colTri'
posChar = DL.toList posChar'
colChar = DL.toList colChar'
texChar = DL.toList texChar'
renderPicture' pdata (Scene posTri colTri posChar colChar texChar) = do
currentProgram $= Just (_basicShader pdata)
bindVertexArrayObject $= Just (_basicVAO pdata)
bindBuffer ArrayBuffer $= Just (_posVBO pdata)
let firstIndex = 0
let vertices :: [Float]
vertices = mapFlat flat3 posTri'
numVertices = length vertices
vertices = mapFlat flat3 posTri
numVertices = length posTri
vertexSize = sizeOf (head vertices)
pokeArray (_ptrPosVBO pdata) vertices
bufferData ArrayBuffer $= (fromIntegral (numVertices * vertexSize), _ptrPosVBO pdata, StreamDraw)
bufferData ArrayBuffer $= (fromIntegral (3 * numVertices * vertexSize), _ptrPosVBO pdata, StreamDraw)
-- marshallVs vertices $ \ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (numVertices * vertexSize), ptr, StreamDraw)
bindBuffer ArrayBuffer $= Just (_colVBO pdata)
let colVs = mapFlat flat4 colTri'
let colVs = mapFlat flat4 colTri
colVsize = sizeOf $ head colVs
pokeArray (_ptrColVBO pdata) colVs
bufferData ArrayBuffer $= (fromIntegral (div (4 * numVertices * colVsize) 3), _ptrColVBO pdata, StreamDraw)
bufferData ArrayBuffer $= (fromIntegral (4 * numVertices * colVsize), _ptrColVBO pdata, StreamDraw)
-- marshallVs colVs $ \ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (div (4 * numVertices * colVsize) 3), ptr, StreamDraw)
drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVertices)
-- currentProgram $= Just (_textShader pdata)
-- bindVertexArrayObject $= Just (_textVAO pdata)
-- bindBuffer ArrayBuffer $= Just (_posVBO pdata)
-- let vertices' = mapFlat flat3 posChar'
-- numVertices' = length vertices'
-- vertexSize' = sizeOf $ head vertices'
-- withArray vertices' $ \ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (numVertices' * vertexSize'), ptr, StreamDraw)
-- bindBuffer ArrayBuffer $= Just (_colVBO pdata)
-- let colVsT = mapFlat flat4 colChar'
-- colVsTsize = sizeOf $ head colVsT
-- withArrayLen colVsT $ \numV' ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (numVertices' * colVsTsize), ptr, StreamDraw)
-- bindBuffer ArrayBuffer $= Just (_texVBO pdata)
-- let texVsT = mapFlat flat2 texChar'
-- texVsTsize = sizeOf $ head texVsT
-- withArrayLen texVsT $ \numV' ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (numVertices' * texVsTsize), ptr, StreamDraw)
-- drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVertices')
currentProgram $= Just (_textShader pdata)
bindVertexArrayObject $= Just (_textVAO pdata)
bindBuffer ArrayBuffer $= Just (_posVBO pdata)
let vertices' = mapFlat flat3 posChar
numVertices' = length posChar
vertexSize' = sizeOf $ head vertices'
pokeArray (_ptrPosVBO pdata) vertices'
bufferData ArrayBuffer $= (fromIntegral (3 * numVertices' * vertexSize'), _ptrPosVBO pdata, StreamDraw)
--withArray vertices' $ \ptr -> do
-- bufferData ArrayBuffer $= (fromIntegral (3 * numVertices' * vertexSize'), ptr, StreamDraw)
bindBuffer ArrayBuffer $= Just (_colVBO pdata)
pokeArray (_ptrColVBO pdata) $ mapFlat flat4 colChar
bufferData ArrayBuffer $= (fromIntegral (4 * numVertices' * vertexSize'), _ptrColVBO pdata, StreamDraw)
bindBuffer ArrayBuffer $= Just (_texVBO pdata)
pokeArray (_ptrTexVBO pdata) $ mapFlat flat2 texChar
bufferData ArrayBuffer $= (fromIntegral (2 * numVertices' * vertexSize'), _ptrTexVBO pdata, StreamDraw)
drawArrays Triangles (fromIntegral firstIndex) (fromIntegral $ numVertices')