{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
module Diagrams.TwoD.Path.Metafont.Types where
import Control.Lens hiding (( # ))
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
import Diagrams.Direction
import Diagrams.TwoD.Types
data PathJoin d j = PJ { forall d j. PathJoin d j -> d
_d1 :: d, forall d j. PathJoin d j -> j
_j :: j, forall d j. PathJoin d j -> d
_d2 :: d }
deriving (forall a b. a -> PathJoin d b -> PathJoin d a
forall a b. (a -> b) -> PathJoin d a -> PathJoin d b
forall d a b. a -> PathJoin d b -> PathJoin d a
forall d a b. (a -> b) -> PathJoin d a -> PathJoin d b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PathJoin d b -> PathJoin d a
$c<$ :: forall d a b. a -> PathJoin d b -> PathJoin d a
fmap :: forall a b. (a -> b) -> PathJoin d a -> PathJoin d b
$cfmap :: forall d a b. (a -> b) -> PathJoin d a -> PathJoin d b
Functor, Int -> PathJoin d j -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d j. (Show d, Show j) => Int -> PathJoin d j -> ShowS
forall d j. (Show d, Show j) => [PathJoin d j] -> ShowS
forall d j. (Show d, Show j) => PathJoin d j -> String
showList :: [PathJoin d j] -> ShowS
$cshowList :: forall d j. (Show d, Show j) => [PathJoin d j] -> ShowS
show :: PathJoin d j -> String
$cshow :: forall d j. (Show d, Show j) => PathJoin d j -> String
showsPrec :: Int -> PathJoin d j -> ShowS
$cshowsPrec :: forall d j. (Show d, Show j) => Int -> PathJoin d j -> ShowS
Show)
makeLenses ''PathJoin
data PathDir n
= PathDirCurl n
| PathDirDir (Dir n)
deriving Int -> PathDir n -> ShowS
forall n. Show n => Int -> PathDir n -> ShowS
forall n. Show n => [PathDir n] -> ShowS
forall n. Show n => PathDir n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathDir n] -> ShowS
$cshowList :: forall n. Show n => [PathDir n] -> ShowS
show :: PathDir n -> String
$cshow :: forall n. Show n => PathDir n -> String
showsPrec :: Int -> PathDir n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> PathDir n -> ShowS
Show
isCurl :: PathDir n -> Bool
isCurl :: forall n. PathDir n -> Bool
isCurl (PathDirDir Dir n
_) = Bool
False
isCurl (PathDirCurl n
_) = Bool
True
type Curl n = n
type Dir n = Direction V2 n
type BasicJoin n = Either (TensionJoin n) (ControlJoin n)
data Tension n
= TensionAmt n
| TensionAtLeast n
deriving Int -> Tension n -> ShowS
forall n. Show n => Int -> Tension n -> ShowS
forall n. Show n => [Tension n] -> ShowS
forall n. Show n => Tension n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tension n] -> ShowS
$cshowList :: forall n. Show n => [Tension n] -> ShowS
show :: Tension n -> String
$cshow :: forall n. Show n => Tension n -> String
showsPrec :: Int -> Tension n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> Tension n -> ShowS
Show
getTension :: Tension n -> n
getTension :: forall n. Tension n -> n
getTension (TensionAmt n
t) = n
t
getTension (TensionAtLeast n
t) = n
t
data TensionJoin n = TJ { forall n. TensionJoin n -> Tension n
_t1 :: Tension n, forall n. TensionJoin n -> Tension n
_t2 :: Tension n }
deriving Int -> TensionJoin n -> ShowS
forall n. Show n => Int -> TensionJoin n -> ShowS
forall n. Show n => [TensionJoin n] -> ShowS
forall n. Show n => TensionJoin n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TensionJoin n] -> ShowS
$cshowList :: forall n. Show n => [TensionJoin n] -> ShowS
show :: TensionJoin n -> String
$cshow :: forall n. Show n => TensionJoin n -> String
showsPrec :: Int -> TensionJoin n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> TensionJoin n -> ShowS
Show
data ControlJoin n = CJ { forall n. ControlJoin n -> P2 n
_c1 :: P2 n, forall n. ControlJoin n -> P2 n
_c2 :: P2 n}
deriving Int -> ControlJoin n -> ShowS
forall n. Show n => Int -> ControlJoin n -> ShowS
forall n. Show n => [ControlJoin n] -> ShowS
forall n. Show n => ControlJoin n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControlJoin n] -> ShowS
$cshowList :: forall n. Show n => [ControlJoin n] -> ShowS
show :: ControlJoin n -> String
$cshow :: forall n. Show n => ControlJoin n -> String
showsPrec :: Int -> ControlJoin n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> ControlJoin n -> ShowS
Show
makeLenses ''TensionJoin
makeLenses ''ControlJoin
data P
data J
data MFPathData a n where
MFPathCycle:: MFPathData P n
MFPathEnd :: P2 n -> MFPathData P n
MFPathPt :: P2 n -> MFPathData J n -> MFPathData P n
MFPathJoin :: PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n)) -> MFPathData P n -> MFPathData J n
data MetafontSegment d j n = MFS { forall d j n. MetafontSegment d j n -> P2 n
_x1 :: P2 n, forall d j n. MetafontSegment d j n -> PathJoin d j
_pj :: (PathJoin d j ), forall d j n. MetafontSegment d j n -> P2 n
_x2 :: P2 n }
deriving (forall a b. a -> MetafontSegment d j b -> MetafontSegment d j a
forall a b.
(a -> b) -> MetafontSegment d j a -> MetafontSegment d j b
forall d j a b. a -> MetafontSegment d j b -> MetafontSegment d j a
forall d j a b.
(a -> b) -> MetafontSegment d j a -> MetafontSegment d j b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MetafontSegment d j b -> MetafontSegment d j a
$c<$ :: forall d j a b. a -> MetafontSegment d j b -> MetafontSegment d j a
fmap :: forall a b.
(a -> b) -> MetafontSegment d j a -> MetafontSegment d j b
$cfmap :: forall d j a b.
(a -> b) -> MetafontSegment d j a -> MetafontSegment d j b
Functor, Int -> MetafontSegment d j n -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d j n.
(Show n, Show d, Show j) =>
Int -> MetafontSegment d j n -> ShowS
forall d j n.
(Show n, Show d, Show j) =>
[MetafontSegment d j n] -> ShowS
forall d j n.
(Show n, Show d, Show j) =>
MetafontSegment d j n -> String
showList :: [MetafontSegment d j n] -> ShowS
$cshowList :: forall d j n.
(Show n, Show d, Show j) =>
[MetafontSegment d j n] -> ShowS
show :: MetafontSegment d j n -> String
$cshow :: forall d j n.
(Show n, Show d, Show j) =>
MetafontSegment d j n -> String
showsPrec :: Int -> MetafontSegment d j n -> ShowS
$cshowsPrec :: forall d j n.
(Show n, Show d, Show j) =>
Int -> MetafontSegment d j n -> ShowS
Show)
data MFPath d j n = MFP { forall d j n. MFPath d j n -> Bool
_loop :: Bool, forall d j n. MFPath d j n -> [MetafontSegment d j n]
_segs :: [MetafontSegment d j n] }
deriving Int -> MFPath d j n -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall d j n.
(Show n, Show d, Show j) =>
Int -> MFPath d j n -> ShowS
forall d j n. (Show n, Show d, Show j) => [MFPath d j n] -> ShowS
forall d j n. (Show n, Show d, Show j) => MFPath d j n -> String
showList :: [MFPath d j n] -> ShowS
$cshowList :: forall d j n. (Show n, Show d, Show j) => [MFPath d j n] -> ShowS
show :: MFPath d j n -> String
$cshow :: forall d j n. (Show n, Show d, Show j) => MFPath d j n -> String
showsPrec :: Int -> MFPath d j n -> ShowS
$cshowsPrec :: forall d j n.
(Show n, Show d, Show j) =>
Int -> MFPath d j n -> ShowS
Show
type MFP n = MFPath (Maybe (PathDir n)) (BasicJoin n) n
type MFS n = MetafontSegment (Maybe (PathDir n)) (BasicJoin n) n
makeLenses ''MetafontSegment
makeLenses ''MFPath
instance Monoid (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))) where
mempty :: PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
mempty = forall d j. d -> j -> d -> PathJoin d j
PJ forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
l mappend :: PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
`mappend` PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
r = forall d j. d -> j -> d -> PathJoin d j
PJ (forall {a}. Maybe a -> Maybe a -> Maybe a
c (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
lforall s a. s -> Getting a s a -> a
^.forall d j. Lens' (PathJoin d j) d
d1) (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
rforall s a. s -> Getting a s a -> a
^.forall d j. Lens' (PathJoin d j) d
d1)) (forall {a}. Maybe a -> Maybe a -> Maybe a
c (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
lforall s a. s -> Getting a s a -> a
^.forall d j j. Lens (PathJoin d j) (PathJoin d j) j j
j) (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
rforall s a. s -> Getting a s a -> a
^.forall d j j. Lens (PathJoin d j) (PathJoin d j) j j
j)) (forall {a}. Maybe a -> Maybe a -> Maybe a
c (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
lforall s a. s -> Getting a s a -> a
^.forall d j. Lens' (PathJoin d j) d
d2) (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
rforall s a. s -> Getting a s a -> a
^.forall d j. Lens' (PathJoin d j) d
d2))
where
c :: Maybe a -> Maybe a -> Maybe a
c Maybe a
a Maybe a
b = case Maybe a
b of
Maybe a
Nothing -> Maybe a
a
Just a
_ -> Maybe a
b
instance Semigroup (PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))) where
<> :: PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
-> PathJoin (Maybe (PathDir n)) (Maybe (BasicJoin n))
(<>) = forall a. Monoid a => a -> a -> a
mappend