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

Partially working ellipse shader

Browse Source
This commit is contained in:
justin
2021-03-10 03:29:10 +01:00
parent bfbd0b6fef
commit cddf7d1f8f
12 changed files with 229 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Data.hs
+2
View File
@@ -61,6 +61,7 @@ data RenderType
| RenderCirc (Point3,Point4,Float)
| RenderArc (Point3,Point4,Point4)
| RenderLine [(Point3,Point4)]
| RenderEllipse [(Point3,Point4,Float)]
data Picture
= Blank
@@ -68,6 +69,7 @@ data Picture
| Polygon Int [Point2]
| PolygonCol Int [(Point2,RGBA)]
| Circle Int Float
| Ellipse Int Point2 Point2 Float
| ThickArc Int Float Float Float Float
| Line Int [Point2]
| LineCol Int [(Point2,RGBA)]
src/Picture/Preload.hs
+14 -10
View File
@@ -22,6 +22,7 @@ data RenderData = RenderData
, _basicShader :: (Program, [UniformLocation])
, _textShader :: (Program, [UniformLocation])
, _circShader :: (Program, [UniformLocation])
, _ellipseShader :: (Program, [UniformLocation])
, _arcShader :: (Program, [UniformLocation])
, _lightmapCircleShader :: (Program, [UniformLocation])
, _backShader :: (Program, [UniformLocation])
@@ -30,6 +31,7 @@ data RenderData = RenderData
, _lineVAO :: VAO
, _textVAO :: VAO
, _circVAO :: VAO
, _ellipseVAO :: VAO
, _arcVAO :: VAO
, _backVAO :: VAO
, _wallVAO :: VAO
@@ -103,6 +105,7 @@ preloadRender = do
fcs <- makeSourcedShader "lightmapCircle" [VertexShader,GeometryShader,FragmentShader]
bgs <- makeSourcedShader "background" [VertexShader,GeometryShader,FragmentShader]
wss <- makeSourcedShader "wallShadow" [VertexShader,GeometryShader,FragmentShader]
es <- makeSourcedShader "ellipse" [VertexShader,GeometryShader,FragmentShader]
wssLightPosUniLoc <- GL.uniformLocation (fst wss) "lightPos"
@@ -145,16 +148,15 @@ preloadRender = do
-- input a list of (attribute location, attrib length) pairs
-- these will have buffers and pointers created
trivao <- setupVAO [(0,3),(1,4)]
linevao <- setupVAO [(0,3),(1,4)]
textvao <- setupVAO [(0,3),(1,4),(2,3)]
circvao <- setupVAO [(0,3),(1,4),(2,1)]
arcvao <- setupVAO [(0,3),(1,4),(2,4)]
backgroundvao
<- setupVAO [(0,4),(1,2)]
wallvao <- setupVAO [(0,4),(1,4)]
fadecircvao
<- setupVAO [(0,4)]
trivao <- setupVAO [(0,3),(1,4)]
linevao <- setupVAO [(0,3),(1,4)]
textvao <- setupVAO [(0,3),(1,4),(2,3)]
circvao <- setupVAO [(0,3),(1,4),(2,1)]
ellipsevao <- setupVAO [(0,3),(1,4),(2,1)]
arcvao <- setupVAO [(0,3),(1,4),(2,4)]
backgroundvao <- setupVAO [(0,4),(1,2)]
wallvao <- setupVAO [(0,4),(1,4)]
fadecircvao <- setupVAO [(0,4)]
return $ RenderData
{ -- _charMap = convertRGBA8 cmap
@@ -162,6 +164,7 @@ preloadRender = do
,_basicShader = bs
, _textShader = ts
, _circShader = cs
, _ellipseShader = es
, _arcShader = as
, _lightmapCircleShader = fcs
, _backShader = bgs
@@ -169,6 +172,7 @@ preloadRender = do
, _triVAO = trivao
, _textVAO = textvao
, _circVAO = circvao
, _ellipseVAO = ellipsevao
, _arcVAO = arcvao
, _lineVAO = linevao
, _backVAO = backgroundvao
src/Picture/Render.hs
+43 -11
View File
@@ -63,6 +63,7 @@ overPos :: (Point3 -> Point3) -> RenderType -> RenderType
overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderEllipse vs) = RenderEllipse $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderCirc (a,b,c)) = RenderCirc (f a,b,c)
overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c)
@@ -73,11 +74,12 @@ overRot _ ren = ren
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
{-# INLINE overCol #-}
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderEllipse vs) = RenderEllipse $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderCirc (a,b,c)) = RenderCirc (a,f b,c)
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overSca :: (Point2 -> Point2) -> RenderType -> RenderType
{-# INLINE overSca #-}
@@ -129,6 +131,9 @@ picToAlt x (PolygonCol i vs)
picToAlt x (Circle i r)
| i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
| otherwise = Ap.empty
picToAlt x (Ellipse i pa pb r)
| i == x = Ap.pure $ RenderEllipse [(zeroZ pa,black,r),(zeroZ pb,black,r)]
| otherwise = Ap.empty
picToAlt x (ThickArc i startA endA rad wdth)
| i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
| otherwise = Ap.empty
@@ -160,6 +165,9 @@ picToLTree mx (PolygonCol i vs)
picToLTree mx (Circle i r)
| Just i == mx || Nothing == mx = LLeaf $ RenderCirc $ ((0,0,0),black,r)
| otherwise = LBranches []
picToLTree mx (Ellipse i pa pb r)
| Just i == mx || Nothing == mx = LLeaf $ RenderEllipse [(zeroZ pa,black,r),(zeroZ pb,black,r)]
| otherwise = LBranches []
picToLTree mx (ThickArc i startA endA rad wdth)
| Just i == mx || Nothing == mx = LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
| otherwise = LBranches []
@@ -194,13 +202,15 @@ theFold :: TwoPtrs
-> ThreePtrs
-> TwoPtrs
-> ThreePtrs
-> F.FoldM IO RenderType (Int,Int,Int,Int,Int)
theFold pas pbs pcs pds pes
= (,,,,) <$> pokeTwoPtrsWith pokePoly pas
-> ThreePtrs
-> F.FoldM IO RenderType (Int,Int,Int,Int,Int,Int)
theFold pas pbs pcs pds pes pfs
= (,,,,,) <$> pokeTwoPtrsWith pokePoly pas
<*> pokeThreePtrsWith pokeText pbs
<*> pokeThreePtrsWith pokeCirc pcs
<*> pokeTwoPtrsWith pokeLine pds
<*> pokeThreePtrsWith pokeArc pes
<*> pokeThreePtrsWith pokeEllipse pfs
type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
type TwoPtrs = (Ptr Float,Ptr Float)
@@ -225,6 +235,21 @@ pokeArc (pa,pb,pc) n (RenderArc (p,c,s))
return $ n + 1
pokeArc _ n _ = return n
pokeEllipse:: ThreePtrs -> Int -> RenderType -> IO Int
{-# INLINE pokeEllipse #-}
pokeEllipse ptrs n (RenderEllipse vs) = foldM (pokeEllipseVert ptrs) n vs
pokeEllipse _ n _ = return n
pokeEllipseVert :: ThreePtrs -> Int -> (Point3,Point4,Float) -> IO Int
{-# INLINE pokeEllipseVert #-}
pokeEllipseVert (pa,pb,pc) n (p,c,s)
| n > 20000 * 2 = return n
| otherwise = do
pokeThreeOff pa n p
pokeFourOff pb n c
pokeElemOff pc n s
return $ n + 1
pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
{-# INLINE pokeTwoOff #-}
pokeTwoOff ptr n (x,y) = do
@@ -364,6 +389,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
,_textShader pdata
,_circShader pdata
,_arcShader pdata
,_ellipseShader pdata
,_lightmapCircleShader pdata
,_backShader pdata
,_wallShadowShader pdata
@@ -437,6 +463,7 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
,_textShader pdata
,_circShader pdata
,_arcShader pdata
,_ellipseShader pdata
] $ \shad -> do
currentProgram $= Just (fst shad)
uniform (snd shad !! 0) $= Vector2 (2::Float) 2
@@ -464,13 +491,14 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
pokeStartTicks <- SDL.ticks
-- poke necessary data
(nTriVs,nTextVs,numCircVs,nLineVs,nArcVs)
(nTriVs,nTextVs,nCircVs,nLineVs,nArcVs,nEllVs)
-- <- F.foldM (theFold (_ptrPosVBO pdata, _ptrColVBO pdata)
<- F.foldM (theFold (twoPtrsVAO $ _triVAO pdata)
(threePtrsVAO $ _textVAO pdata)
(threePtrsVAO $ _circVAO pdata)
(twoPtrsVAO $ _lineVAO pdata)
(threePtrsVAO $ _arcVAO pdata)
(threePtrsVAO $ _ellipseVAO pdata)
) $ tree
pokeEndTicks <-SDL.ticks
@@ -480,10 +508,11 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
-- before it performs another state change
bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
bindArrayBuffers nCircVs $ _vaoBufferTargets $ _circVAO pdata
bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
bindArrayBuffers nLineVs $ _vaoBufferTargets $ _lineVAO pdata
bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
bindArrayBuffers nEllVs $ _vaoBufferTargets $ _ellipseVAO pdata
depthFunc $= Just Less
@@ -505,9 +534,12 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
-- draw circles
currentProgram $= Just (fst $ _circShader pdata)
bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
drawArrays Points 0 (fromIntegral $ numCircVs)
drawArrays Points 0 (fromIntegral $ nCircVs)
-- draw ellipses
currentProgram $= Just (fst $ _ellipseShader pdata)
bindVertexArrayObject $= Just (_vao $ _ellipseVAO pdata)
drawArrays Lines 0 (fromIntegral $ nEllVs)
-- draw arcs
-- assumes that the uniforms are set
currentProgram $= Just (fst $ _arcShader pdata)
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
drawArrays Points 0 (fromIntegral $ nArcVs)