diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: diff --git a/PenroseKiteDart.cabal b/PenroseKiteDart.cabal --- a/PenroseKiteDart.cabal +++ b/PenroseKiteDart.cabal @@ -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 diff --git a/src/HalfTile.hs b/src/HalfTile.hs --- a/src/HalfTile.hs +++ b/src/HalfTile.hs @@ -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. diff --git a/src/Tgraph/Compose.hs b/src/Tgraph/Compose.hs --- a/src/Tgraph/Compose.hs +++ b/src/Tgraph/Compose.hs @@ -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 diff --git a/src/Tgraph/Decompose.hs b/src/Tgraph/Decompose.hs --- a/src/Tgraph/Decompose.hs +++ b/src/Tgraph/Decompose.hs @@ -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 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] diff --git a/src/Tgraph/Prelude.hs b/src/Tgraph/Prelude.hs --- a/src/Tgraph/Prelude.hs +++ b/src/Tgraph/Prelude.hs @@ -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. diff --git a/src/Tgraphs.hs b/src/Tgraphs.hs --- a/src/Tgraphs.hs +++ b/src/Tgraphs.hs @@ -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. diff --git a/src/TileLib.hs b/src/TileLib.hs --- a/src/TileLib.hs +++ b/src/TileLib.hs @@ -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.