diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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: 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.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 diff --git a/src/HalfTile.hs b/src/HalfTile.hs --- a/src/HalfTile.hs +++ b/src/HalfTile.hs @@ -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 diff --git a/src/Tgraph/Prelude.hs b/src/Tgraph/Prelude.hs --- a/src/Tgraph/Prelude.hs +++ b/src/Tgraph/Prelude.hs @@ -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 diff --git a/src/TgraphExamples.hs b/src/TgraphExamples.hs --- a/src/TgraphExamples.hs +++ b/src/TgraphExamples.hs @@ -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 diff --git a/src/TileLib.hs b/src/TileLib.hs --- a/src/TileLib.hs +++ b/src/TileLib.hs @@ -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 - - - - diff --git a/src/TileLibP3.hs b/src/TileLibP3.hs --- a/src/TileLibP3.hs +++ b/src/TileLibP3.hs @@ -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) -