Improve cursor rendering

src/Picture/Data.hs

@@ -70,6 +70,7 @@ data Picture
     | Circle Int Float
     | ThickArc Int Float Float Float Float
     | Line Int [Point2]
+    | LineCol Int [(Point2,RGBA)]
     | Pictures [Picture]
     | OverPic (Point3 -> Point3) (Point2 -> Point2) Float (Point4 -> Point4) Picture
     | OnLayer Int Picture

src/Picture/Render.hs

@@ -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 _ = []