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

Refactor arc drawing

Browse Source
This commit is contained in:
jgk
2021-06-24 13:34:11 +02:00
parent 9f1b501388
commit 45194273e5
6 changed files with 36 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Data.hs
+1 -1
View File
@@ -17,7 +17,7 @@ data RenderType
= RenderPoly [(Point3,Point4)]
| RenderBezQ [(Point3,Point4,Point4)]
| RenderText [(Point3,Point4,Point2)]
| RenderArc (Point3,Point4,Point4)
| RenderArc [(Point3,Point4,Point3)]
| RenderLine [(Point3,Point4)]
| RenderEllipse [(Point3,Point4)]
| RenderConst
src/Picture/Tree.hs
+14 -5
View File
@@ -36,8 +36,18 @@ picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse
,( (-r,-r,0), colE)
,( ( r,-r,0), black)
]
picToLTree mx (ThickArc i startA endA rad wdth)
= filtB mx i $ LLeaf $ RenderArc ((0,0,0),black,(startA,endA,rad,wdth))
picToLTree mx (ThickArc i startA endA rad wdth) = filtB mx i $ LLeaf $ RenderArc
[( (0,0,0),black,(0,0,wdth))
,((xa,ya,0),black,(1,0,wdth))
,((xb,yb,0),black,(1,1,wdth))
,( (0,0,0),black,(0,0,wdth))
,((xb,yb,0),black,(1,1,wdth))
,((xc,yc,0),black,(0,1,wdth))
]
where
(xa,ya) = rotateV startA (rad,0)
(xb,yb) = rotateV (0.5 * (startA + endA)) (rad * sqrt 2,0)
(xc,yc) = rotateV endA (rad,0)
picToLTree mx (Line i ps)
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
picToLTree mx (LineCol i vs)
@@ -78,12 +88,11 @@ 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 (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (f a,b,c)) vs
overPos f (RenderEllipse vs) = RenderEllipse $ map (first f) vs
overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c)
overPos f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (f a,b,c)) vs
overPos _ _ = undefined
overRot :: Float -> RenderType -> RenderType
{-# INLINE overRot #-}
overRot ang (RenderArc (a,b,(r,s,t,v))) = RenderArc (a,b,(r+ang,s+ang,t,v))
overRot _ ren = ren
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
@@ -93,7 +102,7 @@ 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 (RenderBezQ vs) = RenderBezQ $ map (\(a,b,c) -> (a,f b,c)) vs
overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
overCol f (RenderArc vs) = RenderArc $ map (\(a,b,c) -> (a,f b,c)) vs
overCol _ _ = undefined
stringToList :: String -> [(Point3,Point4,Point2)]