PenroseKiteDart 1.10 → 1.10.1

raw patch · 6 files changed

+255/−102 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−1
• PenroseKiteDart.cabal +2/−2
• src/Tgraph/Force.hs +107/−58
• src/Tgraph/Prelude.hs +17/−2
• src/TgraphExamples.hs +108/−37
• src/TileLib.hs +2/−2

@@ -1,10 +1,28 @@ # Revision history for PenroseKiteDart +## version 1.10.1 +-  VPatch is now deformable++-  Added:+     deformVP (in Tgraph.Prelude), deformExample (in TgraphExamples)++-  Also Added:+     kiteOppCount, deuceMissingDart, jackMissingDart, queenMissingDart, aceMissingKite, queenOrKingMissingKite,+     chunking, centerRows, centerRows', arrangeRows'+  +-  Deprecated:+    kiteGaps (Renamed as deuceMissingDart)+    nonKDarts (Renamed as aceMissingKite)+    noTouchingDart (Renamed as jackMissingDart)+    queenMissingDarts (Renamed as queenMissingDart)+    kitesWingDartOrigin  (Renamed as queenOrKingMissingKite)+    arrangeRowsGap (Renamed as arrangeRows')+   ## version 1.10  - Possibly breaking change:-  - Redefined Pieces to use a list of two vectors for the drawn edges instead of a single+  - Redefined Piece to use a list of two vectors for the drawn edges instead of a single   vector for the join edge.   VPatch and Patch now transform correctly before and after drawing (linear transformations).   (Previously only rotations, translations, and uniform scaling worked before drawing.)

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.39.1.+-- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           PenroseKiteDart-version:        1.10+version:        1.10.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

@@ -102,12 +102,16 @@   , wholeTileUpdates   , incompleteHalves   , aceKiteUpdates+  , aceMissingKite   , nonKDarts   , queenOrKingUpdates   , kitesWingDartOrigin+  , queenOrKingMissingKite   , deuceDartUpdates+  , deuceMissingDart   , kiteGaps   , jackDartUpdates+  , jackMissingDart   , noTouchingDart   , sunStarUpdates   , almostSunStar@@ -116,6 +120,7 @@   , kingDartUpdates   , kingMissingThirdDart   , queenDartUpdates+  , queenMissingDart   , queenMissingDarts   , queenKiteUpdates   , queenMissingKite@@ -132,10 +137,11 @@   , mustbeDeuce   , mustbeKing   , isKiteWing-  , isKiteOppV+  , isKiteOppV -- no longer used   , isDartOrigin   , mustbeQueen   , kiteWingCount+  , kiteOppCount   , mustbeJack    -- * Other tools for making new update generators   , newUpdateGenerator@@ -932,7 +938,7 @@    If there is a boundary short edge of a kite half at the vertex,     add another kite half sharing the short edge.     (This converts 1 kite to 2 and 3 kites to 4 in combination with the first rule).-4. (deuceDartUpdates) When two half kites share a short edge their oppV vertex must be a deuce vertex.+4. (deuceDartUpdates) When more than two half kites share an oppV that vertex must be a deuce vertex.    Add any missing half darts needed to complete the vertex. 5. (jackDartUpdates) When a single dart wing is at a vertex which is recognised as an incomplete jack vertex    and has a complete kite below the dart wing, @@ -962,7 +968,7 @@  {-------------------  FORCING RULES and Update Generators -------------------------- 7 vertex types are:-sun, queen, jack (largeDartBase), ace (fool), deuce (largeKiteCentre), king, star+sun, queen, jack (=largeDartBase), ace (fool), deuce (=largeKiteCentre), king, star -}  -- |combineUpdateGenerators combines a list of update generators into a single update generator.@@ -1011,8 +1017,8 @@ -- when creating the update.] -- As an example, addKiteShortE will try to produce an update to add a half-kite with short edge against the boundary. -- Such a function can be used with a UFinder that either returns dart halves with short edge on the boundary--- (nonKDarts in rule 2) or returns kite halves with short edge on the boundary--- (kitesWingDartOrigin in rule 3).+-- (aceMissingKite in rule 2) or returns kite halves with short edge on the boundary+-- (queenOrKingMissingKite in rule 3). type UChecker = BoundaryState -> TileFace -> Try Update  {-|This is a general purpose filter (previously used to create UFinder functions for each force rule).@@ -1023,7 +1029,7 @@  (when given a BoundaryState and list of focus edges).  For some predicates the BoundaryState argument is not used (eg boundaryJoin in incompleteHalves),   but for others it is used to look at other faces at b or at a besides the supplied face - (eg in kitesWingDartOrigin) + (eg in queenOrKingMissingKite)  -} boundaryFilter::  (BoundaryState -> Dedge -> TileFace -> Bool) -> UFinder boundaryFilter predF bd focus =@@ -1043,7 +1049,7 @@  (when given a BoundaryState and list of focus edges).  For some predicates the BoundaryState argument is not used (eg boundaryJoin in incompleteHalves),   but for others it is used to look at other faces besides the supplied face - (eg in kitesWingDartOrigin) + (eg in queenOrKingMissingKite)  -} boundaryEdgeFilter::  EdgeType -> (BoundaryState -> TileFace -> Bool) -> UFinder boundaryEdgeFilter etype predF bd focus =@@ -1068,11 +1074,10 @@ mustbeSun:: BoundaryState -> Vertex -> Bool mustbeSun bd v = length (filter ((==v) . originV) $ filter isKite $ facesAtBV bd v) >= 5 --- |A vertex on the boundary which is an oppV of a kite must be a deuce--- if there is a shared kite short edge at the vertex.+-- |A vertex on the boundary which is an oppV of more than two half kites must be a deuce+-- (also there must be a shared kite short edge at the vertex). mustbeDeuce:: BoundaryState -> Vertex -> Bool-mustbeDeuce bd v = isKiteOppV bd v &&-                   hasAnyMatchingE (map shortE $ filter isKite $ facesAtBV bd v)+mustbeDeuce bd v = kiteOppCount bd v > 2  -- |A boundary vertex which is a kite wing and has 4 dart origins must be a king vertex mustbeKing:: BoundaryState -> Vertex -> Bool@@ -1083,6 +1088,7 @@ isKiteWing:: BoundaryState -> Vertex -> Bool isKiteWing bd v = v `elem` map wingV (filter isKite (facesAtBV bd v)) +-- (No longer used) -- |isKiteOppV bd v - Vertex v is a kite oppV in BoundaryState bd isKiteOppV:: BoundaryState -> Vertex -> Bool isKiteOppV bd v = v `elem` map oppV (filter isKite (facesAtBV bd v))@@ -1092,31 +1098,53 @@ isDartOrigin bd v = v `elem` map originV (filter isDart (facesAtBV bd v))  -- |A boundary vertex with >2 kite wings is a queen vertex --- (needing a fourth kite on a kite short edge or dart on a kite long edge)+-- (needing a fourth kite on a kite short edge or dart on a kite long edge). mustbeQueen:: BoundaryState -> Vertex -> Bool-mustbeQueen bd v = kiteWingCount bd v >2+mustbeQueen bd v = kiteWingCount bd v > 2 +-- |(not exported) A kite half with its wing on the boundary known to be a queen vertex (>2 kite wings).+-- This allows for 2 cases where the short or long of the kite is on the boundary.+queenKiteWing :: BoundaryState -> TileFace -> Bool+queenKiteWing bd fc = isKite fc && mustbeQueen bd (wingV fc)+         -- |kiteWingCount bd v - the number of kite wings at v in BoundaryState bd kiteWingCount:: BoundaryState -> Vertex -> Int kiteWingCount bd v = length $ filter ((==v) . wingV) $ filter isKite (facesAtBV bd v) +-- |kiteOppCount bd v - the number of kite opps at v in BoundaryState bd+kiteOppCount:: BoundaryState -> Vertex -> Int+kiteOppCount bd v = length $ filter ((==v) . oppV) $ filter isKite (facesAtBV bd v)++-- (mustbeJack replaced internally by oneDartJack or twoDartJack but still exported) + -- |mustbeJack  is true of a boundary vertex if--- it is the wing of two darts not sharing a long edge or+-- it is the wing of two darts not sharing an origin or -- it is a wing of a dart and also a kite origin--- (false means it is either undetermined or is a deuce). mustbeJack :: BoundaryState -> Vertex -> Bool mustbeJack bd v =-  (length dWings == 2 && not (hasAnyMatchingE (map longE dWings))) || -- 2 dart wings and dart long edges not shared.-  (length dWings == 1 && isKiteOrigin)+  (length dWingFaces == 2 && not (matching (map originV dWingFaces))) || -- 2 dart wings and dart origins not shared.+  (length dWingFaces == 1 && isKiteOrigin)   where fcs = facesAtBV bd v-        dWings = filter ((==v) . wingV) $ filter isDart fcs+        dWingFaces = filter ((==v) . wingV) $ filter isDart fcs         isKiteOrigin = v `elem` map originV (filter isKite fcs)+        matching (x:y:_) = x == y+        matching _ = False --- |hasMatching asks if a directed edge list has any two matching (=opposing) directed edges.-hasAnyMatchingE :: [Dedge] -> Bool-hasAnyMatchingE ((x,y):more) = (y,x) `elem` more || hasAnyMatchingE more-hasAnyMatchingE [] = False+-- |(not exported) True of a boundary vertex if it is a kite origin and a dart wing (therefore a jack)+oneDartJack :: BoundaryState -> Vertex -> Bool+oneDartJack bd v = isKiteOrigin && isDartWing +   where fcs = facesAtBV bd v+         isKiteOrigin = v `elem` map originV (filter isKite fcs)+         isDartWing = v `elem` map wingV (filter isDart fcs) +-- |(not exported) True of a boundary vertex if it has more than 1 (hence 2) dart wings.+-- WARNING should only be used when a dart long is on the boundary.+-- (This ensures the two darts are not sharing a long edge, so must be a jack).+twoDartJack :: BoundaryState -> Vertex -> Bool+twoDartJack bd v = length dWingFaces > 1+   where fcs = facesAtBV bd v+         dWingFaces = filter ((==v) . wingV) $ filter isDart fcs+ {-| newUpdateGenerator combines an update case finder (UFinder) with its corresponding update checker (UChecker)     to produce an update generator.     This is used to make each of the 10 update generators corresponding to 10 rules. @@ -1144,54 +1172,78 @@ incompleteHalves = boundaryEdgeFilter Join anyFace where     anyFace _ _ = True + -- |Update generator for rule (2) aceKiteUpdates :: UpdateGenerator-aceKiteUpdates = newUpdateGenerator addKiteShortE nonKDarts+aceKiteUpdates = newUpdateGenerator addKiteShortE aceMissingKite  -- |Find half darts with boundary short edge-nonKDarts :: UFinder-nonKDarts = boundaryEdgeFilter Short foundDart where+aceMissingKite :: UFinder+aceMissingKite = boundaryEdgeFilter Short foundDart where     foundDart _ = isDart +{-# DEPRECATED nonKDarts "Renamed as aceMissingKite" #-}+-- |Find half darts with boundary short edge+nonKDarts :: UFinder+nonKDarts = aceMissingKite + -- |Update generator for rule (3)  -- queen and king vertices add a missing kite half (on a boundary kite short edge) queenOrKingUpdates :: UpdateGenerator-queenOrKingUpdates = newUpdateGenerator addKiteShortE kitesWingDartOrigin+queenOrKingUpdates = newUpdateGenerator addKiteShortE queenOrKingMissingKite  -- |Find kites with boundary short edge where the wing is also a dart origin-kitesWingDartOrigin :: UFinder-kitesWingDartOrigin = boundaryEdgeFilter Short kiteWDO where+-- (Hence the wing is a queen or king vertex)+queenOrKingMissingKite :: UFinder+queenOrKingMissingKite = boundaryEdgeFilter Short kiteWDO where    kiteWDO bd fc = isKite fc && isDartOrigin bd (wingV fc) +{-# DEPRECATED kitesWingDartOrigin "Renamed as queenOrKingMissingKite" #-}+-- |Find kites with boundary short edge where the wing is also a dart origin+-- (Hence the wing is a queen or king vertex)+kitesWingDartOrigin :: UFinder+kitesWingDartOrigin = queenOrKingMissingKite + {-| Update generator for rule (4)      (for deuce vertices = largeKiteCentres)-     Kites whose short edge (b,a) matches a boundary edge (a,b) where their oppV -     has 2 other kite halves sharing a shortE.+     Kites whose short edge (b,a) matches a boundary edge (a,b) where the oppV +     has more than 1 other kite half sharing the oppV.      These need a dart adding on the short edge. -} deuceDartUpdates :: UpdateGenerator-deuceDartUpdates = newUpdateGenerator addDartShortE kiteGaps+deuceDartUpdates = newUpdateGenerator addDartShortE deuceMissingDart  -- |Find kite halves with a short edge on the boundary --- where there are 2 other kite halves sharing a short edge--- at oppV of the kite half.+-- where there are more than 2 kite halves sharing the oppV.+deuceMissingDart :: UFinder+deuceMissingDart = boundaryEdgeFilter Short deuceKite where+  deuceKite bd fc = isKite fc && mustbeDeuce bd (oppV fc)++{-# DEPRECATED kiteGaps "Renamed as deuceMissingDart" #-}+-- |Find kite halves with a short edge on the boundary +-- where there are more than 2 kite halves sharing the oppV.+-- Renamed as deuceMissingDart. kiteGaps :: UFinder-kiteGaps = boundaryEdgeFilter Short kiteGap where-  kiteGap bd fc = isKite fc && mustbeDeuce bd (oppV fc)+kiteGaps = deuceMissingDart   -- |Update generator for rule (5) -- jackDartUpdates - jack vertex add a missing second dart jackDartUpdates :: UpdateGenerator-jackDartUpdates = newUpdateGenerator addDartShortE noTouchingDart+jackDartUpdates = newUpdateGenerator addDartShortE jackMissingDart +-- |Find a kite half with a short edge on the boundary where oppV must be a jack vertex+jackMissingDart :: UFinder+jackMissingDart = boundaryEdgeFilter Short farKOfDarts where+   farKOfDarts bd fc  = isKite fc && oneDartJack bd (oppV fc)++{-# DEPRECATED noTouchingDart "Renamed as jackMissingDart" #-} -- |Find kite halves with a short edge on the boundary where oppV must be a jack vertex -- The function mustbeJack finds if a vertex must be a jack. noTouchingDart :: UFinder-noTouchingDart = boundaryEdgeFilter Short farKOfDarts where-   farKOfDarts bd fc  = isKite fc && mustbeJack bd (oppV fc)+noTouchingDart = jackMissingDart   {-| Update generator for rule (6)@@ -1216,16 +1268,14 @@   -- |Update generator for rule (7)--- jack vertices with dart long edge on the boundary - add missing kite top.--- The function mustbeJack finds if a vertex must be a jack.+-- jack vertices with dart long edge on the boundary - add missing kite. jackKiteUpdates :: UpdateGenerator jackKiteUpdates = newUpdateGenerator addKiteLongE jackMissingKite --- |Find a boundary long edge of a dart where the wingV is a jack vertex.--- The function mustbeJack finds if a vertex must be a jack.+-- |Find a boundary long edge of a dart where the wingV has two dart wings (hence a jack vertex). jackMissingKite :: UFinder jackMissingKite = boundaryEdgeFilter Long dartsWingDB where-    dartsWingDB bd fc = isDart fc && mustbeJack bd (wingV fc)+    dartsWingDB bd fc = isDart fc && twoDartJack bd (wingV fc)  -- |Update generator for rule (8) -- king vertices with 2 of the 3 darts  - add another half dart on a boundary long edge of existing darts@@ -1239,20 +1289,24 @@ kingMissingThirdDart = boundaryEdgeFilter Long predicate where     predicate bd fc = isDart fc && mustbeKing bd (originV fc) + -- |Update generator for rule (9) -- queen vertices (more than 2 kite wings) with a boundary kite long edge - add a half dart queenDartUpdates :: UpdateGenerator-queenDartUpdates = newUpdateGenerator addDartLongE queenMissingDarts+queenDartUpdates = newUpdateGenerator addDartLongE queenMissingDart  -- |Find a boundary kite long edge where the wingV must be a queen vertex -- (more than 2 kite wings at the wingV).+queenMissingDart :: UFinder+queenMissingDart = boundaryEdgeFilter Long queenKiteWing++{-# DEPRECATED queenMissingDarts "Renamed as queenMissingDart" #-}+-- |Find a boundary kite long edge where the wingV must be a queen vertex+-- (more than 2 kite wings at the wingV). queenMissingDarts :: UFinder-queenMissingDarts = boundaryEdgeFilter Long predicate where-    predicate bd fc = isKite fc && length kiteWings >2-           where fcWing = wingV fc-                 kiteWings = filter ((==fcWing) . wingV) $-                             filter isKite $ facesAtBV bd fcWing+queenMissingDarts = boundaryEdgeFilter Long queenKiteWing + -- |Update generator for rule (10) -- queen vertices with more than 2 kite wings -- add missing half kite on a boundary kite short edge queenKiteUpdates :: UpdateGenerator@@ -1261,13 +1315,8 @@ -- |Find a kite short edge on the boundary where the wingV must be a queen vertex -- (more than 2 kite wings at the wingV). queenMissingKite :: UFinder-queenMissingKite = boundaryEdgeFilter Short predicate where-    predicate bd fc =-        isKite fc && length kiteWings >2-        where fcWing = wingV fc-              kiteWings = filter ((==fcWing) . wingV) $ filter isKite (facesAtBV bd fcWing)--+queenMissingKite = boundaryEdgeFilter Short queenKiteWing+  --  Six Update Checkers  @@ -1395,7 +1444,7 @@       dartLongDecider f         | mustbeStar bd (originV f) = mapItem (completeSunStar bd f)         | mustbeKing bd (originV f) = mapItem (addDartLongE bd f)-        | mustbeJack bd (wingV f) = mapItem (addKiteLongE bd f)+        | twoDartJack bd (wingV f) = mapItem (addKiteLongE bd f) -- musbeJack         | otherwise = Right mempty        kiteLongDecider f@@ -1404,7 +1453,7 @@         | otherwise = Right mempty        kiteShortDecider f-        | mustbeDeuce bd (oppV f) || mustbeJack bd (oppV f) = mapItem (addDartShortE bd f)+        | mustbeDeuce bd (oppV f) || oneDartJack bd (oppV f) = mapItem (addDartShortE bd f)         | mustbeQueen bd (wingV f) || isDartOrigin bd (wingV f) = mapItem (addKiteShortE bd f)         | otherwise = Right mempty  --     mapItem :: Try Update -> Try Updates

@@ -157,6 +157,7 @@   , centerOn   , alignXaxis   , alignments+  , deformVP     -- * Drawing with Labels   , DrawableLabelled(..)   , labelSize@@ -848,7 +849,8 @@ faceDedges::TileFace -> [Dedge] faceDedges f = [(a,b),(b,c),(c,a)] where (a,b,c) = faceVs f --  faceDedges !f = [(a,b),(b,c),(c,a)] where (!a,!b,!c) = faceVs f--- |produces a list of directed edges (clockwise) round a face.++-- |produces a set of directed edges (clockwise) round a face. faceDedgeSet::TileFace -> Set Dedge faceDedgeSet f = Set.insert (a,b) $ Set.insert (b,c) $ Set.insert (c,a) Set.empty                  where (a,b,c) = faceVs f@@ -1096,10 +1098,23 @@ type instance N VPatch = Double  --- |Make VPatch Transformable.+-- |A VPatch can be transformed. instance Transformable VPatch where+    transform :: Transformation V2 Double -> VPatch -> VPatch     transform t vp = vp {vLocs = VMap.map (transform t) (vLocs vp)} +-- | A VPatch can be deformed+instance Deformable VPatch VPatch where+   deform :: Deformation V2 V2 Double -> VPatch -> VPatch+   deform d vp = vp{vLocs = VMap.map (deform d) (vLocs vp)}++   deform' :: Double -> Deformation V2 V2 Double -> VPatch -> VPatch+   deform' r d vp = vp{vLocs = VMap.map (deform' r d) (vLocs vp)}++-- | Explicitly typed instance of deform for a VPatch+-- (This can avoid the need for type annotations when using deform)+deformVP :: Deformation V2 V2 Double -> VPatch -> VPatch+deformVP = deform  -- |VPatch is in class HasFace instance HasFaces VPatch where

@@ -17,8 +17,12 @@   (-- * Some Layout tools     padBorder   , chunks-  , arrangeRowsGap+  , chunking+  , centerRows+  , centerRows'   , arrangeRows+  , arrangeRows'+  , arrangeRowsGap -- deprecated   , labelAt     -- *  Tgraphs for 7 vertex types   , sunGraph@@ -93,8 +97,9 @@  , extendChoicesFig      -- * Example showing a P3 tiling  , testRhombus-      -- * Example showing a VPatch transform+      -- * Examples showing VPatch transform and deform  , testVPTransform+ , deformExample    ) where @@ -111,6 +116,8 @@ padBorder = pad 1.2 . centerXY  -- |chunks n l -  split a list l into chunks of length n (n>0)+-- The last list may have fewer than n items.+-- An error wil be raised if n<1. chunks::Int -> [a] -> [[a]] chunks n   | n < 1 = error "chunks: argument <1\n"@@ -118,20 +125,58 @@       ch [] = []       ch as = take n as : ch (drop n as) +{- |chunking generalises chunks to allow specifying different lengths.++   chunking ns as - will split the list as into a list of lists, where the lengths of inner lists+   are determined by the Ints in ns (in order). The last Int in ns will be used as a default length for all subsequent inner lists.+   The last inner list may be shorter than specified if there are not enough remaining elements in as.+   An error will be raised if ns is null or if a non-positive Int is encountered in ns before as runs out.+-}+chunking :: [Int] -> [a] -> [[a]]+chunking _ [] = []+chunking (n:_) _ | n<1 = error $ "chunking: non-positive Int found " ++ "show n"+chunking (n:m:more) ds = take n ds: chunking (m:more) (drop n ds)+chunking [n] ds = chunks n ds -- repeat last Int n+chunking [] _ = error "chunking: empty Int list found "++-- |makes a list of lists of diagrams into a single diagram treating them as a column of rows,+-- using default separator of 1.0 for rows and columns (see also centerRows').+centerRows :: OKBackend b =>+              [[Diagram b]] -> Diagram b+centerRows = centerRows' 1.0++-- |given a default seperator value, this makes a list of lists of diagrams into a single diagram treating them as a column of rows,+-- using the default separator for rows and columns.+centerRows' :: OKBackend b =>+               Double -> [[Diagram b]] -> Diagram b+centerRows' s = centerY . vsep s . map (centerX . hsep s)++-- |arrangeRows n diags - arranges diags into a single diagram with n>0 per row, centering each row horizontally.+-- The default separation is 1.0 vertically and horizontally (see also arrangeRows').+-- An error is raised if n<1+arrangeRows :: OKBackend b =>+               Int -> [Diagram b] -> Diagram b+arrangeRows = arrangeRows' 1.0++-- |arrangeRows' s n diags - arranges diags into a single diagram with n>0 per row, centering each row horizontally,+-- with a separation gap (horizontally and vertically) of s.+-- An error is raised if n<1+arrangeRows' :: OKBackend b =>+                Double -> Int -> [Diagram b] -> Diagram b+arrangeRows' s n = centerRows' s . chunks n+++{-# DEPRECATED arrangeRowsGap "Renamed as arrangeRows'" #-} -- |arrangeRowsGap s n diags - arranges diags into n per row, centering each row horizontally,--- with a seperation gap (horizontally and vertically) of s.+-- with a separation gap (horizontally and vertically) of s. -- The result is a single diagram. arrangeRowsGap :: OKBackend b =>                   Double -> Int -> [Diagram b] -> Diagram b-arrangeRowsGap s n = centerY . vsep s . map (centerX . hsep s) . chunks n+arrangeRowsGap = arrangeRows' --- |arrangeRows n diags - arranges diags into n per row, centering each row horizontally.--- The result is a single diagram (seperation is 1 unit vertically and horizontally).-arrangeRows :: OKBackend b =>-               Int -> [Diagram b] -> Diagram b-arrangeRows = arrangeRowsGap 1.0 --- |add a given label at a given point offset from the centre of the given diagram.++-- |add a given label at a given point in the given diagram. labelAt :: OKBackend b =>            Point V2 Double -> String -> Diagram b -> Diagram b labelAt p l d = baselineText l # fontSize (output 15) # moveTo p <> d@@ -423,32 +468,34 @@ kingEmpire2Fig = showEmpire2 kingGraph  --- |emplaceChoices forces then maximally composes. At this top level it--- produces a list of forced choices for each of the unknowns at this top level Tgraph.--- It then repeatedly applies (forceF . decompose ) back to the starting level to return a list of Forced Tgraphs.+-- |emplaceChoices first forces then maximally composes. At this top level it+-- produces a list of forced choices for the unknowns (boundary dart long edges).+-- It then repeatedly applies (forceF . decompose) back to the starting level to return a list of Forced Tgraphs. -- This version relies on compForce theorem and related theorems. -- -- Note that emplaceChoices is no longer considered useful as information--- can still be lost when composing.  A better approach to finding extension choices+-- can still be lost when composing even after forcing so the results may not always extend+-- the given Tgraph (e.g. for sun3Dart).+--+-- A better approach to finding extension choices -- is to calculate a boundaryECovering or a boundaryVCovering after forcing. -- See extendChoices and extendChoicesFig. emplaceChoices:: Tgraph -> [Forced Tgraph] emplaceChoices = emplaceChoicesF . forceF  where    emplaceChoicesF:: Forced Tgraph -> [Forced Tgraph]-  emplaceChoicesF fg | nullGraph compfg = chooseUnknowns [(unknowns $ getDartWingInfoForced fg, fg)]+  emplaceChoicesF fg | nullGraph compfg = chooseUnknowns [(unknowns $ getDartWingInfoForced fg, withForced makeBoundaryState fg)]                      | otherwise        = forceF . decompose <$> emplaceChoicesF compfg                           where compfg = composeF fg -  chooseUnknowns :: [([Vertex],Forced Tgraph)] -> [Forced Tgraph]+  chooseUnknowns :: [([Vertex],Forced BoundaryState)] -> [Forced Tgraph]   chooseUnknowns [] = []-  chooseUnknowns (([],g0):more) = g0:chooseUnknowns more-  chooseUnknowns ((u:unks,g0): more)+  chooseUnknowns (([],bd):more) = withForced recoverGraph bd:chooseUnknowns more+  chooseUnknowns ((u:unks,bd): more)      =  chooseUnknowns (map (remainingunks unks) newgs ++ more)-        where newgs = map (withForced recoverGraph) $ runTry $ tryCheckCasesDKF de g0---        where newgs = map (withForced recoverGraph) $ atLeastOne $ (tryDartAndKiteF (findDartLongForWing u bd) bd)-              de = findDartLongForWing u $ makeBoundaryState (forgetF g0)-              remainingunks startunks g' = (startunks `intersect` boundaryVsDup g', g')+        where newgs = runTry $ tryCheckCasesDKF de bd+              de = findDartLongForWing u $ forgetF bd+              remainingunks startunks bd' = (startunks `intersect` boundaryVsDup bd', bd')    findDartLongForWing :: Vertex -> BoundaryState -> Dedge   findDartLongForWing v bd@@ -456,16 +503,19 @@         Just d -> longE d         Nothing -> error $ "findDartLongForWing: dart not found for dart wing vertex " ++ show v --- |Example showing emplaceChoices for foolD with foolD shown in red in each choice.+-- |Original example showing emplaceChoices for foolD with foolD shown in red in each choice.+-- Note that replacing foolD by sun3Dart shows that the results do not always extend the original Tgraph. -- (See also extendChoicesFig.) emplaceChoicesFig :: OKBackend b => Diagram b-emplaceChoicesFig =  lw thin $ hsep 1 $  overlayg <$> emplaceChoices g+emplaceChoicesFig =  padBorder $ lw thin $ hsep 1 $ overlayg <$> emplaceChoices g     where g = foolD-          overlayg g' = smartAligning algmnt draw g # lc red <> aligning algmnt draw  g'+          overlayg g' = smartAligning algmnt draw g # lc red # lw medium+                        <> aligning algmnt draw g'           algmnt = defaultAlignment $ maxCompForce g --- | extendChoices - better than emplaceChoices using a boundary cover after forcing.--- The resulting list of local possible extensions to given Tgraph.+-- | extendChoices (better than emplaceChoices) uses a boundary cover after forcing.+-- If there are no force failures (with an incorrect Tgraph), +-- the result is a list of all local possible forced extensions to the given Tgraph. extendChoices :: Tgraph -> [Forced Tgraph] extendChoices g = withForced recoverGraph <$> boundaryECovering (forceF $ initFS g) @@ -477,23 +527,44 @@                   aligning (1,5) draw (force foolD) <>                   lw ultraThin (aligning (1,5) draw d) + -- | An example to illustrate drawing P3 tiling (rhombuses). -- The top part (filled) is a 5 times decomposed sunGraph converted to rhombuses (P3) when drawn. -- The bottom part is the 5 times decomposed sunGraph reflected about its x-axis. testRhombus :: OKBackend b => Diagram b-testRhombus = padBorder $-              fillWN darkmagenta indigo g # lw veryThin # lc gold +testRhombus = padBorder $ lw veryThin $+              fillWN darkmagenta indigo g # lc gold                ===-              draw g # reflectY # lw veryThin+              draw g # reflectY       where g = decompositions sunGraph !! 5 --- | Performs a shearY transform before and after drawing foolD (decomposed fool) with labels.--- In the left diagram labels are added after the transform, and on the right they are added before the transform.--- Since PKD version 1.10, linear transforms that do not preserve angles will work as expected on--- VPatch, Patch, P3_Patch.-testVPTransform :: OKBackend b => Diagram b+-- |Performs a shearY transform before and after drawing a forced queenGraph with labels.+-- The left figure shows an untransformed forced queenGraph.+-- The middle figure shows the result of drawing with labels after the VPatch is transformed.+-- The right figure shows the result of transforming the final diagram after drawing with labels.+-- (Since PenroseKiteDart version 1.10, 2D linear transforms will commute with unlabelled drawing+-- from a VPatch, Patch, or P3_Patch.+-- Prior to 1.10 this was only true if the transformation preserved angles.)+testVPTransform  :: OKBackend b => Diagram b testVPTransform =    padBorder $ lw thin $ -  hsep 1 [labelled drawj (shearY 1.2 vp), shearY 1.2 (labelled drawj vp)]-           where vp = makeVP foolD+  hcat [drawing vp, drawing (shearY 1.05 vp), shearY 1.05 (drawing vp)]+           where vp = rotatedVP (90@@deg) g+                 g = force queenGraph+                 drawing = labelled (colourDKG(silver, powderblue, indigo))++-- |Illustrating a non linear (squeeze) deformation being applied to a VPatch.+-- The left figure shows a forced, twice decomposed kingGraph,+-- the middle and right figures are drawn after the deformation,+-- showing both dart/kite (P2 style) and rhombus (P3 style) drawing.+-- Since PenroseKiteDart version 1.10.1 a VPatch is deformable.+deformExample :: OKBackend b => Diagram b+deformExample = padBorder $ lw thin $ hsep 1 [drawing vp1, drawing vp2, drawingR vp2]+  where drawing = colourDKG (darkcyan, indigo, peachpuff)+        drawingR = lc peachpuff . fillNW darkcyan indigo+        g = force $ decompositions kingGraph !!2+        vp1 = rotatedVP (90@@deg) g+        vp2 = deformVP squeeze vp1+        squeeze = Deformation $ \p ->+                   ((p ^. _x) * (1 - (p ^. _y)/30)) ^& (p ^. _y) 

@@ -106,7 +106,7 @@ -} type Piece = HalfTile [V2 Double] -{-|This produces a list of vectors representing the two adjacent non-join tile directed edges of a piece starting from the origin.+{-|This produces a list of vectors representing the two non-join tile directed edges of a piece starting from the origin.  We consider left and right as viewed from the origin. This means that darts are reversed with respect to a view from the tail, but kites are@@ -296,7 +296,7 @@   drawWith = drawPatchWith where     -- turn a patch into a diagram using the first argument for drawing pieces.     -- drawPatchWith:: (Piece -> Diagram B) -> Patch -> Diagram B      -      drawPatchWith pd = position . fmap (viewLoc . mapLoc pd)+      drawPatchWith pd = position . map (viewLoc . mapLoc pd)  -- | the main default case for drawing using drawPiece. draw :: (Drawable a, OKBackend b) =>