module Graphics.Gnuplot.Private.Graph3D where

import qualified Graphics.Gnuplot.Private.FrameOptionSet as OptionSet
import qualified Graphics.Gnuplot.Private.FrameOption as Option
import qualified Graphics.Gnuplot.Private.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.Private.Graph3DType as GraphType
import qualified Graphics.Gnuplot.Private.Graph as Graph
import qualified Graphics.Gnuplot.Value.Atom as Atom
import qualified Data.Map as Map

import Graphics.Gnuplot.Private.Graph2D (Columns, columnToString, )

import Prelude hiding (lines, )


data T x y z =
   Cons {
      T x y z -> Columns
column_   :: Columns,
      T x y z -> Type
type_     :: Type,
      T x y z -> T
lineSpec_ :: LineSpec.T
   }

type Type = String


toString :: T x y z -> String
toString :: T x y z -> Type
toString (Cons Columns
c Type
t T
l) =
   Type
"using " Type -> Type -> Type
forall a. [a] -> [a] -> [a]
++ Columns -> Type
columnToString Columns
c Type -> Type -> Type
forall a. [a] -> [a] -> [a]
++
   Type
" with " Type -> Type -> Type
forall a. [a] -> [a] -> [a]
++ Type
t Type -> Type -> Type
forall a. [a] -> [a] -> [a]
++
   Type
" " Type -> Type -> Type
forall a. [a] -> [a] -> [a]
++ T -> Type
LineSpec.toString T
l


type AxisOption x y z a =
   OptionSet.T (T x y z) -> Atom.OptionSet a

defltOptions :: (Atom.C x, Atom.C y, Atom.C z) => OptionSet.T (T x y z)
defltOptions :: T (T x y z)
defltOptions =
   let mk ::
          Option.T -> Option.T ->
          Atom.OptionSet a ->
          [(Option.T, [String])]
       mk :: T -> T -> OptionSet a -> [(T, [Type])]
mk T
optData T
optFormat OptionSet a
opts =
          (T
optData, OptionSet a -> [Type]
forall a. OptionSet a -> [Type]
Atom.optData OptionSet a
opts) (T, [Type]) -> [(T, [Type])] -> [(T, [Type])]
forall a. a -> [a] -> [a]
:
          (T
optFormat, OptionSet a -> [Type]
forall a. OptionSet a -> [Type]
Atom.optFormat OptionSet a
opts) (T, [Type]) -> [(T, [Type])] -> [(T, [Type])]
forall a. a -> [a] -> [a]
:
          OptionSet a -> [(T, [Type])]
forall a. OptionSet a -> [(T, [Type])]
Atom.optOthers OptionSet a
opts
       result ::
          Atom.OptionSet x ->
          Atom.OptionSet y ->
          Atom.OptionSet z ->
          OptionSet.T (T x y z)
       result :: OptionSet x -> OptionSet y -> OptionSet z -> T (T x y z)
result OptionSet x
optX OptionSet y
optY OptionSet z
optZ =
          Plain -> T (T x y z)
forall graph. Plain -> T graph
OptionSet.Cons (Plain -> T (T x y z)) -> Plain -> T (T x y z)
forall a b. (a -> b) -> a -> b
$
          (Plain -> Plain -> Plain) -> Plain -> Plain -> Plain
forall a b c. (a -> b -> c) -> b -> a -> c
flip Plain -> Plain -> Plain
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Plain
OptionSet.deflt (Plain -> Plain) -> Plain -> Plain
forall a b. (a -> b) -> a -> b
$
          [(T, [Type])] -> Plain
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(T, [Type])] -> Plain) -> [(T, [Type])] -> Plain
forall a b. (a -> b) -> a -> b
$
          T -> T -> OptionSet x -> [(T, [Type])]
forall a. T -> T -> OptionSet a -> [(T, [Type])]
mk T
Option.xData T
Option.xFormat OptionSet x
optX [(T, [Type])] -> [(T, [Type])] -> [(T, [Type])]
forall a. [a] -> [a] -> [a]
++
          T -> T -> OptionSet y -> [(T, [Type])]
forall a. T -> T -> OptionSet a -> [(T, [Type])]
mk T
Option.yData T
Option.yFormat OptionSet y
optY [(T, [Type])] -> [(T, [Type])] -> [(T, [Type])]
forall a. [a] -> [a] -> [a]
++
          T -> T -> OptionSet z -> [(T, [Type])]
forall a. T -> T -> OptionSet a -> [(T, [Type])]
mk T
Option.yData T
Option.yFormat OptionSet z
optZ [(T, [Type])] -> [(T, [Type])] -> [(T, [Type])]
forall a. [a] -> [a] -> [a]
++
          []
   in  OptionSet x -> OptionSet y -> OptionSet z -> T (T x y z)
forall x y z.
OptionSet x -> OptionSet y -> OptionSet z -> T (T x y z)
result OptionSet x
forall a. C a => OptionSet a
Atom.options OptionSet y
forall a. C a => OptionSet a
Atom.options OptionSet z
forall a. C a => OptionSet a
Atom.options


instance (Atom.C x, Atom.C y, Atom.C z) => Graph.C (T x y z) where
   command :: Command (T x y z)
command = Type -> Command (T x y z)
forall graph. Type -> Command graph
Graph.Command Type
"splot"
   toString :: T x y z -> Type
toString = T x y z -> Type
forall x y z. T x y z -> Type
toString
   defltOptions :: T (T x y z)
defltOptions = T (T x y z)
forall x y z. (C x, C y, C z) => T (T x y z)
defltOptions


pm3d :: T x y z
pm3d :: T x y z
pm3d = Columns -> Type -> T -> T x y z
forall x y z. Columns -> Type -> T -> T x y z
Cons (Int
1Int -> Columns -> Columns
forall a. a -> [a] -> [a]
:Int
2Int -> Columns -> Columns
forall a. a -> [a] -> [a]
:Int
3Int -> Columns -> Columns
forall a. a -> [a] -> [a]
:[]) Type
"pm3d" T
LineSpec.deflt

deflt :: GraphType.T x y z a -> Columns -> T x y z
deflt :: T x y z a -> Columns -> T x y z
deflt T x y z a
t Columns
c = Columns -> Type -> T -> T x y z
forall x y z. Columns -> Type -> T -> T x y z
Cons Columns
c (T x y z a -> Type
forall x y z a. T x y z a -> Type
GraphType.toString T x y z a
t) T
LineSpec.deflt

typ :: Type -> T x y z -> T x y z
typ :: Type -> T x y z -> T x y z
typ Type
t T x y z
gr = T x y z
gr{type_ :: Type
type_ = Type
t}

{-
for 3D plots not all line attributes are supported like:
   pointsize
   pointtype

pm3d and impulses allow:
   linestyle
   linewidth
   linecolor
   linetype
   title

FIXME:
Do we need a separate LineSpec3D type or a type parameter for LineSpec?
-}
lineSpec :: LineSpec.T -> T x y z -> T x y z
lineSpec :: T -> T x y z -> T x y z
lineSpec T
ls T x y z
gr = T x y z
gr{lineSpec_ :: T
lineSpec_ = T
ls}