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

Refactor rendering

Browse Source
This commit is contained in:
jgk
2021-06-23 15:16:30 +02:00
parent 899c1c5f6e
commit 9f1b501388
5 changed files with 25 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture/Data.hs
+1 -1
View File
@@ -86,7 +86,7 @@ data Picture
| Line Int [Point2]
| LineCol Int [(Point2,RGBA)]
| Pictures [Picture]
| OverPic (Point3 -> Point3) (Point2 -> Point2) Float (Point4 -> Point4) Picture
| OverPic (Point3 -> Point3) Float (Point4 -> Point4) Picture
| OnLayer Int Picture
blank :: Picture
src/Picture/Tree.hs
+17 -25
View File
@@ -23,18 +23,19 @@ picToLTree mx (Polygon i ps)
= filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
picToLTree mx (PolygonCol i vs)
= filtB mx i $ LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
where (ps,cs) = unzip vs
where
(ps,cs) = unzip vs
picToLTree mx (Poly3D i vs) = filtB mx i $ LLeaf $ RenderPoly $ polyToTris vs
picToLTree mx (BezierQuad i vs)
= filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
where (ps,cols,offps,rads) = unzip4 vs
rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
picToLTree mx (BezierQuad i vs) = filtB mx i $ LLeaf $ RenderBezQ $ zip3 (map zeroZ ps) cols rs
where
(ps,cols,offps,rads) = unzip4 vs
rs = zipWith (\(x,y) (z,w) -> (x,y,z,w)) offps rads
picToLTree mx (Circle i colC colE r)
= filtB mx i $ LLeaf $ RenderEllipse [( (-r, r,0), colC)
,( (-r,-r,0), colE)
,( ( r,-r,0), black)
]
picToLTree mx (Circle i colC colE r) = filtB mx i $ LLeaf $ RenderEllipse
[( (-r, r,0), colC)
,( (-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 (Line i ps)
@@ -46,12 +47,12 @@ picToLTree mx (Text i s)
= filtB mx i $ LLeaf $ RenderText $ stringToList s
picToLTree _ Blank = LBranches []
picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic))
= picToLTree j $ OverPic (f . g) (f' . g') (r + s) (f'' . g'') pic
picToLTree j (OverPic f f' r f'' (Pictures ps))
= LBranches (map (picToLTree j . OverPic f f' r f'') ps)
picToLTree j (OverPic f f' r f'' pic)
= overPos f . overSca f' . overRot r . overCol f'' <$> picToLTree j pic
picToLTree j (OverPic f r f'' (OverPic g s g'' pic))
= picToLTree j $ OverPic (f . g) (r + s) (f'' . g'') pic
picToLTree j (OverPic f r f'' (Pictures ps))
= LBranches (map (picToLTree j . OverPic f r f'') ps)
picToLTree j (OverPic f r f'' pic)
= overPos f . overRot r . overCol f'' <$> picToLTree j pic
picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
| otherwise = LBranches []
picToLTree Nothing (OnLayer _ pic) = picToLTree Nothing pic
@@ -70,10 +71,6 @@ white, black :: Color
white = (1,1,1,1)
black = (0,0,0,1)
scaleT :: (Float,Float) -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
{-# INLINE scaleT #-}
scaleT (x,y) (a,b,(o,s)) = (a,b,(o,s))
overPos :: (Point3 -> Point3) -> RenderType -> RenderType
{-# INLINE overPos #-}
overPos f (RenderPoly vs) = RenderPoly $ map (first f) vs
@@ -99,11 +96,6 @@ 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 _ _ = undefined
overSca :: (Point2 -> Point2) -> RenderType -> RenderType
{-# INLINE overSca #-}
overSca f (RenderText vs) = RenderText $ map (scaleT (f (1,1))) vs
overSca _ p = p
stringToList :: String -> [(Point3,Point4,Point2)]
{-# INLINE stringToList #-}
stringToList s = concat $ zipWith (\x -> map (f x))