module Graphics.Gnuplot.Plot.ThreeDimensional (
   T,
   cloud,
--   function,
   mesh,
   surface,

   linearScale,
   functionToGraph,
   ) where

import qualified Graphics.Gnuplot.Private.Graph3DType as Type
import qualified Graphics.Gnuplot.Private.Graph3D as Graph
import qualified Graphics.Gnuplot.Private.Plot    as Plot
-- import qualified Graphics.Gnuplot.Value.ColumnSet as Col
import qualified Graphics.Gnuplot.Value.Tuple as Tuple
import qualified Graphics.Gnuplot.Value.Atom  as Atom

import Graphics.Gnuplot.Utility
   (functionToGraph, linearScale, assembleCells, )

import Data.List.HT (outerProduct, )


{- |
Plots can be assembled using 'mappend' or 'mconcat'
or several functions from "Data.Foldable".
-}
type T x y z = Plot.T (Graph.T x y z)


-- * computed plots

cloud ::
   (Atom.C x, Atom.C y, Atom.C z,
    Tuple.C a) =>
   Type.T x y z a -> [a] -> T x y z
cloud :: T x y z a -> [a] -> T x y z
cloud T x y z a
typ [a]
ps =
   String -> [T x y z] -> T x y z
forall graph. String -> [graph] -> T graph
Plot.withUniqueFile
      ([[ShowS]] -> String
assembleCells ((a -> [ShowS]) -> [a] -> [[ShowS]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [ShowS]
forall a. C a => a -> [ShowS]
Tuple.text [a]
ps))
      [T x y z a -> Columns -> T x y z
forall x y z a. T x y z a -> Columns -> T x y z
Graph.deflt T x y z a
typ
         [Int
1 .. case T x y z a -> ColumnCount a
forall a x y z. C a => T x y z a -> ColumnCount a
Type.tupleSize T x y z a
typ of Tuple.ColumnCount Int
n -> Int
n]]

{-
function ::
   (Atom.C x, Atom.C y, Atom.C z) =>
   Type.T (x,y,z) -> [x] -> [y] -> (x -> y -> z) -> T
function xArgs yArgs f =
   cloud (liftM2 (\x y -> (x, y, f x y)) xArgs yArgs)
-}


mesh ::
   (Atom.C x, Atom.C y, Atom.C z,
    Tuple.C x, Tuple.C y, Tuple.C z) =>
   [[(x,y,z)]] -> T x y z
mesh :: [[(x, y, z)]] -> T x y z
mesh [[(x, y, z)]]
pss =
   String -> [T x y z] -> T x y z
forall graph. String -> [graph] -> T graph
Plot.withUniqueFile
      ([[ShowS]] -> String
assembleCells (([(x, y, z)] -> [[ShowS]]) -> [[(x, y, z)]] -> [[ShowS]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[(x, y, z)]
ps -> ((x, y, z) -> [ShowS]) -> [(x, y, z)] -> [[ShowS]]
forall a b. (a -> b) -> [a] -> [b]
map (x, y, z) -> [ShowS]
forall a. C a => a -> [ShowS]
Tuple.text [(x, y, z)]
ps [[ShowS]] -> [[ShowS]] -> [[ShowS]]
forall a. [a] -> [a] -> [a]
++ [[]]) [[(x, y, z)]]
pss))
      [T x y z
forall x y z. T x y z
Graph.pm3d]

surface ::
   (Atom.C x, Atom.C y, Atom.C z,
    Tuple.C x, Tuple.C y, Tuple.C z) =>
   [x] -> [y] -> (x -> y -> z) -> T x y z
surface :: [x] -> [y] -> (x -> y -> z) -> T x y z
surface [x]
xArgs [y]
yArgs x -> y -> z
f =
   [[(x, y, z)]] -> T x y z
forall x y z.
(C x, C y, C z, C x, C y, C z) =>
[[(x, y, z)]] -> T x y z
mesh ((x -> y -> (x, y, z)) -> [x] -> [y] -> [[(x, y, z)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [[c]]
outerProduct (\x
x y
y -> (x
x, y
y, x -> y -> z
f x
x y
y)) [x]
xArgs [y]
yArgs)