packages feed

PenroseKiteDart 1.2 → 1.2.1

raw patch · 8 files changed

+146/−94 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Tgraph.Prelude: drawLocatedEdge :: OKBackend b => VertexLocMap -> Dedge -> Diagram b
+ Tgraph.Prelude: drawLocatedEdges :: OKBackend b => VertexLocMap -> [Dedge] -> Diagram b
+ Tgraph.Prelude: makeLD :: Vertex -> Vertex -> Vertex -> TileFace
+ Tgraph.Prelude: makeLK :: Vertex -> Vertex -> Vertex -> TileFace
+ Tgraph.Prelude: makeRD :: Vertex -> Vertex -> Vertex -> TileFace
+ Tgraph.Prelude: makeRK :: Vertex -> Vertex -> Vertex -> TileFace
+ Tgraphs: drawBoundaryJoins :: OKBackend b => Tgraph -> VPatch -> Diagram b
+ TileLib: joinDashing :: (HasStyle c, N c ~ Double) => c -> c
- HalfTile: LD :: rep -> HalfTile rep
+ HalfTile: LD :: !rep -> HalfTile rep
- HalfTile: LK :: rep -> HalfTile rep
+ HalfTile: LK :: !rep -> HalfTile rep
- HalfTile: RD :: rep -> HalfTile rep
+ HalfTile: RD :: !rep -> HalfTile rep
- HalfTile: RK :: rep -> HalfTile rep
+ HalfTile: RK :: !rep -> HalfTile rep
- Tgraph.Compose: DartWingInfo :: [Vertex] -> [Vertex] -> [Vertex] -> IntMap [TileFace] -> DartWingInfo
+ Tgraph.Compose: DartWingInfo :: ![Vertex] -> ![Vertex] -> ![Vertex] -> IntMap [TileFace] -> DartWingInfo
- Tgraph.Compose: [largeDartBases] :: DartWingInfo -> [Vertex]
+ Tgraph.Compose: [largeDartBases] :: DartWingInfo -> ![Vertex]
- Tgraph.Compose: [largeKiteCentres] :: DartWingInfo -> [Vertex]
+ Tgraph.Compose: [largeKiteCentres] :: DartWingInfo -> ![Vertex]
- Tgraph.Compose: [unknowns] :: DartWingInfo -> [Vertex]
+ Tgraph.Compose: [unknowns] :: DartWingInfo -> ![Vertex]
- TileLib: colourDKG :: (Drawable a, OKBackend b) => (Colour Double, Colour Double, Colour Double) -> a -> Diagram b
+ TileLib: colourDKG :: (Drawable a, OKBackend b, Color c1, Color c2, Color c3) => (c1, c2, c3) -> a -> Diagram b
- TileLib: fillDK :: (Drawable a, OKBackend b) => Colour Double -> Colour Double -> a -> Diagram b
+ TileLib: fillDK :: (Drawable a, OKBackend b, Color c1, Color c2) => c1 -> c2 -> a -> Diagram b
- TileLib: fillKD :: (Drawable a, OKBackend b) => Colour Double -> Colour Double -> a -> Diagram b
+ TileLib: fillKD :: (Drawable a, OKBackend b, Color c1, Color c2) => c1 -> c2 -> a -> Diagram b
- TileLib: fillOnlyPiece :: OKBackend b => Colour Double -> Piece -> Diagram b
+ TileLib: fillOnlyPiece :: (OKBackend b, Color c) => c -> Piece -> Diagram b
- TileLib: fillPieceDK :: OKBackend b => Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram b
+ TileLib: fillPieceDK :: (OKBackend b, Color c1, Color c2) => c1 -> c2 -> HalfTile (V2 Double) -> Diagram b
- TileLib: leftFillPieceDK :: OKBackend b => Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram b
+ TileLib: leftFillPieceDK :: (OKBackend b, Color c1, Color c2) => c1 -> c2 -> HalfTile (V2 Double) -> Diagram b

Files

CHANGELOG.md view
@@ -1,5 +1,20 @@ # Revision history for PenroseKiteDart +## version 1.2.1 -- 2025-4-2++Added: drawBoundaryJoins, joinDashing++Renamed: drawEdge, drawEdges as drawLocatedEdge, drawLocatedEdges+Depracating: drawEdge, drawEdges++Generalised: colourDKG, fillDK, fillKD, fillPieceDK, fillOnlyPiece+to work with AlphaColours as well as Colours++Deprecating: colourMaybeDKG, fillMaybeDK, fillMaybePieceDK++Added (strict) makeRD, makeLD, makeRK, makeLK to Tgraph.Prelude++ ## version 1.2 -- 2024-12-1  Release candidate:
PenroseKiteDart.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           PenroseKiteDart-version:        1.2+version:        1.2.1 synopsis:       Library to explore Penrose's Kite and Dart Tilings. description:    Library to explore Penrose's Kite and Dart Tilings using Haskell Diagrams. Please see README.md category:       Graphics
src/HalfTile.hs view
@@ -9,7 +9,7 @@ -} {-# LANGUAGE TypeFamilies              #-} -- needed for Transformable Instance {-# LANGUAGE FlexibleInstances         #-} -- needed for Transformable Instance-{-# LANGUAGE StrictData                #-}+-- {-# LANGUAGE StrictData                #-}  module HalfTile   ( HalfTile(..)@@ -34,10 +34,10 @@ For Pieces - rep is V2 Double For TileFaces (in Tgraphs) rep is (Vertex,Vertex,Vertex) -}-data HalfTile rep = LD rep -- ^ Left Dart-                  | RD rep -- ^ Right Dart-                  | LK rep -- ^ Left Kite-                  | RK rep -- ^ Right Kite+data HalfTile rep = LD !rep -- ^ Left Dart+                  | RD !rep -- ^ Right Dart+                  | LK !rep -- ^ Left Kite+                  | RK !rep -- ^ Right Kite                   deriving (Show,Eq)  -- | Note this ignores the tileLabels when comparing.
src/Tgraph/Compose.hs view
@@ -9,7 +9,7 @@ This module includes the main composition operations compose, partCompose, tryPartCompose but also exposes  getDartWingInfo, getDartWingInfoForced (and type DartWingInfo) and composedFaceGroups for debugging and experimenting. -}-{-# LANGUAGE StrictData             #-} +-- {-# LANGUAGE StrictData             #-}   module Tgraph.Compose    ( compose@@ -74,7 +74,7 @@ -- and a Tgraph made from the composed faces without checking for connectedness and no crossing boundaries. -- This relies on a proof that the result of composing a forced Tgraph does not require these checks. uncheckedPartCompose:: Tgraph -> ([TileFace],Tgraph)-uncheckedPartCompose g = (remainder, makeUncheckedTgraph newfaces) where+uncheckedPartCompose g = (remainder, makeUncheckedTgraph $! evalFaces newfaces) where   (remainder,newfaces) = partComposeFacesWith getDartWingInfoForced g  -- |partComposeFaces g - produces a pair of the remainder faces (faces from g which will not compose)@@ -103,9 +103,9 @@ -- |DartWingInfo is a record type for the result of classifying dart wings in a Tgraph. -- It includes a faceMap from dart wings to faces at that vertex. data DartWingInfo =  DartWingInfo -     { largeKiteCentres  :: [Vertex]-     , largeDartBases  :: [Vertex]-     , unknowns :: [Vertex]+     { largeKiteCentres  :: ![Vertex]+     , largeDartBases  :: ![Vertex]+     , unknowns :: ![Vertex]      , faceMap :: VMap.IntMap [TileFace]       } deriving Show @@ -222,38 +222,38 @@ composedFaceGroups :: DartWingInfo -> [(TileFace,[TileFace])] composedFaceGroups dwInfo = faceGroupRDs ++ faceGroupLDs ++ faceGroupRKs ++ faceGroupLKs where -    faceGroupRDs = fmap (\gp -> (makeRD gp,gp)) groupRDs +    faceGroupRDs = fmap (\gp -> (makenewRD gp,gp)) groupRDs      groupRDs = mapMaybe groupRD (largeDartBases dwInfo)-    makeRD [rd,lk] = RD(originV lk, originV rd, oppV lk) -    makeRD _       = error "composedFaceGroups: RD case"+    makenewRD [rd,lk] = makeRD (originV lk) (originV rd) (oppV lk) +    makenewRD _       = error "composedFaceGroups: RD case"     groupRD v = do  fcs <- VMap.lookup v (faceMap dwInfo)                     rd <- find isRD fcs                     lk <- find (matchingShortE rd) fcs                     return [rd,lk] -    faceGroupLDs = fmap (\gp -> (makeLD gp,gp)) groupLDs +    faceGroupLDs = fmap (\gp -> (makenewLD gp,gp)) groupLDs      groupLDs = mapMaybe groupLD (largeDartBases dwInfo) -    makeLD [ld,rk] = LD(originV rk, oppV rk, originV ld)-    makeLD _       = error "composedFaceGroups: LD case"+    makenewLD [ld,rk] = makeLD (originV rk) (oppV rk) (originV ld)+    makenewLD _       = error "composedFaceGroups: LD case"     groupLD v = do  fcs <- VMap.lookup v (faceMap dwInfo)                     ld <- find isLD fcs                     rk <- find (matchingShortE ld) fcs                     return [ld,rk] -    faceGroupRKs = fmap (\gp -> (makeRK gp,gp)) groupRKs +    faceGroupRKs = fmap (\gp -> (makenewRK gp,gp)) groupRKs      groupRKs = mapMaybe groupRK (largeKiteCentres dwInfo) -    makeRK [rd,_,rk] = RK(originV rd, wingV rk, originV rk)-    makeRK _         = error "composedFaceGroups: RK case"+    makenewRK [rd,_,rk] = makeRK (originV rd) (wingV rk) (originV rk)+    makenewRK _         = error "composedFaceGroups: RK case"     groupRK v = do  fcs <- VMap.lookup v (faceMap dwInfo)                     rd <- find isRD fcs                     lk <- find (matchingShortE rd) fcs                     rk <- find (matchingJoinE lk) fcs                     return [rd,lk,rk] -    faceGroupLKs = fmap (\gp -> (makeLK gp,gp)) groupLKs +    faceGroupLKs = fmap (\gp -> (makenewLK gp,gp)) groupLKs      groupLKs = mapMaybe groupLK (largeKiteCentres dwInfo) -    makeLK [ld,_,lk] = LK(originV ld, originV lk, wingV lk)-    makeLK _         = error "composedFaceGroups: LK case"+    makenewLK [ld,_,lk] = makeLK (originV ld) (originV lk) (wingV lk)+    makenewLK _         = error "composedFaceGroups: LK case"     groupLK v = do  fcs <- VMap.lookup v (faceMap dwInfo)                     ld <- find isLD fcs                     rk <- find (matchingShortE ld) fcs
src/Tgraph/Decompose.hs view
@@ -9,6 +9,8 @@ This module defines decompose and decompositions for Tgraphs, but also exposes  two auxiliary functions for debugging and experimenting. -}+{-# LANGUAGE BangPatterns             #-}+ module Tgraph.Decompose   ( decompose   , decompositions@@ -33,19 +35,19 @@ -- |Decompose a Tgraph. decompose :: Tgraph -> Tgraph decompose g = makeUncheckedTgraph newFaces where-    newFaces = concatMap (decompFace (phiVMap g)) (faces g)+    pvmap = phiVMap g+    !newFaces = evalFaces $ concatMap (decompFace pvmap) (faces g)  -- |phiVMap g produces a finite map from the phi edges (the long edges including kite joins) to assigned new vertices not in g.--- Both (a,b) and (b,a) get the same new vertex number.+-- Both (a,b) and (b,a) get the same new vertex number. This is used(in decompFace and decompose. -- (Sort is used to fix order of assigned numbers). -- (Exported for use in TrackedTgraphs in Tgraphs module).- phiVMap :: Tgraph -> Map.Map Dedge Vertex phiVMap g = edgeVMap where   phiReps = sort [(a,b) | (a,b) <- phiEdges g, a<b]   newVs = [v+1..v+n]-  n = length phiReps-  v = maxV g+  !n = length phiReps+  !v = maxV g   edgeVMap = Map.fromList $ zip phiReps newVs ++ zip (fmap reverseD phiReps) newVs   -- |Decompose a face producing new faces. @@ -55,15 +57,15 @@ decompFace:: Map.Map Dedge Vertex -> TileFace -> [TileFace] decompFace newVFor fc = case fc of       RK(a,b,c) -> [RK(c,x,b), LK(c,y,x), RD(a,x,y)]-        where x = (Map.!) newVFor (a,b)-              y = (Map.!) newVFor (c,a)+        where !x = (Map.!) newVFor (a,b)+              !y = (Map.!) newVFor (c,a)       LK(a,b,c) -> [LK(b,c,y), RK(b,y,x), LD(a,x,y)]-        where x = (Map.!) newVFor (a,b)-              y = (Map.!) newVFor (c,a)       +        where !x = (Map.!) newVFor (a,b)+              !y = (Map.!) newVFor (c,a)              RD(a,b,c) -> [LK(a,x,c), RD(b,c,x)]-        where x = (Map.!) newVFor (a,b)+        where !x = (Map.!) newVFor (a,b)       LD(a,b,c) -> [RK(a,b,x), LD(c,x,b)]-        where x = (Map.!) newVFor (a,c)+        where !x = (Map.!) newVFor (a,c)     -- |infinite list of decompositions of a Tgraph      decompositions :: Tgraph -> [Tgraph]
src/Tgraph/Prelude.hs view
@@ -18,6 +18,7 @@ {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE TypeFamilies              #-} {-# LANGUAGE TupleSections             #-}+{-# LANGUAGE BangPatterns              #-}  module Tgraph.Prelude   ( module HalfTile@@ -86,6 +87,10 @@   , graphEFMap   , defaultAlignment     -- * Other Face/Vertex Operations+  , makeRD+  , makeLD+  , makeRK+  , makeLK   , faceVs   , faceVList   , faceVSet@@ -159,8 +164,8 @@     -- *  Drawing Edges with a VPatch or a VertexLocationMap   , drawEdgesVP   , drawEdgeVP-  , drawEdges-  , drawEdge+  , drawLocatedEdges+  , drawLocatedEdge     -- * Vertex Location and Touching Vertices   , locateVertices   , addVPoint@@ -171,6 +176,8 @@   , touching   , touchingVerticesGen   , locateVerticesGen+  , drawEdges+  , drawEdge   ) where  import Data.List ((\\), intersect, union, elemIndex,foldl',find,nub)@@ -269,10 +276,10 @@ tryCorrectTouchingVs fcs =     onFail ("tryCorrectTouchingVs:\n" ++ show touchVs) $     tryTgraphProps $ nub $ renumberFaces touchVs fcs-        -- renumberFaces allows for a non 1-1 relabelling represented by a list +        -- renumberFaces allows for a many to 1 relabelling represented by a list      where touchVs = touchingVertices fcs -- uses non-generalised version of touchingVertices --- |renumberFaces allows for a non 1-1 relabelling represented by a list of pairs.+-- |renumberFaces allows for a many to 1 relabelling represented by a list of pairs. -- It is used only for tryCorrectTouchingVs in Tgraphs which then checks the result  renumberFaces :: [(Vertex,Vertex)] -> [TileFace] -> [TileFace] renumberFaces prs = fmap renumberFace where@@ -283,20 +290,15 @@     differing = filter $ uncurry (/=)  -- |Creates a (possibly invalid) Tgraph from a list of faces.--- It does not perform checks on the faces. Use makeTgraph (defined in Tgraphs module) or checkedTgraph to perform checks.+-- It does not perform checks on the faces. Use makeTgraph or checkedTgraph to perform checks. -- This is intended for use only when checks are known to be redundant.--- It also fully evaluates the list of faces (to reduce space leaks). makeUncheckedTgraph:: [TileFace] -> Tgraph-makeUncheckedTgraph fcs = Tgraph (evalFaces fcs)+makeUncheckedTgraph = Tgraph -- . evalFaces  -- |force evaluation of a list of faces. evalFaces :: [TileFace] -> [TileFace]-evalFaces fcs = facesMaxV fcs `seq` fcs--{- -- |force evaluation of a face.-evalFace ::TileFace -> TileFace-evalFace face = oppV face `seq` wingV face `seq` originV face `seq` face- -}+evalFaces fcs = find (has0 . tileRep) fcs `seq` fcs where+    has0 (x,y,z) = x==0 || y==0 || z==0  {-| Creates a Tgraph from a list of faces using tryTgraphProps to check required properties and producing an error if a check fails.@@ -594,11 +596,24 @@ defaultAlignment g | nullGraph g = error "defaultAlignment: applied to empty Tgraph\n"                    | otherwise = lowestJoin $ faces g +makeRD,makeLD,makeRK,makeLK :: Vertex -> Vertex -> Vertex -> TileFace+-- |make an RD (strict in arguments)+makeRD !x !y !z = RD(x,y,z)+-- |make an LD (strict in arguments)+makeLD !x !y !z = LD(x,y,z)+-- |make an RK (strict in arguments)+makeRK !x !y !z = RK(x,y,z)+-- |make an LK (strict in arguments)+makeLK !x !y !z = LK(x,y,z)  -- |triple of face vertices in order clockwise starting with origin - tileRep specialised to TileFace+{-# Inline faceVs #-} faceVs::TileFace -> (Vertex,Vertex,Vertex) faceVs = tileRep-+{- faceVs f = let tr = tileRep f+               (x,y,z) = tr+           in x `seq` y `seq` z `seq` tr+ -} -- |list of (three) face vertices in order clockwise starting with origin faceVList::TileFace -> [Vertex] faceVList = (\(x,y,z) -> [x,y,z]) . faceVs@@ -1086,28 +1101,38 @@ -- Will raise an error if any vertex of the edges is not a key in the vertex to location mapping of the VPatch. drawEdgesVP :: OKBackend b =>                VPatch -> [Dedge] -> Diagram b-drawEdgesVP = drawEdges . vLocs --foldMap (drawEdgeVP vp)+drawEdgesVP = drawLocatedEdges . vLocs --foldMap (drawEdgeVP vp)  -- |produce a diagram of a single edge (given a VPatch) -- Will raise an error if either vertex of the edge is not a key in the vertex to location mapping of the VPatch. drawEdgeVP:: OKBackend b =>              VPatch -> Dedge -> Diagram b-drawEdgeVP = drawEdge . vLocs+drawEdgeVP = drawLocatedEdge . vLocs  -- |produce a diagram of a list of edges (given a mapping of vertices to locations) -- Will raise an error if any vertex of the edges is not a key in the mapping.-drawEdges :: OKBackend b =>+drawLocatedEdges :: OKBackend b =>              VertexLocMap -> [Dedge] -> Diagram b-drawEdges = foldMap . drawEdge+drawLocatedEdges = foldMap . drawLocatedEdge + -- |produce a diagram of a single edge (given a mapping of vertices to locations). -- Will raise an error if either vertex of the edge is not a key in the mapping.-drawEdge :: OKBackend b =>-            VertexLocMap -> Dedge -> Diagram b-drawEdge vpMap (a,b) = case (VMap.lookup a vpMap, VMap.lookup b vpMap) of+drawLocatedEdge :: OKBackend b =>+                   VertexLocMap -> Dedge -> Diagram b+drawLocatedEdge vpMap (a,b) = case (VMap.lookup a vpMap, VMap.lookup b vpMap) of                          (Just pa, Just pb) -> pa ~~ pb                          _ -> error $ "drawEdge: location not found for one or both vertices "++ show (a,b) ++ "\n" +-- |deprecated (use drawLocatedEdges)+drawEdges :: OKBackend b =>+             VertexLocMap -> [Dedge] -> Diagram b+drawEdges = drawLocatedEdges++-- |deprecated (use drawLocatedEdge)+drawEdge :: OKBackend b =>+            VertexLocMap -> Dedge -> Diagram b+drawEdge = drawLocatedEdge   {-| locateVertices: processes a list of faces to associate points for each vertex using a default scale and orientation.
src/Tgraphs.hs view
@@ -27,6 +27,7 @@     -- * Smart drawing of Tgraphs   , smart   , boundaryJoinFaces+  , drawBoundaryJoins   , drawJoinsFor   , smartdraw   , restrictSmart@@ -119,7 +120,7 @@ -- smart (labelSize normal draw) g smart :: OKBackend b =>          (VPatch -> Diagram b) -> Tgraph -> Diagram b-smart dr g = drawJoinsFor (boundaryJoinFaces g) vp <> dr vp+smart dr g = drawBoundaryJoins g vp <> dr vp   where vp = makeVP g  -- |select the halftile faces of a Tgraph with a join edge on the boundary.@@ -128,10 +129,15 @@ boundaryJoinFaces g = fmap snd $ incompleteHalves bdry $ boundary bdry where     bdry = makeBoundaryState g --- |given a list of faces and a VPatch with suitable locations, draw just the dashed joins for those faces.+-- draw boundary join edges of a Tgraph using a given VPatch+drawBoundaryJoins :: OKBackend b => Tgraph -> VPatch -> Diagram b+drawBoundaryJoins g vp = drawEdgesVP vp (map joinE $ boundaryJoinFaces g) # joinDashing++-- |Given a list of faces and a VPatch with suitable locations, draw just the dashed joins for those faces.+-- Will raise an error if any vertex in the faces does not have a location in the VPatch. drawJoinsFor::  OKBackend b =>                 [TileFace] -> VPatch -> Diagram b-drawJoinsFor fcs vp = drawWith dashjOnly (subVP vp fcs)+drawJoinsFor fcs vp = drawWith dashjOnly (restrictVP vp fcs)  -- |same as draw except adding dashed lines on boundary join edges.  smartdraw :: OKBackend b => Tgraph -> Diagram b@@ -142,7 +148,7 @@ -- This can be used instead of smart when an appropriate vp is already available. restrictSmart :: OKBackend b =>                  Tgraph -> (VPatch -> Diagram b) -> VPatch -> Diagram b-restrictSmart g dr vp = drawJoinsFor (boundaryJoinFaces g) rvp <> dr rvp+restrictSmart g dr vp = drawBoundaryJoins g rvp <> dr rvp                         where rvp = restrictVP vp $ faces g  -- |smartRotateBefore vfun a g - a tricky combination of smart with rotateBefore.
src/TileLib.hs view
@@ -73,6 +73,7 @@   , scales   , phiScales   , phiScaling+  , joinDashing   ) where  import Diagrams.Prelude@@ -167,9 +168,13 @@ dashjOnly :: OKBackend b =>              Piece -> Diagram b -- dashjOnly piece = drawJoin piece # dashingN [0.003,0.003] 0 # lw ultraThin -- # lc grey -dashjOnly piece = drawJoin piece # dashing [dashmeasure,dashmeasure] 0 # lw ultraThin-                  where dashmeasure = normalized 0.003  `atLeast` output 0.5+dashjOnly piece = drawJoin piece # joinDashing +-- changes line style to ultraThin dashed lines (for drawing join edges)+joinDashing :: (HasStyle c, N c ~ Double) => c -> c+joinDashing = dashing [dashmeasure,dashmeasure] 0 . lw ultraThin+                     where dashmeasure = normalized 0.003  `atLeast` output 0.5+ -- |same as drawPiece but with added join edge (also fillable as a loop). drawRoundPiece :: OKBackend b =>                   Piece -> Diagram b@@ -181,24 +186,26 @@ drawJoin piece = strokeLine $ fromOffsets [joinVector piece]  -- |fillOnlyPiece col piece - fills piece with colour col without drawing any lines.-fillOnlyPiece :: OKBackend b =>-                 Colour Double -> Piece -> Diagram b-fillOnlyPiece col piece  = drawRoundPiece piece # fc col # lw none+-- Can be used with both Colour and AlphaColour+fillOnlyPiece :: (OKBackend b, Color c) =>+                  c -> Piece -> Diagram b+fillOnlyPiece col piece  = drawRoundPiece piece # fillColor col # lw none  -- |fillPieceDK dcol kcol piece - draws and fills the half-tile piece -- with colour dcol for darts and kcol for kites. -- Note the order D K.-fillPieceDK :: OKBackend b =>-               Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram b-fillPieceDK dcol kcol piece = drawPiece piece <> fillOnlyPiece col piece where-    col = case piece of (LD _) -> dcol-                        (RD _) -> dcol-                        (LK _) -> kcol-                        (RK _) -> kcol+-- Can be used with both Colour and AlphaColour+fillPieceDK :: (OKBackend b, Color c1, Color c2) =>+                c1 -> c2 -> HalfTile (V2 Double) -> Diagram b+fillPieceDK dcol kcol piece = drawPiece piece <> filledPiece where+  filledPiece = case piece of+     (LD _) -> fillOnlyPiece dcol piece+     (RD _) -> fillOnlyPiece dcol piece+     (LK _) -> fillOnlyPiece kcol piece+     (RK _) -> fillOnlyPiece kcol piece --- |fillMaybePieceDK d k piece - draws the half-tile piece and possibly fills as well:--- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol--- Nothing indicates no fill for either darts or kites or both.+-- |fillMaybePieceDK  *Deprecated* +-- (use fillPieceDK which works with AlphaColours such as transparent as well as Colours) fillMaybePieceDK :: OKBackend b =>                     Maybe (Colour Double) -> Maybe (Colour Double) -> Piece -> Diagram b fillMaybePieceDK d k piece = drawPiece piece <> filler where@@ -213,11 +220,12 @@ -- |leftFillPieceDK dcol kcol pc fills the whole tile when pc is a left half-tile, -- darts are filled with colour dcol and kites with colour kcol. -- (Right half-tiles produce nothing, so whole tiles are not drawn twice).-leftFillPieceDK :: OKBackend b =>-                   Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram b+-- Works with AlphaColours as well as Colours.+leftFillPieceDK :: (OKBackend b, Color c1, Color c2) =>+                   c1 -> c2 -> HalfTile (V2 Double) -> Diagram b leftFillPieceDK dcol kcol pc =-     case pc of (LD _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fc dcol-                (LK _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fc kcol+     case pc of (LD _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fillColor dcol+                (LK _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fillColor kcol                 _      -> mempty          -- |experiment uses a different rule for drawing half tiles.@@ -263,20 +271,20 @@          a -> Diagram b drawj = drawWith dashjPiece -fillDK, fillKD :: (Drawable a, OKBackend b) =>-                   Colour Double -> Colour Double -> a -> Diagram b+fillDK, fillKD :: (Drawable a, OKBackend b, Color c1, Color c2) =>+                  c1 -> c2 -> a -> Diagram b -- |fillDK dcol kcol a - draws and fills a with colour dcol for darts and kcol for kites. -- Note the order D K.+-- Works with AlphaColours as well as Colours. fillDK c1 c2 = drawWith (fillPieceDK c1 c2)  -- |fillKD kcol dcol a - draws and fills a with colour kcol for kites and dcol for darts. -- Note the order K D.+-- Works with AlphaColours as well as Colours. fillKD c1 c2 = fillDK c2 c1     --- |fillMaybeDK c1 c2 a - draws a and maybe fills as well:--- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol--- Nothing indicates no fill for either darts or kites or both--- Note the order D K.+-- |fillMaybeDK *Deprecated*+-- (Use fillDK which works with AlphaColours such as transparent as well as Colours). fillMaybeDK :: (Drawable a, OKBackend b) =>                Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram b fillMaybeDK c1 c2 = drawWith (fillMaybePieceDK c1 c2)@@ -284,22 +292,18 @@ -- |colourDKG (c1,c2,c3) p - fill in a drawable with colour c1 for darts, colour c2 for kites and -- colour c3 for grout (that is, the non-join edges). -- Note the order D K G.-colourDKG :: (Drawable a, OKBackend b) =>-             (Colour Double, Colour Double, Colour Double) -> a -> Diagram b-colourDKG (c1,c2,c3) a = fillDK c1 c2 a # lc c3+-- Can be used with both Colour and AlphaColour+colourDKG :: (Drawable a, OKBackend b, Color c1, Color c2, Color c3) =>+             (c1,c2,c3) -> a -> Diagram b+colourDKG (c1,c2,c3) a = fillDK c1 c2 a # lineColor c3 --- |colourMaybeDKG (d,k,g) a - draws a and possibly fills as well:--- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol--- Nothing indicates no fill for either darts or kites or both--- The g argument is for grout - i.e the non-join edges round tiles.--- Edges are drawn with gcol if g  = Just gcol and not drawn if g = Nothing.+-- |colourMaybeDKG *Deprecated*+-- (Use colourDKG which works with AlphaColours such as transparent as well as Colours) colourMaybeDKG:: (Drawable a, OKBackend b) =>                  (Maybe (Colour Double),  Maybe (Colour Double), Maybe (Colour Double)) -> a -> Diagram b colourMaybeDKG (d,k,g) a = fillMaybeDK d k a # maybeGrout g where     maybeGrout (Just c) = lc c     maybeGrout Nothing = lw none--  {-| Decomposing splits each located piece in a patch into a list of smaller located pieces to create a refined patch.