{-|
Module      : TileLib
Description : Introducing Pieces and Patches and Drawable class
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

This module introduces Pieces and Patches for drawing finite tilings using Penrose's Dart and Kite tiles.
It includes several primitives for drawing half tiles (Pieces), a class Drawable with instance Patch
and commonly used operations for the Drawable class (draw, drawj, fillDK,..).
There is also a decompose operation for Patches (decompPatch) and sun and star example Patches.
-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE FlexibleInstances         #-} -- needed for Drawable Patch
{-# LANGUAGE TypeOperators             #-} -- needed for type equality constraints ~

module TileLib 
  ( -- * Pieces
    Piece
  , joinVector
  , ldart
  , rdart
  , lkite
  , rkite
    -- * Drawing Pieces
  , Diagram2D
  , phi
  , ttangle
  , pieceEdges
  , wholeTileEdges
  , drawPiece
  , dashjPiece
  , dashjOnly
  , drawRoundPiece
  , drawJoin
  , fillOnlyPiece
  , fillPieceDK
  , fillMaybePieceDK
  , leftFillPieceDK
  , experiment
    -- * Patches and Drawable Class
  , Drawable(..)
  , Patch
  , draw
  , drawj
  , fillDK
  , fillKD
  , fillMaybeDK
  , colourDKG
  , colourMaybeDKG
    -- * Patch Decomposition and Compose choices
  , decompPatch
  , decompositionsP
  , compChoices
  , compNChoices
    -- * Example Patches
  , penta
  , sun
  , TileLib.star
  , suns
  , sun5
  , sun6
    -- * Diagrams of Patches
  , sun6Fig
  , leftFilledSun6
  , filledSun6
    -- * Rotation and Scaling operations
  , rotations
  , scales
  , phiScales
  , phiScaling
  ) where

import Diagrams.Prelude

import HalfTile

{-| Piece type for tile halves: Left Dart, Right Dart, Left Kite, Right Kite
with a vector from their origin along the join edge where
origin for a dart is the tip, origin for a kite is the vertex with smallest internal angle.
Using Imported polymorphic HalfTile.

Pieces are Transformable
-}
type Piece = HalfTile (V2 Double)

-- | get the vector representing the join edge in the direction away from the origin of a piece
joinVector:: Piece -> V2 Double
joinVector :: Piece -> V2 Double
joinVector = Piece -> V2 Double
forall rep. HalfTile rep -> rep
tileRep

-- |ldart,rdart,lkite,rkite are the 4 pieces (with join edge oriented along the x axis, unit length for darts, length phi for kites).
ldart,rdart,lkite,rkite:: Piece
ldart :: Piece
ldart = V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
rdart :: Piece
rdart = V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX
lkite :: Piece
lkite = V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK (Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX)
rkite :: Piece
rkite = V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK (Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX)

-- |All edge lengths are powers of the golden ratio (phi).
-- We also have the interesting property of the golden ratio that phi^2 == phi + 1 and so 1/phi = phi-1
-- (also phi^3 = 2phi +1 and 1/phi^2 = 2-phi)
phi::Double
phi :: Double
phi = (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Floating a => a -> a
sqrt Double
5.0) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2.0

-- |All angles used are multiples of tt where tt is a tenth of a turn
-- (so 36 degrees).
-- ttangle n is n multiples of tt.
ttangle:: Int -> Angle Double
ttangle :: Int -> Angle Double
ttangle Int
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10) Double -> Angle Double -> Angle Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double
forall {b}. Floating b => Angle b
tt
             where tt :: Angle b
tt = b
1b -> b -> b
forall a. Fractional a => a -> a -> a
/b
10 b -> AReview (Angle b) b -> Angle b
forall b a. b -> AReview a b -> a
@@ AReview (Angle b) b
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle b) b
turn

{-|  produces a list of the two adjacent non-join tile directed edges of a piece starting from the origin.

Perhaps confusingly we regard left and right of a dart differently from left and right of a kite.
This is in line with common sense view but darts are reversed from origin point of view.

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.
-}
pieceEdges:: Piece -> [V2 Double]
pieceEdges :: Piece -> [V2 Double]
pieceEdges (LD V2 Double
v) = [V2 Double
v',V2 Double
v V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v'] where v' :: V2 Double
v' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
v
pieceEdges (RD V2 Double
v) = [V2 Double
v',V2 Double
v V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v'] where v' :: V2 Double
v' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
v
pieceEdges (RK V2 Double
v) = [V2 Double
v',V2 Double
v V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v'] where v' :: V2 Double
v' = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
v
pieceEdges (LK V2 Double
v) = [V2 Double
v',V2 Double
v V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v'] where v' :: V2 Double
v' = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
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 :: Piece -> [V2 Double]
wholeTileEdges (LD V2 Double
v) = Piece -> [V2 Double]
wholeTileEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
v)
wholeTileEdges (RD V2 Double
v) = Piece -> [V2 Double]
pieceEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
v) [V2 Double] -> [V2 Double] -> [V2 Double]
forall a. [a] -> [a] -> [a]
++ (V2 Double -> V2 Double) -> [V2 Double] -> [V2 Double]
forall a b. (a -> b) -> [a] -> [b]
map V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated ([V2 Double] -> [V2 Double]
forall a. [a] -> [a]
reverse ([V2 Double] -> [V2 Double]) -> [V2 Double] -> [V2 Double]
forall a b. (a -> b) -> a -> b
$ Piece -> [V2 Double]
pieceEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
v))
wholeTileEdges (LK V2 Double
v) = Piece -> [V2 Double]
pieceEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
v) [V2 Double] -> [V2 Double] -> [V2 Double]
forall a. [a] -> [a] -> [a]
++ (V2 Double -> V2 Double) -> [V2 Double] -> [V2 Double]
forall a b. (a -> b) -> [a] -> [b]
map V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated ([V2 Double] -> [V2 Double]
forall a. [a] -> [a]
reverse ([V2 Double] -> [V2 Double]) -> [V2 Double] -> [V2 Double]
forall a b. (a -> b) -> a -> b
$ Piece -> [V2 Double]
pieceEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
v))
wholeTileEdges (RK V2 Double
v) = Piece -> [V2 Double]
wholeTileEdges (V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
v)


-- | Abbreviation for 2D diagrams for any Backend b.
type Diagram2D b = QDiagram b V2 Double Any


    
    
    
-- |drawing lines for the 2 non-join edges of a piece.
-- 
-- When a specific Backend B is in scope, drawPiece:: Piece -> Diagram B
drawPiece :: Renderable (Path V2 Double) b =>
             Piece -> Diagram2D b
drawPiece :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawPiece = Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> (Piece -> Trail' Line V2 Double)
-> Piece
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([V2 Double] -> Trail' Line V2 Double)
-> (Piece -> [V2 Double]) -> Piece -> Trail' Line V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> [V2 Double]
pieceEdges

-- |same as drawPiece but with join edge added as dashed-line.
-- 
-- When a specific Backend B is in scope, dashjPiece:: Piece -> Diagram B
dashjPiece :: Renderable (Path V2 Double) b =>
              Piece -> Diagram2D b
dashjPiece :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
dashjPiece Piece
piece = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawPiece Piece
piece Diagram2D b -> Diagram2D b -> Diagram2D b
forall a. Semigroup a => a -> a -> a
<> Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
dashjOnly Piece
piece


-- |draw join edge only (as dashed line).
-- 
-- When a specific Backend B is in scope, dashjOnly:: Piece -> Diagram B
dashjOnly :: Renderable (Path V2 Double) b =>
             Piece -> Diagram2D b
dashjOnly :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
dashjOnly Piece
piece = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawJoin Piece
piece Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# [Double] -> Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingN [Double
0.003,Double
0.003] Double
0 Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin -- # lc grey 

-- |same as drawPiece but with added join edge (also fillable as a loop).
-- 
-- When a specific Backend B is in scope, drawRoundPiece:: Piece -> Diagram B
drawRoundPiece :: Renderable (Path V2 Double) b =>
                  Piece -> Diagram2D b
drawRoundPiece :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawRoundPiece = Trail' Loop V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop (Trail' Loop V2 Double -> QDiagram b V2 Double Any)
-> (Piece -> Trail' Loop V2 Double)
-> Piece
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trail' Line V2 Double -> Trail' Loop V2 Double
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (Trail' Line V2 Double -> Trail' Loop V2 Double)
-> (Piece -> Trail' Line V2 Double)
-> Piece
-> Trail' Loop V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([V2 Double] -> Trail' Line V2 Double)
-> (Piece -> [V2 Double]) -> Piece -> Trail' Line V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Piece -> [V2 Double]
pieceEdges

-- |draw join edge only.
-- 
-- When a specific Backend B is in scope, drawJoin:: Piece -> Diagram B
drawJoin :: Renderable (Path V2 Double) b =>
            Piece -> Diagram2D b
drawJoin :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawJoin Piece
piece = Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> Trail' Line V2 Double -> QDiagram b V2 Double Any
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets [Piece -> V2 Double
joinVector Piece
piece]

-- |fillOnlyPiece col piece - fills piece with colour col without drawing any lines.
-- 
-- When a specific Backend B is in scope, fillOnlyPiece:: Colour Double -> Piece -> Diagram B
fillOnlyPiece :: Renderable (Path V2 Double) b =>
                 Colour Double -> Piece -> Diagram2D b
fillOnlyPiece :: forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Piece -> Diagram2D b
fillOnlyPiece Colour Double
col Piece
piece  = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawRoundPiece Piece
piece Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Colour Double -> Diagram2D b -> Diagram2D b
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
col Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
none

-- |fillPieceDK dcol kcol piece - draws and fills the half-tile piece
-- with colour dcol for darts and kcol for kites.
-- Note the order D K.
-- 
-- When a specific Backend B is in scope, fillPieceDK:: Colour Double -> Colour Double -> Piece -> Diagram B
fillPieceDK :: Renderable (Path V2 Double) b =>
               Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram2D b
fillPieceDK :: forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Colour Double -> Piece -> Diagram2D b
fillPieceDK Colour Double
dcol Colour Double
kcol Piece
piece = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawPiece Piece
piece Diagram2D b -> Diagram2D b -> Diagram2D b
forall a. Semigroup a => a -> a -> a
<> Colour Double -> Piece -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Piece -> Diagram2D b
fillOnlyPiece Colour Double
col Piece
piece where
    col :: Colour Double
col = case Piece
piece of (LD V2 Double
_) -> Colour Double
dcol
                        (RD V2 Double
_) -> Colour Double
dcol
                        (LK V2 Double
_) -> Colour Double
kcol
                        (RK V2 Double
_) -> Colour Double
kcol

-- |fillMaybePieceDK d k piece - draws the half-tile piece and possibly fills as well:
-- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol
-- Nothing indicates no fill for either darts or kites or both.
-- 
-- When a specific Backend B is in scope, fillMaybePieceDK:: Maybe (Colour Double) -> Maybe (Colour Double) -> Piece -> Diagram B
fillMaybePieceDK :: Renderable (Path V2 Double) b =>
                    Maybe (Colour Double) -> Maybe (Colour Double) -> Piece -> Diagram2D b
fillMaybePieceDK :: forall b.
Renderable (Path V2 Double) b =>
Maybe (Colour Double)
-> Maybe (Colour Double) -> Piece -> Diagram2D b
fillMaybePieceDK Maybe (Colour Double)
d Maybe (Colour Double)
k Piece
piece = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawPiece Piece
piece Diagram2D b -> Diagram2D b -> Diagram2D b
forall a. Semigroup a => a -> a -> a
<> Diagram2D b
filler where
    maybeFill :: Maybe (Colour Double) -> Diagram2D b
maybeFill (Just Colour Double
c) = Colour Double -> Piece -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Piece -> Diagram2D b
fillOnlyPiece Colour Double
c Piece
piece
    maybeFill  Maybe (Colour Double)
Nothing = Diagram2D b
forall a. Monoid a => a
mempty
    filler :: Diagram2D b
filler = case Piece
piece of (LD V2 Double
_) -> Maybe (Colour Double) -> Diagram2D b
maybeFill Maybe (Colour Double)
d
                           (RD V2 Double
_) -> Maybe (Colour Double) -> Diagram2D b
maybeFill Maybe (Colour Double)
d
                           (LK V2 Double
_) -> Maybe (Colour Double) -> Diagram2D b
maybeFill Maybe (Colour Double)
k
                           (RK V2 Double
_) -> Maybe (Colour Double) -> Diagram2D b
maybeFill Maybe (Colour Double)
k


-- |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).
-- 
-- When a specific Backend B is in scope, leftFillPieceDK:: Colour Double -> Colour Double -> Piece -> Diagram B
leftFillPieceDK :: Renderable (Path V2 Double) b =>
                   Colour Double -> Colour Double -> HalfTile (V2 Double) -> Diagram2D b
leftFillPieceDK :: forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Colour Double -> Piece -> Diagram2D b
leftFillPieceDK Colour Double
dcol Colour Double
kcol Piece
pc =
     case Piece
pc of (LD V2 Double
_) -> Trail' Loop V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop (Trail' Line V2 Double -> Trail' Loop V2 Double
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Trail' Line V2 Double -> Trail' Loop V2 Double)
-> Trail' Line V2 Double -> Trail' Loop V2 Double
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double)
-> [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
forall a b. (a -> b) -> a -> b
$ Piece -> [V2 Double]
wholeTileEdges Piece
pc)  QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Colour Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
dcol
                (LK V2 Double
_) -> Trail' Loop V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop (Trail' Line V2 Double -> Trail' Loop V2 Double
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Loop v n
glueLine (Trail' Line V2 Double -> Trail' Loop V2 Double)
-> Trail' Line V2 Double -> Trail' Loop V2 Double
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double)
-> [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
forall a b. (a -> b) -> a -> b
$ Piece -> [V2 Double]
wholeTileEdges Piece
pc)  QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Colour Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Floating n, Typeable n, HasStyle a) =>
Colour Double -> a -> a
fc Colour Double
kcol
                Piece
_      -> QDiagram b V2 Double Any
forall a. Monoid a => a
mempty
        
-- |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.
-- Half darts have the join edge emphasised in red, while
-- Half kites have the long edge emphasised in black.
-- 
-- When a specific Backend B is in scope, experiment:: Piece -> Diagram B
experiment:: Renderable (Path V2 Double) b =>
             Piece ->  Diagram2D b
experiment :: forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
experiment Piece
piece = Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
emph Piece
piece Diagram2D b -> Diagram2D b -> Diagram2D b
forall a. Semigroup a => a -> a -> a
<> (Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawRoundPiece Piece
piece Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# [Double] -> Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n, Num n) =>
[n] -> n -> a -> a
dashingN [Double
0.003,Double
0.003] Double
0 Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
ultraThin)
    --emph pc <> (drawRoundPiece pc # dashingO [1,2] 0 # lw ultraThin)
  where emph :: Piece -> QDiagram b V2 Double Any
emph Piece
pc = case Piece
pc of
          (LD V2 Double
v) -> (Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> ([V2 Double] -> Trail' Line V2 Double)
-> [V2 Double]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets) [V2 Double
v] QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Colour Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
red   -- emphasise join edge of darts in red
          (RD V2 Double
v) -> (Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> ([V2 Double] -> Trail' Line V2 Double)
-> [V2 Double]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets) [V2 Double
v] QDiagram b V2 Double Any
-> (QDiagram b V2 Double Any -> QDiagram b V2 Double Any)
-> QDiagram b V2 Double Any
forall a b. a -> (a -> b) -> b
# Colour Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
red 
          (LK V2 Double
v) -> (Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> ([V2 Double] -> Trail' Line V2 Double)
-> [V2 Double]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets) [Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
v] -- emphasise long edge for kites
          (RK V2 Double
v) -> (Trail' Line V2 Double -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine (Trail' Line V2 Double -> QDiagram b V2 Double Any)
-> ([V2 Double] -> Trail' Line V2 Double)
-> [V2 Double]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vn (Trail' Line V2 Double)] -> Trail' Line V2 Double
[V2 Double] -> Trail' Line V2 Double
forall t. TrailLike t => [Vn t] -> t
fromOffsets) [Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
v]



-- |A patch is a list of Located pieces (the point associated with each piece locates its originV)
-- Patches are Transformable
type Patch = [Located Piece]

-- | A class for things that can be turned to diagrams when given a function to draw pieces.
class Drawable a where
-- When a specific Backend B is in scope,  drawWith :: Drawable a => (Piece -> Diagram B) -> a -> Diagram B
  drawWith :: Renderable (Path V2 Double) b =>
              (Piece ->  Diagram2D b) -> a ->  Diagram2D b

-- | Patches are drawable
instance Drawable Patch where
  drawWith :: forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> Patch -> Diagram2D b
drawWith = (Piece -> Diagram2D b) -> Patch -> Diagram2D b
forall {a} {c}.
(V a ~ V c, N a ~ N c, Additive (V c), Num (N c), HasOrigin c,
 Monoid c) =>
(a -> c) -> [Located a] -> c
drawPatchWith where
    -- turn a patch into a diagram using the first argument for drawing pieces.
    -- drawPatchWith:: (Piece -> Diagram B) -> Patch -> Diagram B      
      drawPatchWith :: (a -> c) -> [Located a] -> c
drawPatchWith a -> c
pd = [(Point (V c) (N c), c)] -> c
forall (v :: * -> *) n a.
(InSpace v n a, HasOrigin a, Monoid' a) =>
[(Point v n, a)] -> a
position ([(Point (V c) (N c), c)] -> c)
-> ([Located a] -> [(Point (V c) (N c), c)]) -> [Located a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located a -> (Point (V c) (N c), c))
-> [Located a] -> [(Point (V c) (N c), c)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Located c -> (Point (V c) (N c), c)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc (Located c -> (Point (V c) (N c), c))
-> (Located a -> Located c) -> Located a -> (Point (V c) (N c), c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> c) -> Located a -> Located c
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc a -> c
pd)

-- | the main default case for drawing using drawPiece.
-- 
-- When a specific Backend B is in scope, draw :: Drawable a => a -> Diagram B
draw :: (Drawable a, Renderable (Path V2 Double) b) =>
        a -> Diagram2D b
draw :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
a -> Diagram2D b
draw = (Piece -> Diagram2D b) -> a -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
drawPiece

-- | alternative default case for drawing adding dashed lines for join edges.
-- 
-- When a specific Backend B is in scope, drawj :: Drawable a => a -> Diagram B
drawj :: (Drawable a, Renderable (Path V2 Double) b) =>
         a -> Diagram2D b
drawj :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
a -> Diagram2D b
drawj = (Piece -> Diagram2D b) -> a -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith Piece -> Diagram2D b
forall b. Renderable (Path V2 Double) b => Piece -> Diagram2D b
dashjPiece

fillDK, fillKD :: (Drawable a, Renderable (Path V2 Double) b) =>
                   Colour Double -> Colour Double -> a -> Diagram2D b
-- |fillDK dcol kcol a - draws and fills a with colour dcol for darts and kcol for kites.
-- Note the order D K.
-- 
-- When a specific Backend B is in scope, fillDK:: Drawable a => Colour Double -> Colour Double -> a -> Diagram B
fillDK :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Colour Double -> Colour Double -> a -> Diagram2D b
fillDK Colour Double
c1 Colour Double
c2 = (Piece -> Diagram2D b) -> a -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith (Colour Double -> Colour Double -> Piece -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Colour Double -> Piece -> Diagram2D b
fillPieceDK Colour Double
c1 Colour Double
c2)

-- |fillKD kcol dcol a - draws and fills a with colour kcol for kites and dcol for darts.
-- Note the order K D.
-- 
-- When a specific Backend B is in scope, fillKD:: Drawable a => Colour Double -> Colour Double -> a -> Diagram B
fillKD :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Colour Double -> Colour Double -> a -> Diagram2D b
fillKD Colour Double
c1 Colour Double
c2 = Colour Double -> Colour Double -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Colour Double -> Colour Double -> a -> Diagram2D b
fillDK Colour Double
c2 Colour Double
c1
    
-- |fillMaybeDK c1 c2 a - draws a and maybe fills as well:
-- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol
-- Nothing indicates no fill for either darts or kites or both
-- Note the order D K.
-- 
-- When a specific Backend B is in scope, fillMaybeDK:: Drawable a => Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram B
fillMaybeDK :: (Drawable a, Renderable (Path V2 Double) b) =>
               Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram2D b
fillMaybeDK :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram2D b
fillMaybeDK Maybe (Colour Double)
c1 Maybe (Colour Double)
c2 = (Piece -> Diagram2D b) -> a -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith (Maybe (Colour Double)
-> Maybe (Colour Double) -> Piece -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
Maybe (Colour Double)
-> Maybe (Colour Double) -> Piece -> Diagram2D b
fillMaybePieceDK Maybe (Colour Double)
c1 Maybe (Colour Double)
c2)

-- |colourDKG (c1,c2,c3) p - fill in a drawable with colour c1 for darts, colour c2 for kites and
-- colour c3 for grout (that is, the non-join edges).
-- Note the order D K G.
-- 
-- When a specific Backend B is in scope, colourDKG::  Drawable a => (Colour Double,Colour Double,Colour Double) -> a -> Diagram B
colourDKG :: (Drawable a, Renderable (Path V2 Double) b) =>
             (Colour Double,Colour Double,Colour Double) -> a -> Diagram2D b
colourDKG :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Colour Double, Colour Double, Colour Double) -> a -> Diagram2D b
colourDKG (Colour Double
c1,Colour Double
c2,Colour Double
c3) a
a = Colour Double -> Colour Double -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Colour Double -> Colour Double -> a -> Diagram2D b
fillDK Colour Double
c1 Colour Double
c2 a
a Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Colour Double -> Diagram2D b -> Diagram2D b
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c3

-- |colourMaybeDKG (d,k,g) a - draws a and possibly fills as well:
-- darts with dcol if d = Just dcol, kites with kcol if k = Just kcol
-- Nothing indicates no fill for either darts or kites or both
-- The g argument is for grout - i.e the non-join edges round tiles.
-- Edges are drawn with gcol if g  = Just gcol and not drawn if g = Nothing.
-- 
-- When a specific Backend B is in scope, colourMaybeDKG:: Drawable a => (Maybe (Colour Double),  Maybe (Colour Double), Maybe (Colour Double)) -> a -> Diagram B
colourMaybeDKG:: (Drawable a, Renderable (Path V2 Double) b) =>
                 (Maybe (Colour Double),  Maybe (Colour Double), Maybe (Colour Double)) -> a -> Diagram2D b
colourMaybeDKG :: forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Maybe (Colour Double), Maybe (Colour Double),
 Maybe (Colour Double))
-> a -> Diagram2D b
colourMaybeDKG (Maybe (Colour Double)
d,Maybe (Colour Double)
k,Maybe (Colour Double)
g) a
a = Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Maybe (Colour Double) -> Maybe (Colour Double) -> a -> Diagram2D b
fillMaybeDK Maybe (Colour Double)
d Maybe (Colour Double)
k a
a Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Maybe (Colour Double) -> Diagram2D b -> Diagram2D b
forall {a}.
(V a ~ V2, Typeable (N a), Floating (N a), HasStyle a,
 Ord (N a)) =>
Maybe (Colour Double) -> a -> a
maybeGrout Maybe (Colour Double)
g where
    maybeGrout :: Maybe (Colour Double) -> a -> a
maybeGrout (Just Colour Double
c) = Colour Double -> a -> a
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c
    maybeGrout Maybe (Colour Double)
Nothing = Measure (N a) -> a -> a
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure (N a)
forall n. OrderedField n => Measure n
none



{-|
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).
-}
decompPatch :: Patch -> Patch
decompPatch :: Patch -> Patch
decompPatch = (Located Piece -> Patch) -> Patch -> Patch
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Located Piece -> Patch
decompPiece

-- |Decomposing a located piece to a list of (2 or 3) located pieces at smaller scale.
decompPiece :: Located Piece -> [Located Piece]
decompPiece :: Located Piece -> Patch
decompPiece Located Piece
lp = case Located Piece -> (Point (V Piece) (N Piece), Piece)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located Piece
lp of
  (Point (V Piece) (N Piece)
p, RD V2 Double
vd)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
vd  Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               ] where v' :: V2 Double
v'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
vd
                       vd' :: V2 Double
vd' = (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
phi) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V2 Double
v' -- (2-phi) = 1/phi^2
  (Point (V Piece) (N Piece)
p, LD V2 Double
vd)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
vd Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               ]  where v' :: V2 Double
v'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
vd
                        vd' :: V2 Double
vd' = (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
phi) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated V2 Double
v'  -- (2-phi) = 1/phi^2
  (Point (V Piece) (N Piece)
p, RK V2 Double
vk)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
vk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
vk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               ] where v' :: V2 Double
v'  = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
vk
                       vd' :: V2 Double
vd' = (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
phi) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
v'  -- (2-phi) = 1/phi^2
                       vk' :: V2 Double
vk' = ((Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
vk) V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v' -- (phi-1) = 1/phi
  (Point (V Piece) (N Piece)
p, LK V2 Double
vk)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
vk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
vk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               ] where v' :: V2 Double
v'  = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
vk
                       vd' :: V2 Double
vd' = (Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
phi) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
v'  -- (2-phi) = 1/phi^2
                       vk' :: V2 Double
vk' = ((Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
vk) V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v' -- (phi-1) = 1/phi

-- |Create an infinite list of increasing decompositions of a patch
decompositionsP:: Patch -> [Patch]
decompositionsP :: Patch -> [Patch]
decompositionsP = (Patch -> Patch) -> Patch -> [Patch]
forall a. (a -> a) -> a -> [a]
iterate Patch -> Patch
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)
-}
compChoices :: Located Piece -> [Located Piece]
compChoices :: Located Piece -> Patch
compChoices Located Piece
lp = case Located Piece -> (Point (V Piece) (N Piece), Piece)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located Piece
lp of
  (Point (V Piece) (N Piece)
p, RD V2 Double
vd)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
vk  Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               ] where v' :: V2 Double
v'  = (Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
vd                  -- vd*phi^2
                       vd' :: V2 Double
vd' = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) (V2 Double
vd V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v')
                       vk :: V2 Double
vk  = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
v'
  (Point (V Piece) (N Piece)
p, LD V2 Double
vd)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
vd' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
v')
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
vk Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               ] where v' :: V2 Double
v'  = (Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1) Double -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ V2 Double
vd                  -- vd*phi^2
                       vd' :: V2 Double
vd' = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) (V2 Double
vd V2 Double -> V2 Double -> V2 Double
forall a. Num a => V2 a -> V2 a -> V2 a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ V2 Double
v')
                       vk :: V2 Double
vk  = Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
v'
  (Point (V Piece) (N Piece)
p, RK V2 Double
vk)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD V2 Double
vk  Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
lvk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
lv') 
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
rvk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
rv')
               ] where lv' :: V2 Double
lv'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
vk
                       rv' :: V2 Double
rv'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
vk
                       rvk' :: V2 Double
rvk' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
7) V2 Double
vk
                       lvk' :: V2 Double
lvk' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
3) V2 Double
vk
  (Point (V Piece) (N Piece)
p, LK V2 Double
vk)-> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD V2 Double
vk  Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
p
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK V2 Double
rvk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
rv')
               , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK V2 Double
lvk' Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V Piece) (N Piece)
Point V2 Double
p Point V2 Double -> Diff (Point V2) Double -> Point V2 Double
forall a. Num a => Point V2 a -> Diff (Point V2) a -> Point V2 a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Double
Diff (Point V2) Double
lv')
               ] where lv' :: V2 Double
lv'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
9) V2 Double
vk
                       rv' :: V2 Double
rv'  = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
1) V2 Double
vk
                       rvk' :: V2 Double
rvk' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
7) V2 Double
vk
                       lvk' :: V2 Double
lvk' = Double
phiDouble -> V2 Double -> V2 Double
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
3) V2 Double
vk

-- |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]
compNChoices :: Int -> Located Piece -> Patch
compNChoices Int
0 Located Piece
lp = [Located Piece
lp]
compNChoices Int
n Located Piece
lp = do
    Located Piece
lp' <- Located Piece -> Patch
compChoices Located Piece
lp
    Int -> Located Piece -> Patch
compNChoices (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Located Piece
lp'


                                
-- |combine 5 copies of a patch (each rotated by ttangle 2 successively)
-- (ttAngle 2 is 72 degrees) 
-- Must be used with care to avoid creating a nonsense patch
penta:: Patch -> Patch
penta :: Patch -> Patch
penta Patch
p = (Int -> Patch) -> [Int] -> Patch
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> Patch
copy [Int
0..Int
4] 
            where copy :: Int -> Patch
copy Int
n = Angle Double -> Patch -> Patch
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)) Patch
p
  
sun,star::Patch         
-- |sun is a patch with five kites sharing common origin (base of kite)
sun :: Patch
sun =  Patch -> Patch
penta [Piece
rkite Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin, Piece
lkite Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin]
-- |star is a patch with five darts sharing common origin (tip of dart)
star :: Patch
star = Patch -> Patch
penta [Piece
rdart Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin, Piece
ldart Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin]


-- |An infinite list of patches of increasingly decomposed sun
suns::[Patch]
suns :: [Patch]
suns = Patch -> [Patch]
decompositionsP Patch
sun
sun5,sun6:: Patch
-- |a patch of a 6 times decomposed sun
sun6 :: Patch
sun6 = [Patch]
suns[Patch] -> Int -> Patch
forall a. HasCallStack => [a] -> Int -> a
!!Int
6
-- |a patch of a 5 times decomposed sun
sun5 :: Patch
sun5 = [Patch]
suns[Patch] -> Int -> Patch
forall a. HasCallStack => [a] -> Int -> a
!!Int
5 


   -- * Diagrams of Patches

-- |diagram for sun6.
-- 
-- When a specific Backend B is in scope, sun6Fig::Diagram B
sun6Fig :: Renderable (Path V2 Double) b => Diagram2D b
sun6Fig :: forall b. Renderable (Path V2 Double) b => Diagram2D b
sun6Fig = Patch -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
a -> Diagram2D b
draw Patch
sun6 Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin


-- |Colour filled using leftFillPieceDK. 
-- 
-- When a specific Backend B is in scope, leftFilledSun6::Diagram B
leftFilledSun6 :: Renderable (Path V2 Double) b => Diagram2D b
leftFilledSun6 :: forall b. Renderable (Path V2 Double) b => Diagram2D b
leftFilledSun6 = (Piece -> Diagram2D b) -> Patch -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> Patch -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith (Colour Double -> Colour Double -> Piece -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
Colour Double -> Colour Double -> Piece -> Diagram2D b
leftFillPieceDK Colour Double
forall a. (Ord a, Floating a) => Colour a
red Colour Double
forall a. (Ord a, Floating a) => Colour a
blue) Patch
sun6 Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin

-- |Colour filled using fillDK.
-- 
-- When a specific Backend B is in scope, filledSun6::Diagram B
filledSun6 :: Renderable (Path V2 Double) b => Diagram2D b
filledSun6 :: forall b. Renderable (Path V2 Double) b => Diagram2D b
filledSun6 = Colour Double -> Colour Double -> Patch -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
Colour Double -> Colour Double -> a -> Diagram2D b
fillDK Colour Double
forall a. (Ord a, Floating a) => Colour a
darkmagenta Colour Double
forall a. (Ord a, Floating a) => Colour a
indigo Patch
sun6 Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Measure Double -> Diagram2D b -> Diagram2D b
forall a n.
(N a ~ n, HasStyle a, Typeable n) =>
Measure n -> a -> a
lw Measure Double
forall n. OrderedField n => Measure n
thin Diagram2D b -> (Diagram2D b -> Diagram2D b) -> Diagram2D b
forall a b. a -> (a -> b) -> b
# Colour Double -> Diagram2D b -> Diagram2D b
forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
forall a. (Ord a, Floating a) => Colour a
gold




-- |rotations takes a list of integers (representing ttangles) for respective rotations of items in the second list (things to be rotated).
-- This includes Diagrams, Patches, VPatches.
-- The integer list can be shorter than the list of items - the remaining items are left unrotated.
-- It will raise an error if the integer list is longer than the list of items to be rotated.
-- (Rotations by an angle are anti-clockwise)

rotations :: (Transformable a, V a ~ V2, N a ~ Double) => [Int] -> [a] -> [a]
rotations :: forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Int] -> [a] -> [a]
rotations (Int
n:[Int]
ns) (a
d:[a]
ds) = Angle Double -> a -> a
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Int -> Angle Double
ttangle Int
n) a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Int] -> [a] -> [a]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Int] -> [a] -> [a]
rotations [Int]
ns [a]
ds
rotations [] [a]
ds = [a]
ds
rotations [Int]
_  [] = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"rotations: too many rotation integers"

-- |scales takes a list of doubles for respective scalings of items in the second list (things to be scaled).
-- This includes Diagrams, Pieces, Patches, VPatches.
-- The list of doubles can be shorter than the list of items - the remaining items are left unscaled.
-- It will raise an error if the integer list is longer than the list of items to be scaled.
scales :: (Transformable a, V a ~ V2, N a ~ Double) => [Double] -> [a] -> [a]
scales :: forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Double] -> [a] -> [a]
scales (Double
s:[Double]
ss) (a
d:[a]
ds) = Double -> a -> a
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
s a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Double] -> [a] -> [a]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
[Double] -> [a] -> [a]
scales [Double]
ss [a]
ds
scales [] [a]
ds = [a]
ds
scales [Double]
_  [] = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"scales: too many scalars"

-- |increasing scales by a factor of phi along a list starting with 1.
phiScales:: (Transformable a, V a ~ V2, N a ~ Double) => [a] -> [a]
phiScales :: forall a. (Transformable a, V a ~ V2, N a ~ Double) => [a] -> [a]
phiScales = Double -> [a] -> [a]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
Double -> [a] -> [a]
phiScaling Double
1

-- |increasing scales by a factor of phi along a list starting with given first argument
phiScaling:: (Transformable a, V a ~ V2, N a ~ Double) => Double -> [a] -> [a]
phiScaling :: forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
Double -> [a] -> [a]
phiScaling Double
_ [] = []
phiScaling Double
s (a
d:[a]
more) = Double -> a -> a
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale Double
s a
da -> [a] -> [a]
forall a. a -> [a] -> [a]
: Double -> [a] -> [a]
forall a.
(Transformable a, V a ~ V2, N a ~ Double) =>
Double -> [a] -> [a]
phiScaling (Double
phiDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
s) [a]
more