module Geometry.Processes.Penrose
(
-- * Types
  Tile(..)
, TileType(..)
, twin
, flipTile

-- * Graphical representations
, asPolygon
, inscribedPentagons

-- * Recursive construction
, subdivide

-- * Penrose patterns

, phi
, alpha
-- ** Base tiles
, thinTileBase
, thickTileBase

-- ** Preconfigured tilings
, star1
, star2
, decagonRose
, asymmetricDecagon
) where

import Geometry
import Prelude  hiding (length)

-- | A rhombic Penrose tile. Strictly speaking, this is /half/ a tile,
-- because subdividing a full tile will result in half tiles protruding from
-- the original tile. Subdividing half a tile however will produce half tiles
-- that exactly cover the original tile. See 'subdivide'.
data Tile = Tile
    { Tile -> TileType
tileType :: TileType
    , Tile -> Vec2
tileP0 :: Vec2
    , Tile -> Vec2
tileP1 :: Vec2
    , Tile -> Vec2
tileP2 :: Vec2 }
    deriving (Int -> Tile -> ShowS
[Tile] -> ShowS
Tile -> String
(Int -> Tile -> ShowS)
-> (Tile -> String) -> ([Tile] -> ShowS) -> Show Tile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tile -> ShowS
showsPrec :: Int -> Tile -> ShowS
$cshow :: Tile -> String
show :: Tile -> String
$cshowList :: [Tile] -> ShowS
showList :: [Tile] -> ShowS
Show)

-- | Convert the half tile to a polygon. Note that this should be rendered as
-- an open polygon (i.e., don't use 'Graphics.Rendering.Cairo.closePath').
asPolygon :: Tile -> Polygon
asPolygon :: Tile -> Polygon
asPolygon Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} = [Vec2] -> Polygon
Polygon [Vec2
tileP0, Vec2
tileP1, Vec2
tileP2]

instance Transform Tile where
    transform :: Transformation -> Tile -> Tile
transform Transformation
t f :: Tile
f@Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} = Tile
f
        { tileP0 :: Vec2
tileP0 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform Transformation
t Vec2
tileP0
        , tileP1 :: Vec2
tileP1 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform Transformation
t Vec2
tileP1
        , tileP2 :: Vec2
tileP2 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform Transformation
t Vec2
tileP2 }

-- | There are two Penrose rhombs: A thick rhomb with an angle of 72°, and a
-- thin rhomb with an angle of 36°.
data TileType = Thin | Thick
    deriving (TileType -> TileType -> Bool
(TileType -> TileType -> Bool)
-> (TileType -> TileType -> Bool) -> Eq TileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TileType -> TileType -> Bool
== :: TileType -> TileType -> Bool
$c/= :: TileType -> TileType -> Bool
/= :: TileType -> TileType -> Bool
Eq, Int -> TileType -> ShowS
[TileType] -> ShowS
TileType -> String
(Int -> TileType -> ShowS)
-> (TileType -> String) -> ([TileType] -> ShowS) -> Show TileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TileType -> ShowS
showsPrec :: Int -> TileType -> ShowS
$cshow :: TileType -> String
show :: TileType -> String
$cshowList :: [TileType] -> ShowS
showList :: [TileType] -> ShowS
Show)

-- | Subdivide a Penrose tile into smaller tiles. While it's possible to
-- generate a Penrose tiling iteratively by adding more tiles to the side, the
-- possible configurations are non-local, i.e. adding a particular tile
-- somewhere can prevent adding tiles (while following the tiling rules)
-- somewhere else.
--
-- Constructing a Penrose tiling recursively via subdivision on the other hand
-- is much easier, and guarantees to have a tiling that adheres to the tiling
-- rules if you start with a correct tiling.
subdivide :: Tile -> [Tile]
subdivide :: Tile -> [Tile]
subdivide Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} = case TileType
tileType of
    TileType
Thin ->
        [ Tile
            { tileType :: TileType
tileType = TileType
Thick
            , tileP0 :: Vec2
tileP0 = Vec2
tileP0
            , tileP1 :: Vec2
tileP1 = Vec2
newPoint
            , tileP2 :: Vec2
tileP2 = Vec2
tileP1 }
        , Tile
            { tileType :: TileType
tileType = TileType
Thin
            , tileP0 :: Vec2
tileP0 = Vec2
tileP2
            , tileP1 :: Vec2
tileP1 = Vec2
tileP0
            , tileP2 :: Vec2
tileP2 = Vec2
newPoint } ]
      where
        newPoint :: Vec2
newPoint = Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP1)
    TileType
Thick ->
        [ Tile
            { tileType :: TileType
tileType = TileType
Thick
            , tileP0 :: Vec2
tileP0 = Vec2
newPoint2
            , tileP1 :: Vec2
tileP1 = Vec2
newPoint1
            , tileP2 :: Vec2
tileP2 = Vec2
tileP0 }
        , Tile
            { tileType :: TileType
tileType = TileType
Thin
            , tileP0 :: Vec2
tileP0 = Vec2
tileP1
            , tileP1 :: Vec2
tileP1 = Vec2
newPoint2
            , tileP2 :: Vec2
tileP2 = Vec2
newPoint1 }
        , Tile
            { tileType :: TileType
tileType = TileType
Thick
            , tileP0 :: Vec2
tileP0 = Vec2
tileP2
            , tileP1 :: Vec2
tileP1 = Vec2
newPoint2
            , tileP2 :: Vec2
tileP2 = Vec2
tileP1 } ]
      where
        newPoint1 :: Vec2
newPoint1 = Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP0)
        newPoint2 :: Vec2
newPoint2 = Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP0)

-- | The other half of a half tile.
twin :: Tile -> Tile
twin :: Tile -> Tile
twin f :: Tile
f@Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} = Tile
f { tileP1 :: Vec2
tileP1 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Line -> Transformation
mirrorAlong (Vec2 -> Vec2 -> Line
Line Vec2
tileP0 Vec2
tileP2)) Vec2
tileP1 }

-- | Flips a tile: Keeps the same shape, but reverses the orientation. Note
-- that flipping a tile in place will turn a legal configuration to an illegal
-- configuration.
flipTile :: [Tile] -> [Tile]
flipTile :: [Tile] -> [Tile]
flipTile = (Tile -> Tile) -> [Tile] -> [Tile]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tile -> Tile) -> [Tile] -> [Tile])
-> (Tile -> Tile) -> [Tile] -> [Tile]
forall a b. (a -> b) -> a -> b
$ \f :: Tile
f@Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} -> Tile
f { tileP0 :: Vec2
tileP0 = Vec2
tileP2, tileP2 :: Vec2
tileP2 = Vec2
tileP0 }

-- | A different graphical representation of a tile. The first-generation
-- Penrose tiling (P1) uses four shapes: Pentagon, Star, Boat, and Diamond.
--
-- Note that like 'asPolygon', the resulting polygons are open, so don't use
-- 'Graphics.Rendering.Cairo.closePath'.
inscribedPentagons :: Tile -> [Polygon]
inscribedPentagons :: Tile -> [Polygon]
inscribedPentagons f :: Tile
f@Tile{Vec2
TileType
tileType :: Tile -> TileType
tileP0 :: Tile -> Vec2
tileP1 :: Tile -> Vec2
tileP2 :: Tile -> Vec2
tileType :: TileType
tileP0 :: Vec2
tileP1 :: Vec2
tileP2 :: Vec2
..} = case TileType
tileType of
    TileType
Thin -> [[Vec2] -> Polygon
Polygon [Vec2
p0, Vec2
p1, Vec2
p2, Vec2
p3]]
      where
        center :: Vec2
center = Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
a Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP2)
        v0 :: Vec2
v0 = Vec2
p0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
center
        p0 :: Vec2
p0 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phi Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
center)
        p1 :: Vec2
p1 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate Angle
theta) Vec2
v0
        p2 :: Vec2
p2 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0
        p3 :: Vec2
p3 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
0.5 Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
3 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0)

    TileType
Thick -> [Polygon
pentagon1, Polygon
pentagon2]
      where
        pentagon1 :: Polygon
pentagon1 = [Vec2] -> Polygon
Polygon [Vec2
p0, Vec2
p1, Vec2
p2, Vec2
p3]
          where
            center :: Vec2
center = Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
a Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP2)
            v1 :: Vec2
v1 = Vec2
p1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
center
            p0 :: Vec2
p0 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
0.5 Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
v1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Angle -> Angle
forall v. VectorSpace v => v -> v
negateV Angle
theta)) Vec2
v1)
            p1 :: Vec2
p1 = Vec2
tileP2 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
a Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP2)
            p2 :: Vec2
p2 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate Angle
theta) Vec2
v1
            p3 :: Vec2
p3 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v1
        pentagon2 :: Polygon
pentagon2 = [Vec2] -> Polygon
Polygon [Vec2
p0, Vec2
p1, Vec2
p2, Vec2
p3]
          where
            center :: Vec2
center = Vec2
tileP1 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
a Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
tileP1)
            v0 :: Vec2
v0 = Vec2
p0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
center
            p0 :: Vec2
p0 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phi Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Vec2
tileP0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
-. Vec2
center)
            p1 :: Vec2
p1 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate Angle
theta) Vec2
v0
            p2 :: Vec2
p2 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0
            p3 :: Vec2
p3 = Vec2
center Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Double
0.5 Double -> Vec2 -> Vec2
forall v. VectorSpace v => Double -> v -> v
*. (Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0 Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
3 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
theta)) Vec2
v0)
  where
    a :: Double
a = Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phi
    theta :: Angle
theta = case Polygon -> PolygonOrientation
polygonOrientation (Tile -> Polygon
asPolygon Tile
f) of
        PolygonOrientation
PolygonPositive -> (-Double
2) Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha
        PolygonOrientation
PolygonNegative -> Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha

-- | The golden ratio. It occurs quite frequently in Penrose tilings, e.g. the
-- ratio between the long diagonal and the edge of a thick tile is 'phi'.
phi :: Double
phi :: Double
phi = (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double -> Double
forall a. Floating a => a -> a
sqrt Double
5)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2

-- | 36° is the base angle of Penrose tilings.
alpha :: Angle
alpha :: Angle
alpha = Double -> Angle
deg Double
36

-- | A thin tile with edge length 1 (two half tiles)
thinTileBase :: [Tile]
thinTileBase :: [Tile]
thinTileBase = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double -> Angle
rad (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
10))) [Tile
baseTile, Tile -> Tile
twin Tile
baseTile]
  where
    baseTile :: Tile
baseTile = Tile
        { tileType :: TileType
tileType = TileType
Thin
        , tileP0 :: Vec2
tileP0 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate ((-Double
0.5) Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) (Vec2 -> Vec2) -> Vec2 -> Vec2
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Vec2
Vec2 Double
1 Double
0
        , tileP1 :: Vec2
tileP1 = Double -> Double -> Vec2
Vec2 Double
0 Double
0
        , tileP2 :: Vec2
tileP2 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double
0.5 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) (Vec2 -> Vec2) -> Vec2 -> Vec2
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Vec2
Vec2 Double
1 Double
0
        }

-- | A thick tile with edge length 1 (two half tiles)
thickTileBase :: [Tile]
thickTileBase :: [Tile]
thickTileBase = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate (Double -> Angle
rad (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5))) [Tile
baseTile, Tile -> Tile
twin Tile
baseTile]
  where
    baseTile :: Tile
baseTile = Tile
        { tileType :: TileType
tileType = TileType
Thick
        , tileP0 :: Vec2
tileP0 = Double -> Double -> Vec2
Vec2 Double
phi Double
0
        , tileP1 :: Vec2
tileP1 = Transformation -> Vec2 -> Vec2
forall geo. Transform geo => Transformation -> geo -> geo
transform (Angle -> Transformation
rotate Angle
alpha) (Double -> Double -> Vec2
Vec2 Double
1 Double
0)
        , tileP2 :: Vec2
tileP2 = Double -> Double -> Vec2
Vec2 Double
0 Double
0
        }

-- | There are two star configurations, 'star1' and 'star2'. Depending on the
-- orientation of the thick tiles, the pattern grows differently.
star1 :: Vec2 -> Double -> [Tile]
star1 :: Vec2 -> Double -> [Tile]
star1 Vec2
center Double
r = do
    Angle
angle <- [Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
n Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha | Double
n <- [Double
0..Double
4]]
    let rotation :: Tile -> Tile
rotation = Transformation -> Tile -> Tile
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Angle -> Transformation
rotateAround Vec2
center Angle
angle)
        inner :: [Tile]
inner = [Tile] -> [Tile]
flipTile [Tile]
thickTileBase
    Tile
tile <- Vec2 -> Double -> [Tile] -> [Tile]
scaleTo Vec2
center Double
r [Tile]
inner
    Tile -> [Tile]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tile -> Tile
rotation Tile
tile)

-- | There are two star configurations, 'star1' and 'star2'. Depending on the
-- orientation of the thick tiles, the pattern grows differently.
--
-- 'star2' is the base for 'decagonRose'.
star2 :: Vec2 -> Double -> [Tile]
star2 :: Vec2 -> Double -> [Tile]
star2 Vec2
center Double
r = Vec2 -> Double -> [Tile] -> [Tile]
scaleTo Vec2
center Double
r ((Transformation -> Tile -> Tile
forall geo. Transform geo => Transformation -> geo -> geo
transform (Transformation -> Tile -> Tile)
-> (Double -> Transformation) -> Double -> Tile -> Tile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle -> Transformation
rotate (Angle -> Transformation)
-> (Double -> Angle) -> Double -> Transformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) (Double -> Tile -> Tile) -> [Double] -> [Tile -> Tile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0..Double
4]) [Tile -> Tile] -> [Tile] -> [Tile]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tile]
thickTileBase)

-- | A basic Penrose fragment consisting of a 'star2' and some thin tiles
-- around, forming a decagon.
decagonRose :: Vec2 -> Double -> [Tile]
decagonRose :: Vec2 -> Double -> [Tile]
decagonRose Vec2
center Double
r =
    let outer :: [Tile]
outer = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Angle -> Transformation
rotateAround (Double -> Double -> Vec2
Vec2 Double
1 Double
0) (Double
7 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) ([Tile] -> [Tile]
flipTile [Tile]
thinTileBase)
    in  Vec2 -> Double -> [Tile]
star2 Vec2
center Double
r [Tile] -> [Tile] -> [Tile]
forall a. [a] -> [a] -> [a]
++ ((Transformation -> Tile -> Tile
forall geo. Transform geo => Transformation -> geo -> geo
transform (Transformation -> Tile -> Tile)
-> (Double -> Transformation) -> Double -> Tile -> Tile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vec2 -> Angle -> Transformation
rotateAround Vec2
center (Angle -> Transformation)
-> (Double -> Angle) -> Double -> Transformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) (Double -> Tile -> Tile) -> [Double] -> [Tile -> Tile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0..Double
4]) [Tile -> Tile] -> [Tile] -> [Tile]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vec2 -> Double -> [Tile] -> [Tile]
scaleTo Vec2
center Double
r [Tile]
outer)

-- | Another Penrose fragment.
asymmetricDecagon :: Vec2 -> Double -> [Tile]
asymmetricDecagon :: Vec2 -> Double -> [Tile]
asymmetricDecagon Vec2
center Double
r = Vec2 -> Double -> [Tile] -> [Tile]
scaleTo Vec2
center Double
r ([Tile] -> [Tile]) -> [Tile] -> [Tile]
forall a b. (a -> b) -> a -> b
$ [[Tile]] -> [Tile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Tile]
offAxisTiles, Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform Transformation
mirrorYCoords  [Tile]
offAxisTiles, [Tile]
onAxisTiles ]
  where
    origin :: Vec2
origin = Double -> Double -> Vec2
Vec2 (-Double
phi) Double
0
    edge :: Vec2
edge = Double -> Double -> Vec2
Vec2 Double
1 Double
0
    f1 :: [Tile]
f1 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Transformation
translate Vec2
origin) ([Tile] -> [Tile]
flipTile [Tile]
thickTileBase)
    f2 :: [Tile]
f2 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Transformation
translate (Vec2
origin Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
edge) Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Angle -> Transformation
rotate Angle
alpha) ([Tile] -> [Tile]
flipTile [Tile]
thinTileBase)
    f3 :: [Tile]
f3 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Line -> Transformation
mirrorAlong (Vec2 -> Angle -> Double -> Line
angledLine Vec2
origin Angle
alpha Double
1)) [Tile]
f2
    f4 :: [Tile]
f4 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Transformation
translate (Vec2
origin Vec2 -> Vec2 -> Vec2
forall v. VectorSpace v => v -> v -> v
+. Vec2
edge) Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Angle -> Transformation
rotate (Angle -> Angle
forall v. VectorSpace v => v -> v
negateV Angle
alpha)) ([Tile] -> [Tile]
flipTile [Tile]
thickTileBase)
    f5 :: [Tile]
f5 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Transformation
translate Vec2
edge Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Angle -> Transformation
rotate (Double
2 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) [Tile]
thickTileBase
    f6 :: [Tile]
f6 = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Angle -> Transformation
rotateAround (Double -> Double -> Vec2
Vec2 Double
1 Double
0) (Double
7 Double -> Angle -> Angle
forall v. VectorSpace v => Double -> v -> v
*. Angle
alpha)) [Tile]
thinTileBase
    offAxisTiles :: [Tile]
offAxisTiles = [[Tile]] -> [Tile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Tile]
f1, [Tile]
f2, [Tile]
f3, [Tile]
f5]
    onAxisTiles :: [Tile]
onAxisTiles = [[Tile]] -> [Tile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Tile]
f4, [Tile]
f6]

scaleTo :: Vec2 -> Double -> [Tile] -> [Tile]
scaleTo :: Vec2 -> Double -> [Tile] -> [Tile]
scaleTo Vec2
center Double
size = Transformation -> [Tile] -> [Tile]
forall geo. Transform geo => Transformation -> geo -> geo
transform (Vec2 -> Transformation
translate Vec2
center Transformation -> Transformation -> Transformation
forall a. Semigroup a => a -> a -> a
<> Double -> Transformation
scale (Double
sizeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
phi))