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

Improve ellipses

Browse Source
This commit is contained in:
jgk
2021-03-10 03:59:38 +01:00
parent cddf7d1f8f
commit cc86a701db
7 changed files with 39 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Weapons.hs
+1 -1
View File
@@ -1035,7 +1035,7 @@ moveFlame rotd w pt =
-- $ circleSolid 5
-- $ pictures $ reverse [color white $ circleSolid 4
$ pictures $ reverse
[color red $ ellipseSolid (0,-2) (0,2) 6
[color red $ ellipseSolid (-2,0) (2,0) 6
--,color white $ ellipseSolid (2,0) (-2,0) 6
--,color white $ ellipseSolid (2,0) (-2,0) 6
,color (withAlpha 0.5 white) $ circleSolid 5
src/Picture/Data.hs
+1 -1
View File
@@ -61,7 +61,7 @@ data RenderType
| RenderCirc (Point3,Point4,Float)
| RenderArc (Point3,Point4,Point4)
| RenderLine [(Point3,Point4)]
| RenderEllipse [(Point3,Point4,Float)]
| RenderEllipse [(Point3,Point4)]
data Picture
= Blank
src/Picture/Preload.hs
+1 -1
View File
@@ -152,7 +152,7 @@ preloadRender = do
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)]
ellipsevao <- setupVAO [(0,3),(1,4)]
arcvao <- setupVAO [(0,3),(1,4),(2,4)]
backgroundvao <- setupVAO [(0,4),(1,2)]
wallvao <- setupVAO [(0,4),(1,4)]
src/Picture/Render.hs
+19 -14
View File
@@ -63,7 +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 (RenderEllipse vs) = RenderEllipse $ map (first f) vs
overPos f (RenderCirc (a,b,c)) = RenderCirc (f a,b,c)
overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c)
@@ -76,8 +76,8 @@ 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 (RenderEllipse vs) = RenderEllipse $ 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)
@@ -131,8 +131,11 @@ 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)]
picToAlt x (Ellipse i (ax,ay) (bx,by) r)
| i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black)
,((ax,ay-r,0),black)
,((bx,by-r,0),black)
]
| otherwise = Ap.empty
picToAlt x (ThickArc i startA endA rad wdth)
| i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
@@ -165,8 +168,11 @@ 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)]
picToLTree mx (Ellipse i (ax,ay) (bx,by) r)
| Just i == mx || Nothing == mx = LLeaf $ RenderEllipse [((ax,ay+r,0),black)
,((ax,ay-r,0),black)
,((bx,by-r,0),black)
]
| 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))
@@ -202,7 +208,7 @@ theFold :: TwoPtrs
-> ThreePtrs
-> TwoPtrs
-> ThreePtrs
-> ThreePtrs
-> TwoPtrs
-> F.FoldM IO RenderType (Int,Int,Int,Int,Int,Int)
theFold pas pbs pcs pds pes pfs
= (,,,,,) <$> pokeTwoPtrsWith pokePoly pas
@@ -210,7 +216,7 @@ theFold pas pbs pcs pds pes pfs
<*> pokeThreePtrsWith pokeCirc pcs
<*> pokeTwoPtrsWith pokeLine pds
<*> pokeThreePtrsWith pokeArc pes
<*> pokeThreePtrsWith pokeEllipse pfs
<*> pokeTwoPtrsWith pokeEllipse pfs
type ThreePtrs = (Ptr Float,Ptr Float,Ptr Float)
type TwoPtrs = (Ptr Float,Ptr Float)
@@ -235,19 +241,18 @@ pokeArc (pa,pb,pc) n (RenderArc (p,c,s))
return $ n + 1
pokeArc _ n _ = return n
pokeEllipse:: ThreePtrs -> Int -> RenderType -> IO Int
pokeEllipse:: TwoPtrs -> 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
pokeEllipseVert :: TwoPtrs -> Int -> (Point3,Point4) -> IO Int
{-# INLINE pokeEllipseVert #-}
pokeEllipseVert (pa,pb,pc) n (p,c,s)
pokeEllipseVert (pa,pb) n (p,c)
| 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 ()
@@ -498,7 +503,7 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
(threePtrsVAO $ _circVAO pdata)
(twoPtrsVAO $ _lineVAO pdata)
(threePtrsVAO $ _arcVAO pdata)
(threePtrsVAO $ _ellipseVAO pdata)
(twoPtrsVAO $ _ellipseVAO pdata)
) $ tree
pokeEndTicks <-SDL.ticks
@@ -538,7 +543,7 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
-- draw ellipses
currentProgram $= Just (fst $ _ellipseShader pdata)
bindVertexArrayObject $= Just (_vao $ _ellipseVAO pdata)
drawArrays Lines 0 (fromIntegral $ nEllVs)
drawArrays Triangles 0 (fromIntegral $ nEllVs)
-- draw arcs
currentProgram $= Just (fst $ _arcShader pdata)
bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)