module Graphics.Gnuplot.Terminal.PNG (
   T, cons,
   encoding,
   transparent, noTransparent,
   interlace, noInterlace,
   trueColor, noTrueColor,
   fontTiny, fontSmall, fontMedium, fontLarge, fontGiant,
   ) where

import qualified Graphics.Gnuplot.Private.Terminal as Terminal
import qualified Graphics.Gnuplot.Private.Encoding as Encoding
import Data.Maybe (catMaybes, )
import Graphics.Gnuplot.Utility (quote, formatBool, )


data T =
   Cons {
      T -> FilePath
filename_ :: FilePath,
      T -> Maybe T
encoding_ :: Maybe Encoding.T,
      T -> Maybe Bool
transparent_ :: Maybe Bool,
      T -> Maybe Bool
interlace_ :: Maybe Bool,
      T -> Maybe Bool
trueColor_ :: Maybe Bool,
      T -> Maybe FontSize
fontSize_ :: Maybe FontSize
   }

cons :: FilePath -> T
cons :: FilePath -> T
cons FilePath
path =
   Cons :: FilePath
-> Maybe T
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe FontSize
-> T
Cons {
      filename_ :: FilePath
filename_ = FilePath
path,
      encoding_ :: Maybe T
encoding_ = Maybe T
forall a. Maybe a
Nothing,
      transparent_ :: Maybe Bool
transparent_ = Maybe Bool
forall a. Maybe a
Nothing,
      interlace_ :: Maybe Bool
interlace_ = Maybe Bool
forall a. Maybe a
Nothing,
      trueColor_ :: Maybe Bool
trueColor_ = Maybe Bool
forall a. Maybe a
Nothing,
      fontSize_ :: Maybe FontSize
fontSize_ = Maybe FontSize
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}

transparent, noTransparent :: T -> T
transparent :: T -> T
transparent   T
term = T
term{transparent_ :: Maybe Bool
transparent_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True}
noTransparent :: T -> T
noTransparent T
term = T
term{transparent_ :: Maybe Bool
transparent_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}

interlace, noInterlace :: T -> T
interlace :: T -> T
interlace   T
term = T
term{interlace_ :: Maybe Bool
interlace_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True}
noInterlace :: T -> T
noInterlace T
term = T
term{interlace_ :: Maybe Bool
interlace_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}

trueColor, noTrueColor :: T -> T
trueColor :: T -> T
trueColor   T
term = T
term{trueColor_ :: Maybe Bool
trueColor_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True}
noTrueColor :: T -> T
noTrueColor T
term = T
term{trueColor_ :: Maybe Bool
trueColor_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False}



fontTiny, fontSmall, fontMedium, fontLarge, fontGiant :: T -> T
fontTiny :: T -> T
fontTiny   = FontSize -> T -> T
setFontSize FontSize
FontTiny
fontSmall :: T -> T
fontSmall  = FontSize -> T -> T
setFontSize FontSize
FontSmall
fontMedium :: T -> T
fontMedium = FontSize -> T -> T
setFontSize FontSize
FontMedium
fontLarge :: T -> T
fontLarge  = FontSize -> T -> T
setFontSize FontSize
FontLarge
fontGiant :: T -> T
fontGiant  = FontSize -> T -> T
setFontSize FontSize
FontGiant



-- private functions

data FontSize =
   FontTiny | FontSmall | FontMedium | FontLarge | FontGiant

formatFontSize :: FontSize -> String
formatFontSize :: FontSize -> FilePath
formatFontSize FontSize
size =
   case FontSize
size of
      FontSize
FontTiny   -> FilePath
"tiny"
      FontSize
FontSmall  -> FilePath
"small"
      FontSize
FontMedium -> FilePath
"medium"
      FontSize
FontLarge  -> FilePath
"large"
      FontSize
FontGiant  -> FilePath
"giant"

setFontSize :: FontSize -> T -> T
setFontSize :: FontSize -> T -> T
setFontSize FontSize
size T
term =
   T
term{fontSize_ :: Maybe FontSize
fontSize_ = FontSize -> Maybe FontSize
forall a. a -> Maybe a
Just FontSize
size}


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
"png" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
            [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes (
               ((Bool -> FilePath) -> Maybe Bool -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Bool -> FilePath
formatBool FilePath
"transparent") (Maybe Bool -> Maybe FilePath) -> Maybe Bool -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ T -> Maybe Bool
transparent_ T
term) Maybe FilePath -> [Maybe FilePath] -> [Maybe FilePath]
forall a. a -> [a] -> [a]
:
               ((Bool -> FilePath) -> Maybe Bool -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Bool -> FilePath
formatBool FilePath
"interlace") (Maybe Bool -> Maybe FilePath) -> Maybe Bool -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ T -> Maybe Bool
interlace_ T
term) Maybe FilePath -> [Maybe FilePath] -> [Maybe FilePath]
forall a. a -> [a] -> [a]
:
               ((Bool -> FilePath) -> Maybe Bool -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> Bool -> FilePath
formatBool FilePath
"truecolor") (Maybe Bool -> Maybe FilePath) -> Maybe Bool -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ T -> Maybe Bool
trueColor_ T
term) Maybe FilePath -> [Maybe FilePath] -> [Maybe FilePath]
forall a. a -> [a] -> [a]
:
               ((FontSize -> FilePath) -> Maybe FontSize -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FontSize -> FilePath
formatFontSize (Maybe FontSize -> Maybe FilePath)
-> Maybe FontSize -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ T -> Maybe FontSize
fontSize_ T
term) Maybe FilePath -> [Maybe FilePath] -> [Maybe 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
      }