PenroseKiteDart 1.9 → 1.10

raw patch · 7 files changed

+232/−160 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• PenroseKiteDart.cabal +1/−1
• src/HalfTile.hs +1/−1
• src/Tgraph/Prelude.hs +5/−5
• src/TgraphExamples.hs +37/−5
• src/TileLib.hs +121/−102
• src/TileLibP3.hs +48/−46

@@ -1,5 +1,24 @@ # Revision history for PenroseKiteDart ++## version 1.10++- Possibly breaking change:+  - Redefined Pieces 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.)+  - The same changes have been made to P3_Piece in TileLibP3 so P3_Patch will transform correctly.+  - tileRepP3 has been removed (use drawnEdgesP3)++The following no longer use angles in their definition: drawnEdges, drawnEdgesP3, decompPieceP3toP2, decompPieceP2toP3, compChoices, compNChoices++The following do rely on angles so will not work as expected after a transformation that does not preserve angles: wholeTileEdges, leftFillPieceDK.++- Other changes:+  Added joinVectorP3 to TileLibP3+  Added testVPTransform to TgraphExamples+ ## version 1.9  - Possibly breaking changes:

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           PenroseKiteDart-version:        1.9+version:        1.10 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

@@ -31,7 +31,7 @@ {-| Representing half tile pieces polymorphicly. The type parameter (rep) is specialised for graphs and vector representations of tilings. -For Pieces - rep is V2 Double+For Pieces - rep is [V2 Double] For TileFaces (in Tgraphs) rep is (Vertex,Vertex,Vertex) -} data HalfTile rep = LD rep -- ^ Left Dart

@@ -1179,11 +1179,11 @@ -- |converts a VPatch to a Patch, removing vertex information and converting faces to Located Pieces. dropLabels :: VPatch -> Patch dropLabels vp = map convert (faces vp) where-  locations = vLocs vp-  convert face = case (VMap.lookup (originV face) locations , VMap.lookup (oppV face) locations) of-    (Just p, Just p') -> fmap (const (p' .-. p)) face `at` p -- using HalfTile functor fmap-    _ -> error $ "dropLabels: Vertex location not found for some vertices:\n    "-                ++ show (faceVList face \\ VMap.keys locations)  ++ "\n"+   locations = vLocs vp+   convert face = case (VMap.lookup (originV face) locations , VMap.lookup (wingV face) locations, VMap.lookup (oppV face) locations) of +    (Just p, Just p', Just p'') -> fmap (const [p' .-. p, p'' .-. p']) face `at` p -- using HalfTile functor fmap+    _ -> error $ "dropLabels': Vertex location not found for some vertices:\n    "+                 ++ show (faceVList face \\ VMap.keys locations)  ++ "\n"   -- |Tgraphs are Drawable

@@ -86,11 +86,15 @@  , kingEmpiresFig  , kingEmpire1Fig  , kingEmpire2Fig-    -- *  Emplace Choices+    -- *  Emplace Extend Choices  , emplaceChoices  , emplaceChoicesFig+ , extendChoices+ , extendChoicesFig      -- * Example showing a P3 tiling  , testRhombus+      -- * Example showing a VPatch transform+ , testVPTransform    ) where @@ -133,7 +137,6 @@ labelAt p l d = baselineText l # fontSize (output 15) # moveTo p <> d --labelAt p l d = baselineText l # fontSize (normalized 0.02) # moveTo p <> d - fool, foolD, foolDminus:: Tgraph -- |fool: fool's kite - also called an ace. fool = makeTgraph [RK (5,2,7),LK (5,6,4),RK (5,4,3),LK (5,3,2),RD (1,2,3),LD (1,3,4)]@@ -421,9 +424,14 @@   -- |emplaceChoices forces then maximally composes. At this top level it--- produces a list of forced choices for each of the unknowns of this top level Tgraph.+-- 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.--- This version relies on compForce theorem and related theorems+-- 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+-- is to calculate a boundaryECovering or a boundaryVCovering after forcing.+-- See extendChoices and extendChoicesFig. emplaceChoices:: Tgraph -> [Forced Tgraph] emplaceChoices = emplaceChoicesF . forceF  where @@ -448,13 +456,27 @@         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+-- |Example showing emplaceChoices for foolD with foolD shown in red in each choice.+-- (See also extendChoicesFig.) emplaceChoicesFig :: OKBackend b => Diagram b emplaceChoicesFig =  lw thin $ hsep 1 $  overlayg <$> emplaceChoices g     where g = foolD           overlayg g' = smartAligning algmnt draw g # lc red <> 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 :: Tgraph -> [Forced Tgraph]+extendChoices g = withForced recoverGraph <$> boundaryECovering (forceF $ initFS g)++-- | An example of extendChoices applied to foolD+extendChoicesFig :: OKBackend b => Diagram b+extendChoicesFig = padBorder $ lw thin $ vsep 2 [hsep 3 (take 3 figs), hsep 3 (drop 3 figs)] where+   figs = map drawChoice $ extendChoices foolD+   drawChoice d = lc red (smartAligning (1,5) draw foolD) <> +                  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.@@ -464,4 +486,14 @@               ===               draw g # reflectY # lw veryThin       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+testVPTransform = +  padBorder $ lw thin $ +  hsep 1 [labelled drawj (shearY 1.2 vp), shearY 1.2 (labelled drawj vp)]+           where vp = makeVP foolD 

@@ -77,7 +77,7 @@   , sun6     -- * Example Diagrams of Patches   , sun6Fig-  , leftFilledSun6+  -- , leftFilledSun6 TO DO   , filledSun6     -- * Rotation and Scaling operations   , rotations@@ -94,30 +94,55 @@ import HalfTile  {-| Piece is a type for (scaled and oriented) tile halves: Left Dart, Right Dart, Left Kite, Right Kite-represented by a vector from their origin along the join edge where-origin for a dart is the tip, origin for a kite is the vertex opposite the vertex with+represented by a list of two vectors for the non-join edges (starting from the origin).+That is, the first vector is from the origin to the wing of the half-tile,+and the second vector is from the wing to the opp vertex, where+the origin for a dart is the tip, the origin for a kite is the vertex opposite the vertex with largest internal angle.  (This specialises polymorphic HalfTiles with 2D vectors).  Pieces are Transformable (but not translatable until they are located). -}-type Piece = HalfTile (V2 Double)+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.++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+in keeping with a common view (the kite tail being the origin).++So for right dart and left kite the edges are directed and ordered clockwise from the piece origin, and for left dart and right kite these are+directed and ordered anti-clockwise from the piece origin.+-}+drawnEdges:: Piece -> [V2 Double]+drawnEdges = tileRep+ -- | get the vector representing the join edge in the direction away from the origin of a piece joinVector:: Piece -> V2 Double-joinVector = tileRep+joinVector = sumV . drawnEdges  ldart,rdart,lkite,rkite:: Piece -- |ldart is a left dart at the origin with join edge oriented along the x axis, unit length.-ldart = LD unitX+ldart = ldartFromJoin unitX -- |rdart is a right dartat the origin with join edge oriented along the x axis, unit length.-rdart = RD unitX--- |lkite is a left kite at the origin with join edge oriented along the x axis, length phi.-lkite = LK (phi*^unitX)+rdart = rdartFromJoin unitX+-- |lkite  is a left kite at the origin with join edge oriented along the x axis, length phi.+lkite = lkiteFromJoin (phi*^unitX) -- |rkite  is a right kite at the origin with join edge oriented along the x axis, length phi.-rkite = RK (phi*^unitX)+rkite = rkiteFromJoin (phi*^unitX)    +-- not exported+ldartFromJoin, rdartFromJoin, lkiteFromJoin, rkiteFromJoin :: V2 Double -> Piece+-- |create an (untransformed) left dart from a given join vector+ldartFromJoin v = LD [v',v ^-^ v'] where v' = phi*^rotate (ttangle 9) v+-- |create an (untransformed) right dart from a given join vector+rdartFromJoin v = RD [v',v ^-^ v'] where v' = phi*^rotate (ttangle 1) v+-- |create an (untransformed) left kite from a given join vector+lkiteFromJoin v = LK [v',v ^-^ v'] where v' = rotate (ttangle 1) v+-- |create an (untransformed) right kite from a given join vector+rkiteFromJoin v = RK [v',v ^-^ v'] where v' = rotate (ttangle 9) v+ -- |All edge lengths are powers of the golden ratio (phi). -- We have the following roperties of the golden ratio  -- @@ -134,29 +159,7 @@ ttangle n = fromIntegral (n `mod` 10) *^tt              where tt = 1/10 @@ turn -{-|This produces a list of vectors representing the two adjacent 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-in keeping with a common view (the kite tail being the origin).--So for right dart and left kite the edges are directed and ordered clockwise from the piece origin, and for left dart and right kite these are-directed and ordered anti-clockwise from the piece origin.--}-drawnEdges:: Piece -> [V2 Double]-drawnEdges (LD v) = [v',v ^-^ v'] where v' = phi*^rotate (ttangle 9) v-drawnEdges (RD v) = [v',v ^-^ v'] where v' = phi*^rotate (ttangle 1) v-drawnEdges (RK v) = [v',v ^-^ v'] where v' = rotate (ttangle 9) v-drawnEdges (LK v) = [v',v ^-^ v'] where v' = rotate (ttangle 1) v---- |the 4 tile edges of a completed half-tile piece (used for colour fill).--- These are directed and ordered clockwise from the origin of the tile.-wholeTileEdges:: Piece -> [V2 Double]-wholeTileEdges (LD v) = wholeTileEdges (RD v)-wholeTileEdges (RD v) = drawnEdges (RD v) ++ map negated (reverse $ drawnEdges (LD v))-wholeTileEdges (LK v) = drawnEdges (LK v) ++ map negated (reverse $ drawnEdges (RK v))-wholeTileEdges (RK v) = wholeTileEdges (LK v)- {- $OKBackend  Note: Most functions for drawing will have constraint OKBackend b and result type Diagram b -}@@ -226,7 +229,7 @@ -- Note the order D K. -- Can be used with both Colour and AlphaColour fillOnlyPieceDK :: (OKBackend b, Color c1, Color c2) =>-                   c1 -> c2 -> HalfTile (V2 Double) -> Diagram b+                   c1 -> c2 -> Piece -> Diagram b fillOnlyPieceDK dcol kcol piece =      if isDart piece      then fillOnlyPiece dcol piece@@ -237,27 +240,31 @@ -- Note the order D K. -- Can be used with both Colour and AlphaColour fillPieceDK :: (OKBackend b, Color c1, Color c2) =>-               c1 -> c2 -> HalfTile (V2 Double) -> Diagram b+               c1 -> c2 -> Piece -> Diagram b fillPieceDK dcol kcol = drawPiece <> fillOnlyPieceDK dcol kcol-{- -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- -}+ -- |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).+-- N.B. This relies on untransformed angles, so will not work as expected after any transform+-- that does not preserve angles.  -- Works with AlphaColours as well as Colours. leftFillPieceDK :: (OKBackend b, Color c1, Color c2) =>-                   c1 -> c2 -> HalfTile (V2 Double) -> Diagram b+                   c1 -> c2 -> Piece -> Diagram b leftFillPieceDK dcol kcol pc =      case pc of (LD _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fillColor dcol                 (LK _) -> strokeLoop (glueLine $ fromOffsets $ wholeTileEdges pc)  # fillColor kcol                 _      -> mempty-        ++-- | The 4 tile edges of a completed half-tile piece (used for colour fill).+-- This relies on untransformed angles, so will not work as expected after any transform+-- that does not preserve angles. +wholeTileEdges:: Piece -> [V2 Double]+wholeTileEdges p@(LD _) = drawnEdges p ++ map negated (reverse $ drawnEdges $ rdartFromJoin $ joinVector p)+wholeTileEdges p@(RD _) = drawnEdges p ++ map negated (reverse $ drawnEdges $ ldartFromJoin $ joinVector p)+wholeTileEdges p@(LK _) = drawnEdges p ++ map negated (reverse $ drawnEdges $ rkiteFromJoin $ joinVector p)+wholeTileEdges p@(RK _) = drawnEdges p ++ map negated (reverse $ drawnEdges $ rkiteFromJoin $ joinVector p)+ -- |experiment uses a different rule for drawing half tiles. -- This clearly displays the larger kites and darts. -- Half tiles are first drawn with dashed lines, then certain edges are overlayed to emphasise them.@@ -268,14 +275,14 @@ experiment piece = emph piece <> (drawRoundPiece piece # dashingN [0.003,0.003] 0 # lw ultraThin)     --emph pc <> (drawRoundPiece pc # dashingO [1,2] 0 # lw ultraThin)   where emph pc = case pc of-          (LD v) -> (strokeLine . fromOffsets) [v] # lc red   -- emphasise join edge of darts in red-          (RD v) -> (strokeLine . fromOffsets) [v] # lc red -          (LK v) -> (strokeLine . fromOffsets) [rotate (ttangle 1) v] -- emphasise long edge for kites-          (RK v) -> (strokeLine . fromOffsets) [rotate (ttangle 9) v]-+          (LD _) -> (strokeLine . fromOffsets) [joinVector pc] # lc red   -- emphasise join edge of darts in red+          (RD _) -> (strokeLine . fromOffsets) [joinVector pc] # lc red +          (LK (v:_)) -> (strokeLine . fromOffsets) [v] -- emphasise long edge for kites+          (RK (v:_)) -> (strokeLine . fromOffsets) [v]+          other -> error $ "experiment: " ++ show other ++ "\n"  --- |A patch is a list of Located pieces (the point associated with each piece locates its originV)+-- |A patch is a list of Located pieces (the point associated with each piece locates its origin) -- Patches are Transformable (including translatable) type Patch = [Located Piece] @@ -346,7 +353,7 @@  {-| Decomposing splits each located piece in a patch into a list of smaller located pieces to create a refined patch.-(See also decompose in Tgraph.Decompose.hs for a more abstract version of this operation).+(See also decompose in Tgraph.Decompose for a more abstract version of this operation). -} decompPatch :: Patch -> Patch decompPatch = concatMap decompPiece@@ -354,63 +361,79 @@ -- |Decomposing a located piece to a list of (2 or 3) located pieces at smaller scale. decompPiece :: Located Piece -> [Located Piece] decompPiece lp = case viewLoc lp of-  (p, RD vd)-> [ LK vd  `at` p-               , RD vd' `at` (p .+^ v')-               ] where v'  = phi*^rotate (ttangle 1) vd-                       vd' = (2-phi) *^ negated v' -- (2-phi) = 1/phi^2-  (p, LD vd)-> [ RK vd `at` p-               , LD vd' `at` (p .+^ v')-               ]  where v'  = phi*^rotate (ttangle 9) vd-                        vd' = (2-phi) *^ negated v'  -- (2-phi) = 1/phi^2-  (p, RK vk)-> [ RD vd' `at` p-               , LK vk' `at` (p .+^ v')-               , RK vk' `at` (p .+^ v')-               ] where v'  = rotate (ttangle 9) vk-                       vd' = (2-phi) *^ v'  -- (2-phi) = 1/phi^2-                       vk' = ((phi-1) *^ vk) ^-^ v' -- (phi-1) = 1/phi-  (p, LK vk)-> [ LD vd' `at` p-               , RK vk' `at` (p .+^ v')-               , LK vk' `at` (p .+^ v')-               ] where v'  = rotate (ttangle 1) vk-                       vd' = (2-phi) *^ v'  -- (2-phi) = 1/phi^2-                       vk' = ((phi-1) *^ vk) ^-^ v' -- (phi-1) = 1/phi+  (p, RD [z1,z2])-> [ LK [s1, s2 ] `at` p+                    , RD [z2, negate s2] `at` (p .+^ z1)+                    ] +    where s1 = (phi-1) *^ z1+          s2 = sumV [z1,z2] ^-^ s1+  (p, LD [z1,z2])-> [ RK [s1, s2 ] `at` p+                    , LD [z2, negate s2] `at` (p .+^ z1)+                    ]+    where s1 = (phi-1) *^ z1+          s2 = sumV [z1,z2] ^-^ s1+  (p, RK [z1,z2])-> [ RD [s1, s2] `at` p+                    , LK [s4, negate s2] `at` (p .+^ z1)+                    , RK [z2, s3] `at` (p .+^ z1)+                    ]+    where j = sumV [z1,z2]+          s1 = (phi-1) *^ j+          s2 = (2-phi) *^ z1 ^-^ s1+          s3 = (phi-2) *^ j+          s4 = (1-phi) *^ z1+  (p, LK [z1,z2])-> [ LD [s1, s2] `at` p+                    , RK [s4, negate s2] `at` (p .+^ z1)+                    , LK [z2, s3] `at` (p .+^ z1)+                    ]+    where j = sumV [z1,z2]+          s1 = (phi-1) *^ j+          s2 = (2-phi) *^ z1 ^-^ s1+          s3 = (phi-2) *^ j+          s4 = (1-phi) *^ z1+  other -> error $ "decompPiece: " ++ show other ++ "/n" + -- |Create an infinite list of increasing decompositions of a patch decompositionsP:: Patch -> [Patch] decompositionsP = iterate decompPatch + {-| compChoices applied to  a single located piece produces a list of alternative located pieces NOT a Patch. Each of these is a larger scale single piece with a location such that when decomposed-the original piece in its original position is part of the decomposition)+the original piece in its original position is part of the decomposition).+Note that the result is not a Patch as the list represents alternatives. -} compChoices :: Located Piece -> [Located Piece] compChoices lp = case viewLoc lp of-  (p, RD vd)-> [ RD vd' `at` (p .+^ v')-               , RK vk  `at` p-               ] where v'  = (phi+1) *^ vd                  -- vd*phi^2-                       vd' = rotate (ttangle 9) (vd ^-^ v')-                       vk  = rotate (ttangle 1) v'-  (p, LD vd)-> [ LD vd' `at` (p .+^ v')-               , LK vk `at` p-               ] where v'  = (phi+1) *^ vd                  -- vd*phi^2-                       vd' = rotate (ttangle 1) (vd ^-^ v')-                       vk  = rotate (ttangle 9) v'-  (p, RK vk)-> [ LD vk  `at` p-               , LK lvk' `at` (p .+^ lv') -               , RK rvk' `at` (p .+^ rv')-               ] where lv'  = phi*^rotate (ttangle 9) vk-                       rv'  = phi*^rotate (ttangle 1) vk-                       rvk' = phi*^rotate (ttangle 7) vk-                       lvk' = phi*^rotate (ttangle 3) vk-  (p, LK vk)-> [ RD vk  `at` p-               , RK rvk' `at` (p .+^ rv')-               , LK lvk' `at` (p .+^ lv')-               ] where lv'  = phi*^rotate (ttangle 9) vk-                       rv'  = phi*^rotate (ttangle 1) vk-                       rvk' = phi*^rotate (ttangle 7) vk-                       lvk' = phi*^rotate (ttangle 3) vk+  (p, RD [s1,s2])-> [ RD [negate z1,s1] `at` (p .+^ z1)+                    , RK [z1, z2]  `at` p+                    ]+      where z1 = (phi+1) *^ sumV [s1,s2]+            z2 = phi *^ s1 ^-^ z1+  (p, LD [s1,s2])-> [ LD [negate z1,s1] `at` (p .+^ z1)+                    , LK [z1, z2]  `at` p+                    ] +      where z1 = (phi+1) *^ sumV [s1,s2]+            z2 = phi *^ s1 ^-^ z1+  (p, RK [s1,s2])-> [ LD [z1, z2]  `at` p+                    , LK [negate z1,z3] `at` (p .+^ z1) +                    , RK [negate z,s1] `at` (p .+^ z)+                    ]+      where z1 = phi *^ s1+            z  = s1 ^+^ (phi+1) *^ s2+            z2 = sumV [s1,s2] ^-^ z1+            z3 = z1 ^+^ phi *^ z2+  (p, LK [s1,s2])-> [ RD [z1, z2]  `at` p+                    , RK [negate z1,z3] `at` (p .+^ z1) +                    , LK [negate z,s1] `at` (p .+^ z)+                    ]+      where z1 = phi *^ s1+            z  = s1 ^+^ (phi+1) *^ s2+            z2 = sumV [s1,s2] ^-^ z1+            z3 = z1 ^+^ phi *^ z2+  other -> error $ "compChoices: " ++ show other ++ "/n" + -- |compNChoices n lp - gives a list of all the alternatives after n compChoices starting with lp -- Note that the result is not a Patch as the list represents alternatives. compNChoices :: Int -> Located Piece -> [Located Piece]@@ -451,11 +474,11 @@ sun6Fig :: OKBackend b => Diagram b sun6Fig = draw sun6 # lw thin -+{-  -- |Colour filled using leftFillPieceDK.  leftFilledSun6 :: OKBackend b => Diagram b leftFilledSun6 = drawWith (leftFillPieceDK red blue) sun6 # lw thin-+-} -- |Colour filled using fillDK. filledSun6 :: OKBackend b => Diagram b filledSun6 = fillDK darkmagenta indigo sun6 # lw thin # lc gold@@ -494,7 +517,3 @@ phiScaling:: (Transformable a, V a ~ V2, N a ~ Double) => Double -> [a] -> [a] phiScaling _ [] = [] phiScaling s (d:more) = scale s d: phiScaling (phi*s) more----

@@ -23,7 +23,9 @@   (    -- * P3_HalfTiles     P3_HalfTile(..)-  , tileRepP3+ -- , tileRepP3+  , joinVectorP3+  , drawnEdgesP3   -- * P3_Pieces   , P3_Piece   -- * Converting (located) Pieces@@ -34,7 +36,6 @@   , decompP2toP3   , decompP3toP2   -- * Drawing P3_Pieces-  --, drawnEdgesP3   , drawPieceP3   , drawjPieceP3   , drawJPieceP3@@ -94,13 +95,22 @@ instance Transformable a => Transformable (P3_HalfTile a) where     transform t = fmap (transform t) --- |A P3_Piece is a P3_Halftile with a vector along its join edge.--- The vector for a wide rhombus is on the long diagonal,--- and the vector for a narrow rhombus is along the short diagonal.+-- |A P3_Piece is a P3_Halftile with a list of two vectors for the drawn edges.+-- The join vector for a wide rhombus is on the long diagonal,+-- and the join vector for a narrow rhombus is along the short diagonal. -- The choice of which vertex is the origin is derived from conversions -- from Darts and Kites (P2 tilings) -type P3_Piece = P3_HalfTile (V2 Double)+type P3_Piece = P3_HalfTile [V2 Double] +-- |The drawn edges of a P3_Piece excluding the join edge (as a list of vectors)+-- starting from the origin.+drawnEdgesP3 :: P3_Piece -> [V2 Double]+drawnEdgesP3 = tileRepP3++-- |The join edge vector of a P3_Piece (from origin)+joinVectorP3 :: P3_Piece -> V2 Double+joinVectorP3 = sumV . drawnEdgesP3+ -- |Make P3_Halftile a Functor instance Functor P3_HalfTile where     fmap f (LW rep) = LW (f rep)@@ -120,16 +130,23 @@ -- (the join is toward the kite origin.) decompPieceP2toP3 :: Located Piece -> [Located P3_Piece] decompPieceP2toP3 lp = case viewLoc lp of-    (p, LK v) -> [ RW z `at` p-                 , RN ((2-phi)*^ negate v) `at` p.+^v-                 ] where z = rotate (ttangle 1) v-    (p, RK v) -> [ LW z `at` p-                 , LN ((2-phi)*^ negate v) `at` p.+^v-                 ]  where z = rotate (ttangle 9) v-    (p, LD v) -> [ RW (negate z) `at` p.+^ z]-                 where z = phi *^ rotate (ttangle 9) v-    (p, RD v) -> [ LW (negate z) `at` p.+^ z]-                 where z = phi *^ rotate (ttangle 1) v+    (p, LK [z1,z2]) -> [ RW [s1, s2] `at` p+                       , RN [negate z2, negate s2] `at` p.+^j+                       ]+        where j = sumV [z1,z2]+              s1 = (phi-1) *^ j+              s2 = z1 ^-^ s1+    (p, RK [z1,z2]) -> [ LW [s1, s2] `at` p+                       , LN [negate z2, negate s2] `at` p.+^j+                       ]+        where j = sumV [z1,z2]+              s1 = (phi-1) *^ j+              s2 = z1 ^-^ s1+    (p, LD [z1,z2]) -> [ RW [z2,s1] `at` p.+^ z1]+        where s1 = negate (sumV [z1,z2])+    (p, RD [z1,z2]) -> [ LW [z2,s1] `at` p.+^ z1]+        where s1 = negate (sumV [z1,z2])+    other -> error $ "decompPieceP2toP3: " ++ show other ++ "/n"  -- |Converting from P3 to P2 tilings. -- Half narrow rhombuses become half kites (LN->RK,RN->LK).@@ -140,21 +157,20 @@ -- The wide rhombus wing becomes both the kite opp and dart wing. decompPieceP3toP2 :: Located P3_Piece -> [Located Piece] decompPieceP3toP2 lp = case viewLoc lp of-    (p, LW v) -> -- decompPiece (RD (z^-^v) `at` p.+^v)-                 -- where z = (phi-1)*^rotate (ttangle 1) v-                 [ RD ((2-phi)*^v) `at` p-                 , LK (z^-^v) `at` (p.+^v)-                 ] where z = (phi-1)*^rotate (ttangle 1) v-    (p, RW v) -> --decompPiece (LD (z^-^v) `at` p.+^v)-                 --where z = (phi-1)*^rotate (ttangle 9) v-                 [ LD ((2-phi)*^v) `at` p-                 , RK (z^-^v) `at` (p.+^v)-                 ] where z = (phi-1)*^rotate (ttangle 9) v+    (p, LW [z1,z2]) -> +        [ RD [z1,s] `at` p+        , LK [ (1-phi)*^j, negate s] `at` (p.+^j)+        ] where j = sumV [z1,z2]+                s = (2-phi) *^ j ^-^ z1+    (p, RW [z1,z2]) -> +        [ LD [z1,s] `at` p+        , RK [ (1-phi)*^j, negate s] `at` (p.+^j)+        ] where j  = sumV [z1,z2]+                s = (2-phi) *^ j ^-^ z1+    (p, LN [z1,z2]) -> [ RK [negate z1, sumV [z1,z2]] `at` p .+^ z1]+    (p, RN [z1,z2]) -> [ LK [negate z1, sumV [z1,z2]] `at` p .+^ z1]+    other -> error $ "decompPieceP3toP2: " ++ show other ++ "/n" -    (p, LN v) -> [ RK (v^-^z) `at` p.+^ z]-                 where z = phi *^ rotate (ttangle 2) v-    (p, RN v) -> [ LK (v^-^z) `at` p.+^ z]-                 where z = phi *^ rotate (ttangle 8) v  -- | a P3_Patch is analagous to a Patch (but for for P3_Pieces) type P3_Patch =  [Located P3_Piece]@@ -169,21 +185,15 @@ decompP3toP2 :: P3_Patch -> Patch decompP3toP2 = concatMap decompPieceP3toP2 --- |The drawn edges of a P3_Piece excluding the join edge (as a list of vectors)-drawnEdgesP3 :: P3_Piece -> [V2 Double]-drawnEdgesP3 (LW v) = [z,v^-^z] where z = (phi-1)*^rotate (ttangle 1) v-drawnEdgesP3 (RW v) = [z,v^-^z] where z = (phi-1)*^rotate (ttangle 9) v-drawnEdgesP3 (LN v) = [z,v^-^z] where z = phi*^rotate (ttangle 2) v-drawnEdgesP3 (RN v) = [z,v^-^z] where z = phi*^rotate (ttangle 8) v - -- |Draws the two drawn edges of a P3_Piece drawPieceP3 :: OKBackend b => P3_Piece -> Diagram b drawPieceP3 = strokeLine . fromOffsets . drawnEdgesP3 + -- |Draw dashed join only of a P3_Piece.  dashJOnlyP3 :: OKBackend b => P3_Piece -> Diagram b-dashJOnlyP3 p = joinDashing (strokeLine $ fromOffsets [tileRepP3 p])+dashJOnlyP3 p = joinDashing (strokeLine $ fromOffsets [joinVectorP3 p])  -- |Draws all edges of a P3_Piece using a faint dashed line for the join edge -- (J for plain dashed Join, j for faint dashed join)@@ -220,13 +230,6 @@                cw -> cn -> P3_Piece -> Diagram b fillPieceWN cw cn = drawPieceP3 <> fillOnlyPieceWN cw cn -{- -fillPieceWN cw cn rp = drawPieceP3 rp <> filledpiece where-    filledpiece = case rp of-        (LW _ ) -> fillOnlyPieceP3 cw rp-        (RW _ ) -> fillOnlyPieceP3 cw rp-        _       -> fillOnlyPieceP3 cn rp--}  -- | A class for things that can be turned to diagrams when given a function to draw P3_Pieces. class P3_Drawable a where@@ -332,4 +335,3 @@ labelledP3 :: (OKBackend b, P3_DrawableLabelled a) =>             (P3_Patch -> Diagram b) -> a -> Diagram b labelledP3 = labelColourSizeP3 red small --(normalized 0.023)-