Allow for interpolating colors from center to edge of ellipses
This commit is contained in:
+49
-61
@@ -118,80 +118,68 @@ charToTuple :: Char -> (Point3,Point4,Point3)
|
||||
charToTuple c = ((0,0,0),white,(offset,dimText,2*dimText))
|
||||
where offset = fromIntegral (fromEnum c) - 32
|
||||
|
||||
picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
|
||||
{-# INLINE picToAlt #-}
|
||||
picToAlt x (Polygon i ps)
|
||||
| i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
| otherwise = Ap.empty
|
||||
picToAlt x (PolygonCol i vs)
|
||||
| i /= x = Ap.empty
|
||||
| otherwise =
|
||||
let (ps,cs) = unzip vs
|
||||
in Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||
picToAlt x (Circle i r)
|
||||
| i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
|
||||
| otherwise = Ap.empty
|
||||
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))
|
||||
| otherwise = Ap.empty
|
||||
picToAlt x (Line i ps)
|
||||
| i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||
| otherwise = Ap.empty
|
||||
picToAlt x (Text i s)
|
||||
| i == x = Ap.pure $ RenderText $ stringToList s
|
||||
| otherwise = Ap.empty
|
||||
picToAlt j Blank = Ap.empty
|
||||
picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
|
||||
--picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
|
||||
--{-# INLINE picToAlt #-}
|
||||
--picToAlt x (Polygon i ps)
|
||||
-- | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (PolygonCol i vs)
|
||||
-- | i /= x = Ap.empty
|
||||
-- | otherwise =
|
||||
-- let (ps,cs) = unzip vs
|
||||
-- in Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||
--picToAlt x (Circle i r)
|
||||
-- | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
|
||||
-- | otherwise = Ap.empty
|
||||
--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))
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (Line i ps)
|
||||
-- | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (Text i s)
|
||||
-- | i == x = Ap.pure $ RenderText $ stringToList s
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt j Blank = Ap.empty
|
||||
--picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
|
||||
|
||||
collapseBranch :: (RenderType -> RenderType) -> FTree RenderType -> FTree RenderType
|
||||
collapseBranch f (FBranch g t) = FBranch (f . g) t
|
||||
collapseBranch f (FBranches ts) = FBranches $ map (collapseBranch f) ts
|
||||
collapseBranch f (FLeaf x) = FLeaf (f x)
|
||||
|
||||
filtB :: Maybe Int -> Int -> LTree RenderType -> LTree RenderType
|
||||
{-# INLINE filtB #-}
|
||||
filtB mx i t | Just i == mx || Nothing == mx = t
|
||||
| otherwise = LBranches []
|
||||
|
||||
picToLTree :: Maybe Int -> Picture -> LTree RenderType
|
||||
{-# INLINE picToLTree #-}
|
||||
picToLTree mx (Polygon i ps)
|
||||
| Just i == mx = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
| Nothing == mx = LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
| otherwise = LBranches []
|
||||
picToLTree mx (PolygonCol i vs)
|
||||
| Just i == mx || Nothing == mx =
|
||||
let (ps,cs) = unzip vs
|
||||
in LLeaf $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||
| otherwise = LBranches []
|
||||
picToLTree mx (Circle i r)
|
||||
| Just i == mx || Nothing == mx = LLeaf $ RenderEllipse
|
||||
[((-r, r,0), black)
|
||||
,((-r,-r,0), black)
|
||||
,(( r,-r,0), black)
|
||||
]
|
||||
| otherwise = LBranches []
|
||||
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 []
|
||||
= 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
|
||||
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)
|
||||
| Just i == mx || Nothing == mx = LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
||||
| otherwise = LBranches []
|
||||
= filtB mx i $ LLeaf $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
||||
picToLTree mx (Line i ps)
|
||||
| Just i == mx || Nothing == mx = LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||
| otherwise = LBranches []
|
||||
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||
picToLTree mx (LineCol i vs)
|
||||
| Just i == mx || Nothing == mx =
|
||||
let (ps,cs) = unzip vs
|
||||
in LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
|
||||
| otherwise = LBranches []
|
||||
= filtB mx i $ LLeaf $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ doubleLine cs
|
||||
where (ps,cs) = unzip vs
|
||||
picToLTree mx (Text i s)
|
||||
| Just i == mx || Nothing == mx = LLeaf $ RenderText $ stringToList s
|
||||
| otherwise = LBranches []
|
||||
= filtB mx i $ LLeaf $ RenderText $ stringToList s
|
||||
picToLTree j Blank = LBranches []
|
||||
picToLTree j (Pictures pics) = LBranches $ map (picToLTree j) pics
|
||||
picToLTree j (OverPic f f' r f'' (OverPic g g' s g'' pic))
|
||||
|
||||
Reference in New Issue
Block a user