diff --git a/Changes b/Changes new file mode 100644 --- /dev/null +++ b/Changes @@ -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 diff --git a/InstallWindows.txt b/InstallWindows.txt --- a/InstallWindows.txt +++ b/InstallWindows.txt @@ -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 diff --git a/NEWS b/NEWS deleted file mode 100644 --- a/NEWS +++ /dev/null @@ -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 diff --git a/OpenVG.cabal b/OpenVG.cabal --- a/OpenVG.cabal +++ b/OpenVG.cabal @@ -1,27 +1,50 @@ name: OpenVG -version: 0.3.0 +version: 0.4.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley maintainer: Stephen Tetley 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, diff --git a/README.txt b/README.txt --- a/README.txt +++ b/README.txt @@ -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. diff --git a/src/Graphics/Rendering/OpenVG.hs b/src/Graphics/Rendering/OpenVG.hs --- a/src/Graphics/Rendering/OpenVG.hs +++ b/src/Graphics/Rendering/OpenVG.hs @@ -7,10 +7,17 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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. + -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenVG/Util/Colors.hs b/src/Graphics/Rendering/OpenVG/Util/Colors.hs --- a/src/Graphics/Rendering/OpenVG/Util/Colors.hs +++ b/src/Graphics/Rendering/OpenVG/Util/Colors.hs @@ -7,11 +7,17 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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. +-- -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenVG/Util/PathCommands.hs b/src/Graphics/Rendering/OpenVG/Util/PathCommands.hs --- a/src/Graphics/Rendering/OpenVG/Util/PathCommands.hs +++ b/src/Graphics/Rendering/OpenVG/Util/PathCommands.hs @@ -7,11 +7,20 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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]) diff --git a/src/Graphics/Rendering/OpenVG/VG.hs b/src/Graphics/Rendering/OpenVG/VG.hs --- a/src/Graphics/Rendering/OpenVG/VG.hs +++ b/src/Graphics/Rendering/OpenVG/VG.hs @@ -7,13 +7,10 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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. -- -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc b/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc --- a/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc +++ b/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc @@ -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 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) - diff --git a/src/Graphics/Rendering/OpenVG/VG/Blending.hs b/src/Graphics/Rendering/OpenVG/VG/Blending.hs --- a/src/Graphics/Rendering/OpenVG/VG/Blending.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Blending.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 - diff --git a/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs b/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs --- a/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs +++ b/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs @@ -7,35 +7,98 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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) diff --git a/src/Graphics/Rendering/OpenVG/VG/Extending.hs b/src/Graphics/Rendering/OpenVG/VG/Extending.hs --- a/src/Graphics/Rendering/OpenVG/VG/Extending.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Extending.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VG/Images.hs b/src/Graphics/Rendering/OpenVG/VG/Images.hs --- a/src/Graphics/Rendering/OpenVG/VG/Images.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Images.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VG/Paint.hs b/src/Graphics/Rendering/OpenVG/VG/Paint.hs --- a/src/Graphics/Rendering/OpenVG/VG/Paint.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Paint.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VG/Parameters.hs b/src/Graphics/Rendering/OpenVG/VG/Parameters.hs --- a/src/Graphics/Rendering/OpenVG/VG/Parameters.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Parameters.hs @@ -8,7 +8,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenVG/VG/Paths.hs b/src/Graphics/Rendering/OpenVG/VG/Paths.hs --- a/src/Graphics/Rendering/OpenVG/VG/Paths.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Paths.hs @@ -9,19 +9,26 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 +-} diff --git a/src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs b/src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs --- a/src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs +++ b/src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VG/Scissoring.hs b/src/Graphics/Rendering/OpenVG/VG/Scissoring.hs --- a/src/Graphics/Rendering/OpenVG/VG/Scissoring.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Scissoring.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 -------------------------------------------------------------------------------- diff --git a/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs b/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs --- a/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs +++ b/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VG/Utils.hs b/src/Graphics/Rendering/OpenVG/VG/Utils.hs --- a/src/Graphics/Rendering/OpenVG/VG/Utils.hs +++ b/src/Graphics/Rendering/OpenVG/VG/Utils.hs @@ -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) diff --git a/src/Graphics/Rendering/OpenVG/VGU.hs b/src/Graphics/Rendering/OpenVG/VGU.hs --- a/src/Graphics/Rendering/OpenVG/VGU.hs +++ b/src/Graphics/Rendering/OpenVG/VGU.hs @@ -7,17 +7,15 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 diff --git a/src/Graphics/Rendering/OpenVG/VGU/Errors.hs b/src/Graphics/Rendering/OpenVG/VGU/Errors.hs deleted file mode 100644 --- a/src/Graphics/Rendering/OpenVG/VGU/Errors.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# OPTIONS -Wall #-} - --------------------------------------------------------------------------------- --- | --- Module : Graphics.Rendering.OpenVG.VG.Errors --- Copyright : (c) Stephen Tetley 2008, 2009 --- License : BSD3 --- --- Maintainer : Stephen Tetley --- 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 - - - - diff --git a/src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs b/src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs --- a/src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs +++ b/src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs @@ -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) diff --git a/src/Graphics/Rendering/OpenVG/VGU/VGU.hs b/src/Graphics/Rendering/OpenVG/VGU/VGU.hs --- a/src/Graphics/Rendering/OpenVG/VGU/VGU.hs +++ b/src/Graphics/Rendering/OpenVG/VGU/VGU.hs @@ -7,7 +7,7 @@ -- License : BSD3 -- -- Maintainer : Stephen Tetley --- 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 ()