{-# LANGUAGE ViewPatterns #-}
--------------------------------------------------------------------------------
-- |
-- Module      : ArrayFire.Graphics
-- Copyright   : David Johnson (c) 2019-2020
-- License     : BSD 3
-- Maintainer  : David Johnson <djohnson.m@gmail.com>
-- Stability   : Experimental
-- Portability : GHC
--
-- Functions for displaying 'Array' graphically.
--
-- @
-- >>> window <- createWindow 800 600 "New Chart"
-- @
--
--------------------------------------------------------------------------------
module ArrayFire.Graphics where

import Control.Exception
import Foreign.Marshal
import Foreign.Storable
import Foreign.ForeignPtr
import Foreign.C.String

import ArrayFire.Internal.Graphics
import ArrayFire.Exception
import ArrayFire.FFI
import ArrayFire.Internal.Types

-- | Create window
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm)
--
-- >>> window <- createWindow 800 600 "New Chart"
--
createWindow
  :: Int
  -- ^ width
  -> Int
  -- ^ height
  -> String
  -- ^ title
  -> IO Window
  -- ^ 'Window' handle
createWindow :: Int -> Int -> String -> IO Window
createWindow (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
x) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
y) String
str =
  String -> (CString -> IO Window) -> IO Window
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO Window) -> IO Window)
-> (CString -> IO Window) -> IO Window
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
    (Ptr AFWindow -> IO AFErr) -> IO Window
createWindow' (\Ptr AFWindow
p -> Ptr AFWindow -> CInt -> CInt -> CString -> IO AFErr
af_create_window Ptr AFWindow
p CInt
x CInt
y CString
cstr)

-- | Sets 'Window' position
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm)
--
-- >>> window <- createWindow 800 600 "New Chart"
-- >>> setPosition window 800 600
--
setPosition
  :: Window
  -- ^ 'Window' handle
  -> Int
  -- ^ Horizontal start coordinate
  -> Int
  -- ^ Vertical start coordinate
  -> IO ()
setPosition :: Window -> Int -> Int -> IO ()
setPosition Window
w (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CUInt
x) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CUInt
y) =
  Window
w Window -> (AFWindow -> IO AFErr) -> IO ()
`opw` (\AFWindow
p -> AFWindow -> CUInt -> CUInt -> IO AFErr
af_set_position AFWindow
p CUInt
x CUInt
y)

-- | Sets 'Window' title
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm)
--
-- >>> window <- createWindow 800 600 "New Chart"
-- >>> setTitle window "window title"
--
setTitle
  :: Window
  -- ^ 'Window' handle
  -> String
  -- ^ title
  -> IO ()
setTitle :: Window -> String -> IO ()
setTitle Window
w String
str = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstr ->
  Window
w Window -> (AFWindow -> IO AFErr) -> IO ()
`opw` (\AFWindow
p -> AFWindow -> CString -> IO AFErr
af_set_title AFWindow
p CString
cstr)

-- | Sets 'Window' size
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm)
--
-- >>> window <- createWindow 800 600 "New Chart"
-- >>> setSize window 800 600
--
setSize
  :: Window
  -- ^ 'Window' handle
  -> Int
  -- ^ target width of the window
  -> Int
  -- ^ target height of the window
  -> IO ()
setSize :: Window -> Int -> Int -> IO ()
setSize Window
w (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CUInt
x) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CUInt
y) =
  Window
w Window -> (AFWindow -> IO AFErr) -> IO ()
`opw` (\AFWindow
p -> AFWindow -> CUInt -> CUInt -> IO AFErr
af_set_size AFWindow
p CUInt
x CUInt
y)

-- | Draw an image onto a Window
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- >>> drawImage window ('constant' \@'Int' 1) ('Cell' 10 10 "test" 'ColorMapSpectrum')
--
drawImage
  :: Window
  -- ^ 'Window' handle
  -> Array a
  -- ^ Image
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawImage :: forall a. Window -> Array a -> Cell -> IO ()
drawImage (Window ForeignPtr ()
wfptr) (Array ForeignPtr ()
fptr) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
aptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
wfptr ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_image AFWindow
wptr AFWindow
aptr Ptr AFCell
cellPtr

-- | Draw a plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- >>> drawPlot window ('constant' \@'Int' 1) ('constant' \@'Int' 1) ('Cell' 10 10 "test" 'ColorMapSpectrum')
--
-- *Note* X and Y should be vectors.
--
drawPlot
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis data points
  -> Array a
  -- ^ is an 'Array' with the y-axis data points
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawPlot :: forall a. Window -> Array a -> Array a -> Cell -> IO ()
drawPlot (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
      ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_plot AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 Ptr AFCell
cellPtr

-- | Draw a plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- *Note* P should be a 3n x 1 vector or one of a 3xn or nx3 matrices.
--
drawPlot3
  :: Window
  -- ^ the window handle
  -> Array a
  -- ^ is an af_array or matrix with the xyz-values of the points
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawPlot3 :: forall a. Window -> Array a -> Cell -> IO ()
drawPlot3 (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
aptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_plot3 AFWindow
wptr AFWindow
aptr Ptr AFCell
cellPtr

-- | Draw a plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D.
--
drawPlotNd
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' or matrix with the xyz-values of the points
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawPlotNd :: forall a. Window -> Array a -> Cell -> IO ()
drawPlotNd (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
aptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_plot_nd AFWindow
wptr AFWindow
aptr Ptr AFCell
cellPtr

-- | Draw a plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- *Note* X and Y should be vectors.
--
drawPlot2d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis data points
  -> Array a
  -- ^ is an 'Array' with the y-axis data points
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawPlot2d :: forall a. Window -> Array a -> Array a -> Cell -> IO ()
drawPlot2d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
     ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_plot_2d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 Ptr AFCell
cellPtr

-- | Draw a 3D plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- *Note* X, Y and Z should be vectors.
--
drawPlot3d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis data points
  -> Array a
  -- ^ is an 'Array' with the y-axis data points
    -> Array a
  -- ^ is an 'Array' with the z-axis data points
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawPlot3d :: forall a. Window -> Array a -> Array a -> Array a -> Cell -> IO ()
drawPlot3d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
      ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
        ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
          (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
            Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
            AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow -> AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_plot_3d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 Ptr AFCell
cellPtr

-- | Draw a scatter plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm)
--
-- *Note* X and Y should be vectors.
--
drawScatter
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis data points
  -> Array a
  -- ^ is an 'Array' with the y-axis data points
  -> MarkerType
  -- ^ enum specifying which marker to use in the scatter plot
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawScatter :: forall a.
Window -> Array a -> Array a -> MarkerType -> Cell -> IO ()
drawScatter (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (MarkerType -> AFMarkerType
fromMarkerType -> AFMarkerType
m) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
     ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow -> AFWindow -> AFMarkerType -> Ptr AFCell -> IO AFErr
af_draw_scatter AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFMarkerType
m Ptr AFCell
cellPtr

-- | Draw a scatter plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga764410fbdf0cd60c7044c77e36fb2577)
--
-- *Note* X and Y should be vectors.
--
drawScatter3
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an af_array or matrix with the xyz-values of the points
  -> MarkerType
  -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawScatter3 :: forall a. Window -> Array a -> MarkerType -> Cell -> IO ()
drawScatter3 (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (MarkerType -> AFMarkerType
fromMarkerType -> AFMarkerType
m) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> AFMarkerType -> Ptr AFCell -> IO AFErr
af_draw_scatter3 AFWindow
wptr AFWindow
ptr1 AFMarkerType
m Ptr AFCell
cellPtr

-- | Draw a scatter plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga9991b93681e0c18693a5464458781d22)
--
-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D.
--
drawScatterNd
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' or matrix with the xyz-values of the points
  -> MarkerType
  -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawScatterNd :: forall a. Window -> Array a -> MarkerType -> Cell -> IO ()
drawScatterNd (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (MarkerType -> AFMarkerType
fromMarkerType -> AFMarkerType
m) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> AFMarkerType -> Ptr AFCell -> IO AFErr
af_draw_scatter_nd AFWindow
wptr AFWindow
ptr1 AFMarkerType
m Ptr AFCell
cellPtr

-- | Draw a scatter plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga79417722c69883e7a91282b138288010)
--
-- *Note* in must be 2d and of the form [n, order], where order is either 2 or 3. If order is 2, then chart is 2D and if order is 3, then chart is 3D.
--
drawScatter2d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an af_array with the x-axis data points
  -> Array a
  -- ^ is an af_array with the y-axis data points
  -> MarkerType
  -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawScatter2d :: forall a.
Window -> Array a -> Array a -> MarkerType -> Cell -> IO ()
drawScatter2d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (MarkerType -> AFMarkerType
fromMarkerType -> AFMarkerType
m) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow -> AFWindow -> AFMarkerType -> Ptr AFCell -> IO AFErr
af_draw_scatter_2d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFMarkerType
m Ptr AFCell
cellPtr

-- | Draw a scatter plot onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga2b3d0dd690ebcba4c4dbb09cdcaed304)
--
-- *Note* X, Y and Z should be vectors.
--
drawScatter3d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an af_array with the x-axis data points
  -> Array a
  -- ^ is an af_array with the y-axis data points
  -> Array a
  -- ^ is an af_array with the z-axis data points
  -> MarkerType
  -- ^ is an af_marker_type enum specifying which marker to use in the scatter plot
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawScatter3d :: forall a.
Window
-> Array a -> Array a -> Array a -> MarkerType -> Cell -> IO ()
drawScatter3d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3) (MarkerType -> AFMarkerType
fromMarkerType -> AFMarkerType
m) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> AFMarkerType
-> Ptr AFCell
-> IO AFErr
af_draw_scatter_3d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 AFMarkerType
m Ptr AFCell
cellPtr

-- | Draw a Histogram onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaf1648ee35739c86116bfa9c22644dbd7)
--
-- *Note* X should be a vector.
--
drawHistogram
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is the data frequency af_array
  -> Double
  -- ^ is the value of the minimum data point of the array whose histogram(X) is going to be rendered.
  -> Double
  -- ^ is the value of the maximum data point of the array whose histogram(X) is going to be rendered.
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawHistogram :: forall a. Window -> Array a -> Double -> Double -> Cell -> IO ()
drawHistogram (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) Double
minval Double
maxval Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> Double -> Double -> Ptr AFCell -> IO AFErr
af_draw_hist AFWindow
wptr AFWindow
ptr1 Double
minval Double
maxval Ptr AFCell
cellPtr

-- | Draw a Surface onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaaee14e457272b2cd1bd4ed1228370229)
--
-- *Note* X and Y should be vectors. S should be a 2D array
--
drawSurface
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an af_array with the x-axis data points
  -> Array a
  -- ^ is an af_array with the y-axis data points
  -> Array a
  -- ^ is an af_array with the z-axis data points
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
drawSurface :: forall a. Window -> Array a -> Array a -> Array a -> Cell -> IO ()
drawSurface (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow -> AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_surface AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 Ptr AFCell
cellPtr

-- | Draw a Vector Field onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#ga2d31a148578d749be4224e7119b386bc)
--
-- *Note* all the 'Array' inputs should be vectors and the same size
--
drawVectorFieldND
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the points
  -> Array a
  -- ^ is an 'Array' with the directions
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawVectorFieldND :: forall a. Window -> Array a -> Array a -> Cell -> IO ()
drawVectorFieldND (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
     ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
      (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
        Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
        AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> AFWindow -> AFWindow -> Ptr AFCell -> IO AFErr
af_draw_vector_field_nd AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 Ptr AFCell
cellPtr

-- | Draw a Vector Field onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaf2d3be32c1b6a9034a3bb851206b4b5a)
--
-- *Note* all the 'Array' inputs should be vectors and the same size
--
drawVectorField3d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis points
  -> Array a
  -- ^ is an 'Array' with the y-axis points
  -> Array a
  -- ^ is an 'Array' with the z-axis points
  -> Array a
  -- ^ is an 'Array' with the x-axis directions
  -> Array a
  -- ^ is an 'Array' with the y-axis directions
  -> Array a
  -- ^ is an 'Array' with the z-axis directions
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
drawVectorField3d :: forall a.
Window
-> Array a
-> Array a
-> Array a
-> Array a
-> Array a
-> Array a
-> Cell
-> IO ()
drawVectorField3d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3)
  (Array ForeignPtr ()
fptr4) (Array ForeignPtr ()
fptr5) (Array ForeignPtr ()
fptr6) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
      ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
        ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
          ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr4 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr4 ->
            ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr5 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr5 ->
              ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr6 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr6 -> do
                (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
                  Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
                  AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> Ptr AFCell
-> IO AFErr
af_draw_vector_field_3d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 AFWindow
ptr4 AFWindow
ptr5 AFWindow
ptr6 Ptr AFCell
cellPtr

-- | Draw a Vector Field onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__draw.htm#gaa1a667e4d29ab089629acd5296f29a7b)
--
-- *Note* all the 'Array' inputs should be vectors and the same size
--
drawVectorField2d
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ is an 'Array' with the x-axis points
  -> Array a
  -- ^ is the window handle
  -> Array a
  -- ^ is the window handle
  -> Array a
  -- ^ is the window handle
  -> Cell
  -- ^ is the window handle
  -> IO ()
drawVectorField2d :: forall a.
Window -> Array a -> Array a -> Array a -> Array a -> Cell -> IO ()
drawVectorField2d (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3) (Array ForeignPtr ()
fptr4) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
      ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
        ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
          ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr4 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr4 ->
            (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
              Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
              AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> Ptr AFCell
-> IO AFErr
af_draw_vector_field_2d AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 AFWindow
ptr4 Ptr AFCell
cellPtr

-- | Draw a grid onto a 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga37fc7eb00ae11c25e1a60d341663d68d)
--
-- *Note* all the 'Array' inputs should be vectors and the same size
--
grid
  :: Window
  -- ^ is the window handle
  -> Int
  -- ^ is number of rows you want to show in a window
  -> Int
  -- ^ is number of coloumns you want to show in a window
  -> IO ()
grid :: Window -> Int -> Int -> IO ()
grid (Window ForeignPtr ()
w) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
rows) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
cols) =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ())
-> ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> CInt -> CInt -> IO AFErr
af_grid AFWindow
wptr CInt
rows CInt
cols

-- | Setting axes limits for a histogram/plot/surface/vector field.
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga62d2cad30e3aad06c24999fe5ac34598)
--
-- *Note* Set to NULL if the chart is 2D.
--
setAxesLimitsCompute
  :: Window
  -- ^ is the window handle
  -> Array a
  -- ^ the data to compute the limits for x-axis.
  -> Array a
  -- ^ the data to compute the limits for y-axis.
  -> Array a
  -- ^ the data to compute the limits for z-axis.
  -> Bool
  -- ^ is for using the exact min/max values from x, y and z. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same.
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
setAxesLimitsCompute :: forall a.
Window -> Array a -> Array a -> Array a -> Bool -> Cell -> IO ()
setAxesLimitsCompute (Window ForeignPtr ()
w) (Array ForeignPtr ()
fptr1) (Array ForeignPtr ()
fptr2) (Array ForeignPtr ()
fptr3) (Int -> CBool
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CBool) -> (Bool -> Int) -> Bool -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum -> CBool
exact) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr1 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr1 ->
      ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr2 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr2 ->
        ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
fptr3 ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
ptr3 ->
          (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
            Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
            AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> AFWindow
-> AFWindow
-> AFWindow
-> CBool
-> Ptr AFCell
-> IO AFErr
af_set_axes_limits_compute AFWindow
wptr AFWindow
ptr1 AFWindow
ptr2 AFWindow
ptr3 CBool
exact Ptr AFCell
cellPtr

-- | Setting axes limits for a 2D histogram/plot/surface/vector field.
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadadc41caf7d6a9b7ca2e674079971895)
--
setAxesLimits2d
  :: Window
  -- ^ is the window handle
  -> Float
  -- ^ is the minimum on x-axis
  -> Float
  -- ^ is the maximum on x-axis
  -> Float
  -- ^ is the minimum on y-axis
  -> Float
  -- ^ is the maximum on y-axis
  -> Bool
  -- ^ is for using the exact min/max values from x, and y. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same.
  -> Cell
  -- ^ is structure af_cell that has the properties that are used for the current rendering.
  -> IO ()
setAxesLimits2d :: Window -> Float -> Float -> Float -> Float -> Bool -> Cell -> IO ()
setAxesLimits2d (Window ForeignPtr ()
w) Float
xmin Float
xmax Float
ymin Float
ymax (Int -> CBool
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CBool) -> (Bool -> Int) -> Bool -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum -> CBool
exact) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> Float
-> Float
-> Float
-> Float
-> CBool
-> Ptr AFCell
-> IO AFErr
af_set_axes_limits_2d AFWindow
wptr Float
xmin Float
xmax Float
ymin Float
ymax CBool
exact Ptr AFCell
cellPtr

-- | Setting axes limits for a 3D histogram/plot/surface/vector field.
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadcd1bd46b9d6fabc047365ca5dc3f73d)
--
setAxesLimits3d
  :: Window
  -- ^ is the window handle
  -> Float
  -- ^ is the minimum on x-axis
  -> Float
  -- ^ is the maximum on x-axis
  -> Float
  -- ^ is the minimum on y-axis
  -> Float
  -- ^ is the maximum on y-axis
  -> Float
  -- ^ is the minimum on z-axis
  -> Float
  -- ^ is the maximum on z-axis
  -> Bool
  -- ^ is for using the exact min/max values from x, y and z. If exact is false then the most significant digit is rounded up to next power of 2 and the magnitude remains the same.
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
setAxesLimits3d :: Window
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Bool
-> Cell
-> IO ()
setAxesLimits3d (Window ForeignPtr ()
w) Float
xmin Float
xmax Float
ymin Float
ymax Float
zmin Float
zmax (Int -> CBool
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CBool) -> (Bool -> Int) -> Bool -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum -> CBool
exact) Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
      AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> CBool
-> Ptr AFCell
-> IO AFErr
af_set_axes_limits_3d AFWindow
wptr Float
xmin Float
xmax Float
ymin Float
ymax Float
zmin Float
zmax CBool
exact Ptr AFCell
cellPtr


-- | Setting axes titles
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gadcd1bd46b9d6fabc047365ca5dc3f73d)
--
setAxesTitles
  :: Window
  -- ^ is the window handle
  -> String
  -- ^ is the name of the x-axis
  -> String
  -- ^ is the name of the y-axis
  -> String
  -- ^ is the name of the z-axis
  -> Cell
  -- ^ is structure 'Cell' that has the properties that are used for the current rendering.
  -> IO ()
setAxesTitles :: Window -> String -> String -> String -> Cell -> IO ()
setAxesTitles (Window ForeignPtr ()
w) String
x String
y String
z Cell
cell =
  IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   ForeignPtr () -> (AFWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ()
w ((AFWindow -> IO ()) -> IO ()) -> (AFWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AFWindow
wptr ->
    (Ptr AFCell -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr AFCell -> IO ()) -> IO ()) -> (Ptr AFCell -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr AFCell
cellPtr -> do
      String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
x ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
xstr ->
        String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
y ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ystr ->
          String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
z ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
zstr -> do
            Ptr AFCell -> AFCell -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr AFCell
cellPtr (AFCell -> IO ()) -> IO AFCell -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cell -> IO AFCell
cellToAFCell Cell
cell
            AFErr -> IO ()
throwAFError (AFErr -> IO ()) -> IO AFErr -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AFWindow -> CString -> CString -> CString -> Ptr AFCell -> IO AFErr
af_set_axes_titles AFWindow
wptr CString
xstr CString
ystr CString
zstr Ptr AFCell
cellPtr

-- | Displays 'Window'
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga50dae861324dca1cce9f583256f5a654)
--
showWindow
  :: Window
  -- ^ 'Window' handle
   -> IO ()
showWindow :: Window -> IO ()
showWindow = (Window -> (AFWindow -> IO AFErr) -> IO ()
`opw` AFWindow -> IO AFErr
af_show)

-- | Checks if 'Window' is closed
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#ga50dae861324dca1cce9f583256f5a654)
--
isWindowClosed :: Window -> IO Bool
isWindowClosed :: Window -> IO Bool
isWindowClosed Window
w =
  Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (CBool -> Int) -> CBool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBool -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (CBool -> Bool) -> IO CBool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Window
w Window -> (Ptr CBool -> AFWindow -> IO AFErr) -> IO CBool
forall a.
Storable a =>
Window -> (Ptr a -> AFWindow -> IO AFErr) -> IO a
`opw1` Ptr CBool -> AFWindow -> IO AFErr
af_is_window_closed)

-- | Sets 'Window' visibility
--
-- [ArrayFire Docs](http://arrayfire.org/docs/group__gfx__func__window.htm#gad7b63c70d45e101c4d8d500273e310c7)
--
setVisibility
  :: Window
  -- ^ 'Window' handle
  -> Bool
  -- ^ Set to 'True' to display 'Window'
  -> IO ()
setVisibility :: Window -> Bool -> IO ()
setVisibility Window
w (Int -> CBool
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CBool) -> (Bool -> Int) -> Bool -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum -> CBool
b) = Window
w Window -> (AFWindow -> IO AFErr) -> IO ()
`opw` (AFWindow -> CBool -> IO AFErr
`af_set_visibility` CBool
b)