{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.Metafont.Internal
-- Copyright   :  (c) 2013 Daniel Bergey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  bergey@alum.mit.edu
--
-- Solve equations due to John Hobby, as implemented in Donald Knuth's
-- /Metafont/, to create (usually) smooth paths from specified points
-- and directions.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Path.Metafont.Internal
       (
           solve, computeControls, locatedTrail
           -- combinator style
           , mfPathToSegments
       )
    where

import           Control.Lens                      hiding (at, ( # ))
import           Data.Maybe

import           Diagrams.Prelude                  hiding (view)
import           Diagrams.Solve.Tridiagonal

import           Diagrams.TwoD.Path.Metafont.Types


-- | Reverse a MetaFont segment, including all directions & joins.
reverseSeg :: Num n => MFS n -> MFS n
reverseSeg :: forall n. Num n => MFS n -> MFS n
reverseSeg MFS n
s = P2 n -> PathJoin (Maybe (PathDir n)) (BasicJoin n) -> P2 n -> MFS n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS (MFS n
sMFS n -> Getting (P2 n) (MFS n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (MFS n) (P2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2) (Maybe (PathDir n)
-> BasicJoin n
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ (Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
rDir (Maybe (PathDir n) -> Maybe (PathDir n))
-> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ MFS n
sMFS n
-> Getting (Maybe (PathDir n)) (MFS n) (Maybe (PathDir n))
-> Maybe (PathDir n)
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (Maybe (PathDir n)) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (Maybe (PathDir n)) (MFS n))
-> ((Maybe (PathDir n)
     -> Const (Maybe (PathDir n)) (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (Maybe (PathDir n)) (MFS n) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n)
 -> Const (Maybe (PathDir n)) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const
     (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2) (MFS n
sMFS n -> Getting (BasicJoin n) (MFS n) (BasicJoin n) -> BasicJoin n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (BasicJoin n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (BasicJoin n) (MFS n))
-> ((BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (BasicJoin n) (MFS n) (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j((BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
    -> BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
-> (BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (BasicJoin n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> BasicJoin n)
-> (BasicJoin n -> Const (BasicJoin n) (BasicJoin n))
-> BasicJoin n
-> Const (BasicJoin n) (BasicJoin n)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BasicJoin n -> BasicJoin n
forall {n} {n}.
Either (TensionJoin n) (ControlJoin n)
-> Either (TensionJoin n) (ControlJoin n)
rj) (Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
rDir (Maybe (PathDir n) -> Maybe (PathDir n))
-> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ MFS n
sMFS n
-> Getting (Maybe (PathDir n)) (MFS n) (Maybe (PathDir n))
-> Maybe (PathDir n)
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (Maybe (PathDir n)) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (Maybe (PathDir n)) (MFS n))
-> ((Maybe (PathDir n)
     -> Const (Maybe (PathDir n)) (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (Maybe (PathDir n)) (MFS n) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n)
 -> Const (Maybe (PathDir n)) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const
     (Maybe (PathDir n)) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1)) (MFS n
sMFS n -> Getting (P2 n) (MFS n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (MFS n) (P2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1) where
  rj :: Either (TensionJoin n) (ControlJoin n)
-> Either (TensionJoin n) (ControlJoin n)
rj (Left TensionJoin n
t) = (TensionJoin n -> Either (TensionJoin n) (ControlJoin n)
forall a b. a -> Either a b
Left (Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (TensionJoin n
tTensionJoin n
-> Getting (Tension n) (TensionJoin n) (Tension n) -> Tension n
forall s a. s -> Getting a s a -> a
^.Getting (Tension n) (TensionJoin n) (Tension n)
forall n (f :: * -> *).
Functor f =>
(Tension n -> f (Tension n)) -> TensionJoin n -> f (TensionJoin n)
t2) (TensionJoin n
tTensionJoin n
-> Getting (Tension n) (TensionJoin n) (Tension n) -> Tension n
forall s a. s -> Getting a s a -> a
^.Getting (Tension n) (TensionJoin n) (Tension n)
forall n (f :: * -> *).
Functor f =>
(Tension n -> f (Tension n)) -> TensionJoin n -> f (TensionJoin n)
t1)))
  rj (Right ControlJoin n
c) = (ControlJoin n -> Either (TensionJoin n) (ControlJoin n)
forall a b. b -> Either a b
Right (P2 n -> P2 n -> ControlJoin n
forall n. P2 n -> P2 n -> ControlJoin n
CJ (ControlJoin n
cControlJoin n -> Getting (P2 n) (ControlJoin n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (ControlJoin n) (P2 n)
forall n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n)) -> ControlJoin n -> f (ControlJoin n)
c2) (ControlJoin n
cControlJoin n -> Getting (P2 n) (ControlJoin n) (P2 n) -> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (ControlJoin n) (P2 n)
forall n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n)) -> ControlJoin n -> f (ControlJoin n)
c1)))
  rDir :: Maybe (PathDir n) -> Maybe (PathDir n)
rDir (Just (PathDirDir Dir n
d)) = (PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (Dir n -> PathDir n
forall n. Dir n -> PathDir n
PathDirDir (Dir n -> Dir n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Dir n
d)))
  rDir Maybe (PathDir n)
d = Maybe (PathDir n)
d

-- | Calculate the length of a MetaFont segment.
mfSegmentLength :: Floating n  => MetafontSegment p j n -> n
mfSegmentLength :: forall n p j. Floating n => MetafontSegment p j n -> n
mfSegmentLength = V2 n -> n
forall a. Floating a => V2 a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (V2 n -> n)
-> (MetafontSegment p j n -> V2 n) -> MetafontSegment p j n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetafontSegment p j n -> V2 n
forall n p j. Num n => MetafontSegment p j n -> V2 n
mfSegmentOffset

-- | Calculate the vector between endpoints of the given segment.
mfSegmentOffset :: Num n => MetafontSegment p j n -> V2 n
mfSegmentOffset :: forall n p j. Num n => MetafontSegment p j n -> V2 n
mfSegmentOffset MetafontSegment p j n
s = MetafontSegment p j n
sMetafontSegment p j n
-> Getting (Point V2 n) (MetafontSegment p j n) (Point V2 n)
-> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MetafontSegment p j n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2 Point V2 n -> Point V2 n -> Diff (Point V2) n
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
.-. MetafontSegment p j n
sMetafontSegment p j n
-> Getting (Point V2 n) (MetafontSegment p j n) (Point V2 n)
-> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MetafontSegment p j n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1

-- | leftCurl s is True if the first direction of s is specified as a curl
leftCurl, rightCurl :: MFS n -> Bool
leftCurl :: forall n. MFS n -> Bool
leftCurl (MFS P2 n
_ (PJ (Just (PathDirCurl n
_)) BasicJoin n
_ Maybe (PathDir n)
_) P2 n
_) = Bool
True
leftCurl MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
_ = Bool
False

-- | rightCurl s is True if the second direction of s is specified as a curl
rightCurl :: forall n. MFS n -> Bool
rightCurl (MFS P2 n
_ (PJ Maybe (PathDir n)
_ BasicJoin n
_ (Just (PathDirCurl n
_))) P2 n
_) = Bool
True
rightCurl MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
_ = Bool
False

-- | Normalize a number representing number of turns to ±½
normalizeTurns :: RealFrac n => n -> n
normalizeTurns :: forall n. RealFrac n => n -> n
normalizeTurns n
t | n
t n -> n -> Bool
forall a. Ord a => a -> a -> Bool
>  n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2   = n
t n -> n -> n
forall a. Num a => a -> a -> a
- Int -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (n -> Int
forall b. Integral b => n -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling n
t :: Int)
normalizeTurns n
t | n
t n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< -n
1n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2   = n
t n -> n -> n
forall a. Num a => a -> a -> a
- Int -> n
forall a b. (Real a, Fractional b) => a -> b
realToFrac (n -> Int
forall b. Integral b => n -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor n
t   :: Int)
normalizeTurns n
t = n
t

-- | By analogy with fromJust, fromLeft returns the Left value or errors
fromLeft :: Either a b -> a
fromLeft :: forall a b. Either a b -> a
fromLeft (Left a
l) = a
l
fromLeft (Right b
_) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"got Right in fromLeft"


-- | Fill in default values for as many blank directions as possible.
-- @fillDirs@ implements all of the following rules:
--
-- 1. Empty direction at beginning or end of path -> curl 1.
--    Note cyclic paths have no beginning/end; will use cyclic tridiagonal.
--
-- 2. Empty direction next to & -> curl 1.
--
-- 3. empty P nonempty -> replace empty with nonempty.
--
-- 4. nonempty P empty -> replace empty with nonempty.
--
-- 5.  .. z .. controls u and ...  -> {u - z} z ... controls if (u /=
--        z), or {curl 1} if u = z
--
--        Similarly  controls u and v ... z ... ->  z {z - v} (or curl 1)
fillDirs :: (Num n, Eq n) => MFP n -> MFP n
fillDirs :: forall n. (Num n, Eq n) => MFP n -> MFP n
fillDirs MFP n
p  = (MFP n -> MFP n
forall n. MFP n -> MFP n
copyDirsLoop (MFP n -> MFP n) -> (MFP n -> MFP n) -> MFP n -> MFP n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFP n -> MFP n
forall n. Num n => MFP n -> MFP n
curlEnds) MFP n
p MFP n -> (MFP n -> MFP n) -> MFP n
forall a b. a -> (a -> b) -> b
& ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Identity (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs (([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Identity (MFP n))
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n
-> MFP n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
              ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall n. [MFS n] -> [MFS n]
copyDirsR ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall n. [MFS n] -> [MFS n]
copyDirsL ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a b. (a -> b) -> [a] -> [b]
map MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
forall n. (Num n, Eq n) => MFS n -> MFS n
controlPtDirs)

-- rules 1 & 2
curlEnds :: Num n => MFP n -> MFP n
curlEnds :: forall n. Num n => MFP n -> MFP n
curlEnds MFP n
p | (MFP n
pMFP n -> Getting Bool (MFP n) Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool (MFP n) Bool
forall d j n (f :: * -> *).
Functor f =>
(Bool -> f Bool) -> MFPath d j n -> f (MFPath d j n)
loop) = MFP n
p
curlEnds MFP n
p             = MFP n
p MFP n -> (MFP n -> MFP n) -> MFP n
forall a b. a -> (a -> b) -> b
& ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Identity (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs (([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Identity (MFP n))
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n
-> MFP n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall {n} {j2} {n}.
Num n =>
[MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
leftEnd where
  leftEnd :: [MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
leftEnd  [MetafontSegment (Maybe (PathDir n)) j2 n
s]         = [MetafontSegment (Maybe (PathDir n)) j2 n
s MetafontSegment (Maybe (PathDir n)) j2 n
-> (MetafontSegment (Maybe (PathDir n)) j2 n
    -> MetafontSegment (Maybe (PathDir n)) j2 n)
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) j2
 -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) j2
  -> Identity (PathJoin (Maybe (PathDir n)) j2))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) j2
    -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) j2
-> Identity (PathJoin (Maybe (PathDir n)) j2)
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> (Maybe (PathDir n) -> Maybe (PathDir n))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
curlIfEmpty MetafontSegment (Maybe (PathDir n)) j2 n
-> (MetafontSegment (Maybe (PathDir n)) j2 n
    -> MetafontSegment (Maybe (PathDir n)) j2 n)
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) j2
 -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) j2
  -> Identity (PathJoin (Maybe (PathDir n)) j2))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) j2
    -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) j2
-> Identity (PathJoin (Maybe (PathDir n)) j2)
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> (Maybe (PathDir n) -> Maybe (PathDir n))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
curlIfEmpty]
  leftEnd  (MetafontSegment (Maybe (PathDir n)) j2 n
s:[MetafontSegment (Maybe (PathDir n)) j2 n]
ss)      = (MetafontSegment (Maybe (PathDir n)) j2 n
s MetafontSegment (Maybe (PathDir n)) j2 n
-> (MetafontSegment (Maybe (PathDir n)) j2 n
    -> MetafontSegment (Maybe (PathDir n)) j2 n)
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) j2
 -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) j2
  -> Identity (PathJoin (Maybe (PathDir n)) j2))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) j2
    -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) j2
-> Identity (PathJoin (Maybe (PathDir n)) j2)
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> (Maybe (PathDir n) -> Maybe (PathDir n))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
curlIfEmpty) MetafontSegment (Maybe (PathDir n)) j2 n
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
forall a. a -> [a] -> [a]
: [MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
forall {n} {j2} {n}.
Num n =>
[MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
rightEnd [MetafontSegment (Maybe (PathDir n)) j2 n]
ss
  leftEnd  []          = []
  rightEnd :: [MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
rightEnd []          = []
  rightEnd [MetafontSegment (Maybe (PathDir n)) j2 n
s]         = [MetafontSegment (Maybe (PathDir n)) j2 n
s MetafontSegment (Maybe (PathDir n)) j2 n
-> (MetafontSegment (Maybe (PathDir n)) j2 n
    -> MetafontSegment (Maybe (PathDir n)) j2 n)
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) j2
 -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) j2
  -> Identity (PathJoin (Maybe (PathDir n)) j2))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) j2
    -> Identity (PathJoin (Maybe (PathDir n)) j2))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> Identity (MetafontSegment (Maybe (PathDir n)) j2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) j2
-> Identity (PathJoin (Maybe (PathDir n)) j2)
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MetafontSegment (Maybe (PathDir n)) j2 n
 -> Identity (MetafontSegment (Maybe (PathDir n)) j2 n))
-> (Maybe (PathDir n) -> Maybe (PathDir n))
-> MetafontSegment (Maybe (PathDir n)) j2 n
-> MetafontSegment (Maybe (PathDir n)) j2 n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (PathDir n) -> Maybe (PathDir n)
forall {n}. Num n => Maybe (PathDir n) -> Maybe (PathDir n)
curlIfEmpty]
  rightEnd (MetafontSegment (Maybe (PathDir n)) j2 n
s:[MetafontSegment (Maybe (PathDir n)) j2 n]
ss)      = MetafontSegment (Maybe (PathDir n)) j2 n
sMetafontSegment (Maybe (PathDir n)) j2 n
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
forall a. a -> [a] -> [a]
:[MetafontSegment (Maybe (PathDir n)) j2 n]
-> [MetafontSegment (Maybe (PathDir n)) j2 n]
rightEnd [MetafontSegment (Maybe (PathDir n)) j2 n]
ss
  curlIfEmpty :: Maybe (PathDir n) -> Maybe (PathDir n)
curlIfEmpty Maybe (PathDir n)
Nothing  = PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n)) -> PathDir n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ n -> PathDir n
forall n. n -> PathDir n
PathDirCurl n
1
  curlIfEmpty Maybe (PathDir n)
d        = Maybe (PathDir n)
d

-- rule 3
copyDirsL :: [MFS n] -> [MFS n]
copyDirsL :: forall n. [MFS n] -> [MFS n]
copyDirsL (s1 :: MFS n
s1@(MFS P2 n
_ (PJ Maybe (PathDir n)
_ BasicJoin n
_ Maybe (PathDir n)
Nothing) P2 n
_) : ss :: [MFS n]
ss@(MFS P2 n
_ (PJ (Just PathDir n
d) BasicJoin n
_ Maybe (PathDir n)
_) P2 n
_ : [MFS n]
_))
  = (MFS n
s1 MFS n -> (MFS n -> MFS n) -> MFS n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Identity (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Identity (MFS n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MFS n
-> Identity (MFS n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MFS n -> Identity (MFS n))
-> Maybe (PathDir n) -> MFS n -> MFS n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just PathDir n
d) MFS n -> [MFS n] -> [MFS n]
forall a. a -> [a] -> [a]
: [MFS n] -> [MFS n]
forall n. [MFS n] -> [MFS n]
copyDirsL [MFS n]
ss
copyDirsL (MFS n
s1 : [MFS n]
ss') = MFS n
s1 MFS n -> [MFS n] -> [MFS n]
forall a. a -> [a] -> [a]
: [MFS n] -> [MFS n]
forall n. [MFS n] -> [MFS n]
copyDirsL [MFS n]
ss'
copyDirsL [] = []

-- rule 4
copyDirsR :: [MFS n] -> [MFS n]
copyDirsR :: forall n. [MFS n] -> [MFS n]
copyDirsR (s1 :: MFS n
s1@(MFS P2 n
_ (PJ Maybe (PathDir n)
_ BasicJoin n
_ (Just PathDir n
d)) P2 n
_) : s2 :: MFS n
s2@(MFS P2 n
_ (PJ Maybe (PathDir n)
Nothing BasicJoin n
_ Maybe (PathDir n)
_) P2 n
_) : [MFS n]
ss)
  = MFS n
s1 MFS n -> [MFS n] -> [MFS n]
forall a. a -> [a] -> [a]
: [MFS n] -> [MFS n]
forall n. [MFS n] -> [MFS n]
copyDirsR ((MFS n
s2 MFS n -> (MFS n -> MFS n) -> MFS n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Identity (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Identity (MFS n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MFS n
-> Identity (MFS n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1 ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
 -> MFS n -> Identity (MFS n))
-> Maybe (PathDir n) -> MFS n -> MFS n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just PathDir n
d) MFS n -> [MFS n] -> [MFS n]
forall a. a -> [a] -> [a]
: [MFS n]
ss)
copyDirsR (MFS n
s1 : [MFS n]
ss') = MFS n
s1 MFS n -> [MFS n] -> [MFS n]
forall a. a -> [a] -> [a]
: [MFS n] -> [MFS n]
forall n. [MFS n] -> [MFS n]
copyDirsR [MFS n]
ss'
copyDirsR [] = []

-- copy a direction from one end of a loop to the other
copyDirsLoop :: MFP n -> MFP n
copyDirsLoop :: forall n. MFP n -> MFP n
copyDirsLoop MFP n
p | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MFP n -> Bool
forall d j n. MFPath d j n -> Bool
_loop MFP n
p = MFP n
p
copyDirsLoop p :: MFP n
p@(MFP Bool
_ []) = MFP n
p
copyDirsLoop MFP n
p | (MFP n
pMFP n -> Getting (Endo Bool) (MFP n) Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo Bool) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo Bool) (MFP n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo Bool) (MFP n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_head((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Bool -> Const (Endo Bool) Bool)
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Bool -> Const (Endo Bool) Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Bool -> Const (Endo Bool) Bool)
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const (Endo Bool) Bool)
    -> Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> (Bool -> Const (Endo Bool) Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const (Endo Bool) Bool)
-> Maybe (PathDir n)
-> Const (Endo Bool) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isJust) Bool -> Bool -> Bool
&&
                 (MFP n
pMFP n -> Getting (Endo Bool) (MFP n) Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo Bool) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo Bool) (MFP n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo Bool) (MFP n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Snoc s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_last((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Bool -> Const (Endo Bool) Bool)
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Bool -> Const (Endo Bool) Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Bool -> Const (Endo Bool) Bool)
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const (Endo Bool) Bool)
    -> Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> (Bool -> Const (Endo Bool) Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const (Endo Bool) Bool)
-> Maybe (PathDir n)
-> Const (Endo Bool) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isNothing) =
                   MFP n
p MFP n -> (MFP n -> MFP n) -> MFP n
forall a b. a -> (a -> b) -> b
& ASetter (MFP n) (MFP n) (Maybe (PathDir n)) (Maybe (PathDir n))
-> (Maybe (PathDir n) -> Maybe (PathDir n)) -> MFP n -> MFP n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Identity (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Identity (MFP n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ASetter (MFP n) (MFP n) (Maybe (PathDir n)) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Snoc s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_last((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2) (Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. a -> b -> a
const (Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n))
-> Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ MFP n
pMFP n
-> Getting (Endo (Maybe (PathDir n))) (MFP n) (Maybe (PathDir n))
-> Maybe (PathDir n)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo (Maybe (PathDir n)))
      [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo (Maybe (PathDir n))) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo (Maybe (PathDir n)))
       [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo (Maybe (PathDir n))) (MFP n))
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo (Maybe (PathDir n)))
         [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo (Maybe (PathDir n))) (MFP n) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_head((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo (Maybe (PathDir n)))
       (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo (Maybe (PathDir n)))
      [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo (Maybe (PathDir n)))
         (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Maybe (PathDir n)
    -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (Endo (Maybe (PathDir n)))
      (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (Endo (Maybe (PathDir n)))
       (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (Endo (Maybe (PathDir n)))
         (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n)
    -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n)
 -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const
     (Endo (Maybe (PathDir n)))
     (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1)
copyDirsLoop MFP n
p | MFP n
pMFP n -> Getting (Endo Bool) (MFP n) Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo Bool) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo Bool) (MFP n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo Bool) (MFP n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_head((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Bool -> Const (Endo Bool) Bool)
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Bool -> Const (Endo Bool) Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Bool -> Const (Endo Bool) Bool)
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const (Endo Bool) Bool)
    -> Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> (Bool -> Const (Endo Bool) Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const (Endo Bool) Bool)
-> Maybe (PathDir n)
-> Const (Endo Bool) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isNothing Bool -> Bool -> Bool
&&
                 MFP n
pMFP n -> Getting (Endo Bool) (MFP n) Bool -> Bool
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo Bool) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo Bool) (MFP n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo Bool) (MFP n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Snoc s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_last((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Bool -> Const (Endo Bool) Bool)
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Bool -> Const (Endo Bool) Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo Bool) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const (Endo Bool) Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Bool -> Const (Endo Bool) Bool)
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo Bool) (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const (Endo Bool) Bool)
    -> Maybe (PathDir n) -> Const (Endo Bool) (Maybe (PathDir n)))
-> (Bool -> Const (Endo Bool) Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (Endo Bool) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const (Endo Bool) Bool)
-> Maybe (PathDir n)
-> Const (Endo Bool) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isJust =
                   MFP n
p MFP n -> (MFP n -> MFP n) -> MFP n
forall a b. a -> (a -> b) -> b
& ASetter (MFP n) (MFP n) (Maybe (PathDir n)) (Maybe (PathDir n))
-> (Maybe (PathDir n) -> Maybe (PathDir n)) -> MFP n -> MFP n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Identity (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Identity (MFP n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ASetter (MFP n) (MFP n) (Maybe (PathDir n)) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_head((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Identity [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Identity (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Identity (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1) (Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. a -> b -> a
const (Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n))
-> Maybe (PathDir n) -> Maybe (PathDir n) -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ MFP n
pMFP n
-> Getting (Endo (Maybe (PathDir n))) (MFP n) (Maybe (PathDir n))
-> Maybe (PathDir n)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo (Maybe (PathDir n)))
      [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> MFP n -> Const (Endo (Maybe (PathDir n))) (MFP n)
forall d1 j1 n1 d2 j2 n2 (f :: * -> *).
Functor f =>
([MetafontSegment d1 j1 n1] -> f [MetafontSegment d2 j2 n2])
-> MFPath d1 j1 n1 -> f (MFPath d2 j2 n2)
segs(([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  -> Const
       (Endo (Maybe (PathDir n)))
       [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
 -> MFP n -> Const (Endo (Maybe (PathDir n))) (MFP n))
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> Const
         (Endo (Maybe (PathDir n)))
         [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> Getting (Endo (Maybe (PathDir n))) (MFP n) (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Snoc s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_last((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo (Maybe (PathDir n)))
       (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo (Maybe (PathDir n)))
      [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo (Maybe (PathDir n)))
         (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> (Maybe (PathDir n)
    -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (Endo (Maybe (PathDir n)))
      (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (Endo (Maybe (PathDir n)))
       (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (Endo (Maybe (PathDir n)))
         (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n)
    -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n)
 -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const
     (Endo (Maybe (PathDir n)))
     (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2)
copyDirsLoop MFP n
p = MFP n
p

-- rule 5
-- apply rule 5 before rules 3 & 4, then depend on those rules to copy the directions
-- into adjacent segments
controlPtDirs :: forall n. (Num n, Eq n) => MFS n -> MFS n
controlPtDirs :: forall n. (Num n, Eq n) => MFS n -> MFS n
controlPtDirs s :: MFS n
s@(MFS P2 n
z0 (PJ Maybe (PathDir n)
_ jj :: BasicJoin n
jj@(Right (CJ P2 n
u P2 n
v)) Maybe (PathDir n)
_) P2 n
z1) = MFS n
s MFS n -> (MFS n -> MFS n) -> MFS n
forall a b. a -> (a -> b) -> b
& (PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Identity (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj ((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Identity (MFS n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n) -> MFS n -> MFS n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PathJoin (Maybe (PathDir n)) (BasicJoin n)
dirs where
  dirs :: PathJoin (Maybe (PathDir n)) (BasicJoin n)
dirs = Maybe (PathDir n)
-> BasicJoin n
-> Maybe (PathDir n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ (P2 n -> P2 n -> Maybe (PathDir n)
dir P2 n
z0 P2 n
u) BasicJoin n
jj (P2 n -> P2 n -> Maybe (PathDir n)
dir P2 n
v P2 n
z1)
  dir :: P2 n -> P2 n -> Maybe (PathDir n)
  dir :: P2 n -> P2 n -> Maybe (PathDir n)
dir P2 n
p0 P2 n
p1 | P2 n
p0 P2 n -> P2 n -> Bool
forall a. Eq a => a -> a -> Bool
== P2 n
p1 = PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n)) -> PathDir n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ n -> PathDir n
forall n. n -> PathDir n
PathDirCurl n
1
  dir P2 n
p0 P2 n
p1 | Bool
otherwise = PathDir n -> Maybe (PathDir n)
forall a. a -> Maybe a
Just (PathDir n -> Maybe (PathDir n))
-> (V2 n -> PathDir n) -> V2 n -> Maybe (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dir n -> PathDir n
forall n. Dir n -> PathDir n
PathDirDir (Dir n -> PathDir n) -> (V2 n -> Dir n) -> V2 n -> PathDir n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Maybe (PathDir n)) -> V2 n -> Maybe (PathDir n)
forall a b. (a -> b) -> a -> b
$ (P2 n
p1 P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
p0)
controlPtDirs MFS n
s = MFS n
s

-- | Run all the rules required to fully specify all segment directions,
-- but do not replace the Joins with ControlJoin.
solve :: RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solve :: forall n. RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solve = MFP n -> MFPath (Dir n) (BasicJoin n) n
forall n. RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solvePath (MFP n -> MFPath (Dir n) (BasicJoin n) n)
-> (MFP n -> MFP n) -> MFP n -> MFPath (Dir n) (BasicJoin n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFP n -> MFP n
forall n. (Num n, Eq n) => MFP n -> MFP n
fillDirs

-- | each sublist of groupSegments ss satisfies:
-- isJust . d1 . pj . head
-- isJust . d2 . pj . last
-- all (isNothing . d1 . pj) . init . tail
-- all (isNothing . d2 . pj) . init . tail
-- That is, each sublist can be handled as a line,
-- (except the first and last, if the initial MFP was a loop).
groupSegments :: [MFS n] -> [[MFS n]]
groupSegments :: forall n. [MFS n] -> [[MFS n]]
groupSegments [] = []
groupSegments (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
s:[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss) = (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
sMetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. a -> [a] -> [a]
:[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
open)[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall a. a -> [a] -> [a]
:[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall n. [MFS n] -> [[MFS n]]
groupSegments [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
rest where
  ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
open,[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
rest) = (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n],
    [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Getting
  Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool)
-> Getting
     Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Bool
forall a b. (a -> b) -> a -> b
$ (PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const Bool Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting
     Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const Bool Bool)
    -> Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
-> (Bool -> Const Bool Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const Bool Bool)
-> Maybe (PathDir n)
-> Const Bool (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isNothing) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss

-- | Calculate the tangent direction at all remaining points.
-- This function dispatches all of the hard work to other functions.
-- It distinguishes 3 cases:
-- * A loop with no internal directions given.
-- * A loop with one or more directions given.
--     Mathematically, this is handled like a line, but the Loopness is
--     preserved, so that the Diagrams Trail is a Loop.
-- * A line, consisting of one or more segments as described in groupSegments.
-- Note that the result type is different from the input, reflecting
-- fully specified directions.
solvePath :: RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solvePath :: forall n. RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solvePath (MFP Bool
False [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss) = Bool
-> [MetafontSegment (Dir n) (BasicJoin n) n]
-> MFPath (Dir n) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
False ([[MetafontSegment (Dir n) (BasicJoin n) n]]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MetafontSegment (Dir n) (BasicJoin n) n]]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [[MetafontSegment (Dir n) (BasicJoin n) n]])
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Dir n) (BasicJoin n) n]]
forall a b. (a -> b) -> [a] -> [b]
map [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall n.
RealFloat n =>
[MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLine ([[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
 -> [[MetafontSegment (Dir n) (BasicJoin n) n]])
-> ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
    -> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [[MetafontSegment (Dir n) (BasicJoin n) n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall n. [MFS n] -> [[MFS n]]
groupSegments ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall a b. (a -> b) -> a -> b
$ [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss)
-- A simple loop.  All directions are unknown, curvature gives us enough equations.
solvePath (MFP Bool
True [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss) | (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool)
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Getting
  Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting
   Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n -> Bool)
-> Getting
     Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Bool
forall a b. (a -> b) -> a -> b
$ (PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Bool -> Const Bool Bool)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting
     Bool (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((Bool -> Const Bool Bool)
    -> Maybe (PathDir n) -> Const Bool (Maybe (PathDir n)))
-> (Bool -> Const Bool Bool)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const Bool (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Bool)
-> (Bool -> Const Bool Bool)
-> Maybe (PathDir n)
-> Const Bool (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> Bool
forall a. Maybe a -> Bool
isNothing) [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss = Bool
-> [MetafontSegment (Dir n) (BasicJoin n) n]
-> MFPath (Dir n) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
True ([MetafontSegment (Dir n) (BasicJoin n) n]
 -> MFPath (Dir n) (BasicJoin n) n)
-> [MetafontSegment (Dir n) (BasicJoin n) n]
-> MFPath (Dir n) (BasicJoin n) n
forall a b. (a -> b) -> a -> b
$ [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall n.
RealFloat n =>
[MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLoop [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss
solvePath (MFP Bool
True [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss) = Bool
-> [MetafontSegment (Dir n) (BasicJoin n) n]
-> MFPath (Dir n) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
True [MetafontSegment (Dir n) (BasicJoin n) n]
ss'' where
  ss' :: [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss' = [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall n. [MFS n] -> [[MFS n]]
groupSegments [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss
  ss'' :: [MetafontSegment (Dir n) (BasicJoin n) n]
ss'' = [[MetafontSegment (Dir n) (BasicJoin n) n]]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[MetafontSegment (Dir n) (BasicJoin n) n]]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> ([[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
    -> [[MetafontSegment (Dir n) (BasicJoin n) n]])
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Dir n) (BasicJoin n) n]]
forall a b. (a -> b) -> [a] -> [b]
map [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall n.
RealFloat n =>
[MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLine ([[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
 -> [MetafontSegment (Dir n) (BasicJoin n) n])
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall a b. (a -> b) -> a -> b
$ case [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss'[[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> Getting
     (Endo [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!Getting
  (Endo [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
_head[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Getting
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
     (Maybe (PathDir n))
-> Maybe (PathDir n)
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> Const
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall s a. Cons s s a a => Traversal' s a
Traversal'
  [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
  (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
_head((MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
  -> Const
       (Endo (Maybe (PathDir n)))
       (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
 -> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
 -> Const
      (Endo (Maybe (PathDir n)))
      [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n])
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
    -> Const
         (Endo (Maybe (PathDir n)))
         (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> Getting
     (Endo (Maybe (PathDir n)))
     [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
     (Maybe (PathDir n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const
      (Endo (Maybe (PathDir n)))
      (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const
       (Endo (Maybe (PathDir n)))
       (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
 -> Const
      (Endo (Maybe (PathDir n)))
      (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n))
-> ((Maybe (PathDir n)
     -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const
         (Endo (Maybe (PathDir n)))
         (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> (Maybe (PathDir n)
    -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> Const
     (Endo (Maybe (PathDir n)))
     (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n)
 -> Const (Endo (Maybe (PathDir n))) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const
     (Endo (Maybe (PathDir n)))
     (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1 of
      (Just (PathDirDir Dir n
_)) -> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss'
      Maybe (PathDir n)
_ -> ([[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> ([[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
    -> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
-> Maybe [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall a. a -> a
id (Maybe [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
 -> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
-> Maybe [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall a b. (a -> b) -> a -> b
$ [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss'[[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> Getting
     (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> Maybe [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall s a. s -> Getting (First a) s a -> Maybe a
^?Getting
  (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall s a. Cons s s a a => Traversal' s s
Traversal'
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
_tailGetting
  (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> Getting
     (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> Getting
     (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
     [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Getting
  (First [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]])
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall s a. Snoc s s a a => Traversal' s s
Traversal'
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
  [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
_init) [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
forall a. [a] -> [a] -> [a]
++ [[[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. HasCallStack => [a] -> a
last [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss' [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. [a] -> [a] -> [a]
++ [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. HasCallStack => [a] -> a
head [[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]]
ss']

-- | Calculate the tangent directions at all points.  The input list is assumed
-- to form a loop; this is not checked.
-- See 'setDirs' for an explanation of offset angles.
solveLoop :: forall n. (RealFloat n) => [MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLoop :: forall n.
RealFloat n =>
[MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLoop [MFS n]
ss = (MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n)
-> [MFS n]
-> [n]
-> [n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n
forall n.
Floating n =>
MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n
setDirs [MFS n]
ss [n]
thetas [n]
phis where
  segmentPairs :: [(MFS n, MFS n)]
segmentPairs = [MFS n] -> [MFS n] -> [(MFS n, MFS n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [MFS n]
ss ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail ([MFS n] -> [MFS n]) -> ([MFS n] -> [MFS n]) -> [MFS n] -> [MFS n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
cycle ([MFS n] -> [MFS n]) -> [MFS n] -> [MFS n]
forall a b. (a -> b) -> a -> b
$ [MFS n]
ss)
  thetas, phis :: [n]
  thetas :: [n]
thetas = [MFS n] -> [n]
forall n. RealFloat n => [MFS n] -> [n]
loopDirs [MFS n]
ss
  phis :: [n]
phis = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map n -> n
forall a. Num a => a -> a
negate ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) (((MFS n, MFS n) -> n) -> [(MFS n, MFS n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi [(MFS n, MFS n)]
segmentPairs) ([n] -> [n]
forall a. HasCallStack => [a] -> [a]
tail ([n] -> [n]) -> ([n] -> [n]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> [n]
forall a. HasCallStack => [a] -> [a]
cycle ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ [n]
thetas)

-- | Calculate the offset angles θ for the case of a loop.
--   This is a system of (length ss) equations.  The first element of
--   loopDirs ss is θ for the starting point of the first segment of ss.
loopDirs :: RealFloat n => [MFS n] -> [n]
loopDirs :: forall n. RealFloat n => [MFS n] -> [n]
loopDirs [MFS n]
ss = [n] -> [n] -> [n] -> [n] -> n -> n -> [n]
forall a. Fractional a => [a] -> [a] -> [a] -> [a] -> a -> a -> [a]
solveCyclicTriDiagonal [n]
lower [n]
diag [n]
upper [n]
products n
ll n
ur where
  ([n]
lower, [n]
diag, [n]
upper, [n]
products, n
ll, n
ur) = [MFS n] -> ([n], [n], [n], [n], n, n)
forall n. RealFloat n => [MFS n] -> ([n], [n], [n], [n], n, n)
loopEqs [MFS n]
ss

-- | Calculate the coefficients for the loop case, in the
-- format required by solveCyclicTriDiagonal.
-- See mf.web ¶ 273
loopEqs :: RealFloat n => [MFS n]
           -> ([n], [n], [n], [n], n, n)
loopEqs :: forall n. RealFloat n => [MFS n] -> ([n], [n], [n], [n], n, n)
loopEqs [MFS n]
ss = ([n]
lower, [n]
diag, [n]
upper, [n]
products, n
ll, n
ur) where
  lower :: [n]
lower = (MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
aCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss)
  sLast :: MFS n
sLast = [MFS n] -> MFS n
forall a. HasCallStack => [a] -> a
last [MFS n]
ss
  diag :: [n]
diag = (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
bCo ([MFS n] -> [n]) -> [MFS n] -> [n]
forall a b. (a -> b) -> a -> b
$ [MFS n
sLast] [MFS n] -> [MFS n] -> [MFS n]
forall a. [a] -> [a] -> [a]
++ [MFS n]
ss) ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
cCo [MFS n]
ss)
  upper :: [n]
upper = (MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
dCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss)
  ur :: n
ur = MFS n -> n
forall n. Floating n => MFS n -> n
aCo MFS n
sLast
  ll :: n
ll = MFS n -> n
forall n. Floating n => MFS n -> n
dCo MFS n
sLast
  segmentPairs :: [(MFS n, MFS n)]
segmentPairs = [MFS n] -> [MFS n] -> [(MFS n, MFS n)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[MFS n] -> MFS n
forall a. HasCallStack => [a] -> a
last [MFS n]
ss] [MFS n] -> [MFS n] -> [MFS n]
forall a. [a] -> [a] -> [a]
++ [MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss) [MFS n]
ss
  products :: [n]
products = (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)
               [-n
1 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n. Floating n => MFS n -> n
bCo MFS n
l n -> n -> n
forall a. Num a => a -> a -> a
* (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi (MFS n, MFS n)
s | s :: (MFS n, MFS n)
s@(MFS n
l,MFS n
_) <- [(MFS n, MFS n)]
segmentPairs]
               ((n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*)
                ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
dCo [MFS n]
ss)
                (((MFS n, MFS n) -> n) -> [(MFS n, MFS n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi ([(MFS n, MFS n)] -> [n]) -> [(MFS n, MFS n)] -> [n]
forall a b. (a -> b) -> a -> b
$ [(MFS n, MFS n)] -> [(MFS n, MFS n)]
forall a. HasCallStack => [a] -> [a]
tail [(MFS n, MFS n)]
segmentPairs)
                [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [MFS n -> n
forall n. Floating n => MFS n -> n
dCo MFS n
sLast n -> n -> n
forall a. Num a => a -> a -> a
* (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi ([(MFS n, MFS n)] -> (MFS n, MFS n)
forall a. HasCallStack => [a] -> a
head [(MFS n, MFS n)]
segmentPairs)])

-- | solveLine takes a list of segments where only the first and last points
-- have known directions.  The type signature matches that of solveLoop, and the
-- precondition is not checked.
-- The equivalent MetaFont code (in make_choices) is written in terms of points,
-- rather than segments.  See metafont code paragraphs 271--274.
solveLine :: forall n. RealFloat n => [MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLine :: forall n.
RealFloat n =>
[MFS n] -> [MetafontSegment (Dir n) (BasicJoin n) n]
solveLine [MFS P2 n
z1 (PJ (Just (PathDirDir Dir n
d1')) BasicJoin n
jj (Just (PathDirDir Dir n
d2'))) P2 n
z2] =
  [P2 n
-> PathJoin (Dir n) (BasicJoin n)
-> P2 n
-> MetafontSegment (Dir n) (BasicJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
z1 (Dir n -> BasicJoin n -> Dir n -> PathJoin (Dir n) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ Dir n
d1' BasicJoin n
jj Dir n
d2') P2 n
z2]
solveLine [MFS n]
ss = (MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n)
-> [MFS n]
-> [n]
-> [n]
-> [MetafontSegment (Dir n) (BasicJoin n) n]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n
forall n.
Floating n =>
MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n
setDirs [MFS n]
ss ([n] -> [n]
forall a. HasCallStack => [a] -> [a]
init [n]
thetas) [n]
phis where
  segmentPairs :: [(MFS n, MFS n)]
segmentPairs = [MFS n] -> [MFS n] -> [(MFS n, MFS n)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss) ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail [MFS n]
ss)
  thetas :: [n]
thetas = [MFS n] -> [n]
forall n. RealFloat n => [MFS n] -> [n]
lineDirs [MFS n]
ss
  phis :: [n]
  phis :: [n]
phis = (n -> n) -> [n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map n -> n
forall a. Num a => a -> a
negate ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) (((MFS n, MFS n) -> n) -> [(MFS n, MFS n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi [(MFS n, MFS n)]
segmentPairs [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n
0]) ([n] -> [n]
forall a. HasCallStack => [a] -> [a]
tail [n]
thetas)

-- | setDirs takes a segment with underspecified directions, and two offset
-- angles, and sets the directions at both ends of the segment.
-- The offset angle is measured between the direction vector at either end and
-- the vector difference of the segment endpoints.
setDirs :: Floating n => MFS n -- ^ The segment to be modified
        -> n -- ^ theta, the offset angle at the starting point
        -> n -- ^ phi, the ofset angle at the endpoint
        -> MetafontSegment (Dir n) (BasicJoin n) n
setDirs :: forall n.
Floating n =>
MFS n -> n -> n -> MetafontSegment (Dir n) (BasicJoin n) n
setDirs (MFS P2 n
z0 (PJ Maybe (PathDir n)
w0' BasicJoin n
jj Maybe (PathDir n)
w1') P2 n
z1) n
t n
p = P2 n
-> PathJoin (Direction V2 n) (BasicJoin n)
-> P2 n
-> MetafontSegment (Direction V2 n) (BasicJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
z0 (Direction V2 n
-> BasicJoin n
-> Direction V2 n
-> PathJoin (Direction V2 n) (BasicJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ Direction V2 n
w0 BasicJoin n
jj Direction V2 n
w1) P2 n
z1 where
    offs :: Direction V2 n
offs  = V2 n -> Direction V2 n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Direction V2 n) -> V2 n -> Direction V2 n
forall a b. (a -> b) -> a -> b
$ P2 n
z1 P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0
    w0 :: Direction V2 n
w0 = case Maybe (PathDir n)
w0' of
      (Just (PathDirDir Direction V2 n
d)) -> Direction V2 n
d
      Maybe (PathDir n)
_ -> Direction V2 n
offs Direction V2 n
-> (Direction V2 n -> Direction V2 n) -> Direction V2 n
forall a b. a -> (a -> b) -> b
# Angle n -> Direction V2 n -> Direction V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (n
t n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)
    w1 :: Direction V2 n
w1 = case Maybe (PathDir n)
w1' of
      (Just (PathDirDir Direction V2 n
d)) -> Direction V2 n
d
      Maybe (PathDir n)
_ -> Direction V2 n
offs Direction V2 n
-> (Direction V2 n -> Direction V2 n) -> Direction V2 n
forall a b. a -> (a -> b) -> b
# Angle n -> Direction V2 n -> Direction V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (n -> n
forall a. Num a => a -> a
negate n
p n -> AReview (Angle n) n -> Angle n
forall b a. b -> AReview a b -> a
@@ AReview (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn)

-- | psi (l,r) calculates the turning angle between segments l and r, if
-- each segment were a straight line connecting its endpoints.  The endpoint of l
-- is assumed to be the starting point of r; this is not checked.
psi :: RealFloat n => (MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi :: forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi (MetafontSegment p j1 n
l,MetafontSegment p j1 n
r) = n -> n
forall n. RealFrac n => n -> n
normalizeTurns n
t where
  t :: n
t = Getting n (Angle n) n -> Angle n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn (Angle n -> n) -> Angle n -> n
forall a b. (a -> b) -> a -> b
$ V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween (MetafontSegment p j1 n -> V2 n
forall n p j. Num n => MetafontSegment p j n -> V2 n
mfSegmentOffset MetafontSegment p j1 n
r) (MetafontSegment p j1 n -> V2 n
forall n p j. Num n => MetafontSegment p j n -> V2 n
mfSegmentOffset MetafontSegment p j1 n
l)

-- | lineDirs calculates the offset angles θ for a Line.  Most of the work
-- done by lineEqs and solveTriDiagonal, but lineDirs handles the separate cases
-- of an empty list, and lists of length one.  See mf.web ¶ 280.
lineDirs :: RealFloat n => [MFS n] -> [n]
lineDirs :: forall n. RealFloat n => [MFS n] -> [n]
lineDirs [MFS n]
ss | [MFS n] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MFS n]
ss Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = [n] -> [n] -> [n] -> [n] -> [n]
forall a. Fractional a => [a] -> [a] -> [a] -> [a] -> [a]
solveTriDiagonal [n]
lower [n]
diag [n]
upper [n]
products where
  ([n]
lower, [n]
diag, [n]
upper, [n]
products) = [MFS n] -> ([n], [n], [n], [n])
forall n. RealFloat n => [MFS n] -> ([n], [n], [n], [n])
lineEqs [MFS n]
ss
lineDirs [] = []
lineDirs [MFS n
s] | MFS n -> Bool
forall n. MFS n -> Bool
leftCurl MFS n
s Bool -> Bool -> Bool
&& MFS n -> Bool
forall n. MFS n -> Bool
rightCurl MFS n
s = [n
0, n
0] where
lineDirs [MFS n
s] | MFS n -> Bool
forall n. MFS n -> Bool
rightCurl MFS n
s = [n] -> [n] -> [n] -> [n] -> [n]
forall a. Fractional a => [a] -> [a] -> [a] -> [a] -> [a]
solveTriDiagonal [n
a] [n
1,n
c] [n
0] [n -> n
forall n. RealFrac n => n -> n
normalizeTurns n
t, n
r] where
  (n
a,n
c,n
r) = MFS n -> (n, n, n)
forall n. RealFloat n => MFS n -> (n, n, n)
solveOneSeg MFS n
s
  (PathDirDir Dir n
d) = MFS n
sMFS n -> Getting (PathDir n) (MFS n) (PathDir n) -> PathDir n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (PathDir n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (PathDir n) (MFS n))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (PathDir n) (MFS n) (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> PathDir n)
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> Maybe (PathDir n)
-> Const (PathDir n) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> PathDir n
forall a. HasCallStack => Maybe a -> a
fromJust
  t :: n
t = Getting n (Angle n) n -> Angle n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn (Angle n -> n) -> Angle n -> n
forall a b. (a -> b) -> a -> b
$ Dir n -> Dir n -> Angle n
forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Direction v n -> Direction v n -> Angle n
angleBetweenDirs Dir n
d (V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Dir n) -> V2 n -> Dir n
forall a b. (a -> b) -> a -> b
$ MFS n
sMFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2 Point V2 n -> Point V2 n -> Diff (Point V2) n
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
.-. MFS n
sMFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)
lineDirs [MFS n
s] | MFS n -> Bool
forall n. MFS n -> Bool
leftCurl MFS n
s = [n] -> [n]
forall a. [a] -> [a]
reverse ([n] -> [n]) -> [n] -> [n]
forall a b. (a -> b) -> a -> b
$ [MFS n] -> [n]
forall n. RealFloat n => [MFS n] -> [n]
lineDirs [MFS n -> MFS n
forall n. Num n => MFS n -> MFS n
reverseSeg MFS n
s]
lineDirs [MFS n]
_ = [Char] -> [n]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [n]) -> [Char] -> [n]
forall a b. (a -> b) -> a -> b
$ [Char]
"lineDirs was called on something inappropriate.  \
\It should be called on a list of segments with directions specified at both ends.\
\It should only be called through solveLine."

-- | Each intermediate point produces one curvature equation, as in loopEqs.
-- The endpoint equations are the same as those for the single-segment line in
-- lineDirs.
-- lineEqs only works when segs has length > 1; this precondition is not checked.
lineEqs :: RealFloat n => [MFS n] -> ([n], [n], [n], [n])
lineEqs :: forall n. RealFloat n => [MFS n] -> ([n], [n], [n], [n])
lineEqs [MFS n]
ss = ([n]
lower, [n]
diag, [n]
upper, [n]
products) where
  segmentPairs :: [(MFS n, MFS n)]
segmentPairs = [MFS n] -> [MFS n] -> [(MFS n, MFS n)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss) ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail [MFS n]
ss)
  lower :: [n]
lower = (MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
aCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss) [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n
an]
  diag :: [n]
diag  = n
c0 n -> [n] -> [n]
forall a. a -> [a] -> [a]
: (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+) ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
bCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
init [MFS n]
ss)) ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
cCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail [MFS n]
ss)) [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n
cn]
  upper :: [n]
upper = (n
d0 n -> [n] -> [n]
forall a. a -> [a] -> [a]
: (MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
dCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail [MFS n]
ss))
  products :: [n]
products = n
r0 n -> [n] -> [n]
forall a. a -> [a] -> [a]
: (n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-)
               [-n
1 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n. Floating n => MFS n -> n
bCo MFS n
l n -> n -> n
forall a. Num a => a -> a -> a
* (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi (MFS n, MFS n)
s | s :: (MFS n, MFS n)
s@(MFS n
l,MFS n
_) <- [(MFS n, MFS n)]
segmentPairs]
               ((n -> n -> n) -> [n] -> [n] -> [n]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith n -> n -> n
forall a. Num a => a -> a -> a
(*)
                 ((MFS n -> n) -> [MFS n] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map MFS n -> n
forall n. Floating n => MFS n -> n
dCo ([MFS n] -> [MFS n]
forall a. HasCallStack => [a] -> [a]
tail ([MFS n] -> [MFS n]) -> [MFS n] -> [MFS n]
forall a b. (a -> b) -> a -> b
$ [MFS n]
ss))
                 (((MFS n, MFS n) -> n) -> [(MFS n, MFS n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi ([(MFS n, MFS n)] -> [(MFS n, MFS n)]
forall a. HasCallStack => [a] -> [a]
tail [(MFS n, MFS n)]
segmentPairs)
                [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n
0])) [n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++ [n
rn]
  (n
d0,n
c0,n
_) = MFS n -> (n, n, n)
forall n. RealFloat n => MFS n -> (n, n, n)
solveOneSeg (MFS n -> (n, n, n)) -> (MFS n -> MFS n) -> MFS n -> (n, n, n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFS n -> MFS n
forall n. Num n => MFS n -> MFS n
reverseSeg (MFS n -> (n, n, n)) -> MFS n -> (n, n, n)
forall a b. (a -> b) -> a -> b
$ MFS n
s0
  r0 :: n
r0 = PathDir n -> n
r0' (MFS n
s0MFS n -> Getting (PathDir n) (MFS n) (PathDir n) -> PathDir n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (PathDir n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (PathDir n) (MFS n))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (PathDir n) (MFS n) (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d1((Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> PathDir n)
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> Maybe (PathDir n)
-> Const (PathDir n) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> PathDir n
forall a. HasCallStack => Maybe a -> a
fromJust) where
    r0' :: PathDir n -> n
r0' (PathDirDir Dir n
d) = n -> n
forall n. RealFrac n => n -> n
normalizeTurns n
t where
      t :: n
t = Getting n (Angle n) n -> Angle n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn (Angle n -> n) -> Angle n -> n
forall a b. (a -> b) -> a -> b
$ Dir n -> Dir n -> Angle n
forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Direction v n -> Direction v n -> Angle n
angleBetweenDirs Dir n
d  (V2 n -> Dir n
forall (v :: * -> *) n. v n -> Direction v n
direction (V2 n -> Dir n) -> V2 n -> Dir n
forall a b. (a -> b) -> a -> b
$ MFS n
s0MFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2 Point V2 n -> Point V2 n -> Diff (Point V2) n
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
.-. MFS n
s0MFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)
    r0' (PathDirCurl n
_) = n -> n
forall a. Num a => a -> a
negate (n -> n) -> n -> n
forall a b. (a -> b) -> a -> b
$ n
d0 n -> n -> n
forall a. Num a => a -> a -> a
* (MFS n, MFS n) -> n
forall n p j1.
RealFloat n =>
(MetafontSegment p j1 n, MetafontSegment p j1 n) -> n
psi (MFS n
s0, [MFS n]
ss[MFS n] -> Int -> MFS n
forall a. HasCallStack => [a] -> Int -> a
!!Int
1)
  s0 :: MFS n
s0 = [MFS n] -> MFS n
forall a. HasCallStack => [a] -> a
head [MFS n]
ss
  (n
an, n
cn, n
rn) = MFS n -> (n, n, n)
forall n. RealFloat n => MFS n -> (n, n, n)
solveOneSeg ([MFS n] -> MFS n
forall a. HasCallStack => [a] -> a
last [MFS n]
ss)

-- These functions calculate the coefficients in lineEqs, loopEqs
-- They are derived in mf.web ¶ 272-273
alpha, beta, aCo, bCo, cCo, dCo :: Floating n => MFS n -> n
alpha :: forall n. Floating n => MFS n -> n
alpha MFS n
s = n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ MFS n
sMFS n -> Getting n (MFS n) n -> n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const n (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const n (MFS n))
-> ((n -> Const n n)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting n (MFS n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> Const n (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j((BasicJoin n -> Const n (BasicJoin n))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((n -> Const n n) -> BasicJoin n -> Const n (BasicJoin n))
-> (n -> Const n n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> TensionJoin n)
-> (TensionJoin n -> Const n (TensionJoin n))
-> BasicJoin n
-> Const n (BasicJoin n)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BasicJoin n -> TensionJoin n
forall a b. Either a b -> a
fromLeft((TensionJoin n -> Const n (TensionJoin n))
 -> BasicJoin n -> Const n (BasicJoin n))
-> ((n -> Const n n) -> TensionJoin n -> Const n (TensionJoin n))
-> (n -> Const n n)
-> BasicJoin n
-> Const n (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Tension n -> Const n (Tension n))
-> TensionJoin n -> Const n (TensionJoin n)
forall n (f :: * -> *).
Functor f =>
(Tension n -> f (Tension n)) -> TensionJoin n -> f (TensionJoin n)
t1((Tension n -> Const n (Tension n))
 -> TensionJoin n -> Const n (TensionJoin n))
-> ((n -> Const n n) -> Tension n -> Const n (Tension n))
-> (n -> Const n n)
-> TensionJoin n
-> Const n (TensionJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Tension n -> n)
-> (n -> Const n n) -> Tension n -> Const n (Tension n)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Tension n -> n
forall n. Tension n -> n
getTension
beta :: forall n. Floating n => MFS n -> n
beta  MFS n
s = n
1 n -> n -> n
forall a. Fractional a => a -> a -> a
/ MFS n
sMFS n -> Getting n (MFS n) n -> n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const n (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const n (MFS n))
-> ((n -> Const n n)
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting n (MFS n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> Const n (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j((BasicJoin n -> Const n (BasicJoin n))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((n -> Const n n) -> BasicJoin n -> Const n (BasicJoin n))
-> (n -> Const n n)
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const n (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BasicJoin n -> TensionJoin n)
-> (TensionJoin n -> Const n (TensionJoin n))
-> BasicJoin n
-> Const n (BasicJoin n)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BasicJoin n -> TensionJoin n
forall a b. Either a b -> a
fromLeft((TensionJoin n -> Const n (TensionJoin n))
 -> BasicJoin n -> Const n (BasicJoin n))
-> ((n -> Const n n) -> TensionJoin n -> Const n (TensionJoin n))
-> (n -> Const n n)
-> BasicJoin n
-> Const n (BasicJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Tension n -> Const n (Tension n))
-> TensionJoin n -> Const n (TensionJoin n)
forall n (f :: * -> *).
Functor f =>
(Tension n -> f (Tension n)) -> TensionJoin n -> f (TensionJoin n)
t2((Tension n -> Const n (Tension n))
 -> TensionJoin n -> Const n (TensionJoin n))
-> ((n -> Const n n) -> Tension n -> Const n (Tension n))
-> (n -> Const n n)
-> TensionJoin n
-> Const n (TensionJoin n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Tension n -> n)
-> (n -> Const n n) -> Tension n -> Const n (Tension n)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Tension n -> n
forall n. Tension n -> n
getTension
aCo :: forall n. Floating n => MFS n -> n
aCo MFS n
s = (MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n p j. Floating n => MetafontSegment p j n -> n
mfSegmentLength MFS n
s)
bCo :: forall n. Floating n => MFS n -> n
bCo MFS n
s = (n
3 n -> n -> n
forall a. Num a => a -> a -> a
- MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n p j. Floating n => MetafontSegment p j n -> n
mfSegmentLength MFS n
s)
cCo :: forall n. Floating n => MFS n -> n
cCo MFS n
s = (n
3 n -> n -> n
forall a. Num a => a -> a -> a
- MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n p j. Floating n => MetafontSegment p j n -> n
mfSegmentLength MFS n
s)
dCo :: forall n. Floating n => MFS n -> n
dCo MFS n
s = (MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s) n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2 n -> n -> n
forall a. Num a => a -> a -> a
* MFS n -> n
forall n p j. Floating n => MetafontSegment p j n -> n
mfSegmentLength MFS n
s)

-- | solveOneSeg calculates the coefficients of the angle equation for
-- the final segment of a line, which may incidentally be the only
-- segment.
solveOneSeg :: RealFloat n => MFS n -> (n, n, n)
solveOneSeg :: forall n. RealFloat n => MFS n -> (n, n, n)
solveOneSeg MFS n
s = (n
a, n
c, n
r) where
  a :: n
a = PathDir n -> n
a' (MFS n
sMFS n -> Getting (PathDir n) (MFS n) (PathDir n) -> PathDir n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (PathDir n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (PathDir n) (MFS n))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (PathDir n) (MFS n) (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> PathDir n)
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> Maybe (PathDir n)
-> Const (PathDir n) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> PathDir n
forall a. HasCallStack => Maybe a -> a
fromJust) where
    a' :: PathDir n -> n
a' (PathDirDir Dir n
_) = n
0
    a' (PathDirCurl n
g) = (n
3 n -> n -> n
forall a. Num a => a -> a -> a
- MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s) n -> n -> n
forall a. Num a => a -> a -> a
* (MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s) n -> n -> n
forall a. Floating a => a -> a -> a
**n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n
g n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2) n -> n -> n
forall a. Num a => a -> a -> a
+ MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s
  c :: n
c = PathDir n -> n
c' (MFS n
sMFS n -> Getting (PathDir n) (MFS n) (PathDir n) -> PathDir n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (PathDir n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (PathDir n) (MFS n))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (PathDir n) (MFS n) (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> PathDir n)
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> Maybe (PathDir n)
-> Const (PathDir n) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> PathDir n
forall a. HasCallStack => Maybe a -> a
fromJust) where
       c' :: PathDir n -> n
c' (PathDirDir Dir n
_) = n
1
       c' (PathDirCurl n
g) = MFS n -> n
forall n. Floating n => MFS n -> n
beta MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
3 n -> n -> n
forall a. Num a => a -> a -> a
* n
g n -> n -> n
forall a. Fractional a => a -> a -> a
/ (MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s n -> n -> n
forall a. Floating a => a -> a -> a
**n
2) n -> n -> n
forall a. Num a => a -> a -> a
+ n
3 n -> n -> n
forall a. Num a => a -> a -> a
- MFS n -> n
forall n. Floating n => MFS n -> n
alpha MFS n
s
  r :: n
r = PathDir n -> n
r' (MFS n
sMFS n -> Getting (PathDir n) (MFS n) (PathDir n) -> PathDir n
forall s a. s -> Getting a s a -> a
^.(PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> MFS n -> Const (PathDir n) (MFS n)
forall d1 j1 n d2 j2 (f :: * -> *).
Functor f =>
(PathJoin d1 j1 -> f (PathJoin d2 j2))
-> MetafontSegment d1 j1 n -> f (MetafontSegment d2 j2 n)
pj((PathJoin (Maybe (PathDir n)) (BasicJoin n)
  -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
 -> MFS n -> Const (PathDir n) (MFS n))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
    -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> Getting (PathDir n) (MFS n) (PathDir n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j (f :: * -> *).
Functor f =>
(d -> f d) -> PathJoin d j -> f (PathJoin d j)
d2((Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
 -> PathJoin (Maybe (PathDir n)) (BasicJoin n)
 -> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> ((PathDir n -> Const (PathDir n) (PathDir n))
    -> Maybe (PathDir n) -> Const (PathDir n) (Maybe (PathDir n)))
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> Const (PathDir n) (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (PathDir n) -> PathDir n)
-> (PathDir n -> Const (PathDir n) (PathDir n))
-> Maybe (PathDir n)
-> Const (PathDir n) (Maybe (PathDir n))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Maybe (PathDir n) -> PathDir n
forall a. HasCallStack => Maybe a -> a
fromJust) where
    r' :: PathDir n -> n
r' (PathDirDir Dir n
d) = n -> n
forall n. RealFrac n => n -> n
normalizeTurns n
t where
      t :: n
t = Getting n (Angle n) n -> Angle n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Angle n) n
forall n. Floating n => Iso' (Angle n) n
Iso' (Angle n) n
turn (Angle n -> n) -> Angle n -> n
forall a b. (a -> b) -> a -> b
$ V2 n -> V2 n -> Angle n
forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
v n -> v n -> Angle n
angleBetween (Dir n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Dir n
d)  (MFS n
sMFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2 Point V2 n -> Point V2 n -> Diff (Point V2) n
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
.-. MFS n
sMFS n -> Getting (Point V2 n) (MFS n) (Point V2 n) -> Point V2 n
forall s a. s -> Getting a s a -> a
^.Getting (Point V2 n) (MFS n) (Point V2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)
    r' (PathDirCurl n
_) = n
0

-- | Take a segment whose endpoint directions have been fully
--   determined, and compute the control points to realize it as a
--   cubic Bézier segment.  If the segment already has control points
--   specified, the directions are ignored (they are assumed to
--   match).  If the segment tensions are specified as TensionAtLeast,
--   check whether the minimum tension will lead to an inflection
--   point.  If so, pick the maximum velocity (equivalent to minimum
--   tension) that avoids the inflection point.  Otherwise, calculate
--   the velocity from the tension using 'hobbyF'.  Then calculate the
--   control point positions from the direction and the velocity.
--   Afterwards we can forget the direction information (since the
--   control points are what we really want, and the directions can be
--   recovered by subtracting the control points from the endpoints
--   anyway).
computeControls
  :: RealFloat n => MetafontSegment (Dir n) (BasicJoin n) n
  -> MetafontSegment () (ControlJoin n) n
computeControls :: forall n.
RealFloat n =>
MetafontSegment (Dir n) (BasicJoin n) n
-> MetafontSegment () (ControlJoin n) n
computeControls (MFS P2 n
z0 (PJ Dir n
_ (Right ControlJoin n
cj) Dir n
_) P2 n
z1)
  = P2 n
-> PathJoin () (ControlJoin n)
-> P2 n
-> MetafontSegment () (ControlJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
z0 (() -> ControlJoin n -> () -> PathJoin () (ControlJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ () ControlJoin n
cj ()) P2 n
z1
computeControls (MFS P2 n
z0 (PJ Dir n
w0 (Left (TJ Tension n
a Tension n
b)) Dir n
w1) P2 n
z1)
  = P2 n
-> PathJoin () (ControlJoin n)
-> P2 n
-> MetafontSegment () (ControlJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
z0 (() -> ControlJoin n -> () -> PathJoin () (ControlJoin n)
forall d j. d -> j -> d -> PathJoin d j
PJ () (P2 n -> P2 n -> ControlJoin n
forall n. P2 n -> P2 n -> ControlJoin n
CJ P2 n
u P2 n
v) ()) P2 n
z1
  where
    w0' :: V2 n
w0' = Dir n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Dir n
w0
    w1' :: V2 n
w1' = Dir n -> V2 n
forall (v :: * -> *) n.
(Metric v, Floating n) =>
Direction v n -> v n
fromDirection Dir n
w1
    (P2 n
u,P2 n
v) = P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n)
forall n.
RealFloat n =>
P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n)
ctrlPts P2 n
z0 V2 n
w0' n
va n
vb V2 n
w1' P2 n
z1
    offs :: Diff (Point V2) n
offs  = P2 n
z1 P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0
    theta :: Angle n
theta = V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
w0' V2 n
Diff (Point V2) n
offs
    phi :: Angle n
phi   = V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
Diff (Point V2) n
offs V2 n
w1'
    sinR :: Angle n -> n
sinR  = n -> n
forall a. Floating a => a -> a
sin (n -> n) -> (Angle n -> n) -> Angle n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting n (Angle n) n -> Angle n -> n
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
    boundingTriangleExists :: Bool
boundingTriangleExists = n -> n
forall a. Num a => a -> a
signum (Angle n -> n
sinR Angle n
theta) n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n -> n
forall a. Num a => a -> a
signum (Angle n -> n
sinR Angle n
phi)
                             Bool -> Bool -> Bool
&& n -> n
forall a. Num a => a -> a
signum (Angle n -> n
sinR Angle n
theta) n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n -> n
forall a. Num a => a -> a
signum (Angle n -> n
sinR (Angle n
thetaAngle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^Angle n
phi))
    va :: n
va = case Tension n
a of
              (TensionAmt n
ta) -> Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
theta Angle n
phi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
ta
              (TensionAtLeast n
ta) -> case Bool
boundingTriangleExists of
                  Bool
True -> n -> n -> n
forall a. Ord a => a -> a -> a
min (Angle n -> n
sinR Angle n
phi n -> n -> n
forall a. Fractional a => a -> a -> a
/ Angle n -> n
sinR (Angle n
theta Angle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Angle n
phi))
                              (Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
theta Angle n
phi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
ta)
                  Bool
False -> Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
theta Angle n
phi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
ta
    vb :: n
vb = case Tension n
b of
              (TensionAmt n
tb) -> Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
phi Angle n
theta n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
tb
              (TensionAtLeast n
tb) -> case Bool
boundingTriangleExists of
                  Bool
True -> n -> n -> n
forall a. Ord a => a -> a -> a
min (Angle n -> n
sinR Angle n
theta n -> n -> n
forall a. Fractional a => a -> a -> a
/ Angle n -> n
sinR (Angle n
theta Angle n -> Angle n -> Angle n
forall a. Num a => Angle a -> Angle a -> Angle a
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ Angle n
phi))
                              (Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
phi Angle n
theta n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
tb)
                  Bool
False -> Angle n -> Angle n -> n
forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
phi Angle n
theta n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
tb

-- | Compute the control points for a cubic bezier, given a segment
--   where we know the directions and tensions at both endpoints,
--   i.e. go from
--
--   @z0{w0} .. tension a and b .. {w1}z1@
--
--   to
--
--   @z0 .. controls u and v .. z1@.
--
--   This uses a mysterious, magical formula due to John Hobby.
ctrlPts :: RealFloat n => P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n)
ctrlPts :: forall n.
RealFloat n =>
P2 n -> V2 n -> n -> n -> V2 n -> P2 n -> (P2 n, P2 n)
ctrlPts P2 n
z0 V2 n
w0 n
va n
vb V2 n
w1 P2 n
z1 = (P2 n
u,P2 n
v)
  where
    offs :: Diff (Point V2) n
offs  = P2 n
z1 P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0
    theta :: Angle n
theta = V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
w0 V2 n
Diff (Point V2) n
offs
    phi :: Angle n
phi   = V2 n -> V2 n -> Angle n
forall n. RealFloat n => V2 n -> V2 n -> Angle n
signedAngleBetween V2 n
Diff (Point V2) n
offs V2 n
w1
    u :: P2 n
u     = P2 n
z0 P2 n -> Diff (Point V2) n -> P2 n
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 n
Diff (Point V2) n
offs V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
theta  V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
va)
    v :: P2 n
v     = P2 n
z1 P2 n -> Diff (Point V2) n -> P2 n
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 n
Diff (Point V2) n
offs V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# Angle n -> V2 n -> V2 n
forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate (Angle n -> Angle n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated Angle n
phi) V2 n -> (V2 n -> V2 n) -> V2 n
forall a b. a -> (a -> b) -> b
# n -> V2 n -> V2 n
forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
vb)

-- | Some weird function that computes some sort of scaling factor
--   based on the turning angles between endpoints and direction
--   vectors (again due to Hobby).
hobbyF :: Floating n => Angle n -> Angle n -> n
hobbyF :: forall n. Floating n => Angle n -> Angle n -> n
hobbyF Angle n
theta' Angle n
phi' = let
    theta :: n
theta = Angle n
theta' Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
    phi :: n
phi = Angle n
phi' Angle n -> Getting n (Angle n) n -> n
forall s a. s -> Getting a s a -> a
^. Getting n (Angle n) n
forall n (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p n (f n) -> p (Angle n) (f (Angle n))
rad
    in
     (n
2 n -> n -> n
forall a. Num a => a -> a -> a
+ n -> n
forall a. Floating a => a -> a
sqrt n
2 n -> n -> n
forall a. Num a => a -> a -> a
* (n -> n
forall a. Floating a => a -> a
sin n
theta n -> n -> n
forall a. Num a => a -> a -> a
- n -> n
forall a. Floating a => a -> a
sin n
phi n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
16)n -> n -> n
forall a. Num a => a -> a -> a
*(n -> n
forall a. Floating a => a -> a
sin n
phi n -> n -> n
forall a. Num a => a -> a -> a
- n -> n
forall a. Floating a => a -> a
sin n
theta n -> n -> n
forall a. Fractional a => a -> a -> a
/ n
16)n -> n -> n
forall a. Num a => a -> a -> a
*(n -> n
forall a. Floating a => a -> a
cos n
theta n -> n -> n
forall a. Num a => a -> a -> a
- n -> n
forall a. Floating a => a -> a
cos n
phi))
     n -> n -> n
forall a. Fractional a => a -> a -> a
/
     (n
3 n -> n -> n
forall a. Num a => a -> a -> a
* (n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ (n -> n
forall a. Floating a => a -> a
sqrt n
5 n -> n -> n
forall a. Num a => a -> a -> a
- n
1)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Floating a => a -> a
cos n
theta n -> n -> n
forall a. Num a => a -> a -> a
+ (n
3 n -> n -> n
forall a. Num a => a -> a -> a
- n -> n
forall a. Floating a => a -> a
sqrt n
5)n -> n -> n
forall a. Fractional a => a -> a -> a
/n
2 n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Floating a => a -> a
cos n
phi))

-- | Convert a fully specified MetafontSegment to a Diagrams Segment
importSegment :: Num n => MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
importSegment :: forall n.
Num n =>
MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
importSegment (MFS P2 n
z0 (PJ () (CJ P2 n
u P2 n
v) ()) P2 n
z1) = V2 n -> V2 n -> V2 n -> Segment Closed V2 n
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (P2 n
u P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0) (P2 n
v P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0) (P2 n
z1 P2 n -> P2 n -> Diff (Point V2) n
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
.-. P2 n
z0)

-- | Convert a MetaFont path to a Diagrams Trail, using a Loop or Line as needed
locatedTrail :: (Floating n, Ord n) => MFPath () (ControlJoin n) n -> Located (Trail V2 n)
locatedTrail :: forall n.
(Floating n, Ord n) =>
MFPath () (ControlJoin n) n -> Located (Trail V2 n)
locatedTrail (MFP Bool
False [MetafontSegment () (ControlJoin n) n]
ss)  = (Trail' Line V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Line v n -> Trail v n
wrapLine (Trail' Line V2 n -> Trail V2 n)
-> ([MetafontSegment () (ControlJoin n) n] -> Trail' Line V2 n)
-> [MetafontSegment () (ControlJoin n) n]
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed (V (Trail' Line V2 n)) (N (Trail' Line V2 n))]
-> Trail' Line V2 n
[Segment Closed V2 n] -> Trail' Line V2 n
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments ([Segment Closed V2 n] -> Trail' Line V2 n)
-> ([MetafontSegment () (ControlJoin n) n]
    -> [Segment Closed V2 n])
-> [MetafontSegment () (ControlJoin n) n]
-> Trail' Line V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n)
-> [MetafontSegment () (ControlJoin n) n] -> [Segment Closed V2 n]
forall a b. (a -> b) -> [a] -> [b]
map MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
forall n.
Num n =>
MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
importSegment ([MetafontSegment () (ControlJoin n) n] -> Trail V2 n)
-> [MetafontSegment () (ControlJoin n) n] -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [MetafontSegment () (ControlJoin n) n]
ss)
                                Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` ([MetafontSegment () (ControlJoin n) n]
-> MetafontSegment () (ControlJoin n) n
forall a. HasCallStack => [a] -> a
head [MetafontSegment () (ControlJoin n) n]
ss MetafontSegment () (ControlJoin n) n
-> Getting (P2 n) (MetafontSegment () (ControlJoin n) n) (P2 n)
-> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (MetafontSegment () (ControlJoin n) n) (P2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)
locatedTrail (MFP Bool
True [MetafontSegment () (ControlJoin n) n]
ss)   = (Trail' Loop V2 n -> Trail V2 n
forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop (Trail' Loop V2 n -> Trail V2 n)
-> ([MetafontSegment () (ControlJoin n) n] -> Trail' Loop V2 n)
-> [MetafontSegment () (ControlJoin n) n]
-> Trail V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Segment Closed (V (Trail' Loop V2 n)) (N (Trail' Loop V2 n))]
-> Trail' Loop V2 n
[Segment Closed V2 n] -> Trail' Loop V2 n
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments ([Segment Closed V2 n] -> Trail' Loop V2 n)
-> ([MetafontSegment () (ControlJoin n) n]
    -> [Segment Closed V2 n])
-> [MetafontSegment () (ControlJoin n) n]
-> Trail' Loop V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n)
-> [MetafontSegment () (ControlJoin n) n] -> [Segment Closed V2 n]
forall a b. (a -> b) -> [a] -> [b]
map MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
forall n.
Num n =>
MetafontSegment () (ControlJoin n) n -> Segment Closed V2 n
importSegment ([MetafontSegment () (ControlJoin n) n] -> Trail V2 n)
-> [MetafontSegment () (ControlJoin n) n] -> Trail V2 n
forall a b. (a -> b) -> a -> b
$ [MetafontSegment () (ControlJoin n) n]
ss)
                                Trail V2 n
-> Point (V (Trail V2 n)) (N (Trail V2 n)) -> Located (Trail V2 n)
forall a. a -> Point (V a) (N a) -> Located a
`at` ([MetafontSegment () (ControlJoin n) n]
-> MetafontSegment () (ControlJoin n) n
forall a. HasCallStack => [a] -> a
head [MetafontSegment () (ControlJoin n) n]
ss MetafontSegment () (ControlJoin n) n
-> Getting (P2 n) (MetafontSegment () (ControlJoin n) n) (P2 n)
-> P2 n
forall s a. s -> Getting a s a -> a
^.Getting (P2 n) (MetafontSegment () (ControlJoin n) n) (P2 n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)

-- | Convert a path in combinator syntax to the internal
-- representation used for solving.
mfPathToSegments :: forall n. Num n => MFPathData P n -> MFP n
mfPathToSegments :: forall n. Num n => MFPathData P n -> MFP n
mfPathToSegments = MFPath (Maybe (PathDir n)) (BasicJoin n) n
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall {d} {j} {n}. MFPath d j n -> MFPath d j n
fixCycleSegment (MFPath (Maybe (PathDir n)) (BasicJoin n) n
 -> MFPath (Maybe (PathDir n)) (BasicJoin n) n)
-> (MFPathData P n -> MFPath (Maybe (PathDir n)) (BasicJoin n) n)
-> MFPathData P n
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n)
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall a b. (a, b) -> b
snd ((P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n)
 -> MFPath (Maybe (PathDir n)) (BasicJoin n) n)
-> (MFPathData P n
    -> (P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n))
-> MFPathData P n
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MFPathData P n
-> (P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n)
mfPathToSegments'
  where
    mfPathToSegments' :: MFPathData P n -> (P2 n, MFP n)
    mfPathToSegments' :: MFPathData P n
-> (P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n)
mfPathToSegments' (MFPathEnd P2 n
p0) = (P2 n
p0, Bool
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
False [])
    mfPathToSegments' MFPathData P n
MFPathCycle    = (P2 n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin, Bool
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
True [])
    mfPathToSegments' (MFPathPt P2 n
p0 (MFPathJoin PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
jj MFPathData P n
path)) = (P2 n
p0, Bool
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> MFPath (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
c (P2 n
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
-> P2 n
-> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
p0 PathJoin (Maybe (PathDir n)) (BasicJoin n)
jj' P2 n
p1 MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
-> [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
forall a. a -> [a] -> [a]
: [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss))
      where
        (P2 n
p1, MFP Bool
c [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
ss) = MFPathData P n
-> (P2 n, MFPath (Maybe (PathDir n)) (BasicJoin n) n)
mfPathToSegments' MFPathData P n
path
        jj' :: PathJoin (Maybe (PathDir n)) (BasicJoin n)
jj' = case PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
jjPathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> Getting
     (Maybe (BasicJoin n))
     (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
     (Maybe (BasicJoin n))
-> Maybe (BasicJoin n)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (BasicJoin n))
  (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)))
  (Maybe (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j of
            Maybe (BasicJoin n)
Nothing -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
jj PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall a b. a -> (a -> b) -> b
& (Maybe (BasicJoin n) -> Identity (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j ((Maybe (BasicJoin n) -> Identity (BasicJoin n))
 -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> BasicJoin n
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TensionJoin n -> BasicJoin n
forall a b. a -> Either a b
Left (Tension n -> Tension n -> TensionJoin n
forall n. Tension n -> Tension n -> TensionJoin n
TJ (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1) (n -> Tension n
forall n. n -> Tension n
TensionAmt n
1))
            Just BasicJoin n
bj -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
jj PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
    -> PathJoin (Maybe (PathDir n)) (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall a b. a -> (a -> b) -> b
& (Maybe (BasicJoin n) -> Identity (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n))
forall d j1 j2 (f :: * -> *).
Functor f =>
(j1 -> f j2) -> PathJoin d j1 -> f (PathJoin d j2)
j ((Maybe (BasicJoin n) -> Identity (BasicJoin n))
 -> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
 -> Identity (PathJoin (Maybe (PathDir n)) (BasicJoin n)))
-> BasicJoin n
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (BasicJoin n)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BasicJoin n
bj
    fixCycleSegment :: MFPath d j n -> MFPath d j n
fixCycleSegment (MFP Bool
True [MetafontSegment d j n]
ss) = Bool -> [MetafontSegment d j n] -> MFPath d j n
forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
True ([MetafontSegment d j n]
ss [MetafontSegment d j n]
-> ([MetafontSegment d j n] -> [MetafontSegment d j n])
-> [MetafontSegment d j n]
forall a b. a -> (a -> b) -> b
& (MetafontSegment d j n -> Identity (MetafontSegment d j n))
-> [MetafontSegment d j n] -> Identity [MetafontSegment d j n]
forall s a. Snoc s s a a => Traversal' s a
Traversal' [MetafontSegment d j n] (MetafontSegment d j n)
_last((MetafontSegment d j n -> Identity (MetafontSegment d j n))
 -> [MetafontSegment d j n] -> Identity [MetafontSegment d j n])
-> ((P2 n -> Identity (P2 n))
    -> MetafontSegment d j n -> Identity (MetafontSegment d j n))
-> (P2 n -> Identity (P2 n))
-> [MetafontSegment d j n]
-> Identity [MetafontSegment d j n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(P2 n -> Identity (P2 n))
-> MetafontSegment d j n -> Identity (MetafontSegment d j n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x2 ((P2 n -> Identity (P2 n))
 -> [MetafontSegment d j n] -> Identity [MetafontSegment d j n])
-> P2 n -> [MetafontSegment d j n] -> [MetafontSegment d j n]
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [MetafontSegment d j n]
ss[MetafontSegment d j n]
-> Getting (Endo (P2 n)) [MetafontSegment d j n] (P2 n) -> P2 n
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?!(MetafontSegment d j n
 -> Const (Endo (P2 n)) (MetafontSegment d j n))
-> [MetafontSegment d j n]
-> Const (Endo (P2 n)) [MetafontSegment d j n]
forall s a. Cons s s a a => Traversal' s a
Traversal' [MetafontSegment d j n] (MetafontSegment d j n)
_head((MetafontSegment d j n
  -> Const (Endo (P2 n)) (MetafontSegment d j n))
 -> [MetafontSegment d j n]
 -> Const (Endo (P2 n)) [MetafontSegment d j n])
-> ((P2 n -> Const (Endo (P2 n)) (P2 n))
    -> MetafontSegment d j n
    -> Const (Endo (P2 n)) (MetafontSegment d j n))
-> Getting (Endo (P2 n)) [MetafontSegment d j n] (P2 n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(P2 n -> Const (Endo (P2 n)) (P2 n))
-> MetafontSegment d j n
-> Const (Endo (P2 n)) (MetafontSegment d j n)
forall d j n (f :: * -> *).
Functor f =>
(P2 n -> f (P2 n))
-> MetafontSegment d j n -> f (MetafontSegment d j n)
x1)
    fixCycleSegment MFPath d j n
p = MFPath d j n
p