{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.TwoD.Path.Metafont
(
module Diagrams.TwoD.Path.Metafont.Combinators
, module Diagrams.TwoD.Path.Metafont
, metafontParser
)
where
import Control.Lens hiding (at, ( # ))
import Data.Either
import Data.Text (Text)
import Text.Parsec (ParseError, parse)
import Diagrams.Prelude hiding (view)
import Diagrams.TwoD.Path.Metafont.Combinators
import Diagrams.TwoD.Path.Metafont.Internal
import Diagrams.TwoD.Path.Metafont.Parser
import Diagrams.TwoD.Path.Metafont.Types
fromString :: (TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) => Text -> Either ParseError t
fromString :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) =>
Text -> Either ParseError t
fromString Text
s = case forall s t a.
Stream s Identity t =>
Parsec s () a -> SourceName -> s -> Either ParseError a
parse forall n.
(Num n, Read n) =>
Parser (MFPath (Maybe (PathDir n)) (BasicJoin n) n)
metafontParser SourceName
"" Text
s of
(Left ParseError
err) -> forall a b. a -> Either a b
Left ParseError
err
(Right MFPath (Maybe (PathDir n)) (BasicJoin n) n
p) -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
MFP n -> t
fromPath forall a b. (a -> b) -> a -> b
$ MFPath (Maybe (PathDir n)) (BasicJoin n) n
p
fromStrings :: (TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) => [Text] -> Either [ParseError] [t]
fromStrings :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) =>
[Text] -> Either [ParseError] [t]
fromStrings [Text]
ss = case forall a b. [Either a b] -> ([a], [b])
partitionEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall t n.
(TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) =>
Text -> Either ParseError t
fromString forall a b. (a -> b) -> a -> b
$ [Text]
ss of
([],[t]
ts) -> forall a b. b -> Either a b
Right [t]
ts
([ParseError]
es,[t]
_) -> forall a b. a -> Either a b
Left [ParseError]
es
fromPath :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => MFP n -> t
fromPath :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
MFP n -> t
fromPath = forall t. TrailLike t => Located (Trail (V t) (N t)) -> t
trailLike forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
(Floating n, Ord n) =>
MFPath () (ControlJoin n) n -> Located (Trail V2 n)
locatedTrail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (forall d1 j1 n1 d2 j2 n2.
Lens
(MFPath d1 j1 n1)
(MFPath d2 j2 n2)
[MetafontSegment d1 j1 n1]
[MetafontSegment d2 j2 n2]
segsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped) forall n.
RealFloat n =>
MetafontSegment (Dir n) (BasicJoin n) n
-> MetafontSegment () (ControlJoin n) n
computeControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. RealFloat n => MFP n -> MFPath (Dir n) (BasicJoin n) n
solve
flex :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => [P2 n] -> t
flex :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
[P2 n] -> t
flex [P2 n]
ps = forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
MFP n -> t
fromPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall d j n. Bool -> [MetafontSegment d j n] -> MFPath d j n
MFP Bool
False forall a b. (a -> b) -> a -> b
$ (MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
s0forall a. a -> [a] -> [a]
:[MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
rest) where
tj :: Either (TensionJoin n) b
tj = forall a b. a -> Either a b
Left (forall n. Tension n -> Tension n -> TensionJoin n
TJ (forall n. n -> Tension n
TensionAmt n
1) (forall n. n -> Tension n
TensionAmt n
1))
jj :: PathJoin (Maybe (PathDir n)) (BasicJoin n)
jj = forall d j. d -> j -> d -> PathJoin d j
PJ forall a. Maybe a
Nothing forall {b}. Either (TensionJoin n) b
tj forall a. Maybe a
Nothing
s0 :: MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
s0 = forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS (forall a. [a] -> a
head [P2 n]
ps) PathJoin (Maybe (PathDir n)) (BasicJoin n)
jj (forall a. [a] -> a
headforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ [P2 n]
ps)
d :: Maybe (PathDir n)
d = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Dir n -> PathDir n
PathDirDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. v n -> Direction v n
direction forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [P2 n]
ps forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. forall a. [a] -> a
head [P2 n]
ps
seg :: P2 n -> P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
seg P2 n
z1 P2 n
z2 = forall d j n. P2 n -> PathJoin d j -> P2 n -> MetafontSegment d j n
MFS P2 n
z1 (forall d j. d -> j -> d -> PathJoin d j
PJ Maybe (PathDir n)
d forall {b}. Either (TensionJoin n) b
tj forall a. Maybe a
Nothing) P2 n
z2
rest :: [MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n]
rest = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith P2 n -> P2 n -> MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
seg (forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ [P2 n]
ps) (forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ [P2 n]
ps)
metafont :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => MFPathData P n -> t
metafont :: forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
MFPathData P n -> t
metafont = forall t n.
(TrailLike t, V t ~ V2, N t ~ n, RealFloat n) =>
MFP n -> t
fromPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Num n => MFPathData P n -> MFP n
mfPathToSegments