{-|
Module      : TileLibP3
Description : Converting between Kites and Darts (P2 tiles) to Rhombuses (P3 tiles) and drawing
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

This module introduces Penrose\'s P3 tilings (narrow and wide rhombuses).
It includes P3_HalfTiles, P3_Pieces and P3_Patches to represent and draw
rhombuses plus conversion to and from Darts and Kites (the P2 tiles).
A class P3_Drawable is introduced with instance P3_Patch, Patch, VPatch, Tgraph
and generalised drawing functions for drawing P3 tilings.
-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE FlexibleInstances         #-} -- needed for P3_Drawable P3_Patch
{-# LANGUAGE Strict                    #-}
-- {-# LANGUAGE TypeOperators             #-} -- needed for type equality constraints ~

module TileLibP3 
  ( 
  -- * P3_HalfTiles
    P3_HalfTile(..)
  , tileRepP3
  -- * P3_Pieces
  , P3_Piece
  -- * Converting (located) Pieces
  , decompPieceP2toP3
  , decompPieceP3toP2
  -- * Converting Patches
  , P3_Patch
  , decompP2toP3
  , decompP3toP2
  -- * Drawing P3_Pieces
  --, drawnEdgesP3
  , drawPieceP3
  , drawjPieceP3
  , fillOnlyPieceP3
  , fillOnlyPieceWN
  , fillPieceWN
   -- * P3_Drawable Class
  , P3_Drawable(..)
  -- * Drawing functions producing P3 Rhombuses
  , drawP3
  , drawjP3
  , dashjP3
  , fillWN
  , fillNW
  -- * P3_DrawableLabelled Class
  , P3_DrawableLabelled(..)
  -- * Adding labels to functions producing P3 Rhombuses
  , labelSizeP3
  , labelledP3
  ) where

import Diagrams.Prelude
--import Diagrams.TwoD.Text (Text) -- now in CheckBackend

import CheckBackend
import HalfTile
import TileLib
import Tgraph.Prelude
import Tgraph.Decompose ( phiVMap )

import qualified Data.Map.Strict as Map ((!))
import qualified Data.IntMap.Strict as VMap (fromList, toList, lookup)

-- | Penrose P3 Tiling uses wide and narrow rhombuses
-- These are split into half tiles (triangles) as with kites and darts
data P3_HalfTile a
   = LW a -- ^ Left Wide Rhombus
   | RW a -- ^ Right Wide Rhombus
   | LN a -- ^ Left Narrow Rhombus
   | RN a -- ^ Right Narrow Rhombus
   deriving (Int -> P3_HalfTile a -> ShowS
[P3_HalfTile a] -> ShowS
P3_HalfTile a -> String
(Int -> P3_HalfTile a -> ShowS)
-> (P3_HalfTile a -> String)
-> ([P3_HalfTile a] -> ShowS)
-> Show (P3_HalfTile a)
forall a. Show a => Int -> P3_HalfTile a -> ShowS
forall a. Show a => [P3_HalfTile a] -> ShowS
forall a. Show a => P3_HalfTile a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> P3_HalfTile a -> ShowS
showsPrec :: Int -> P3_HalfTile a -> ShowS
$cshow :: forall a. Show a => P3_HalfTile a -> String
show :: P3_HalfTile a -> String
$cshowList :: forall a. Show a => [P3_HalfTile a] -> ShowS
showList :: [P3_HalfTile a] -> ShowS
Show,P3_HalfTile a -> P3_HalfTile a -> Bool
(P3_HalfTile a -> P3_HalfTile a -> Bool)
-> (P3_HalfTile a -> P3_HalfTile a -> Bool) -> Eq (P3_HalfTile a)
forall a. Eq a => P3_HalfTile a -> P3_HalfTile a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => P3_HalfTile a -> P3_HalfTile a -> Bool
== :: P3_HalfTile a -> P3_HalfTile a -> Bool
$c/= :: forall a. Eq a => P3_HalfTile a -> P3_HalfTile a -> Bool
/= :: P3_HalfTile a -> P3_HalfTile a -> Bool
Eq)

{-# INLINE tileRepP3 #-}
-- | tileRepP3 produces the representation without the label (LW,RW,LN,RN)
tileRepP3 :: P3_HalfTile a -> a
tileRepP3 :: forall a. P3_HalfTile a -> a
tileRepP3 (LW a
a) = a
a
tileRepP3 (RW a
a) = a
a
tileRepP3 (LN a
a) = a
a
tileRepP3 (RN a
a) = a
a

-- |Needed for Transformable instance of P3_HalfTile - requires TypeFamilies
type instance N (P3_HalfTile a) = N a
-- |Needed for Transformable instance of P3_HalfTile - requires TypeFamilies
type instance V (P3_HalfTile a) = V a
-- |P3_HalfTile inherits Transformable  - Requires FlexibleInstances
instance Transformable a => Transformable (P3_HalfTile a) where
    transform :: Transformation (V (P3_HalfTile a)) (N (P3_HalfTile a))
-> P3_HalfTile a -> P3_HalfTile a
transform Transformation (V (P3_HalfTile a)) (N (P3_HalfTile a))
t = (a -> a) -> P3_HalfTile a -> P3_HalfTile a
forall a b. (a -> b) -> P3_HalfTile a -> P3_HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V a) (N a)
Transformation (V (P3_HalfTile a)) (N (P3_HalfTile a))
t)

-- |A P3_Piece is a P3_Halftile with a vector along its join edge.
-- The vector for a wide rhombus is on the long diagonal,
-- and the vector for a narrow rhombus is along the short diagonal.
-- The choice of which vertex is the origin is derived from conversions
-- from Darts and Kites (P2 tilings) 
type P3_Piece = P3_HalfTile (V2 Double)

-- |Make P3_Halftile a Functor
instance Functor P3_HalfTile where
    fmap :: forall a b. (a -> b) -> P3_HalfTile a -> P3_HalfTile b
fmap a -> b
f (LW a
rep) = b -> P3_HalfTile b
forall a. a -> P3_HalfTile a
LW (a -> b
f a
rep)
    fmap a -> b
f (RW a
rep) = b -> P3_HalfTile b
forall a. a -> P3_HalfTile a
RW (a -> b
f a
rep)
    fmap a -> b
f (LN a
rep) = b -> P3_HalfTile b
forall a. a -> P3_HalfTile a
LN (a -> b
f a
rep)
    fmap a -> b
f (RN a
rep) = b -> P3_HalfTile b
forall a. a -> P3_HalfTile a
RN (a -> b
f a
rep)

-- |Converting from P2 to P3 tilings.
-- Half darts become half wide rhombuses (LD->RW,RD->LW).
-- (The new origin is the dart wing, and 
-- the new join is the dart long edge.)
-- Half kites are decomposed to a half wide and a half narrow rhombus.
-- (For wide rhombuses, the new origin is the kite origin and the join is the kite long edge.)
-- (For narrow rhombuses, the new origin is the kite opp and the join is toward the kite origin.)
decompPieceP2toP3 :: Located Piece -> [Located P3_Piece]
decompPieceP2toP3 :: Located Piece -> [Located P3_Piece]
decompPieceP2toP3 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, LK V2 Double
v) -> [ V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
RW V2 Double
z P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point (V P3_Piece) (N P3_Piece)
p
                 , V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
RN ((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 a. Num a => a -> a
negate V2 Double
v) P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
pPoint 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 z :: V2 Double
z = 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, RK V2 Double
v) -> [ V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
LW V2 Double
z P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point (V P3_Piece) (N P3_Piece)
p
                 , V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
LN ((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 a. Num a => a -> a
negate V2 Double
v) P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
pPoint 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 z :: V2 Double
z = 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, LD V2 Double
v) -> [ V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
RW (V2 Double -> V2 Double
forall a. Num a => a -> a
negate V2 Double
z) P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
pPoint 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
z]
                 where z :: V2 Double
z = Double
phi Double -> 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
    (Point (V Piece) (N Piece)
p, RD V2 Double
v) -> [ V2 Double -> P3_Piece
forall a. a -> P3_HalfTile a
LW (V2 Double -> V2 Double
forall a. Num a => a -> a
negate V2 Double
z) P3_Piece -> Point (V P3_Piece) (N P3_Piece) -> Located P3_Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V Piece) (N Piece)
Point V2 Double
pPoint 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
z]
                 where z :: V2 Double
z = Double
phi Double -> 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

-- |Converting from P3 to P2 tilings.
-- Half narrow rhombuses become half kites
-- (but the origin vertex and join edge are changed).
-- Half wide rhombuses are decomposed to a half dart and a half kite.
decompPieceP3toP2 :: Located P3_Piece -> [Located Piece]
decompPieceP3toP2 :: Located P3_Piece -> [Located Piece]
decompPieceP3toP2 Located P3_Piece
lp = case Located P3_Piece -> (Point (V P3_Piece) (N P3_Piece), P3_Piece)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc Located P3_Piece
lp of
    (Point (V P3_Piece) (N P3_Piece)
p, LW V2 Double
v) -> -- decompPiece (RD (z^-^v) `at` p.+^v)
                 -- where z = (phi-1)*^rotate (ttangle 1) v
                 [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RD ((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) 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 (V P3_Piece) (N P3_Piece)
p
                 , V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK (V2 Double
zV2 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) Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V P3_Piece) (N P3_Piece)
Point V2 Double
pPoint 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 z :: V2 Double
z = (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
*^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 P3_Piece) (N P3_Piece)
p, RW V2 Double
v) -> --decompPiece (LD (z^-^v) `at` p.+^v)
                 --where z = (phi-1)*^rotate (ttangle 9) v
                 [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LD ((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) 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 (V P3_Piece) (N P3_Piece)
p
                 , V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK (V2 Double
zV2 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) Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` (Point (V P3_Piece) (N P3_Piece)
Point V2 Double
pPoint 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 z :: V2 Double
z = (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
*^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 P3_Piece) (N P3_Piece)
p, LN V2 Double
v) -> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
RK (V2 Double
vV2 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
z) Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V P3_Piece) (N P3_Piece)
Point V2 Double
pPoint 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
z]
                 where z :: V2 Double
z = Double
phi Double -> 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
2) V2 Double
v
    (Point (V P3_Piece) (N P3_Piece)
p, RN V2 Double
v) -> [ V2 Double -> Piece
forall rep. rep -> HalfTile rep
LK (V2 Double
vV2 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
z) Piece -> Point (V Piece) (N Piece) -> Located Piece
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V P3_Piece) (N P3_Piece)
Point V2 Double
pPoint 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
z]
                 where z :: V2 Double
z = Double
phi Double -> 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
8) V2 Double
v

-- | a P3_Patch is analagous to a Patch (but for for P3_Pieces)
type P3_Patch =  [Located P3_Piece]

-- |Conversion from a Patch to a P3_Patch (Kites and Darts to Rhombuses)
decompP2toP3 :: Patch -> P3_Patch
decompP2toP3 :: [Located Piece] -> [Located P3_Piece]
decompP2toP3 = (Located Piece -> [Located P3_Piece])
-> [Located Piece] -> [Located P3_Piece]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Located Piece -> [Located P3_Piece]
decompPieceP2toP3

-- |Conversion from a P3_Patch to a Patch (Rhombuses to Kites and Darts)
-- Note this does not reverse decompP2toP3, but the combination
-- decompP3toP2 . decompP2toP3 is equivalent to a decompose operation (decompPatch)
decompP3toP2 :: P3_Patch -> Patch
decompP3toP2 :: [Located P3_Piece] -> [Located Piece]
decompP3toP2 = (Located P3_Piece -> [Located Piece])
-> [Located P3_Piece] -> [Located Piece]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Located P3_Piece -> [Located Piece]
decompPieceP3toP2

-- |The drawn edges of a P3_Piece excluding the join edge (as a list of vectors)
drawnEdgesP3 :: P3_Piece -> [V2 Double]
drawnEdgesP3 :: P3_Piece -> [V2 Double]
drawnEdgesP3 (LW V2 Double
v) = [V2 Double
z,V2 Double
vV2 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
z] where z :: V2 Double
z = (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
*^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
drawnEdgesP3 (RW V2 Double
v) = [V2 Double
z,V2 Double
vV2 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
z] where z :: V2 Double
z = (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
*^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
drawnEdgesP3 (LN V2 Double
v) = [V2 Double
z,V2 Double
vV2 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
z] where z :: V2 Double
z = 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
2) V2 Double
v
drawnEdgesP3 (RN V2 Double
v) = [V2 Double
z,V2 Double
vV2 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
z] where z :: V2 Double
z = 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
8) V2 Double
v


-- |Draws the two drawn edges of a P3_Piece
drawPieceP3 :: OKBackend b => P3_Piece -> Diagram b
drawPieceP3 :: forall b. OKBackend b => P3_Piece -> Diagram b
drawPieceP3 = 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)
-> (P3_Piece -> Trail' Line V2 Double)
-> P3_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)
-> (P3_Piece -> [V2 Double]) -> P3_Piece -> Trail' Line V2 Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P3_Piece -> [V2 Double]
drawnEdgesP3

-- |Draw dashed join only of a P3_Piece 
dashjOnlyP3 :: OKBackend b => P3_Piece -> Diagram b
dashjOnlyP3 :: forall b. OKBackend b => P3_Piece -> Diagram b
dashjOnlyP3 P3_Piece
p = QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall c. (HasStyle c, N c ~ Double) => c -> c
joinDashing (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 [P3_Piece -> V2 Double
forall a. P3_HalfTile a -> a
tileRepP3 P3_Piece
p])


-- |Draws all edges of a P3_Piece using a faint dashed line for the join edge
drawjPieceP3 :: OKBackend b => P3_Piece -> Diagram b
drawjPieceP3 :: forall b. OKBackend b => P3_Piece -> Diagram b
drawjPieceP3 = P3_Piece -> QDiagram b (V b) (N b) Any
P3_Piece -> QDiagram b V2 Double Any
forall b. OKBackend b => P3_Piece -> Diagram b
drawPieceP3 (P3_Piece -> QDiagram b V2 Double Any)
-> (P3_Piece -> QDiagram b V2 Double Any)
-> P3_Piece
-> QDiagram b V2 Double Any
forall a. Semigroup a => a -> a -> a
<> P3_Piece -> QDiagram b (V b) (N b) Any
P3_Piece -> QDiagram b V2 Double Any
forall b. OKBackend b => P3_Piece -> Diagram b
dashjOnlyP3

-- |Fills a P3_Piece with a colour (without drawn edges)
fillOnlyPieceP3 :: (OKBackend b, Color c) =>
                   c -> P3_Piece -> Diagram b
fillOnlyPieceP3 :: forall b c. (OKBackend b, Color c) => c -> P3_Piece -> Diagram b
fillOnlyPieceP3 c
c P3_Piece
p = 
    Measure Double -> Diagram b -> Diagram 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 (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ c -> Diagram b -> Diagram b
forall n a c.
(InSpace V2 n a, Color c, Typeable n, Floating n, HasStyle a) =>
c -> a -> a
fillColor c
c (Diagram b -> Diagram b) -> Diagram b -> Diagram b
forall a b. (a -> b) -> a -> b
$ 
    Trail' Loop V2 (N b) -> QDiagram b V2 (N b) Any
forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Loop V2 n -> QDiagram b V2 n Any
strokeLoop (Trail' Loop V2 (N b) -> QDiagram b V2 (N b) Any)
-> Trail' Loop V2 (N b) -> QDiagram b V2 (N b) Any
forall a b. (a -> b) -> a -> b
$ Trail' Line V2 (N b) -> Trail' Loop V2 (N b)
forall (v :: * -> *) n. Trail' Line v n -> Trail' Loop v n
closeLine (Trail' Line V2 (N b) -> Trail' Loop V2 (N b))
-> Trail' Line V2 (N b) -> Trail' Loop V2 (N b)
forall a b. (a -> b) -> a -> b
$ [Vn (Trail' Line V2 (N b))] -> Trail' Line V2 (N b)
forall t. TrailLike t => [Vn t] -> t
fromOffsets ([Vn (Trail' Line V2 (N b))] -> Trail' Line V2 (N b))
-> [Vn (Trail' Line V2 (N b))] -> Trail' Line V2 (N b)
forall a b. (a -> b) -> a -> b
$ P3_Piece -> [V2 Double]
drawnEdgesP3 P3_Piece
p

-- |Fills a P3_Piece with one of 2 colours (but no drawn edges).
-- The first colour is used for wide rhombuses, and the second for narrow rhombuses.
-- (Note the order WN)
fillOnlyPieceWN :: (OKBackend b, Color cw, Color cn) =>
               cw -> cn -> P3_Piece -> Diagram b
fillOnlyPieceWN :: forall b cw cn.
(OKBackend b, Color cw, Color cn) =>
cw -> cn -> P3_Piece -> Diagram b
fillOnlyPieceWN cw
cw cn
cn P3_Piece
rp = Diagram b
filledpiece where
    filledpiece :: Diagram b
filledpiece = case P3_Piece
rp of
        (LW V2 Double
_ ) -> cw -> P3_Piece -> Diagram b
forall b c. (OKBackend b, Color c) => c -> P3_Piece -> Diagram b
fillOnlyPieceP3 cw
cw P3_Piece
rp
        (RW V2 Double
_ ) -> cw -> P3_Piece -> Diagram b
forall b c. (OKBackend b, Color c) => c -> P3_Piece -> Diagram b
fillOnlyPieceP3 cw
cw P3_Piece
rp
        P3_Piece
_       -> cn -> P3_Piece -> Diagram b
forall b c. (OKBackend b, Color c) => c -> P3_Piece -> Diagram b
fillOnlyPieceP3 cn
cn P3_Piece
rp

-- |Fills and draws a P3_Piece with one of 2 colours
-- The first colour is used for wide rhombuses, and the second for narrow rhombuses.
-- (Note the order WN)
fillPieceWN :: (OKBackend b, Color cw, Color cn) =>
               cw -> cn -> P3_Piece -> Diagram b
fillPieceWN :: forall b cw cn.
(OKBackend b, Color cw, Color cn) =>
cw -> cn -> P3_Piece -> Diagram b
fillPieceWN cw
cw cn
cn = P3_Piece -> QDiagram b (V b) (N b) Any
P3_Piece -> QDiagram b V2 Double Any
forall b. OKBackend b => P3_Piece -> Diagram b
drawPieceP3 (P3_Piece -> QDiagram b V2 Double Any)
-> (P3_Piece -> QDiagram b V2 Double Any)
-> P3_Piece
-> QDiagram b V2 Double Any
forall a. Semigroup a => a -> a -> a
<> cw -> cn -> P3_Piece -> QDiagram b (V b) (N b) Any
forall b cw cn.
(OKBackend b, Color cw, Color cn) =>
cw -> cn -> P3_Piece -> Diagram b
fillOnlyPieceWN cw
cw cn
cn

{- 
fillPieceWN cw cn rp = drawPieceP3 rp <> filledpiece where
    filledpiece = case rp of
        (LW _ ) -> fillOnlyPieceP3 cw rp
        (RW _ ) -> fillOnlyPieceP3 cw rp
        _       -> fillOnlyPieceP3 cn rp
-}

-- | A class for things that can be turned to diagrams when given a function to draw P3_Pieces.
class P3_Drawable a where
  drawP3With :: OKBackend b =>
                (P3_Piece ->  Diagram b) -> a -> Diagram b

-- | A P3_Patch is P3_Drawable.
instance P3_Drawable P3_Patch where
  -- | turn a P3_Patch into a diagram given a function for drawing P3_Pieces.
  drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> P3_Patch -> Diagram b
  drawP3With :: forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> [Located P3_Piece] -> Diagram b
drawP3With P3_Piece -> Diagram b
pd = [(Point V2 Double, QDiagram b V2 Double Any)]
-> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, HasOrigin a, Monoid' a) =>
[(Point v n, a)] -> a
position ([(Point V2 Double, QDiagram b V2 Double Any)]
 -> QDiagram b V2 Double Any)
-> ([Located P3_Piece]
    -> [(Point V2 Double, QDiagram b V2 Double Any)])
-> [Located P3_Piece]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located P3_Piece -> (Point V2 Double, QDiagram b V2 Double Any))
-> [Located P3_Piece]
-> [(Point V2 Double, QDiagram b V2 Double Any)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Located (QDiagram b V2 Double Any)
-> (Point
      (V (QDiagram b V2 Double Any)) (N (QDiagram b V2 Double Any)),
    QDiagram b V2 Double Any)
Located (QDiagram b V2 Double Any)
-> (Point V2 Double, QDiagram b V2 Double Any)
forall a. Located a -> (Point (V a) (N a), a)
viewLoc (Located (QDiagram b V2 Double Any)
 -> (Point V2 Double, QDiagram b V2 Double Any))
-> (Located P3_Piece -> Located (QDiagram b V2 Double Any))
-> Located P3_Piece
-> (Point V2 Double, QDiagram b V2 Double Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (P3_Piece -> QDiagram b V2 Double Any)
-> Located P3_Piece -> Located (QDiagram b V2 Double Any)
forall a b. SameSpace a b => (a -> b) -> Located a -> Located b
mapLoc P3_Piece -> Diagram b
P3_Piece -> QDiagram b V2 Double Any
pd)

-- | A Patch is also P3_Drawable (by conversion to a P3_Patch).
instance P3_Drawable Patch where
  drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> Patch -> Diagram b
  drawP3With :: forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> [Located Piece] -> Diagram b
drawP3With P3_Piece -> Diagram b
pd = (P3_Piece -> Diagram b) -> [Located P3_Piece] -> Diagram b
forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> [Located P3_Piece] -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With P3_Piece -> Diagram b
pd ([Located P3_Piece] -> QDiagram b V2 Double Any)
-> ([Located Piece] -> [Located P3_Piece])
-> [Located Piece]
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Located Piece] -> [Located P3_Piece]
decompP2toP3

-- | A VPatch is P3_Drawable.
instance P3_Drawable VPatch where
    drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> VPatch -> Diagram b
    drawP3With :: forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> VPatch -> Diagram b
drawP3With P3_Piece -> Diagram b
pd = (P3_Piece -> Diagram b) -> [Located Piece] -> Diagram b
forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> [Located Piece] -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With P3_Piece -> Diagram b
pd ([Located Piece] -> QDiagram b V2 Double Any)
-> (VPatch -> [Located Piece])
-> VPatch
-> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> [Located Piece]
dropLabels

-- | A Tgraph is P3_Drawable.
instance P3_Drawable Tgraph where
    drawP3With :: OKBackend b => (P3_Piece -> Diagram b) -> Tgraph -> Diagram b
    drawP3With :: forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> Tgraph -> Diagram b
drawP3With P3_Piece -> Diagram b
pd = (P3_Piece -> Diagram b) -> VPatch -> Diagram b
forall b.
OKBackend b =>
(P3_Piece -> Diagram b) -> VPatch -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With P3_Piece -> Diagram b
pd (VPatch -> QDiagram b V2 Double Any)
-> (Tgraph -> VPatch) -> Tgraph -> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- |The main drawing function for anything P3_Drawable
drawP3 :: (OKBackend b, P3_Drawable a) => 
          a -> Diagram b
drawP3 :: forall b a. (OKBackend b, P3_Drawable a) => a -> Diagram b
drawP3 = (P3_Piece -> QDiagram b (V b) (N b) Any)
-> a -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => (P3_Piece -> Diagram b) -> a -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With P3_Piece -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => P3_Piece -> Diagram b
drawPieceP3

-- |An alternative drawing function for anything P3_Drawable adding dashed lines for join edges
drawjP3 :: (OKBackend b, P3_Drawable a) => 
          a -> Diagram b
drawjP3 :: forall b a. (OKBackend b, P3_Drawable a) => a -> Diagram b
drawjP3 = (P3_Piece -> QDiagram b (V b) (N b) Any)
-> a -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => (P3_Piece -> Diagram b) -> a -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With P3_Piece -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => P3_Piece -> Diagram b
drawjPieceP3

{-# DEPRECATED dashjP3 "Replaced by drawjP3" #-}
-- |Deprecated (renamed as drawjP3)
dashjP3 :: (OKBackend b, P3_Drawable a) => 
          a -> Diagram b
dashjP3 :: forall b a. (OKBackend b, P3_Drawable a) => a -> Diagram b
dashjP3 = a -> Diagram b
forall b a. (OKBackend b, P3_Drawable a) => a -> Diagram b
drawjP3

-- |The main draw and fill function for anything P3_Drawable.
-- The first colour is used for wide rhombuses, and the second for narrow rhombuses.
-- (Note the order W N).
fillWN :: (OKBackend b, P3_Drawable a, Color cw, Color cn) =>
          cw -> cn -> a -> Diagram b
fillWN :: forall b a cw cn.
(OKBackend b, P3_Drawable a, Color cw, Color cn) =>
cw -> cn -> a -> Diagram b
fillWN cw
cw cn
cn = (P3_Piece -> QDiagram b (V b) (N b) Any)
-> a -> QDiagram b (V b) (N b) Any
forall b. OKBackend b => (P3_Piece -> Diagram b) -> a -> Diagram b
forall a b.
(P3_Drawable a, OKBackend b) =>
(P3_Piece -> Diagram b) -> a -> Diagram b
drawP3With (cw -> cn -> P3_Piece -> QDiagram b (V b) (N b) Any
forall b cw cn.
(OKBackend b, Color cw, Color cn) =>
cw -> cn -> P3_Piece -> Diagram b
fillPieceWN cw
cw cn
cn)

-- |A variation on fillWN where
-- the first colour is for narrow rhombuses, the second for wide rhombuses.
-- (Note the order N W).
fillNW :: (OKBackend b, P3_Drawable a, Color cw, Color cn) =>
          cw -> cn -> a -> Diagram b
fillNW :: forall b a cw cn.
(OKBackend b, P3_Drawable a, Color cw, Color cn) =>
cw -> cn -> a -> Diagram b
fillNW = (cn -> cw -> a -> QDiagram b V2 Double Any)
-> cw -> cn -> a -> QDiagram b V2 Double Any
forall a b c. (a -> b -> c) -> b -> a -> c
flip cn -> cw -> a -> QDiagram b (V b) (N b) Any
cn -> cw -> a -> QDiagram b V2 Double Any
forall b a cw cn.
(OKBackend b, P3_Drawable a, Color cw, Color cn) =>
cw -> cn -> a -> Diagram b
fillWN --drawP3With (fillPieceWN cw cn)


-- | A class for things that can be drawn (P3 style) with labels when given a colour and a measure (size) for the labels and a 
-- a draw function (for P3_Patches).
-- So labelColourSizeP3 c m  modifies a P3_Patch drawing function to add labels (of colour c and size measure m).
-- Measures are defined in Diagrams. In particular: tiny, verySmall, small, normal, large, veryLarge, huge.
class P3_DrawableLabelled a where
   labelColourSizeP3 :: OKBackend b => 
                        Colour Double -> Measure Double -> (P3_Patch -> Diagram b) -> a -> Diagram b

-- | VPatches can be drawn (Rhombus/P3 style) with labels
-- NB: the additional vertices for P3 are only added when drawing and are not part of the VPatch.
-- Thus using such a vertex for alignment will raise an error.
instance P3_DrawableLabelled VPatch where
     labelColourSizeP3 :: forall b.
OKBackend b =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> VPatch
-> Diagram b
labelColourSizeP3 Colour Double
c Measure Double
m [Located P3_Piece] -> Diagram b
d VPatch
vp = QDiagram b V2 Double Any
drawLabels QDiagram b V2 Double Any
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a. Semigroup a => a -> a -> a
<> [Located P3_Piece] -> Diagram b
d [Located P3_Piece]
p3Patch where
        p3Patch :: [Located P3_Piece]
p3Patch = [Located Piece] -> [Located P3_Piece]
decompP2toP3 ([Located Piece] -> [Located P3_Piece])
-> [Located Piece] -> [Located P3_Piece]
forall a b. (a -> b) -> a -> b
$ VPatch -> [Located Piece]
dropLabels VPatch
vp
        drawLabels :: QDiagram b V2 Double Any
drawLabels = [(Point V2 Double, QDiagram b V2 Double Any)]
-> QDiagram b V2 Double Any
forall (v :: * -> *) n a.
(InSpace v n a, HasOrigin a, Monoid' a) =>
[(Point v n, a)] -> a
position ([(Point V2 Double, QDiagram b V2 Double Any)]
 -> QDiagram b V2 Double Any)
-> [(Point V2 Double, QDiagram b V2 Double Any)]
-> QDiagram b V2 Double Any
forall a b. (a -> b) -> a -> b
$ (Int, Point V2 Double)
-> (Point V2 Double, QDiagram b V2 Double Any)
drawlabel ((Int, Point V2 Double)
 -> (Point V2 Double, QDiagram b V2 Double Any))
-> [(Int, Point V2 Double)]
-> [(Point V2 Double, QDiagram b V2 Double Any)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VertexLocMap -> [(Int, Point V2 Double)]
forall a. IntMap a -> [(Int, a)]
VMap.toList (VPatch -> VertexLocMap
extendLocsP3 VPatch
vp)
        drawlabel :: (Int, Point V2 Double)
-> (Point V2 Double, QDiagram b V2 Double Any)
drawlabel(Int
v,Point V2 Double
p) = (Point V2 Double
p, String -> QDiagram b V2 Double Any
forall n b.
(TypeableFloat n, Renderable (Text n) b) =>
String -> QDiagram b V2 n Any
baselineText (Int -> String
forall a. Show a => a -> String
show Int
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
# Measure Double
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a n.
(N a ~ n, Typeable n, HasStyle a) =>
Measure n -> a -> a
fontSize Measure Double
m 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
c)

-- | (Not exported) Extend the vertex locations of a VPatch with locations for new kite join vertices
-- appearing in (Rhombus/P3 style) drawing of tiles.
-- The new vertex numbers are generated with phiVMap from Tgraph.Decompose
extendLocsP3 :: VPatch -> VertexLocMap
extendLocsP3 :: VPatch -> VertexLocMap
extendLocsP3 VPatch
vp = VertexLocMap
locmap VertexLocMap -> VertexLocMap -> VertexLocMap
forall a. Semigroup a => a -> a -> a
<> [(Int, Point V2 Double)] -> VertexLocMap
forall a. [(Int, a)] -> IntMap a
VMap.fromList ((TileFace -> (Int, Point V2 Double))
-> [TileFace] -> [(Int, Point V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map (Dedge -> (Int, Point V2 Double)
locateNew (Dedge -> (Int, Point V2 Double))
-> (TileFace -> Dedge) -> TileFace -> (Int, Point V2 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Dedge
joinOfTile) (VPatch -> [TileFace]
forall a. HasFaces a => a -> [TileFace]
kites VPatch
vp)) where
    locmap :: VertexLocMap
locmap = VPatch -> VertexLocMap
vLocs VPatch
vp
    newemap :: Map Dedge Int
newemap = VPatch -> Map Dedge Int
forall a. HasFaces a => a -> Map Dedge Int
phiVMap VPatch
vp
    locateNew :: Dedge -> (Int, Point V2 Double)
locateNew (Int
a,Int
b) = case (Int -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Int -> IntMap a -> Maybe a
VMap.lookup Int
a VertexLocMap
locmap, Int -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Int -> IntMap a -> Maybe a
VMap.lookup Int
b VertexLocMap
locmap) of
        (Just Point V2 Double
pa, Just Point V2 Double
pb) -> (Map Dedge Int
newemap Map Dedge Int -> Dedge -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Int
a,Int
b), Point V2 Double
pa 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
.+^ (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
*^ (Point V2 Double
pb Point V2 Double -> Point V2 Double -> Diff (Point V2) Double
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 Double
pa))
        (Maybe (Point V2 Double), Maybe (Point V2 Double))
_ -> String -> (Int, Point V2 Double)
forall a. HasCallStack => String -> a
error String
"extendLocsP3: Missing location for a kite join"

-- | Tgraphs can be drawn (Rhombus/P3 style) with labels
-- NB: the additional vertices for P3 are only added when drawing and are not part of the Tgraph
-- or its VPatch.
-- Thus using such a vertex for alignment will raise an error.
instance P3_DrawableLabelled Tgraph where
     labelColourSizeP3 :: forall b.
OKBackend b =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> Tgraph
-> Diagram b
labelColourSizeP3 Colour Double
c Measure Double
m [Located P3_Piece] -> Diagram b
d = Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> VPatch
-> Diagram b
forall b.
OKBackend b =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> VPatch
-> Diagram b
forall a b.
(P3_DrawableLabelled a, OKBackend b) =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> a
-> Diagram b
labelColourSizeP3 Colour Double
c Measure Double
m [Located P3_Piece] -> Diagram b
d (VPatch -> QDiagram b V2 Double Any)
-> (Tgraph -> VPatch) -> Tgraph -> QDiagram b V2 Double Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- | Default Version of labelColourSizeP3 with colour red.
-- Example usage: labelSizeP3 tiny drawP3 a , labelSizeP3 normal drawjP3 a
labelSizeP3 :: (OKBackend b, P3_DrawableLabelled a) =>
               Measure Double -> (P3_Patch -> Diagram b) -> a -> Diagram b
labelSizeP3 :: forall b a.
(OKBackend b, P3_DrawableLabelled a) =>
Measure Double
-> ([Located P3_Piece] -> Diagram b) -> a -> Diagram b
labelSizeP3 = Colour Double
-> Measure Double
-> ([Located P3_Piece] -> QDiagram b (V b) (N b) Any)
-> a
-> QDiagram b (V b) (N b) Any
forall b.
OKBackend b =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> a
-> Diagram b
forall a b.
(P3_DrawableLabelled a, OKBackend b) =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> a
-> Diagram b
labelColourSizeP3 Colour Double
forall a. (Ord a, Floating a) => Colour a
red

-- | Default Version of labelColourSizeP3 using red and small (rather than normal label size).
-- Example usage: labelledP3 drawP3 a , labelledP3 drawjP3 a
labelledP3 :: (OKBackend b, P3_DrawableLabelled a) =>
            (P3_Patch -> Diagram b) -> a -> Diagram b
labelledP3 :: forall b a.
(OKBackend b, P3_DrawableLabelled a) =>
([Located P3_Piece] -> Diagram b) -> a -> Diagram b
labelledP3 = Colour Double
-> Measure Double
-> ([Located P3_Piece] -> QDiagram b (V b) (N b) Any)
-> a
-> QDiagram b (V b) (N b) Any
forall b.
OKBackend b =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> a
-> Diagram b
forall a b.
(P3_DrawableLabelled a, OKBackend b) =>
Colour Double
-> Measure Double
-> ([Located P3_Piece] -> Diagram b)
-> a
-> Diagram b
labelColourSizeP3 Colour Double
forall a. (Ord a, Floating a) => Colour a
red Measure Double
forall n. OrderedField n => Measure n
small --(normalized 0.023)