{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Diagrams.TwoD.Path.Metafont.Internal
(
solve, computeControls, locatedTrail
, 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
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
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
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, 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 :: 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
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
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"
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)
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
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 [] = []
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 [] = []
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
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
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
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
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)
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']
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)
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
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 :: 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 :: Floating n => MFS n
-> n
-> n
-> 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 :: 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 :: 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."
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)
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 :: 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
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
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)
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))
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)
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)
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