{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module TileLib
(
Piece
, joinVector
, ldart
, rdart
, lkite
, rkite
, Diagram2D
, phi
, ttangle
, pieceEdges
, wholeTileEdges
, drawPiece
, dashjPiece
, dashjOnly
, drawRoundPiece
, drawJoin
, fillOnlyPiece
, fillPieceDK
, fillMaybePieceDK
, leftFillPieceDK
, experiment
, Drawable(..)
, Patch
, draw
, drawj
, fillDK
, fillKD
, fillMaybeDK
, colourDKG
, colourMaybeDKG
, decompPatch
, decompositionsP
, compChoices
, compNChoices
, penta
, sun
, TileLib.star
, suns
, sun5
, sun6
, sun6Fig
, leftFilledSun6
, filledSun6
, rotations
, scales
, phiScales
, phiScaling
) where
import Diagrams.Prelude
import HalfTile
type Piece = HalfTile (V2 Double)
joinVector:: Piece -> V2 Double
joinVector :: Piece -> V2 Double
joinVector = Piece -> V2 Double
forall rep. HalfTile rep -> rep
tileRep
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)
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
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
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
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)
type Diagram2D b = QDiagram b V2 Double Any
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
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
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
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
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 :: 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 :: 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 :: 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 :: 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:: 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)
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
(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]
(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]
type Patch = [Located Piece]
class Drawable a where
drawWith :: Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
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
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)
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
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 :: 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 :: 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 :: (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 :: (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:: (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
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
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'
(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'
(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'
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'
(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'
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'
decompositionsP:: Patch -> [Patch]
decompositionsP :: Patch -> [Patch]
decompositionsP = (Patch -> Patch) -> Patch -> [Patch]
forall a. (a -> a) -> a -> [a]
iterate Patch -> Patch
decompPatch
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' :: 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' :: 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 :: 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'
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 :: 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 :: 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]
suns::[Patch]
suns :: [Patch]
suns = Patch -> [Patch]
decompositionsP Patch
sun
sun5,sun6:: Patch
sun6 :: Patch
sun6 = [Patch]
suns[Patch] -> Int -> Patch
forall a. HasCallStack => [a] -> Int -> a
!!Int
6
sun5 :: Patch
sun5 = [Patch]
suns[Patch] -> Int -> Patch
forall a. HasCallStack => [a] -> Int -> a
!!Int
5
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
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
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 :: (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 :: (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"
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
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