packages feed

OpenVG 0.3.0 → 0.4.0

raw patch · 25 files changed

+1226/−882 lines, 25 filesdep +Tensor

Dependencies added: Tensor

Files

+ Changes view
@@ -0,0 +1,58 @@++version 0.4.0 (13 Dec 2009):+  * LinearGradient type changed to be Vector4 VGfloat.+ +  * RadialGradient changed to (Vector4 VGfloat, VGfloat).++  * Removed Marshal and Unmarshal type classes, marshallBool and +    unmarshalBool moved out of the BasicTypes module.++  * Type change for colorRampStops.++  * Name change - maxStops changed to maxColorRampStops.++  * PathType(..) changed to PathAbsRel(..).++  * Substantial changes to Haddock docs.++  * Error handling in VGU redone - the original code in +    ErrorsInternal was taken wholesale from Sven Panne\'s +    OpenGL binding to help me bootstrap OpenVG binding. +    Regrettably I forgot to replace it or attribute it -+    I've now replaced it. Sincere apologies to Sven Panne.++version 0.3.0 (10 Dec 2009):+  * Changes to use the split OpenGL packages ++  * Added type coercions for the Size data type (these might not be ideal).+++version 0.2.1 (10 Dec 2009):+  * .cabal file upper bounds for OpenGL and GLUT++  * Windows installation instructions updated.+++version 0.2 (07 Jul 2009):+  * Updated to support ShivaVG version 0.2.1++  * ShivaVG 0.2.1 add support for+    - vgHardwareQuery ++  * ShivaVG 0.2.1 stubbed a number of functions that were previously missing+    - vgMask+    - vgChildImage+    - vgGetParent+    - vgColorMatrix+    - vgConvolve+    - vgSeparableConvolve+    - vgGaussianBlur+    - vgLookup+    - vgLookupSingle++    - vguComputeWarpQuadToSquare+    - vguComputeWarpSquareToQuad+    - vguComputeWarpQuadToQuad+ +version 0.1 (02 Feb 2009):+  * Support for ShivaVG version 0.2.0
InstallWindows.txt view
@@ -1,5 +1,3 @@-*** NOT CURRENTLY WORKING ***- These instructions assume you have Haskell and OpenGL with the  split packages working and have MinGW/msys installed and are  comfortable with them.@@ -56,9 +54,9 @@ I dropped the archive into my home directory C:\msys\1.0\home\stephen -> tar xvfz OpenVG-0.2.1.tar.gz+> tar xvfz OpenVG-0.3.X.tar.gz -> cd OpenVG-0.2.1+> cd OpenVG-0.3.X > runhaskell Setup.lhs configure > runhaskell Setup.lhs build > runhaskell Setup.lhs install
− NEWS 
@@ -1,24 +0,0 @@---version 0.2 (07 Jul 2009):-  * Updated to support ShivaVG version 0.2.1-  * ShivaVG 0.2.1 add support for-    - vgHardwareQuery --  * ShivaVG 0.2.1 stubbed a number of functions that were previously missing-    - vgMask-    - vgChildImage-    - vgGetParent-    - vgColorMatrix-    - vgConvolve-    - vgSeparableConvolve-    - vgGaussianBlur-    - vgLookup-    - vgLookupSingle--    - vguComputeWarpQuadToSquare-    - vguComputeWarpSquareToQuad-    - vguComputeWarpQuadToQuad- -version 0.1 (02 Feb 2009):-  * Support for ShivaVG version 0.2.0
OpenVG.cabal view
@@ -1,27 +1,50 @@ name:             OpenVG-version:          0.3.0+version:          0.4.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com> maintainer:       Stephen Tetley <stephen.tetley@gmail.com> homepage:         http://code.google.com/p/copperbox/ category:         Graphics-synopsis:         OpenVG (shivag-0.2.1) binding+synopsis:         OpenVG (ShivaVG-0.2.1) binding description:-  A Haskell binding for the OpenVG vector graphics API version 1.0.1-  specifically the ShivaVG-0.2.1 implementation.+  A Haskell binding for the OpenVG vector graphics API version +  1.0.1, specifically the ShivaVG-0.2.1 implementation.   .-  This version (0.3.0) is NOT compatible with the Haskell Platform -  - it uses the split OpenGL packages (RAW, Tensor, etc.).+  This version (0.4.0) is NOT compatible with the Haskell Platform +  (2009.2.0.2) - it uses the split OpenGL packages (RAW, StateVar, +  etc.).   .-  ** NOT CURRENTLY WORKING ON WINDOWS **+  \*\* WARNING - the module @Graphics.Rendering.OpenVG.VG.Paths@ +  seems flawed in hindsight, as it ammalgamates the OpenVG +  @VGPathSegment@ and @VGPathCommand@ data types into one Haskell +  type. The binding is thus likely to change in the next major +  revision in what is perhaps the worst place. \*\*.   .   Changelog-  0.2.1 to 0.3.0 Changes to use the split OpenGL packages, added type coercions -  in the Size data type (these might not be ideal).+  .+  0.3.0 to 0.4.0 +  .+  * LinearGradient type changed to be Vector4 VGfloat.   . -  0.2 to 0.2.1 .cabal file upper bounds for OpenGL and GLUT, and-  Windows installation instructions updated.+  * RadialGradient changed to (Vector4 VGfloat, VGfloat).+  .+  * Removed Marshal and Unmarshal type classes, marshallBool and +    unmarshalBool moved out of the BasicTypes module.+  .+  * Type change for colorRampStops.+  .+  * Name change - maxStops changed to maxColorRampStops.+  .+  * PathType(..) changed to PathAbsRel(..).+  . +  * Substantial changes to Haddock docs.+  .+  * Error handling in VGU redone - the original code in +    ErrorsInternal was taken wholesale from Sven Panne\'s +    OpenGL binding to help me bootstrap the OpenVG binding. +    Regrettably I forgot to replace it or attribute it -+    I've now replaced it. Sincere apologies to Sven Panne.   build-type:         Simple stability:          experimental@@ -29,15 +52,19 @@  extra-source-files:   InstallWindows.txt,-  NEWS,+  Changes,   README.txt,   examples/TestUtils.hs,   examples/TestVgu.hs  library   hs-source-dirs:     src-  build-depends:      base < 5, OpenGL >= 2.4 && < 2.5, GLUT >= 2.2 && < 2.3,-                      OpenGLRaw >=1.1.0.1 && < 2, StateVar >= 1.0.0.0 && < 2+  build-depends:      base < 5, +                      OpenGL    >= 2.4     && < 2.5, +                      GLUT      >= 2.2     && < 2.3,+                      OpenGLRaw >= 1.1.0.1 && < 2, +                      StateVar  >= 1.0.0.0 && < 2,+                      Tensor    >= 1.0.0.1 && < 2       exposed-modules:@@ -57,8 +84,7 @@     Graphics.Rendering.OpenVG.VG.RenderingQuality,     Graphics.Rendering.OpenVG.VG.Scissoring,     Graphics.Rendering.OpenVG.VG.ShivaExtensions,-    Graphics.Rendering.OpenVG.VGU.VGU,-    Graphics.Rendering.OpenVG.VGU.Errors+    Graphics.Rendering.OpenVG.VGU.VGU      other-modules:     Graphics.Rendering.OpenVG.VG.Constants,
README.txt view
@@ -3,16 +3,20 @@ Haskell OpenVG 0.1 binds to ShivaVG-0.2.0 Haskell OpenVG 0.2 binds to ShivaVG-0.2.1 Haskell OpenVG 0.2.1 binds to ShivaVG-0.2.1-Haskell OpenVG 0.3.0 binds to ShiaVG-0.2.1+Haskell OpenVG 0.3.0 binds to ShiaVG-0.2.1 +(thanks to Stefan Kirsten for the patches).+Haskell OpenVG 0.4.0 binds to ShivaVG-0.2.1 + I've tested the bindings on both Windows XP (MinGW/Msys)  and MacOSX Leopard.  On MacOSX both the 0.2 and 0.1 bindings seem work on  their respective libraries. -On Windows I've not been able to get the 0.3.0 bindings to -work (yet), 0.2.1 is preferred...+On Windows the version 0.4.0 bindings now work, though please +make sure your Haskell OpenGL binding works first before trying +the OpenVG binding.
src/Graphics/Rendering/OpenVG.hs view
@@ -7,10 +7,17 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC --+-- Import (convenience) module for the VG and VGU library modules.+--  -- A Haskell binding for the OpenVG vector and raster graphics API.+--+-- The implementation targets the Shiva-VG implementation which +-- is not complete. Image Filters and Querying Hardware are not +-- implemented and various functions are missing. + -- --------------------------------------------------------------------------------
src/Graphics/Rendering/OpenVG/Util/Colors.hs view
@@ -7,11 +7,17 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  deprecated -- Portability :  GHC ----- Colour definitions named with the SVG \'named colours\', but--- defining OpenGL colours. +-- \*\* This module is deprecated \*\*+-- +-- Colour definitions named with the SVG \'named colours\'.+-- +-- If this module is /useful/ it would be better off outside the +-- OpenVG bindings package and presented in some /higher-level/ +-- package.+-- -- --------------------------------------------------------------------------------
src/Graphics/Rendering/OpenVG/Util/PathCommands.hs view
@@ -7,11 +7,20 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  deprecated -- Portability :  GHC ----- Path Segment commands corresponding to section 8.5.2 --+-- \*\* This module is deprecated \*\*+--+-- Path Segment shorthand commands patterned after section 8.5.2.+--+-- This module is needs more thought - currently it is a sketch +-- to help create paths. If it becomes useful in the future it +-- is still be better off outside the OpenVG bindings package +-- and presented in some higher-level package.+--+ --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.Util.PathCommands (@@ -40,18 +49,18 @@  data SegmentCommand a =       CLOSE_PATH-   | MOVE_TO    PathType a a-   | LINE_TO    PathType a a-   | HLINE_TO   PathType a-   | VLINE_TO   PathType a-   | QUAD_TO    PathType a a a a-   | CUBIC_TO   PathType a a a a a a-   | SQUAD_TO   PathType a a-   | SCUBIC_TO  PathType a a a a-   | SCCWARC_TO PathType a a a a a-   | SCWARC_TO  PathType a a a a a-   | LCCWARC_TO PathType a a a a a-   | LCWARC_TO  PathType a a a a a+   | MOVE_TO    PathAbsRel a a+   | LINE_TO    PathAbsRel a a+   | HLINE_TO   PathAbsRel a+   | VLINE_TO   PathAbsRel a+   | QUAD_TO    PathAbsRel a a a a+   | CUBIC_TO   PathAbsRel a a a a a a+   | SQUAD_TO   PathAbsRel a a+   | SCUBIC_TO  PathAbsRel a a a a+   | SCCWARC_TO PathAbsRel a a a a a+   | SCWARC_TO  PathAbsRel a a a a a+   | LCCWARC_TO PathAbsRel a a a a a+   | LCWARC_TO  PathAbsRel a a a a a    deriving ( Eq, Show )  pathData :: StorablePathData a => [SegmentCommand a] -> ([PathCommand], [a])
src/Graphics/Rendering/OpenVG/VG.hs view
@@ -7,13 +7,10 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC ----- A Haskell binding for the OpenVG vector and raster graphics API --- (version 1.0.1).--- The implementation targets the Shiva-VG implementation which is not --- complete. Image Filters and Querying Hardware are not implemented. +-- Import (convenience) module for the VG library modules. -- --------------------------------------------------------------------------------
src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc view
@@ -24,7 +24,7 @@   VGboolean, VGfloat,   VGenum,   -  vg_FALSE, vg_TRUE, marshalBool, unmarshalBool,+  vg_FALSE, vg_TRUE,      -- * Handle-based Types   VGHandle,@@ -34,15 +34,12 @@      -- * Points   Point,-  -  -- * Size conversion-  unSize  + ) where  #include <vg/openvg.h>  import Graphics.Rendering.OpenGL.Raw.Core31-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )  import Foreign.Ptr @@ -58,25 +55,12 @@   --- | The type of data that can be displayed. type VGboolean = GLint  #{enum VGboolean,   , vg_FALSE    = VG_FALSE   , vg_TRUE     = VG_TRUE   }--marshalBool :: Bool -> VGboolean-marshalBool x = case x of-  True -> vg_TRUE-  False -> vg_FALSE--unmarshalBool :: VGboolean -> Bool-unmarshalBool x-    | x == vg_TRUE  = True-    | x == vg_FALSE = False-    | otherwise = error ("unmarshalBool: illegal value " ++ show x)-        newtype VGHandle = VGHandle (Ptr ()) @@ -90,14 +74,6 @@ type VGPaint = VGHandle  --- | Point (VGfloat,VGfloat)  type Point = (VGfloat, VGfloat)----- Helper - unwrap Size--unSize :: Size -> (VGint,VGint)-unSize (Size w h) = (fromIntegral w, fromIntegral h)-
src/Graphics/Rendering/OpenVG/VG/Blending.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 12 (Blending) @@ -29,7 +29,6 @@     vg_BLEND_ADDITIVE )  import Graphics.Rendering.OpenVG.VG.Parameters (      seti, ParamType ( BlendMode ) )-import Graphics.Rendering.OpenVG.VG.Utils ( Marshal(..), enumValue )  import Data.StateVar (    SettableStateVar, makeSettableStateVar ) @@ -38,7 +37,7 @@ -------------------------------------------------------------------------------- -- Setting the blend mode    --- | BlendMode defines the possible blend modes.        +-- | 'BlendMode' enumerates the possible blend modes.         data BlendMode =       Src    | SrcOver@@ -52,31 +51,32 @@    | Additive    deriving ( Eq, Ord, Show ) --- | Set the blend mode - @blendMode@ is typed wrapper--- over this equivalent OpenVG code:++-- | Set the blend mode. ----- @ VGBlendMode mode; @+-- 'blendMode' is a write-only state variable corresponding to+-- @VG_BLEND_MODE@:+--    +-- > vgSeti(VG_BLEND_MODE, mode); ----- @ vgSeti(VG_BLEND_MODE, mode); @ blendMode :: SettableStateVar BlendMode-blendMode = makeSettableStateVar $ \mode -> seti BlendMode (enumValue mode)+blendMode = makeSettableStateVar $ +    seti BlendMode . fromIntegral . marshalBlendMode  --------------------------------------------------------------------------------  marshalBlendMode :: BlendMode -> VGenum marshalBlendMode x = case x of-    Src -> vg_BLEND_SRC-    SrcOver -> vg_BLEND_SRC_OVER-    DstOver -> vg_BLEND_DST_OVER-    SrcIn -> vg_BLEND_SRC_IN-    DstIn -> vg_BLEND_DST_IN+    Src       -> vg_BLEND_SRC+    SrcOver   -> vg_BLEND_SRC_OVER+    DstOver   -> vg_BLEND_DST_OVER+    SrcIn     -> vg_BLEND_SRC_IN+    DstIn     -> vg_BLEND_DST_IN     Multiply' -> vg_BLEND_MULTIPLY-    Screen -> vg_BLEND_SCREEN-    Darken -> vg_BLEND_DARKEN-    Lighten -> vg_BLEND_LIGHTEN-    Additive -> vg_BLEND_ADDITIVE+    Screen    -> vg_BLEND_SCREEN+    Darken    -> vg_BLEND_DARKEN+    Lighten   -> vg_BLEND_LIGHTEN+    Additive  -> vg_BLEND_ADDITIVE     -instance Marshal BlendMode where marshal = marshalBlendMode-
src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs view
@@ -7,35 +7,98 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC ----- This module corresponds to section 4.3 (Forcing Drawing to Complete) --- of the OpenVG 1.0.1 specs.+-- This module corresponds to sections 4.1 (Errors) and 4.3 +-- (Forcing Drawing to Complete) of the OpenVG 1.0.1 specs. -- --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VG.DrawingContext (+  -- * Errors+  VG_ErrorCode(..),+  getError,      -- * Forcing drawing to complete   flush,    finish-) where  +) where++import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGenum ) import Graphics.Rendering.OpenVG.VG.CFunDecls ( -        vgFlush, vgFinish ) +        vgGetError, vgFlush, vgFinish )  +import Graphics.Rendering.OpenVG.VG.Constants (+      vg_NO_ERROR, +      vg_BAD_HANDLE_ERROR, +      vg_ILLEGAL_ARGUMENT_ERROR,+      vg_OUT_OF_MEMORY_ERROR, +      vg_PATH_CAPABILITY_ERROR,+      vg_UNSUPPORTED_IMAGE_FORMAT_ERROR, +      vg_UNSUPPORTED_PATH_FORMAT_ERROR,+      vg_IMAGE_IN_USE_ERROR,+      vg_NO_CONTEXT_ERROR ) ++import Control.Monad ( liftM )+ --------------------------------------------------------------------------------+-- Errors+++data VG_ErrorCode =+     VG_NoError+   | VG_BadHandle+   | VG_IllegalArgument+   | VG_OutOfMemory+   | VG_PathCapability+   | VG_UnsupportedImageFormat+   | VG_UnsupportedPathFormat+   | VG_ImageInUse+   | VG_NoContextError+   deriving ( Eq, Ord, Show )++-- | +getError :: IO VG_ErrorCode+getError = liftM unmarshalErrorCode vgGetError ++++-------------------------------------------------------------------------------- --  Forcing drawing to complete --- | @flush@ - corresponds directly to the OpenVG call @vgFlush@.+-- | 'flush' ensures all the outstanding drawing requests on the +-- current context are completed. The call may return before the +-- actual drawing takes place.+--+-- 'flush' corresponds to the OpenVG call @vgFlush@.+--  flush :: IO () flush = vgFlush --- | @finish@ - corresponds directly to the OpenVG call @vgFinish@.+-- | 'finish' forces all the outstanding drawing requests on the +-- current context are performed. The call returns when drawing is+-- completed.+--+-- 'finish' corresponds to the OpenVG call @vgFinish@.+-- finish :: IO () finish = vgFinish  - +-------------------------------------------------------------------------------- ++unmarshalErrorCode :: VGenum -> VG_ErrorCode+unmarshalErrorCode x +    | x == vg_NO_ERROR                       = VG_NoError+    | x == vg_BAD_HANDLE_ERROR               = VG_BadHandle+    | x == vg_ILLEGAL_ARGUMENT_ERROR         = VG_IllegalArgument+    | x == vg_OUT_OF_MEMORY_ERROR            = VG_OutOfMemory+    | x == vg_PATH_CAPABILITY_ERROR          = VG_PathCapability+    | x == vg_UNSUPPORTED_IMAGE_FORMAT_ERROR = VG_UnsupportedImageFormat+    | x == vg_UNSUPPORTED_PATH_FORMAT_ERROR  = VG_UnsupportedPathFormat +    | x == vg_IMAGE_IN_USE_ERROR             = VG_ImageInUse+    | x == vg_NO_CONTEXT_ERROR               = VG_NoContextError+    | otherwise = error ("unmarshalErrorCode: illegal value " ++ show x)
src/Graphics/Rendering/OpenVG/VG/Extending.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 14 (Extending the API) @@ -45,18 +45,25 @@   -- | Query the OpenVG implementation.   +-- +-- 'stringId' wraps the OpenVG function vgGetString:+--+-- > const VGubyte * vgGetString(VGStringID name)+-- stringId :: StringID -> GettableStateVar String stringId sid = makeGettableStateVar $ do      cstr <- vgGetString (marshalStringID sid)     ans  <- peekCString cstr     return ans ++ --------------------------------------------------------------------------------     marshalStringID :: StringID -> VGenum marshalStringID x = case x of -    Vendor -> vg_VENDOR-    Renderer -> vg_RENDERER-    Version -> vg_VERSION+    Vendor     -> vg_VENDOR+    Renderer   -> vg_RENDERER+    Version    -> vg_VERSION     Extensions -> vg_EXTENSIONS
src/Graphics/Rendering/OpenVG/VG/Images.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 10 (Images) @@ -27,9 +27,9 @@   -- * Creating and destroying images   maxImageWidth, maxImageHeight, maxImagePixels, maxImageBytes,   -  withImage,   createImage,    destroyImage, +  withImage,         -- * Querying images@@ -58,7 +58,7 @@ ) where  import Graphics.Rendering.OpenVG.VG.BasicTypes ( -    VGenum, VGint, VGImage, marshalBool, unSize )+    VGenum, VGint, VGImage ) import Graphics.Rendering.OpenVG.VG.CFunDecls (      vgCreateImage, vgDestroyImage, vgClearImage,     vgImageSubData, vgGetImageSubData, @@ -87,9 +87,10 @@     ParamType ( ImageQuality, ImageMode,                 MaxImageWidth, MaxImageHeight,                  MaxImagePixels, MaxImageBytes ) )-import Graphics.Rendering.OpenVG.VG.Utils ( -    Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral, bitwiseOr ) +import Graphics.Rendering.OpenVG.VG.Utils ( bitwiseOr, unSizeM, marshalBool )++ import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size (..) )    import Data.StateVar (@@ -103,6 +104,7 @@ -------------------------------------------------------------------------------- -- Image quality +-- | Resampling quality to be used when drawing images. data ImageQuality =       Nonantialiased    | Faster@@ -110,22 +112,27 @@    deriving ( Eq, Ord, Show )        --- | Set the image quality - @imageQuality@ is typed wrapper--- over this equivalent OpenVG code:+-- | Set the image quality. ----- @ VGImageQuality quality; @+-- 'imageQuality' is a write-only state variable corresponding to+-- @VG_IMAGE_QUALITY@: ----- @ vgSeti(VG_IMAGE_QUALITY, quality); @+-- > vgSeti(VG_IMAGE_QUALITY, quality);+--  imageQuality :: SettableStateVar ImageQuality  -imageQuality = makeSettableStateVar $ \mode -> -    seti ImageQuality (fromIntegral $ marshalImageQuality mode)  +imageQuality = makeSettableStateVar $ +    seti ImageQuality . fromIntegral . marshalImageQuality           -------------------------------------------------------------------------------- --  Image formats --- | ImageFormat enumerates /all/ the image formats supported by OpenVG.--- ShivaVG currently only supports @sRGBA_8888@.+-- | Image formats and colur spaces supported by OpenVG. +--+-- \*\* NOTE - ImageFormat enumerates /all/ the image formats +-- supported by OpenVG. ShivaVG currently only supports +-- @sRGBA_8888@. \*\*+-- data ImageFormat =       -- RGB{A,X} channel ordering      SRGBX8888@@ -178,100 +185,160 @@ -- Creating and destroying images  -- | Get the maximum available width for the 'createImage' function.--- @maxImageWidth@ is equivalent to this OpenVG code:+-- +-- 'maxImageWidth' is a read-only state variable corresponding to+-- @VG_MAX_IMAGE_WIDTH@: ----- @ VGint imageMaxWidth = vgGeti(VG_MAX_IMAGE_WIDTH); @+-- > VGint imageMaxWidth = vgGeti(VG_MAX_IMAGE_WIDTH);+-- maxImageWidth :: GettableStateVar VGint maxImageWidth = makeGettableStateVar $ geti MaxImageWidth   -- | Get the maximum available width for the 'createImage' function.--- @maxImageWidth@ is equivalent to this OpenVG code: ----- @ VGint imageMaxWidth = vgGeti(VG_MAX_IMAGE_WIDTH); @+-- 'maxImageWidth' is a read-only state variable corresponding to+-- @VG_MAX_IMAGE_HEIGHT@:+--+-- > VGint imageMaxWidth = vgGeti(VG_MAX_IMAGE_WIDTH);+-- maxImageHeight :: GettableStateVar VGint maxImageHeight = makeGettableStateVar $ geti MaxImageHeight --- | Get the largest available value of the product of the @width@ and --- @height@ passed to the 'createImage' function.--- @maxImagePixels@ is equivalent to this OpenVG code:++-- | Get the largest number of pixels that may make up an image +-- supported by OpenVG implementation. ----- @ VGint imageMaxPixels = vgGeti(VG_MAX_IMAGE_PIXELS); @+-- 'maxImagePixels' is a read-only state variable corresponding to+-- @VG_MAX_IMAGE_PIXELS@:+--+-- > VGint imageMaxPixels = vgGeti(VG_MAX_IMAGE_PIXELS);+-- maxImagePixels :: GettableStateVar VGint maxImagePixels = makeGettableStateVar $ geti MaxImagePixels --- | Get the largest available number of bytes that may make up the image data--- passed to the 'createImage' function.--- @maxImageBytes@ is equivalent to this OpenVG code:++-- | Get the largest number of bytes that may make up an image +-- supported by OpenVG implementation. ----- @ VGint imageMaxBytes = vgGeti(VG_MAX_IMAGE_BYTES); @+-- 'maxImageBytes' is a read-only state variable corresponding to+-- @VG_MAX_IMAGE_BYTES@:+--+-- > VGint imageMaxBytes = vgGeti(VG_MAX_IMAGE_BYTES);+-- maxImageBytes :: GettableStateVar VGint maxImageBytes = makeGettableStateVar $ geti MaxImageBytes ---- | @withImage@ - create an image, run an action on it, destroy the image.-withImage :: ImageFormat -> Size -> [ImageQuality] -> (VGImage -> IO a) -> IO a-withImage fmt sz qual action = do-    img   <- createImage fmt sz qual-    ans   <- action img-    destroyImage img-    return ans          --- | @createImage@ corresponds to the OpenVG function @vgCreateImage@.             +-- | Create an image and return a handle to it.+--+-- 'createImage' corresponds to the OpenVG function +-- @vgCreateImage@.+-- createImage :: ImageFormat -> Size -> [ImageQuality] -> IO VGImage -createImage SRGBA8888 sz qs = let (w,h) = unSize sz in-    vgCreateImage (marshal SRGBA8888) w h (bitwiseOr qs) -createImage _         _          _  = error $ "unsupported image format"+createImage SRGBA8888 sz qs = +    unSizeM (\w h -> vgCreateImage (marshalImageFormat SRGBA8888)+                                   w +                                   h +                                   (bitwiseOr marshalImageQuality qs)) sz +createImage _         _  _  = error $ "unsupported image format" --- | @destroyImage@ corresponds to the OpenVG function @vgDestroyImage@. +-- | Destroy the image and the resources assciated with it. +-- +-- 'destroyImage' corresponds to the OpenVG function +-- @vgDestroyImage@. +-- destroyImage :: VGImage -> IO ()  destroyImage = vgDestroyImage  +-- | Create an image, run an action on it, destroy the image.+-- +-- 'withImage' is a convenience function defined within the +-- Haskell binding it does not have a corresponding OpenVG +-- function.+--+withImage :: ImageFormat -> Size -> [ImageQuality] -> (VGImage -> IO a) -> IO a+withImage fmt sz qual action = do+    img   <- createImage fmt sz qual+    ans   <- action img+    destroyImage img+    return ans++ -------------------------------------------------------------------------------- -- Querying images  --- | Get the ImageFormat used to defined the image.+-- | Get the image format.+--+-- 'imageFormat' provides access to the OpenVG state variable+-- @VG_IMAGE_FORMAT@:+--+-- > VGImageFormat imageFormat = +-- >      (VGImageFormat)vgGetParameteri(image, VG_IMAGE_FORMAT);+--  imageFormat :: VGImage -> GettableStateVar ImageFormat-imageFormat h = makeGettableStateVar $ do -    a <- getParameteri h vg_IMAGE_FORMAT-    return $ unmarshalIntegral a +imageFormat h = makeGettableStateVar $ +   getParameteri h vg_IMAGE_FORMAT >>= +   return . unmarshalImageFormat . fromIntegral --- | Get the width used to defined the image.+-- | Get the image width.+--+-- 'imageWidth' is a read-only state variable corresponding to+-- @VG_IMAGE_WIDTH@:+--+-- > VGint imageWidth = vgGetParameteri(image, VG_IMAGE_WIDTH);+--  imageWidth :: VGImage -> GettableStateVar VGint-imageWidth h = makeGettableStateVar $ getParameteri h vg_IMAGE_WIDTH+imageWidth = makeGettableStateVar . flip getParameteri vg_IMAGE_WIDTH --- | Get the height used to defined the image.+-- | Get the image height.+--+-- 'imageHeight' is a read-only state variable corresponding to+-- @VG_IMAGE_HEIGHT@:+--+-- > VGint imageHeight = vgGetParameteri(image, VG_IMAGE_HEIGHT);+--  imageHeight :: VGImage -> GettableStateVar VGint-imageHeight h = makeGettableStateVar $ getParameteri h vg_IMAGE_HEIGHT+imageHeight = makeGettableStateVar . flip getParameteri vg_IMAGE_HEIGHT    -------------------------------------------------------------------------------- -- Reading and writing image pixels --- | Fill the given rectangle inside the image with the current color setting--- from the @StateVar@ 'clearColor'+-- | Fill the given rectangle inside the image with the current +-- color setting from the @StateVar@ 'clearColor'.+--+-- 'clearImage' corresponds to the OpenVG function @vgClearImage@.+-- clearImage :: VGImage -> Position -> Size -> IO () -clearImage handle (Position x y) sz = -   let (w,h) = unSize sz in vgClearImage handle x y w h+clearImage handle (Position x y) = unSizeM $ vgClearImage handle x y                          --- | @imageSubData@ corresponds to the OpenVG function @vgImageSubData@. +-- | Read the pixel values from memory and store the results in +-- a rectagular portion of an image.+--+-- 'imageSubData' corresponds to the OpenVG function +-- @vgImageSubData@. +-- imageSubData :: VGImage -> Ptr a -> VGint -> ImageFormat                   -> Position -> Size -> IO ()-imageSubData image imgdata stride fmt (Position x y) sz =-    vgImageSubData image imgdata stride (marshalImageFormat fmt) x y w h  -  where-    (w,h) = unSize sz-   --- | @getImageSubData@ corresponds to the OpenVG function @vgGetImageSubData@.                   +imageSubData image imgdata stride fmt (Position x y) =+    unSizeM $ vgImageSubData image imgdata stride (marshalImageFormat fmt) x y++++-- | Read the pixel values from a image and store the results in +-- memory.+--+-- 'getImageSubData' corresponds to the OpenVG function +-- @vgGetImageSubData@. +-- getImageSubData :: VGImage -> Ptr a -> VGint -> ImageFormat                     -> Position -> Size -> IO ()-getImageSubData image imgdata stride fmt (Position x y) sz = -     vgGetImageSubData image imgdata stride (marshalImageFormat fmt) x y w h -  where-    (w,h) = unSize sz+getImageSubData image imgdata stride fmt (Position x y) = +    unSizeM $ vgGetImageSubData image imgdata stride (marshalImageFormat fmt) x y     -------------------------------------------------------------------------------- @@ -281,13 +348,14 @@ -------------------------------------------------------------------------------- -- Copying pixels between images --- | @copyImage@ corresponds to the OpenVG function @vgCopyImage@.+-- | Copy pixels between images.+--+-- 'copyImage' corresponds to the OpenVG function @vgCopyImage@.+-- copyImage :: VGImage -> Position -> VGImage -> Position                 -> Size -> Bool -> IO () copyImage dst (Position dx dy) src (Position sx sy) sz dither = -    vgCopyImage dst dx dy src sx sy w h (marshalBool dither)-  where-     (w,h) = unSize sz+    unSizeM (\w h -> vgCopyImage dst dx dy src sx sy w h (marshalBool dither)) sz  -------------------------------------------------------------------------------- -- Drawing iamges to the drawing surface@@ -298,18 +366,24 @@    | Multiply    | Stencil    deriving ( Eq, Ord, Show )-   --- | Set the image drawing mode - @drawImageMode@ is typed wrapper--- over this equivalent OpenVG code:++++-- | Set the draw image mode. ----- @ VGImageMode drawImageMode; @+-- 'drawImageMode' is a write-only state variable corresponding to+-- @VG_IMAGE_MODE@: ----- @ vgSeti(VG_IMAGE_MODE, drawImageMode); @+-- > vgSeti(VG_IMAGE_MODE, quality);+--     drawImageMode :: SettableStateVar ImageMode  -drawImageMode = makeSettableStateVar $ \mode -> -    seti ImageMode (enumValue mode)  +drawImageMode = makeSettableStateVar $+    seti ImageMode . fromIntegral . marshalImageMode --- | @drawImage@ corresponds to the OpenVG function @vgDrawImage@. +-- | Draw the image on the current drawing surface.+--+-- 'drawImage' corresponds to the OpenVG function @vgDrawImage@.+-- drawImage :: VGImage -> IO () drawImage = vgDrawImage @@ -317,33 +391,51 @@ -------------------------------------------------------------------------------- -- Reading and writing drawing surface pixels --- | @setPixels@ corresponds to the OpenVG function @vgSetPixels@. +-- | Copy pixel data from the image to the drawing surface.+--+-- 'setPixels' corresponds to the OpenVG function @vgSetPixels@. +-- setPixels :: Position -> VGImage -> Position -> Size -> IO ()-setPixels (Position dx dy) src (Position sx sy) sz = let (w,h) = unSize sz in -    vgSetPixels dx dy src sx sy w h+setPixels (Position dx dy) src (Position sx sy) =+    unSizeM $ vgSetPixels dx dy src sx sy --- | @writePixels@ corresponds to the OpenVG function @vgWritePixels@. +-- | Copy pixels to the drawing surface without first creating an+-- image.+--+-- 'writePixels' corresponds to the OpenVG function @vgWritePixels@.+-- writePixels :: Ptr a -> VGint -> ImageFormat -> Position -> Size -> IO ()-writePixels pixeldata stride fmt (Position dx dy) sz = let (w,h) = unSize sz in -    vgWritePixels pixeldata stride (marshal fmt) dx dy w h+writePixels pixeldata stride fmt (Position dx dy) =  +    unSizeM $ vgWritePixels pixeldata stride (marshalImageFormat fmt) dx dy --- | @getPixels@ corresponds to the OpenVG function @vgGetPixels@. +-- | Retrieve pixel information from the drawing surface. +-- +-- 'getPixels' corresponds to the OpenVG function @vgGetPixels@.+-- getPixels :: VGImage  -> Position -> Position -> Size -> IO ()-getPixels dst (Position dx dy) (Position sx sy) sz = let (w,h) = unSize sz in -    vgGetPixels dst dx dy sx sy w h+getPixels dst (Position dx dy) (Position sx sy) =  +    unSizeM $ vgGetPixels dst dx dy sx sy --- | @readPixels@ corresponds to the OpenVG function @vgReadPixels@.+-- | Copy data from the drawing surface without creating an+-- image first. +-- +-- 'readPixels' corresponds to the OpenVG function @vgReadPixels@.+-- readPixels :: Ptr a -> VGint -> ImageFormat -> Position -> Size -> IO ()-readPixels pixeldata stride fmt (Position sx sy) sz = let (w,h) = unSize sz in -    vgReadPixels pixeldata stride (marshal fmt) sx sy w h+readPixels pixeldata stride fmt (Position sx sy) = unSizeM $+    vgReadPixels pixeldata stride (marshalImageFormat fmt) sx sy  -------------------------------------------------------------------------------- -- Copying portions of the drawing surface --- | @copyPixels@ corresponds to the OpenVG function @vgCopyPixels@.+-- | Copy pixels from one region of the drawing surface to +-- another.+--+-- 'copyPixels' corresponds to the OpenVG function @vgCopyPixels@.+-- copyPixels :: Position -> Position -> Size -> IO ()-copyPixels (Position dx dy) (Position sx sy) sz = -    let (w,h) = unSize sz in vgCopyPixels dx dy sx sy w h+copyPixels (Position dx dy) (Position sx sy) = +    unSizeM $ vgCopyPixels dx dy sx sy                                     @@ -353,48 +445,47 @@  marshalImageFormat :: ImageFormat -> VGenum marshalImageFormat x = case x of -    SRGBX8888 -> vg_sRGBX_8888-    SRGBA8888 -> vg_sRGBA_8888+    SRGBX8888    -> vg_sRGBX_8888+    SRGBA8888    -> vg_sRGBA_8888     SRGBA8888Pre -> vg_sRGBA_8888_PRE-    SRGB565 -> vg_sRGB_565-    SRGBA5551 -> vg_sRGBA_5551-    SRGBA4444 -> vg_sRGBA_4444-    SL8 -> vg_sL_8-    LRGBX8888 -> vg_lRGBX_8888-    LRGBA8888 -> vg_lRGBA_8888+    SRGB565      -> vg_sRGB_565+    SRGBA5551    -> vg_sRGBA_5551+    SRGBA4444    -> vg_sRGBA_4444+    SL8          -> vg_sL_8+    LRGBX8888    -> vg_lRGBX_8888+    LRGBA8888    -> vg_lRGBA_8888     LRGBA8888Pre -> vg_lRGBA_8888_PRE-    LL8 -> vg_lL_8-    A8 -> vg_A_8-    BW1 -> vg_BW_1-    -- FormatA1 ->      (not supported in shiva-vg)-    -- FormatA4 ->      (not supported in shiva-vg)-    SXRGB8888 -> vg_sXRGB_8888-    SARGB8888 -> vg_sARGB_8888+    LL8          -> vg_lL_8+    A8           -> vg_A_8+    BW1          -> vg_BW_1+    -- FormatA1    ->      (not supported in shiva-vg)+    -- FormatA4    ->      (not supported in shiva-vg)+    SXRGB8888    -> vg_sXRGB_8888+    SARGB8888    -> vg_sARGB_8888     SARGB8888Pre -> vg_sARGB_8888_PRE-    SARGB1555 -> vg_sARGB_1555-    SARGB4444 -> vg_sARGB_4444-    LXRGB8888 -> vg_lXRGB_8888-    LARGB8888 -> vg_lARGB_8888+    SARGB1555    -> vg_sARGB_1555+    SARGB4444    -> vg_sARGB_4444+    LXRGB8888    -> vg_lXRGB_8888+    LARGB8888    -> vg_lARGB_8888     LARGB8888Pre -> vg_lARGB_8888_PRE-    SBGRX8888 -> vg_sBGRX_8888-    SBGRA8888 -> vg_sBGRA_8888+    SBGRX8888    -> vg_sBGRX_8888+    SBGRA8888    -> vg_sBGRA_8888     SBGRA8888Pre -> vg_sBGRA_8888_PRE-    SBGR565 -> vg_sBGR_565-    SBGRA5551 -> vg_sBGRA_5551-    SBGRA4444 -> vg_sBGRA_4444-    LBGRX8888 -> vg_lBGRX_8888-    LBGRA8888 -> vg_lBGRA_8888+    SBGR565      -> vg_sBGR_565+    SBGRA5551    -> vg_sBGRA_5551+    SBGRA4444    -> vg_sBGRA_4444+    LBGRX8888    -> vg_lBGRX_8888+    LBGRA8888    -> vg_lBGRA_8888     LBGRA8888Pre -> vg_lBGRA_8888_PRE-    SXBGR8888 -> vg_sXBGR_8888-    SABGR8888 -> vg_sABGR_8888+    SXBGR8888    -> vg_sXBGR_8888+    SABGR8888    -> vg_sABGR_8888     SABGR8888Pre -> vg_sABGR_8888_PRE-    SABGR1555 -> vg_sABGR_1555-    SABGR4444 -> vg_sABGR_4444-    LXBGR8888 -> vg_lXBGR_8888-    LABGR8888 -> vg_lABGR_8888+    SABGR1555    -> vg_sABGR_1555+    SABGR4444    -> vg_sABGR_4444+    LXBGR8888    -> vg_lXBGR_8888+    LABGR8888    -> vg_lABGR_8888     LABGR8888Pre -> vg_lABGR_8888_PRE -instance Marshal ImageFormat where marshal = marshalImageFormat  unmarshalImageFormat :: VGenum -> ImageFormat unmarshalImageFormat x@@ -440,23 +531,17 @@     | x == vg_lABGR_8888_PRE    = LABGR8888Pre       | otherwise = error ("unmarshalImageFormat: illegal value " ++ show x) -instance Unmarshal ImageFormat where unmarshal = unmarshalImageFormat     marshalImageQuality :: ImageQuality -> VGenum marshalImageQuality x = case x of     Nonantialiased -> vg_IMAGE_QUALITY_NONANTIALIASED-    Faster -> vg_IMAGE_QUALITY_FASTER-    Better -> vg_IMAGE_QUALITY_BETTER+    Faster         -> vg_IMAGE_QUALITY_FASTER+    Better         -> vg_IMAGE_QUALITY_BETTER -instance Marshal ImageQuality where marshal = marshalImageQuality   -            marshalImageMode :: ImageMode -> VGenum marshalImageMode x = case x of-    Normal -> vg_DRAW_IMAGE_NORMAL+    Normal   -> vg_DRAW_IMAGE_NORMAL     Multiply -> vg_DRAW_IMAGE_MULTIPLY-    Stencil -> vg_DRAW_IMAGE_STENCIL--instance Marshal ImageMode where marshal = marshalImageMode  -+    Stencil  -> vg_DRAW_IMAGE_STENCIL
src/Graphics/Rendering/OpenVG/VG/Paint.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 9 (Paint) @@ -18,8 +18,8 @@  module Graphics.Rendering.OpenVG.VG.Paint (   -- * Creating and destroying paint objects -  withPaint,   createPaint, destroyPaint, +  withPaint,      -- * Setting the current paint    setPaint, getPaint,@@ -28,21 +28,24 @@   PaintType(..),    paintType,   paintColor,+  maxColorRampStops,   colorRampSpreadMode,+  ColorRampStops,   colorRampStops,   colorRampPremultiplied,+   LinearGradient,   linearGradient,   RadialGradient,    radialGradient,-  tilingMode,-  -  maxStops,+   paintPattern,+  tilingMode+   ) where  import Graphics.Rendering.OpenVG.VG.BasicTypes ( -    VGenum, VGint, VGfloat, VGImage, VGPaint, Point )+    VGenum, VGint, VGfloat, VGImage, VGPaint ) import Graphics.Rendering.OpenVG.VG.CFunDecls (      vgCreatePaint, vgDestroyPaint,      vgSetPaint,@@ -61,15 +64,15 @@     vg_COLOR_RAMP_SPREAD_REFLECT,                  vg_TILE_FILL, vg_TILE_PAD, vg_TILE_REPEAT, vg_TILE_REFLECT )+ import Graphics.Rendering.OpenVG.VG.Parameters (      ParamType( MaxColorRampStops ),     geti, getParameteri,      setParameteri, setParameterfv )      -import Graphics.Rendering.OpenVG.VG.Paths (-    PaintMode(..) )-import Graphics.Rendering.OpenVG.VG.Utils ( -    Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral, bitwiseOr )+import Graphics.Rendering.OpenVG.VG.Paths ( PaintMode(..), marshalPaintMode )+import Graphics.Rendering.OpenVG.VG.Utils ( bitwiseOr, marshalBool )+ import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) )  import Data.StateVar (@@ -77,41 +80,69 @@     SettableStateVar, makeSettableStateVar,     GettableStateVar, makeGettableStateVar ) +import Data.Tensor ( Vector4(..) )++import Control.Monad ( liftM )+ -------------------------------------------------------------------------------- -- Creating and destroying paint objects  +    +    +-- | Create a paint object and return a handle +-- to it.+--+-- 'createPaint' corresponds to the OpenVG function +-- @vgCreatePaint@.+--+createPaint :: IO VGPaint  +createPaint = vgCreatePaint --- | @withPaint@ - create a paint object, run an action on it, destroy the +-- | Destroy a paint object and the resources associated with it.+--+-- 'destroyPaint' corresponds to the OpenVG function +-- @vgDestoryPaint@.+--+destroyPaint :: VGPaint -> IO ()+destroyPaint = vgDestroyPaint++-- | Create a paint object, run an action on it, destroy the  -- paint object.+--+-- 'withPaint' is a convenience function defined within the +-- Haskell binding it does not have a corresponding OpenVG +-- function.+-- withPaint :: (VGPaint -> IO a) -> IO a withPaint action = do     img   <- createPaint     ans   <- action img     destroyPaint img     return ans-    -    --- | @createPaint@ corresponds to the OpenVG function @vgCreatePaint@.-createPaint :: IO VGPaint  -createPaint = vgCreatePaint --- | @destroyPaint@ corresponds to the OpenVG function @vgDestroyPaint@.-destroyPaint :: VGPaint -> IO ()-destroyPaint = vgDestroyPaint  -------------------------------------------------------------------------------- -- Setting the current paint  --- | Set the paint mode on the supplied handle.+-- | Set the paint mode of the supplied paint handle.+--+-- 'setPaint' corresponds to the OpenVG function @vgSetPaint@+-- setPaint :: VGPaint -> SettableStateVar [PaintMode]-setPaint h = makeSettableStateVar $ \ms -> vgSetPaint h (bitwiseOr ms)+setPaint h = makeSettableStateVar $ vgSetPaint h . bitwiseOr marshalPaintMode      --- | Get the paint object currently set for the supplied paint mode. --- Note currently @vgGetPaint@ is not working and will throw a runtime error --- if called.+-- | Get the paint object currently set for the supplied paint +-- mode.+-- +-- 'getPaint' corresponds to the OpenVG function @vgGetPaint@.+--+-- \*\* Note -- currently @vgGetPaint@ is not implemented by +-- ShivaVG, and this stub function will throw a runtime error +-- when called. \*\*+-- getPaint :: PaintMode -> GettableStateVar VGPaint-getPaint paint_mode = makeGettableStateVar $ vgGetPaint (marshal paint_mode)+getPaint = makeGettableStateVar . vgGetPaint . marshalPaintMode   where     vgGetPaint :: VGenum -> IO VGPaint          vgGetPaint = error "vgGetPaint - error"@@ -120,6 +151,7 @@ -- Setting paint parameters   -- | PaintType determines the type of paint to be applied.+-- data PaintType =       Color    | LinearGradient@@ -127,23 +159,46 @@    | Pattern    deriving ( Eq, Ord, Show ) --- Control the PaintType of the supplied handle, the default value is--- @Color@.+-- | Query and set the 'PaintType' of the supplied handle.+-- +-- 'paintType' is a read-write state variable corresponding to +-- @VG_PAINT_TYPE@+--+-- The default value of 'paintType' is 'Color'.+-- paintType :: VGPaint -> StateVar PaintType paintType handle = makeStateVar (getPaintType handle) (setPaintType handle)    where     getPaintType :: VGPaint -> IO PaintType-    getPaintType h = do -        a <- getParameteri h vg_PAINT_TYPE-        return $ unmarshalIntegral a +    getPaintType h = liftM (unmarshalPaintType . fromIntegral) +                           (getParameteri h vg_PAINT_TYPE )          setPaintType :: VGPaint -> PaintType -> IO ()-    setPaintType h v = -        setParameteri h vg_PAINT_TYPE (enumValue v)+    setPaintType h = +        setParameteri h vg_PAINT_TYPE . fromIntegral . marshalPaintType -        --- Control the color of the supplied handle, the default value is--- @red=0.0f, green=0.0f, blue=0.0f, alpha=1.0f@      ++{-+-- ShivaVG does not seem to have implemented vgSetColor yet. +setColor :: VGPaint -> VGuint -> IO ()+setColor = vgSetColor+-}++{-+-- ShivaVG does not seem to have implemented vgGetColor yet. +getColor :: VGPaint -> IO VGuint+getColor = vgGetColor+-}+++-- | Set the paint color of the supplied handle.+--+-- 'paintColor' is a write-only state variable corresponding to+-- @VG_PAINT_COLOR@.+--+-- The default value of 'paintColor' is black: +-- @red=0.0f, green=0.0f, blue=0.0f, alpha=1.0f@.+-- paintColor :: VGPaint -> SettableStateVar (Color4 VGfloat) paintColor h = makeSettableStateVar $      \(Color4 r g b a) -> setParameterfv h vg_PAINT_COLOR [r,g,b,a]@@ -156,43 +211,110 @@    | CReflect    deriving ( Eq, Ord, Show )    --- | Control the @ColorRampSpreadMode@ of the supplied handle, --- the default value is @CPad@ aka VG_COLOR_RAMP_SPREAD_PAD. +-- | Set the color ramp spread mode of the supplied handle.+--+-- 'colorRampSpreadMode' is a write-only state variable +-- corresponding to @VG_PAINT_COLOR_RAMP_SPREAD_MODE@.+-- +-- The default value is @CPad@ aka VG_COLOR_RAMP_SPREAD_PAD. +-- colorRampSpreadMode :: VGPaint -> SettableStateVar ColorRampSpreadMode-colorRampSpreadMode h = makeSettableStateVar $ -    \a -> setParameteri h vg_PAINT_COLOR_RAMP_SPREAD_MODE (enumValue a)-                            +colorRampSpreadMode h = +    let conv = fromIntegral . marshalColorRampSpreadMode in +      makeSettableStateVar $+        setParameteri h vg_PAINT_COLOR_RAMP_SPREAD_MODE . conv                                  --- paintColorRampStops - is [VGfloat] good enough, or should it be --- [Color4 VGfloat]?  ++   +-- | Query the maximum number of ramp stops supported by the +-- implementation.+--+-- 'maxColorRampStops' is a read-only state variable +-- corresponding to @VG_MAX_COLOR_RAMP_STOPS@.+-- +maxColorRampStops :: GettableStateVar VGint +maxColorRampStops = makeGettableStateVar $ geti MaxColorRampStops+++-- | ColorRampStops = (offset, color_value)+--+type ColorRampStops = (VGfloat, Vector4 VGfloat)+     --- | Control the color ramp stops of the supplied handle, --- the default value is @[]@. -colorRampStops :: VGPaint -> SettableStateVar [VGfloat]+-- | Set the color ramp stops of the supplied handle.+--+-- 'colorRampStops' is a write-only state variable corresponding+-- to @VG_PAINT_COLOR_RAMP_STOPS@.+--+colorRampStops :: VGPaint -> SettableStateVar [ColorRampStops] colorRampStops h = makeSettableStateVar $ -    \xs -> setParameterfv h vg_PAINT_COLOR_RAMP_STOPS xs+    setParameterfv h vg_PAINT_COLOR_RAMP_STOPS . foldr fn []+  where+    fn (o,(Vector4 r g b a)) acc = o:r:g:b:a:acc   --- | Control the color ramp stops of the supplied handle, --- the default value is @[]@. +-- | Set whether or not the color ramp stops are premultiplied.+--+-- 'colorRampPremultiplied' is a write-only state variable +-- corresponding to @VG_PAINT_COLOR_RAMP_PREMULTIPLIED@.+-- colorRampPremultiplied :: VGPaint -> SettableStateVar Bool-colorRampPremultiplied h = makeSettableStateVar $ -    \a -> setParameteri h vg_PAINT_COLOR_RAMP_PREMULTIPLIED (enumValue a)+colorRampPremultiplied h = let conv = fromIntegral . marshalBool in +    makeSettableStateVar $ +      setParameteri h vg_PAINT_COLOR_RAMP_PREMULTIPLIED . conv -type LinearGradient = (Point,Point) +-- | LinearGradient = (x0,y0,x1,y1). +type LinearGradient = Vector4 VGfloat++-- | Set the linear gradient of the supplied handle.+--+-- 'linearGradient' is a write-only state variable, it corresponds+-- to a sequence of two OpenVG calls. The first sets the +-- @VG_PAINT_TYPE@ parameter to @VG_PAINT_TYPE_LINEAR_GRADIENT@, +-- the second sets the @VG_PAINT_LINEAR_GRADIENT@ parameter to the+-- supplied Vector4. +--  linearGradient :: VGPaint -> SettableStateVar LinearGradient-linearGradient h = makeSettableStateVar $ \((x0,y0),(x1,y1)) -> do+linearGradient h = makeSettableStateVar $ \(Vector4 x0 y0 x1 y1) -> do     setParameteri  h vg_PAINT_TYPE (fromIntegral vg_PAINT_LINEAR_GRADIENT)     setParameterfv h vg_PAINT_LINEAR_GRADIENT [x0,y0,x1,y1] -type RadialGradient = (Point,Point,VGfloat) +-- | LinearGradient = ((cx,cy,fx,fy),r). +-- +-- @(cx,cy)@ is the centerpoint of the graient circle, @(fx,fy)@ +-- is a focal point within the circle, @r@ is the radius.+type RadialGradient = (Vector4 VGfloat, VGfloat)++-- | Set the radial gradient of the supplied handle.+--+-- 'radialGradient' is a write-only state variable, it corresponds+-- to a sequence of two OpenVG calls. The first sets the +-- @VG_PAINT_TYPE@ parameter to @VG_PAINT_TYPE_RADIAL_GRADIENT@, +-- the  second sets the @VG_PAINT_RADIAL_GRADIENT@ parameter to +-- the supplied 5 values. +--  radialGradient :: VGPaint -> SettableStateVar RadialGradient-radialGradient h = makeSettableStateVar $ \((x0,y0),(x1,y1),r) -> do+radialGradient h = makeSettableStateVar $ \((Vector4 x0 y0 x1 y1),r) -> do     setParameteri  h vg_PAINT_TYPE (fromIntegral vg_PAINT_RADIAL_GRADIENT)     setParameterfv h vg_PAINT_RADIAL_GRADIENT [x0,y0,x1,y1,r] ++       +-- | Set the paint pattern on the on the paint object+-- with the new values from the supplied image+--+-- 'paintPattern' corresponds to the OpenVG function +-- @vgPaintPattern@.+--+paintPattern :: VGPaint -> VGImage -> IO ()+paintPattern = vgPaintPattern+++-- | Define colours for source pixels that lie outside the source+-- image.+-- data TilingMode =       TFill    | TPad@@ -200,24 +322,21 @@    | TReflect    deriving ( Eq, Ord, Show )     --- | Control the @TilingMode@ of the supplied handle, --- the default value is @TFill@ aka VG_TILE_FILL.+-- | Set the tiling mode of the supplied handle.+-- +-- 'tilingMode' is a write-only state variable +-- corresponding to @VG_PAINT_PATTERN_TILING_MODE@.+--+-- The default value is @TFill@ aka VG_TILE_FILL.+-- tilingMode :: VGPaint -> SettableStateVar TilingMode-tilingMode h = makeSettableStateVar $ -    \a -> setParameteri h vg_PAINT_PATTERN_TILING_MODE (enumValue a)-    +tilingMode h = let conv = fromIntegral . marshalTilingMode in+    makeSettableStateVar $+      setParameteri h vg_PAINT_PATTERN_TILING_MODE . conv     --- | Get the maximum number of ramp stops supported by the implementation.-maxStops :: GettableStateVar VGint -maxStops = makeGettableStateVar $ geti MaxColorRampStops  -       --- | @paintPattern@ - corresponds directly to the OpenVG call @vgPaintPattern@.-paintPattern :: VGPaint -> VGImage -> IO ()-paintPattern = vgPaintPattern - --------------------------------------------------------------------------------  @@ -225,12 +344,10 @@  marshalPaintType :: PaintType -> VGenum marshalPaintType x = case x of-    Color -> vg_PAINT_TYPE_COLOR+    Color          -> vg_PAINT_TYPE_COLOR     LinearGradient -> vg_PAINT_TYPE_LINEAR_GRADIENT     RadialGradient -> vg_PAINT_TYPE_RADIAL_GRADIENT-    Pattern -> vg_PAINT_TYPE_PATTERN--instance Marshal PaintType where marshal = marshalPaintType+    Pattern        -> vg_PAINT_TYPE_PATTERN   unmarshalPaintType :: VGenum -> PaintType@@ -241,22 +358,16 @@     | x == vg_PAINT_TYPE_PATTERN            = Pattern     | otherwise = error ("unmarshalPaintType: illegal value " ++ show x) -instance Unmarshal PaintType where unmarshal = unmarshalPaintType- marshalColorRampSpreadMode :: ColorRampSpreadMode -> VGenum marshalColorRampSpreadMode x = case x of -    CPad -> vg_COLOR_RAMP_SPREAD_PAD-    CRepeat -> vg_COLOR_RAMP_SPREAD_REPEAT+    CPad     -> vg_COLOR_RAMP_SPREAD_PAD+    CRepeat  -> vg_COLOR_RAMP_SPREAD_REPEAT     CReflect -> vg_COLOR_RAMP_SPREAD_REFLECT -instance Marshal ColorRampSpreadMode where marshal = marshalColorRampSpreadMode- marshalTilingMode :: TilingMode -> VGenum marshalTilingMode x = case x of-    TFill -> vg_TILE_FILL-    TPad -> vg_TILE_PAD-    TRepeat -> vg_TILE_REPEAT+    TFill    -> vg_TILE_FILL+    TPad     -> vg_TILE_PAD+    TRepeat  -> vg_TILE_REPEAT     TReflect -> vg_TILE_REFLECT-   -instance Marshal TilingMode where marshal = marshalTilingMode
src/Graphics/Rendering/OpenVG/VG/Parameters.hs view
@@ -8,7 +8,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 5 (Setting API Parameters) @@ -51,7 +51,9 @@  import Foreign.Marshal.Array ( newArray, peekArray )  -+-- | The parameter type of variables accessible with @vgSet@ +-- or @vgGet@.+--  data ParamType =       MatrixMode    | FillRule@@ -69,7 +71,6 @@    | StrokeDashPhaseReset    | TileFillColor    | ClearColor-   -- | GlyphOrigin        {- Not in shiva-vg -}     | Masking    | Scissoring    | PixelLayout@@ -90,121 +91,255 @@    | MaxGaussianStdDeviation    deriving ( Eq, Ord, Show ) +-- | Set a value of type 'VGfloat' within the current context.+--+-- 'setf' corresponds to the OpenVG function @vgSetf@.+--+-- > void vgSetf (VGParamType paramType, VGfloat value);+-- setf :: ParamType -> VGfloat -> IO ()-setf typ val = vgSetf (marshalParamType typ) val+setf typ = vgSetf $ marshalParamType typ +-- | Set a value of type 'VGint' within the current context.+--+-- 'seti' corresponds to the OpenVG function @vgSeti@.+--+-- > void vgSeti (VGParamType paramType, VGint value);+-- seti :: ParamType -> VGint -> IO ()-seti typ val = vgSeti (marshalParamType typ) val+seti typ = vgSeti $ marshalParamType typ --- vgSetfv :: VGenum -> VGint -> Ptr VGfloat -> IO ()--- TODO - Lists or arrays?+-- | Set a list of 'VGfloat' values within the current context.+--+-- 'setfv' corresponds to the OpenVG function @vgSetfv@.+--+-- > void vgSetfv(VGParamType paramType, VGint count, const VGfloat * values);+-- setfv :: ParamType -> [VGfloat] -> IO ()-setfv typ vals = do-    a <- newArray vals-    vgSetfv (marshalParamType typ) (fromIntegral $ length vals) a+setfv typ vals = newArray vals >>= +                 vgSetfv (marshalParamType typ) (fromIntegral $ length vals)     ++-- | Set a list of 'VGint' values within the current context.+--+-- 'setiv' corresponds to the OpenVG function @vgSetiv@.+--+-- > void vgSetiv(VGParamType paramType, VGint count, const VGint * values);+-- setiv :: ParamType -> [VGint] -> IO ()-setiv typ vals = do-    a <- newArray vals-    vgSetiv (marshalParamType typ) (fromIntegral $ length vals) a+setiv typ vals = newArray vals >>= +                 vgSetiv (marshalParamType typ) (fromIntegral $ length vals) -        ++++-- | Get a value of type 'VGfloat' from the current context.+--+-- 'getf' corresponds to the OpenVG function @vgGetf@.+--+-- > VGfloat vgGetf (VGParamType paramType);+--         getf :: ParamType -> IO VGfloat-getf typ = vgGetf (marshalParamType typ)+getf = vgGetf . marshalParamType +-- | Get a value of type 'VGint' from the current context.+--+-- 'geti' corresponds to the OpenVG function @vgGeti@.+--+-- > VGint vgGeti (VGParamType paramType);+--  geti :: ParamType -> IO VGint-geti typ = vgGeti (marshalParamType typ)+geti = vgGeti . marshalParamType  +-- | Get the maximum number of values that the respective 'getfv'+-- or 'getiv' call would return for the given 'ParamType'.+--+-- 'getVectorSize' corresponds to the OpenVG function +-- @vgGetVectorSize@.+--+-- > VGint vgGetVectorSize(VGParamType paramType);+--  getVectorSize :: ParamType -> IO VGint-getVectorSize typ = vgGetVectorSize (marshalParamType typ)+getVectorSize typ = vgGetVectorSize $ marshalParamType typ ++-- | Get a list of value of type 'VGfloat' from the current +-- context.+--+-- 'getfv' corresponds to the OpenVG function @vgGetfv@.+--+-- > void vgGetfv(VGParamType paramType, VGint count, VGfloat * values);+--  getfv :: ParamType -> VGint -> IO [VGfloat]-getfv typ i = do-    ptr <- vgGetfv (marshalParamType typ) i -    peekArray (fromIntegral i) ptr+getfv typ i = vgGetfv (marshalParamType typ) i >>= peekArray (fromIntegral i)     +-- | Get a list of value of type 'VGint' from the current +-- context.+--+-- 'getiv' corresponds to the OpenVG function @vgGetiv@.+--+-- > void vgGetiv(VGParamType paramType, VGint count, VGint * values);+--  getiv :: ParamType -> VGint -> IO [VGint]-getiv typ i = do-    ptr <- vgGetiv (marshalParamType typ) i -    peekArray (fromIntegral i) ptr+getiv typ i = vgGetiv (marshalParamType typ) i >>= peekArray (fromIntegral i)  +-- | Set the supplied parameter of the handle to a value of type+-- 'VGfloat'.+--+-- 'setParameterf' corresponds to the OpenVG function +-- @vgSetParameterf@.+--+-- > void vgSetParameterf (VGHandle object, VGint paramType, VGfloat value);+-- setParameterf :: VGHandle -> VGenum -> VGfloat -> IO () setParameterf = vgSetParameterf-                                 +++-- | Set the supplied parameter of the handle to a value of type+-- 'VGint'.+--+-- 'setParameteri' corresponds to the OpenVG function +-- @vgSetParameteri@.+--+-- > void vgSetParameteri (VGHandle object, VGint paramType, VGint value);+--                                  setParameteri :: VGHandle -> VGenum -> VGint -> IO () setParameteri = vgSetParameteri ++-- | Set the supplied parameter of the handle to the list of +-- supplied 'VGfloat' values.+--+-- 'setParameterfv' corresponds to the OpenVG function +-- @vgSetParameterfv@.+--+-- > void vgSetParameterfv(VGHandle object, VGint paramType, +-- >                       VGint count, const VGfloat * values);+-- setParameterfv :: VGHandle -> VGenum -> [VGfloat] -> IO ()-setParameterfv h typ vals = do-    a <- newArray vals-    vgSetParameterfv h typ (fromIntegral $ length vals) a+setParameterfv h typ vals = +    newArray vals >>= vgSetParameterfv h typ (fromIntegral $ length vals) ++-- | Set the supplied parameter of the handle to the list of +-- supplied 'VGint' values.+--+-- 'setParameteriv' corresponds to the OpenVG function +-- @vgSetParameteriv@.+--+-- > void vgSetParameteriv(VGHandle object, VGint paramType, +-- >                       VGint count, const VGint * values);+-- setParameteriv :: VGHandle -> VGenum -> [VGint] -> IO ()-setParameteriv h typ vals = do-    a <- newArray vals-    vgSetParameteriv h typ (fromIntegral $ length vals) a+setParameteriv h typ vals =+    newArray vals >>= vgSetParameteriv h typ (fromIntegral $ length vals) +++-- | Get the 'VGfloat' value of the parameter on the supplied +-- handle.+--+-- 'getParameterf' corresponds to the OpenVG function +-- @vgGetParameterf@.+--+-- > VGfloat vgGetParameterf (VGHandle object, VGint paramType);+-- getParameterf :: VGHandle -> VGenum -> IO VGfloat getParameterf = vgGetParameterf +-- | Get the 'VGint' value of the parameter on the supplied +-- handle.+--+-- 'getParameteri' corresponds to the OpenVG function +-- @vgGetParameteri@.+--+-- > VGint vgGetParameteri (VGHandle object, VGint paramType);+-- getParameteri :: VGHandle -> VGenum -> IO VGint getParameteri = vgGetParameteri -+-- | Get the maximum number of values that the respective +-- 'getParameterfv' or 'getParameteriv' call on the supplied +-- handle would return for the given 'ParamType'.+--+-- 'getParameterVectorSize' corresponds to the OpenVG function +-- @vgGetParameterVectorSize@.+--+-- > VGint vgGetParameterVectorSize (VGHandle object, VGint paramType);+--  getParameterVectorSize :: VGHandle -> VGenum -> IO VGint getParameterVectorSize = vgGetParameterVectorSize +-- | Get the list of 'VGfloat' values for the parameter on the +-- supplied handle.+--+-- 'getParameterfv' corresponds to the OpenVG function +-- @vgGetParameterfv@.+--+-- > void vgGetParameterfv(VGHandle object, +-- >                       VGint paramType, +-- >                       VGint count, VGfloat * values)+-- getParameterfv :: VGHandle -> VGenum -> VGint -> IO [VGfloat]-getParameterfv h typ i = do-    ptr <- vgGetParameterfv h typ i -    peekArray (fromIntegral i) ptr+getParameterfv h typ i = +    vgGetParameterfv h typ i >>= peekArray (fromIntegral i) ++-- | Get the list of 'VGint' values for the parameter on the +-- supplied handle.+--+-- 'getParameteriv' corresponds to the OpenVG function +-- @vgGetParameteriv@.+--+-- > void vgGetParameteriv(VGHandle object, +-- >                       VGint paramType, +-- >                       VGint count, VGint * values)+-- getParameteriv :: VGHandle -> VGenum -> VGint -> IO [VGint]-getParameteriv h typ i = do-    ptr <- vgGetParameteriv h typ i -    peekArray (fromIntegral i) ptr+getParameteriv h typ i =+    vgGetParameteriv h typ i >>= peekArray (fromIntegral i)                  --------------------------------------------------------------------------------          marshalParamType :: ParamType -> VGenum marshalParamType x = case x of-    MatrixMode -> vg_MATRIX_MODE -    FillRule -> vg_FILL_RULE-    ImageQuality -> vg_IMAGE_QUALITY-    RenderingQuality -> vg_RENDERING_QUALITY-    BlendMode -> vg_BLEND_MODE-    ImageMode -> vg_IMAGE_MODE-    ScissorRects -> vg_SCISSOR_RECTS-    StrokeLineWidth -> vg_STROKE_LINE_WIDTH-    StrokeCapStyle -> vg_STROKE_CAP_STYLE-    StrokeJoinStyle -> vg_STROKE_JOIN_STYLE-    StrokeMiterLimit -> vg_STROKE_MITER_LIMIT-    StrokeDashPattern -> vg_STROKE_DASH_PATTERN-    StrokeDashPhase -> vg_STROKE_DASH_PHASE -    StrokeDashPhaseReset -> vg_STROKE_DASH_PHASE_RESET-    TileFillColor -> vg_TILE_FILL_COLOR -    ClearColor -> vg_CLEAR_COLOR -    -- ParamGlyphOrigin -> vg_GLYPH_ORIGIN         {- Not in shiva-vg -}-    Masking -> vg_MASKING-    Scissoring -> vg_SCISSORING -    PixelLayout -> vg_PIXEL_LAYOUT-    ScreenLayout -> vg_SCREEN_LAYOUT -    FilterFormatLinear -> vg_FILTER_FORMAT_LINEAR+    MatrixMode                -> vg_MATRIX_MODE +    FillRule                  -> vg_FILL_RULE+    ImageQuality              -> vg_IMAGE_QUALITY+    RenderingQuality          -> vg_RENDERING_QUALITY+    BlendMode                 -> vg_BLEND_MODE+    ImageMode                 -> vg_IMAGE_MODE+    ScissorRects              -> vg_SCISSOR_RECTS+    StrokeLineWidth           -> vg_STROKE_LINE_WIDTH+    StrokeCapStyle            -> vg_STROKE_CAP_STYLE+    StrokeJoinStyle           -> vg_STROKE_JOIN_STYLE+    StrokeMiterLimit          -> vg_STROKE_MITER_LIMIT+    StrokeDashPattern         -> vg_STROKE_DASH_PATTERN+    StrokeDashPhase           -> vg_STROKE_DASH_PHASE +    StrokeDashPhaseReset      -> vg_STROKE_DASH_PHASE_RESET+    TileFillColor             -> vg_TILE_FILL_COLOR +    ClearColor                -> vg_CLEAR_COLOR +    -- ParamGlyphOrigin       -> vg_GLYPH_ORIGIN         {- Not in shiva-vg -}+    Masking                   -> vg_MASKING+    Scissoring                -> vg_SCISSORING +    PixelLayout               -> vg_PIXEL_LAYOUT+    ScreenLayout              -> vg_SCREEN_LAYOUT +    FilterFormatLinear        -> vg_FILTER_FORMAT_LINEAR     FilterFormatPremultiplied -> vg_FILTER_FORMAT_PREMULTIPLIED-    FilterChannelMask -> vg_FILTER_CHANNEL_MASK -    MaxScissorRects -> vg_MAX_SCISSOR_RECTS -    MaxDashCount -> vg_MAX_DASH_COUNT-    MaxKernelSize -> vg_MAX_KERNEL_SIZE-    MaxSaparableKernelSize -> vg_MAX_SEPARABLE_KERNEL_SIZE-    MaxColorRampStops -> vg_MAX_COLOR_RAMP_STOPS-    MaxImageWidth -> vg_MAX_IMAGE_WIDTH-    MaxImageHeight -> vg_MAX_IMAGE_HEIGHT-    MaxImagePixels -> vg_MAX_IMAGE_PIXELS-    MaxImageBytes -> vg_MAX_IMAGE_BYTES-    MaxFloat -> vg_MAX_FLOAT-    MaxGaussianStdDeviation -> vg_MAX_GAUSSIAN_STD_DEVIATION +    FilterChannelMask         -> vg_FILTER_CHANNEL_MASK +    MaxScissorRects           -> vg_MAX_SCISSOR_RECTS +    MaxDashCount              -> vg_MAX_DASH_COUNT+    MaxKernelSize             -> vg_MAX_KERNEL_SIZE+    MaxSaparableKernelSize    -> vg_MAX_SEPARABLE_KERNEL_SIZE+    MaxColorRampStops         -> vg_MAX_COLOR_RAMP_STOPS+    MaxImageWidth             -> vg_MAX_IMAGE_WIDTH+    MaxImageHeight            -> vg_MAX_IMAGE_HEIGHT+    MaxImagePixels            -> vg_MAX_IMAGE_PIXELS+    MaxImageBytes             -> vg_MAX_IMAGE_BYTES+    MaxFloat                  -> vg_MAX_FLOAT+    MaxGaussianStdDeviation   -> vg_MAX_GAUSSIAN_STD_DEVIATION   --------------------------------------------------------------------------------
src/Graphics/Rendering/OpenVG/VG/Paths.hs view
@@ -9,19 +9,26 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  HIGHLY UNSTABLE -- Portability :  GHC -- -- This module corresponds to section 8 (Paths)  -- of the OpenVG 1.0.1 specs. --+-- \*\* WARNING - this module is due to be changed significantly +-- in the next revision so that it is closer to the original +-- OpenVG API. --+-- This is unfortunate as the module defines the most significant +-- data types for vectors - the @Paths@. \*\*+--+-- --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VG.Paths (   -- * Datatypes   PathDatatype(..),-  PathType(..),+  PathAbsRel(..),   PathCommand(..),      @@ -74,7 +81,7 @@   import Graphics.Rendering.OpenVG.VG.BasicTypes ( -    VGenum, VGint, VGfloat, VGPath, marshalBool, unmarshalBool )+    VGenum, VGint, VGfloat, VGPath ) import Graphics.Rendering.OpenVG.VG.CFunDecls (      vgCreatePath, vgClearPath, vgDestroyPath,      vgRemovePathCapabilities, vgGetPathCapabilities, @@ -124,14 +131,15 @@     getParameteri, getParameterf, seti, setf, setfv, geti )           import Graphics.Rendering.OpenVG.VG.Utils ( -    Marshal(..), Unmarshal(..), unmarshalIntegral, enumValue, -    bitwiseOr, unbits )+    bitwiseOr, unbits32, marshalBool, unmarshalBool )  import Data.StateVar (     SettableStateVar, makeSettableStateVar,     GettableStateVar, makeGettableStateVar,     ( $= ) )  +import Control.Applicative+import Control.Monad import Data.Int ( Int8, Int16, Int32 ) import Foreign.Marshal.Array ( newArray ) import Foreign.Storable ( Storable )@@ -139,8 +147,9 @@ -------------------------------------------------------------------------------- -- Datatypes --- | @PathDatatype@ defines the permissible numeric types for path --- coordinate data.     +-- | 'PathDatatype' enumerates the available numeric types for +-- path coordinate data.     +-- data PathDatatype =      Int8    | Int16@@ -148,16 +157,17 @@    | Float    deriving ( Eq, Ord, Show ) --- | @PathType@ corresponds to the OpenVG enumeration @VGPathAbsRel@. -data PathType = -      Absolute+-- | 'PathAbsRel' enumerates the path addressing types, +-- @absolute@ or @relative@. +data PathAbsRel = +     Absolute    | Relative    deriving ( Eq, Ord, Show )  -- There is no Haskell equivalent to @VGPathSegment@.  -- It is subsumed by PathCommand  --- | @PathCommand@ corresponds to the OpenVG enumeration @VGPathCommand@,+-- | 'PathCommand' corresponds to the OpenVG enumeration @VGPathCommand@, -- but includes ClosePath aka @VG_CLOSE_PATH@.       data PathCommand =       ClosePath@@ -212,9 +222,14 @@   -- | @withPath@ - create a path, run an action on it, destroy the path.-withPath :: PathDatatype -> VGfloat -> VGfloat-                 -> VGint -> VGint -> [PathCapabilities]-                 -> (VGPath -> IO a) -> IO a+withPath :: PathDatatype +         -> VGfloat +         -> VGfloat+         -> VGint +         -> VGint +         -> [PathCapabilities]+         -> (VGPath -> IO a) +         -> IO a withPath typ scl bi sch cch cs action = do     path  <- createPath typ scl bi sch cch cs     ans   <- action path@@ -225,19 +240,26 @@ -- | @createPath@ - corresponds to the OpenVG function @vgCreatePath@. -- @createPath@ can only create paths in the standard format  -- (VG_PATH_FORMAT_STANDARD), extensions are not supported.   -createPath :: PathDatatype -> VGfloat -> VGfloat-                 -> VGint -> VGint -> [PathCapabilities] -> IO VGPath+createPath :: PathDatatype +           -> VGfloat +           -> VGfloat+           -> VGint +           -> VGint +           -> [PathCapabilities] +           -> IO VGPath createPath typ scl bi sch cch cs = -    vgCreatePath fmt (marshal typ) scl bi sch cch (bitwiseOr cs)+    vgCreatePath fmt (marshalPathDatatype typ) scl bi sch cch caps   where     -- Other paths formats maybe defined as extensions, for the present     -- restrict the format to just VG_PATH_FORMAT_STANDARD -    fmt :: VGint-    fmt = vg_PATH_FORMAT_STANDARD+    fmt   :: VGint+    fmt   = vg_PATH_FORMAT_STANDARD+    caps  = bitwiseOr marshalPathCapabilities cs +  -- | @clearPath@ corresponds to the OpenVG function @vgClearPath@.          clearPath :: VGPath -> [PathCapabilities] -> IO ()-clearPath h cs = vgClearPath h (bitwiseOr cs)+clearPath h = vgClearPath h . bitwiseOr marshalPathCapabilities  -- | @destroyPath@ corresponds to the OpenVG function @vgDestroyPath@.  destroyPath :: VGPath -> IO ()@@ -249,34 +271,28 @@ -- | @format@ - get the path format. Currently the only supported  -- format is @VG_PATH_FORMAT_STANDARD@ - 0.  format :: VGPath -> GettableStateVar VGint-format h = makeGettableStateVar $-    getParameteri h vg_PATH_FORMAT+format = makeGettableStateVar . flip getParameteri vg_PATH_FORMAT  -- | @datatype@ - get the PathDatatype. datatype :: VGPath -> GettableStateVar PathDatatype-datatype h = makeGettableStateVar $ do-    a <- getParameteri h vg_PATH_DATATYPE-    return $ unmarshalIntegral a+datatype = makeGettableStateVar . liftM (unmarshalPathDatatype . fromIntegral)  +                                . (getParameteri `flip` vg_PATH_DATATYPE)  -- | @pathScale@ - get the scaling factor of the path.     pathScale :: VGPath -> GettableStateVar VGfloat-pathScale h = makeGettableStateVar $-    getParameterf h vg_PATH_SCALE+pathScale = makeGettableStateVar . flip getParameterf vg_PATH_SCALE  -- | @bias@ - get the bias factor of the path.  bias :: VGPath -> GettableStateVar VGfloat-bias h = makeGettableStateVar $-    getParameterf h vg_PATH_BIAS+bias = makeGettableStateVar . flip getParameterf vg_PATH_BIAS  -- | @numSegments@ - get the number of segments stored in the path.      numSegments :: VGPath -> GettableStateVar VGint -numSegments h = makeGettableStateVar $-    getParameteri h vg_PATH_NUM_SEGMENTS+numSegments = makeGettableStateVar . flip getParameteri vg_PATH_NUM_SEGMENTS  -- | @numSegments@ - get the total number of coordinates stored in the path.  numCoords :: VGPath -> GettableStateVar VGint -numCoords h = makeGettableStateVar $-    getParameteri h vg_PATH_NUM_COORDS+numCoords = makeGettableStateVar . flip getParameteri vg_PATH_NUM_COORDS      --------------------------------------------------------------------------------@@ -285,14 +301,14 @@ -- | @getPathCapabilities@ corresponds to the OpenVG  -- function @vgGetPathCapabilities@.  getPathCapabilities :: VGPath -> IO [PathCapabilities]-getPathCapabilities h = do -    b <- vgGetPathCapabilities h-    return $ unbits b+getPathCapabilities h = +    unbits32 unmarshalPathCapabilities <$> vgGetPathCapabilities h      -- | @removePathCapabilities@ corresponds to the OpenVG  -- function @vgRemovePathCapabilities@.   removePathCapabilities :: VGPath -> [PathCapabilities] -> IO ()-removePathCapabilities h cs = vgRemovePathCapabilities h (bitwiseOr cs)+removePathCapabilities h =+     vgRemovePathCapabilities h . bitwiseOr marshalPathCapabilities  -------------------------------------------------------------------------------- -- Copying data between paths@@ -316,7 +332,7 @@ -- | @appendPathData@ - TODO is this implementation valid? appendPathData :: StorablePathData a => VGPath -> [PathCommand] -> [a] -> IO () appendPathData h cs ds = do -    cmd_arr <- newArray (map (fromIntegral . marshal) cs)+    cmd_arr <- newArray (map (fromIntegral . marshalPathCommand) cs)     d_arr   <- newArray ds     vgAppendPathData h (fromIntegral $ length cs) cmd_arr d_arr @@ -327,9 +343,8 @@ -- | @modifyPathCoords@ corresponds to the OpenVG  -- function @vgModifyPathCoords@.  modifyPathCoords :: StorablePathData a => VGPath -> VGint -> [a] -> IO ()-modifyPathCoords h start ds = do-    d_arr   <- newArray ds-    vgModifyPathCoords h start (fromIntegral $ length ds) d_arr+modifyPathCoords h start ds = +    newArray ds >>= vgModifyPathCoords h start (fromIntegral $ length ds)       -------------------------------------------------------------------------------- -- Transforming a path@@ -348,9 +363,8 @@ -------------------------------------------------------------------------------- -- Interpolating between paths interpolatePath :: VGPath -> VGPath -> VGPath -> VGfloat -> IO Bool-interpolatePath dst start end amount = do -    a <- vgInterpolatePath dst start end amount-    return $ unmarshalBool a+interpolatePath dst start end amount =+    unmarshalBool <$> vgInterpolatePath dst start end amount             --------------------------------------------------------------------------------@@ -358,8 +372,7 @@  -- | Set the line width. lineWidth :: SettableStateVar VGfloat-lineWidth = makeSettableStateVar $ \a -> -    setf StrokeLineWidth a+lineWidth = makeSettableStateVar $ setf StrokeLineWidth  -- | @CapStyle@ corresponds to the OpenVG enumeration @VGCapStyle@.    data CapStyle = @@ -371,8 +384,8 @@     -- | Set the end cap style. capStyle :: SettableStateVar CapStyle-capStyle = makeSettableStateVar $ \a -> -    seti StrokeCapStyle (enumValue a)+capStyle = makeSettableStateVar $+    seti StrokeCapStyle . fromIntegral . marshalCapStyle  -- | @JoinStyle@ corresponds to the OpenVG enumeration @VGJoinStyle@.   data JoinStyle = @@ -383,21 +396,20 @@     -- | Set the join style.     joinStyle :: SettableStateVar JoinStyle-joinStyle = makeSettableStateVar $ \a -> -    seti StrokeJoinStyle (enumValue a)+joinStyle = makeSettableStateVar $  +    seti StrokeJoinStyle . fromIntegral . marshalJoinStyle  -- | Set the miter limit.  miterLimit :: SettableStateVar VGfloat-miterLimit = makeSettableStateVar $ \a -> setf StrokeMiterLimit a+miterLimit = makeSettableStateVar $ setf StrokeMiterLimit  -- | Get the maximum dash count supported by the implementation. maxDashCount :: GettableStateVar VGint -maxDashCount = makeGettableStateVar $-    geti MaxDashCount+maxDashCount = makeGettableStateVar $ geti MaxDashCount  -- | Set the dash pattern. dashPattern :: SettableStateVar [VGfloat]-dashPattern = makeSettableStateVar $ \a -> setfv StrokeDashPattern a+dashPattern = makeSettableStateVar $ setfv StrokeDashPattern  -- | Disable the dash pattern. disableDashPattern :: IO ()@@ -405,13 +417,12 @@  -- | Set the dash phase. dashPhase :: SettableStateVar VGfloat-dashPhase = makeSettableStateVar $ \a -> -    setf StrokeDashPhase a+dashPhase = makeSettableStateVar $ setf StrokeDashPhase  -- | Reset the dash phase.     dashPhaseReset :: SettableStateVar Bool-dashPhaseReset = makeSettableStateVar $ \a -> -    seti StrokeDashPhaseReset (marshalBool a)+dashPhaseReset = +    makeSettableStateVar $ seti StrokeDashPhaseReset . marshalBool  --------------------------------------------------------------------------------     -- Filling or stroking a path@@ -424,8 +435,7 @@  -- | Set the fill rule.    fillRule :: SettableStateVar FillRule-fillRule = makeSettableStateVar $ \a -> -    seti FillRule (fromIntegral $ marshalFillRule a)+fillRule = makeSettableStateVar $ seti FillRule . fromIntegral . marshalFillRule  -- | @PaintMode@ corresponds to the OpenVG enumeration @VGPaintMode@.  data PaintMode =@@ -435,30 +445,29 @@  -- | @drawPath@ corresponds to the OpenVG function @vgDrawPath@.     drawPath :: VGPath -> [PaintMode] -> IO ()-drawPath h ps = vgDrawPath h (bitwiseOr ps)+drawPath h = vgDrawPath h . bitwiseOr marshalPaintMode  -- | Fill a path. fillPath :: VGPath -> IO ()-fillPath h = drawPath h [FillPath]+fillPath = drawPath `flip` [FillPath]  -- | Stroke a path. strokePath :: VGPath -> IO ()-strokePath h = drawPath h [StrokePath]+strokePath = drawPath `flip` [StrokePath]  -- | Fill and stroke a path. fillStrokePath :: VGPath -> IO ()-fillStrokePath h = drawPath h [FillPath, StrokePath]+fillStrokePath = drawPath `flip` [FillPath, StrokePath]   --------------------------------------------------------------------------------  marshalPathDatatype :: PathDatatype -> VGenum marshalPathDatatype x = case x of-    Int8 -> vg_PATH_DATATYPE_S_8+    Int8  -> vg_PATH_DATATYPE_S_8     Int16 -> vg_PATH_DATATYPE_S_16     Int32 -> vg_PATH_DATATYPE_S_32     Float -> vg_PATH_DATATYPE_F -instance Marshal PathDatatype where marshal = marshalPathDatatype  unmarshalPathDatatype :: VGenum -> PathDatatype   unmarshalPathDatatype x@@ -468,57 +477,53 @@     | x == vg_PATH_DATATYPE_F     = Float          | otherwise = error ("unmarshalPathDatatype: illegal value " ++ show x) -instance Unmarshal PathDatatype where unmarshal = unmarshalPathDatatype  - marshalPathCommand :: PathCommand -> VGenum marshalPathCommand x = case x of-    ClosePath -> vg_CLOSE_PATH-    MoveToAbs -> vg_MOVE_TO_ABS-    MoveToRel -> vg_MOVE_TO_REL-    LineToAbs -> vg_LINE_TO_ABS-    LineToRel -> vg_LINE_TO_REL-    HLineToAbs -> vg_HLINE_TO_ABS-    HLineToRel -> vg_HLINE_TO_REL-    VLineToAbs -> vg_VLINE_TO_ABS-    VLineToRel -> vg_VLINE_TO_REL-    QuadToAbs -> vg_QUAD_TO_ABS-    QuadToRel -> vg_QUAD_TO_REL-    CubicToAbs -> vg_CUBIC_TO_ABS-    CubicToRel -> vg_CUBIC_TO_REL-    SQuadToAbs -> vg_SQUAD_TO_ABS-    SQuadToRel -> vg_SQUAD_TO_REL-    SCubicToAbs -> vg_SCUBIC_TO_ABS-    SCubicToRel -> vg_SCUBIC_TO_REL+    ClosePath    -> vg_CLOSE_PATH+    MoveToAbs    -> vg_MOVE_TO_ABS+    MoveToRel    -> vg_MOVE_TO_REL+    LineToAbs    -> vg_LINE_TO_ABS+    LineToRel    -> vg_LINE_TO_REL+    HLineToAbs   -> vg_HLINE_TO_ABS+    HLineToRel   -> vg_HLINE_TO_REL+    VLineToAbs   -> vg_VLINE_TO_ABS+    VLineToRel   -> vg_VLINE_TO_REL+    QuadToAbs    -> vg_QUAD_TO_ABS+    QuadToRel    -> vg_QUAD_TO_REL+    CubicToAbs   -> vg_CUBIC_TO_ABS+    CubicToRel   -> vg_CUBIC_TO_REL+    SQuadToAbs   -> vg_SQUAD_TO_ABS+    SQuadToRel   -> vg_SQUAD_TO_REL+    SCubicToAbs  -> vg_SCUBIC_TO_ABS+    SCubicToRel  -> vg_SCUBIC_TO_REL     SCCWArcToAbs -> vg_SCCWARC_TO_ABS     SCCWArcToRel -> vg_SCCWARC_TO_REL-    SCWArcToAbs -> vg_SCWARC_TO_ABS-    SCWArcToRel -> vg_SCWARC_TO_REL+    SCWArcToAbs  -> vg_SCWARC_TO_ABS+    SCWArcToRel  -> vg_SCWARC_TO_REL     LCCWArcToAbs -> vg_LCCWARC_TO_ABS     LCCWArcToRel -> vg_LCCWARC_TO_REL-    LCWArcToAbs -> vg_LCWARC_TO_ABS-    LCWArcToRel -> vg_LCWARC_TO_REL+    LCWArcToAbs  -> vg_LCWARC_TO_ABS+    LCWArcToRel  -> vg_LCWARC_TO_REL -instance Marshal PathCommand where marshal = marshalPathCommand        marshalPathCapabilities :: PathCapabilities -> VGenum marshalPathCapabilities x = case x of -    AppendFrom -> vg_PATH_CAPABILITY_APPEND_FROM-    AppendTo -> vg_PATH_CAPABILITY_APPEND_TO-    Modify -> vg_PATH_CAPABILITY_MODIFY-    TransformFrom -> vg_PATH_CAPABILITY_TRANSFORM_FROM-    TransformTo -> vg_PATH_CAPABILITY_TRANSFORM_TO-    InterpolateFrom -> vg_PATH_CAPABILITY_INTERPOLATE_FROM-    InterpolateTo -> vg_PATH_CAPABILITY_INTERPOLATE_TO-    PathLength -> vg_PATH_CAPABILITY_PATH_LENGTH-    PointAlongPath -> vg_PATH_CAPABILITY_POINT_ALONG_PATH-    TangentAlongPath -> vg_PATH_CAPABILITY_TANGENT_ALONG_PATH-    PathBounds -> vg_PATH_CAPABILITY_PATH_BOUNDS+    AppendFrom           -> vg_PATH_CAPABILITY_APPEND_FROM+    AppendTo             -> vg_PATH_CAPABILITY_APPEND_TO+    Modify               -> vg_PATH_CAPABILITY_MODIFY+    TransformFrom        -> vg_PATH_CAPABILITY_TRANSFORM_FROM+    TransformTo          -> vg_PATH_CAPABILITY_TRANSFORM_TO+    InterpolateFrom      -> vg_PATH_CAPABILITY_INTERPOLATE_FROM+    InterpolateTo        -> vg_PATH_CAPABILITY_INTERPOLATE_TO+    PathLength           -> vg_PATH_CAPABILITY_PATH_LENGTH+    PointAlongPath       -> vg_PATH_CAPABILITY_POINT_ALONG_PATH+    TangentAlongPath     -> vg_PATH_CAPABILITY_TANGENT_ALONG_PATH+    PathBounds           -> vg_PATH_CAPABILITY_PATH_BOUNDS     PathTransfomedBounds -> vg_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS-    CapabilityAll -> vg_PATH_CAPABILITY_ALL+    CapabilityAll        -> vg_PATH_CAPABILITY_ALL -instance Marshal PathCapabilities where marshal = marshalPathCapabilities       unmarshalPathCapabilities :: VGenum -> PathCapabilities  unmarshalPathCapabilities x@@ -537,15 +542,13 @@     | x == vg_PATH_CAPABILITY_ALL                     = CapabilityAll      | otherwise = error ("unmarshalPathCapabilities: illegal value " ++ show x)         -instance Unmarshal PathCapabilities where unmarshal = unmarshalPathCapabilities   marshalCapStyle :: CapStyle -> VGenum marshalCapStyle x = case x of-    CButt -> vg_CAP_BUTT-    CRound -> vg_CAP_ROUND+    CButt   -> vg_CAP_BUTT+    CRound  -> vg_CAP_ROUND     CSquare -> vg_CAP_SQUARE -instance Marshal CapStyle where marshal = marshalCapStyle      marshalJoinStyle :: JoinStyle -> VGenum marshalJoinStyle x = case x of@@ -553,7 +556,6 @@     JRound -> vg_JOIN_ROUND      JBevel -> vg_JOIN_BEVEL -instance Marshal JoinStyle where marshal = marshalJoinStyle  marshalFillRule :: FillRule -> VGenum marshalFillRule x = case x of @@ -563,14 +565,14 @@ marshalPaintMode :: PaintMode -> VGenum      marshalPaintMode x = case x of      StrokePath -> vg_STROKE_PATH-    FillPath -> vg_FILL_PATH+    FillPath   -> vg_FILL_PATH++{-      unmarshalPaintMode :: VGenum -> PaintMode  unmarshalPaintMode x     | x == vg_STROKE_PATH         = StrokePath      | x == vg_FILL_PATH           = FillPath      | otherwise = error ("unmarshalPaintMode: illegal value " ++ show x)--instance Marshal PaintMode where marshal = marshalPaintMode-instance Unmarshal PaintMode where unmarshal = unmarshalPaintMode+-}
src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 6 (Rendering Quality and Antialiasing) @@ -60,35 +60,43 @@ import Graphics.Rendering.OpenVG.VG.Parameters (      ParamType ( MatrixMode, RenderingQuality, ScreenLayout ),      seti, geti  )-import Graphics.Rendering.OpenVG.VG.Utils ( -    Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral )  import Data.StateVar (     StateVar(), makeStateVar, SettableStateVar, makeSettableStateVar )    +import Control.Applicative import Foreign.Ptr ( Ptr )      -------------------------------------------------------------------------------- -- Rendering quality                      --- | @RenderingQuality@ corresponds to the OpenVG --- enumeration @VGRenderingQuality@. +-- | 'RenderingQuality' enumerates the settings available for+-- rendering quality. +--  data RenderingQuality =       Nonantialiased'    | Faster'    | Better'    deriving ( Eq, Ord, Show ) --- | Set the rendering quality - the default is /Better/.+-- | Set the rendering quality.+--+-- 'renderingQuality' is a write-only state variable corresponding to+-- @VG_RENDERING_QUALITY@:+--+-- The default value for 'renderingQuality' is @Better\'@.+-- renderingQuality :: SettableStateVar RenderingQuality  -renderingQuality = makeSettableStateVar $ \mode -> -    seti RenderingQuality (enumValue mode) +renderingQuality = makeSettableStateVar $+    seti RenderingQuality . fromIntegral . marshalRenderingQuality      -------------------------------------------------------------------------------- -- Additional quality settings  --- | @PixelLayout@ corresponds to the OpenVG enumeration @VGPixelLayout@.  +-- | 'PixelLayout' enumerates the possible geometric layouts of +-- color emissions within pixel elements.+-- data PixelLayout =       Unknown    | RgbVertical@@ -97,22 +105,24 @@    | BgrHorizontal    deriving ( Eq, Ord, Show ) --- | @pixelLayout@ - a @StateVar@ to get and set the pixel layout.+-- | Set and query the pixel layout.+--+-- 'pixelLayout' is a read-write state variable corresponding to+-- @VG_PIXEL_LAYOUT@.+-- pixelLayout :: StateVar PixelLayout pixelLayout = makeStateVar getPixelLayout setPixelLayout   where     getPixelLayout :: IO PixelLayout-    getPixelLayout = do-        a <- geti ScreenLayout -        return $ unmarshalIntegral a+    getPixelLayout = unmarshalPixelLayout . fromIntegral <$> geti ScreenLayout              setPixelLayout :: PixelLayout -> IO ()  -    setPixelLayout a = seti ScreenLayout (enumValue a)  +    setPixelLayout = seti ScreenLayout . fromIntegral . marshalPixelLayout      -------------------------------------------------------------------------------- -- Matrix manipulation --- | @MatrixMode@ corresponds to the OpenVG  enumeration @VGMatrixMode@.  +-- | 'MatrixMode' enumerates the manipulable matrices.   data MatrixMode =      PathUserToSurface    | ImageUserToSurface@@ -121,39 +131,77 @@    deriving ( Eq, Ord, Show )     -- | Set the matrix mode.+--+-- 'matrixMode' is a write-only state variable corresponding to+-- @VG_MATRIX_MODE@:+-- matrixMode :: SettableStateVar MatrixMode  -matrixMode = makeSettableStateVar $ \mode -> -    seti MatrixMode (enumValue mode) +matrixMode = makeSettableStateVar $  +    seti MatrixMode . fromIntegral . marshalMatrixMode --- | @loadIdentity@ corresponds to the OpenVG function @vgLoadIdentity@. +-- | Set the current matrix to the identity matrix.+--+-- 'loadIdentity' corresponds to the OpenVG function +-- @vgLoadIdentity@. +-- loadIdentity :: IO () loadIdentity = vgLoadIdentity --- | @loadMatrix@ corresponds to the OpenVG function @vgLoadMatrix@. +-- | Set the current matrix to the supplied matrix.+--+-- 'loadMatrix' corresponds to the OpenVG function @vgLoadMatrix@.+-- +-- \*\* Note - this function has an unfortunate type and should+-- be wrapped. \*\* +-- loadMatrix :: Ptr VGfloat -> IO () loadMatrix = vgLoadMatrix --- | @getMatrix@ - TODO.+-- | Get the current matrix.+--+-- 'getMatrix' corresponds to the OpenVG function @vgGetMatrix@.+-- +-- \*\* Note - this function has an unfortunate type and should+-- be wrapped. \*\* +-- getMatrix :: IO (Ptr VGfloat) getMatrix = vgGetMatrix --- | @multMatrix@ - TODO.+-- | Multiply the current matrix by the supplied matrix.+-- +-- 'multMatrix' corresponds to the OpenVG function @vgMultMatrix@.+-- +-- \*\* Note - this function has an unfortunate type and should+-- be wrapped. \*\* +-- multMatrix :: Ptr VGfloat -> IO () multMatrix = vgMultMatrix --- | @translate@ corresponds to the OpenVG function @vgTranslate@. +-- | Apply a translation to the current matrix.+--+-- 'translate' corresponds to the OpenVG function @vgTranslate@. +-- translate :: VGfloat -> VGfloat -> IO () translate = vgTranslate --- | @scale@ corresponds to the OpenVG function @vgScale@. +-- | Apply a scaling to the current matrix.+--+-- 'scale' corresponds to the OpenVG function @vgScale@. +-- scale :: VGfloat -> VGfloat -> IO () scale = vgScale --- | @shear@ corresponds to the OpenVG function @vgShear@.     +-- | Apply a shear to the current matrix.+--+-- 'shear' corresponds to the OpenVG function @vgShear@.+-- shear :: VGfloat -> VGfloat -> IO () shear = vgShear --- | @rotate@ corresponds to the OpenVG function @vgRotate@.     +-- | Apply a rotation to the current matrix.+--+-- 'rotate' corresponds to the OpenVG function @vgRotate@.+-- rotate :: VGfloat -> IO () rotate = vgRotate         @@ -163,20 +211,18 @@ marshalRenderingQuality :: RenderingQuality -> VGenum marshalRenderingQuality x = case x of     Nonantialiased' -> vg_RENDERING_QUALITY_NONANTIALIASED  -    Faster' -> vg_RENDERING_QUALITY_FASTER-    Better' -> vg_RENDERING_QUALITY_BETTER+    Faster'         -> vg_RENDERING_QUALITY_FASTER+    Better'         -> vg_RENDERING_QUALITY_BETTER -instance Marshal RenderingQuality where marshal = marshalRenderingQuality  marshalPixelLayout :: PixelLayout -> VGenum marshalPixelLayout x = case x of-    Unknown -> vg_PIXEL_LAYOUT_UNKNOWN-    RgbVertical -> vg_PIXEL_LAYOUT_RGB_VERTICAL-    BgrVertical -> vg_PIXEL_LAYOUT_BGR_VERTICAL+    Unknown       -> vg_PIXEL_LAYOUT_UNKNOWN+    RgbVertical   -> vg_PIXEL_LAYOUT_RGB_VERTICAL+    BgrVertical   -> vg_PIXEL_LAYOUT_BGR_VERTICAL     RgbHorizontal -> vg_PIXEL_LAYOUT_RGB_HORIZONTAL     BgrHorizontal -> vg_PIXEL_LAYOUT_BGR_HORIZONTAL -instance Marshal PixelLayout where marshal = marshalPixelLayout   unmarshalPixelLayout :: VGenum -> PixelLayout @@ -188,14 +234,12 @@     | x == vg_PIXEL_LAYOUT_BGR_HORIZONTAL = BgrHorizontal      | otherwise = error ("unmarshalPixelLayout: illegal value " ++ show x)     -instance Unmarshal PixelLayout where unmarshal = unmarshalPixelLayout      marshalMatrixMode :: MatrixMode -> VGenum marshalMatrixMode x = case x of -    PathUserToSurface -> vg_MATRIX_PATH_USER_TO_SURFACE+    PathUserToSurface  -> vg_MATRIX_PATH_USER_TO_SURFACE     ImageUserToSurface -> vg_MATRIX_IMAGE_USER_TO_SURFACE-    FillPaintToUser -> vg_MATRIX_FILL_PAINT_TO_USER-    StrokePaintToUser -> vg_MATRIX_STROKE_PAINT_TO_USER+    FillPaintToUser    -> vg_MATRIX_FILL_PAINT_TO_USER+    StrokePaintToUser  -> vg_MATRIX_STROKE_PAINT_TO_USER     -instance Marshal MatrixMode where marshal = marshalMatrixMode
src/Graphics/Rendering/OpenVG/VG/Scissoring.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 7 (Scissoring, Masking and Clearing) @@ -32,14 +32,15 @@   clear   ) where -import Graphics.Rendering.OpenVG.VG.BasicTypes ( -    VGint, VGfloat, marshalBool, unSize )+import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGint, VGfloat ) import Graphics.Rendering.OpenVG.VG.CFunDecls ( vgClear ) import Graphics.Rendering.OpenVG.VG.Parameters (      ParamType ( Scissoring, ScissorRects, MaxScissorRects,                  Masking, ClearColor ),        seti, geti, setiv, setfv ) +import Graphics.Rendering.OpenVG.VG.Utils ( unSize, unSizeM, marshalBool )+ import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) ) import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) ) @@ -52,18 +53,30 @@ -- Scissoring  -- | Enable or disable scissoring.+--+-- 'scissoring' is a write-only state variable corresponding to+-- @VG_SCISSORING@.+-- scissoring :: SettableStateVar Bool  -scissoring = makeSettableStateVar $ \a -> -    seti Scissoring (fromIntegral $ marshalBool a) +scissoring = makeSettableStateVar $ +    seti Scissoring . fromIntegral . marshalBool  type ScissorRect = (Position, Size)       -- | Get the maximum number of scissoring rectangles.+--+-- 'maxScissorRects' is a read-only state variable corresponding +-- to @VG_MAX_SCISSOR_RECTS@ +-- maxScissorRects :: GettableStateVar VGint maxScissorRects = makeGettableStateVar $ geti MaxScissorRects   -- | Specify the scissoring rectangles.+--+-- 'scissorRects' is a write-only state variable corresponding to +-- @VG_SCISSOR_RECTS@.+-- scissorRects :: SettableStateVar [ScissorRect] scissorRects = makeSettableStateVar $ \ss ->     setiv ScissorRects (foldr f [] ss) where @@ -72,7 +85,7 @@ -------------------------------------------------------------------------------- -- Alpha masking --- | @MaskOperation@ corresponds to the OpenVG enumeration @VGMaskOperation@.    +-- | 'MaskOperation' enumerations the possible mask operations.     data MaskOperation =      ClearMask    | FillMask@@ -83,8 +96,11 @@    deriving ( Eq, Ord, Show )  -- | Enable or disable alpha masking.   +--+-- 'alphaMasking' is a write-only state variable.+-- alphaMasking :: SettableStateVar Bool-alphaMasking = makeSettableStateVar $ \a -> seti Masking (marshalBool a)  +alphaMasking = makeSettableStateVar $ seti Masking . marshalBool  -- vgMask not implemented in shiva-vg @@ -92,13 +108,21 @@ -- Fast clearing  -- | Set the color for clearing.+--+-- 'clearColor' is a write-only state variable corresponding to+-- @VG_CLEAR_COLOR@+-- clearColor :: SettableStateVar (Color4 VGfloat) clearColor = makeSettableStateVar $      \(Color4 r g b a) -> setfv ClearColor [r,g,b,a] --- | @clear@ corresponds to the OpenVG function @vgClear@.+-- | Fill the specified portion of the drawing surface with the+-- current clear color.+-- +-- 'clear' corresponds to the OpenVG function @vgClear@.+-- clear :: Position -> Size -> IO ()-clear (Position x y) sz = let (w,h) = unSize sz in vgClear x y w h+clear (Position x y) = unSizeM $ vgClear x y   --------------------------------------------------------------------------------
src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- Shiva extensions to replace EGL - see the README in the shiva-vg@@ -16,45 +16,53 @@ --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VG.ShivaExtensions (-  -- * ShivaVG extensions-  -  withContextSH, -  +  -- * ShivaVG extensions     createContextSH,   resizeSurfaceSH, -  destroyContextSH+  destroyContextSH,++  withContextSH+ ) where -import Graphics.Rendering.OpenVG.VG.BasicTypes ( vg_TRUE, unSize ) import Graphics.Rendering.OpenVG.VG.CFunDecls (          vgCreateContextSH, vgResizeSurfaceSH, vgDestroyContextSH )  +import Graphics.Rendering.OpenVG.VG.Utils ( unSizeM, unmarshalBool )++ import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) ) --- | Create an OpenVG context, if the creation is successful run the --- action (destroying the context afterwards). If the creation fails--- run the failureAction. -withContextSH :: Size -> (IO a) -> (IO a) -> IO a-withContextSH sz action failureAction = do-    okb <- createContextSH sz-    if okb then action >>= \ans -> destroyContextSH >> return ans-           else failureAction- +import Control.Applicative  --- | Create an OpenVG context on top of an already created OpenGL context.   ++-- | Create an OpenVG context on top of a previously created +-- OpenGL context.+-- createContextSH :: Size -> IO Bool-createContextSH sz = let (w,h) = unSize sz in do -    vgbool <- vgCreateContextSH w h-    if vgbool == vg_TRUE then return True else return False+createContextSH = unSizeM $ \w h -> unmarshalBool <$> vgCreateContextSH w h --- | @resizeSurfaceSH@ should be called whenever the size of the +-- | 'resizeSurfaceSH' should be called whenever the size of the  -- surface changes.    +-- resizeSurfaceSH :: Size -> IO ()-resizeSurfaceSH sz = let (w,h) = unSize sz in vgResizeSurfaceSH w h+resizeSurfaceSH = unSizeM vgResizeSurfaceSH  -- | Destroy the OpenVG context.+-- destroyContextSH :: IO () destroyContextSH = vgDestroyContextSH + ++-- | Create an OpenVG context, if the creation is successful run +-- the action and destroy the context afterwards. If the +-- creation fails run the failureAction. +-- +withContextSH :: Size -> (IO a) -> (IO a) -> IO a+withContextSH sz action failureAction = do+    okb <- createContextSH sz+    if okb then action >>= \ans -> destroyContextSH >> return ans+           else failureAction
src/Graphics/Rendering/OpenVG/VG/Utils.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS -Wall #-}  --------------------------------------------------------------------------------@@ -17,41 +16,60 @@ --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VG.Utils (-  Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral, -  bitwiseOr, unbits -) where+  marshalBool, unmarshalBool,+  bitwiseOr, unbits32,+  unSize, unSizeF, unSizeM +  ) where + import Graphics.Rendering.OpenVG.VG.BasicTypes ( -        VGint, VGenum, VGbitfield, -        marshalBool )+        VGint, VGenum, VGbitfield, VGboolean, vg_TRUE, vg_FALSE )++import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )++ import Data.Bits -class Marshal a where marshal :: a -> VGenum-class Unmarshal a where unmarshal :: VGenum -> a  -instance Marshal VGint where marshal = fromIntegral-instance Marshal Bool where marshal = fromIntegral . marshalBool -enumValue :: Marshal a => a -> VGint-enumValue = fromIntegral . marshal +marshalBool :: Bool -> VGboolean+marshalBool x = case x of+  True -> vg_TRUE+  False -> vg_FALSE -unmarshalIntegral :: (Integral a, Unmarshal b)  => a -> b-unmarshalIntegral = unmarshal . fromIntegral+unmarshalBool :: VGboolean -> Bool+unmarshalBool x+    | x == vg_TRUE  = True+    | x == vg_FALSE = False+    | otherwise = error ("unmarshalBool: illegal value " ++ show x)+    -bitwiseOr :: Marshal a => [a] -> VGbitfield-bitwiseOr = sum . map (fromIntegral . marshal) +bitwiseOr :: (a -> VGenum) ->  [a] -> VGbitfield+bitwiseOr fn = sum . map (fromIntegral . fn) --- not the world's best formulation...-unbits :: Unmarshal a => VGbitfield -> [a]-unbits bf = map unmarshal $ step bf 0 1 where-    step _ i _ | i > 32         = error $ "bomb"-    step a _ _ | a <= 0         = []-    step a i j | a `testBit` i  = j : step (a - fromIntegral j) (i+1) (j*2)-               | otherwise      = step a (i+1) (j*2) +-- unbits is not productive at every step so cannot be an unfold. +unbits32 :: (VGenum -> a) -> VGbitfield -> [a]+unbits32 fn field = step field (0::Int) where+    step a i | i >= 32        = []      -- should be unreachable anyway+             | a <= 0         = []+             | a `testBit` i  = (fn $ 2 ^ i) : step (a `clearBit` i) (i+1) +             | otherwise      = step a (i+1)+++-- Helper - unwrap Size++unSize :: Size -> (VGint,VGint)+unSize (Size w h) = (fromIntegral w, fromIntegral h)++unSizeF :: (VGint -> VGint -> a) -> Size -> a+unSizeF f (Size w h) = f (fromIntegral w) (fromIntegral h)++unSizeM :: Monad m => (VGint -> VGint -> m a) -> Size -> m a+unSizeM f (Size w h) = f (fromIntegral w) (fromIntegral h)
src/Graphics/Rendering/OpenVG/VGU.hs view
@@ -7,17 +7,15 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC ----- A Haskell binding for the OpenVG vector and raster graphics API.+-- Import (convenience) module for the VGU utility library module. -- --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VGU (-  module Graphics.Rendering.OpenVG.VGU.Errors,   module Graphics.Rendering.OpenVG.VGU.VGU ) where -import Graphics.Rendering.OpenVG.VGU.Errors import Graphics.Rendering.OpenVG.VGU.VGU
− src/Graphics/Rendering/OpenVG/VGU/Errors.hs 
@@ -1,37 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module      :  Graphics.Rendering.OpenVG.VG.Errors--- Copyright   :  (c) Stephen Tetley 2008, 2009--- License     :  BSD3------ Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable--- Portability :  GHC------ This module corresponds to section 4.1 (Errors) --- of the OpenVG 1.0.1 specs.-----------------------------------------------------------------------------------------module Graphics.Rendering.OpenVG.VGU.Errors (-   Error(..), ErrorCategory(..), errors-) where--import Graphics.Rendering.OpenVG.VGU.ErrorsInternal (-   Error(..), ErrorCategory(..), getErrors )-   -import Data.StateVar (-   GettableStateVar, makeGettableStateVar )-------------------------------------------------------------------------------------errors :: GettableStateVar [Error]-errors = makeGettableStateVar getErrors----
src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs view
@@ -10,67 +10,24 @@ -- Stability   :  highly unstable -- Portability :  GHC ----- This module corresponds to section 4.1 (Errors) --- of the OpenVG 1.0.1 specs.---+-- VGU error codes. --+-- Portions of code have been copied from +--  --------------------------------------------------------------------------------  module Graphics.Rendering.OpenVG.VGU.ErrorsInternal (-   Error(..), ErrorCategory(..), getErrors,-   recordErrorCode, recordBadHandle, recordIllegalArgument, recordOutOfMemory+   VGU_ErrorCode(..),+   withErrorCode,+   unmarshalErrorCode ) where -import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGenum ) -import Graphics.Rendering.OpenVG.VG.CFunDecls ( vgGetError )-import Graphics.Rendering.OpenVG.VG.Constants (-      vg_NO_ERROR, -      vg_BAD_HANDLE_ERROR, -      vg_ILLEGAL_ARGUMENT_ERROR,-      vg_OUT_OF_MEMORY_ERROR, -      vg_PATH_CAPABILITY_ERROR,-      vg_UNSUPPORTED_IMAGE_FORMAT_ERROR, -      vg_UNSUPPORTED_PATH_FORMAT_ERROR,-      vg_IMAGE_IN_USE_ERROR,-      vg_NO_CONTEXT_ERROR ) +import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGenum ) import Graphics.Rendering.OpenVG.VGU.CInternals -import Data.IORef ( IORef, newIORef, readIORef, writeIORef )-import System.IO.Unsafe ( unsafePerformIO )------------------------------------------------------------------------------------- Follow the convention of the OpenGL binding, both VG and VGU errors are --- handled in this module+import Control.Monad ( liftM )  ----------------------------------------------------------------------------------- | VG errors.--data VG_ErrorCode =-     VG_NoError-   | VG_BadHandle-   | VG_IllegalArgument-   | VG_OutOfMemory-   | VG_PathCapability-   | VG_UnsupportedImageFormat-   | VG_UnsupportedPathFormat-   | VG_ImageInUse-   | VG_NoContextError-   deriving ( Eq, Ord, Show )-   --vg_marshalErrorCode :: VG_ErrorCode -> VGenum-vg_marshalErrorCode x = case x of-    VG_NoError  -> vg_NO_ERROR-    VG_BadHandle -> vg_BAD_HANDLE_ERROR-    VG_IllegalArgument -> vg_ILLEGAL_ARGUMENT_ERROR-    VG_OutOfMemory -> vg_OUT_OF_MEMORY_ERROR-    VG_PathCapability -> vg_PATH_CAPABILITY_ERROR-    VG_UnsupportedImageFormat -> vg_UNSUPPORTED_IMAGE_FORMAT_ERROR-    VG_UnsupportedPathFormat -> vg_UNSUPPORTED_PATH_FORMAT_ERROR-    VG_ImageInUse -> vg_IMAGE_IN_USE_ERROR-    VG_NoContextError -> vg_NO_CONTEXT_ERROR-   --------------------------------------------------------------------------------- -- | VGU errors.         data VGU_ErrorCode = @@ -82,159 +39,17 @@    | VGU_BadWarp    deriving ( Eq, Ord, Show ) -vgu_marshalErrorCode :: VGU_ErrorCode -> VGenum-vgu_marshalErrorCode x = case x of-    VGU_NoError -> vgu_NO_ERROR-    VGU_BadHandle -> vgu_BAD_HANDLE_ERROR-    VGU_IllegalArgument -> vgu_ILLEGAL_ARGUMENT_ERROR-    VGU_OutOfMemory -> vgu_OUT_OF_MEMORY_ERROR-    VGU_PathCapability -> vgu_PATH_CAPABILITY_ERROR-    VGU_BadWarp -> vgu_BAD_WARP_ERROR -------------------------------------------------------------------------------------- | OpenVG errors have no error string - so this is slight different from --- HsOpenGL.--data Error = Error ErrorCategory-   deriving ( Eq, Ord, Show )-------------------------------------------------------------------------------------- | Ammalganted error categories--data ErrorCategory =-     BadHandle-   | IllegalArgument-   | OutOfMemory-   | PathCapability-   | UnsupportedImageFormat-   | UnsupportedPathFormat-   | ImageInUse-   | NoContextError-   | BadWarp-   deriving ( Eq, Ord, Show )--unmarshalErrorCategory :: VGenum -> ErrorCategory-unmarshalErrorCategory c-   | isBadHandle c                = BadHandle-   | isIllegalArgument c          = IllegalArgument-   | isOutOfMemory c              = OutOfMemory-   | isPathCapability c           = PathCapability-   | isUnsupportedImageFormat c   = UnsupportedImageFormat-   | isUnsupportedPathFormat c    = UnsupportedPathFormat-   | isImageInUse c               = ImageInUse-   | isNoContextError c           = NoContextError-   | isBadWarp c                  = BadWarp-   | otherwise = error "unmarshalErrorCategory"-   -   -isBadHandle :: VGenum -> Bool-isBadHandle c =-   c == vg_marshalErrorCode  VG_BadHandle ||-   c == vgu_marshalErrorCode VGU_BadHandle--isIllegalArgument :: VGenum -> Bool-isIllegalArgument c =-   c == vg_marshalErrorCode  VG_IllegalArgument ||-   c == vgu_marshalErrorCode VGU_IllegalArgument--isOutOfMemory :: VGenum -> Bool-isOutOfMemory c =-   c == vg_marshalErrorCode  VG_OutOfMemory ||-   c == vgu_marshalErrorCode VGU_OutOfMemory--isPathCapability :: VGenum -> Bool-isPathCapability c =-   c == vg_marshalErrorCode  VG_PathCapability ||-   c == vgu_marshalErrorCode VGU_PathCapability-      -isUnsupportedImageFormat :: VGenum -> Bool-isUnsupportedImageFormat c =-   c == vg_marshalErrorCode  VG_UnsupportedImageFormat-      -isUnsupportedPathFormat :: VGenum -> Bool-isUnsupportedPathFormat c =-   c == vg_marshalErrorCode  VG_UnsupportedPathFormat-        -isImageInUse :: VGenum -> Bool-isImageInUse c =-   c == vg_marshalErrorCode  VG_ImageInUse-   -isNoContextError :: VGenum -> Bool-isNoContextError c =-   c == vg_marshalErrorCode  VG_NoContextError-   -isBadWarp :: VGenum -> Bool-isBadWarp c =-   c == vgu_marshalErrorCode  VGU_BadWarp-------------------------------------------------------------------------------------- Unlike OpenGL, there is no error description string to inspect--makeError :: VGenum -> IO Error-makeError e = do-   let category = unmarshalErrorCategory e-   return $ Error category-   -      ------------------------------------------------------------------------------------- Verbatim from GLU ErrorsInternal just type names changed.--{-# NOINLINE theRecordedErrors #-}-theRecordedErrors :: IORef ([VGenum],Bool)-theRecordedErrors = unsafePerformIO (newIORef ([], True))--getRecordedErrors :: IO ([VGenum],Bool)-getRecordedErrors =  readIORef theRecordedErrors--setRecordedErrors :: ([VGenum],Bool) -> IO ()-setRecordedErrors = writeIORef theRecordedErrors-------------------------------------------------------------------------------------getVGErrors :: IO [VGenum]-getVGErrors = getVGErrorsAux []-   where getVGErrorsAux acc = do-            errorCode <- vgGetError-            if isError errorCode-               then getVGErrorsAux (errorCode : acc)-               else return $ reverse acc--isError :: VGenum -> Bool-isError = (/= vg_marshalErrorCode VG_NoError)+withErrorCode :: IO VGenum -> IO VGU_ErrorCode+withErrorCode f = liftM unmarshalErrorCode f   -----------------------------------------------------------------------------------getErrors :: IO [Error]-getErrors = do-   es <- getErrorCodesAux (const ([], True))-   mapM makeError es--recordErrorCode :: VGenum -> IO ()-recordErrorCode e = do-   getErrorCodesAux (\es -> (if null es then [e] else [], False))-   return ()--recordBadHandle :: IO ()-recordBadHandle = recordErrorCode (vg_marshalErrorCode VG_BadHandle)--recordIllegalArgument :: IO ()-recordIllegalArgument = recordErrorCode (vg_marshalErrorCode VG_IllegalArgument)--recordOutOfMemory :: IO ()-recordOutOfMemory = recordErrorCode (vg_marshalErrorCode VG_OutOfMemory)---- ToDo: Make this thread-safe-getErrorCodesAux :: ([VGenum] -> ([VGenum],Bool)) -> IO [VGenum]-getErrorCodesAux f = do-   (recordedErrors, useVGErrors) <- getRecordedErrors-   vgErrors <- getVGErrors-   let es = if useVGErrors then recordedErrors ++ vgErrors else recordedErrors-   setRecordedErrors (f es)-   return es+unmarshalErrorCode :: VGenum -> VGU_ErrorCode+unmarshalErrorCode x+    | x == vgu_NO_ERROR               = VGU_NoError+    | x == vgu_BAD_HANDLE_ERROR       = VGU_BadHandle+    | x == vgu_ILLEGAL_ARGUMENT_ERROR = VGU_IllegalArgument+    | x == vgu_OUT_OF_MEMORY_ERROR    = VGU_OutOfMemory+    | x == vgu_PATH_CAPABILITY_ERROR  = VGU_PathCapability+    | x == vgu_BAD_WARP_ERROR         = VGU_BadWarp+    | otherwise = error ("unmarshalErrorCode: illegal value " ++ show x)
src/Graphics/Rendering/OpenVG/VGU/VGU.hs view
@@ -7,7 +7,7 @@ -- License     :  BSD3 -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>--- Stability   :  highly unstable+-- Stability   :  unstable -- Portability :  GHC -- -- This module corresponds to section 16 (The VGU Utility Library) @@ -27,46 +27,65 @@ ) where  -import Graphics.Rendering.OpenVG.VG.BasicTypes ( -    VGfloat, VGenum, VGPath, marshalBool )+import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGfloat, VGenum, VGPath )+import Graphics.Rendering.OpenVG.VG.Utils ( marshalBool ) import Graphics.Rendering.OpenVG.VGU.CInternals-import Graphics.Rendering.OpenVG.VGU.ErrorsInternal ( recordErrorCode )+import Graphics.Rendering.OpenVG.VGU.ErrorsInternal ( +        VGU_ErrorCode, withErrorCode )++ import Foreign.Marshal.Array ( newArray ) -    -line :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat -> IO ()+-- | Append a line segment to a path.+--+line :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat -> IO VGU_ErrorCode line path x0 y0 x1 y1 = withErrorCode $ vguLine path x0 y0 x1 y1       -polygon :: VGPath -> [VGfloat] -> Bool -> IO ()+-- | Append a polyline or polygon to a path.+--+polygon :: VGPath -> [VGfloat] -> Bool -> IO VGU_ErrorCode polygon path pts closed = do     pts' <- newArray pts      withErrorCode $ vguPolygon path pts' (fromIntegral $ length pts)                                           (marshalBool closed)-            -rect :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat-               -> IO ()+           +-- | Append a rectangle with its lower left corner at @(x,y)@ +-- to a path.+--+rect :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat -> IO VGU_ErrorCode rect path x y w h = withErrorCode $ vguRect path x y w h ++-- | Append a rounded corner rectangle with its lower left +-- corner at @(x,y)@ to a path.+-- roundRect :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat-                    -> VGfloat -> VGfloat -                    -> IO ()+          -> VGfloat -> VGfloat +          -> IO VGU_ErrorCode roundRect path x y w h aw ah = withErrorCode $ vguRoundRect path x y w h aw ah ++-- | Append an ellipse to the path.+-- ellipse :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat -                  -> IO ()  +        -> IO VGU_ErrorCode   ellipse path cx cy w h = withErrorCode $ vguEllipse path cx cy w h  +-- | 'ArcType' enumerates the control styles of an arc.+-- data ArcType =     ArcOpen   | ArcChord   | ArcPie    deriving ( Eq, Ord, Show ) -arc :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat-           -> VGfloat -> VGfloat -> ArcType -           -> IO ()  +-- | Append an elliptical arc to a path.+--+arc :: VGPath  -> VGfloat -> VGfloat -> VGfloat -> VGfloat+    -> VGfloat -> VGfloat -> ArcType +    -> IO VGU_ErrorCode  arc path x y w h sa ae atyp =      withErrorCode $ vguArc path x y w h sa ae (marshalArcType atyp)            @@ -74,15 +93,10 @@  marshalArcType :: ArcType -> VGenum marshalArcType x = case x of -    ArcOpen -> vgu_ARC_OPEN+    ArcOpen  -> vgu_ARC_OPEN     ArcChord -> vgu_ARC_CHORD-    ArcPie -> vgu_ARC_PIE+    ArcPie   -> vgu_ARC_PIE  -- -withErrorCode :: IO VGenum -> IO ()-withErrorCode f = do -  a <- f-  recordErrorCode a-  return ()