Buffer.hs

{-|
Module      : Gegl.Buffer
Description : Functions for Buffer manipulation
Copyright   : (c) Amedeo Molnár, 2015-2016
License     : LGPL-3
Maintainer  : nek0@nek0.eu
Stability   : experimental
Portability : POSIX

This module contains all functions necessary for manipulate 'GeglBuffer's.
Contents is roughly comparable to the functions provided by @gegl-buffer.h@ in
gegl-0.3.8.
-}
{-# LANGUAGE RecordWildCards #-}
module GEGL.Buffer
  ( FFI.GeglBuffer(..)
  , gegl_buffer_new
  , gegl_buffer_default_new
  , gegl_buffer_save
  , gegl_buffer_load
  , gegl_buffer_flush
  , gegl_buffer_create_sub_buffer
  , gegl_buffer_get_extent
  , gegl_buffer_set_extent
  -- | Some convenience functions that operate on the basis of
  -- 'gegl_buffer_get_extent'.
  , gegl_buffer_get_x
  , gegl_buffer_get_y
  , gegl_buffer_get_height
  , gegl_buffer_get_width
  , gegl_buffer_get_pixel_count
  -- | Returning to main functions
  , gegl_buffer_set_color
  , gegl_buffer_set_pattern
  -- , gegl_buffer_iterator_new
  , gegl_buffer_clear
  , gegl_buffer_get
  ) where

import qualified GEGL.FFI.Buffer as FFI
import qualified GEGL.FFI.Rectangle as FFI (GeglRectangle(..))
import qualified GEGL.FFI.Color as FFI (GeglColor(..))

import GEGL.Enums (GeglAccessMode, GeglAbyssPolicy)

import BABL.Format (PixelFormat, babl_format)
import BABL.FFI.Format (BablFormatPtr(..))

import System.Glib.GObject (objectUnref)

import Foreign.ForeignPtr
import Foreign.Storable (peek)
import Foreign.C.String
import Foreign.C.Types (CDouble(..), CInt(..))
import Foreign.Ptr (nullPtr, Ptr(..))
import Foreign.Marshal (free)
import Foreign.Marshal.Utils (new)
import Foreign.Marshal.Alloc (malloc)

-- | Create a new 'GeglBuffer'.
gegl_buffer_new
  :: Maybe FFI.GeglRectangle -- ^ Geometry of the buffer. If 'Nothing' is passed
                             -- , the buffer is created empty
  -> BablFormatPtr           -- ^ Pixel format of the buffer
  -> IO FFI.GeglBuffer
gegl_buffer_new mrect (BablFormatPtr format) = do
  ptr <- case mrect of
    Just rect -> new rect
    Nothing   -> return nullPtr
  val <- FFI.GeglBuffer <$>
    (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_new ptr format)
  free ptr
  return val

-- | Creates a new 'GeglBuffer', which defaults to an empty buffer with the 'RGBAfloat' format.
gegl_buffer_default_new :: IO FFI.GeglBuffer
gegl_buffer_default_new = FFI.GeglBuffer <$>
  (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_new nullPtr nullPtr)

-- | Create a new 'GeglBuffer' from a backend. If @Nothing@ is passed as geometry,
--   The extent will be inherited from the backend
gegl_buffer_new_for_backend
  :: Maybe FFI.GeglRectangle -- ^ Geometry
  -> Ptr a                   -- ^ Backend
  -> IO FFI.GeglBuffer       -- ^ New buffer
gegl_buffer_new_for_backend mext backend = do
  rectPtr <- case mext of
    Just ext -> new ext
    Nothing  -> return nullPtr
  buf <- FFI.GeglBuffer <$>
    (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_new_for_backend rectPtr backend)
  free rectPtr
  return buf

-- | Open an existing on-disk 'GeglBuffer'. The buffer is opened in a monitored
--   state so multiple instances of gegl can share the same buffer. Sets on one
--   buffer are reflected in th eother.
gegl_buffer_open
  :: FilePath          -- ^ Path to buffer
  -> IO FFI.GeglBuffer -- ^ The buffer
gegl_buffer_open fp = do
  cfp <- newCString fp
  ret <- FFI.GeglBuffer <$> (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_open cfp)
  free cfp
  return ret

-- | Write a 'GeglBuffer' to a file.
gegl_buffer_save
  :: FFI.GeglBuffer     -- Buffer to save
  -> FilePath           -- Path where to save
  -> FFI.GeglRectangle  -- Region of interest to write
  -> IO ()
gegl_buffer_save (FFI.GeglBuffer fbuf) fp roi = do
  croi <- new roi
  cfp  <- newCString fp
  withForeignPtr fbuf $ \buf ->
    FFI.c_gegl_buffer_save buf cfp croi
  free croi
  free cfp

-- | Load an existing buffer from disk.
gegl_buffer_load
  :: FilePath          -- File path to saved buffer
  -> IO FFI.GeglBuffer -- Resulting buffer
gegl_buffer_load path = do
  cpath <- newCString path
  ret <- FFI.GeglBuffer <$> (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_load cpath)
  free cpath
  return ret

-- | Flush all unsaved data to disk. This is not necessary for shared 'GeglBuffer's
--   opened with "gegl_buffer_open" since they auto-sync on writes.
gegl_buffer_flush
  :: FFI.GeglBuffer -- ^ Buffer to flush
  -> IO ()
gegl_buffer_flush (FFI.GeglBuffer fbuf) =
  withForeignPtr fbuf $ \buf ->
    FFI.c_gegl_buffer_flush buf

-- | Create a new sub 'GeglBuffer', that is a view on a larger buffer.
gegl_buffer_create_sub_buffer
  :: FFI.GeglBuffer    -- ^ Parent buffer
  -> FFI.GeglRectangle -- ^ Coordinates of new buffer
  -> IO FFI.GeglBuffer -- ^ Child buffer
gegl_buffer_create_sub_buffer (FFI.GeglBuffer fbuf) rect = do
  crect <- new rect
  ret <- withForeignPtr fbuf $ \buf -> FFI.GeglBuffer <$>
    (newForeignPtr objectUnref =<< FFI.c_gegl_buffer_create_sub_buffer buf crect)
  free crect
  return ret

-- | Retrieve position and size of the area considered active in a buffer.
gegl_buffer_get_extent
  :: FFI.GeglBuffer       -- ^ The buffer
  -> IO FFI.GeglRectangle -- ^ active area
gegl_buffer_get_extent (FFI.GeglBuffer fbuffer) = do
  rectPtr <- withForeignPtr fbuffer $ \buffer -> FFI.c_gegl_buffer_get_extent buffer
  rect <- peek rectPtr
  -- free rectPtr
  return rect

-- | Change postition and size of the area considered active in a buffer.
gegl_buffer_set_extent
  :: FFI.GeglBuffer    -- ^ The buffer
  -> FFI.GeglRectangle -- ^ New extent of the buffer
  -> IO Bool           -- ^ Returns 'True' on success, otherwise 'False'
gegl_buffer_set_extent (FFI.GeglBuffer fbuffer) rect = do
  ptr <- new rect
  val <- withForeignPtr fbuffer $ \buffer -> FFI.c_gegl_buffer_set_extent buffer ptr
  free ptr
  return val

-- | get X coordinate of the upper left corner of a buffer
gegl_buffer_get_x
  :: FFI.GeglBuffer -- ^ The buffer
  -> IO Int
gegl_buffer_get_x buffer = do
  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer
  return rectangleX

-- | get Y coordinate of the upper left corner of a buffer
gegl_buffer_get_y
  :: FFI.GeglBuffer -- ^ The buffer
  -> IO Int
gegl_buffer_get_y buffer = do
  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer
  return rectangleY

-- | get height of a buffer
gegl_buffer_get_height
  :: FFI.GeglBuffer -- ^ The buffer
  -> IO Int
gegl_buffer_get_height buffer = do
  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer
  return rectangleHeight

-- | get width of a buffer
gegl_buffer_get_width
  :: FFI.GeglBuffer -- ^ The buffer
  -> IO Int
gegl_buffer_get_width buffer = do
  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer
  return rectangleWidth

-- | get pixel count of a buffer
gegl_buffer_get_pixel_count
  :: FFI.GeglBuffer -- ^ The buffer
  -> IO Int
gegl_buffer_get_pixel_count buffer = do
  FFI.GeglRectangle{..} <- gegl_buffer_get_extent buffer
  return $ rectangleWidth * rectangleHeight

-- | Sets a region covered by a 'GeglRectangle' to a specified colour.
gegl_buffer_set_color
  :: FFI.GeglBuffer    -- ^ The buffer
  -> FFI.GeglRectangle -- ^ Area of the buffer to fill
  -> FFI.GeglColor     -- ^ The colour to fill with
  -> IO ()
gegl_buffer_set_color (FFI.GeglBuffer fbuffer) rect (FFI.GeglColor color) = do
  rectPtr <- new rect
  withForeignPtr fbuffer $ \buffer ->
    FFI.c_gegl_buffer_set_color buffer rectPtr color
  free rectPtr

-- | Fill a region with a repeating pattern.
gegl_buffer_set_pattern
  :: FFI.GeglBuffer    -- ^ Target buffer
  -> FFI.GeglRectangle -- ^ Area of target buffer to fill
  -> FFI.GeglBuffer    -- ^ A buffer to be repeated as pattern
  -> Double            -- ^ X offset
  -> Double            -- ^ Y offset
  -> IO ()
gegl_buffer_set_pattern
  (FFI.GeglBuffer fbuffer)
  rect
  (FFI.GeglBuffer fpattern)
  xoff
  yoff
  = do
    rectPtr <- new rect
    let (cx, cy) = (CDouble xoff, CDouble yoff)
    withForeignPtr fbuffer $ \buffer ->
      withForeignPtr fpattern $ \pattern ->
        FFI.c_gegl_buffer_set_pattern
          buffer
          rectPtr
          pattern
          cx
          cy
    free rectPtr

-- | Clear a provided rectangular region by setting all associated memory to 0.
gegl_buffer_clear
  :: FFI.GeglBuffer    -- ^ Target buffer
  -> FFI.GeglRectangle -- ^ Area to clear
  -> IO ()
gegl_buffer_clear (FFI.GeglBuffer fbuf) rect = do
  rectPtr <- new rect
  withForeignPtr fbuf $ \buf ->
    FFI.c_gegl_buffer_clear buf rectPtr
  free rectPtr

-- | Fetch a rectangular linear buffer of pixel data from the 'GeglBuffer',
-- convert it if neccessary and push it into a memory location.
gegl_buffer_get
  :: FFI.GeglBuffer          -- ^ Buffer to retrieve data from
  -> Maybe FFI.GeglRectangle -- ^ Coordinates to retrieve data from. If set to
                             -- 'Nothing' the whole buffer is taken.
  -> Double                  -- ^ Sampling scale
  -> Maybe BablFormatPtr     -- ^ Format to convert the data to. If set to 'Nothing'
                             -- no conversion is performed.
  -> Ptr a                   -- The memory destination to write the data to.
  -> Int                     -- Rowstride in bytes or @0@ to compute it
                             -- automatically from format
  -> GeglAbyssPolicy         -- Abyss policy
  -> IO ()
gegl_buffer_get (FFI.GeglBuffer fbuf) mrect scale mformat dest stride ap = do
  rect <- case mrect of
    Just r -> new r
    Nothing -> return nullPtr
  let format = case mformat of
        Just (BablFormatPtr ptr) -> ptr
        Nothing -> nullPtr
  withForeignPtr fbuf $ \buf ->
    FFI.c_gegl_buffer_get
      buf
      rect
      (CDouble scale)
      format
      dest
      (CInt $ fromIntegral stride)
      (CInt $ fromIntegral $ fromEnum ap)
  free rect