Partially working ellipse shader
This commit is contained in:
+43
-11
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user