Improve cursor rendering
This commit is contained in:
+7
-26
@@ -141,31 +141,6 @@ picToAlt x (Text i s)
|
||||
picToAlt j Blank = Ap.empty
|
||||
picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
|
||||
|
||||
picToList :: Int -> Picture -> [RenderType]
|
||||
{-# INLINE picToList #-}
|
||||
picToList x (Polygon i ps)
|
||||
| i == x = [RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black]
|
||||
| otherwise = []
|
||||
picToList x (PolygonCol i vs)
|
||||
| i /= x = []
|
||||
| otherwise =
|
||||
let (ps,cs) = unzip vs
|
||||
in [RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs]
|
||||
picToList x (Circle i r)
|
||||
| i == x = [RenderCirc $ ((0,0,0),black,r)]
|
||||
| otherwise = []
|
||||
picToList x (ThickArc i startA endA rad wdth)
|
||||
| i == x = [RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))]
|
||||
| otherwise = []
|
||||
picToList x (Line i ps)
|
||||
| i == x = [RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white]
|
||||
| otherwise = []
|
||||
picToList x (Text i s)
|
||||
| i == x = [RenderText $ stringToList s]
|
||||
| otherwise = []
|
||||
picToList j Blank = []
|
||||
picToList j (Pictures pics) = concatMap (picToList 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
|
||||
@@ -191,6 +166,11 @@ picToLTree mx (ThickArc i 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 []
|
||||
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 []
|
||||
picToLTree mx (Text i s)
|
||||
| Just i == mx || Nothing == mx = LLeaf $ RenderText $ stringToList s
|
||||
| otherwise = LBranches []
|
||||
@@ -204,7 +184,8 @@ picToLTree (Just j) (OnLayer i pic) | j == i = picToLTree Nothing pic
|
||||
| otherwise = LBranches []
|
||||
picToLTree Nothing (OnLayer _ pic) = picToLTree Nothing pic
|
||||
|
||||
doubleLine :: [Point2] -> [Point2]
|
||||
doubleLine :: [a] -> [a]
|
||||
{-# INLINE doubleLine #-}
|
||||
doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:xs)
|
||||
doubleLine _ = []
|
||||
|
||||
|
||||
Reference in New Issue
Block a user