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

Refactor poking tuples

Browse Source
This commit is contained in:
jgk
2021-02-19 19:19:08 +01:00
parent defc8da088
commit 2866535b52
4 changed files with 58 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shader/arc.frag
+1 -2
View File
@@ -2,11 +2,10 @@
in vec4 gColor;
in vec2 cenPosT;
in float gRad;
in float gWdth;
out vec4 fColor;
out float gl_FragDepth;
uniform vec2 winSize;
void main()
{
vec2 pos = gl_FragCoord.xy;
shader/arc.geom
+4 -2
View File
@@ -2,9 +2,10 @@
layout (points) in;
layout (triangle_strip, max_vertices = 4) out;
in vec4 vColor [];
in float vRad [];
in vec4 vparams [];
out vec4 gColor;
out float gRad;
out float gWdth;
out vec2 cenPosT;
uniform vec2 winSize;
@@ -15,7 +16,8 @@ void main()
vec3 cenPos = gl_in[0].gl_Position.xyz;
//cenPos = vec3 (0.5,0,0);
gColor = vColor[0];
gRad = vRad[0] * zoom * 2;
gRad = vparams[0].x * zoom * 2;
gWdth = vparams[0].w * zoom * 2;
// gRad = 0.2;
cenPosT = vec2 ( (cenPos.x + 1) * 0.5 * winSize.x , (cenPos.y + 1) * 0.5 * winSize.y);
shader/arc.vert
+3 -3
View File
@@ -1,13 +1,13 @@
#version 430 core
layout (location = 0) in vec3 position;
layout (location = 1) in vec4 color;
layout (location = 2) in float rad;
layout (location = 2) in vec4 saEaRadWdth;
out vec4 vColor;
out float vRad;
out vec4 vparams;
void main()
{
gl_Position = vec4(position,1);
//gl_Position = vec4(0,0,0,1);
vColor = color;
vRad = rad;
vparams = saEaRadWdth;
}
src/Picture/Render.hs
+50 -38
View File
@@ -141,9 +141,41 @@ theFold :: (Ptr Float,Ptr Float)
-> (Ptr Float,Ptr Float,Ptr Float)
-> (Ptr Float,Ptr Float,Ptr Float)
-> (Ptr Float,Ptr Float)
-> F.FoldM IO RenderType (Int,Int,Int,Int)
theFold pas pbs pcs pds = (,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
-> (Ptr Float,Ptr Float,Ptr Float)
-> F.FoldM IO RenderType (Int,Int,Int,Int,Int)
theFold pas pbs pcs pds pes
= (,,,,) <$> pokeFold pas <*> pokeTextFold pbs <*> pokeCircFold pcs
<*> pokeLineFold pds
<*> pokeThreePtrsWith pokeArc pes
type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
pokeThreePtrsWith :: (ThreePtrs -> Int -> RenderType -> IO Int)
-> ThreePtrs -> F.FoldM IO RenderType Int
pokeThreePtrsWith pokeF ptrs = F.FoldM (pokeF ptrs) (return 0) return
pokeArc:: ThreePtrs -> Int -> RenderType -> IO Int
pokeArc (pa,pb,pc) n (RenderArc ((x,y,z),(r,g,b,a),(s,t,u,v)))
| n > 20000 * 2 = return n
| otherwise = return n
pokeArc _ n _ = return n
pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
pokeTwoOff ptr n (x,y) = do
pokeElemOff ptr (2*n+0) x
pokeElemOff ptr (2*n+1) y
pokeThreeOff :: Ptr Float -> Int -> (Float,Float,Float) -> IO ()
pokeThreeOff ptr n (x,y,z) = do
pokeElemOff ptr (3*n+0) x
pokeElemOff ptr (3*n+1) y
pokeElemOff ptr (3*n+2) z
pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
pokeFourOff ptr n (x,y,z,w) = do
pokeElemOff ptr (4*n+0) x
pokeElemOff ptr (4*n+1) y
pokeElemOff ptr (4*n+2) z
pokeElemOff ptr (4*n+3) w
pokeLineFold :: (Ptr Float, Ptr Float) -> F.FoldM IO RenderType Int
pokeLineFold (pa,pb) = F.FoldM
@@ -155,16 +187,11 @@ pokeLine pa pb n (RenderLine vs) = foldM (pokeLineVert pa pb) n vs
pokeLine _ _ n _ = return n
pokeLineVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
pokeLineVert pa pb n ((x,y,z),(r,g,b,a))
pokeLineVert pa pb n (p,c)
| n > 20000 * 2 = return n
| otherwise = do
pokeElemOff pa (3*n+0) x
pokeElemOff pa (3*n+1) y
pokeElemOff pa (3*n+2) z
pokeElemOff pb (4*n+0) r
pokeElemOff pb (4*n+1) g
pokeElemOff pb (4*n+2) b
pokeElemOff pb (4*n+3) a
pokeThreeOff pa n p
pokeFourOff pb n c
return (n+1)
pokeCirc :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
@@ -172,17 +199,12 @@ pokeCirc pa pb pc n (RenderCirc vs) = pokeCircVert pa pb pc n vs
pokeCirc _ _ _ n _ = return n
pokeCircVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Float) -> IO Int
pokeCircVert pa pb pc n ((x,y,z),(r,g,b,a),s)
pokeCircVert pa pb pc n (p,c,s)
| n > 20000 * 2 = return n
| otherwise = do
pokeElemOff pa (3*n+0) x
pokeElemOff pa (3*n+1) y
pokeElemOff pa (3*n+2) z
pokeElemOff pb (4*n+0) r
pokeElemOff pb (4*n+1) g
pokeElemOff pb (4*n+2) b
pokeElemOff pb (4*n+3) a
pokeElemOff pc n s
pokeThreeOff pa n p
pokeFourOff pb n c
pokeElemOff pc n s
return (n+1)
pokeText :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> RenderType -> IO Int
@@ -190,18 +212,12 @@ pokeText pa pb pc n (RenderText vs) = foldM (pokeTextVert pa pb pc) n vs
pokeText _ _ _ n _ = return n
pokeTextVert :: Ptr Float -> Ptr Float -> Ptr Float -> Int -> (Point3, Point4, Point2) -> IO Int
pokeTextVert pa pb pc n ((x,y,z),(r,g,b,a),(s,t))
pokeTextVert pa pb pc n (p,c,t)
| n > 20000 * 2 = return n
| otherwise = do
pokeElemOff pa (3*n+0) x
pokeElemOff pa (3*n+1) y
pokeElemOff pa (3*n+2) z
pokeElemOff pb (4*n+0) r
pokeElemOff pb (4*n+1) g
pokeElemOff pb (4*n+2) b
pokeElemOff pb (4*n+3) a
pokeElemOff pc (2*n+0) s
pokeElemOff pc (2*n+1) t
pokeThreeOff pa n p
pokeFourOff pb n c
pokeTwoOff pc n t
return (n+1)
pokePic :: Ptr Float -> Ptr Float -> FTree RenderType -> IO Int
@@ -213,16 +229,11 @@ pokePoly pa pb n (RenderPoly vs) = foldM (pokeVert pa pb) n vs
pokePoly _ _ n _ = return n
pokeVert :: Ptr Float -> Ptr Float -> Int -> (Point3, Point4) -> IO Int
pokeVert pa pb n ((x,y,z),(r,g,b,a))
pokeVert pa pb n (p,c)
| n > 20000 * 2 = return n
| otherwise = do
pokeElemOff pa (3*n+0) x
pokeElemOff pa (3*n+1) y
pokeElemOff pa (3*n+2) z
pokeElemOff pb (4*n+0) r
pokeElemOff pb (4*n+1) g
pokeElemOff pb (4*n+2) b
pokeElemOff pb (4*n+3) a
pokeThreeOff pa n p
pokeFourOff pb n c
return (n+1)
translate3 :: Float -> Float -> Point3 -> Point3
@@ -250,11 +261,12 @@ renderPicture' pdata zoom (winx,winy) pic = do
let firstIndex = 0
numArcVs = 0
(nTriVs,numVert',numCircVs,nLineVs)
(nTriVs,numVert',numCircVs,nLineVs,nArcVs)
<- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
(_ptrCharPos pdata, _ptrCharCol pdata, _ptrCharTex pdata)
(_ptrCircPos pdata, _ptrCircCol pdata, _ptrCircSca pdata)
(_ptrLinePos pdata, _ptrLineCol pdata)
(_ptrArcPos pdata, _ptrArcCol pdata, _ptrArcSca pdata)
) $ picToFTree pic
depthFunc $= Just Less