module Graphics.Gnuplot.Terminal.PostScript (
T, cons,
encoding,
landscape, portrait, eps,
color, monochrome,
font, embedFont,
) where
import qualified Graphics.Gnuplot.Private.Terminal as Terminal
import qualified Graphics.Gnuplot.Private.Encoding as Encoding
import Graphics.Gnuplot.Utility (listFromMaybeWith, quote, )
import Data.Foldable (foldMap, )
data T =
Cons {
T -> FilePath
filename_ :: FilePath,
T -> Maybe T
encoding_ :: Maybe Encoding.T,
T -> Maybe Mode
mode_ :: Maybe Mode,
T -> Maybe Bool
color_ :: Maybe Bool,
T -> [FilePath]
embedFont_ :: [FilePath],
T -> Maybe (FilePath, Int)
font_ :: Maybe (String, Int)
}
cons :: FilePath -> T
cons :: FilePath -> T
cons FilePath
path =
Cons :: FilePath
-> Maybe T
-> Maybe Mode
-> Maybe Bool
-> [FilePath]
-> Maybe (FilePath, Int)
-> T
Cons {
filename_ :: FilePath
filename_ = FilePath
path,
encoding_ :: Maybe T
encoding_ = Maybe T
forall a. Maybe a
Nothing,
mode_ :: Maybe Mode
mode_ = Maybe Mode
forall a. Maybe a
Nothing,
color_ :: Maybe Bool
color_ = Maybe Bool
forall a. Maybe a
Nothing,
embedFont_ :: [FilePath]
embedFont_ = [],
font_ :: Maybe (FilePath, Int)
font_ = Maybe (FilePath, Int)
forall a. Maybe a
Nothing
}
encoding :: Encoding.T -> T -> T
encoding :: T -> T -> T
encoding T
enc T
term = T
term{encoding_ :: Maybe T
encoding_ = T -> Maybe T
forall a. a -> Maybe a
Just T
enc}
landscape :: T -> T
landscape :: T -> T
landscape = Mode -> T -> T
setMode Mode
Landscape
portrait :: T -> T
portrait :: T -> T
portrait = Mode -> T -> T
setMode Mode
Portrait
eps :: T -> T
eps :: T -> T
eps = Mode -> T -> T
setMode Mode
EPS
color :: T -> T
color :: T -> T
color T
term =
T
term{color_ :: Maybe Bool
color_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True}
monochrome :: T -> T
monochrome :: T -> T
monochrome T
term =
T
term{color_ :: Maybe Bool
color_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}
font :: String -> Int -> T -> T
font :: FilePath -> Int -> T -> T
font FilePath
fontName Int
fontSize T
term =
T
term{font_ :: Maybe (FilePath, Int)
font_ = (FilePath, Int) -> Maybe (FilePath, Int)
forall a. a -> Maybe a
Just (FilePath
fontName, Int
fontSize)}
embedFont :: FilePath -> T -> T
embedFont :: FilePath -> T -> T
embedFont FilePath
fontFile T
term =
T
term{embedFont_ :: [FilePath]
embedFont_ = FilePath
fontFile FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: T -> [FilePath]
embedFont_ T
term}
data Mode =
Landscape
| Portrait
| EPS
formatMode :: Mode -> String
formatMode :: Mode -> FilePath
formatMode Mode
mode =
case Mode
mode of
Mode
Landscape -> FilePath
"landscape"
Mode
Portrait -> FilePath
"portrait"
Mode
EPS -> FilePath
"eps"
setMode :: Mode -> T -> T
setMode :: Mode -> T -> T
setMode Mode
mode T
term = T
term{mode_ :: Maybe Mode
mode_ = Mode -> Maybe Mode
forall a. a -> Maybe a
Just Mode
mode}
instance Terminal.C T where
canonical :: T -> T
canonical T
term =
Cons :: [FilePath] -> [FilePath] -> [FilePath] -> Bool -> T
Terminal.Cons {
precommands :: [FilePath]
Terminal.precommands = Maybe T -> [FilePath]
Encoding.formatMaybe (Maybe T -> [FilePath]) -> Maybe T -> [FilePath]
forall a b. (a -> b) -> a -> b
$ T -> Maybe T
encoding_ T
term,
options :: [FilePath]
Terminal.options =
FilePath
"postscript" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
((Mode -> FilePath) -> Maybe Mode -> [FilePath]
forall a b. (a -> b) -> Maybe a -> [b]
listFromMaybeWith Mode -> FilePath
formatMode (Maybe Mode -> [FilePath]) -> Maybe Mode -> [FilePath]
forall a b. (a -> b) -> a -> b
$ T -> Maybe Mode
mode_ T
term) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
((Bool -> FilePath) -> Maybe Bool -> [FilePath]
forall a b. (a -> b) -> Maybe a -> [b]
listFromMaybeWith (\Bool
b -> if Bool
b then FilePath
"color" else FilePath
"monochrome") (Maybe Bool -> [FilePath]) -> Maybe Bool -> [FilePath]
forall a b. (a -> b) -> a -> b
$ T -> Maybe Bool
color_ T
term) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
((FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\FilePath
path -> FilePath
"fontfile" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> FilePath
quote FilePath
path FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: []) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ T -> [FilePath]
embedFont_ T
term) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
(((FilePath, Int) -> [FilePath])
-> Maybe (FilePath, Int) -> [FilePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(FilePath
name,Int
size) -> FilePath
"font" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> FilePath
quote FilePath
name FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show Int
size FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: []) (Maybe (FilePath, Int) -> [FilePath])
-> Maybe (FilePath, Int) -> [FilePath]
forall a b. (a -> b) -> a -> b
$ T -> Maybe (FilePath, Int)
font_ T
term) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
[],
commands :: [FilePath]
Terminal.commands =
[FilePath
"set output " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath
quote (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ T -> FilePath
filename_ T
term)],
interactive :: Bool
Terminal.interactive = Bool
False
}