{-|
Module      : Tgraph.Prelude
Description : Introducing types Tgraph, VPatch and drawing operations.
Copyright   : (c) Chris Reade, 2021
License     : BSD-style
Maintainer  : chrisreade@mac.com
Stability   : experimental

Introduces Tgraphs and includes operations on vertices, edges and faces as well as Tgraphs.
Plus VPatch (Vertex Patch) as intermediary between Tgraph and Diagram.
Conversion and drawing operations to produce Diagrams.
The module also includes functions to calculate (relative) locations of vertices (locateVertices, addVPoint),
touching vertex checks (touchingVertices, touchingVerticesGen), and edge drawing functions.

This module re-exports module HalfTile and module Tgraph.Try.
-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TupleSections             #-}

module Tgraph.Prelude
  ( module HalfTile
  , module Tgraph.Try
    -- * Types for Tgraphs, Faces, Vertices, Directed Edges
  , Tgraph -- not Data Constructor
  , TileFace
  , Vertex
  , VertexSet
  , VertexMap
    -- $Edges
  , Dedge
  , EdgeType(..)
   -- * Property Checking for Tgraphs
  , makeUncheckedTgraph
  , checkedTgraph
  , tryTgraphProps
  , tryConnectedNoCross
--  , findEdgeLoops
  , hasEdgeLoops
  , duplicates
--  , conflictingDedges
  , edgeType
--  , sharedEdges
--  , newSharedEdges
  , noNewConflict
-- unused  , noNewConflictFull
--  , legal
--  , illegals
  , illegalTiling
--  , crossingBVs
  , crossingVertices
  , crossingBoundaries
  , connected
--  , connectedBy
    -- * Basic Tgraph operations
  , faces
  , emptyTgraph
  , nullGraph
  , maxV
  , ldarts
  , rdarts
  , lkites
  , rkites
  , kites
  , darts
  , selectFaces
  , removeFaces
  , removeVertices
  , selectVertices
  , vertexSet
  , graphDedges
  , graphEdges
  , internalEdges
  , graphBoundary
  , phiEdges
  , nonPhiEdges
  , graphEFMap
  , defaultAlignment
    -- * Other Face/Vertex Operations
  , faceVs
  , faceVList
  , faceVSet
  , facesVSet
  , facesMaxV
  , firstV
  , secondV
  , thirdV
  , originV
  , wingV
  , oppV
  , indexV
  , nextV 
  , prevV
  , isAtV
  , hasVIn
    -- * Other Edge Operations
  , faceDedges
  , facesDedges 
  , reverseD
  , joinE
  , shortE
  , longE
  , joinOfTile
  , facePhiEdges
  , faceNonPhiEdges
--  , matchingE
  , matchingLongE
  , matchingShortE
  , matchingJoinE
  , hasDedge
  , hasDedgeIn
  , facesEdges
--   , bothDir
--   , bothDirOneWay
  , facesBoundary
--   , missingRevs
    -- * Other Face Operations
  , edgeNb
  , vertexFacesMap
  , dedgesFacesMap
  , buildEFMap
  , faceForEdge
  , edgeNbs
--  , extractLowestJoin
  , lowestJoin
    -- * VPatch and Conversions
  , VPatch(..)
  , VertexLocMap
  , makeVP
  , subVP
  , relevantVP
  , restrictVP
  , graphFromVP
  , removeFacesVP
  , selectFacesVP
  , findLoc
    -- * Drawing Tgraphs and Vpatches with Labels
  , DrawableLabelled(..)
  , labelSize
  , labelled
  , rotateBefore
  , dropLabels
-- * VPatch alignment with vertices
  , centerOn
  , alignXaxis
  , alignments
  , alignAll
  , alignBefore
  , makeAlignedVP
    -- *  Drawing Edges with a VPatch or a VertexLocationMap
  , drawEdgesVP
  , drawEdgeVP
  , drawEdges
  , drawEdge
    -- * Vertex Location and Touching Vertices
  , locateVertices
  , addVPoint
  , axisJoin
--  , find3Locs
--  , thirdVertexLoc
  , touchingVertices
  , touching
  , touchingVerticesGen
  , locateVerticesGen
  ) where

import Data.List ((\\), intersect, union, elemIndex,foldl',find)
-- import Data.Either(fromRight, lefts, rights, isLeft)
import qualified Data.IntMap.Strict as VMap (IntMap, alter, lookup, fromList, fromListWith, (!), map, filterWithKey,insert, empty, toList, assocs, keys, keysSet)
import qualified Data.IntSet as IntSet (IntSet,union,empty,singleton,insert,delete,fromList,toList,null,(\\),notMember,deleteMin,findMin,findMax,member,difference)
import qualified Data.Map.Strict as Map (Map, fromList, lookup, fromListWith)
import Data.Maybe (mapMaybe) -- edgeNbrs
import qualified Data.Set as Set  (fromList,member,null,delete)-- used for locateVertices

import Diagrams.Prelude hiding (union)
import Diagrams.TwoD.Text (Text)

import TileLib
import HalfTile
import Tgraph.Try


{---------------------
*********************
Tgraphs
*********************
-----------------------}



-- $Types for Tgraphs, Vertices, Directed Edges, Faces

-- |Tgraph vertices (must be positive)
type Vertex = Int
-- | directed edge
type Dedge = (Vertex,Vertex)
-- | Vertex Sets
type VertexSet = IntSet.IntSet

-- |Tgraph faces  (vertices clockwise starting with tile origin vertex)
-- a specialisation of HalfTile
type TileFace = HalfTile (Vertex,Vertex,Vertex)

-- |A Tgraph is a list of faces.
-- All vertex labels should be positive, so 0 is not used as a vertex label.
-- Tgraphs should be constructed with makeTgraph or checkedTgraph to check required properties.
-- The data constructor Tgraph is not exported (but see also makeUncheckedTgraph).
newtype Tgraph = Tgraph [TileFace]
                 deriving (Vertex -> Tgraph -> ShowS
[Tgraph] -> ShowS
Tgraph -> String
(Vertex -> Tgraph -> ShowS)
-> (Tgraph -> String) -> ([Tgraph] -> ShowS) -> Show Tgraph
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> Tgraph -> ShowS
showsPrec :: Vertex -> Tgraph -> ShowS
$cshow :: Tgraph -> String
show :: Tgraph -> String
$cshowList :: [Tgraph] -> ShowS
showList :: [Tgraph] -> ShowS
Show)

-- | type used to classify edges of faces 
data EdgeType = Short | Long | Join deriving (Vertex -> EdgeType -> ShowS
[EdgeType] -> ShowS
EdgeType -> String
(Vertex -> EdgeType -> ShowS)
-> (EdgeType -> String) -> ([EdgeType] -> ShowS) -> Show EdgeType
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> EdgeType -> ShowS
showsPrec :: Vertex -> EdgeType -> ShowS
$cshow :: EdgeType -> String
show :: EdgeType -> String
$cshowList :: [EdgeType] -> ShowS
showList :: [EdgeType] -> ShowS
Show,EdgeType -> EdgeType -> Bool
(EdgeType -> EdgeType -> Bool)
-> (EdgeType -> EdgeType -> Bool) -> Eq EdgeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EdgeType -> EdgeType -> Bool
== :: EdgeType -> EdgeType -> Bool
$c/= :: EdgeType -> EdgeType -> Bool
/= :: EdgeType -> EdgeType -> Bool
Eq)

-- |Abbreviation for Mapping from Vertex keys (also used for Boundaries)
type VertexMap a = VMap.IntMap a

{-------------------------------------------
********************************************
Basic Tgraph, vertex, edge, face operations
********************************************
--------------------------------------------}

{-*
Tgraphs and Property Checking
-}


-- |Creates a (possibly invalid) Tgraph from a list of faces.
-- It does not perform checks on the faces. Use makeTgraph (defined in Tgraphs module) or checkedTgraph to perform checks.
-- This is intended for use only when checks are known to be redundant (the data constructor Tgraph is hidden).
makeUncheckedTgraph:: [TileFace] -> Tgraph
makeUncheckedTgraph :: [TileFace] -> Tgraph
makeUncheckedTgraph [TileFace]
fcs = [TileFace] -> Tgraph
Tgraph [TileFace]
fcs

{-| Creates a Tgraph from a list of faces AND checks for edge loops, edge conflicts and
crossing boundaries and connectedness and legal tiling with tryTgraphProps.
(No crossing boundaries and connected implies tile-connected).
Produces an error if a check fails.

Note: This does not check for touching vertices (distinct labels for the same vertex).
To perform this additional check use makeTgraph (defined in Tgraphs module) which also calls tryTgraphProps.
-}
checkedTgraph:: [TileFace] -> Tgraph
checkedTgraph :: [TileFace] -> Tgraph
checkedTgraph = Try Tgraph -> Tgraph
forall a. Try a -> a
runTry (Try Tgraph -> Tgraph)
-> ([TileFace] -> Try Tgraph) -> [TileFace] -> Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Try Tgraph -> Try Tgraph
forall a. String -> Try a -> Try a
onFail String
report (Try Tgraph -> Try Tgraph)
-> ([TileFace] -> Try Tgraph) -> [TileFace] -> Try Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> Try Tgraph
tryTgraphProps
 where report :: String
report = String
"checkedTgraph: Failed\n"  -- ++ " for faces: " ++ show fcs ++ "\n"


{- | Checks a list of faces to avoid: 
    edge loops,
    edge conflicts (same directed edge on two or more faces),
    illegal tilings (breaking legal rules for tiling),
    vertices not all >0 ,
    crossing boundaries, and 
    non-connectedness.

Returns Right g where g is a Tgraph on passing checks.
Returns Left lines if a test fails, where lines describes the problem found.
-}
tryTgraphProps:: [TileFace] -> Try Tgraph
tryTgraphProps :: [TileFace] -> Try Tgraph
tryTgraphProps []       =  Tgraph -> Try Tgraph
forall a b. b -> Either a b
Right Tgraph
emptyTgraph 
tryTgraphProps [TileFace]
fcs
      | [TileFace] -> Bool
hasEdgeLoops [TileFace]
fcs  =  String -> Try Tgraph
forall a b. a -> Either a b
Left (String -> Try Tgraph) -> String -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ String
"tryTgraphProps: Non-valid tile-face(s)\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                      String
"Edge Loops at: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Vertex] -> String
forall a. Show a => a -> String
show ([TileFace] -> [Vertex]
findEdgeLoops [TileFace]
fcs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      | [TileFace] -> Bool
illegalTiling [TileFace]
fcs =  String -> Try Tgraph
forall a b. a -> Either a b
Left (String -> Try Tgraph) -> String -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ String
"tryTgraphProps: Non-legal tiling\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                      String
"Conflicting face directed edges (non-planar tiling): "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Dedge] -> String
forall a. Show a => a -> String
show ([TileFace] -> [Dedge]
conflictingDedges [TileFace]
fcs) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                      String
"\nIllegal tile juxtapositions: "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(TileFace, EdgeType, TileFace, EdgeType)] -> String
forall a. Show a => a -> String
show ([TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
illegals [TileFace]
fcs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      | Bool
otherwise         = let vs :: VertexSet
vs = [TileFace] -> VertexSet
facesVSet [TileFace]
fcs
                            in if VertexSet -> Vertex
IntSet.findMin VertexSet
vs Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
<Vertex
1 -- any (<1) $ IntSet.toList vs
                               then String -> Try Tgraph
forall a b. a -> Either a b
Left (String -> Try Tgraph) -> String -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ String
"tryTgraphProps: Vertex numbers not all >0: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Vertex] -> String
forall a. Show a => a -> String
show (VertexSet -> [Vertex]
IntSet.toList VertexSet
vs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
                               else [TileFace] -> Try Tgraph
tryConnectedNoCross [TileFace]
fcs 

-- |Checks a list of faces for no crossing boundaries and connectedness.
-- (No crossing boundaries and connected implies tile-connected).
-- Returns Right g where g is a Tgraph on passing checks.
-- Returns Left lines if a test fails, where lines describes the problem found.
-- This is used by tryTgraphProps after other checks have been made,
-- but can be used alone when other properties are known to hold (e.g. in tryPartCompose)
tryConnectedNoCross:: [TileFace] -> Try Tgraph
tryConnectedNoCross :: [TileFace] -> Try Tgraph
tryConnectedNoCross [TileFace]
fcs
  | Bool -> Bool
not ([TileFace] -> Bool
connected [TileFace]
fcs) =    String -> Try Tgraph
forall a b. a -> Either a b
Left (String -> Try Tgraph) -> String -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ String
"tryConnectedNoCross: Non-valid Tgraph (Not connected)\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show [TileFace]
fcs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  | [TileFace] -> Bool
crossingBoundaries [TileFace]
fcs = String -> Try Tgraph
forall a b. a -> Either a b
Left (String -> Try Tgraph) -> String -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ String
"tryConnectedNoCross: Non-valid Tgraph\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                  String
"Crossing boundaries found at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Vertex] -> String
forall a. Show a => a -> String
show ([TileFace] -> [Vertex]
crossingBVs [TileFace]
fcs) 
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nwith faces\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TileFace] -> String
forall a. Show a => a -> String
show [TileFace]
fcs
  | Bool
otherwise            = Tgraph -> Try Tgraph
forall a b. b -> Either a b
Right ([TileFace] -> Tgraph
Tgraph [TileFace]
fcs)

-- |Returns any repeated vertices in a single tileface for a list of tilefaces.
findEdgeLoops:: [TileFace] -> [Vertex]
findEdgeLoops :: [TileFace] -> [Vertex]
findEdgeLoops = (TileFace -> [Vertex]) -> [TileFace] -> [Vertex]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a]
duplicates ([Vertex] -> [Vertex])
-> (TileFace -> [Vertex]) -> TileFace -> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> [Vertex]
faceVList)

-- |Checks if there are repeated vertices within a tileface for a list of tilefaces.
-- Returns True if there are any.
hasEdgeLoops:: [TileFace] -> Bool
hasEdgeLoops :: [TileFace] -> Bool
hasEdgeLoops = Bool -> Bool
not (Bool -> Bool) -> ([TileFace] -> Bool) -> [TileFace] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Vertex] -> Bool)
-> ([TileFace] -> [Vertex]) -> [TileFace] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> [Vertex]
findEdgeLoops


-- |duplicates finds duplicated items in a list (reverses order but unique results)
duplicates :: Eq a => [a] -> [a]
duplicates :: forall a. Eq a => [a] -> [a]
duplicates = ([a], [a]) -> [a]
forall a b. (a, b) -> a
fst (([a], [a]) -> [a]) -> ([a] -> ([a], [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a], [a]) -> a -> ([a], [a])) -> ([a], [a]) -> [a] -> ([a], [a])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([a], [a]) -> a -> ([a], [a])
forall {a}. Eq a => ([a], [a]) -> a -> ([a], [a])
check ([],[]) where
 check :: ([a], [a]) -> a -> ([a], [a])
check ([a]
dups,[a]
seen) a
x | a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
dups = ([a]
dups,[a]
seen)
                     | a
x a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
seen = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
dups,[a]
seen)
                     | Bool
otherwise = ([a]
dups,a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
seen)

-- |conflictingDedges fcs returns a list of conflicting directed edges in fcs
-- i.e. different faces having the same edge in the same direction.
-- (which should be null for a Tgraph)
conflictingDedges :: [TileFace] -> [Dedge]
conflictingDedges :: [TileFace] -> [Dedge]
conflictingDedges = [Dedge] -> [Dedge]
forall a. Eq a => [a] -> [a]
duplicates ([Dedge] -> [Dedge])
-> ([TileFace] -> [Dedge]) -> [TileFace] -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> [Dedge]
facesDedges



-- | edgeType d f - classifies the directed edge d
-- which must be one of the three directed edges of face f.
-- An error is raised if it is not a directed edge of the face
edgeType:: Dedge -> TileFace -> EdgeType
edgeType :: Dedge -> TileFace -> EdgeType
edgeType Dedge
d TileFace
f | Dedge
d Dedge -> Dedge -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Dedge
longE TileFace
f  = EdgeType
Long
             | Dedge
d Dedge -> Dedge -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Dedge
shortE TileFace
f = EdgeType
Short
             | Dedge
d Dedge -> Dedge -> Bool
forall a. Eq a => a -> a -> Bool
== TileFace -> Dedge
joinE TileFace
f  = EdgeType
Join 
             | Bool
otherwise = String -> EdgeType
forall a. HasCallStack => String -> a
error (String -> EdgeType) -> String -> EdgeType
forall a b. (a -> b) -> a -> b
$ String
"edgeType: directed edge " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dedge -> String
forall a. Show a => a -> String
show Dedge
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ 
                                   String
" not found in face " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |For a list of tile faces fcs this produces a list of tuples of the form (f1,etpe1,f2,etype2)
-- where f1 and f2 share a common edge and etype1 is the type of the shared edge in f1 and
-- etype2 is the type of the shared edge in f2.
-- This list can then be checked for inconsistencies / illegal pairings (using legal).
sharedEdges:: [TileFace] -> [(TileFace,EdgeType,TileFace,EdgeType)]
sharedEdges :: [TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
sharedEdges [TileFace]
fcs = [(TileFace
f1, Dedge -> TileFace -> EdgeType
edgeType Dedge
d1 TileFace
f1, TileFace
f2, Dedge -> TileFace -> EdgeType
edgeType Dedge
d2 TileFace
f2) 
                   | TileFace
f1 <- [TileFace]
fcs
                   , Dedge
d1 <- TileFace -> [Dedge]
faceDedges TileFace
f1
                   , let d2 :: Dedge
d2 = Dedge -> Dedge
reverseD Dedge
d1
                   , TileFace
f2 <- (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileFace -> Dedge -> Bool
`hasDedge` Dedge
d2) [TileFace]
fcs
                  ]

-- |A version of sharedEdges comparing a single face against a list of faces.
-- This does not look at shared edges within the list, but just the new face against the list.
newSharedEdges:: TileFace -> [TileFace] -> [(TileFace,EdgeType,TileFace,EdgeType)]
newSharedEdges :: TileFace
-> [TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
newSharedEdges TileFace
face [TileFace]
fcs = 
    [(TileFace
face, Dedge -> TileFace -> EdgeType
edgeType Dedge
d1 TileFace
face, TileFace
fc', Dedge -> TileFace -> EdgeType
edgeType Dedge
d2 TileFace
fc') 
     | Dedge
d1 <- TileFace -> [Dedge]
faceDedges TileFace
face
     , let d2 :: Dedge
d2 = Dedge -> Dedge
reverseD Dedge
d1
     , TileFace
fc' <- (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileFace -> Dedge -> Bool
`hasDedge` Dedge
d2) [TileFace]
fcs
    ]

-- | noNewConflict face fcs returns True if face has an illegal shared edge with fcs.
-- It does not check for illegal cases within the fcs.
noNewConflict :: TileFace -> [TileFace] -> Bool
noNewConflict :: TileFace -> [TileFace] -> Bool
noNewConflict TileFace
face [TileFace]
fcs = [(TileFace, EdgeType, TileFace, EdgeType)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(TileFace, EdgeType, TileFace, EdgeType)] -> Bool)
-> [(TileFace, EdgeType, TileFace, EdgeType)] -> Bool
forall a b. (a -> b) -> a -> b
$ ((TileFace, EdgeType, TileFace, EdgeType) -> Bool)
-> [(TileFace, EdgeType, TileFace, EdgeType)]
-> [(TileFace, EdgeType, TileFace, EdgeType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((TileFace, EdgeType, TileFace, EdgeType) -> Bool)
-> (TileFace, EdgeType, TileFace, EdgeType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace, EdgeType, TileFace, EdgeType) -> Bool
legal) [(TileFace, EdgeType, TileFace, EdgeType)]
shared where
    shared :: [(TileFace, EdgeType, TileFace, EdgeType)]
shared = TileFace
-> [TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
newSharedEdges TileFace
face [TileFace]
fcs

{-
-- |noNewConflictFull face fcs  where face is a new face and fcs are neighbouring faces.
-- Checks for illegal shared edges using noNewConflict but also checks that face does not have a directed edge
-- in the same direction as a directed edge in fcs.
noNewConflictFull :: TileFace -> [TileFace] -> Bool
noNewConflictFull face fcs = null (faceDedges face `intersect` facesDedges fcs) && noNewConflict face fcs
-}

-- | legal (f1,etype1,f2,etype2) is True if and only if it is legal for f1 and f2 to share an edge
-- with edge type etype1 (and etype2 is equal to etype1).                   
legal:: (TileFace,EdgeType,TileFace,EdgeType) -> Bool                
legal :: (TileFace, EdgeType, TileFace, EdgeType) -> Bool
legal (LK (Vertex, Vertex, Vertex)
_, EdgeType
e1,    RK (Vertex, Vertex, Vertex)
_ , EdgeType
e2    ) = EdgeType
e1 EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
e2 
legal (RK (Vertex, Vertex, Vertex)
_, EdgeType
e1,    LK (Vertex, Vertex, Vertex)
_ , EdgeType
e2    ) = EdgeType
e1 EdgeType -> EdgeType -> Bool
forall a. Eq a => a -> a -> Bool
== EdgeType
e2 
legal (LK (Vertex, Vertex, Vertex)
_, EdgeType
Short, RD (Vertex, Vertex, Vertex)
_ , EdgeType
Short) = Bool
True
legal (RD (Vertex, Vertex, Vertex)
_, EdgeType
Short, LK (Vertex, Vertex, Vertex)
_ , EdgeType
Short) = Bool
True
legal (LK (Vertex, Vertex, Vertex)
_, EdgeType
Long,  RD (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (RD (Vertex, Vertex, Vertex)
_, EdgeType
Long,  LK (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (LD (Vertex, Vertex, Vertex)
_, EdgeType
Join,  RD (Vertex, Vertex, Vertex)
_ , EdgeType
Join ) = Bool
True
legal (RD (Vertex, Vertex, Vertex)
_, EdgeType
Join,  LD (Vertex, Vertex, Vertex)
_ , EdgeType
Join ) = Bool
True
legal (LD (Vertex, Vertex, Vertex)
_, EdgeType
Long,  RD (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (RD (Vertex, Vertex, Vertex)
_, EdgeType
Long,  LD (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (LD (Vertex, Vertex, Vertex)
_, EdgeType
Short, RK (Vertex, Vertex, Vertex)
_ , EdgeType
Short) = Bool
True
legal (RK (Vertex, Vertex, Vertex)
_, EdgeType
Short, LD (Vertex, Vertex, Vertex)
_ , EdgeType
Short) = Bool
True
legal (LD (Vertex, Vertex, Vertex)
_, EdgeType
Long,  RK (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (RK (Vertex, Vertex, Vertex)
_, EdgeType
Long,  LD (Vertex, Vertex, Vertex)
_ , EdgeType
Long ) = Bool
True
legal (TileFace, EdgeType, TileFace, EdgeType)
_ = Bool
False               

-- | Returns a list of illegal face parings of the form (f1,e1,f2,e2) where f1 and f2 share an edge
-- and e1 is the type of this edge in f1, and e2 is the type of this edge in f2.
-- The list should be null for a legal Tgraph.
illegals:: [TileFace] -> [(TileFace,EdgeType,TileFace,EdgeType)]
illegals :: [TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
illegals = ((TileFace, EdgeType, TileFace, EdgeType) -> Bool)
-> [(TileFace, EdgeType, TileFace, EdgeType)]
-> [(TileFace, EdgeType, TileFace, EdgeType)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((TileFace, EdgeType, TileFace, EdgeType) -> Bool)
-> (TileFace, EdgeType, TileFace, EdgeType)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace, EdgeType, TileFace, EdgeType) -> Bool
legal) ([(TileFace, EdgeType, TileFace, EdgeType)]
 -> [(TileFace, EdgeType, TileFace, EdgeType)])
-> ([TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)])
-> [TileFace]
-> [(TileFace, EdgeType, TileFace, EdgeType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
sharedEdges

-- | Returns True if there are conflicting directed edges or if there are illegal shared edges
-- in the list of tile faces
illegalTiling:: [TileFace] -> Bool
illegalTiling :: [TileFace] -> Bool
illegalTiling [TileFace]
fcs = Bool -> Bool
not ([(TileFace, EdgeType, TileFace, EdgeType)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TileFace] -> [(TileFace, EdgeType, TileFace, EdgeType)]
illegals [TileFace]
fcs)) Bool -> Bool -> Bool
|| Bool -> Bool
not ([Dedge] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TileFace] -> [Dedge]
conflictingDedges [TileFace]
fcs))

-- |crossingBVs fcs returns a list of vertices with crossing boundaries
-- (which should be null).               
crossingBVs :: [TileFace] -> [Vertex]
crossingBVs :: [TileFace] -> [Vertex]
crossingBVs = [Dedge] -> [Vertex]
crossingVertices ([Dedge] -> [Vertex])
-> ([TileFace] -> [Dedge]) -> [TileFace] -> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> [Dedge]
facesBoundary 

-- |Given a list of directed boundary edges, crossingVertices returns a list of vertices occurring
-- more than once at the start of the directed edges in the list.
-- Used for finding crossing boundary vertices when the boundary is already calculated.
crossingVertices:: [Dedge] -> [Vertex]
crossingVertices :: [Dedge] -> [Vertex]
crossingVertices [Dedge]
des = [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a]
duplicates ((Dedge -> Vertex) -> [Dedge] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Vertex
forall a b. (a, b) -> a
fst [Dedge]
des) -- OR duplicates (fmap snd des)

-- |There are crossing boundaries if vertices occur more than once
-- at the start of all boundary directed edges
-- (or more than once at the end of all boundary directed edges).
crossingBoundaries :: [TileFace] -> Bool
crossingBoundaries :: [TileFace] -> Bool
crossingBoundaries = Bool -> Bool
not (Bool -> Bool) -> ([TileFace] -> Bool) -> [TileFace] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Vertex] -> Bool)
-> ([TileFace] -> [Vertex]) -> [TileFace] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> [Vertex]
crossingBVs

-- |Predicate to check a Tgraph is a connected graph.
connected:: [TileFace] -> Bool
connected :: [TileFace] -> Bool
connected [] =  Bool
True
connected [TileFace]
fcs = [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (([Vertex], [Vertex]) -> [Vertex]
forall a b. (a, b) -> b
snd (([Vertex], [Vertex]) -> [Vertex])
-> ([Vertex], [Vertex]) -> [Vertex]
forall a b. (a -> b) -> a -> b
$ [Dedge] -> Vertex -> VertexSet -> ([Vertex], [Vertex])
connectedBy ([TileFace] -> [Dedge]
facesEdges [TileFace]
fcs) (VertexSet -> Vertex
IntSet.findMin VertexSet
vs) VertexSet
vs)
                   where vs :: VertexSet
vs = [TileFace] -> VertexSet
facesVSet [TileFace]
fcs

-- |Auxiliary function for calculating connectedness.
-- connectedBy edges v verts returns a pair of lists of vertices (conn,unconn)
-- where conn is a list of vertices from the set verts that are connected to v by a chain of edges,
-- and unconn is a list of vertices from set verts that are not connected to v.
-- This version creates an IntMap to represent edges (Vertex to [Vertex])
-- and uses IntSets for the search algorithm arguments.
connectedBy :: [Dedge] -> Vertex -> VertexSet -> ([Vertex],[Vertex])
connectedBy :: [Dedge] -> Vertex -> VertexSet -> ([Vertex], [Vertex])
connectedBy [Dedge]
edges Vertex
v VertexSet
verts = VertexSet -> VertexSet -> VertexSet -> ([Vertex], [Vertex])
search VertexSet
IntSet.empty (Vertex -> VertexSet
IntSet.singleton Vertex
v) (Vertex -> VertexSet -> VertexSet
IntSet.delete Vertex
v VertexSet
verts) where 
  nextMap :: IntMap [Vertex]
nextMap = ([Vertex] -> [Vertex] -> [Vertex])
-> [(Vertex, [Vertex])] -> IntMap [Vertex]
forall a. (a -> a -> a) -> [(Vertex, a)] -> IntMap a
VMap.fromListWith [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
(++) ([(Vertex, [Vertex])] -> IntMap [Vertex])
-> [(Vertex, [Vertex])] -> IntMap [Vertex]
forall a b. (a -> b) -> a -> b
$ (Dedge -> (Vertex, [Vertex])) -> [Dedge] -> [(Vertex, [Vertex])]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex
a,Vertex
b)->(Vertex
a,[Vertex
b])) [Dedge]
edges
-- search arguments (sets):  done (=processed), visited, unvisited.
  search :: VertexSet -> VertexSet -> VertexSet -> ([Vertex], [Vertex])
search VertexSet
done VertexSet
visited VertexSet
unvisited 
    | VertexSet -> Bool
IntSet.null VertexSet
unvisited = (VertexSet -> [Vertex]
IntSet.toList VertexSet
visited [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
++ VertexSet -> [Vertex]
IntSet.toList VertexSet
done,[])
    | VertexSet -> Bool
IntSet.null VertexSet
visited = (VertexSet -> [Vertex]
IntSet.toList VertexSet
done, VertexSet -> [Vertex]
IntSet.toList VertexSet
unvisited)  -- any unvisited are not connected
    | Bool
otherwise =
        VertexSet -> VertexSet -> VertexSet -> ([Vertex], [Vertex])
search (Vertex -> VertexSet -> VertexSet
IntSet.insert Vertex
x VertexSet
done) (VertexSet -> VertexSet -> VertexSet
IntSet.union VertexSet
newVs VertexSet
visited') (VertexSet
unvisited VertexSet -> VertexSet -> VertexSet
IntSet.\\ VertexSet
newVs)
        where x :: Vertex
x = VertexSet -> Vertex
IntSet.findMin VertexSet
visited
              visited' :: VertexSet
visited' = VertexSet -> VertexSet
IntSet.deleteMin VertexSet
visited
              newVs :: VertexSet
newVs = [Vertex] -> VertexSet
IntSet.fromList ([Vertex] -> VertexSet) -> [Vertex] -> VertexSet
forall a b. (a -> b) -> a -> b
$ (Vertex -> Bool) -> [Vertex] -> [Vertex]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex -> VertexSet -> Bool
`IntSet.notMember` VertexSet
done) ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex]
forall a b. (a -> b) -> a -> b
$ IntMap [Vertex]
nextMap IntMap [Vertex] -> Vertex -> [Vertex]
forall a. IntMap a -> Vertex -> a
VMap.! Vertex
x 



-- |Retrieve the faces of a Tgraph
faces :: Tgraph -> [TileFace]
faces :: Tgraph -> [TileFace]
faces (Tgraph [TileFace]
fcs) = [TileFace]
fcs

-- |The empty Tgraph
emptyTgraph :: Tgraph
emptyTgraph :: Tgraph
emptyTgraph = [TileFace] -> Tgraph
Tgraph []

-- |is the Tgraph empty?
nullGraph:: Tgraph -> Bool
nullGraph :: Tgraph -> Bool
nullGraph = [TileFace] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([TileFace] -> Bool) -> (Tgraph -> [TileFace]) -> Tgraph -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |find the maximum vertex number in a Tgraph, returning 0 for an empty Tgraph.
maxV :: Tgraph -> Int
maxV :: Tgraph -> Vertex
maxV = [TileFace] -> Vertex
facesMaxV ([TileFace] -> Vertex)
-> (Tgraph -> [TileFace]) -> Tgraph -> Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

ldarts,rdarts,lkites,rkites, kites, darts :: Tgraph -> [TileFace]
-- | selecting left darts from a Tgraph
ldarts :: Tgraph -> [TileFace]
ldarts = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isLD ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces
-- | selecting right darts from a Tgraph
rdarts :: Tgraph -> [TileFace]
rdarts = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isRD ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces
-- | selecting left kites from a Tgraph
lkites :: Tgraph -> [TileFace]
lkites = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isLK ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces
-- | selecting right kites from a Tgraph
rkites :: Tgraph -> [TileFace]
rkites = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isRK ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces 
-- | selecting half kites from a Tgraph
kites :: Tgraph -> [TileFace]
kites = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isKite ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces
-- | selecting half darts from a Tgraph
darts :: Tgraph -> [TileFace]
darts = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart ([TileFace] -> [TileFace])
-> (Tgraph -> [TileFace]) -> Tgraph -> [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |selects faces from a Tgraph (removing any not in the list),
-- but checks resulting Tgraph for connectedness and no crossing boundaries.
selectFaces :: [TileFace] -> Tgraph -> Tgraph
selectFaces :: [TileFace] -> Tgraph -> Tgraph
selectFaces [TileFace]
fcs Tgraph
g = Try Tgraph -> Tgraph
forall a. Try a -> a
runTry (Try Tgraph -> Tgraph) -> Try Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ [TileFace] -> Try Tgraph
tryConnectedNoCross ([TileFace] -> Try Tgraph) -> [TileFace] -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
faces Tgraph
g [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [TileFace]
fcs

-- |removes faces from a Tgraph,
-- but checks resulting Tgraph for connectedness and no crossing boundaries.
removeFaces :: [TileFace] -> Tgraph -> Tgraph
removeFaces :: [TileFace] -> Tgraph -> Tgraph
removeFaces [TileFace]
fcs Tgraph
g = Try Tgraph -> Tgraph
forall a. Try a -> a
runTry (Try Tgraph -> Tgraph) -> Try Tgraph -> Tgraph
forall a b. (a -> b) -> a -> b
$ [TileFace] -> Try Tgraph
tryConnectedNoCross ([TileFace] -> Try Tgraph) -> [TileFace] -> Try Tgraph
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
faces Tgraph
g [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
\\ [TileFace]
fcs

-- |removeVertices vs g - removes any vertex in the list vs from g
-- by removing all faces at those vertices. Resulting Tgraph is checked
-- for required properties  e.g. connectedness and no crossing boundaries.
removeVertices :: [Vertex] -> Tgraph -> Tgraph
removeVertices :: [Vertex] -> Tgraph -> Tgraph
removeVertices [Vertex]
vs Tgraph
g = [TileFace] -> Tgraph -> Tgraph
removeFaces ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Vertex] -> TileFace -> Bool
hasVIn [Vertex]
vs) (Tgraph -> [TileFace]
faces Tgraph
g)) Tgraph
g

-- |selectVertices vs g - removes any face that does not have a vertex in the list vs from g.
-- Resulting Tgraph is checked
-- for required properties  e.g. connectedness and no crossing boundaries.
selectVertices :: [Vertex] -> Tgraph -> Tgraph
selectVertices :: [Vertex] -> Tgraph -> Tgraph
selectVertices [Vertex]
vs Tgraph
g = [TileFace] -> Tgraph -> Tgraph
selectFaces ((TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Vertex] -> TileFace -> Bool
hasVIn [Vertex]
vs) (Tgraph -> [TileFace]
faces Tgraph
g)) Tgraph
g

-- |the set of vertices of a Tgraph
vertexSet:: Tgraph -> VertexSet
vertexSet :: Tgraph -> VertexSet
vertexSet = [TileFace] -> VertexSet
facesVSet ([TileFace] -> VertexSet)
-> (Tgraph -> [TileFace]) -> Tgraph -> VertexSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |A list of all the directed edges of a Tgraph (going clockwise round faces)
graphDedges :: Tgraph -> [Dedge]
graphDedges :: Tgraph -> [Dedge]
graphDedges = [TileFace] -> [Dedge]
facesDedges ([TileFace] -> [Dedge])
-> (Tgraph -> [TileFace]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |graphEdges returns a list of all the edges of a Tgraph (both directions of each edge).
graphEdges :: Tgraph -> [Dedge]
graphEdges :: Tgraph -> [Dedge]
graphEdges = [TileFace] -> [Dedge]
facesEdges ([TileFace] -> [Dedge])
-> (Tgraph -> [TileFace]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |internal edges are shared by two faces = all edges except boundary edges
internalEdges :: Tgraph -> [Dedge]
internalEdges :: Tgraph -> [Dedge]
internalEdges Tgraph
g =  [Dedge]
des [Dedge] -> [Dedge] -> [Dedge]
forall a. Eq a => [a] -> [a] -> [a]
\\ (Dedge -> Dedge) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Dedge
reverseD ([Dedge] -> [Dedge]
missingRevs [Dedge]
des) where
    des :: [Dedge]
des = Tgraph -> [Dedge]
graphDedges Tgraph
g

-- |graphBoundary g are missing reverse directed edges in graphDedges g (the result contains single directions only)
-- Direction is such that a face is on LHS and exterior is on RHS of each boundary directed edge.
graphBoundary :: Tgraph -> [Dedge]
graphBoundary :: Tgraph -> [Dedge]
graphBoundary = [TileFace] -> [Dedge]
facesBoundary ([TileFace] -> [Dedge])
-> (Tgraph -> [TileFace]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |phiEdges returns a list of the longer (phi-length) edges of a Tgraph (including kite joins).
-- This includes both directions of each edge.
phiEdges :: Tgraph -> [Dedge]
phiEdges :: Tgraph -> [Dedge]
phiEdges = [Dedge] -> [Dedge]
bothDir ([Dedge] -> [Dedge]) -> (Tgraph -> [Dedge]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace -> [Dedge]) -> [TileFace] -> [Dedge]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TileFace -> [Dedge]
facePhiEdges ([TileFace] -> [Dedge])
-> (Tgraph -> [TileFace]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |nonPhiEdges returns a list of the shorter edges of a Tgraph (including dart joins).
-- This includes both directions of each edge.
nonPhiEdges :: Tgraph -> [Dedge]
nonPhiEdges :: Tgraph -> [Dedge]
nonPhiEdges = [Dedge] -> [Dedge]
bothDir ([Dedge] -> [Dedge]) -> (Tgraph -> [Dedge]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace -> [Dedge]) -> [TileFace] -> [Dedge]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TileFace -> [Dedge]
faceNonPhiEdges ([TileFace] -> [Dedge])
-> (Tgraph -> [TileFace]) -> Tgraph -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces 

-- | graphEFMap g - is a mapping associating with each directed edge of g, the unique TileFace with that directed edge.
-- This is more efficient than using dedgesFacesMap for the complete mapping.
graphEFMap :: Tgraph -> Map.Map Dedge TileFace
graphEFMap :: Tgraph -> Map Dedge TileFace
graphEFMap = [TileFace] -> Map Dedge TileFace
buildEFMap ([TileFace] -> Map Dedge TileFace)
-> (Tgraph -> [TileFace]) -> Tgraph -> Map Dedge TileFace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> [TileFace]
faces

-- |the default alignment of a non-empty Tgraph is (v1,v2) where v1 is the lowest numbered face origin,
-- and v2 is the lowest numbered opp vertex of faces with origin at v1. This is the lowest join of g.
-- An error will be raised if the Tgraph is empty.
defaultAlignment :: Tgraph -> (Vertex,Vertex)
defaultAlignment :: Tgraph -> Dedge
defaultAlignment Tgraph
g | Tgraph -> Bool
nullGraph Tgraph
g = String -> Dedge
forall a. HasCallStack => String -> a
error String
"defaultAlignment: applied to empty Tgraph\n"
                   | Bool
otherwise = [TileFace] -> Dedge
lowestJoin ([TileFace] -> Dedge) -> [TileFace] -> Dedge
forall a b. (a -> b) -> a -> b
$ Tgraph -> [TileFace]
faces Tgraph
g


-- |triple of face vertices in order clockwise starting with origin - tileRep specialised to TileFace
faceVs::TileFace -> (Vertex,Vertex,Vertex)
faceVs :: TileFace -> (Vertex, Vertex, Vertex)
faceVs = TileFace -> (Vertex, Vertex, Vertex)
forall rep. HalfTile rep -> rep
tileRep

-- |list of (three) face vertices in order clockwise starting with origin
faceVList::TileFace -> [Vertex]
faceVList :: TileFace -> [Vertex]
faceVList = (\(Vertex
x,Vertex
y,Vertex
z) -> [Vertex
x,Vertex
y,Vertex
z]) ((Vertex, Vertex, Vertex) -> [Vertex])
-> (TileFace -> (Vertex, Vertex, Vertex)) -> TileFace -> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> (Vertex, Vertex, Vertex)
faceVs

-- |the set of vertices of a face
faceVSet :: TileFace -> VertexSet
faceVSet :: TileFace -> VertexSet
faceVSet = [Vertex] -> VertexSet
IntSet.fromList ([Vertex] -> VertexSet)
-> (TileFace -> [Vertex]) -> TileFace -> VertexSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> [Vertex]
faceVList

-- |the set of vertices of a list of faces
facesVSet:: [TileFace] -> VertexSet
facesVSet :: [TileFace] -> VertexSet
facesVSet = [VertexSet] -> VertexSet
forall a. Monoid a => [a] -> a
mconcat ([VertexSet] -> VertexSet)
-> ([TileFace] -> [VertexSet]) -> [TileFace] -> VertexSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace -> VertexSet) -> [TileFace] -> [VertexSet]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> VertexSet
faceVSet

-- |find the maximum vertex for a list of faces (0 for an empty list).
facesMaxV :: [TileFace] -> Vertex
facesMaxV :: [TileFace] -> Vertex
facesMaxV [] = Vertex
0
facesMaxV [TileFace]
fcs = VertexSet -> Vertex
IntSet.findMax (VertexSet -> Vertex) -> VertexSet -> Vertex
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexSet
facesVSet [TileFace]
fcs

-- Whilst first, second and third vertex of a face are obvious (clockwise), 
-- it is often more convenient to refer to the originV (=firstV),
-- oppV (the vertex at the other end of the join edge), and
-- wingV (the remaining vertex not on the join edge)

-- |firstV, secondV and thirdV vertices of a face are counted clockwise starting with the origin
firstV,secondV,thirdV:: TileFace -> Vertex
firstV :: TileFace -> Vertex
firstV  TileFace
face = Vertex
a where (Vertex
a,Vertex
_,Vertex
_) = TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face
secondV :: TileFace -> Vertex
secondV TileFace
face = Vertex
b where (Vertex
_,Vertex
b,Vertex
_) = TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face
thirdV :: TileFace -> Vertex
thirdV  TileFace
face = Vertex
c where (Vertex
_,Vertex
_,Vertex
c) = TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face

originV,wingV,oppV:: TileFace -> Vertex
-- |the origin vertex of a face (firstV)
originV :: TileFace -> Vertex
originV = TileFace -> Vertex
firstV
-- |wingV returns the vertex not on the join edge of a face
wingV :: TileFace -> Vertex
wingV (LD(Vertex
_,Vertex
_,Vertex
c)) = Vertex
c
wingV (RD(Vertex
_,Vertex
b,Vertex
_)) = Vertex
b
wingV (LK(Vertex
_,Vertex
b,Vertex
_)) = Vertex
b
wingV (RK(Vertex
_,Vertex
_,Vertex
c)) = Vertex
c
-- |oppV returns the vertex at the opposite end of the join edge from the origin of a face
oppV :: TileFace -> Vertex
oppV (LD(Vertex
_,Vertex
b,Vertex
_)) = Vertex
b
oppV (RD(Vertex
_,Vertex
_,Vertex
c)) = Vertex
c
oppV (LK(Vertex
_,Vertex
_,Vertex
c)) = Vertex
c
oppV (RK(Vertex
_,Vertex
b,Vertex
_)) = Vertex
b

-- |indexV finds the index of a vertex in a face (firstV -> 0, secondV -> 1, thirdV -> 2)
indexV :: Vertex -> TileFace -> Int
indexV :: Vertex -> TileFace -> Vertex
indexV Vertex
v TileFace
face = case Vertex -> [Vertex] -> Maybe Vertex
forall a. Eq a => a -> [a] -> Maybe Vertex
elemIndex Vertex
v (TileFace -> [Vertex]
faceVList TileFace
face) of
                  Just Vertex
i -> Vertex
i
                  Maybe Vertex
_      -> String -> Vertex
forall a. HasCallStack => String -> a
error (String
"indexV: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found in " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
face)                

-- |nextV returns the next vertex in a face going clockwise from v
-- where v must be a vertex of the face
nextV :: Vertex -> TileFace -> Vertex
nextV :: Vertex -> TileFace -> Vertex
nextV Vertex
v TileFace
face = case Vertex -> TileFace -> Vertex
indexV Vertex
v TileFace
face of
                    Vertex
0 -> TileFace -> Vertex
secondV TileFace
face
                    Vertex
1 -> TileFace -> Vertex
thirdV TileFace
face
                    Vertex
2 -> TileFace -> Vertex
firstV TileFace
face
                    Vertex
_ -> String -> Vertex
forall a. HasCallStack => String -> a
error String
"nextV: index error"
-- |prevV returns the previous vertex in a face (i.e. next going anti-clockwise) from v
-- where v must be a vertex of the face
prevV :: Vertex -> TileFace -> Vertex
prevV :: Vertex -> TileFace -> Vertex
prevV Vertex
v TileFace
face = case Vertex -> TileFace -> Vertex
indexV Vertex
v TileFace
face of
                    Vertex
0 -> TileFace -> Vertex
thirdV TileFace
face
                    Vertex
1 -> TileFace -> Vertex
firstV TileFace
face
                    Vertex
2 -> TileFace -> Vertex
secondV TileFace
face
                    Vertex
_ -> String -> Vertex
forall a. HasCallStack => String -> a
error String
"prevV: index error"

-- |isAtV v f asks if a face f has v as a vertex
isAtV:: Vertex -> TileFace -> Bool           
isAtV :: Vertex -> TileFace -> Bool
isAtV Vertex
v (LD(Vertex
a,Vertex
b,Vertex
c))  =  Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c
isAtV Vertex
v (RD(Vertex
a,Vertex
b,Vertex
c))  =  Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c
isAtV Vertex
v (LK(Vertex
a,Vertex
b,Vertex
c))  =  Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c
isAtV Vertex
v (RK(Vertex
a,Vertex
b,Vertex
c))  =  Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
a Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
b Bool -> Bool -> Bool
|| Vertex
vVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==Vertex
c

-- |hasVIn vs f - asks if face f has an element of vs as a vertex
hasVIn:: [Vertex] -> TileFace -> Bool           
hasVIn :: [Vertex] -> TileFace -> Bool
hasVIn [Vertex]
vs TileFace
face = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Vertex] -> Bool) -> [Vertex] -> Bool
forall a b. (a -> b) -> a -> b
$ TileFace -> [Vertex]
faceVList TileFace
face [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Vertex]
vs


{- $Edges
Edges: (a,b) is regarded as a directed edge from a to b.
A list of such pairs will usually be regarded as a list of directed edges.
In the special case that the list is symmetrically closed [(b,a) is in the list whenever (a,b) is in the list]
we will refer to this as an edge list rather than a directed edge list.                  
-}


-- |directed edges (clockwise) round a face.
faceDedges::TileFace -> [Dedge]
faceDedges :: TileFace -> [Dedge]
faceDedges (LD(Vertex
a,Vertex
b,Vertex
c)) = [(Vertex
a,Vertex
b),(Vertex
b,Vertex
c),(Vertex
c,Vertex
a)]
faceDedges (RD(Vertex
a,Vertex
b,Vertex
c)) = [(Vertex
a,Vertex
b),(Vertex
b,Vertex
c),(Vertex
c,Vertex
a)]
faceDedges (LK(Vertex
a,Vertex
b,Vertex
c)) = [(Vertex
a,Vertex
b),(Vertex
b,Vertex
c),(Vertex
c,Vertex
a)]
faceDedges (RK(Vertex
a,Vertex
b,Vertex
c)) = [(Vertex
a,Vertex
b),(Vertex
b,Vertex
c),(Vertex
c,Vertex
a)]

-- |Returns the list of all directed edges (clockwise round each) of a list of tile faces.
facesDedges :: [TileFace] -> [Dedge]
facesDedges :: [TileFace] -> [Dedge]
facesDedges = (TileFace -> [Dedge]) -> [TileFace] -> [Dedge]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TileFace -> [Dedge]
faceDedges

-- |opposite directed edge.
reverseD:: Dedge -> Dedge
reverseD :: Dedge -> Dedge
reverseD (Vertex
a,Vertex
b) = (Vertex
b,Vertex
a)

{-
-- |firstE, secondE and thirdE are the directed edges of a face counted clockwise from the origin, 
firstE,secondE,thirdE:: TileFace -> Dedge
firstE = head . faceDedges
secondE = head . tail . faceDedges
thirdE = head . tail . tail . faceDedges
-}

joinE, shortE, longE, joinOfTile:: TileFace -> Dedge
-- |the join directed edge of a face in the clockwise direction going round the face (see also joinOfTile).
joinE :: TileFace -> Dedge
joinE (LD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex
a,Vertex
b)
joinE (RD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex
c,Vertex
a)
joinE (LK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex
c,Vertex
a)
joinE (RK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex
a,Vertex
b)
-- |The short directed edge of a face in the clockwise direction going round the face.
-- This is the non-join short edge for darts.
shortE :: TileFace -> Dedge
shortE (LD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex
b,Vertex
c)
shortE (RD(Vertex
_,Vertex
b,Vertex
c)) = (Vertex
b,Vertex
c)
shortE (LK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex
b,Vertex
c)
shortE (RK(Vertex
_,Vertex
b,Vertex
c)) = (Vertex
b,Vertex
c)

-- |The long directed edge of a face in the clockwise direction going round the face.
-- This is the non-join long edge for kites.
longE :: TileFace -> Dedge
longE (LD(Vertex
a,Vertex
_,Vertex
c)) = (Vertex
c,Vertex
a)
longE (RD(Vertex
a,Vertex
b,Vertex
_)) = (Vertex
a,Vertex
b)
longE (LK(Vertex
a,Vertex
b,Vertex
_)) = (Vertex
a,Vertex
b) 
longE (RK(Vertex
a,Vertex
_,Vertex
c)) = (Vertex
c,Vertex
a)

-- |The join edge of a face directed from the origin (not clockwise for RD and LK)
joinOfTile :: TileFace -> Dedge
joinOfTile TileFace
face = (TileFace -> Vertex
originV TileFace
face, TileFace -> Vertex
oppV TileFace
face)

facePhiEdges, faceNonPhiEdges::  TileFace -> [Dedge]
-- |The phi edges of a face (both directions)
-- which is long edges for darts, and join and long edges for kites
facePhiEdges :: TileFace -> [Dedge]
facePhiEdges face :: TileFace
face@(RD (Vertex, Vertex, Vertex)
_) = [Dedge
e, Dedge -> Dedge
reverseD Dedge
e] where e :: Dedge
e = TileFace -> Dedge
longE TileFace
face
facePhiEdges face :: TileFace
face@(LD (Vertex, Vertex, Vertex)
_) = [Dedge
e, Dedge -> Dedge
reverseD Dedge
e] where e :: Dedge
e = TileFace -> Dedge
longE TileFace
face
facePhiEdges TileFace
face        = [Dedge
e, Dedge -> Dedge
reverseD Dedge
e, Dedge
j, Dedge -> Dedge
reverseD Dedge
j] 
                         where e :: Dedge
e = TileFace -> Dedge
longE TileFace
face
                               j :: Dedge
j = TileFace -> Dedge
joinE TileFace
face

-- |The non-phi edges of a face (both directions)
-- which is short edges for kites, and join and short edges for darts.
faceNonPhiEdges :: TileFace -> [Dedge]
faceNonPhiEdges TileFace
face = [Dedge] -> [Dedge]
bothDirOneWay (TileFace -> [Dedge]
faceDedges TileFace
face) [Dedge] -> [Dedge] -> [Dedge]
forall a. Eq a => [a] -> [a] -> [a]
\\ TileFace -> [Dedge]
facePhiEdges TileFace
face

-- |matchingE eselect face is a predicate on tile faces 
-- where eselect selects a particular edge type of a face
-- (eselect could be joinE or longE or shortE for example).
-- This is True for face' if face' has an eselect edge matching the (reversed) eselect edge of face.
matchingE :: (TileFace -> Dedge) -> TileFace -> TileFace -> Bool
matchingE :: (TileFace -> Dedge) -> TileFace -> TileFace -> Bool
matchingE TileFace -> Dedge
eselect TileFace
face = (Dedge -> Dedge -> Bool
forall a. Eq a => a -> a -> Bool
== Dedge -> Dedge
reverseD (TileFace -> Dedge
eselect TileFace
face)) (Dedge -> Bool) -> (TileFace -> Dedge) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Dedge
eselect

matchingLongE,matchingShortE,matchingJoinE ::  TileFace -> TileFace -> Bool
      -- Used in Compose (getDartWingInfo and composedFaceGroups).
-- |check if two TileFaces have opposite directions for their long edge.
matchingLongE :: TileFace -> TileFace -> Bool
matchingLongE  = (TileFace -> Dedge) -> TileFace -> TileFace -> Bool
matchingE TileFace -> Dedge
longE
-- |check if two TileFaces have opposite directions for their short edge.
matchingShortE :: TileFace -> TileFace -> Bool
matchingShortE = (TileFace -> Dedge) -> TileFace -> TileFace -> Bool
matchingE TileFace -> Dedge
shortE
-- |check if two TileFaces have opposite directions for their join edge.
matchingJoinE :: TileFace -> TileFace -> Bool
matchingJoinE  = (TileFace -> Dedge) -> TileFace -> TileFace -> Bool
matchingE TileFace -> Dedge
joinE

-- |hasDedge f e returns True if directed edge e is one of the directed edges of face f
hasDedge :: TileFace -> Dedge -> Bool
hasDedge :: TileFace -> Dedge -> Bool
hasDedge TileFace
f Dedge
e = Dedge
e Dedge -> [Dedge] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` TileFace -> [Dedge]
faceDedges TileFace
f

-- |hasDedgeIn f es - is True if face f has a directed edge in the list of directed edges es.
hasDedgeIn :: TileFace -> [Dedge] -> Bool
hasDedgeIn :: TileFace -> [Dedge] -> Bool
hasDedgeIn TileFace
face [Dedge]
es = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Dedge] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Dedge] -> Bool) -> [Dedge] -> Bool
forall a b. (a -> b) -> a -> b
$ [Dedge]
es [Dedge] -> [Dedge] -> [Dedge]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` TileFace -> [Dedge]
faceDedges TileFace
face

-- |facesEdges returns a list of all the edges of a list of TileFaces (both directions of each edge).
facesEdges :: [TileFace] -> [Dedge]
facesEdges :: [TileFace] -> [Dedge]
facesEdges = [Dedge] -> [Dedge]
bothDir ([Dedge] -> [Dedge])
-> ([TileFace] -> [Dedge]) -> [TileFace] -> [Dedge]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TileFace] -> [Dedge]
facesDedges

-- |bothDir adds missing reverse directed edges to a list of directed edges
-- to complete edges (Result is a complete edge list)
-- It assumes no duplicates in argument.
bothDir:: [Dedge] -> [Dedge]
bothDir :: [Dedge] -> [Dedge]
bothDir [Dedge]
es = [Dedge] -> [Dedge]
missingRevs [Dedge]
es [Dedge] -> [Dedge] -> [Dedge]
forall a. [a] -> [a] -> [a]
++ [Dedge]
es

-- |bothDirOneWay adds all the reverse directed edges to a list of directed edges
-- without checking for duplicates.
-- Should be used on lists with single directions only.
-- If the argument may contain reverse directions, use bothDir to avoid duplicates.
bothDirOneWay:: [Dedge] -> [Dedge]
bothDirOneWay :: [Dedge] -> [Dedge]
bothDirOneWay [] = []
bothDirOneWay (e :: Dedge
e@(Vertex
a,Vertex
b):[Dedge]
es)= Dedge
eDedge -> [Dedge] -> [Dedge]
forall a. a -> [a] -> [a]
:(Vertex
b,Vertex
a)Dedge -> [Dedge] -> [Dedge]
forall a. a -> [a] -> [a]
:[Dedge] -> [Dedge]
bothDirOneWay [Dedge]
es

-- |facesBoundary fcs are missing reverse directed edges in facesDedges fcs (the result contains single directions only)
-- Direction is such that a face is on LHS and exterior is on RHS of each boundary directed edge.
facesBoundary :: [TileFace] -> [Dedge]
facesBoundary :: [TileFace] -> [Dedge]
facesBoundary [TileFace]
fcs = [Dedge] -> [Dedge]
missingRevs ([Dedge] -> [Dedge]) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> a -> b
$ [TileFace] -> [Dedge]
facesDedges [TileFace]
fcs


-- | efficiently finds missing reverse directions from a list of directed edges (using IntMap)
missingRevs:: [Dedge] -> [Dedge]
missingRevs :: [Dedge] -> [Dedge]
missingRevs [Dedge]
es = [Dedge] -> [Dedge]
revUnmatched [Dedge]
es where
    vmap :: IntMap [Vertex]
vmap = ([Vertex] -> [Vertex] -> [Vertex])
-> [(Vertex, [Vertex])] -> IntMap [Vertex]
forall a. (a -> a -> a) -> [(Vertex, a)] -> IntMap a
VMap.fromListWith [Vertex] -> [Vertex] -> [Vertex]
forall a. [a] -> [a] -> [a]
(++) ([(Vertex, [Vertex])] -> IntMap [Vertex])
-> [(Vertex, [Vertex])] -> IntMap [Vertex]
forall a b. (a -> b) -> a -> b
$ (Dedge -> (Vertex, [Vertex])) -> [Dedge] -> [(Vertex, [Vertex])]
forall a b. (a -> b) -> [a] -> [b]
map Dedge -> (Vertex, [Vertex])
forall {a} {a}. (a, a) -> (a, [a])
singleton [Dedge]
es
    singleton :: (a, a) -> (a, [a])
singleton (a
a,a
b) = (a
a,[a
b])
    seekR :: Dedge -> Bool
seekR (Vertex
a,Vertex
b) = case Vertex -> IntMap [Vertex] -> Maybe [Vertex]
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
b IntMap [Vertex]
vmap of
                   Maybe [Vertex]
Nothing -> Bool
False
                   Just [Vertex]
vs -> Vertex
a Vertex -> [Vertex] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Vertex]
vs
                    
    revUnmatched :: [Dedge] -> [Dedge]
revUnmatched [] = []
    revUnmatched (e :: Dedge
e@(Vertex
a,Vertex
b):[Dedge]
more) | Dedge -> Bool
seekR Dedge
e = [Dedge] -> [Dedge]
revUnmatched [Dedge]
more
                                | Bool
otherwise = (Vertex
b,Vertex
a)Dedge -> [Dedge] -> [Dedge]
forall a. a -> [a] -> [a]
:[Dedge] -> [Dedge]
revUnmatched [Dedge]
more


-- |two tile faces are edge neighbours
edgeNb::TileFace -> TileFace -> Bool
edgeNb :: TileFace -> TileFace -> Bool
edgeNb TileFace
face = (Dedge -> Bool) -> [Dedge] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Dedge -> [Dedge] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Dedge]
edges) ([Dedge] -> Bool) -> (TileFace -> [Dedge]) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> [Dedge]
faceDedges where
      edges :: [Dedge]
edges = (Dedge -> Dedge) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Dedge
reverseD (TileFace -> [Dedge]
faceDedges TileFace
face)



{-|vertexFacesMap vs fcs -
For list of vertices vs and list of faces fcs,
create an IntMap from each vertex in vs to a list of those faces in fcs that are at that vertex.
-}
vertexFacesMap:: [Vertex] -> [TileFace] -> VertexMap [TileFace]
vertexFacesMap :: [Vertex] -> [TileFace] -> VertexMap [TileFace]
vertexFacesMap [Vertex]
vs = (VertexMap [TileFace] -> TileFace -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [TileFace] -> VertexMap [TileFace]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' VertexMap [TileFace] -> TileFace -> VertexMap [TileFace]
insertf VertexMap [TileFace]
startVF where
    startVF :: VertexMap [TileFace]
startVF = [(Vertex, [TileFace])] -> VertexMap [TileFace]
forall a. [(Vertex, a)] -> IntMap a
VMap.fromList ([(Vertex, [TileFace])] -> VertexMap [TileFace])
-> [(Vertex, [TileFace])] -> VertexMap [TileFace]
forall a b. (a -> b) -> a -> b
$ (Vertex -> (Vertex, [TileFace]))
-> [Vertex] -> [(Vertex, [TileFace])]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[]) [Vertex]
vs
    insertf :: VertexMap [TileFace] -> TileFace -> VertexMap [TileFace]
insertf VertexMap [TileFace]
vfmap TileFace
f = (Vertex -> VertexMap [TileFace] -> VertexMap [TileFace])
-> VertexMap [TileFace] -> [Vertex] -> VertexMap [TileFace]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Maybe [TileFace] -> Maybe [TileFace])
-> Vertex -> VertexMap [TileFace] -> VertexMap [TileFace]
forall a. (Maybe a -> Maybe a) -> Vertex -> IntMap a -> IntMap a
VMap.alter Maybe [TileFace] -> Maybe [TileFace]
addf) VertexMap [TileFace]
vfmap (TileFace -> [Vertex]
faceVList TileFace
f)
                      where addf :: Maybe [TileFace] -> Maybe [TileFace]
addf Maybe [TileFace]
Nothing = Maybe [TileFace]
forall a. Maybe a
Nothing
                            addf (Just [TileFace]
fs) = [TileFace] -> Maybe [TileFace]
forall a. a -> Maybe a
Just (TileFace
fTileFace -> [TileFace] -> [TileFace]
forall a. a -> [a] -> [a]
:[TileFace]
fs)

-- | dedgesFacesMap des fcs - Produces an edge-face map. Each directed edge in des is associated with
-- a unique TileFace in fcs that has that directed edge (if there is one).
-- It will report an error if more than one TileFace in fcs has the same directed edge in des. 
-- If the directed edges and faces are all those from a Tgraph, graphEFMap will be more efficient.
-- dedgesFacesMap is intended for a relatively small subset of directed edges in a Tgraph.
dedgesFacesMap:: [Dedge] -> [TileFace] -> Map.Map Dedge TileFace
dedgesFacesMap :: [Dedge] -> [TileFace] -> Map Dedge TileFace
dedgesFacesMap [Dedge]
des [TileFace]
fcs =  [(Dedge, TileFace)] -> Map Dedge TileFace
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Dedge] -> [(Dedge, TileFace)]
assocFaces [Dedge]
des) where
   vs :: [Vertex]
vs = (Dedge -> Vertex) -> [Dedge] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Vertex
forall a b. (a, b) -> a
fst [Dedge]
des [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
`union` (Dedge -> Vertex) -> [Dedge] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Vertex
forall a b. (a, b) -> b
snd [Dedge]
des
   vfMap :: VertexMap [TileFace]
vfMap = [Vertex] -> [TileFace] -> VertexMap [TileFace]
vertexFacesMap [Vertex]
vs [TileFace]
fcs
   assocFaces :: [Dedge] -> [(Dedge, TileFace)]
assocFaces [] = []
   assocFaces (d :: Dedge
d@(Vertex
a,Vertex
b):[Dedge]
more) = case (Vertex -> VertexMap [TileFace] -> Maybe [TileFace]
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
a VertexMap [TileFace]
vfMap, Vertex -> VertexMap [TileFace] -> Maybe [TileFace]
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
b VertexMap [TileFace]
vfMap) of
      (Just [TileFace]
fcs1, Just [TileFace]
fcs2) -> case (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileFace -> Dedge -> Bool
`hasDedge` Dedge
d) ([TileFace] -> [TileFace]) -> [TileFace] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ [TileFace]
fcs1 [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [TileFace]
fcs2 of 
                                   [TileFace
face] -> (Dedge
d,TileFace
face)(Dedge, TileFace) -> [(Dedge, TileFace)] -> [(Dedge, TileFace)]
forall a. a -> [a] -> [a]
:[Dedge] -> [(Dedge, TileFace)]
assocFaces [Dedge]
more
                                   []   -> [Dedge] -> [(Dedge, TileFace)]
assocFaces [Dedge]
more
                                   [TileFace]
_   -> String -> [(Dedge, TileFace)]
forall a. HasCallStack => String -> a
error (String -> [(Dedge, TileFace)]) -> String -> [(Dedge, TileFace)]
forall a b. (a -> b) -> a -> b
$ String
"dedgesFacesMap: more than one Tileface has the same directed edge: "
                                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dedge -> String
forall a. Show a => a -> String
show Dedge
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
      (Maybe [TileFace], Maybe [TileFace])
_ -> [Dedge] -> [(Dedge, TileFace)]
assocFaces [Dedge]
more


-- |Build a Map from directed edges to faces (the unique face containing the directed edge)
buildEFMap:: [TileFace] -> Map.Map Dedge TileFace
buildEFMap :: [TileFace] -> Map Dedge TileFace
buildEFMap = [(Dedge, TileFace)] -> Map Dedge TileFace
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Dedge, TileFace)] -> Map Dedge TileFace)
-> ([TileFace] -> [(Dedge, TileFace)])
-> [TileFace]
-> Map Dedge TileFace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace -> [(Dedge, TileFace)])
-> [TileFace] -> [(Dedge, TileFace)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TileFace -> [(Dedge, TileFace)]
assignFace where
  assignFace :: TileFace -> [(Dedge, TileFace)]
assignFace TileFace
f = (Dedge -> (Dedge, TileFace)) -> [Dedge] -> [(Dedge, TileFace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,TileFace
f) (TileFace -> [Dedge]
faceDedges TileFace
f)
{-
buildEFMap = mconcat . fmap processFace where
  processFace face = Map.fromList $ (,face) <$> faceDedges face
-}

-- | look up a face for an edge in an edge-face map
faceForEdge :: Dedge -> Map.Map Dedge TileFace ->  Maybe TileFace
faceForEdge :: Dedge -> Map Dedge TileFace -> Maybe TileFace
faceForEdge = Dedge -> Map Dedge TileFace -> Maybe TileFace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup

-- |Given a tileface (face) and a map from each directed edge to the tileface containing it (efMap)
-- return the list of edge neighbours of face.
edgeNbs:: TileFace -> Map.Map Dedge TileFace -> [TileFace]
edgeNbs :: TileFace -> Map Dedge TileFace -> [TileFace]
edgeNbs TileFace
face Map Dedge TileFace
efMap = (Dedge -> Maybe TileFace) -> [Dedge] -> [TileFace]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Dedge -> Maybe TileFace
getNbr [Dedge]
edges where
    getNbr :: Dedge -> Maybe TileFace
getNbr Dedge
e = Dedge -> Map Dedge TileFace -> Maybe TileFace
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Dedge
e Map Dedge TileFace
efMap
    edges :: [Dedge]
edges = (Dedge -> Dedge) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Dedge
reverseD ([Dedge] -> [Dedge]) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> a -> b
$ TileFace -> [Dedge]
faceDedges TileFace
face

-- |For a non-empty list of tile faces
-- find the face with lowest originV (and then lowest oppV).
-- Move this face to the front of the returned list of faces.
-- Used by locateVertices to determine the starting point for location calculation
extractLowestJoin:: [TileFace] -> (TileFace,[TileFace])
extractLowestJoin :: [TileFace] -> (TileFace, [TileFace])
extractLowestJoin [TileFace]
fcs
  | [TileFace] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TileFace]
fcs  = String -> (TileFace, [TileFace])
forall a. HasCallStack => String -> a
error String
"extractLowestJoin: applied to empty list of faces"
  | Bool
otherwise = (TileFace
face, [TileFace]
fcs[TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
\\[TileFace
face])
    where a :: Vertex
a = [Vertex] -> Vertex
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV [TileFace]
fcs)
          aFaces :: [TileFace]
aFaces = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex
aVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) [TileFace]
fcs
          b :: Vertex
b = [Vertex] -> Vertex
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
oppV [TileFace]
aFaces)
          face :: TileFace
face = case (TileFace -> Bool) -> [TileFace] -> Maybe TileFace
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (((Vertex
a,Vertex
b)Dedge -> Dedge -> Bool
forall a. Eq a => a -> a -> Bool
==) (Dedge -> Bool) -> (TileFace -> Dedge) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Dedge
joinOfTile) [TileFace]
aFaces of
                  Just TileFace
f -> TileFace
f
                  Maybe TileFace
Nothing -> String -> TileFace
forall a. HasCallStack => String -> a
error (String -> TileFace) -> String -> TileFace
forall a b. (a -> b) -> a -> b
$ String
"extractLowestJoin: no face fond at "
                                     String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with opp vertex at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
--          (face: _) = filter (((a,b)==) . joinOfTile) aFaces

-- |Return the join edge with lowest origin vertex (and lowest oppV vertex if there is more than one).
-- The resulting edge is always directed from the origin to the opp vertex, i.e (orig,opp).
lowestJoin:: [TileFace] -> Dedge
lowestJoin :: [TileFace] -> Dedge
lowestJoin [TileFace]
fcs | [TileFace] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TileFace]
fcs  = String -> Dedge
forall a. HasCallStack => String -> a
error String
"lowestJoin: applied to empty list of faces"
lowestJoin [TileFace]
fcs = (Vertex
a,Vertex
b) where
    a :: Vertex
a = [Vertex] -> Vertex
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
originV [TileFace]
fcs)
    aFaces :: [TileFace]
aFaces = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex
aVertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
==) (Vertex -> Bool) -> (TileFace -> Vertex) -> TileFace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TileFace -> Vertex
originV) [TileFace]
fcs
    b :: Vertex
b = [Vertex] -> Vertex
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((TileFace -> Vertex) -> [TileFace] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Vertex
oppV [TileFace]
aFaces)

{---------------------
*********************
VPatch and Conversions
*********************
-----------------------}

-- |Abbreviation for finite mappings from Vertex to Location (i.e Point)
type VertexLocMap = VMap.IntMap (Point V2 Double)


-- |A VPatch has a map from vertices to points along with a list of tile faces.
-- It is an intermediate form between Tgraphs and Diagrams
data VPatch = VPatch {VPatch -> VertexLocMap
vLocs :: VertexLocMap,  VPatch -> [TileFace]
vpFaces::[TileFace]} deriving Vertex -> VPatch -> ShowS
[VPatch] -> ShowS
VPatch -> String
(Vertex -> VPatch -> ShowS)
-> (VPatch -> String) -> ([VPatch] -> ShowS) -> Show VPatch
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> VPatch -> ShowS
showsPrec :: Vertex -> VPatch -> ShowS
$cshow :: VPatch -> String
show :: VPatch -> String
$cshowList :: [VPatch] -> ShowS
showList :: [VPatch] -> ShowS
Show

-- |needed for making VPatch transformable
type instance V VPatch = V2
-- |needed for making VPatch transformable
type instance N VPatch = Double


-- |Make VPatch Transformable.
instance Transformable VPatch where 
    transform :: Transformation (V VPatch) (N VPatch) -> VPatch -> VPatch
transform Transformation (V VPatch) (N VPatch)
t VPatch
vp = VPatch
vp {vLocs :: VertexLocMap
vLocs = (Point V2 Double -> Point V2 Double)
-> VertexLocMap -> VertexLocMap
forall a b. (a -> b) -> IntMap a -> IntMap b
VMap.map (Transformation (V (Point V2 Double)) (N (Point V2 Double))
-> Point V2 Double -> Point V2 Double
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Point V2 Double)) (N (Point V2 Double))
Transformation (V VPatch) (N VPatch)
t) (VPatch -> VertexLocMap
vLocs VPatch
vp)}


{-|Convert a Tgraph to a VPatch.
This uses locateVertices to form an intermediate VertexLocMap (mapping of vertices to positions).
This makes the join of the face with lowest origin and lowest oppV align on the positive x axis.
-}
makeVP::Tgraph -> VPatch
makeVP :: Tgraph -> VPatch
makeVP Tgraph
g = VPatch {vLocs :: VertexLocMap
vLocs = [TileFace] -> VertexLocMap
locateVertices [TileFace]
fcs, vpFaces :: [TileFace]
vpFaces  = [TileFace]
fcs} where fcs :: [TileFace]
fcs = Tgraph -> [TileFace]
faces Tgraph
g

-- |Creates a VPatch from a list of tile faces, using the vertex location map from the given VPatch.
-- The vertices in the tile faces should have locations assigned in the given VPatch vertex locations.
-- However THIS IS NOT CHECKED so missing locations for vertices will raise an error when drawing.
-- subVP vp fcs can be used for both subsets of tile faces of vp,
-- and also for larger scale faces which use the same vertex to point assignment (e.g in compositions).
-- The vertex location map is not changed (see also relevantVP and restrictVP).
subVP:: VPatch -> [TileFace] -> VPatch
subVP :: VPatch -> [TileFace] -> VPatch
subVP VPatch
vp [TileFace]
fcs = VPatch
vp {vpFaces :: [TileFace]
vpFaces  = [TileFace]
fcs} 

-- | removes locations for vertices not used in the faces of a VPatch.
-- (Useful when restricting which labels get drawn).
-- relevantVP vp will raise an error if any vertex in the faces of vp is not a key in the location map of vp.
relevantVP :: VPatch -> VPatch
relevantVP :: VPatch -> VPatch
relevantVP VPatch
vp 
  | [Vertex] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Vertex]
diffList = VPatch
vp{vLocs :: VertexLocMap
vLocs = VertexLocMap
locVs}   
  | Bool
otherwise = String -> VPatch
forall a. HasCallStack => String -> a
error (String -> VPatch) -> String -> VPatch
forall a b. (a -> b) -> a -> b
$ String
"relevantVP: missing locations for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                    [Vertex] -> String
forall a. Show a => a -> String
show [Vertex]
diffList String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
  where
     vs :: VertexSet
vs = [TileFace] -> VertexSet
facesVSet (VPatch -> [TileFace]
vpFaces VPatch
vp)
     source :: VertexSet
source = VertexLocMap -> VertexSet
forall a. IntMap a -> VertexSet
VMap.keysSet VertexLocMap
locVs
     diffList :: [Vertex]
diffList = VertexSet -> [Vertex]
IntSet.toList (VertexSet -> [Vertex]) -> VertexSet -> [Vertex]
forall a b. (a -> b) -> a -> b
$ VertexSet -> VertexSet -> VertexSet
IntSet.difference VertexSet
vs VertexSet
source
     locVs :: VertexLocMap
locVs = (Vertex -> Point V2 Double -> Bool) -> VertexLocMap -> VertexLocMap
forall a. (Vertex -> a -> Bool) -> IntMap a -> IntMap a
VMap.filterWithKey (\ Vertex
v Point V2 Double
_ -> Vertex
v Vertex -> VertexSet -> Bool
`IntSet.member` VertexSet
vs) (VertexLocMap -> VertexLocMap) -> VertexLocMap -> VertexLocMap
forall a b. (a -> b) -> a -> b
$ VPatch -> VertexLocMap
vLocs VPatch
vp

-- | A combination of subVP and relevantVP. Restricts a vp to a list of faces, removing locations for vertices not in the faces.
-- (Useful when restricting which labels get drawn)
-- restrictVP vp fcs will raise an error if any vertex in fcs is not a key in the location map of vp.
restrictVP:: VPatch -> [TileFace] -> VPatch
restrictVP :: VPatch -> [TileFace] -> VPatch
restrictVP VPatch
vp [TileFace]
fcs = VPatch -> VPatch
relevantVP (VPatch -> [TileFace] -> VPatch
subVP VPatch
vp [TileFace]
fcs)

-- |Recover a Tgraph from a VPatch by dropping the vertex positions and checking Tgraph properties.
graphFromVP:: VPatch -> Tgraph
graphFromVP :: VPatch -> Tgraph
graphFromVP = [TileFace] -> Tgraph
checkedTgraph ([TileFace] -> Tgraph)
-> (VPatch -> [TileFace]) -> VPatch -> Tgraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> [TileFace]
vpFaces

-- |remove a list of faces from a VPatch
removeFacesVP :: VPatch -> [TileFace] -> VPatch
removeFacesVP :: VPatch -> [TileFace] -> VPatch
removeFacesVP VPatch
vp [TileFace]
fcs = VPatch -> [TileFace] -> VPatch
restrictVP VPatch
vp (VPatch -> [TileFace]
vpFaces VPatch
vp [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
\\ [TileFace]
fcs)

-- |make a new VPatch with a list of selected faces from a VPatch.
-- This will ignore any faces that are not in the given VPatch.
selectFacesVP:: VPatch -> [TileFace] -> VPatch
selectFacesVP :: VPatch -> [TileFace] -> VPatch
selectFacesVP VPatch
vp [TileFace]
fcs = VPatch -> [TileFace] -> VPatch
restrictVP VPatch
vp ([TileFace]
fcs [TileFace] -> [TileFace] -> [TileFace]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` VPatch -> [TileFace]
vpFaces VPatch
vp)

-- |find the location of a single vertex in a VPatch
findLoc :: Vertex -> VPatch -> Maybe (Point V2 Double)
findLoc :: Vertex -> VPatch -> Maybe (Point V2 Double)
findLoc Vertex
v = Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v (VertexLocMap -> Maybe (Point V2 Double))
-> (VPatch -> VertexLocMap) -> VPatch -> Maybe (Point V2 Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> VertexLocMap
vLocs




-- |VPatches are drawable
instance Drawable VPatch where
    drawWith :: forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> VPatch -> Diagram2D b
drawWith Piece -> Diagram2D b
pd VPatch
vp = (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 Piece -> Diagram2D b
pd (VPatch -> Patch
dropLabels VPatch
vp)

-- |converts a VPatch to a Patch, removing vertex information and converting faces to Located Pieces.
-- (Usage can be confined to Drawable VPatch instance and DrawableLabelled VPatch instance.)
dropLabels :: VPatch -> Patch
dropLabels :: VPatch -> Patch
dropLabels VPatch
vp = (TileFace -> Located Piece) -> [TileFace] -> Patch
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TileFace -> Located Piece
convert (VPatch -> [TileFace]
vpFaces VPatch
vp) where
  locations :: VertexLocMap
locations = VPatch -> VertexLocMap
vLocs VPatch
vp
  convert :: TileFace -> Located Piece
convert TileFace
face = case (Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup (TileFace -> Vertex
originV TileFace
face) VertexLocMap
locations , Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup (TileFace -> Vertex
oppV TileFace
face) VertexLocMap
locations) of
    (Just Point V2 Double
p, Just Point V2 Double
p') -> ((Vertex, Vertex, Vertex) -> V2 Double) -> TileFace -> Piece
forall a b. (a -> b) -> HalfTile a -> HalfTile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (V2 Double -> (Vertex, Vertex, Vertex) -> V2 Double
forall a b. a -> b -> a
const (Point V2 Double
p' 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
p)) TileFace
face 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 -- using HalfTile functor fmap
    (Maybe (Point V2 Double), Maybe (Point V2 Double))
_ -> String -> Located Piece
forall a. HasCallStack => String -> a
error (String -> Located Piece) -> String -> Located Piece
forall a b. (a -> b) -> a -> b
$ String
"dropLabels: Vertex location not found for some vertices:\n    " 
                String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Vertex] -> String
forall a. Show a => a -> String
show (TileFace -> [Vertex]
faceVList TileFace
face [Vertex] -> [Vertex] -> [Vertex]
forall a. Eq a => [a] -> [a] -> [a]
\\ VertexLocMap -> [Vertex]
forall a. IntMap a -> [Vertex]
VMap.keys VertexLocMap
locations)  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |Tgraphs are Drawable
instance Drawable Tgraph where
    drawWith :: forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> Tgraph -> Diagram2D b
drawWith Piece -> Diagram2D b
pd = (Piece -> Diagram2D b) -> VPatch -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
(Piece -> Diagram2D b) -> VPatch -> Diagram2D b
forall a b.
(Drawable a, Renderable (Path V2 Double) b) =>
(Piece -> Diagram2D b) -> a -> Diagram2D b
drawWith Piece -> Diagram2D b
pd (VPatch -> Diagram2D b)
-> (Tgraph -> VPatch) -> Tgraph -> Diagram2D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- | A class for things that can be drawn with labels when given a colour and a measure (size) for the label and a 
-- a draw function (for Patches).
-- So labelColourSize c m  modifies a 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 DrawableLabelled a where
-- | When a specific Backend B is in scope, 
--
-- labelColourSize :: DrawableLabelled a => Colour Double -> Measure Double -> (Patch -> Diagram B) -> a -> Diagram B
  labelColourSize :: (Renderable (Path V2 Double) b, Renderable (Text Double) b) => 
                     Colour Double -> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
-- The argument type of the draw function is Patch rather than VPatch, which prevents labelling twice.


-- | VPatches can be drawn with labels
instance DrawableLabelled VPatch where
  labelColourSize :: forall b.
(Renderable (Path V2 Double) b, Renderable (Text Double) b) =>
Colour Double
-> Measure Double
-> (Patch -> Diagram2D b)
-> VPatch
-> Diagram2D b
labelColourSize Colour Double
c Measure Double
m Patch -> QDiagram b V2 Double Any
d VPatch
vp = VertexLocMap -> QDiagram b V2 Double Any
drawLabels (VPatch -> VertexLocMap
vLocs VPatch
vp) QDiagram b V2 Double Any
-> QDiagram b V2 Double Any -> QDiagram b V2 Double Any
forall a. Semigroup a => a -> a -> a
<> Patch -> QDiagram b V2 Double Any
d (VPatch -> Patch
dropLabels VPatch
vp) where
     drawLabels :: VertexLocMap -> QDiagram b V2 Double Any
drawLabels VertexLocMap
vpMap = [(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
$ (Vertex, Point V2 Double)
-> (Point V2 Double, QDiagram b V2 Double Any)
drawlabel ((Vertex, Point V2 Double)
 -> (Point V2 Double, QDiagram b V2 Double Any))
-> [(Vertex, Point V2 Double)]
-> [(Point V2 Double, QDiagram b V2 Double Any)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VertexLocMap -> [(Vertex, Point V2 Double)]
forall a. IntMap a -> [(Vertex, a)]
VMap.toList VertexLocMap
vpMap
     drawlabel :: (Vertex, Point V2 Double)
-> (Point V2 Double, QDiagram b V2 Double Any)
drawlabel(Vertex
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 (Vertex -> String
forall a. Show a => a -> String
show Vertex
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)

-- | Tgraphs can be drawn with labels
instance DrawableLabelled Tgraph where
  labelColourSize :: forall b.
(Renderable (Path V2 Double) b, Renderable (Text Double) b) =>
Colour Double
-> Measure Double
-> (Patch -> Diagram2D b)
-> Tgraph
-> Diagram2D b
labelColourSize Colour Double
c Measure Double
r Patch -> Diagram2D b
d = Colour Double
-> Measure Double
-> (Patch -> Diagram2D b)
-> VPatch
-> Diagram2D b
forall b.
(Renderable (Path V2 Double) b, Renderable (Text Double) b) =>
Colour Double
-> Measure Double
-> (Patch -> Diagram2D b)
-> VPatch
-> Diagram2D b
forall a b.
(DrawableLabelled a, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
labelColourSize Colour Double
c Measure Double
r Patch -> Diagram2D b
d (VPatch -> Diagram2D b)
-> (Tgraph -> VPatch) -> Tgraph -> Diagram2D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- | Default Version of labelColourSize with colour red. Example usage: labelSize tiny draw a , labelSize normal drawj a
--
-- When a specific Backend B is in scope, labelSize :: DrawableLabelled a => Measure Double -> (Patch -> Diagram B) -> a -> Diagram B
labelSize :: (Renderable (Path V2 Double) b, Renderable (Text Double) b, DrawableLabelled a) => 
             Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
labelSize :: forall b a.
(Renderable (Path V2 Double) b, Renderable (Text Double) b,
 DrawableLabelled a) =>
Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
labelSize = Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
forall b.
(Renderable (Path V2 Double) b, Renderable (Text Double) b) =>
Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(DrawableLabelled a, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
labelColourSize Colour Double
forall a. (Ord a, Floating a) => Colour a
red

-- | Default Version of labelColourSize using red and small (rather than normal label size). Example usage: labelled draw a , labelled drawj a
--
-- When a specific Backend B is in scope, labelled :: DrawableLabelled a => (Patch -> Diagram B) -> a -> Diagram B
labelled :: (Renderable (Path V2 Double) b, Renderable (Text Double) b, DrawableLabelled a) => 
            (Patch -> Diagram2D b) -> a -> Diagram2D b
labelled :: forall b a.
(Renderable (Path V2 Double) b, Renderable (Text Double) b,
 DrawableLabelled a) =>
(Patch -> Diagram2D b) -> a -> Diagram2D b
labelled = Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
forall b.
(Renderable (Path V2 Double) b, Renderable (Text Double) b) =>
Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
forall a b.
(DrawableLabelled a, Renderable (Path V2 Double) b,
 Renderable (Text Double) b) =>
Colour Double
-> Measure Double -> (Patch -> Diagram2D b) -> a -> Diagram2D b
labelColourSize Colour Double
forall a. (Ord a, Floating a) => Colour a
red Measure Double
forall n. OrderedField n => Measure n
small --(normalized 0.023)

-- |rotateBefore vfun a g - makes a VPatch from g then rotates by angle a before applying the VPatch function vfun.
-- Tgraphs need to be rotated after a VPatch is calculated but before any labelled drawing.
-- E.g. rotateBefore (labelled draw) angle graph.
rotateBefore :: (VPatch -> a) -> Angle Double -> Tgraph -> a
rotateBefore :: forall a. (VPatch -> a) -> Angle Double -> Tgraph -> a
rotateBefore VPatch -> a
vfun Angle Double
angle = VPatch -> a
vfun (VPatch -> a) -> (Tgraph -> VPatch) -> Tgraph -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Angle Double -> VPatch -> VPatch
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle Double
angle (VPatch -> VPatch) -> (Tgraph -> VPatch) -> Tgraph -> VPatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- |center a VPatch on a particular vertex. (Raises an error if the vertex is not in the VPatch vertices)
centerOn :: Vertex -> VPatch -> VPatch
centerOn :: Vertex -> VPatch -> VPatch
centerOn Vertex
a VPatch
vp = 
    case Vertex -> VPatch -> Maybe (Point V2 Double)
findLoc Vertex
a VPatch
vp of
        Just Point V2 Double
loca -> Vn VPatch -> VPatch -> VPatch
forall t. Transformable t => Vn t -> t -> t
translate (Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin 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
loca) VPatch
vp
        Maybe (Point V2 Double)
_ -> String -> VPatch
forall a. HasCallStack => String -> a
error (String -> VPatch) -> String -> VPatch
forall a b. (a -> b) -> a -> b
$ String
"centerOn: vertex not found (Vertex " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"

-- |alignXaxis takes a vertex pair (a,b) and a VPatch vp
-- for centering vp on a and rotating the result so that b is on the positive X axis.
-- (Raises an error if either a or b are not in the VPatch vertices)
alignXaxis :: (Vertex, Vertex) -> VPatch -> VPatch    
alignXaxis :: Dedge -> VPatch -> VPatch
alignXaxis (Vertex
a,Vertex
b) VPatch
vp =  Angle Double -> VPatch -> VPatch
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle Double
angle VPatch
newvp
  where newvp :: VPatch
newvp = Vertex -> VPatch -> VPatch
centerOn Vertex
a VPatch
vp
        angle :: Angle Double
angle = Direction V2 Double -> Direction V2 Double -> Angle Double
forall n.
RealFloat n =>
Direction V2 n -> Direction V2 n -> Angle n
signedAngleBetweenDirs (V2 Double -> Direction V2 Double
forall (v :: * -> *) n. v n -> Direction v n
direction V2 Double
forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX) (V2 Double -> Direction V2 Double
forall (v :: * -> *) n. v n -> Direction v n
direction (Point V2 Double
locb 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
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)) 
        locb :: Point V2 Double
locb = case Vertex -> VPatch -> Maybe (Point V2 Double)
findLoc Vertex
b VPatch
newvp of
                Just Point V2 Double
l -> Point V2 Double
l
                Maybe (Point V2 Double)
Nothing -> String -> Point V2 Double
forall a. HasCallStack => String -> a
error (String -> Point V2 Double) -> String -> Point V2 Double
forall a b. (a -> b) -> a -> b
$ String
"alignXaxis: second alignment vertex not found (Vertex " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex -> String
forall a. Show a => a -> String
show Vertex
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")\n"

-- |alignments takes a list of vertex pairs for respective alignmants of VPatches in the second list.
-- For a pair (a,b) the corresponding VPatch is centered on a then b is aligned along the positive x axis. 
-- The vertex pair list can be shorter than the list of VPatch - the remaining VPatch are left as they are.
-- (Raises an error if either vertex in a pair is not in the corresponding VPatch vertices)
alignments :: [(Vertex, Vertex)] -> [VPatch] -> [VPatch]     
alignments :: [Dedge] -> [VPatch] -> [VPatch]
alignments [] [VPatch]
vps = [VPatch]
vps
alignments [Dedge]
_  [] = String -> [VPatch]
forall a. HasCallStack => String -> a
error String
"alignments: Too many alignment pairs.\n"  -- non-null list of pairs
alignments ((Vertex
a,Vertex
b):[Dedge]
more) (VPatch
vp:[VPatch]
vps) =  Dedge -> VPatch -> VPatch
alignXaxis (Vertex
a,Vertex
b) VPatch
vp VPatch -> [VPatch] -> [VPatch]
forall a. a -> [a] -> [a]
: [Dedge] -> [VPatch] -> [VPatch]
alignments [Dedge]
more [VPatch]
vps

-- |alignAll (a,b) vpList
-- provided both vertices a and b exist in each VPatch in vpList, the VPatch are all aligned
-- centred on a, with b on the positive x axis.
-- An error is raised if any VPatch does not contain both a and b vertices.
alignAll:: (Vertex, Vertex) -> [VPatch] -> [VPatch]     
alignAll :: Dedge -> [VPatch] -> [VPatch]
alignAll (Vertex
a,Vertex
b) = (VPatch -> VPatch) -> [VPatch] -> [VPatch]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dedge -> VPatch -> VPatch
alignXaxis (Vertex
a,Vertex
b))

-- |alignBefore vfun (a,b) g - makes a VPatch from g oriented with centre on a and b aligned on the x-axis
-- before applying the VPatch function vfun
-- Will raise an error if either a or b is not a vertex in g.
-- Tgraphs need to be aligned after a VPatch is calculated but before any labelled drawing.
-- E.g. alignBefore (labelled draw) (a,b) g
alignBefore :: (VPatch -> a) -> (Vertex,Vertex) -> Tgraph -> a
alignBefore :: forall a. (VPatch -> a) -> Dedge -> Tgraph -> a
alignBefore VPatch -> a
vfun Dedge
vs = VPatch -> a
vfun (VPatch -> a) -> (Tgraph -> VPatch) -> Tgraph -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dedge -> VPatch -> VPatch
alignXaxis Dedge
vs (VPatch -> VPatch) -> (Tgraph -> VPatch) -> Tgraph -> VPatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tgraph -> VPatch
makeVP

-- | makeAlignedVP (a,b) g - make a VPatch from g oriented with centre on a and b aligned on the x-axis.
-- Will raise an error if either a or b is not a vertex in g.
makeAlignedVP:: (Vertex,Vertex) ->  Tgraph -> VPatch        
makeAlignedVP :: Dedge -> Tgraph -> VPatch
makeAlignedVP = (VPatch -> VPatch) -> Dedge -> Tgraph -> VPatch
forall a. (VPatch -> a) -> Dedge -> Tgraph -> a
alignBefore VPatch -> VPatch
forall a. a -> a
id


-- |produce a diagram of a list of edges (given a VPatch)
-- Will raise an error if any vertex of the edges is not a key in the vertex to location mapping of the VPatch.
--
-- When a specific Backend B is in scope, drawEdgesVP :: VPatch -> [Dedge] -> Diagram B
drawEdgesVP :: Renderable (Path V2 Double) b =>
               VPatch -> [Dedge] -> Diagram2D b
drawEdgesVP :: forall b.
Renderable (Path V2 Double) b =>
VPatch -> [Dedge] -> Diagram2D b
drawEdgesVP = VertexLocMap -> [Dedge] -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
VertexLocMap -> [Dedge] -> Diagram2D b
drawEdges (VertexLocMap -> [Dedge] -> Diagram2D b)
-> (VPatch -> VertexLocMap) -> VPatch -> [Dedge] -> Diagram2D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> VertexLocMap
vLocs --foldMap (drawEdgeVP vp)

-- |produce a diagram of a single edge (given a VPatch)
-- Will raise an error if either vertex of the edge is not a key in the vertex to location mapping of the VPatch.
--
-- When a specific Backend B is in scope, drawEdgeVP :: VPatch -> Dedge -> Diagram B
drawEdgeVP:: Renderable (Path V2 Double) b =>
               VPatch -> Dedge -> Diagram2D b
drawEdgeVP :: forall b.
Renderable (Path V2 Double) b =>
VPatch -> Dedge -> Diagram2D b
drawEdgeVP = VertexLocMap -> Dedge -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
VertexLocMap -> Dedge -> Diagram2D b
drawEdge (VertexLocMap -> Dedge -> Diagram2D b)
-> (VPatch -> VertexLocMap) -> VPatch -> Dedge -> Diagram2D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VPatch -> VertexLocMap
vLocs

-- |produce a diagram of a list of edges (given a mapping of vertices to locations)
-- Will raise an error if any vertex of the edges is not a key in the mapping.
--
-- When a specific Backend B is in scope, drawEdges :: VertexLocMap -> [Dedge] -> Diagram B
drawEdges :: Renderable (Path V2 Double) b =>
             VertexLocMap -> [Dedge] -> Diagram2D b
drawEdges :: forall b.
Renderable (Path V2 Double) b =>
VertexLocMap -> [Dedge] -> Diagram2D b
drawEdges = (Dedge -> Diagram2D b) -> [Dedge] -> Diagram2D b
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Dedge -> Diagram2D b) -> [Dedge] -> Diagram2D b)
-> (VertexLocMap -> Dedge -> Diagram2D b)
-> VertexLocMap
-> [Dedge]
-> Diagram2D b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VertexLocMap -> Dedge -> Diagram2D b
forall b.
Renderable (Path V2 Double) b =>
VertexLocMap -> Dedge -> Diagram2D b
drawEdge

-- |produce a diagram of a single edge (given a mapping of vertices to locations).
-- Will raise an error if either vertex of the edge is not a key in the mapping.
--
-- When a specific Backend B is in scope, drawEdge :: VertexLocMap -> Dedge -> Diagram B
drawEdge :: Renderable (Path V2 Double) b =>
            VertexLocMap -> Dedge -> Diagram2D b
drawEdge :: forall b.
Renderable (Path V2 Double) b =>
VertexLocMap -> Dedge -> Diagram2D b
drawEdge VertexLocMap
vpMap (Vertex
a,Vertex
b) = case (Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
a VertexLocMap
vpMap, Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
b VertexLocMap
vpMap) of
                         (Just Point V2 Double
pa, Just Point V2 Double
pb) -> Point V2 Double
pa Point V2 Double -> Point V2 Double -> Diagram2D b
forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Point v n -> Point v n -> t
~~ Point V2 Double
pb
                         (Maybe (Point V2 Double), Maybe (Point V2 Double))
_ -> String -> Diagram2D b
forall a. HasCallStack => String -> a
error (String -> Diagram2D b) -> String -> Diagram2D b
forall a b. (a -> b) -> a -> b
$ String
"drawEdge: location not found for one or both vertices "String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dedge -> String
forall a. Show a => a -> String
show(Vertex
a,Vertex
b) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"



{-| locateVertices: processes a list of faces to associate points for each vertex.
It aligns the lowest numbered join of the faces on the x-axis, and returns a vertex-to-point Map.
It will raise an error if faces are not connected.
If faces have crossing boundaries (i.e not locally tile-connected), this could raise an error
or a result with touching vertices (i.e. more than one vertex with the same location).
-}
locateVertices:: [TileFace] -> VertexLocMap
--  This version is made more efficient by calculating an edge to face map
--  and also using Sets for 2nd arg of fastAddVPoints.
locateVertices :: [TileFace] -> VertexLocMap
locateVertices [] = VertexLocMap
forall a. IntMap a
VMap.empty
locateVertices [TileFace]
fcs = [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPoints [TileFace
joinFace] ([TileFace] -> Set TileFace
forall a. Ord a => [a] -> Set a
Set.fromList [TileFace]
more) (TileFace -> VertexLocMap
axisJoin TileFace
joinFace) where
    (TileFace
joinFace,[TileFace]
more) = [TileFace] -> (TileFace, [TileFace])
extractLowestJoin [TileFace]
fcs
    efMap :: Map Dedge TileFace
efMap = [TileFace] -> Map Dedge TileFace
buildEFMap [TileFace]
fcs  -- map from Dedge to TileFace

{- fastAddVPoints readyfaces fcOther vpMap.
The first argument list of faces (readyfaces) contains the ones being processed next in order where
each will have at least two known vertex locations in vpMap.
The second argument Set of faces (fcOther) are faces that have not yet been added
and may not yet have known vertex locations.
The third argument is the mapping of vertices to points.
-}
    fastAddVPoints :: [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPoints [] Set TileFace
fcOther VertexLocMap
vpMap | Set TileFace -> Bool
forall a. Set a -> Bool
Set.null Set TileFace
fcOther = VertexLocMap
vpMap 
    fastAddVPoints [] Set TileFace
fcOther VertexLocMap
_ = String -> VertexLocMap
forall a. HasCallStack => String -> a
error (String -> VertexLocMap) -> String -> VertexLocMap
forall a b. (a -> b) -> a -> b
$ String
"locateVertices (fastAddVPoints): Faces not tile-connected: "
                                          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set TileFace -> String
forall a. Show a => a -> String
show Set TileFace
fcOther String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/n"
    fastAddVPoints (TileFace
face:[TileFace]
fs) Set TileFace
fcOther VertexLocMap
vpMap = [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPoints ([TileFace]
fs[TileFace] -> [TileFace] -> [TileFace]
forall a. [a] -> [a] -> [a]
++[TileFace]
nbs) Set TileFace
fcOther' VertexLocMap
vpMap' where
        nbs :: [TileFace]
nbs = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileFace -> Set TileFace -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TileFace
fcOther) (TileFace -> Map Dedge TileFace -> [TileFace]
edgeNbs TileFace
face Map Dedge TileFace
efMap)
        fcOther' :: Set TileFace
fcOther' = (Set TileFace -> TileFace -> Set TileFace)
-> Set TileFace -> [TileFace] -> Set TileFace
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((TileFace -> Set TileFace -> Set TileFace)
-> Set TileFace -> TileFace -> Set TileFace
forall a b c. (a -> b -> c) -> b -> a -> c
flip TileFace -> Set TileFace -> Set TileFace
forall a. Ord a => a -> Set a -> Set a
Set.delete) Set TileFace
fcOther [TileFace]
nbs
--        fcOther' = foldr Set.delete fcOther nbs
        vpMap' :: VertexLocMap
vpMap' = TileFace -> VertexLocMap -> VertexLocMap
addVPoint TileFace
face VertexLocMap
vpMap

-- |Given a tileface and a vertex to location map which gives locations for at least 2 of the tileface vertices
-- this returns a new map by adding a location for the third vertex (when missing) or the same map when not missing.
-- It will raise an error if there are fewer than 2 tileface vertices with a location in the map
-- (indicating a non tile-connected face).
-- It is possible that a newly added location is already in the range of the map (creating a touching vertices),
-- so this needs to be checked for.
addVPoint:: TileFace -> VertexLocMap -> VertexLocMap
addVPoint :: TileFace -> VertexLocMap -> VertexLocMap
addVPoint TileFace
face VertexLocMap
vpMap = 
  case TileFace -> VertexLocMap -> Maybe (Vertex, Point V2 Double)
thirdVertexLoc TileFace
face VertexLocMap
vpMap of
    Just (Vertex
v,Point V2 Double
p) -> Vertex -> Point V2 Double -> VertexLocMap -> VertexLocMap
forall a. Vertex -> a -> IntMap a -> IntMap a
VMap.insert Vertex
v Point V2 Double
p VertexLocMap
vpMap
    Maybe (Vertex, Point V2 Double)
Nothing -> VertexLocMap
vpMap

-- |axisJoin face 
-- initialises a vertex to point mapping with locations for the join edge vertices of face
-- with originV face at the origin and aligned along the x axis with unit length for a half dart
-- and length phi for a half kite. (Used to initialise locateVertices)
axisJoin::TileFace -> VertexLocMap                
axisJoin :: TileFace -> VertexLocMap
axisJoin TileFace
face = 
  Vertex -> Point V2 Double -> VertexLocMap -> VertexLocMap
forall a. Vertex -> a -> IntMap a -> IntMap a
VMap.insert (TileFace -> Vertex
originV TileFace
face) Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (VertexLocMap -> VertexLocMap) -> VertexLocMap -> VertexLocMap
forall a b. (a -> b) -> a -> b
$ Vertex -> Point V2 Double -> VertexLocMap -> VertexLocMap
forall a. Vertex -> a -> IntMap a -> IntMap a
VMap.insert (TileFace -> Vertex
oppV TileFace
face) ((Double, Double) -> Point V2 Double
forall n. (n, n) -> P2 n
p2(Double
x,Double
0)) VertexLocMap
forall a. IntMap a
VMap.empty where
    x :: Double
x = if TileFace -> Bool
forall rep. HalfTile rep -> Bool
isDart TileFace
face then Double
1 else Double
phi

-- |lookup 3 vertex locations in a vertex to point map.
find3Locs::(Vertex,Vertex,Vertex) -> VertexLocMap
             -> (Maybe (Point V2 Double),Maybe (Point V2 Double),Maybe (Point V2 Double))              
find3Locs :: (Vertex, Vertex, Vertex)
-> VertexLocMap
-> (Maybe (Point V2 Double), Maybe (Point V2 Double),
    Maybe (Point V2 Double))
find3Locs (Vertex
v1,Vertex
v2,Vertex
v3) VertexLocMap
vpMap = (Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v1 VertexLocMap
vpMap, Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v2 VertexLocMap
vpMap, Vertex -> VertexLocMap -> Maybe (Point V2 Double)
forall a. Vertex -> IntMap a -> Maybe a
VMap.lookup Vertex
v3 VertexLocMap
vpMap)

{-| thirdVertexLoc face vpMap,  where face is a tileface and vpMap associates points with vertices (positions).
It looks up all 3 vertices of face in vpMap hoping to find at least 2 of them, it then returns Just pr
where pr associates a new location with the third vertex.
If all 3 are found, returns Nothing.
If none or one found this is an error (a non tile-connected face).

New Version: This assumes all edge lengths are 1 or phi.
It now uses signorm to produce vectors of length 1 rather than rely on relative lengths.
(Requires ttangle and phi from TileLib).
-}
thirdVertexLoc:: TileFace -> VertexLocMap -> Maybe (Vertex, Point V2 Double)        
thirdVertexLoc :: TileFace -> VertexLocMap -> Maybe (Vertex, Point V2 Double)
thirdVertexLoc face :: TileFace
face@(LD (Vertex, Vertex, Vertex)
_) VertexLocMap
vpMap = case (Vertex, Vertex, Vertex)
-> VertexLocMap
-> (Maybe (Point V2 Double), Maybe (Point V2 Double),
    Maybe (Point V2 Double))
find3Locs (TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face) VertexLocMap
vpMap of
  (Just Point V2 Double
loc1, Just Point V2 Double
loc2, Maybe (Point V2 Double)
Nothing) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
wingV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
9) (Point V2 Double
loc2 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
loc1))
  (Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc2, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
originV TileFace
face, Point V2 Double
loc2 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 = V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
7) (Point V2 Double
loc3 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
loc2))
  (Just Point V2 Double
loc1, Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
oppV TileFace
face, Point V2 Double
loc1 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 = V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Point V2 Double
loc3 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
loc1))
  (Just Point V2 Double
_ , Just Point V2 Double
_ , Just Point V2 Double
_)      -> Maybe (Vertex, Point V2 Double)
forall a. Maybe a
Nothing
  (Maybe (Point V2 Double), Maybe (Point V2 Double),
 Maybe (Point V2 Double))
_ -> String -> Maybe (Vertex, Point V2 Double)
forall a. HasCallStack => String -> a
error (String -> Maybe (Vertex, Point V2 Double))
-> String -> Maybe (Vertex, Point V2 Double)
forall a b. (a -> b) -> a -> b
$ String
"thirdVertexLoc: face not tile-connected?: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
face String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

thirdVertexLoc face :: TileFace
face@(RD (Vertex, Vertex, Vertex)
_) VertexLocMap
vpMap = case (Vertex, Vertex, Vertex)
-> VertexLocMap
-> (Maybe (Point V2 Double), Maybe (Point V2 Double),
    Maybe (Point V2 Double))
find3Locs (TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face) VertexLocMap
vpMap of
  (Just Point V2 Double
loc1, Just Point V2 Double
loc2, Maybe (Point V2 Double)
Nothing) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
oppV TileFace
face, Point V2 Double
loc1 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 = V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
9) (Point V2 Double
loc2 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
loc1))
  (Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc2, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
originV TileFace
face, Point V2 Double
loc3 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 = V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
3) (Point V2 Double
loc2 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
loc3))
  (Just Point V2 Double
loc1, Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
wingV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Point V2 Double
loc3 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
loc1))
  (Just Point V2 Double
_ , Just Point V2 Double
_ , Just Point V2 Double
_)      -> Maybe (Vertex, Point V2 Double)
forall a. Maybe a
Nothing
  (Maybe (Point V2 Double), Maybe (Point V2 Double),
 Maybe (Point V2 Double))
_ -> String -> Maybe (Vertex, Point V2 Double)
forall a. HasCallStack => String -> a
error (String -> Maybe (Vertex, Point V2 Double))
-> String -> Maybe (Vertex, Point V2 Double)
forall a b. (a -> b) -> a -> b
$ String
"thirdVertexLoc: face not tile-connected?: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
face String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
 
thirdVertexLoc face :: TileFace
face@(LK (Vertex, Vertex, Vertex)
_) VertexLocMap
vpMap = case (Vertex, Vertex, Vertex)
-> VertexLocMap
-> (Maybe (Point V2 Double), Maybe (Point V2 Double),
    Maybe (Point V2 Double))
find3Locs (TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face) VertexLocMap
vpMap of
  (Just Point V2 Double
loc1, Just Point V2 Double
loc2, Maybe (Point V2 Double)
Nothing) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
oppV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
9) (Point V2 Double
loc2 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
loc1))
  (Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc2, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
originV TileFace
face, Point V2 Double
loc2 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
8) (Point V2 Double
loc3 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
loc2))
  (Just Point V2 Double
loc1, Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
wingV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Point V2 Double
loc3 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
loc1))
  (Just Point V2 Double
_ , Just Point V2 Double
_ , Just Point V2 Double
_)      -> Maybe (Vertex, Point V2 Double)
forall a. Maybe a
Nothing
  (Maybe (Point V2 Double), Maybe (Point V2 Double),
 Maybe (Point V2 Double))
_ -> String -> Maybe (Vertex, Point V2 Double)
forall a. HasCallStack => String -> a
error (String -> Maybe (Vertex, Point V2 Double))
-> String -> Maybe (Vertex, Point V2 Double)
forall a b. (a -> b) -> a -> b
$ String
"thirdVertexLoc: face not tile-connected?: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
face String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
 
thirdVertexLoc face :: TileFace
face@(RK (Vertex, Vertex, Vertex)
_) VertexLocMap
vpMap = case (Vertex, Vertex, Vertex)
-> VertexLocMap
-> (Maybe (Point V2 Double), Maybe (Point V2 Double),
    Maybe (Point V2 Double))
find3Locs (TileFace -> (Vertex, Vertex, Vertex)
faceVs TileFace
face) VertexLocMap
vpMap of
  (Just Point V2 Double
loc1, Just Point V2 Double
loc2, Maybe (Point V2 Double)
Nothing) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
wingV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
9) (Point V2 Double
loc2 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
loc1))
  (Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc2, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
originV TileFace
face, Point V2 Double
loc2 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
8) (Point V2 Double
loc3 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
loc2))
  (Just Point V2 Double
loc1, Maybe (Point V2 Double)
Nothing, Just Point V2 Double
loc3) -> (Vertex, Point V2 Double) -> Maybe (Vertex, Point V2 Double)
forall a. a -> Maybe a
Just (TileFace -> Vertex
oppV TileFace
face, Point V2 Double
loc1 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
*^V2 Double -> V2 Double
forall a. Floating a => V2 a -> V2 a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> f a
signorm (Angle Double -> V2 Double -> V2 Double
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Vertex -> Angle Double
ttangle Vertex
1) (Point V2 Double
loc3 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
loc1))
  (Just Point V2 Double
_ , Just Point V2 Double
_ , Just Point V2 Double
_)      -> Maybe (Vertex, Point V2 Double)
forall a. Maybe a
Nothing
  (Maybe (Point V2 Double), Maybe (Point V2 Double),
 Maybe (Point V2 Double))
_ -> String -> Maybe (Vertex, Point V2 Double)
forall a. HasCallStack => String -> a
error (String -> Maybe (Vertex, Point V2 Double))
-> String -> Maybe (Vertex, Point V2 Double)
forall a b. (a -> b) -> a -> b
$ String
"thirdVertexLoc: face not tile-connected?: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TileFace -> String
forall a. Show a => a -> String
show TileFace
face String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"



-- *  Touching Vertices


{-| 
touchingVertices checks that no vertices are too close to each other using locateVertices.
If vertices are too close that indicates we may have different vertex numbers at the same location
(the touching vertex problem). 
It returns pairs of vertices that are too close (higher number first in each pair)
An empty list is returned if there are no touching vertices.
Complexity has order of the square of the number of vertices.
                           
This is used in makeTgraph and fullUnion (via correctTouchingVertices).
-}
touchingVertices:: [TileFace] -> [(Vertex,Vertex)]
touchingVertices :: [TileFace] -> [Dedge]
touchingVertices [TileFace]
fcs = [(Vertex, Point V2 Double)] -> [Dedge]
forall {b}. Eq b => [(b, Point V2 Double)] -> [(b, b)]
check [(Vertex, Point V2 Double)]
vpAssoc where
  vpAssoc :: [(Vertex, Point V2 Double)]
vpAssoc = VertexLocMap -> [(Vertex, Point V2 Double)]
forall a. IntMap a -> [(Vertex, a)]
VMap.assocs (VertexLocMap -> [(Vertex, Point V2 Double)])
-> VertexLocMap -> [(Vertex, Point V2 Double)]
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexLocMap
locateVertices [TileFace]
fcs  -- assocs puts in key order so that check returns (higher,lower) pairs
  check :: [(b, Point V2 Double)] -> [(b, b)]
check [] = []
  check ((b
v,Point V2 Double
p):[(b, Point V2 Double)]
more) = [(b
v1,b
v) | b
v1 <- [b]
nearv ] [(b, b)] -> [(b, b)] -> [(b, b)]
forall a. [a] -> [a] -> [a]
++ [(b, Point V2 Double)] -> [(b, b)]
check (((b, Point V2 Double) -> Bool)
-> [(b, Point V2 Double)] -> [(b, Point V2 Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> [b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [b]
nearv)(b -> Bool)
-> ((b, Point V2 Double) -> b) -> (b, Point V2 Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b, Point V2 Double) -> b
forall a b. (a, b) -> a
fst) [(b, Point V2 Double)]
more)
                        where nearv :: [b]
nearv = [b
v1 | (b
v1,Point V2 Double
p1) <- [(b, Point V2 Double)]
more, Point V2 Double -> Point V2 Double -> Bool
touching Point V2 Double
p Point V2 Double
p1 ]
-- check ((v,p):more) = [(v1,v) | (v1,p1) <- more, touching p p1 ] ++ check more
-- does not correctly deal with 3 or more vertices touching at the same point

{-|touching checks if two points are considered close.
Close means the square of the distance between them is less than a certain number (currently 0.1) so they cannot be
vertex locations for 2 different vertices in a VPatch using unit scale for short edges.
It is used in touchingVertices and touchingVerticesGen).
-}
touching :: Point V2 Double -> Point V2 Double -> Bool
touching :: Point V2 Double -> Point V2 Double -> Bool
touching Point V2 Double
p Point V2 Double
p1 = V2 Double -> Double
forall a. Num a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Num a) => f a -> a
quadrance (Point V2 Double
p 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
p1) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.1 -- quadrance is square of length of a vector
--  0.1 represents a distance of about 0.316 units (= sqrt 0.1)


{-*  Generalised Touching Vertices
-}

{-| 
touchingVerticesGen  generalises touchingVertices to allow for multiple faces sharing a directed edge.
This can arise when applied to the union of faces from 2 Tgraphs which might clash in places.
It is used in the calculation of commonFaces.  
-}
touchingVerticesGen:: [TileFace] -> [(Vertex,Vertex)]
touchingVerticesGen :: [TileFace] -> [Dedge]
touchingVerticesGen [TileFace]
fcs = [(Vertex, Point V2 Double)] -> [Dedge]
forall {b}. Eq b => [(b, Point V2 Double)] -> [(b, b)]
check [(Vertex, Point V2 Double)]
vpAssoc where
  vpAssoc :: [(Vertex, Point V2 Double)]
vpAssoc = VertexLocMap -> [(Vertex, Point V2 Double)]
forall a. IntMap a -> [(Vertex, a)]
VMap.assocs (VertexLocMap -> [(Vertex, Point V2 Double)])
-> VertexLocMap -> [(Vertex, Point V2 Double)]
forall a b. (a -> b) -> a -> b
$ [TileFace] -> VertexLocMap
locateVerticesGen [TileFace]
fcs  -- assocs puts in key order so that check returns (higher,lower) pairs  
  check :: [(b, Point V2 Double)] -> [(b, b)]
check [] = []
  check ((b
v,Point V2 Double
p):[(b, Point V2 Double)]
more) = [(b
v1,b
v) | b
v1 <- [b]
nearv ] [(b, b)] -> [(b, b)] -> [(b, b)]
forall a. [a] -> [a] -> [a]
++ [(b, Point V2 Double)] -> [(b, b)]
check (((b, Point V2 Double) -> Bool)
-> [(b, Point V2 Double)] -> [(b, Point V2 Double)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((b -> [b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [b]
nearv)(b -> Bool)
-> ((b, Point V2 Double) -> b) -> (b, Point V2 Double) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(b, Point V2 Double) -> b
forall a b. (a, b) -> a
fst) [(b, Point V2 Double)]
more)
                        where nearv :: [b]
nearv = [b
v1 | (b
v1,Point V2 Double
p1) <- [(b, Point V2 Double)]
more, Point V2 Double -> Point V2 Double -> Bool
touching Point V2 Double
p Point V2 Double
p1 ]

{-| locateVerticesGen generalises locateVertices to allow for multiple faces sharing an edge.
This can arise when applied to the union of faces from 2 Tgraphs (e.g. in commonFaces)    
-}
locateVerticesGen:: [TileFace] -> VertexLocMap
locateVerticesGen :: [TileFace] -> VertexLocMap
locateVerticesGen [] = VertexLocMap
forall a. IntMap a
VMap.empty
locateVerticesGen [TileFace]
fcs = [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPointsGen [TileFace
face] ([TileFace] -> Set TileFace
forall a. Ord a => [a] -> Set a
Set.fromList [TileFace]
more) (TileFace -> VertexLocMap
axisJoin TileFace
face) where
    (TileFace
face,[TileFace]
more) = [TileFace] -> (TileFace, [TileFace])
extractLowestJoin [TileFace]
fcs
    efMapGen :: Map Dedge [TileFace]
efMapGen = [TileFace] -> Map Dedge [TileFace]
forall {t :: * -> *}.
Foldable t =>
t TileFace -> Map Dedge [TileFace]
buildEFMapGen [TileFace]
fcs  -- map from Dedge to [TileFace]

{- fastAddVPointsGen readyfaces fcOther vpMap.
The first argument list of faces (readyfaces) contains the ones being processed next in order where
each will have at least two known vertex locations in vpMap.
The second argument Set of faces (fcOther) are faces that have not yet been added
and may not yet have known vertex locations.
The third argument is the mapping of vertices to points.
-}
    fastAddVPointsGen :: [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPointsGen [] Set TileFace
fcOther VertexLocMap
vpMap | Set TileFace -> Bool
forall a. Set a -> Bool
Set.null Set TileFace
fcOther = VertexLocMap
vpMap 
    fastAddVPointsGen [] Set TileFace
fcOther VertexLocMap
_ = String -> VertexLocMap
forall a. HasCallStack => String -> a
error (String -> VertexLocMap) -> String -> VertexLocMap
forall a b. (a -> b) -> a -> b
$ String
"fastAddVPointsGen: Faces not tile-connected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Set TileFace -> String
forall a. Show a => a -> String
show Set TileFace
fcOther String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
    fastAddVPointsGen (TileFace
f:[TileFace]
fs) Set TileFace
fcOther VertexLocMap
vpMap = [TileFace] -> Set TileFace -> VertexLocMap -> VertexLocMap
fastAddVPointsGen ([TileFace]
fs[TileFace] -> [TileFace] -> [TileFace]
forall a. [a] -> [a] -> [a]
++[TileFace]
nbs) Set TileFace
fcOther' VertexLocMap
vpMap' where
        nbs :: [TileFace]
nbs = (TileFace -> Bool) -> [TileFace] -> [TileFace]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileFace -> Set TileFace -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TileFace
fcOther) (TileFace -> [TileFace]
edgeNbsGen TileFace
f)
--        nbs = filter (`Set.member` fcOther) (edgeNbsGen efMapGen fc)
        fcOther' :: Set TileFace
fcOther' = (TileFace -> Set TileFace -> Set TileFace)
-> Set TileFace -> [TileFace] -> Set TileFace
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TileFace -> Set TileFace -> Set TileFace
forall a. Ord a => a -> Set a -> Set a
Set.delete Set TileFace
fcOther [TileFace]
nbs
        vpMap' :: VertexLocMap
vpMap' = TileFace -> VertexLocMap -> VertexLocMap
addVPoint TileFace
f VertexLocMap
vpMap
-- Generalises buildEFMap by allowing for multiple faces on a directed edge.
-- buildEFMapGen:: [TileFace] -> Map.Map Dedge [TileFace]
    buildEFMapGen :: t TileFace -> Map Dedge [TileFace]
buildEFMapGen = ([TileFace] -> [TileFace] -> [TileFace])
-> [(Dedge, [TileFace])] -> Map Dedge [TileFace]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [TileFace] -> [TileFace] -> [TileFace]
forall a. [a] -> [a] -> [a]
(++) ([(Dedge, [TileFace])] -> Map Dedge [TileFace])
-> (t TileFace -> [(Dedge, [TileFace])])
-> t TileFace
-> Map Dedge [TileFace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TileFace -> [(Dedge, [TileFace])])
-> t TileFace -> [(Dedge, [TileFace])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TileFace -> [(Dedge, [TileFace])]
processFace
    processFace :: TileFace -> [(Dedge, [TileFace])]
processFace TileFace
f = (,[TileFace
f]) (Dedge -> (Dedge, [TileFace])) -> [Dedge] -> [(Dedge, [TileFace])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TileFace -> [Dedge]
faceDedges TileFace
f

-- Generalised edgeNbs allowing for multiple faces on a directed edge.
-- edgeNbsGen:: Map.Map Dedge [TileFace] -> TileFace -> [TileFace]
    edgeNbsGen :: TileFace -> [TileFace]
edgeNbsGen TileFace
f = [[TileFace]] -> [TileFace]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TileFace]] -> [TileFace]) -> [[TileFace]] -> [TileFace]
forall a b. (a -> b) -> a -> b
$ (Dedge -> Maybe [TileFace]) -> [Dedge] -> [[TileFace]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Dedge -> Maybe [TileFace]
getNbrs [Dedge]
edges where
      getNbrs :: Dedge -> Maybe [TileFace]
getNbrs Dedge
e = Dedge -> Map Dedge [TileFace] -> Maybe [TileFace]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Dedge
e Map Dedge [TileFace]
efMapGen
      edges :: [Dedge]
edges = (Dedge -> Dedge) -> [Dedge] -> [Dedge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dedge -> Dedge
reverseD (TileFace -> [Dedge]
faceDedges TileFace
f) 
{-
    edgeNbsGen efMapGen f = concat $ mapMaybe getNbrs edges where
      getNbrs e = Map.lookup e efMapGen
      edges = fmap reverseD (faceDedges f) 
-}