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
   }


{- |
Setting the encoding to anything different
from 'Graphics.Gnuplot.Encoding.locale'
makes only sense if you write your gnuplot files manually using this encoding.
-}
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)}

{- |
Embed a font file in the generated PostScript output.
Each call adds a new font file,
there is no way to remove it again.
-}
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}


-- private functions

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
      }