{-# 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 s = case parse metafontParser "" s of
(Left err) -> Left err
(Right p) -> Right . fromPath $ p
fromStrings :: (TrailLike t, V t ~ V2, N t ~ n, Read n, RealFloat n) => [Text] -> Either [ParseError] [t]
fromStrings ss = case partitionEithers . map fromString $ ss of
([],ts) -> Right ts
(es,_) -> Left es
fromPath :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => MFP n -> t
fromPath = trailLike . locatedTrail . over (segs.mapped) computeControls . solve
flex :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => [P2 n] -> t
flex ps = fromPath . MFP False $ (s0:rest) where
tj = Left (TJ (TensionAmt 1) (TensionAmt 1))
jj = PJ Nothing tj Nothing
s0 = MFS (head ps) jj (head.tail $ ps)
d = Just . PathDirDir . direction $ last ps .-. head ps
seg z1 z2 = MFS z1 (PJ d tj Nothing) z2
rest = zipWith seg (init . tail $ ps) (tail . tail $ ps)
metafont :: (TrailLike t, V t ~ V2, N t ~ n, RealFloat n) => MFPathData P n -> t
metafont = fromPath . mfPathToSegments