module Graphics.Gnuplot.MultiPlot (
   T,
   Part,
   partFromFrame,
   partFromPlot,
   simpleFromFrameArray,
   simpleFromPartArray,
   title,
   ) where

import qualified Graphics.Gnuplot.Private.Frame as Frame
import qualified Graphics.Gnuplot.Private.Plot as Plot

import qualified Graphics.Gnuplot.Private.Display as Display
import qualified Graphics.Gnuplot.Private.Graph as Graph

import Data.Monoid (mconcat, )
import Data.Foldable (foldMap, )

import Data.Array (Array, elems, bounds, )
import Data.Ix (Ix, rangeSize, )

import Graphics.Gnuplot.Utility (quote, )


data T =
   Cons {
      T -> Maybe String
title_ :: Maybe String,
      T -> Int
numRows, T -> Int
numColumns :: Int,
      T -> [Part]
parts :: [Part]
   }

newtype Part = Part {Part -> Script
scriptFromPart :: Display.Script}

{-
We could generalize this to Frame and Plot
but MultiPlot itself cannot be made a part.
Thus the parameter cannot be generalized to
@Display.C gfx => gfx@.
-}
partFromFrame :: Graph.C graph => Frame.T graph -> Part
partFromFrame :: T graph -> Part
partFromFrame =
   Script -> Part
Part (Script -> Part) -> (T graph -> Script) -> T graph -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T graph -> Script
forall gfx. C gfx => gfx -> Script
Display.toScript

partFromPlot :: Graph.C graph => Plot.T graph -> Part
partFromPlot :: T graph -> Part
partFromPlot =
   Script -> Part
Part (Script -> Part) -> (T graph -> Script) -> T graph -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T graph -> Script
forall gfx. C gfx => gfx -> Script
Display.toScript


{-
The @simple@ prefix is for functions
that don't accept custom options.
Options have to be implemented, yet.
-}
simpleFromFrameArray ::
   (Graph.C graph, Ix i, Ix j) =>
   Array (i,j) (Frame.T graph) -> T
simpleFromFrameArray :: Array (i, j) (T graph) -> T
simpleFromFrameArray =
   Array (i, j) Part -> T
forall i j. (Ix i, Ix j) => Array (i, j) Part -> T
simpleFromPartArray (Array (i, j) Part -> T)
-> (Array (i, j) (T graph) -> Array (i, j) Part)
-> Array (i, j) (T graph)
-> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (T graph -> Part) -> Array (i, j) (T graph) -> Array (i, j) Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T graph -> Part
forall graph. C graph => T graph -> Part
partFromFrame

simpleFromPartArray ::
   (Ix i, Ix j) =>
   Array (i,j) Part -> T
simpleFromPartArray :: Array (i, j) Part -> T
simpleFromPartArray Array (i, j) Part
arr =
   let ((i
r0,j
c0), (i
r1,j
c1)) = Array (i, j) Part -> ((i, j), (i, j))
forall i e. Array i e -> (i, i)
bounds Array (i, j) Part
arr
   in  Maybe String -> Int -> Int -> [Part] -> T
Cons Maybe String
forall a. Maybe a
Nothing
          ((i, i) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (i
r0,i
r1))
          ((j, j) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (j
c0,j
c1))
          (Array (i, j) Part -> [Part]
forall i e. Array i e -> [e]
elems Array (i, j) Part
arr)


title :: String -> T -> T
title :: String -> T -> T
title String
str T
mp =
   T
mp {title_ :: Maybe String
title_ = String -> Maybe String
forall a. a -> Maybe a
Just String
str}


instance Display.C T where
   toScript :: T -> Script
toScript T
mp =
      [Script] -> Script
forall a. Monoid a => [a] -> a
mconcat ([Script] -> Script) -> [Script] -> Script
forall a b. (a -> b) -> a -> b
$
      (Body -> Script
Display.pure (Body -> Script) -> Body -> Script
forall a b. (a -> b) -> a -> b
$
         [T] -> [String] -> Body
Display.Body []
            [String
"set multiplot layout " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             Int -> String
forall a. Show a => a -> String
show (T -> Int
numRows T
mp) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (T -> Int
numColumns T
mp) String -> String -> String
forall a. [a] -> [a] -> [a]
++
             (String -> String) -> Maybe String -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((String
" title " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
quote) (T -> Maybe String
title_ T
mp)]) Script -> [Script] -> [Script]
forall a. a -> [a] -> [a]
:
      ((Part -> Script) -> [Part] -> [Script]
forall a b. (a -> b) -> [a] -> [b]
map Part -> Script
scriptFromPart ([Part] -> [Script]) -> [Part] -> [Script]
forall a b. (a -> b) -> a -> b
$ T -> [Part]
parts T
mp) [Script] -> [Script] -> [Script]
forall a. [a] -> [a] -> [a]
++
      (Body -> Script
Display.pure (Body -> Script) -> Body -> Script
forall a b. (a -> b) -> a -> b
$
         [T] -> [String] -> Body
Display.Body [] [String
"unset multiplot"]) Script -> [Script] -> [Script]
forall a. a -> [a] -> [a]
:
      []