[project @ 2002-10-20 14:29:26 by as49]

[project @ 2002-10-20 14:29:26 by as49]

Documentation fixes.

darcs-hash:20021020142926-d90cf-6d42e96a981050c1083f51973c8362bae0441eeb.gz

--  -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Drawable@
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.2 $ from $Date: 2002/10/20 14:29:26 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Library General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--  Drawing primitives.
--
-- @documentation@ ------------------------------------------------------------
--
-- * This module defines drawing primitives that can operate on
--   @ref data DrawWindow@s, @ref data Pixmap@s and
--   @ref data Bitmap@s.
--
-- @todo@ ---------------------------------------------------------------------
--
-- * if gdk_visuals are implemented, do: get_visual
-- * if gdk_colormaps are implemented, do: set_colormap, get_colormap
-- * text drawing functions
--
module Drawable(
  Drawable,
  DrawableClass,
  castToDrawable,
  drawableGetDepth,
  drawableGetSize,
  drawableGetClipRegion,
  drawableGetVisibleRegion,
  drawPoint,
  drawPoints,
  drawLine,
  drawLines,
  drawSegments,
  drawRectangle,
  drawArc,
  drawPolygon,
  drawDrawable) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import GObject	(makeNewGObject)
import Structs  (Point)
{#import Hierarchy#}
{#import Region#}	(Region, makeNewRegion)

{# context lib="gtk" prefix="gdk" #}

-- methods

-- @method drawableGetDepth@ Get the size of pixels.
--
-- * Returns the number of bits which are use to store information on each
--   pixels in this @ref data Drawable@.
--
drawableGetDepth :: DrawableClass d => d -> IO Int
drawableGetDepth d = liftM fromIntegral $
		     {#call unsafe drawable_get_depth#} (toDrawable d)

-- @method drawableGetSize@ Retrieve the size of the @ref type Drawable@.
--
-- * The result might not be up-to-date if there are still resizing messages
--   to be processed.
--
drawableGetSize :: DrawableClass d => d -> IO (Int, Int)
drawableGetSize d = alloca $ \wPtr -> alloca $ \hPtr -> do
  {#call unsafe drawable_get_size#} (toDrawable d) wPtr hPtr
  (w::{#type gint#}) <- peek wPtr
  (h::{#type gint#}) <- peek hPtr
  return (fromIntegral w, fromIntegral h)

-- @method drawableGetClipRegion@ Determine where not to draw.
--
-- * Computes the region of a drawable that potentially can be written
--   to by drawing primitives. This region will not take into account the
--   clip region for the GC, and may also not take into account other
--   factors such as if the window is obscured by other windows, but no
--   area outside of this region will be affected by drawing primitives.
--
drawableGetClipRegion :: DrawableClass d => d -> IO Region
drawableGetClipRegion d = do
  rPtr <- {#call unsafe drawable_get_clip_region#} (toDrawable d)
  makeNewRegion rPtr

-- @method drawableGetVisibleRegion@ Determine what not to redraw.
--
-- * Computes the region of a drawable that is potentially visible.
-- This does not necessarily take into account if the window is obscured
-- by other windows, but no area outside of this region is visible.
--
drawableGetVisibleRegion :: DrawableClass d => d -> IO Region
drawableGetVisibleRegion d = do
  rPtr <- {#call unsafe drawable_get_visible_region#} (toDrawable d)
  makeNewRegion rPtr

-- @method drawPoint@ Draw a point into a @ref type Drawable@.
--
drawPoint :: DrawableClass d => d -> GC -> Point -> IO ()
drawPoint d gc (x,y) = {#call unsafe draw_point#} (toDrawable d)
  (toGC gc) (fromIntegral x) (fromIntegral y)

-- @method drawPoints@ Draw several points into a @ref type Drawable@.
--
-- * This function is more efficient than calling @ref method drawPoint@ on
--   several points.
--
drawPoints :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawPoints d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_points#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- @method drawLine@ Draw a line into a @ref type Drawable@.
--
-- * The parameters are x1, y1, x2, y2.
--
-- * Drawing several separate lines can be done more efficiently by
--   @ref method drawSegments@.
--
drawLine :: DrawableClass d => d -> GC -> Point -> Point -> IO ()
drawLine d gc (x1,y1) (x2,y2) = {#call unsafe draw_line#} (toDrawable d)
  (toGC gc) (fromIntegral x1) (fromIntegral y1) (fromIntegral x2)
  (fromIntegral x2)

-- @method drawLines@ Draw several lines.
--
-- * The function uses the current line width, dashing and especially the
--   joining specification in the graphics context (in contrast to
--   @ref method drawSegments@.
--
drawLines :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawLines d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_lines#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- @method drawSegments@ Draw several unconnected lines.
--
-- * This method draws several unrelated lines.
--
drawSegments :: DrawableClass d => d -> GC -> [(Point,Point)] -> IO ()
drawSegments d gc pps = withArray (concatMap (\((x1,y1),(x2,y2)) ->
  [fromIntegral x1, fromIntegral y1, fromIntegral x2, fromIntegral y2])
  pps) $ \(aPtr :: Ptr {#type gint#}) ->
    {#call unsafe draw_segments#} (toDrawable d) (toGC gc)
    (castPtr aPtr) (fromIntegral (length pps))

-- @method drawRectangle@ Draw a rectangular object.
--
-- * Draws a rectangular outline or filled rectangle, using the
--   foreground color and other attributes of the @ref type GC@.
--
-- * A rectangle drawn filled is 1 pixel smaller in both dimensions
--   than a rectangle outlined. Calling @ref method drawRectangle@ w gc
--   True 0 0 20 20 results in a filled rectangle 20 pixels wide and 20
--   pixels high. Calling @ref method drawRectangle@ d gc False 0 0 20 20
--   results in an outlined rectangle with corners at (0, 0), (0, 20), (20,
--   20), and (20, 0), which makes it 21 pixels wide and 21 pixels high.
--
drawRectangle :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				       Int -> Int -> IO ()
drawRectangle d gc filled x y width height = {#call unsafe draw_rectangle#}
  (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x)
  (fromIntegral y) (fromIntegral width) (fromIntegral height)

-- @method drawArc@ Draws an arc or a filled 'pie slice'.
--
-- * The arc is defined by the bounding rectangle of the entire
--   ellipse, and the start and end angles of the part of the ellipse to be
--   drawn.
--
-- * The starting angle @ref arg aStart@ is relative to the 3 o'clock
--   position, counter-clockwise, in 1/64ths of a degree. @ref arg aEnd@
--   is measured similarly, but relative to @ref arg aStart@.
--
drawArc :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				 Int -> Int -> Int -> Int -> IO ()
drawArc d gc filled x y width height aStart aEnd =
  {#call unsafe draw_arc#} (toDrawable d) (toGC gc) (fromBool filled)
  (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
  (fromIntegral aStart) (fromIntegral aEnd)

-- @method drawPolygon@ Draws an outlined or filled polygon.
--
-- * The polygon is closed automatically, connecting the last point to
--   the first point if necessary.
--
drawPolygon :: DrawableClass d => d -> GC -> Bool -> [Point] -> IO ()
drawPolygon d gc filled points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr::Ptr {#type gint#}) -> {#call unsafe draw_polygon#} (toDrawable d)
  (toGC gc) (fromBool filled) (castPtr aPtr) (fromIntegral (length points))

-- @method drawDrawable@ Copies another @ref type Drawable@.
--
-- * Copies the (width,height) region of the @ref arg src@ at coordinates
--   (@ref arg xSrc@, @ref arg ySrc@) to coordinates (@ref arg xDest@,
--   @ref arg yDest@) in the @ref arg dest@. The @ref arg width@ and/or
--   @ref arg height@ may be given as -1, in which case the entire source
--   drawable will be copied.
--
-- * Most fields in @ref arg gc@ are not used for this operation, but
--   notably the clip mask or clip region will be honored.  The source and
--   destination drawables must have the same visual and colormap, or
--   errors will result. (On X11, failure to match visual/colormap results
--   in a BadMatch error from the X server.)  A common cause of this
--   problem is an attempt to draw a bitmap to a color drawable. The way to
--   draw a bitmap is to set the bitmap as a clip mask on your
--   @ref type GC@, then use @ref method drawRectangle@ to draw a
--   rectangle clipped to the bitmap.
--
drawDrawable :: (DrawableClass src, DrawableClass dest) =>
		dest -> GC -> src -> Int -> Int -> Int -> Int ->
		Int -> Int -> IO ()
drawDrawable dest gc src xSrc ySrc xDest yDest width height =
  {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc)
  (toDrawable src)
  (fromIntegral xSrc) (fromIntegral ySrc) (fromIntegral xDest)
  (fromIntegral yDest) (fromIntegral width) (fromIntegral height)

--  -*-haskell-*-
--  GIMP Toolkit (GTK) @entry Drawable@
--
--  Author : Axel Simon
--  Created: 22 September 2002
--
--  Version $Revision: 1.1 $ from $Date: 2002/10/06 16:14:07 $
--
--  Copyright (c) 2002 Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Library General Public License for more details.
--
-- @description@ --------------------------------------------------------------
--
--  Drawing primitives.
--
-- @documentation@ ------------------------------------------------------------
--
-- * This module defines drawing primitives that can operate on
--   @ref object DrawWindow@s, @ref object Pixmap@s and
--   @ref object Bitmap@s.
--
-- @todo@ ---------------------------------------------------------------------
--
-- * if gdk_visuals are implemented, do: get_visual
-- * if gdk_colormaps are implemented, do: set_colormap, get_colormap
-- * text drawing functions
--
module Drawable(
  Drawable,
  DrawableClass,
  castToDrawable,
  drawableGetDepth,
  drawableGetSize,
  drawableGetClipRegion,
  drawableGetVisibleRegion,
  drawPoint,
  drawPoints,
  drawLine,
  drawLines,
  drawSegments,
  drawRectangle,
  drawArc,
  drawPolygon,
  drawDrawable) where

import Monad	(liftM)
import Foreign
import UTFCForeign
import GObject	(makeNewGObject)
import Structs  (Point)
{#import Hierarchy#}
{#import Region#}	(Region, makeNewRegion)

{# context lib="gtk" prefix="gdk" #}

-- methods

-- @method drawableGetDepth@ Get the size of pixels.
--
-- * Returns the number of bits which are use to store information on each
--   pixels in this @ref object Drawable@.
--
drawableGetDepth :: DrawableClass d => d -> IO Int
drawableGetDepth d = liftM fromIntegral $
		     {#call unsafe drawable_get_depth#} (toDrawable d)

-- @method drawableGetSize@ Retrieve the size of the @ref type Drawable@.
--
-- * The result might not be up-to-date if there are still resizing messages
--   to be processed.
--
drawableGetSize :: DrawableClass d => d -> IO (Int, Int)
drawableGetSize d = alloca $ \wPtr -> alloca $ \hPtr -> do
  {#call unsafe drawable_get_size#} (toDrawable d) wPtr hPtr
  (w::{#type gint#}) <- peek wPtr
  (h::{#type gint#}) <- peek hPtr
  return (fromIntegral w, fromIntegral h)

-- @method drawableGetClipRegion@ Determine where not to draw.
--
-- * Computes the region of a drawable that potentially can be written
--   to by drawing primitives. This region will not take into account the
--   clip region for the GC, and may also not take into account other
--   factors such as if the window is obscured by other windows, but no
--   area outside of this region will be affected by drawing primitives.
--
drawableGetClipRegion :: DrawableClass d => d -> IO Region
drawableGetClipRegion d = do
  rPtr <- {#call unsafe drawable_get_clip_region#} (toDrawable d)
  makeNewRegion rPtr

-- @method drawableGetVisibleRegion@ Determine what not to redraw.
--
-- * Computes the region of a drawable that is potentially visible.
-- This does not necessarily take into account if the window is obscured
-- by other windows, but no area outside of this region is visible.
--
drawableGetVisibleRegion :: DrawableClass d => d -> IO Region
drawableGetVisibleRegion d = do
  rPtr <- {#call unsafe drawable_get_visible_region#} (toDrawable d)
  makeNewRegion rPtr

-- @method drawPoint@ Draw a point into a @ref type Drawable@.
--
drawPoint :: DrawableClass d => d -> GC -> Point -> IO ()
drawPoint d gc (x,y) = {#call unsafe draw_point#} (toDrawable d)
  (toGC gc) (fromIntegral x) (fromIntegral y)

-- @method drawPoints@ Draw several points into a @ref type Drawable@.
--
-- * This function is more efficient than calling @ref method drawPoint@ on
--   several points.
--
drawPoints :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawPoints d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_points#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- @method drawLine@ Draw a line into a @ref type Drawable@.
--
-- * The parameters are x1, y1, x2, y2.
--
-- * Drawing several separate lines can be done more efficiently by
--   @ref method drawSegments@.
--
drawLine :: DrawableClass d => d -> GC -> Point -> Point -> IO ()
drawLine d gc (x1,y1) (x2,y2) = {#call unsafe draw_line#} (toDrawable d)
  (toGC gc) (fromIntegral x1) (fromIntegral y1) (fromIntegral x2)
  (fromIntegral x2)

-- @method drawLines@ Draw several lines.
--
-- * The function uses the current line width, dashing and especially the
--   joining specification in the graphics context (in contrast to
--   @ref method drawSegments@.
--
drawLines :: DrawableClass d => d -> GC -> [Point] -> IO ()
drawLines d gc points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr :: Ptr {#type gint#}) -> {#call unsafe draw_lines#} (toDrawable d)
    (toGC gc) (castPtr aPtr) (fromIntegral (length points))

-- @method drawSegments@ Draw several unconnected lines.
--
-- * This method draws several unrelated lines.
--
drawSegments :: DrawableClass d => d -> GC -> [(Point,Point)] -> IO ()
drawSegments d gc pps = withArray (concatMap (\((x1,y1),(x2,y2)) ->
  [fromIntegral x1, fromIntegral y1, fromIntegral x2, fromIntegral y2])
  pps) $ \(aPtr :: Ptr {#type gint#}) ->
    {#call unsafe draw_segments#} (toDrawable d) (toGC gc)
    (castPtr aPtr) (fromIntegral (length pps))

-- @method drawRectangle@ Draw a rectangular object.
--
-- * Draws a rectangular outline or filled rectangle, using the
--   foreground color and other attributes of the @ref type GC@.
--
-- * A rectangle drawn filled is 1 pixel smaller in both dimensions
--   than a rectangle outlined. Calling @ref method drawRectangle@ w gc
--   True 0 0 20 20 results in a filled rectangle 20 pixels wide and 20
--   pixels high. Calling @ref method drawRectangle@ d gc False 0 0 20 20
--   results in an outlined rectangle with corners at (0, 0), (0, 20), (20,
--   20), and (20, 0), which makes it 21 pixels wide and 21 pixels high.
--
drawRectangle :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				       Int -> Int -> IO ()
drawRectangle d gc filled x y width height = {#call unsafe draw_rectangle#}
  (toDrawable d) (toGC gc) (fromBool filled) (fromIntegral x)
  (fromIntegral y) (fromIntegral width) (fromIntegral height)

-- @method drawArc@ Draws an arc or a filled 'pie slice'.
--
-- * The arc is defined by the bounding rectangle of the entire
--   ellipse, and the start and end angles of the part of the ellipse to be
--   drawn.
--
-- * The starting angle @ref arg aStart@ is relative to the 3 o'clock
--   position, counter-clockwise, in 1/64ths of a degree. @ref arg aEnd@
--   is measured similarly, but relative to @ref arg aStart@.
--
drawArc :: DrawableClass d => d -> GC -> Bool -> Int -> Int ->
				 Int -> Int -> Int -> Int -> IO ()
drawArc d gc filled x y width height aStart aEnd =
  {#call unsafe draw_arc#} (toDrawable d) (toGC gc) (fromBool filled)
  (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
  (fromIntegral aStart) (fromIntegral aEnd)

-- @method drawPolygon@ Draws an outlined or filled polygon.
--
-- * The polygon is closed automatically, connecting the last point to
--   the first point if necessary.
--
drawPolygon :: DrawableClass d => d -> GC -> Bool -> [Point] -> IO ()
drawPolygon d gc filled points =
  withArray (concatMap (\(x,y) -> [fromIntegral x, fromIntegral y]) points) $
  \(aPtr::Ptr {#type gint#}) -> {#call unsafe draw_polygon#} (toDrawable d)
  (toGC gc) (fromBool filled) (castPtr aPtr) (fromIntegral (length points))

-- @method drawDrawable@ Copies another @ref type Drawable@.
--
-- * Copies the (width,height) region of the @ref arg src@ at coordinates
--   (@ref arg xSrc@, @ref arg ySrc@) to coordinates (@ref arg xDest@, @ref
--   arg yDest@) in the @ref arg dest@. The @ref arg width@ and/or @ref arg
--   height@ may be given as -1, in which case the entire source drawable
--   will be copied.
--
-- * Most fields in @ref arg gc@ are not used for this operation, but
--   notably the clip mask or clip region will be honored.  The source and
--   destination drawables must have the same visual and colormap, or
--   errors will result. (On X11, failure to match visual/colormap results
--   in a BadMatch error from the X server.)  A common cause of this
--   problem is an attempt to draw a bitmap to a color drawable. The way to
--   draw a bitmap is to set the bitmap as a clip mask on your
--   @ref type GC@, then use @ref method drawRectangle@ to draw a
--   rectangle clipped to the bitmap.
--
drawDrawable :: (DrawableClass src, DrawableClass dest) =>
		dest -> GC -> src -> Int -> Int -> Int -> Int ->
		Int -> Int -> IO ()
drawDrawable dest gc src xSrc ySrc xDest yDest width height =
  {#call unsafe draw_drawable#} (toDrawable dest) (toGC gc)
  (toDrawable src)
  (fromIntegral xSrc) (fromIntegral ySrc) (fromIntegral xDest)
  (fromIntegral yDest) (fromIntegral width) (fromIntegral height)


gtksourceview2: typo: can-redo -> can-undo (for sourceBufferCanUndo)

darcs-hash:20090112043017-21862-ca1d5baaa7ad742f2547652f97986bedb4252049.gz

-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceBuffer
--
--  Author : Peter Gavin
--  derived from sourceview bindings by Axel Simon and Duncan Coutts
--
--  Created: 18 December 2008
--
--  Copyright (C) 2003-2008 Peter Gavin, Duncan Coutts, Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.SourceView.SourceBuffer (
  SourceBuffer,
  SourceBufferClass,
  castToSourceBuffer,
  sourceBufferNew,
  sourceBufferNewWithLanguage,
  sourceBufferSetHighlightSyntax,
  sourceBufferGetHighlightSyntax,
  sourceBufferSetLanguage,
  sourceBufferGetLanguage,
  sourceBufferSetHighlightMatchingBrackets,
  sourceBufferGetHighlightMatchingBrackets,
  sourceBufferSetStyleScheme,
  sourceBufferGetStyleScheme,
  sourceBufferSetMaxUndoLevels,
  sourceBufferGetMaxUndoLevels,
  sourceBufferGetCanUndo,
  sourceBufferGetCanRedo,
  sourceBufferUndo,
  sourceBufferRedo,
  sourceBufferBeginNotUndoableAction,
  sourceBufferEndNotUndoableAction,
  sourceBufferCreateSourceMark,
  sourceBufferEnsureHighlight,
  sourceBufferCanRedo,
  sourceBufferCanUndo,
  sourceBufferHighlightMatchingBrackets,
  sourceBufferHighlightSyntax,
  sourceBufferLanguage,
  sourceBufferSourceStyleScheme,
  sourceBufferHighlightUpdated
  ) where

import Control.Monad	(liftM)
import Data.Maybe    (fromMaybe)

import System.Glib.FFI
import System.Glib.GObject              (constructNewGObject,
					 makeNewGObject)
{#import System.Glib.Properties#}
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.SourceView.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.Multiline.Types#}
{#import Graphics.UI.Gtk.Multiline.TextIter#}

import Graphics.UI.Gtk.SourceView.SourceMark

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create a new 'SourceBuffer', possibly
-- taking a 'TextTagTable'.
--
sourceBufferNew :: Maybe TextTagTable -> IO SourceBuffer
sourceBufferNew tt = constructNewGObject mkSourceBuffer $
  {#call unsafe source_buffer_new#}
  (fromMaybe (mkTextTagTable nullForeignPtr) tt)

-- | Create a new 'SourceBuffer'
-- with a 'SourceLanguage'.
--
sourceBufferNewWithLanguage :: SourceLanguage -> IO SourceBuffer
sourceBufferNewWithLanguage lang = constructNewGObject mkSourceBuffer $
  {#call unsafe source_buffer_new_with_language#} lang

-- |
--
sourceBufferSetHighlightSyntax :: SourceBuffer -> Bool -> IO ()
sourceBufferSetHighlightSyntax sb newVal =
  {#call unsafe source_buffer_set_highlight_syntax#} sb (fromBool newVal)

-- |
--
sourceBufferGetHighlightSyntax :: SourceBuffer -> IO Bool
sourceBufferGetHighlightSyntax sb = liftM toBool $
  {#call unsafe source_buffer_get_highlight_syntax#} sb

-- |
--
sourceBufferSetLanguage :: SourceBuffer -> SourceLanguage -> IO ()
sourceBufferSetLanguage sb lang =
  {#call unsafe source_buffer_set_language#} sb lang

-- |
--
sourceBufferGetLanguage :: SourceBuffer -> IO SourceLanguage
sourceBufferGetLanguage sb = makeNewGObject mkSourceLanguage $
  {#call unsafe source_buffer_get_language#} sb

-- |
--
sourceBufferSetHighlightMatchingBrackets :: SourceBuffer -> Bool -> IO ()
sourceBufferSetHighlightMatchingBrackets sb newVal =
  {#call unsafe source_buffer_set_highlight_matching_brackets#} sb (fromBool newVal)

-- |
--
sourceBufferGetHighlightMatchingBrackets :: SourceBuffer -> IO Bool
sourceBufferGetHighlightMatchingBrackets sb = liftM toBool $
  {#call unsafe source_buffer_get_highlight_matching_brackets#} sb

-- |
--
sourceBufferSetStyleScheme :: SourceBuffer -> SourceStyleScheme -> IO ()
sourceBufferSetStyleScheme sb sss =
    {#call unsafe source_buffer_set_style_scheme#} sb sss

-- |
--
sourceBufferGetStyleScheme :: SourceBuffer -> IO SourceStyleScheme
sourceBufferGetStyleScheme sb = makeNewGObject mkSourceStyleScheme $
  {#call unsafe source_buffer_get_style_scheme#} sb

-- |
--
sourceBufferSetMaxUndoLevels :: SourceBuffer -> Int -> IO ()
sourceBufferSetMaxUndoLevels sb newVal =
  {#call unsafe source_buffer_set_max_undo_levels#} sb (fromIntegral newVal)

-- |
--
sourceBufferGetMaxUndoLevels :: SourceBuffer -> IO Int
sourceBufferGetMaxUndoLevels sb = liftM fromIntegral $
  {#call unsafe source_buffer_get_max_undo_levels#} sb

-- |
--
sourceBufferGetCanUndo :: SourceBuffer -> IO Bool
sourceBufferGetCanUndo sb = liftM toBool $
  {#call unsafe source_buffer_can_undo#} sb

-- |
--
sourceBufferGetCanRedo :: SourceBuffer -> IO Bool
sourceBufferGetCanRedo sb = liftM toBool $
  {#call unsafe source_buffer_can_redo#} sb

-- |
--
sourceBufferUndo :: SourceBuffer -> IO ()
sourceBufferUndo sb =
  {#call source_buffer_undo#} sb

-- |
--
sourceBufferRedo :: SourceBuffer -> IO ()
sourceBufferRedo sb =
  {#call source_buffer_redo#} sb

-- |
--
sourceBufferBeginNotUndoableAction :: SourceBuffer -> IO ()
sourceBufferBeginNotUndoableAction sb =
  {#call source_buffer_begin_not_undoable_action#} sb

-- |
--
sourceBufferEndNotUndoableAction :: SourceBuffer -> IO ()
sourceBufferEndNotUndoableAction sb =
  {#call source_buffer_end_not_undoable_action#} sb

-- | Creates a marker in the buffer of the given type.
--
-- *  A marker is
--    semantically very similar to a 'Graphics.UI.Gtk.Multiline.TextMark',
--    except it has a type
--    which is used by the 'SourceView' displaying the buffer to show a
--    pixmap on the left margin, at the line the marker is in.  Because
--    of this, a marker is generally associated to a line and not a
--    character position.  Markers are also accessible through a position
--    or range in the buffer.
--
-- *  Markers are implemented using 'Graphics.UI.Gtk.Multiline.TextMark',
--    so all characteristics
--    and restrictions to marks apply to markers too.  These includes
--    life cycle issues and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkSet'
--    and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkDeleted' signal
--    emissions.
--
-- *  Like a 'Graphics.UI.Gtk.Multiline.TextMark', a 'SourceMarker'
--    can be anonymous if the
--    passed name is @Nothing@.  Also, the buffer owns the markers so you
--    shouldn't unreference it.

sourceBufferCreateSourceMark :: SourceBuffer -- the buffer
                         -> Maybe String -- the name of the mark
                         -> String -- the category of the mark
                         -> TextIter -> IO SourceMark
sourceBufferCreateSourceMark sb name category iter =
  makeNewGObject mkSourceMark $
  maybeWith withCString name       $ \strPtr1 ->
  withCString category $ \strPtr2 ->
  {#call source_buffer_create_source_mark#} sb strPtr1 strPtr2 iter

-- |
--
sourceBufferEnsureHighlight :: SourceBuffer -> TextIter -> TextIter -> IO ()
sourceBufferEnsureHighlight sb start end =
    {#call source_buffer_ensure_highlight#} sb start end

-- |
--
sourceBufferCanRedo :: ReadAttr SourceBuffer Bool
sourceBufferCanRedo = readAttrFromBoolProperty "can-redo"

-- |
--
sourceBufferCanUndo :: ReadAttr SourceBuffer Bool
sourceBufferCanUndo = readAttrFromBoolProperty "can-undo"

-- |
--
sourceBufferHighlightMatchingBrackets :: Attr SourceBuffer Bool
sourceBufferHighlightMatchingBrackets = newAttrFromBoolProperty "highlight-matching-brackets"

-- |
--
sourceBufferHighlightSyntax :: Attr SourceBuffer Bool
sourceBufferHighlightSyntax = newAttrFromBoolProperty "highlight-matching-brackets"

-- |
--
sourceBufferLanguage :: Attr SourceBuffer (Maybe SourceLanguage)
sourceBufferLanguage = newAttrFromMaybeObjectProperty "language" gTypeSourceLanguage

-- |
--
sourceBufferMaxUndoLevels :: Attr SourceBuffer Int
sourceBufferMaxUndoLevels = newAttrFromIntProperty "max-undo-levels"

-- |
--
sourceBufferSourceStyleScheme :: Attr SourceBuffer (Maybe SourceStyleScheme)
sourceBufferSourceStyleScheme = newAttrFromMaybeObjectProperty "style-scheme" gTypeSourceStyleScheme

-- |
--
sourceBufferHighlightUpdated :: Signal SourceBuffer (TextIter -> TextIter -> IO ())
sourceBufferHighlightUpdated = Signal $ connect_BOXED_BOXED__NONE "highlight-updated" mkTextIterCopy mkTextIterCopy

-- -*-haskell-*-
--  GIMP Toolkit (GTK) SourceBuffer
--
--  Author : Peter Gavin
--  derived from sourceview bindings by Axel Simon and Duncan Coutts
--
--  Created: 18 December 2008
--
--  Copyright (C) 2003-2008 Peter Gavin, Duncan Coutts, Axel Simon
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
module Graphics.UI.Gtk.SourceView.SourceBuffer (
  SourceBuffer,
  SourceBufferClass,
  castToSourceBuffer,
  sourceBufferNew,
  sourceBufferNewWithLanguage,
  sourceBufferSetHighlightSyntax,
  sourceBufferGetHighlightSyntax,
  sourceBufferSetLanguage,
  sourceBufferGetLanguage,
  sourceBufferSetHighlightMatchingBrackets,
  sourceBufferGetHighlightMatchingBrackets,
  sourceBufferSetStyleScheme,
  sourceBufferGetStyleScheme,
  sourceBufferSetMaxUndoLevels,
  sourceBufferGetMaxUndoLevels,
  sourceBufferGetCanUndo,
  sourceBufferGetCanRedo,
  sourceBufferUndo,
  sourceBufferRedo,
  sourceBufferBeginNotUndoableAction,
  sourceBufferEndNotUndoableAction,
  sourceBufferCreateSourceMark,
  sourceBufferEnsureHighlight,
  sourceBufferCanRedo,
  sourceBufferCanUndo,
  sourceBufferHighlightMatchingBrackets,
  sourceBufferHighlightSyntax,
  sourceBufferLanguage,
  sourceBufferSourceStyleScheme,
  sourceBufferHighlightUpdated
  ) where

import Control.Monad	(liftM)
import Data.Maybe    (fromMaybe)

import System.Glib.FFI
import System.Glib.GObject              (constructNewGObject,
					 makeNewGObject)
{#import System.Glib.Properties#}
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.SourceView.Types#}
{#import Graphics.UI.Gtk.Signals#}
{#import Graphics.UI.Gtk.Multiline.Types#}
{#import Graphics.UI.Gtk.Multiline.TextIter#}

import Graphics.UI.Gtk.SourceView.SourceMark

{# context lib="gtk" prefix="gtk" #}

-- methods

-- | Create a new 'SourceBuffer', possibly
-- taking a 'TextTagTable'.
--
sourceBufferNew :: Maybe TextTagTable -> IO SourceBuffer
sourceBufferNew tt = constructNewGObject mkSourceBuffer $
  {#call unsafe source_buffer_new#}
  (fromMaybe (mkTextTagTable nullForeignPtr) tt)

-- | Create a new 'SourceBuffer'
-- with a 'SourceLanguage'.
--
sourceBufferNewWithLanguage :: SourceLanguage -> IO SourceBuffer
sourceBufferNewWithLanguage lang = constructNewGObject mkSourceBuffer $
  {#call unsafe source_buffer_new_with_language#} lang

-- |
--
sourceBufferSetHighlightSyntax :: SourceBuffer -> Bool -> IO ()
sourceBufferSetHighlightSyntax sb newVal =
  {#call unsafe source_buffer_set_highlight_syntax#} sb (fromBool newVal)

-- |
--
sourceBufferGetHighlightSyntax :: SourceBuffer -> IO Bool
sourceBufferGetHighlightSyntax sb = liftM toBool $
  {#call unsafe source_buffer_get_highlight_syntax#} sb

-- |
--
sourceBufferSetLanguage :: SourceBuffer -> SourceLanguage -> IO ()
sourceBufferSetLanguage sb lang =
  {#call unsafe source_buffer_set_language#} sb lang

-- |
--
sourceBufferGetLanguage :: SourceBuffer -> IO SourceLanguage
sourceBufferGetLanguage sb = makeNewGObject mkSourceLanguage $
  {#call unsafe source_buffer_get_language#} sb

-- |
--
sourceBufferSetHighlightMatchingBrackets :: SourceBuffer -> Bool -> IO ()
sourceBufferSetHighlightMatchingBrackets sb newVal =
  {#call unsafe source_buffer_set_highlight_matching_brackets#} sb (fromBool newVal)

-- |
--
sourceBufferGetHighlightMatchingBrackets :: SourceBuffer -> IO Bool
sourceBufferGetHighlightMatchingBrackets sb = liftM toBool $
  {#call unsafe source_buffer_get_highlight_matching_brackets#} sb

-- |
--
sourceBufferSetStyleScheme :: SourceBuffer -> SourceStyleScheme -> IO ()
sourceBufferSetStyleScheme sb sss =
    {#call unsafe source_buffer_set_style_scheme#} sb sss

-- |
--
sourceBufferGetStyleScheme :: SourceBuffer -> IO SourceStyleScheme
sourceBufferGetStyleScheme sb = makeNewGObject mkSourceStyleScheme $
  {#call unsafe source_buffer_get_style_scheme#} sb

-- |
--
sourceBufferSetMaxUndoLevels :: SourceBuffer -> Int -> IO ()
sourceBufferSetMaxUndoLevels sb newVal =
  {#call unsafe source_buffer_set_max_undo_levels#} sb (fromIntegral newVal)

-- |
--
sourceBufferGetMaxUndoLevels :: SourceBuffer -> IO Int
sourceBufferGetMaxUndoLevels sb = liftM fromIntegral $
  {#call unsafe source_buffer_get_max_undo_levels#} sb

-- |
--
sourceBufferGetCanUndo :: SourceBuffer -> IO Bool
sourceBufferGetCanUndo sb = liftM toBool $
  {#call unsafe source_buffer_can_undo#} sb

-- |
--
sourceBufferGetCanRedo :: SourceBuffer -> IO Bool
sourceBufferGetCanRedo sb = liftM toBool $
  {#call unsafe source_buffer_can_redo#} sb

-- |
--
sourceBufferUndo :: SourceBuffer -> IO ()
sourceBufferUndo sb =
  {#call source_buffer_undo#} sb

-- |
--
sourceBufferRedo :: SourceBuffer -> IO ()
sourceBufferRedo sb =
  {#call source_buffer_redo#} sb

-- |
--
sourceBufferBeginNotUndoableAction :: SourceBuffer -> IO ()
sourceBufferBeginNotUndoableAction sb =
  {#call source_buffer_begin_not_undoable_action#} sb

-- |
--
sourceBufferEndNotUndoableAction :: SourceBuffer -> IO ()
sourceBufferEndNotUndoableAction sb =
  {#call source_buffer_end_not_undoable_action#} sb

-- | Creates a marker in the buffer of the given type.
--
-- *  A marker is
--    semantically very similar to a 'Graphics.UI.Gtk.Multiline.TextMark',
--    except it has a type
--    which is used by the 'SourceView' displaying the buffer to show a
--    pixmap on the left margin, at the line the marker is in.  Because
--    of this, a marker is generally associated to a line and not a
--    character position.  Markers are also accessible through a position
--    or range in the buffer.
--
-- *  Markers are implemented using 'Graphics.UI.Gtk.Multiline.TextMark',
--    so all characteristics
--    and restrictions to marks apply to markers too.  These includes
--    life cycle issues and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkSet'
--    and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkDeleted' signal
--    emissions.
--
-- *  Like a 'Graphics.UI.Gtk.Multiline.TextMark', a 'SourceMarker'
--    can be anonymous if the
--    passed name is @Nothing@.  Also, the buffer owns the markers so you
--    shouldn't unreference it.

sourceBufferCreateSourceMark :: SourceBuffer -- the buffer
                         -> Maybe String -- the name of the mark
                         -> String -- the category of the mark
                         -> TextIter -> IO SourceMark
sourceBufferCreateSourceMark sb name category iter =
  makeNewGObject mkSourceMark $
  maybeWith withCString name       $ \strPtr1 ->
  withCString category $ \strPtr2 ->
  {#call source_buffer_create_source_mark#} sb strPtr1 strPtr2 iter

-- |
--
sourceBufferEnsureHighlight :: SourceBuffer -> TextIter -> TextIter -> IO ()
sourceBufferEnsureHighlight sb start end =
    {#call source_buffer_ensure_highlight#} sb start end

-- |
--
sourceBufferCanRedo :: ReadAttr SourceBuffer Bool
sourceBufferCanRedo = readAttrFromBoolProperty "can-redo"

-- |
--
sourceBufferCanUndo :: ReadAttr SourceBuffer Bool
sourceBufferCanUndo = readAttrFromBoolProperty "can-redo"

-- |
--
sourceBufferHighlightMatchingBrackets :: Attr SourceBuffer Bool
sourceBufferHighlightMatchingBrackets = newAttrFromBoolProperty "highlight-matching-brackets"

-- |
--
sourceBufferHighlightSyntax :: Attr SourceBuffer Bool
sourceBufferHighlightSyntax = newAttrFromBoolProperty "highlight-matching-brackets"

-- |
--
sourceBufferLanguage :: Attr SourceBuffer (Maybe SourceLanguage)
sourceBufferLanguage = newAttrFromMaybeObjectProperty "language" gTypeSourceLanguage

-- |
--
sourceBufferMaxUndoLevels :: Attr SourceBuffer Int
sourceBufferMaxUndoLevels = newAttrFromIntProperty "max-undo-levels"

-- |
--
sourceBufferSourceStyleScheme :: Attr SourceBuffer (Maybe SourceStyleScheme)
sourceBufferSourceStyleScheme = newAttrFromMaybeObjectProperty "style-scheme" gTypeSourceStyleScheme

-- |
--
sourceBufferHighlightUpdated :: Signal SourceBuffer (TextIter -> TextIter -> IO ())
sourceBufferHighlightUpdated = Signal $ connect_BOXED_BOXED__NONE "highlight-updated" mkTextIterCopy mkTextIterCopy


memory management bindings (1D)

memory management bindings (1D)

Ignore-this: dcf4c03e6463cf774fc87358dbbdc917

darcs-hash:20090719055819-115f9-c64704cc0c31efefa17d0839d8e0c44d6513ea66.gz

{-
 - Haskell bindings to the CUDA library
 -
 - This uses the higher-level "C for CUDA" interface and runtime API, which
 - itself is implemented with the lower-level driver API.
 -}

{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.Runtime
  (
    --
    -- Device management
    --
    chooseDevice,
    getDevice,
    getDeviceCount,
    getDeviceProperties,
    setDevice,
    setDeviceFlags,
    setValidDevices,

    --
    -- Memory management
    --
    malloc, mallocPitch,
    memcpy, memcpyAsync,
    memset,

    --
    -- Stream management
    --
    streamCreate,
    streamDestroy,
    streamQuery,
    streamSynchronize
  ) where

import Foreign.CUDA.Types
import Foreign.CUDA.Utils

import Foreign.CUDA.Internal.C2HS hiding (malloc)

#include <cuda_runtime_api.h>
{#context lib="cudart" prefix="cuda"#}

{# pointer *cudaDeviceProp as ^ foreign -> DeviceProperties nocode #}

--------------------------------------------------------------------------------
-- Device Management
--------------------------------------------------------------------------------

--
-- Select compute device which best matches criteria
--
chooseDevice     :: DeviceProperties -> IO (Either String Int)
chooseDevice dev =  resultIfOk `fmap` cudaChooseDevice dev

{# fun unsafe cudaChooseDevice
    { alloca-      `Int'              peekIntConv* ,
      withDevProp* `DeviceProperties'              } -> `Result' cToEnum #}
    where
        withDevProp = with

--
-- Returns which device is currently being used
--
getDevice :: IO (Either String Int)
getDevice =  resultIfOk `fmap` cudaGetDevice

{# fun unsafe cudaGetDevice
    { alloca- `Int' peekIntConv* } -> `Result' cToEnum #}

--
-- Returns the number of compute-capable devices
--
getDeviceCount :: IO (Either String Int)
getDeviceCount =  resultIfOk `fmap` cudaGetDeviceCount

{# fun unsafe cudaGetDeviceCount
    { alloca- `Int' peekIntConv* } -> `Result' cToEnum #}

--
-- Return information about the selected compute device
--
getDeviceProperties   :: Int -> IO (Either String DeviceProperties)
getDeviceProperties n =  resultIfOk `fmap` cudaGetDeviceProperties n

{# fun unsafe cudaGetDeviceProperties
    { alloca- `DeviceProperties' peek* ,
              `Int'                    } -> `Result' cToEnum #}

--
-- Set device to be used for GPU execution
--
setDevice   :: Int -> IO (Maybe String)
setDevice n =  nothingIfOk `fmap` cudaSetDevice n

{# fun unsafe cudaSetDevice
    { `Int' } -> `Result' cToEnum #}

--
-- Set flags to be used for device executions
--
setDeviceFlags   :: [DeviceFlags] -> IO (Maybe String)
setDeviceFlags f =  nothingIfOk `fmap` cudaSetDeviceFlags (combineBitMasks f)

{# fun unsafe cudaSetDeviceFlags
    { `Int' } -> `Result' cToEnum #}

--
-- Set list of devices for CUDA execution in priority order
--
setValidDevices   :: [Int] -> IO (Maybe String)
setValidDevices l =  nothingIfOk `fmap` cudaSetValidDevices l (length l)

{# fun unsafe cudaSetValidDevices
    { withArrayIntConv* `[Int]' ,
                        `Int'   } -> `Result' cToEnum #}
    where
        withArrayIntConv = withArray . map cIntConv

--------------------------------------------------------------------------------
-- Memory Management
--------------------------------------------------------------------------------

--
-- Allocate the specified number of bytes in linear memory on the device. The
-- memory is suitably aligned for any kind of variable, and is not cleared.
--
-- If the allocation is successful, it is marked to be automatically released
-- when no longer needed.
--
malloc       :: Integer -> IO (Either String DevicePtr)
malloc bytes = do
    (rv,ptr) <- cudaMalloc bytes
    case rv of
        Success -> doAutoRelease cudaFree_ >>= \fp ->
                   newDevicePtr fp ptr >>= (return.Right)
        _       -> return.Left $ getErrorString rv

{# fun unsafe cudaMalloc
    { alloca-  `Ptr ()'  peek* ,
      cIntConv `Integer'       } -> `Result' cToEnum #}

--
-- Allocate pitched memory on the device
--
mallocPitch              :: Integer -> Integer -> IO (Either String (DevicePtr,Integer))
mallocPitch width height =  do
    (rv,ptr,pitch) <- cudaMallocPitch width height
    case rv of
        Success -> doAutoRelease cudaFree_ >>= \fp ->
                   newDevicePtr fp ptr >>= \dp -> return.Right $ (dp,pitch)
        _       -> return.Left $ getErrorString rv

{# fun unsafe cudaMallocPitch
    { alloca-  `Ptr ()' peek*         ,
      alloca-  `Integer' peekIntConv* ,
      cIntConv `Integer'              ,
      cIntConv `Integer'              } -> `Result' cToEnum #}

--
-- Free previously allocated memory on the device
--
cudaFree_   :: Ptr () -> IO ()
cudaFree_ p =  throwIf_ (/= Success) (getErrorString) (cudaFree p)

{# fun unsafe cudaFree
    { id `Ptr ()' } -> `Result' cToEnum #}

foreign import ccall "wrapper"
    doAutoRelease   :: (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))

--
-- Copy data between host and device
--
memcpy :: DevicePtr -> DevicePtr -> Integer -> CopyDirection -> IO (Maybe String)
memcpy dst src bytes dir =  nothingIfOk `fmap` cudaMemcpy dst src bytes dir

{# fun unsafe cudaMemcpy
    { withDevicePtr* `DevicePtr'     ,
      withDevicePtr* `DevicePtr'     ,
      cIntConv       `Integer'       ,
      cFromEnum      `CopyDirection' } -> `Result' cToEnum #}

--
-- Copy data between host and device asynchronously
--
memcpyAsync :: DevicePtr -> DevicePtr -> Integer -> CopyDirection -> Stream -> IO (Maybe String)
memcpyAsync dst src bytes dir stream =  nothingIfOk `fmap` cudaMemcpyAsync dst src bytes dir stream

{# fun unsafe cudaMemcpyAsync
    { withDevicePtr* `DevicePtr'     ,
      withDevicePtr* `DevicePtr'     ,
      cIntConv       `Integer'       ,
      cFromEnum      `CopyDirection' ,
      cIntConv       `Stream'        } -> `Result' cToEnum #}

--
-- Initialize device memory to a given value
--
memset                  :: DevicePtr -> Integer -> Int -> IO (Maybe String)
memset ptr symbol bytes =  nothingIfOk `fmap` cudaMemset ptr bytes symbol

{# fun unsafe cudaMemset
    { withDevicePtr* `DevicePtr' ,
                     `Int'       ,
      cIntConv       `Integer'   } -> `Result' cToEnum #}

--------------------------------------------------------------------------------
-- Stream Management
--------------------------------------------------------------------------------

--
-- Create an asynchronous stream
--
streamCreate :: IO (Either String Stream)
streamCreate =  resultIfOk `fmap` cudaStreamCreate

{# fun unsafe cudaStreamCreate
    { alloca- `Stream' peek* } -> `Result' cToEnum #}

--
-- Destroy and clean up an asynchronous stream
--
streamDestroy   :: Stream -> IO (Maybe String)
streamDestroy s =  nothingIfOk `fmap` cudaStreamDestroy s

{# fun unsafe cudaStreamDestroy
    { cIntConv `Stream' } -> `Result' cToEnum #}

--
-- Determine if all operations in a stream have completed
--
streamQuery   :: Stream -> IO (Either String Bool)
streamQuery s = cudaStreamQuery s >>= \rv -> do
    return $ case rv of
        Success  -> Right True
        NotReady -> Right False
        _        -> Left (getErrorString rv)

{# fun unsafe cudaStreamQuery
    { cIntConv `Stream' } -> `Result' cToEnum #}

--
-- Block until all operations have been completed
--
streamSynchronize   :: Stream -> IO (Maybe String)
streamSynchronize s =  nothingIfOk `fmap` cudaStreamSynchronize s

{# fun unsafe cudaStreamSynchronize
    { cIntConv `Stream' } -> `Result' cToEnum #}

{-
 - Haskell bindings to the CUDA library
 -
 - This uses the higher-level "C for CUDA" interface and runtime API, which
 - itself is implemented with the lower-level driver API.
 -}

{-# LANGUAGE ForeignFunctionInterface #-}

module Foreign.CUDA.Runtime
  (
    --
    -- Device management
    --
    chooseDevice,
    getDevice,
    getDeviceCount,
    getDeviceProperties,
    setDevice,
    setDeviceFlags,
    setValidDevices,

    --
    -- Memory management
    --
    malloc,

    --
    -- Stream management
    --
    streamCreate, streamDestroy, streamQuery, streamSynchronize
  ) where

import Foreign.CUDA.Types
import Foreign.CUDA.Utils

import Foreign.CUDA.Internal.C2HS hiding (malloc)

#include <cuda_runtime_api.h>
{#context lib="cudart" prefix="cuda"#}

{# pointer *cudaDeviceProp as ^ foreign -> DeviceProperties nocode #}

--------------------------------------------------------------------------------
-- Device Management
--------------------------------------------------------------------------------

--
-- Select compute device which best matches criteria
--
chooseDevice     :: DeviceProperties -> IO (Either String Int)
chooseDevice dev =  resultIfOk `fmap` cudaChooseDevice dev

{# fun unsafe cudaChooseDevice
    { alloca-      `Int'              peekIntConv* ,
      withDevProp* `DeviceProperties'              } -> `Result' cToEnum #}
    where
        withDevProp = with

--
-- Returns which device is currently being used
--
getDevice :: IO (Either String Int)
getDevice =  resultIfOk `fmap` cudaGetDevice

{# fun unsafe cudaGetDevice
    { alloca- `Int' peekIntConv* } -> `Result' cToEnum #}

--
-- Returns the number of compute-capable devices
--
getDeviceCount :: IO (Either String Int)
getDeviceCount =  resultIfOk `fmap` cudaGetDeviceCount

{# fun unsafe cudaGetDeviceCount
    { alloca- `Int' peekIntConv* } -> `Result' cToEnum #}

--
-- Return information about the selected compute device
--
getDeviceProperties   :: Int -> IO (Either String DeviceProperties)
getDeviceProperties n =  resultIfOk `fmap` cudaGetDeviceProperties n

{# fun unsafe cudaGetDeviceProperties
    { alloca- `DeviceProperties' peek*,
              `Int'                   } -> `Result' cToEnum #}

--
-- Set device to be used for GPU execution
--
setDevice   :: Int -> IO (Maybe String)
setDevice n =  nothingIfOk `fmap` cudaSetDevice n

{# fun unsafe cudaSetDevice
    { `Int' } -> `Result' cToEnum #}

--
-- Set flags to be used for device executions
--
setDeviceFlags   :: [DeviceFlags] -> IO (Maybe String)
setDeviceFlags f =  nothingIfOk `fmap` cudaSetDeviceFlags (combineBitMasks f)

{# fun unsafe cudaSetDeviceFlags
    { `Int' } -> `Result' cToEnum #}

--
-- Set list of devices for CUDA execution in priority order
--
setValidDevices   :: [Int] -> IO (Maybe String)
setValidDevices l =  nothingIfOk `fmap` cudaSetValidDevices l (length l)

{# fun unsafe cudaSetValidDevices
    { withArrayIntConv* `[Int]' ,
                        `Int'   } -> `Result' cToEnum #}
    where
        withArrayIntConv = withArray . map cIntConv

--------------------------------------------------------------------------------
-- Memory Management
--------------------------------------------------------------------------------

--
-- Allocate the specified number of bytes in linear memory on the device. The
-- memory is suitably aligned for any kind of variable, and is not cleared.
--
-- If the allocation is successful, it is marked to be automatically released
-- when no longer needed.
--
malloc       :: Integer -> IO (Either String DevicePtr)
malloc bytes = do
    (rv,ptr) <- cudaMalloc bytes
    case rv of
        Success -> doAutoRelease cudaFree_ >>= \fp ->
                   newDevicePtr fp ptr >>= (return.Right)
        _       -> return.Left $ getErrorString rv

{# fun unsafe cudaMalloc
    { alloca-  `Ptr ()'  peek*,
      cIntConv `Integer'      } -> `Result' cToEnum #}

--
-- Free previously allocated memory on the device
--
cudaFree_   :: Ptr () -> IO ()
cudaFree_ p =  throwIf_ (/= Success) (getErrorString) (cudaFree p)

{# fun unsafe cudaFree
    { id `Ptr ()' } -> `Result' cToEnum #}

foreign import ccall "wrapper"
    doAutoRelease   :: (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))

--------------------------------------------------------------------------------
-- Stream Management
--------------------------------------------------------------------------------

--
-- Create an asynchronous stream
--
streamCreate :: IO (Either String Stream)
streamCreate =  resultIfOk `fmap` cudaStreamCreate

{# fun unsafe cudaStreamCreate
    { alloca- `Stream' peek* } -> `Result' cToEnum #}

--
-- Destroy and clean up an asynchronous stream
--
streamDestroy   :: Stream -> IO (Maybe String)
streamDestroy s =  nothingIfOk `fmap` cudaStreamDestroy s

{# fun unsafe cudaStreamDestroy
    { cIntConv `Stream' } -> `Result' cToEnum #}

--
-- Determine if all operations in a stream have completed
--
streamQuery   :: Stream -> IO (Either String Bool)
streamQuery s = cudaStreamQuery s >>= \rv -> do
    return $ case rv of
        Success  -> Right True
        NotReady -> Right False
        _        -> Left (getErrorString rv)

{# fun unsafe cudaStreamQuery
    { cIntConv `Stream' } -> `Result' cToEnum #}

--
-- Block until all operations have been completed
--
streamSynchronize   :: Stream -> IO (Maybe String)
streamSynchronize s =  nothingIfOk `fmap` cudaStreamSynchronize s

{# fun unsafe cudaStreamSynchronize
    { cIntConv `Stream' } -> `Result' cToEnum #}