diff --git a/InstallWindows.txt b/InstallWindows.txt new file mode 100644 --- /dev/null +++ b/InstallWindows.txt @@ -0,0 +1,115 @@ +It is tedious to install ShivaVG on Windows with MinGW/Msys (I +don't think Cygwin will work at all). With GHC-6.10.1 most +people appear to be following these instructions to install +HOpenGL and HGLUT - they are the ones I followed: + +http://netsuperbrain.com/blog/posts/freeglut-windows-hopengl-hglut/ + +To get Shiva-VG to work under MinGW/Msys you have to do the same +trick of compiling directly with gcc rather than using the makefiles +as per *Compile and Install freeglut*. + +Here's what I did: + +I dropped the archive into my home directory +C:\msys\1.0\home\stephen + +> tar xvfz shivavg-0.2.0.tar.gz + +> cd shivavg-0.2.0/src + +> gcc -O2 -c *.c -I../include/VG + +That should build the *.o files. + +> gcc -shared -o openvg32.dll *.o -Wl,--enable-stdcall-fixup,--out-implib,libopenvg32.a -lopengl32 -lglu32 -lgdi32 -lwinmm + +That should create `openvg32.dll` and `libopenvg32.a`. + +Put `libshivavg32.a` into your MinGW lib directory, on my system +it is here: + +C:\MinGW\lib + +Also copy the `vg` folder from `shivavg-0.2.0\include` to the +MinGW include directory, on my system it is here: + +C:\MinGW\include + +You should have folders for both the GL and OpenVG headers: + +C:\MinGW\include\GL +C:\MinGW\include\vg + +Now you should be able to build the Haskell binding to Shiva: + +I dropped the archive into my home directory +C:\msys\1.0\home\stephen + +> tar xvfz OpenVG-0.1.tar.gz + +> cd OpenVG-0.1 +> runhaskell Setup.hs configure +> runhaskell Setup.hs build +> runhaskell Setup.hs install +> runhaskell Setup.hs haddock + +To run the test you need to copy `openvg32.dll` from +the shivavg src directory into OpenVG-0.1/examples. +The cd to examples and run with: +> runhaskell -lopenvg TestVgu.hs + +This should display a white window with some line drawn +shapes. + +Better examples of OpenVG capabilities are in the ShivaVG +examples. Particularly test_tiger which uses the famous +tiger from SVG tutorials. + + +Running ShivaVG's C examples +---------------------------- + +ShivaVG itself seems to have some problems with FreeGlut - +at least if the are both compiled through the direct gcc +(no makefile) hack as per the *netsuperbrain.com* blog tutorial. + +Compiling should be straight-forward, the following command +compiles test_tiger.exe: + +> gcc -o test_tiger test.c test_tiger_paths.c test_tiger.c -lm -lglut32 -lglu32 -lopengl32 -lopenvg32 + +To run the test_tiger.exe you will need to drop to put a copy of +the `openvg32.dll` that you compiled (in the src directory) into +the examples directory. + +You will also need a copy of `glut32.dll` in the examples +directory - and here seems to be the snag. + +I don't think the `glut32.dll` produced by FreeGlut works +- at least not if its compiled as per the *netsuperbrain.com* +guide. The `glut32.dll` compiled from FreeGlut is identifiable +as its 308KB in size (on my computer at least). If you try to +run test_tiger.exe with this it may fail with an +`Entry Point Not Found` dialog for the function +`_glutCreateMenuWithExit` (it certainly fails for me). + +To get around this, I have to use the `glut32.dll` from my +Cygwin installation, this is 232KB in size and was in the folder: + +C:\cygwin\bin + +I copied this into the `examples` folder along with `openvg32.dll` +then double-clicking on test_tiger.exe should work. + + + + + + + + + + + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008 Stephen Peter Tetley + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/OpenVG.cabal b/OpenVG.cabal new file mode 100644 --- /dev/null +++ b/OpenVG.cabal @@ -0,0 +1,64 @@ +name: OpenVG +version: 0.1 +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.0) binding +description: + A Haskell binding for the OpenVG vector graphics API version 1.0.1 + (specifically the shivavg-0.2.0 implementation). + +build-type: Simple +stability: alpha +cabal-version: >= 1.2 + +extra-source-files: + InstallWindows.txt, + README.txt, + examples/TestUtils.hs, + examples/TestVgu.hs + +library + hs-source-dirs: src + build-depends: base, OpenGL >= 2.2, GLUT >= 2.1.1.2 + + + exposed-modules: + Graphics.Rendering.OpenVG, + Graphics.Rendering.OpenVG.VG, + Graphics.Rendering.OpenVG.VGU, + Graphics.Rendering.OpenVG.VG.BasicTypes, + Graphics.Rendering.OpenVG.VG.Blending, + Graphics.Rendering.OpenVG.VG.DrawingContext, + Graphics.Rendering.OpenVG.VG.Extending, + Graphics.Rendering.OpenVG.VG.Images, + Graphics.Rendering.OpenVG.VG.Paint, + Graphics.Rendering.OpenVG.VG.Parameters, + Graphics.Rendering.OpenVG.VG.Paths, + 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 + + other-modules: + Graphics.Rendering.OpenVG.VG.Constants, + Graphics.Rendering.OpenVG.VG.Utils, + Graphics.Rendering.OpenVG.VG.CFunDecls, + Graphics.Rendering.OpenVG.VGU.CInternals, + Graphics.Rendering.OpenVG.VGU.ErrorsInternal + + extensions: + ForeignFunctionInterface, TypeSynonymInstances, CPP + + ghc-options: -Wall + + includes: vg/openvg.h, vg/vgu.h + + + + + diff --git a/README.txt b/README.txt new file mode 100644 --- /dev/null +++ b/README.txt @@ -0,0 +1,23 @@ +Haskell bindings to ShivaVG (OpenVG implementation). + +I've tested the bindings on both Windows XP (MinGW/Msys) +and MacOSX leopard. + +KNOWN PROBLEMS: + +MacOSX - runhaskell / GHCi freeze the shell when you try to run +the example TestVgu.hs. You will have to compile it first. + +Windows - running the test through GHCi kills the GHCi session +when you close the display window. Its better to run through +runhaskell. + +Shiva-VG (the C Library) should install quite easily on MacOSX - +I installed it with the usual `configure`, `make` % `make install`. +I would imagine Linux is easy too. Windows isn't at all easy - but +there are instructions in the file `InstallWindows.txt`. + + +On all platforms you will need OpenGL and GLUT and the Haskell +bindings to OpenGL and GLUT installed and working. + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/examples/TestUtils.hs b/examples/TestUtils.hs new file mode 100644 --- /dev/null +++ b/examples/TestUtils.hs @@ -0,0 +1,73 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : TestUtils +-- Copyright : (c) Stephen Tetley 2008 +-- License : LGPL - this is a direct translation of Ivan Leben's code +-- (test.c) so its LGPL. +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Helper functions +-- +-------------------------------------------------------------------------------- + + +module TestUtils ( + testCreatePath, + testDestoryPaths, + + testDrawString, + testInit +) where + +import Graphics.Rendering.OpenVG hiding ( + loadIdentity, lineWidth, scale, translate, matrixMode ) +import qualified Graphics.Rendering.OpenVG as VG +import Graphics.UI.GLUT + +testCreatePath :: IO VGPath +testCreatePath = createPath VG.Float 1.0 0.0 0 0 [CapabilityAll] + +testDestoryPaths :: [VGPath] -> IO () +testDestoryPaths = mapM_ destroyPath + + +testDrawString :: GLfloat -> GLfloat -> String -> IO () +testDrawString x y test_string = do + + blend $= Enabled + blendFunc $= (SrcAlpha, OneMinusSrcAlpha) + lineSmooth $= Enabled + multisample $= Disabled + + matrixMode $= (Modelview 0) -- eh? + preservingMatrix $ do + loadIdentity + translate (Vector3 (x+0.5) (y+0.5) 0) + scale k k k + lineWidth $= 1.0 + renderString Roman test_string + + lineSmooth $= Disabled + where + k :: GLfloat + k = 0.15 + +testInit :: Position -> Size -> String -> IO Window +testInit xy sz title = do + (_progName, _args) <- getArgsAndInitialize + initialDisplayMode $= [ RGBAMode, DoubleBuffered, WithAlphaComponent, + WithStencilBuffer, Multisampling ] + initialWindowSize $= sz + initialWindowPosition $= xy + win <- createWindow title + -- ... + okb <- VG.createContextSH $ sz + if okb then putStrLn "testInit - okay" else error "testInit - failed" + return win + + diff --git a/examples/TestVgu.hs b/examples/TestVgu.hs new file mode 100644 --- /dev/null +++ b/examples/TestVgu.hs @@ -0,0 +1,127 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : TestVgu +-- Copyright : (c) Stephen Tetley 2008 +-- License : LGPL - this is a direct translation of Ivan Leben's code +-- (test_vgu.c) so its LGPL +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Haskell translation of test_vgu from the shivavg examples +-- + +-------------------------------------------------------------------------------- + +-- On Windows copy `openvg32.dll` and `glut32.dll` into this directory, +-- then under MinGW/Msys cd to this directory and run this at the prompt: +-- MinGW> runhaskell.exe -lopenvg32 TestVgu.hs + +-- You can run through GHCi, but closing the display window kills the +-- GHCi session. + +-- On MacOSX runhaskell won't work, a blank window is printed and the +-- shell effectively freezes. You will have to do a compile to see the demo: +-- shell> ghc --make -lopenvg TestVgu.hs +-- the run the compiled app. + +-- GHCi does not work either. + + +module Main where + +import TestUtils + +import Graphics.Rendering.OpenVG ( + VGPath, VGfloat, + ArcType(..), line, polygon, roundRect, ellipse, arc, + destroyContextSH ) +import qualified Graphics.Rendering.OpenVG as VG +import Graphics.UI.GLUT + +import Control.Monad ( zipWithM_ ) + + +display :: [VGPath] -> IO () +display primitives = do + VG.clearColor $= white + sz <- get $ windowSize + pos <- get $ windowPosition + VG.clear pos sz + VG.matrixMode $= VG.PathUserToSurface + + zipWithM_ fn primitives coords + putStrLn "display - flush..." + swapBuffers + where + white :: Color4 GLfloat + white = Color4 1.0 1.0 1.0 1.0 + + coords = [(x,y) | y <- [0..2], x <- [0..2] ] + + fn :: VGPath -> (VGfloat, VGfloat) -> IO () + fn a (x,y) = do + VG.loadIdentity + VG.translate (100 + x*150) (100 + y*150) + VG.drawPath a [VG.StrokePath] + +points :: [VGfloat] +points = [(-30),(-30), 30,(-30), 0,30] + +createPrimitives :: IO [VGPath] +createPrimitives = do + line1 <- testCreatePath + line line1 (-30.0) (-30.0) 30.0 30.0 + + poly_open <- testCreatePath + polygon poly_open points True + + poly_closed <- testCreatePath + polygon poly_closed points False + + rect1 <- testCreatePath + VG.rect rect1 (-50) (-30) 100 60 + + rect_round <- testCreatePath + roundRect rect_round (-50) (-30) 100 60 30 30 + + ellipse1 <- testCreatePath + ellipse ellipse1 0 0 100 60 + + arc_open <- testCreatePath + arc arc_open 0 0 100 60 0 270 ArcOpen + + arc_chord <- testCreatePath + arc arc_chord 0 0 100 60 0 270 ArcChord + + arc_pie <- testCreatePath + arc arc_pie 0 0 100 60 0 270 ArcPie + + return [ line1, poly_open, poly_closed + , rect1, rect_round, ellipse1 + , arc_open, arc_chord, arc_pie + ] + + + +main :: IO () +main = do + win <- testInit (Position 0 0) (Size 500 500) title + prims <- createPrimitives + displayCallback $= display prims + mainLoop + + -- end + testDestoryPaths prims + destroyContextSH + destroyWindow win + + where + title = "Haskell OpenVG: VGU Primitives test" + +-- testDisplay :: IO () + + diff --git a/src/Graphics/Rendering/OpenVG.hs b/src/Graphics/Rendering/OpenVG.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG.hs @@ -0,0 +1,23 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- A Haskell binding for the OpenVG vector and raster graphics API. +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG ( + module Graphics.Rendering.OpenVG.VG, + module Graphics.Rendering.OpenVG.VGU, +) where + +import Graphics.Rendering.OpenVG.VG +import Graphics.Rendering.OpenVG.VGU diff --git a/src/Graphics/Rendering/OpenVG/VG.hs b/src/Graphics/Rendering/OpenVG/VG.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG.hs @@ -0,0 +1,43 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly 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. +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG ( + module Graphics.Rendering.OpenVG.VG.BasicTypes, + module Graphics.Rendering.OpenVG.VG.Blending, + module Graphics.Rendering.OpenVG.VG.DrawingContext, + module Graphics.Rendering.OpenVG.VG.Extending, + module Graphics.Rendering.OpenVG.VG.Images, + module Graphics.Rendering.OpenVG.VG.Paint, + module Graphics.Rendering.OpenVG.VG.Parameters, + module Graphics.Rendering.OpenVG.VG.Paths, + module Graphics.Rendering.OpenVG.VG.RenderingQuality, + module Graphics.Rendering.OpenVG.VG.Scissoring, + module Graphics.Rendering.OpenVG.VG.ShivaExtensions +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes +import Graphics.Rendering.OpenVG.VG.Blending +import Graphics.Rendering.OpenVG.VG.DrawingContext +import Graphics.Rendering.OpenVG.VG.Extending +import Graphics.Rendering.OpenVG.VG.Images +import Graphics.Rendering.OpenVG.VG.Paint +import Graphics.Rendering.OpenVG.VG.Parameters +import Graphics.Rendering.OpenVG.VG.Paths +import Graphics.Rendering.OpenVG.VG.RenderingQuality +import Graphics.Rendering.OpenVG.VG.Scissoring +import Graphics.Rendering.OpenVG.VG.ShivaExtensions diff --git a/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc b/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/BasicTypes.hsc @@ -0,0 +1,91 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.BasicTypes +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to sections 3.2 (Primitive Data Types) +-- and 3.6 (Handle-based Data Types) of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.BasicTypes ( + -- * Primitive Types + VGbyte, VGubyte, VGshort, VGint, VGuint, VGbitfield, + VGboolean, VGfloat, + VGenum, + + vg_FALSE, vg_TRUE, marshalBool, unmarshalBool, + + -- * Handle-based Types + VGHandle, + vg_INVALID_HANDLE, + + VGPath, VGImage, VGPaint, + + -- * Points + Point, + +) where + +#include + +import Data.Word ( Word32 ) +import Graphics.Rendering.OpenGL.GL.BasicTypes + +type VGfloat = GLfloat +type VGbyte = GLbyte +type VGubyte = GLubyte +type VGshort = GLshort +type VGint = GLint +type VGuint = GLuint +type VGbitfield = GLbitfield + +type VGenum = GLenum + + + +-- | 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) + + +type VGHandle = #type VGHandle + +vg_INVALID_HANDLE :: VGHandle +vg_INVALID_HANDLE = #const VG_INVALID_HANDLE + +type VGPath = VGHandle +type VGImage = VGHandle +type VGPaint = VGHandle + + +-- | Point (VGfloat,VGfloat) +type Point = (VGfloat, VGfloat) + + + diff --git a/src/Graphics/Rendering/OpenVG/VG/Blending.hs b/src/Graphics/Rendering/OpenVG/VG/Blending.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Blending.hs @@ -0,0 +1,82 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Blending +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 12 (Blending) +-- of the OpenVG 1.0.1 specs. +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Blending ( + -- * Setting the blend mode + BlendMode(..), + blendMode +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGenum ) +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_BLEND_SRC, vg_BLEND_SRC_OVER, vg_BLEND_DST_OVER, + vg_BLEND_SRC_IN, vg_BLEND_DST_IN, vg_BLEND_MULTIPLY, + vg_BLEND_SCREEN, vg_BLEND_DARKEN, vg_BLEND_LIGHTEN, + vg_BLEND_ADDITIVE ) +import Graphics.Rendering.OpenVG.VG.Parameters ( + seti, ParamType ( BlendMode ) ) +import Graphics.Rendering.OpenVG.VG.Utils ( Marshal(..), enumValue ) + +import Graphics.Rendering.OpenGL.GL.StateVar ( + SettableStateVar, makeSettableStateVar ) + + +-------------------------------------------------------------------------------- +-- Setting the blend mode + +-- | BlendMode defines the possible blend modes. +data BlendMode = + Src + | SrcOver + | DstOver + | SrcIn + | DstIn + | Multiply' -- Unfortunate name conflict + | Screen + | Darken + | Lighten + | Additive + deriving ( Eq, Ord, Show ) + +-- | Set the blend mode - @blendMode@ is typed wrapper +-- over this equivalent OpenVG code: +-- +-- @ VGBlendMode mode; @ +-- +-- @ vgSeti(VG_BLEND_MODE, mode); @ +blendMode :: SettableStateVar BlendMode +blendMode = makeSettableStateVar $ \mode -> seti BlendMode (enumValue mode) + +-------------------------------------------------------------------------------- + +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 + Multiply' -> vg_BLEND_MULTIPLY + 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/CFunDecls.hsc b/src/Graphics/Rendering/OpenVG/VG/CFunDecls.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/CFunDecls.hsc @@ -0,0 +1,499 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.CFunDecls +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Internal module declaring all the foreign declarations of the functions +-- defined in . +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.CFunDecls where + +#include + +import Graphics.Rendering.OpenVG.VG.BasicTypes + +import Foreign.Ptr ( Ptr ) +import Foreign.C.String ( CString ) + +-- 'suffix indicates a marshalled enum type. +type VGErrorCode' = VGenum +type VGHardwareQueryResult' = VGenum +type VGHardwareQueryType' = VGenum +type VGImageChannel' = VGenum +type VGImageFormat' = VGenum +type VGMaskOperation' = VGenum +type VGPaintMode' = VGenum +type VGPathDatatype' = VGenum +type VGStringID' = VGenum +type VGTilingMode' = VGenum + + +foreign import ccall unsafe "vg/openvg.h vgGetError" + vgGetError :: IO VGErrorCode' + + + +foreign import ccall unsafe "vg/openvg.h vgFlush" + vgFlush :: IO () + +foreign import ccall unsafe "vg/openvg.h vgFinish" + vgFinish :: IO () + + +-- getters and setters +foreign import ccall unsafe "vg/openvg.h vgSeti" + vgSeti :: VGenum -> VGint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetf" + vgSetf :: VGenum -> VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetfv" + vgSetfv :: VGenum -> VGint -> Ptr VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetiv" + vgSetiv :: VGenum -> VGint -> Ptr VGint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgGetf" + vgGetf :: VGenum -> IO VGfloat + +foreign import ccall unsafe "vg/openvg.h vgGeti" + vgGeti :: VGenum -> IO VGint + +foreign import ccall unsafe "vg/openvg.h vgGetVectorSize" + vgGetVectorSize :: VGenum -> IO VGint + +foreign import ccall unsafe "vg/openvg.h vgGetfv" + vgGetfv :: VGenum -> VGint -> IO (Ptr VGfloat) + +foreign import ccall unsafe "vg/openvg.h vgGetiv" + vgGetiv :: VGenum -> VGint -> IO (Ptr VGint) + +foreign import ccall unsafe "vg/openvg.h vgSetParameterf" + vgSetParameterf :: VGHandle -> VGenum -> VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetParameteri" + vgSetParameteri :: VGHandle -> VGenum -> VGint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetParameterfv" + vgSetParameterfv :: VGHandle -> VGenum -> VGint -> Ptr VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetParameteriv" + vgSetParameteriv :: VGHandle -> VGenum -> VGint -> Ptr VGint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgGetParameterf" + vgGetParameterf :: VGHandle -> VGenum -> IO VGfloat + +foreign import ccall unsafe "vg/openvg.h vgGetParameteri" + vgGetParameteri :: VGHandle -> VGenum -> IO VGint + +foreign import ccall unsafe "vg/openvg.h vgGetParameterVectorSize" + vgGetParameterVectorSize :: VGHandle -> VGenum -> IO VGint + +foreign import ccall unsafe "vg/openvg.h vgGetParameterfv" + vgGetParameterfv :: VGHandle -> VGenum -> VGint -> IO (Ptr VGfloat) + +foreign import ccall unsafe "vg/openvg.h vgGetParameteriv" + vgGetParameteriv :: VGHandle -> VGenum -> VGint -> IO (Ptr VGint) + + +-- | Matrix Manipulation +-- set the current matrix to the identity matrix +foreign import ccall unsafe "vg/openvg.h vgLoadIdentity" + vgLoadIdentity :: IO () + +foreign import ccall unsafe "vg/openvg.h vgLoadMatrix" + vgLoadMatrix :: Ptr VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgGetMatrix" + vgGetMatrix :: IO (Ptr VGfloat) + +-- multiple the current matrix by the given matrix +foreign import ccall unsafe "vg/openvg.h vgMultMatrix" + vgMultMatrix :: Ptr VGfloat -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgTranslate" + vgTranslate :: VGfloat -> VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgScale" + vgScale :: VGfloat -> VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgShear" + vgShear :: VGfloat -> VGfloat -> IO () + +foreign import ccall unsafe "vg/openvg.h vgRotate" + vgRotate :: VGfloat -> IO () + +-- | Masking and Clearing +{- +-- TODO vgMask seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgMask" + vgMask :: VGImage -> VGMaskOperation' -> + VGint -> VGint -> VGint -> VGint -> IO () +-} + +foreign import ccall unsafe "vg/openvg.h vgClear" + vgClear :: VGint -> VGint -> VGint -> VGint -> IO () + + + +-- | Paths +foreign import ccall unsafe "vg/openvg.h vgCreatePath" + vgCreatePath :: VGint + -> VGPathDatatype' + -> VGfloat + -> VGfloat + -> VGint + -> VGint + -> VGbitfield + -> IO VGPath + + + +foreign import ccall unsafe "vg/openvg.h vgClearPath" + vgClearPath :: VGPath -> VGbitfield -> IO () + +foreign import ccall unsafe "vg/openvg.h vgDestroyPath" + vgDestroyPath :: VGPath -> IO () + +foreign import ccall unsafe "vg/openvg.h vgRemovePathCapabilities" + vgRemovePathCapabilities :: VGPath -> VGbitfield -> IO () + +foreign import ccall unsafe "vg/openvg.h vgGetPathCapabilities" + vgGetPathCapabilities :: VGPath -> IO VGbitfield + +foreign import ccall unsafe "vg/openvg.h vgAppendPath" + vgAppendPath :: VGPath -> VGPath -> IO () + +-- append the data in /Ptr a/ to the path handle /VGPath/. +foreign import ccall unsafe "vg/openvg.h vgAppendPathData" + vgAppendPathData :: VGPath -> VGint -> Ptr VGubyte -> Ptr a -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgModifyPathCoords" + vgModifyPathCoords :: VGPath -> VGint -> VGint -> Ptr a -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgTransformPath" + vgTransformPath :: VGPath -> VGPath -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgInterpolatePath" + vgInterpolatePath :: VGPath + -> VGPath + -> VGPath + -> VGfloat + -> IO VGboolean +{- +-- TODO vgPathLength seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgPathLength" + vgPathLength :: VGPath -> VGint -> VGint -> IO VGfloat +-} + +{- +-- TODO vgPointAlongPath seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgPointAlongPath" + vgPointAlongPath :: VGPath + -> VGint + -> VGint + -> VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> IO () +-} + +foreign import ccall unsafe "vg/openvg.h vgPathBounds" + vgPathBounds :: VGPath + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgPathTransformedBounds" + vgPathTransformedBounds :: VGPath + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> Ptr VGfloat + -> IO () + +foreign import ccall unsafe "vg/openvg.h vgDrawPath" + vgDrawPath :: VGPath -> VGbitfield -> IO () + + + +-- | Paint +foreign import ccall unsafe "vg/openvg.h vgCreatePaint" + vgCreatePaint :: IO VGPaint + +foreign import ccall unsafe "vg/openvg.h vgDestroyPaint" + vgDestroyPaint :: VGPaint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetPaint" + vgSetPaint :: VGPaint -> VGbitfield -> IO () + +{- +-- TODO vgGetPaint seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgGetPaint" + vgGetPaint :: VGPaintMode' -> IO VGPaint +-} + +{- +-- TODO vgSetColor seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgSetColor" + vgSetColor :: VGPaint -> VGuint -> IO () +-} + +{- +-- TODO vgGetColor seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgGetColor" + vgGetColor :: VGPaint -> IO VGuint +-} + +foreign import ccall unsafe "vg/openvg.h vgPaintPattern" + vgPaintPattern :: VGPaint -> VGImage -> IO () + + +-- | Images + +foreign import ccall unsafe "vg/openvg.h vgCreateImage" + vgCreateImage :: VGImageFormat' + -> VGint + -> VGint + -> VGbitfield + -> IO VGImage + + +foreign import ccall unsafe "vg/openvg.h vgDestroyImage" + vgDestroyImage :: VGImage -> IO () + +foreign import ccall unsafe "vg/openvg.h vgClearImage" + vgClearImage :: VGImage -> VGint -> VGint -> VGint -> VGint -> IO () + +foreign import ccall unsafe "vg/openvg.h vgImageSubData" + vgImageSubData :: VGImage + -> Ptr a + -> VGint + -> VGImageFormat' + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgGetImageSubData" + vgGetImageSubData :: VGImage + -> Ptr a + -> VGint + -> VGImageFormat' + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + +{- +-- TODO vgChildImage seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgChildImage" + vgChildImage :: VGImage -> VGint -> VGint -> VGint -> VGint -> IO VGImage +-} + +{- +-- TODO vgGetParent seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgGetParent" + vgGetParent :: VGImage -> IO VGImage +-} + + +foreign import ccall unsafe "vg/openvg.h vgCopyImage" + vgCopyImage :: VGImage -> VGint -> VGint + -> VGImage -> VGint -> VGint + -> VGint -> VGint + -> VGboolean + -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgDrawImage" + vgDrawImage :: VGImage -> IO () + +foreign import ccall unsafe "vg/openvg.h vgSetPixels" + vgSetPixels :: VGint + -> VGint + -> VGImage + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + +foreign import ccall unsafe "vg/openvg.h vgWritePixels" + vgWritePixels :: Ptr a + -> VGint + -> VGImageFormat' + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgGetPixels" + vgGetPixels :: VGImage + -> VGint + -> VGint + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + +foreign import ccall unsafe "vg/openvg.h vgReadPixels" + vgReadPixels :: Ptr a + -> VGint + -> VGImageFormat' + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgCopyPixels" + vgCopyPixels :: VGint + -> VGint + -> VGint + -> VGint + -> VGint + -> VGint + -> IO () + + +-- | Image Filters + +{- +-- TODO vgColorMatrix seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgColorMatrix" + vgColorMatrix :: VGImage -> VGImage -> Ptr VGfloat -> IO () +-} + +{- +-- TODO vgConvolve seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgConvolve" + vgConvolve :: VGImage + -> VGImage + -> VGint + -> VGint + -> VGint + -> VGint + -> Ptr VGshort + -> VGfloat + -> VGfloat + -> VGTilingMode' + -> IO () +-} + +{- +-- TODO vgSeparableConvolve seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgSeparableConvolve" + vgSeparableConvolve :: VGImage + -> VGImage + -> VGint + -> VGint + -> VGint + -> VGint + -> Ptr VGshort + -> Ptr VGshort + -> VGfloat + -> VGfloat + -> VGTilingMode' + -> IO () +-} + +{- +-- TODO vgGaussianBlur seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgGaussianBlur" + vgGaussianBlur :: VGImage + -> VGImage + -> VGfloat + -> VGfloat + -> VGTilingMode' + -> IO () +-} + +{- +-- TODO vgLookup seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgLookup" + vgLookup :: VGImage + -> VGImage + -> Ptr VGubyte + -> Ptr VGubyte + -> Ptr VGubyte + -> Ptr VGubyte + -> VGboolean + -> VGboolean + -> IO () +-} + +{- +-- TODO vgLookupSingle seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgLookupSingle" + vgLookupSingle :: VGImage + -> VGImage + -> Ptr VGuint + -> VGImageChannel' + -> VGboolean + -> VGboolean + -> IO () +-} + + +-- | Hardware Queries +{- +-- TODO vgHardwareQuery seems to be missing in the dll... ? +foreign import ccall unsafe "vg/openvg.h vgHardwareQuery" + vgHardwareQuery :: VGHardwareQueryType' + -> VGint + -> IO VGHardwareQueryResult' +-} + +-- | Renderer and Extension Information +foreign import ccall unsafe "vg/openvg.h vgGetString" + vgGetString :: VGStringID' -> IO CString + +-- | Shiva-VG Extensions +-- See the README in the shiva archive. +foreign import ccall unsafe "vg/openvg.h vgCreateContextSH" + vgCreateContextSH :: VGint -> VGint -> IO VGboolean + +foreign import ccall unsafe "vg/openvg.h vgResizeSurfaceSH" + vgResizeSurfaceSH :: VGint -> VGint -> IO () + + +foreign import ccall unsafe "vg/openvg.h vgDestroyContextSH" + vgDestroyContextSH :: IO () + + + + + + + + + diff --git a/src/Graphics/Rendering/OpenVG/VG/Constants.hsc b/src/Graphics/Rendering/OpenVG/VG/Constants.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Constants.hsc @@ -0,0 +1,384 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Constants +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Aliases for constants defined in . +-- +-------------------------------------------------------------------------------- + + +module Graphics.Rendering.OpenVG.VG.Constants where + +#include + +import Graphics.Rendering.OpenVG.VG.BasicTypes + +vg_PATH_FORMAT_STANDARD :: VGint +vg_PATH_FORMAT_STANDARD = #const VG_PATH_FORMAT_STANDARD + +vg_MAXSHORT :: VGshort +vg_MAXSHORT = #const VG_MAXSHORT + +vg_MAXINT :: VGint +vg_MAXINT = #const VG_MAXINT + +-- shiva-vg has no VG_MAXFLOAT +-- vg_MAXFLOAT :: VGfloat +-- vg_MAXFLOAT = #const VG_MAXFLOAT + + +-- | Enumerations + +#{enum VGenum, + , vg_NO_ERROR = VG_NO_ERROR + , vg_BAD_HANDLE_ERROR = VG_BAD_HANDLE_ERROR + , vg_ILLEGAL_ARGUMENT_ERROR = VG_ILLEGAL_ARGUMENT_ERROR + , vg_OUT_OF_MEMORY_ERROR = VG_OUT_OF_MEMORY_ERROR + , vg_PATH_CAPABILITY_ERROR = VG_PATH_CAPABILITY_ERROR + , vg_UNSUPPORTED_IMAGE_FORMAT_ERROR = VG_UNSUPPORTED_IMAGE_FORMAT_ERROR + , vg_UNSUPPORTED_PATH_FORMAT_ERROR = VG_UNSUPPORTED_PATH_FORMAT_ERROR + , vg_IMAGE_IN_USE_ERROR = VG_IMAGE_IN_USE_ERROR + , vg_NO_CONTEXT_ERROR = VG_NO_CONTEXT_ERROR + } + +#{enum VGenum, + , vg_MATRIX_MODE = VG_MATRIX_MODE + , vg_FILL_RULE = VG_FILL_RULE + , vg_IMAGE_QUALITY = VG_IMAGE_QUALITY + , vg_RENDERING_QUALITY = VG_RENDERING_QUALITY + , vg_BLEND_MODE = VG_BLEND_MODE + , vg_IMAGE_MODE = VG_IMAGE_MODE + + , vg_SCISSOR_RECTS = VG_SCISSOR_RECTS + + , vg_STROKE_LINE_WIDTH = VG_STROKE_LINE_WIDTH + , vg_STROKE_CAP_STYLE = VG_STROKE_CAP_STYLE + , vg_STROKE_JOIN_STYLE = VG_STROKE_JOIN_STYLE + , vg_STROKE_MITER_LIMIT = VG_STROKE_MITER_LIMIT + , vg_STROKE_DASH_PATTERN = VG_STROKE_DASH_PATTERN + , vg_STROKE_DASH_PHASE = VG_STROKE_DASH_PHASE + , vg_STROKE_DASH_PHASE_RESET = VG_STROKE_DASH_PHASE_RESET + + , vg_TILE_FILL_COLOR = VG_TILE_FILL_COLOR + + , vg_CLEAR_COLOR = VG_CLEAR_COLOR + + , vg_MASKING = VG_MASKING + , vg_SCISSORING = VG_SCISSORING + + , vg_PIXEL_LAYOUT = VG_PIXEL_LAYOUT + , vg_SCREEN_LAYOUT = VG_SCREEN_LAYOUT + + , vg_FILTER_FORMAT_LINEAR = VG_FILTER_FORMAT_LINEAR + , vg_FILTER_FORMAT_PREMULTIPLIED = VG_FILTER_FORMAT_PREMULTIPLIED + + , vg_FILTER_CHANNEL_MASK = VG_FILTER_CHANNEL_MASK + + , vg_MAX_SCISSOR_RECTS = VG_MAX_SCISSOR_RECTS + , vg_MAX_DASH_COUNT = VG_MAX_DASH_COUNT + , vg_MAX_KERNEL_SIZE = VG_MAX_KERNEL_SIZE + , vg_MAX_SEPARABLE_KERNEL_SIZE = VG_MAX_SEPARABLE_KERNEL_SIZE + , vg_MAX_COLOR_RAMP_STOPS = VG_MAX_COLOR_RAMP_STOPS + , vg_MAX_IMAGE_WIDTH = VG_MAX_IMAGE_WIDTH + , vg_MAX_IMAGE_HEIGHT = VG_MAX_IMAGE_HEIGHT + , vg_MAX_IMAGE_PIXELS = VG_MAX_IMAGE_PIXELS + , vg_MAX_IMAGE_BYTES = VG_MAX_IMAGE_BYTES + , vg_MAX_FLOAT = VG_MAX_FLOAT + , vg_MAX_GAUSSIAN_STD_DEVIATION = VG_MAX_GAUSSIAN_STD_DEVIATION + } + + +#{enum VGenum, + , vg_RENDERING_QUALITY_NONANTIALIASED = VG_RENDERING_QUALITY_NONANTIALIASED + , vg_RENDERING_QUALITY_FASTER = VG_RENDERING_QUALITY_FASTER + , vg_RENDERING_QUALITY_BETTER = VG_RENDERING_QUALITY_BETTER + } + + + +#{enum VGenum, + , vg_PIXEL_LAYOUT_UNKNOWN = VG_PIXEL_LAYOUT_UNKNOWN + , vg_PIXEL_LAYOUT_RGB_VERTICAL = VG_PIXEL_LAYOUT_RGB_VERTICAL + , vg_PIXEL_LAYOUT_BGR_VERTICAL = VG_PIXEL_LAYOUT_BGR_VERTICAL + , vg_PIXEL_LAYOUT_RGB_HORIZONTAL = VG_PIXEL_LAYOUT_RGB_HORIZONTAL + , vg_PIXEL_LAYOUT_BGR_HORIZONTAL = VG_PIXEL_LAYOUT_BGR_HORIZONTAL + } + +#{enum VGenum, + , vg_MATRIX_PATH_USER_TO_SURFACE = VG_MATRIX_PATH_USER_TO_SURFACE + , vg_MATRIX_IMAGE_USER_TO_SURFACE = VG_MATRIX_IMAGE_USER_TO_SURFACE + , vg_MATRIX_FILL_PAINT_TO_USER = VG_MATRIX_FILL_PAINT_TO_USER + , vg_MATRIX_STROKE_PAINT_TO_USER = VG_MATRIX_STROKE_PAINT_TO_USER + } + +#{enum VGenum, + , vg_CLEAR_MASK = VG_CLEAR_MASK + , vg_FILL_MASK = VG_FILL_MASK + , vg_SET_MASK = VG_SET_MASK + , vg_UNION_MASK = VG_UNION_MASK + , vg_INTERSECT_MASK = VG_INTERSECT_MASK + , vg_SUBTRACT_MASK = VG_SUBTRACT_MASK + } + + +#{enum VGenum, + , vg_PATH_DATATYPE_S_8 = VG_PATH_DATATYPE_S_8 + , vg_PATH_DATATYPE_S_16 = VG_PATH_DATATYPE_S_16 + , vg_PATH_DATATYPE_S_32 = VG_PATH_DATATYPE_S_32 + , vg_PATH_DATATYPE_F = VG_PATH_DATATYPE_F + } + +#{enum VGenum, + , vg_ABSOLUTE = VG_ABSOLUTE + , vg_RELATIVE = VG_RELATIVE + } + +#{enum VGenum, + , vg_CLOSE_PATH = VG_CLOSE_PATH + , vg_MOVE_TO = VG_MOVE_TO + , vg_LINE_TO = VG_LINE_TO + , vg_HLINE_TO = VG_HLINE_TO + , vg_VLINE_TO = VG_VLINE_TO + , vg_QUAD_TO = VG_QUAD_TO + , vg_CUBIC_TO = VG_CUBIC_TO + , vg_SQUAD_TO = VG_SQUAD_TO + , vg_SCUBIC_TO = VG_SCUBIC_TO + , vg_SCCWARC_TO = VG_SCCWARC_TO + , vg_SCWARC_TO = VG_SCWARC_TO + , vg_LCCWARC_TO = VG_LCCWARC_TO + , vg_LCWARC_TO = VG_LCWARC_TO + } + + +#{enum VGenum, + , vg_MOVE_TO_ABS = VG_MOVE_TO_ABS + , vg_MOVE_TO_REL = VG_MOVE_TO_REL + , vg_LINE_TO_ABS = VG_LINE_TO_ABS + , vg_LINE_TO_REL = VG_LINE_TO_REL + , vg_HLINE_TO_ABS = VG_HLINE_TO_ABS + , vg_HLINE_TO_REL = VG_HLINE_TO_REL + , vg_VLINE_TO_ABS = VG_VLINE_TO_ABS + , vg_VLINE_TO_REL = VG_VLINE_TO_REL + , vg_QUAD_TO_ABS = VG_QUAD_TO_ABS + , vg_QUAD_TO_REL = VG_QUAD_TO_REL + , vg_CUBIC_TO_ABS = VG_CUBIC_TO_ABS + , vg_CUBIC_TO_REL = VG_CUBIC_TO_REL + , vg_SQUAD_TO_ABS = VG_SQUAD_TO_ABS + , vg_SQUAD_TO_REL = VG_SQUAD_TO_REL + , vg_SCUBIC_TO_ABS = VG_SCUBIC_TO_ABS + , vg_SCUBIC_TO_REL = VG_SCUBIC_TO_REL + , vg_SCCWARC_TO_ABS = VG_SCCWARC_TO_ABS + , vg_SCCWARC_TO_REL = VG_SCCWARC_TO_REL + , vg_SCWARC_TO_ABS = VG_SCWARC_TO_ABS + , vg_SCWARC_TO_REL = VG_SCWARC_TO_REL + , vg_LCCWARC_TO_ABS = VG_LCCWARC_TO_ABS + , vg_LCCWARC_TO_REL = VG_LCCWARC_TO_REL + , vg_LCWARC_TO_ABS = VG_LCWARC_TO_ABS + , vg_LCWARC_TO_REL = VG_LCWARC_TO_REL + } + +-- typedef VGHandle VGPath; + + +#{enum VGenum, + , vg_PATH_CAPABILITY_APPEND_FROM = VG_PATH_CAPABILITY_APPEND_FROM + , vg_PATH_CAPABILITY_APPEND_TO = VG_PATH_CAPABILITY_APPEND_TO + , vg_PATH_CAPABILITY_MODIFY = VG_PATH_CAPABILITY_MODIFY + , vg_PATH_CAPABILITY_TRANSFORM_FROM = VG_PATH_CAPABILITY_TRANSFORM_FROM + , vg_PATH_CAPABILITY_TRANSFORM_TO = VG_PATH_CAPABILITY_TRANSFORM_TO + , vg_PATH_CAPABILITY_INTERPOLATE_FROM = VG_PATH_CAPABILITY_INTERPOLATE_FROM + , vg_PATH_CAPABILITY_INTERPOLATE_TO = VG_PATH_CAPABILITY_INTERPOLATE_TO + , vg_PATH_CAPABILITY_PATH_LENGTH = VG_PATH_CAPABILITY_PATH_LENGTH + , vg_PATH_CAPABILITY_POINT_ALONG_PATH = VG_PATH_CAPABILITY_POINT_ALONG_PATH + , vg_PATH_CAPABILITY_TANGENT_ALONG_PATH = VG_PATH_CAPABILITY_TANGENT_ALONG_PATH + , vg_PATH_CAPABILITY_PATH_BOUNDS = VG_PATH_CAPABILITY_PATH_BOUNDS + , vg_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS = VG_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS + , vg_PATH_CAPABILITY_ALL = VG_PATH_CAPABILITY_ALL + } + +#{enum VGenum, + , vg_PATH_FORMAT = VG_PATH_FORMAT + , vg_PATH_DATATYPE = VG_PATH_DATATYPE + , vg_PATH_SCALE = VG_PATH_SCALE + , vg_PATH_BIAS = VG_PATH_BIAS + , vg_PATH_NUM_SEGMENTS = VG_PATH_NUM_SEGMENTS + , vg_PATH_NUM_COORDS = VG_PATH_NUM_COORDS + } + +#{enum VGenum, + , vg_CAP_BUTT = VG_CAP_BUTT + , vg_CAP_ROUND = VG_CAP_ROUND + , vg_CAP_SQUARE = VG_CAP_SQUARE + } + +#{enum VGenum, + , vg_JOIN_MITER = VG_JOIN_MITER + , vg_JOIN_ROUND = VG_JOIN_ROUND + , vg_JOIN_BEVEL = VG_JOIN_BEVEL + } + +#{enum VGenum, + , vg_EVEN_ODD = VG_EVEN_ODD + , vg_NON_ZERO = VG_NON_ZERO + } + +#{enum VGenum, + , vg_STROKE_PATH = VG_STROKE_PATH + , vg_FILL_PATH = VG_FILL_PATH +} + +-- typedef VGHandle VGPaint; + +#{enum VGenum, + , vg_PAINT_TYPE = VG_PAINT_TYPE + , vg_PAINT_COLOR = VG_PAINT_COLOR + , vg_PAINT_COLOR_RAMP_SPREAD_MODE = VG_PAINT_COLOR_RAMP_SPREAD_MODE + , vg_PAINT_COLOR_RAMP_PREMULTIPLIED = VG_PAINT_COLOR_RAMP_PREMULTIPLIED + , vg_PAINT_COLOR_RAMP_STOPS = VG_PAINT_COLOR_RAMP_STOPS + + , vg_PAINT_LINEAR_GRADIENT = VG_PAINT_LINEAR_GRADIENT + + , vg_PAINT_RADIAL_GRADIENT = VG_PAINT_RADIAL_GRADIENT + + , vg_PAINT_PATTERN_TILING_MODE = VG_PAINT_PATTERN_TILING_MODE +} + +#{enum VGenum, + , vg_PAINT_TYPE_COLOR = VG_PAINT_TYPE_COLOR + , vg_PAINT_TYPE_LINEAR_GRADIENT = VG_PAINT_TYPE_LINEAR_GRADIENT + , vg_PAINT_TYPE_RADIAL_GRADIENT = VG_PAINT_TYPE_RADIAL_GRADIENT + , vg_PAINT_TYPE_PATTERN = VG_PAINT_TYPE_PATTERN + } + +#{enum VGenum, + , vg_COLOR_RAMP_SPREAD_PAD = VG_COLOR_RAMP_SPREAD_PAD + , vg_COLOR_RAMP_SPREAD_REPEAT = VG_COLOR_RAMP_SPREAD_REPEAT + , vg_COLOR_RAMP_SPREAD_REFLECT = VG_COLOR_RAMP_SPREAD_REFLECT + } + +#{enum VGenum, + , vg_TILE_FILL = VG_TILE_FILL + , vg_TILE_PAD = VG_TILE_PAD + , vg_TILE_REPEAT = VG_TILE_REPEAT + , vg_TILE_REFLECT = VG_TILE_REFLECT + } + +#{enum VGenum, + , vg_sRGBX_8888 = VG_sRGBX_8888 + , vg_sRGBA_8888 = VG_sRGBA_8888 + , vg_sRGBA_8888_PRE = VG_sRGBA_8888_PRE + , vg_sRGB_565 = VG_sRGB_565 + , vg_sRGBA_5551 = VG_sRGBA_5551 + , vg_sRGBA_4444 = VG_sRGBA_4444 + , vg_sL_8 = VG_sL_8 + , vg_lRGBX_8888 = VG_lRGBX_8888 + , vg_lRGBA_8888 = VG_lRGBA_8888 + , vg_lRGBA_8888_PRE = VG_lRGBA_8888_PRE + , vg_lL_8 = VG_lL_8 + , vg_A_8 = VG_A_8 + , vg_BW_1 = VG_BW_1 + + , vg_sXRGB_8888 = VG_sXRGB_8888 + , vg_sARGB_8888 = VG_sARGB_8888 + , vg_sARGB_8888_PRE = VG_sARGB_8888_PRE + , vg_sARGB_1555 = VG_sARGB_1555 + , vg_sARGB_4444 = VG_sARGB_4444 + , vg_lXRGB_8888 = VG_lXRGB_8888 + , vg_lARGB_8888 = VG_lARGB_8888 + , vg_lARGB_8888_PRE = VG_lARGB_8888_PRE + + , vg_sBGRX_8888 = VG_sBGRX_8888 + , vg_sBGRA_8888 = VG_sBGRA_8888 + , vg_sBGRA_8888_PRE = VG_sBGRA_8888_PRE + , vg_sBGR_565 = VG_sBGR_565 + , vg_sBGRA_5551 = VG_sBGRA_5551 + , vg_sBGRA_4444 = VG_sBGRA_4444 + , vg_lBGRX_8888 = VG_lBGRX_8888 + , vg_lBGRA_8888 = VG_lBGRA_8888 + , vg_lBGRA_8888_PRE = VG_lBGRA_8888_PRE + + , vg_sXBGR_8888 = VG_sXBGR_8888 + , vg_sABGR_8888 = VG_sABGR_8888 + , vg_sABGR_8888_PRE = VG_sABGR_8888_PRE + , vg_sABGR_1555 = VG_sABGR_1555 + , vg_sABGR_4444 = VG_sABGR_4444 + , vg_lXBGR_8888 = VG_lXBGR_8888 + , vg_lABGR_8888 = VG_lABGR_8888 + , vg_lABGR_8888_PRE = VG_lABGR_8888_PRE +} + + +-- typedef VGHandle VGImage; + + +#{enum VGenum, + , vg_IMAGE_QUALITY_NONANTIALIASED = VG_IMAGE_QUALITY_NONANTIALIASED + , vg_IMAGE_QUALITY_FASTER = VG_IMAGE_QUALITY_FASTER + , vg_IMAGE_QUALITY_BETTER = VG_IMAGE_QUALITY_BETTER + } + +#{enum VGenum, + , vg_IMAGE_FORMAT = VG_IMAGE_FORMAT + , vg_IMAGE_WIDTH = VG_IMAGE_WIDTH + , vg_IMAGE_HEIGHT = VG_IMAGE_HEIGHT + } + +#{enum VGenum, + , vg_DRAW_IMAGE_NORMAL = VG_DRAW_IMAGE_NORMAL + , vg_DRAW_IMAGE_MULTIPLY = VG_DRAW_IMAGE_MULTIPLY + , vg_DRAW_IMAGE_STENCIL = VG_DRAW_IMAGE_STENCIL + } + +#{enum VGenum, + , vg_RED = VG_RED + , vg_GREEN = VG_GREEN + , vg_BLUE = VG_BLUE + , vg_ALPHA = VG_ALPHA + } + +#{enum VGenum, + , vg_BLEND_SRC = VG_BLEND_SRC + , vg_BLEND_SRC_OVER = VG_BLEND_SRC_OVER + , vg_BLEND_DST_OVER = VG_BLEND_DST_OVER + , vg_BLEND_SRC_IN = VG_BLEND_SRC_IN + , vg_BLEND_DST_IN = VG_BLEND_DST_IN + , vg_BLEND_MULTIPLY = VG_BLEND_MULTIPLY + , vg_BLEND_SCREEN = VG_BLEND_SCREEN + , vg_BLEND_DARKEN = VG_BLEND_DARKEN + , vg_BLEND_LIGHTEN = VG_BLEND_LIGHTEN + , vg_BLEND_ADDITIVE = VG_BLEND_ADDITIVE + , vg_BLEND_SRC_OUT_SH = VG_BLEND_SRC_OUT_SH + , vg_BLEND_DST_OUT_SH = VG_BLEND_DST_OUT_SH + , vg_BLEND_SRC_ATOP_SH = VG_BLEND_SRC_ATOP_SH + , vg_BLEND_DST_ATOP_SH = VG_BLEND_DST_ATOP_SH + } + +#{enum VGenum, + , vg_IMAGE_FORMAT_QUERY = VG_IMAGE_FORMAT_QUERY + , vg_PATH_DATATYPE_QUERY = VG_PATH_DATATYPE_QUERY + } + +#{enum VGenum, + , vg_HARDWARE_ACCELERATED = VG_HARDWARE_ACCELERATED + , vg_HARDWARE_UNACCELERATED = VG_HARDWARE_UNACCELERATED + } + +#{enum VGenum, + , vg_VENDOR = VG_VENDOR + , vg_RENDERER = VG_RENDERER + , vg_VERSION = VG_VERSION + , vg_EXTENSIONS = VG_EXTENSIONS + } + +-- end of file + diff --git a/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs b/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/DrawingContext.hs @@ -0,0 +1,41 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.ShivaExtensions +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 4.3 (Forcing Drawing to Complete) +-- of the OpenVG 1.0.1 specs. +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.DrawingContext ( + + -- * Forcing drawing to complete + flush, + finish +) where + + +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgFlush, vgFinish ) + +-------------------------------------------------------------------------------- +-- Forcing drawing to complete + +-- | @flush@ - corresponds directly to the OpenVG call @vgFlush@. +flush :: IO () +flush = vgFlush + +-- | @finish@ - corresponds directly to the OpenVG call @vgFinish@. +finish :: IO () +finish = vgFinish + + + diff --git a/src/Graphics/Rendering/OpenVG/VG/Extending.hs b/src/Graphics/Rendering/OpenVG/VG/Extending.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Extending.hs @@ -0,0 +1,62 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Extending +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 14 (Extending the API) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Extending ( + -- * Accessing extensions dynamically + StringID(..), + stringId, +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( VGenum ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( vgGetString ) +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_VENDOR, vg_RENDERER, vg_VERSION, vg_EXTENSIONS ) + +import Graphics.Rendering.OpenGL.GL.StateVar ( + GettableStateVar, makeGettableStateVar ) + +import Foreign.C.String ( peekCString ) + +-------------------------------------------------------------------------------- +-- Accessing extensions dynamically + +data StringID = + Vendor + | Renderer + | Version + | Extensions + deriving ( Eq, Ord, Show ) + + + +-- | Query the OpenVG implementation. +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 + Extensions -> vg_EXTENSIONS + diff --git a/src/Graphics/Rendering/OpenVG/VG/Images.hs b/src/Graphics/Rendering/OpenVG/VG/Images.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Images.hs @@ -0,0 +1,454 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Images +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 10 (Images) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Images ( + -- * Image quality + ImageQuality(..), + imageQuality, + + -- * Image formats + ImageFormat(..), + + -- * Creating and destroying images + maxImageWidth, maxImageHeight, maxImagePixels, maxImageBytes, + + withImage, + createImage, + destroyImage, + + + -- * Querying images + imageFormat, imageWidth, imageHeight, + + -- * Reading and writing image pixels + clearImage, + + imageSubData, getImageSubData, + + -- * Copying pixels between images + copyImage, + + -- * Drawing iamges to the drawing surface + ImageMode(..), + drawImageMode, + drawImage, + + -- * Reading and writing drawing surface pixels + setPixels, writePixels, getPixels, readPixels, + + -- * Copying portions of the drawing surface + copyPixels, + + +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGenum, VGint, VGImage, marshalBool ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgCreateImage, vgDestroyImage, vgClearImage, + vgImageSubData, vgGetImageSubData, + vgCopyImage, vgDrawImage, + vgSetPixels, vgWritePixels, vgGetPixels, vgReadPixels, vgCopyPixels ) +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_sRGBX_8888, vg_sRGBA_8888, vg_sRGBA_8888_PRE, vg_sRGB_565, + vg_sRGBA_5551, vg_sRGBA_4444, vg_sL_8, vg_lRGBX_8888, + vg_lRGBA_8888, vg_lRGBA_8888_PRE, vg_lL_8, vg_A_8, vg_BW_1, + + vg_sXRGB_8888, vg_sARGB_8888, vg_sARGB_8888_PRE, vg_sARGB_1555, + vg_sARGB_4444, vg_lXRGB_8888, vg_lARGB_8888, vg_lARGB_8888_PRE, + vg_sBGRX_8888, vg_sBGRA_8888, vg_sBGRA_8888_PRE, vg_sBGR_565, + vg_sBGRA_5551, vg_sBGRA_4444, vg_lBGRX_8888, vg_lBGRA_8888, + vg_lBGRA_8888_PRE, vg_sXBGR_8888, vg_sABGR_8888, + vg_sABGR_8888_PRE, vg_sABGR_1555, vg_sABGR_4444, vg_lXBGR_8888, + vg_lABGR_8888, vg_lABGR_8888_PRE, + + vg_IMAGE_QUALITY_NONANTIALIASED, vg_IMAGE_QUALITY_FASTER, + vg_IMAGE_QUALITY_BETTER, + vg_IMAGE_FORMAT, vg_IMAGE_WIDTH, vg_IMAGE_HEIGHT, + vg_DRAW_IMAGE_NORMAL, vg_DRAW_IMAGE_MULTIPLY, vg_DRAW_IMAGE_STENCIL ) + +import Graphics.Rendering.OpenVG.VG.Parameters ( + seti, geti, getParameteri, + ParamType ( ImageQuality, ImageMode, + MaxImageWidth, MaxImageHeight, + MaxImagePixels, MaxImageBytes ) ) +import Graphics.Rendering.OpenVG.VG.Utils ( + Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral, bitwiseOr ) + +import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size (..) ) +import Graphics.Rendering.OpenGL.GL.StateVar ( + GettableStateVar, makeGettableStateVar, + SettableStateVar, makeSettableStateVar ) + + +import Foreign.Ptr ( Ptr ) + + +-------------------------------------------------------------------------------- +-- Image quality + +data ImageQuality = + Nonantialiased + | Faster + | Better + deriving ( Eq, Ord, Show ) + + +-- | Set the image quality - @imageQuality@ is typed wrapper +-- over this equivalent OpenVG code: +-- +-- @ VGImageQuality quality; @ +-- +-- @ vgSeti(VG_IMAGE_QUALITY, quality); @ +imageQuality :: SettableStateVar ImageQuality +imageQuality = makeSettableStateVar $ \mode -> + seti ImageQuality (fromIntegral $ marshalImageQuality mode) + + +-------------------------------------------------------------------------------- +-- Image formats + +-- | ImageFormat enumerates /all/ the image formats supported by OpenVG. +-- ShivaVG currently only supports @sRGBA_8888@. +data ImageFormat = + -- RGB{A,X} channel ordering + SRGBX8888 + | SRGBA8888 + | SRGBA8888Pre + | SRGB565 + | SRGBA5551 + | SRGBA4444 + | SL8 + | LRGBX8888 + | LRGBA8888 + | LRGBA8888Pre + | LL8 + | A8 + | BW1 + -- {A,X}RGB channel ordering + | SXRGB8888 + | SARGB8888 + | SARGB8888Pre + | SARGB1555 + | SARGB4444 + | LXRGB8888 + | LARGB8888 + | LARGB8888Pre + -- BGR{A,X} channel ordering + | SBGRX8888 + | SBGRA8888 + | SBGRA8888Pre + | SBGR565 + | SBGRA5551 + | SBGRA4444 + | LBGRX8888 + | LBGRA8888 + | LBGRA8888Pre + -- {A,X}BGR channel ordering + | SXBGR8888 + | SABGR8888 + | SABGR8888Pre + | SABGR1555 + | SABGR4444 + | LXBGR8888 + | LABGR8888 + | LABGR8888Pre + deriving ( Eq, Ord, Show ) + + + + +-------------------------------------------------------------------------------- +-- Creating and destroying images + +-- | Get the maximum available width for the 'createImage' function. +-- @maxImageWidth@ is equivalent to this OpenVG code: +-- +-- @ 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); @ +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: +-- +-- @ 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: +-- +-- @ 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@. +createImage :: ImageFormat -> Size -> [ImageQuality] -> IO VGImage +createImage SRGBA8888 (Size w h) qs = + vgCreateImage (marshal SRGBA8888) w h (bitwiseOr qs) +createImage _ _ _ = error $ "unsupported image format" + + +-- | @destroyImage@ corresponds to the OpenVG function @vgDestroyImage@. +destroyImage :: VGImage -> IO () +destroyImage = vgDestroyImage + + +-------------------------------------------------------------------------------- +-- Querying images + +-- | Get the ImageFormat used to defined the image. +imageFormat :: VGImage -> GettableStateVar ImageFormat +imageFormat h = makeGettableStateVar $ do + a <- getParameteri h vg_IMAGE_FORMAT + return $ unmarshalIntegral a + +-- | Get the width used to defined the image. +imageWidth :: VGImage -> GettableStateVar VGint +imageWidth h = makeGettableStateVar $ getParameteri h vg_IMAGE_WIDTH + +-- | Get the height used to defined the image. +imageHeight :: VGImage -> GettableStateVar VGint +imageHeight h = makeGettableStateVar $ getParameteri h vg_IMAGE_HEIGHT + + +-------------------------------------------------------------------------------- +-- Reading and writing image pixels + +-- | Fill the given rectangle inside the image with the current color setting +-- from the @StateVar@ 'clearColor' +clearImage :: VGImage -> Position -> Size -> IO () +clearImage handle (Position x y) (Size w h) = vgClearImage handle x y w h + + +-- | @imageSubData@ corresponds to the OpenVG function @vgImageSubData@. +imageSubData :: VGImage -> Ptr a -> VGint -> ImageFormat + -> Position -> Size -> IO () +imageSubData image imgdata stride fmt (Position x y) (Size w h) = + vgImageSubData image imgdata stride (marshalImageFormat fmt) x y w h + +-- | @getImageSubData@ corresponds to the OpenVG function @vgGetImageSubData@. +getImageSubData :: VGImage -> Ptr a -> VGint -> ImageFormat + -> Position -> Size -> IO () +getImageSubData image imgdata stride fmt (Position x y) (Size w h) = + vgGetImageSubData image imgdata stride (marshalImageFormat fmt) x y w h + +-------------------------------------------------------------------------------- + +-- childImage - not implemented in shiva-vg +-- getParent - not implemented in shiva-vg + +-------------------------------------------------------------------------------- +-- Copying 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) (Size w h) dither = + vgCopyImage dst dx dy src sx sy w h (marshalBool dither) + +-------------------------------------------------------------------------------- +-- Drawing iamges to the drawing surface + +-- | Styles of image drawing +data ImageMode = + Normal + | Multiply + | Stencil + deriving ( Eq, Ord, Show ) + +-- | Set the image drawing mode - @drawImageMode@ is typed wrapper +-- over this equivalent OpenVG code: +-- +-- @ VGImageMode drawImageMode; @ +-- +-- @ vgSeti(VG_IMAGE_MODE, drawImageMode); @ +drawImageMode :: SettableStateVar ImageMode +drawImageMode = makeSettableStateVar $ \mode -> + seti ImageMode (enumValue mode) + +-- | @drawImage@ corresponds to the OpenVG function @vgDrawImage@. +drawImage :: VGImage -> IO () +drawImage = vgDrawImage + + +-------------------------------------------------------------------------------- +-- Reading and writing drawing surface pixels + +-- | @setPixels@ corresponds to the OpenVG function @vgSetPixels@. +setPixels :: Position -> VGImage -> Position -> Size -> IO () +setPixels (Position dx dy) src (Position sx sy) (Size w h) = + vgSetPixels dx dy src sx sy w h + +-- | @writePixels@ corresponds to the OpenVG function @vgWritePixels@. +writePixels :: Ptr a -> VGint -> ImageFormat -> Position -> Size -> IO () +writePixels pixeldata stride fmt (Position dx dy) (Size w h) = + vgWritePixels pixeldata stride (marshal fmt) dx dy w h + +-- | @getPixels@ corresponds to the OpenVG function @vgGetPixels@. +getPixels :: VGImage -> Position -> Position -> Size -> IO () +getPixels dst (Position dx dy) (Position sx sy) (Size w h) = + vgGetPixels dst dx dy sx sy w h + +-- | @readPixels@ corresponds to the OpenVG function @vgReadPixels@. +readPixels :: Ptr a -> VGint -> ImageFormat -> Position -> Size -> IO () +readPixels pixeldata stride fmt (Position sx sy) (Size w h) = + vgReadPixels pixeldata stride (marshal fmt) sx sy w h + +-------------------------------------------------------------------------------- +-- Copying portions of the drawing surface + +-- | @copyPixels@ corresponds to the OpenVG function @vgCopyPixels@. +copyPixels :: Position -> Position -> Size -> IO () +copyPixels (Position dx dy) (Position sx sy) (Size w h) = + vgCopyPixels dx dy sx sy w h + + + + + +-------------------------------------------------------------------------------- + +marshalImageFormat :: ImageFormat -> VGenum +marshalImageFormat x = case x of + 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 + 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 + SARGB8888Pre -> vg_sARGB_8888_PRE + 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 + 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 + LBGRA8888Pre -> vg_lBGRA_8888_PRE + 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 + LABGR8888Pre -> vg_lABGR_8888_PRE + +instance Marshal ImageFormat where marshal = marshalImageFormat + +unmarshalImageFormat :: VGenum -> ImageFormat +unmarshalImageFormat x + | x == vg_sRGBX_8888 = SRGBX8888 + | x == vg_sRGBA_8888 = SRGBA8888 + | x == vg_sRGBA_8888_PRE = SRGBA8888Pre + | x == vg_sRGB_565 = SRGB565 + | x == vg_sRGBA_5551 = SRGBA5551 + | x == vg_sRGBA_4444 = SRGBA4444 + | x == vg_sL_8 = SL8 + | x == vg_lRGBX_8888 = LRGBX8888 + | x == vg_lRGBA_8888 = LRGBA8888 + | x == vg_lRGBA_8888_PRE = LRGBA8888Pre + | x == vg_lL_8 = LL8 + | x == vg_A_8 = A8 + | x == vg_BW_1 = BW1 + -- FormatA1 = (not supported in shiva-vg) + -- FormatA4 = (not supported in shiva-vg) + | x == vg_sXRGB_8888 = SXRGB8888 + | x == vg_sARGB_8888 = SARGB8888 + | x == vg_sARGB_8888_PRE = SARGB8888Pre + | x == vg_sARGB_1555 = SARGB1555 + | x == vg_sARGB_4444 = SARGB4444 + | x == vg_lXRGB_8888 = LXRGB8888 + | x == vg_lARGB_8888 = LARGB8888 + | x == vg_lARGB_8888_PRE = LARGB8888Pre + | x == vg_sBGRX_8888 = SBGRX8888 + | x == vg_sBGRA_8888 = SBGRA8888 + | x == vg_sBGRA_8888_PRE = SBGRA8888Pre + | x == vg_sBGR_565 = SBGR565 + | x == vg_sBGRA_5551 = SBGRA5551 + | x == vg_sBGRA_4444 = SBGRA4444 + | x == vg_lBGRX_8888 = LBGRX8888 + | x == vg_lBGRA_8888 = LBGRA8888 + | x == vg_lBGRA_8888_PRE = LBGRA8888Pre + | x == vg_sXBGR_8888 = SXBGR8888 + | x == vg_sABGR_8888 = SABGR8888 + | x == vg_sABGR_8888_PRE = SABGR8888Pre + | x == vg_sABGR_1555 = SABGR1555 + | x == vg_sABGR_4444 = SABGR4444 + | x == vg_lXBGR_8888 = LXBGR8888 + | x == vg_lABGR_8888 = LABGR8888 + | 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 + +instance Marshal ImageQuality where marshal = marshalImageQuality + + + +marshalImageMode :: ImageMode -> VGenum +marshalImageMode x = case x of + Normal -> vg_DRAW_IMAGE_NORMAL + Multiply -> vg_DRAW_IMAGE_MULTIPLY + Stencil -> vg_DRAW_IMAGE_STENCIL + +instance Marshal ImageMode where marshal = marshalImageMode + diff --git a/src/Graphics/Rendering/OpenVG/VG/Paint.hs b/src/Graphics/Rendering/OpenVG/VG/Paint.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Paint.hs @@ -0,0 +1,262 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Paint +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 9 (Paint) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Paint ( + -- * Creating and destroying paint objects + withPaint, + createPaint, destroyPaint, + + -- * Setting the current paint + setPaint, getPaint, + + -- * Setting paint parameters + PaintType(..), + paintType, + paintColor, + colorRampSpreadMode, + colorRampStops, + colorRampPremultiplied, + LinearGradient, + linearGradient, + RadialGradient, + radialGradient, + tilingMode, + + maxStops, + paintPattern, +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGenum, VGint, VGfloat, VGImage, VGPaint, Point ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgCreatePaint, vgDestroyPaint, + vgSetPaint, + vgPaintPattern ) + +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_PAINT_TYPE, vg_PAINT_COLOR, vg_PAINT_COLOR_RAMP_SPREAD_MODE, + vg_PAINT_COLOR_RAMP_STOPS, vg_PAINT_COLOR_RAMP_PREMULTIPLIED, + vg_PAINT_LINEAR_GRADIENT, vg_PAINT_RADIAL_GRADIENT, + vg_PAINT_PATTERN_TILING_MODE, + + vg_PAINT_TYPE_COLOR, vg_PAINT_TYPE_LINEAR_GRADIENT, + vg_PAINT_TYPE_RADIAL_GRADIENT, vg_PAINT_TYPE_PATTERN, + + vg_COLOR_RAMP_SPREAD_PAD, vg_COLOR_RAMP_SPREAD_REPEAT, + 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.OpenGL.GL.StateVar ( + StateVar(), makeStateVar, + SettableStateVar, makeSettableStateVar, + GettableStateVar, makeGettableStateVar ) +import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) ) + +-------------------------------------------------------------------------------- +-- Creating and destroying paint objects + + +-- | @withPaint@ - create a paint object, run an action on it, destroy the +-- paint object. +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. +setPaint :: VGPaint -> SettableStateVar [PaintMode] +setPaint h = makeSettableStateVar $ \ms -> vgSetPaint h (bitwiseOr ms) + + +-- | 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. +getPaint :: PaintMode -> GettableStateVar VGPaint +getPaint paint_mode = makeGettableStateVar $ vgGetPaint (marshal paint_mode) + where + vgGetPaint :: VGenum -> IO VGPaint + vgGetPaint = error "vgGetPaint - error" + +-------------------------------------------------------------------------------- +-- Setting paint parameters + +-- | PaintType determines the type of paint to be applied. +data PaintType = + Color + | LinearGradient + | RadialGradient + | Pattern + deriving ( Eq, Ord, Show ) + +-- Control the PaintType of the supplied handle, the default value 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 + + setPaintType :: VGPaint -> PaintType -> IO () + setPaintType h v = + setParameteri h vg_PAINT_TYPE (enumValue v) + + +-- Control the color of the supplied handle, the default value is +-- @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] + +-- | Spread modes define how the color ramp stops are extended or +-- repeated to define interpolated color. +data ColorRampSpreadMode = + CPad + | CRepeat + | CReflect + deriving ( Eq, Ord, Show ) + +-- | Control the @ColorRampSpreadMode@ of the supplied handle, +-- 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) + + +-- paintColorRampStops - is [VGfloat] good enough, or should it be +-- [Color4 VGfloat]? + +-- | Control the color ramp stops of the supplied handle, +-- the default value is @[]@. +colorRampStops :: VGPaint -> SettableStateVar [VGfloat] +colorRampStops h = makeSettableStateVar $ + \xs -> setParameterfv h vg_PAINT_COLOR_RAMP_STOPS xs + + +-- | Control the color ramp stops of the supplied handle, +-- the default value is @[]@. +colorRampPremultiplied :: VGPaint -> SettableStateVar Bool +colorRampPremultiplied h = makeSettableStateVar $ + \a -> setParameteri h vg_PAINT_COLOR_RAMP_PREMULTIPLIED (enumValue a) + +type LinearGradient = (Point,Point) + +linearGradient :: VGPaint -> SettableStateVar LinearGradient +linearGradient h = makeSettableStateVar $ \((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) + +radialGradient :: VGPaint -> SettableStateVar RadialGradient +radialGradient h = makeSettableStateVar $ \((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] + +data TilingMode = + TFill + | TPad + | TRepeat + | TReflect + deriving ( Eq, Ord, Show ) + +-- | Control the @TilingMode@ of the supplied handle, +-- 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) + + +-- | 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 + + +-------------------------------------------------------------------------------- + + + + +marshalPaintType :: PaintType -> VGenum +marshalPaintType x = case x of + 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 + + +unmarshalPaintType :: VGenum -> PaintType +unmarshalPaintType x + | x == vg_PAINT_TYPE_COLOR = Color + | x == vg_PAINT_TYPE_LINEAR_GRADIENT = LinearGradient + | x == vg_PAINT_TYPE_RADIAL_GRADIENT = RadialGradient + | 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 + 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 + 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 new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Parameters.hs @@ -0,0 +1,212 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Parameters +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 5 (Setting API Parameters) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Parameters ( + ParamType(..), marshalParamType, + setf, seti, setfv, setiv, + getf, geti, getVectorSize, getfv, getiv, + setParameterf, setParameteri, setParameterfv, setParameteriv, + getParameterf, getParameteri, getParameterVectorSize, + getParameterfv, getParameteriv +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGenum, VGfloat, VGint, VGHandle ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgSetf, vgSeti, vgSetfv, vgSetiv, + vgGetf, vgGeti, vgGetVectorSize, vgGetfv, vgGetiv, + + vgSetParameterf, vgSetParameteri, vgSetParameterfv, vgSetParameteriv, + vgGetParameterf, vgGetParameteri, vgGetParameterVectorSize, + vgGetParameterfv, vgGetParameteriv ) + +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_MATRIX_MODE, vg_FILL_RULE, vg_IMAGE_QUALITY, vg_RENDERING_QUALITY, + vg_BLEND_MODE, vg_IMAGE_MODE, vg_SCISSOR_RECTS, vg_STROKE_LINE_WIDTH, + vg_STROKE_CAP_STYLE, vg_STROKE_JOIN_STYLE, vg_STROKE_MITER_LIMIT, + vg_STROKE_DASH_PATTERN, vg_STROKE_DASH_PHASE, vg_STROKE_DASH_PHASE_RESET, + vg_TILE_FILL_COLOR, vg_CLEAR_COLOR, vg_MASKING, + vg_SCISSORING, vg_PIXEL_LAYOUT, vg_SCREEN_LAYOUT, vg_FILTER_FORMAT_LINEAR, + vg_FILTER_FORMAT_PREMULTIPLIED, vg_FILTER_CHANNEL_MASK, + vg_MAX_SCISSOR_RECTS, vg_MAX_DASH_COUNT, vg_MAX_KERNEL_SIZE, + vg_MAX_SEPARABLE_KERNEL_SIZE, vg_MAX_COLOR_RAMP_STOPS, + vg_MAX_IMAGE_WIDTH, vg_MAX_IMAGE_HEIGHT, vg_MAX_IMAGE_PIXELS, + vg_MAX_IMAGE_BYTES, vg_MAX_FLOAT, vg_MAX_GAUSSIAN_STD_DEVIATION ) + +import Foreign.Marshal.Array ( newArray, peekArray ) + + +data ParamType = + MatrixMode + | FillRule + | ImageQuality + | RenderingQuality + | BlendMode + | ImageMode + | ScissorRects + | StrokeLineWidth + | StrokeCapStyle + | StrokeJoinStyle + | StrokeMiterLimit + | StrokeDashPattern + | StrokeDashPhase + | StrokeDashPhaseReset + | TileFillColor + | ClearColor + -- | GlyphOrigin {- Not in shiva-vg -} + | Masking + | Scissoring + | PixelLayout + | ScreenLayout + | FilterFormatLinear + | FilterFormatPremultiplied + | FilterChannelMask + | MaxScissorRects + | MaxDashCount + | MaxKernelSize + | MaxSaparableKernelSize + | MaxColorRampStops + | MaxImageWidth + | MaxImageHeight + | MaxImagePixels + | MaxImageBytes + | MaxFloat + | MaxGaussianStdDeviation + deriving ( Eq, Ord, Show ) + +setf :: ParamType -> VGfloat -> IO () +setf typ val = vgSetf (marshalParamType typ) val + +seti :: ParamType -> VGint -> IO () +seti typ val = vgSeti (marshalParamType typ) val + +-- vgSetfv :: VGenum -> VGint -> Ptr VGfloat -> IO () +-- TODO - Lists or arrays? +setfv :: ParamType -> [VGfloat] -> IO () +setfv typ vals = do + a <- newArray vals + vgSetfv (marshalParamType typ) (fromIntegral $ length vals) a + +setiv :: ParamType -> [VGint] -> IO () +setiv typ vals = do + a <- newArray vals + vgSetiv (marshalParamType typ) (fromIntegral $ length vals) a + + +getf :: ParamType -> IO VGfloat +getf typ = vgGetf (marshalParamType typ) + +geti :: ParamType -> IO VGint +geti typ = vgGeti (marshalParamType typ) + + +getVectorSize :: ParamType -> IO VGint +getVectorSize typ = vgGetVectorSize (marshalParamType typ) + +getfv :: ParamType -> VGint -> IO [VGfloat] +getfv typ i = do + ptr <- vgGetfv (marshalParamType typ) i + peekArray (fromIntegral i) ptr + +getiv :: ParamType -> VGint -> IO [VGint] +getiv typ i = do + ptr <- vgGetiv (marshalParamType typ) i + peekArray (fromIntegral i) ptr + + +setParameterf :: VGHandle -> VGenum -> VGfloat -> IO () +setParameterf = vgSetParameterf + +setParameteri :: VGHandle -> VGenum -> VGint -> IO () +setParameteri = vgSetParameteri + +setParameterfv :: VGHandle -> VGenum -> [VGfloat] -> IO () +setParameterfv h typ vals = do + a <- newArray vals + vgSetParameterfv h typ (fromIntegral $ length vals) a + +setParameteriv :: VGHandle -> VGenum -> [VGint] -> IO () +setParameteriv h typ vals = do + a <- newArray vals + vgSetParameteriv h typ (fromIntegral $ length vals) a + +getParameterf :: VGHandle -> VGenum -> IO VGfloat +getParameterf = vgGetParameterf + +getParameteri :: VGHandle -> VGenum -> IO VGint +getParameteri = vgGetParameteri + + +getParameterVectorSize :: VGHandle -> VGenum -> IO VGint +getParameterVectorSize = vgGetParameterVectorSize + +getParameterfv :: VGHandle -> VGenum -> VGint -> IO [VGfloat] +getParameterfv h typ i = do + ptr <- vgGetParameterfv h typ i + peekArray (fromIntegral i) ptr + +getParameteriv :: VGHandle -> VGenum -> VGint -> IO [VGint] +getParameteriv h typ i = do + ptr <- vgGetParameteriv h typ i + peekArray (fromIntegral i) ptr + +-------------------------------------------------------------------------------- + +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 + 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 + +-------------------------------------------------------------------------------- + + + diff --git a/src/Graphics/Rendering/OpenVG/VG/Paths.hs b/src/Graphics/Rendering/OpenVG/VG/Paths.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Paths.hs @@ -0,0 +1,576 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Paths +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 8 (Paths) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Paths ( + -- * Datatypes + PathDatatype(..), + PathType(..), + PathCommand(..), + + + -- * Creating and destroying paths + PathCapabilities(..), + withPath, + createPath, clearPath, destroyPath, + + -- * Path queries + format, datatype, pathScale, bias, numSegments, numCoords, + + -- * Querying and modifying path capabilities + getPathCapabilities, + removePathCapabilities, + + -- * Copying data between paths + appendPath, + + -- * Appending client-side data to a path. + StorablePathData, -- don't export the member as the instances are fixed + appendPathData, + + -- * Modifying path data + modifyPathCoords, + + -- * Transforming a path + transformPath, + + -- * Interpolating between paths + interpolatePath, + + -- * Setting stroke parameters + lineWidth, + CapStyle(..), capStyle, + JoinStyle(..), joinStyle, + miterLimit, + maxDashCount, + dashPattern, disableDashPattern, + dashPhase, + dashPhaseReset, + + -- * Filling or stroking a path + FillRule(..), fillRule, + PaintMode(..), marshalPaintMode, + drawPath, + fillPath, + strokePath, + fillStrokePath +) where + + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGenum, VGint, VGfloat, VGPath, marshalBool, unmarshalBool ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgCreatePath, vgClearPath, vgDestroyPath, + vgRemovePathCapabilities, vgGetPathCapabilities, + vgAppendPath, vgAppendPathData, vgModifyPathCoords, + vgTransformPath, vgInterpolatePath, + vgDrawPath ) +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_PATH_DATATYPE_S_8, vg_PATH_DATATYPE_S_16, + vg_PATH_DATATYPE_S_32, vg_PATH_DATATYPE_F, + vg_PATH_FORMAT_STANDARD, + + vg_CLOSE_PATH, + vg_MOVE_TO_ABS, vg_MOVE_TO_REL, + vg_LINE_TO_ABS, vg_LINE_TO_REL, + vg_HLINE_TO_ABS, vg_HLINE_TO_REL, + vg_VLINE_TO_ABS, vg_VLINE_TO_REL, + vg_QUAD_TO_ABS, vg_QUAD_TO_REL, + vg_CUBIC_TO_ABS, vg_CUBIC_TO_REL, + vg_SQUAD_TO_ABS, vg_SQUAD_TO_REL, + vg_SCUBIC_TO_ABS, vg_SCUBIC_TO_REL, + vg_SCCWARC_TO_ABS, vg_SCCWARC_TO_REL, + vg_SCWARC_TO_ABS, vg_SCWARC_TO_REL, + vg_LCCWARC_TO_ABS, vg_LCCWARC_TO_REL, + vg_LCWARC_TO_ABS, vg_LCWARC_TO_REL, + + vg_PATH_CAPABILITY_APPEND_FROM, vg_PATH_CAPABILITY_APPEND_TO, + vg_PATH_CAPABILITY_MODIFY, vg_PATH_CAPABILITY_TRANSFORM_FROM, + vg_PATH_CAPABILITY_TRANSFORM_TO, vg_PATH_CAPABILITY_INTERPOLATE_FROM, + vg_PATH_CAPABILITY_INTERPOLATE_TO, vg_PATH_CAPABILITY_PATH_LENGTH, + vg_PATH_CAPABILITY_POINT_ALONG_PATH, vg_PATH_CAPABILITY_TANGENT_ALONG_PATH, + vg_PATH_CAPABILITY_PATH_BOUNDS, vg_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS, + vg_PATH_CAPABILITY_ALL, + + vg_PATH_FORMAT, vg_PATH_DATATYPE, vg_PATH_SCALE, vg_PATH_BIAS, + vg_PATH_NUM_SEGMENTS, vg_PATH_NUM_COORDS, + vg_CAP_BUTT, vg_CAP_ROUND, vg_CAP_SQUARE, + vg_JOIN_MITER, vg_JOIN_ROUND, vg_JOIN_BEVEL, + vg_EVEN_ODD, vg_NON_ZERO, + vg_STROKE_PATH, vg_FILL_PATH ) +import Graphics.Rendering.OpenVG.VG.Parameters ( + ParamType ( FillRule, + StrokeLineWidth, StrokeCapStyle, + StrokeJoinStyle, StrokeMiterLimit, + StrokeDashPattern, + StrokeDashPhase, StrokeDashPhaseReset, + MaxDashCount ), + getParameteri, getParameterf, seti, setf, setfv, geti ) + +import Graphics.Rendering.OpenVG.VG.Utils ( + Marshal(..), Unmarshal(..), unmarshalIntegral, enumValue, + bitwiseOr, unbits ) + +import Graphics.Rendering.OpenGL.GL.StateVar ( + SettableStateVar, makeSettableStateVar, + GettableStateVar, makeGettableStateVar, + ( $= ) ) + +import Data.Int ( Int8, Int16, Int32 ) +import Foreign.Marshal.Array ( newArray ) +import Foreign.Storable ( Storable ) + +-------------------------------------------------------------------------------- +-- Datatypes + +-- | @PathDatatype@ defines the permissible numeric types for path +-- coordinate data. +data PathDatatype = + Int8 + | Int16 + | Int32 + | Float + deriving ( Eq, Ord, Show ) + +-- | @PathType@ corresponds to the OpenVG enumeration @VGPathAbsRel@. +data PathType = + 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@, +-- but includes ClosePath aka @VG_CLOSE_PATH@. +data PathCommand = + ClosePath + | MoveToAbs + | MoveToRel + | LineToAbs + | LineToRel + | HLineToAbs + | HLineToRel + | VLineToAbs + | VLineToRel + | QuadToAbs + | QuadToRel + | CubicToAbs + | CubicToRel + | SQuadToAbs + | SQuadToRel + | SCubicToAbs + | SCubicToRel + | SCCWArcToAbs + | SCCWArcToRel + | SCWArcToAbs + | SCWArcToRel + | LCCWArcToAbs + | LCCWArcToRel + | LCWArcToAbs + | LCWArcToRel + deriving ( Eq, Ord, Show ) + + + +-------------------------------------------------------------------------------- +-- Creating and destroying paths + +-- | PathCapabilities specify which operations may be performed on a +-- given path. +data PathCapabilities = + AppendFrom + | AppendTo + | Modify + | TransformFrom + | TransformTo + | InterpolateFrom + | InterpolateTo + | PathLength + | PointAlongPath + | TangentAlongPath + | PathBounds + | PathTransfomedBounds + | CapabilityAll + deriving ( Eq, Ord, Show ) + + +-- | @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 typ scl bi sch cch cs action = do + path <- createPath typ scl bi sch cch cs + ans <- action path + destroyPath path + return ans + + +-- | @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 typ scl bi sch cch cs = + vgCreatePath fmt (marshal typ) scl bi sch cch (bitwiseOr cs) + 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 + +-- | @clearPath@ corresponds to the OpenVG function @vgClearPath@. +clearPath :: VGPath -> [PathCapabilities] -> IO () +clearPath h cs = vgClearPath h (bitwiseOr cs) + +-- | @destroyPath@ corresponds to the OpenVG function @vgDestroyPath@. +destroyPath :: VGPath -> IO () +destroyPath = vgDestroyPath + +-------------------------------------------------------------------------------- +-- Path queries + +-- | @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 + +-- | @datatype@ - get the PathDatatype. +datatype :: VGPath -> GettableStateVar PathDatatype +datatype h = makeGettableStateVar $ do + a <- getParameteri h vg_PATH_DATATYPE + return $ unmarshalIntegral a + +-- | @pathScale@ - get the scaling factor of the path. +pathScale :: VGPath -> GettableStateVar VGfloat +pathScale h = makeGettableStateVar $ + getParameterf h vg_PATH_SCALE + +-- | @bias@ - get the bias factor of the path. +bias :: VGPath -> GettableStateVar VGfloat +bias h = makeGettableStateVar $ + getParameterf h 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@ - get the total number of coordinates stored in the path. +numCoords :: VGPath -> GettableStateVar VGint +numCoords h = makeGettableStateVar $ + getParameteri h vg_PATH_NUM_COORDS + + +-------------------------------------------------------------------------------- +-- Path capabilities + +-- | @getPathCapabilities@ corresponds to the OpenVG +-- function @vgGetPathCapabilities@. +getPathCapabilities :: VGPath -> IO [PathCapabilities] +getPathCapabilities h = do + b <- vgGetPathCapabilities h + return $ unbits b + +-- | @removePathCapabilities@ corresponds to the OpenVG +-- function @vgRemovePathCapabilities@. +removePathCapabilities :: VGPath -> [PathCapabilities] -> IO () +removePathCapabilities h cs = vgRemovePathCapabilities h (bitwiseOr cs) + +-------------------------------------------------------------------------------- +-- Copying data between paths + +-- | @appendPath@ corresponds to the OpenVG function @vgAppendPath@. +appendPath :: VGPath -> VGPath -> IO () +appendPath = vgAppendPath + + +-------------------------------------------------------------------------------- +-- Appending client-side data to a path + + +class Storable a => StorablePathData a + +instance StorablePathData Int8 +instance StorablePathData Int16 +instance StorablePathData Int32 +instance StorablePathData VGfloat + +-- | @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) + d_arr <- newArray ds + vgAppendPathData h (fromIntegral $ length cs) cmd_arr d_arr + + +-------------------------------------------------------------------------------- +-- Modifying path data + +-- | @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 + +-------------------------------------------------------------------------------- +-- Transforming a path + +-- | @transformPath@ corresponds to the OpenVG function @vgTransformPath@. +transformPath :: VGPath -> VGPath -> IO () +transformPath = vgTransformPath + +-------------------------------------------------------------------------------- +-- Querying the bounding box of a path + +-- pathBounds __ TODO + +-- pathTransformedBounds __ TODO + +-------------------------------------------------------------------------------- +-- 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 + + +-------------------------------------------------------------------------------- +-- Setting stroke parameters + +-- | Set the line width. +lineWidth :: SettableStateVar VGfloat +lineWidth = makeSettableStateVar $ \a -> + setf StrokeLineWidth a + +-- | @CapStyle@ corresponds to the OpenVG enumeration @VGCapStyle@. +data CapStyle = + CButt + | CRound + | CSquare + deriving ( Eq, Ord, Show ) + + +-- | Set the end cap style. +capStyle :: SettableStateVar CapStyle +capStyle = makeSettableStateVar $ \a -> + seti StrokeCapStyle (enumValue a) + +-- | @JoinStyle@ corresponds to the OpenVG enumeration @VGJoinStyle@. +data JoinStyle = + JMiter + | JRound + | JBevel + deriving ( Eq, Ord, Show ) + +-- | Set the join style. +joinStyle :: SettableStateVar JoinStyle +joinStyle = makeSettableStateVar $ \a -> + seti StrokeJoinStyle (enumValue a) + +-- | Set the miter limit. +miterLimit :: SettableStateVar VGfloat +miterLimit = makeSettableStateVar $ \a -> setf StrokeMiterLimit a + +-- | Get the maximum dash count supported by the implementation. +maxDashCount :: GettableStateVar VGint +maxDashCount = makeGettableStateVar $ + geti MaxDashCount + +-- | Set the dash pattern. +dashPattern :: SettableStateVar [VGfloat] +dashPattern = makeSettableStateVar $ \a -> setfv StrokeDashPattern a + +-- | Disable the dash pattern. +disableDashPattern :: IO () +disableDashPattern = dashPattern $= [] + +-- | Set the dash phase. +dashPhase :: SettableStateVar VGfloat +dashPhase = makeSettableStateVar $ \a -> + setf StrokeDashPhase a + +-- | Reset the dash phase. +dashPhaseReset :: SettableStateVar Bool +dashPhaseReset = makeSettableStateVar $ \a -> + seti StrokeDashPhaseReset (marshalBool a) + +-------------------------------------------------------------------------------- +-- Filling or stroking a path + +-- | @FillRule@ corresponds to the OpenVG enumeration @VGFillRule@. +data FillRule = + EvenOdd + | NonZero + deriving ( Eq, Ord, Show ) + +-- | Set the fill rule. +fillRule :: SettableStateVar FillRule +fillRule = makeSettableStateVar $ \a -> + seti FillRule (fromIntegral $ marshalFillRule a) + +-- | @PaintMode@ corresponds to the OpenVG enumeration @VGPaintMode@. +data PaintMode = + StrokePath + | FillPath + deriving ( Eq, Ord, Show ) + +-- | @drawPath@ corresponds to the OpenVG function @vgDrawPath@. +drawPath :: VGPath -> [PaintMode] -> IO () +drawPath h ps = vgDrawPath h (bitwiseOr ps) + +-- | Fill a path. +fillPath :: VGPath -> IO () +fillPath h = drawPath h [FillPath] + +-- | Stroke a path. +strokePath :: VGPath -> IO () +strokePath h = drawPath h [StrokePath] + +-- | Fill and stroke a path. +fillStrokePath :: VGPath -> IO () +fillStrokePath h = drawPath h [FillPath, StrokePath] + +-------------------------------------------------------------------------------- + +marshalPathDatatype :: PathDatatype -> VGenum +marshalPathDatatype x = case x of + 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 + | x == vg_PATH_DATATYPE_S_8 = Int8 + | x == vg_PATH_DATATYPE_S_16 = Int16 + | x == vg_PATH_DATATYPE_S_32 = Int32 + | 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 + SCCWArcToAbs -> vg_SCCWARC_TO_ABS + SCCWArcToRel -> vg_SCCWARC_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 + +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 + PathTransfomedBounds -> vg_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS + CapabilityAll -> vg_PATH_CAPABILITY_ALL + +instance Marshal PathCapabilities where marshal = marshalPathCapabilities + +unmarshalPathCapabilities :: VGenum -> PathCapabilities +unmarshalPathCapabilities x + | x == vg_PATH_CAPABILITY_APPEND_FROM = AppendFrom + | x == vg_PATH_CAPABILITY_APPEND_TO = AppendTo + | x == vg_PATH_CAPABILITY_MODIFY = Modify + | x == vg_PATH_CAPABILITY_TRANSFORM_FROM = TransformFrom + | x == vg_PATH_CAPABILITY_TRANSFORM_TO = TransformTo + | x == vg_PATH_CAPABILITY_INTERPOLATE_FROM = InterpolateFrom + | x == vg_PATH_CAPABILITY_INTERPOLATE_TO = InterpolateTo + | x == vg_PATH_CAPABILITY_PATH_LENGTH = PathLength + | x == vg_PATH_CAPABILITY_POINT_ALONG_PATH = PointAlongPath + | x == vg_PATH_CAPABILITY_TANGENT_ALONG_PATH = TangentAlongPath + | x == vg_PATH_CAPABILITY_PATH_BOUNDS = PathBounds + | x == vg_PATH_CAPABILITY_PATH_TRANSFORMED_BOUNDS = PathTransfomedBounds + | 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 + CSquare -> vg_CAP_SQUARE + +instance Marshal CapStyle where marshal = marshalCapStyle + +marshalJoinStyle :: JoinStyle -> VGenum +marshalJoinStyle x = case x of + JMiter -> vg_JOIN_MITER + JRound -> vg_JOIN_ROUND + JBevel -> vg_JOIN_BEVEL + +instance Marshal JoinStyle where marshal = marshalJoinStyle + +marshalFillRule :: FillRule -> VGenum +marshalFillRule x = case x of + EvenOdd -> vg_EVEN_ODD + NonZero -> vg_NON_ZERO + +marshalPaintMode :: PaintMode -> VGenum +marshalPaintMode x = case x of + StrokePath -> vg_STROKE_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 new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/RenderingQuality.hs @@ -0,0 +1,201 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.RenderingQuality +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 6 (Rendering Quality and Antialiasing) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.RenderingQuality ( + + -- * Rendering quality + RenderingQuality(..), + renderingQuality, + + -- * Additional quality settings + PixelLayout(..), + pixelLayout, + + -- * Matrix manipulation + MatrixMode(..), + matrixMode, + + loadIdentity, + loadMatrix, + getMatrix, + multMatrix, + translate, + scale, + shear, + rotate +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGfloat, VGenum ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgLoadIdentity, vgLoadMatrix, vgGetMatrix, vgMultMatrix, + vgTranslate, vgScale, vgShear, vgRotate + ) +import Graphics.Rendering.OpenVG.VG.Constants ( + vg_RENDERING_QUALITY_NONANTIALIASED, vg_RENDERING_QUALITY_FASTER, + vg_RENDERING_QUALITY_BETTER, + -- + vg_PIXEL_LAYOUT_UNKNOWN, + vg_PIXEL_LAYOUT_RGB_VERTICAL, vg_PIXEL_LAYOUT_BGR_VERTICAL, + vg_PIXEL_LAYOUT_RGB_HORIZONTAL, vg_PIXEL_LAYOUT_BGR_HORIZONTAL, + -- + vg_MATRIX_PATH_USER_TO_SURFACE, vg_MATRIX_IMAGE_USER_TO_SURFACE, + vg_MATRIX_FILL_PAINT_TO_USER, vg_MATRIX_STROKE_PAINT_TO_USER, + ) +import Graphics.Rendering.OpenVG.VG.Parameters ( + ParamType ( MatrixMode, RenderingQuality, ScreenLayout ), + seti, geti ) +import Graphics.Rendering.OpenVG.VG.Utils ( + Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral ) + +import Graphics.Rendering.OpenGL.GL.StateVar ( + StateVar(), makeStateVar, SettableStateVar, makeSettableStateVar ) + +import Foreign.Ptr ( Ptr ) + + +-------------------------------------------------------------------------------- +-- Rendering quality + +-- | @RenderingQuality@ corresponds to the OpenVG +-- enumeration @VGRenderingQuality@. +data RenderingQuality = + Nonantialiased' + | Faster' + | Better' + deriving ( Eq, Ord, Show ) + +-- | Set the rendering quality - the default is /Better/. +renderingQuality :: SettableStateVar RenderingQuality +renderingQuality = makeSettableStateVar $ \mode -> + seti RenderingQuality (enumValue mode) + +-------------------------------------------------------------------------------- +-- Additional quality settings + +-- | @PixelLayout@ corresponds to the OpenVG enumeration @VGPixelLayout@. +data PixelLayout = + Unknown + | RgbVertical + | BgrVertical + | RgbHorizontal + | BgrHorizontal + deriving ( Eq, Ord, Show ) + +-- | @pixelLayout@ - a @StateVar@ to get and set the pixel layout. +pixelLayout :: StateVar PixelLayout +pixelLayout = makeStateVar getPixelLayout setPixelLayout + where + getPixelLayout :: IO PixelLayout + getPixelLayout = do + a <- geti ScreenLayout + return $ unmarshalIntegral a + + setPixelLayout :: PixelLayout -> IO () + setPixelLayout a = seti ScreenLayout (enumValue a) + +-------------------------------------------------------------------------------- +-- Matrix manipulation + +-- | @MatrixMode@ corresponds to the OpenVG enumeration @VGMatrixMode@. +data MatrixMode = + PathUserToSurface + | ImageUserToSurface + | FillPaintToUser + | StrokePaintToUser + deriving ( Eq, Ord, Show ) + +-- | Set the matrix mode. +matrixMode :: SettableStateVar MatrixMode +matrixMode = makeSettableStateVar $ \mode -> + seti MatrixMode (enumValue mode) + +-- | @loadIdentity@ corresponds to the OpenVG function @vgLoadIdentity@. +loadIdentity :: IO () +loadIdentity = vgLoadIdentity + +-- | @loadMatrix@ corresponds to the OpenVG function @vgLoadMatrix@. +loadMatrix :: Ptr VGfloat -> IO () +loadMatrix = vgLoadMatrix + +-- | @getMatrix@ - TODO. +getMatrix :: IO (Ptr VGfloat) +getMatrix = vgGetMatrix + +-- | @multMatrix@ - TODO. +multMatrix :: Ptr VGfloat -> IO () +multMatrix = vgMultMatrix + +-- | @translate@ corresponds to the OpenVG function @vgTranslate@. +translate :: VGfloat -> VGfloat -> IO () +translate = vgTranslate + +-- | @scale@ corresponds to the OpenVG function @vgScale@. +scale :: VGfloat -> VGfloat -> IO () +scale = vgScale + +-- | @shear@ corresponds to the OpenVG function @vgShear@. +shear :: VGfloat -> VGfloat -> IO () +shear = vgShear + +-- | @rotate@ corresponds to the OpenVG function @vgRotate@. +rotate :: VGfloat -> IO () +rotate = vgRotate + + +-------------------------------------------------------------------------------- + +marshalRenderingQuality :: RenderingQuality -> VGenum +marshalRenderingQuality x = case x of + Nonantialiased' -> vg_RENDERING_QUALITY_NONANTIALIASED + 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 + RgbHorizontal -> vg_PIXEL_LAYOUT_RGB_HORIZONTAL + BgrHorizontal -> vg_PIXEL_LAYOUT_BGR_HORIZONTAL + +instance Marshal PixelLayout where marshal = marshalPixelLayout + + +unmarshalPixelLayout :: VGenum -> PixelLayout +unmarshalPixelLayout x + | x == vg_PIXEL_LAYOUT_UNKNOWN = Unknown + | x == vg_PIXEL_LAYOUT_RGB_VERTICAL = RgbVertical + | x == vg_PIXEL_LAYOUT_BGR_VERTICAL = BgrVertical + | x == vg_PIXEL_LAYOUT_RGB_HORIZONTAL = RgbHorizontal + | 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 + ImageUserToSurface -> vg_MATRIX_IMAGE_USER_TO_SURFACE + 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 new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Scissoring.hs @@ -0,0 +1,117 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Scissoring +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 7 (Scissoring, Masking and Clearing) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Scissoring ( + -- * Scissoring + scissoring, + ScissorRect, + maxScissorRects, + scissorRects, + + -- * Alpha masking + MaskOperation(..), + alphaMasking, + + -- * Fast clearing + clearColor, + clear +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGint, VGfloat, marshalBool ) +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.OpenGL.GL.StateVar ( + SettableStateVar, makeSettableStateVar, + GettableStateVar, makeGettableStateVar ) + +import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) ) +import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color4(..) ) + + +-------------------------------------------------------------------------------- +-- Scissoring + +-- | Enable or disable scissoring. +scissoring :: SettableStateVar Bool +scissoring = makeSettableStateVar $ \a -> + seti Scissoring (fromIntegral $ marshalBool a) + +type ScissorRect = (Position, Size) + +-- | Get the maximum number of scissoring rectangles. +maxScissorRects :: GettableStateVar VGint +maxScissorRects = makeGettableStateVar $ geti MaxScissorRects + + +-- | Specify the scissoring rectangles. +scissorRects :: SettableStateVar [ScissorRect] +scissorRects = makeSettableStateVar $ \ss -> + setiv ScissorRects (foldr f [] ss) where + f ((Position mx my), (Size w h)) a = mx:my:w:h:a + +-------------------------------------------------------------------------------- +-- Alpha masking + +-- | @MaskOperation@ corresponds to the OpenVG enumeration @VGMaskOperation@. +data MaskOperation = + ClearMask + | FillMask + | SetMask + | UnionMask + | IntersectMask + | SubtractMask + deriving ( Eq, Ord, Show ) + +-- | Enable or disable alpha masking. +alphaMasking :: SettableStateVar Bool +alphaMasking = makeSettableStateVar $ \a -> seti Masking (marshalBool a) + +-- vgMask not implemented in shiva-vg + +-------------------------------------------------------------------------------- +-- Fast clearing + +-- | Set the color for clearing. +clearColor :: SettableStateVar (Color4 VGfloat) +clearColor = makeSettableStateVar $ + \(Color4 r g b a) -> setfv ClearColor [r,g,b,a] + +-- | @clear@ corresponds to the OpenVG function @vgClear@. +clear :: Position -> Size -> IO () +clear (Position x y) (Size w h) = vgClear x y w h + + +-------------------------------------------------------------------------------- + +{- +-- Defined but not (YET) used: marshalMaskOperation +marshalMaskOperation :: MaskOperation -> VGenum +marshalMaskOperation x = case x of + ClearMask -> vg_CLEAR_MASK + FillMask -> vg_FILL_MASK + SetMask -> vg_SET_MASK + UnionMask -> vg_UNION_MASK + IntersectMask -> vg_INTERSECT_MASK + SubtractMask -> vg_SUBTRACT_MASK +-} + + diff --git a/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs b/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/ShivaExtensions.hs @@ -0,0 +1,60 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.ShivaExtensions +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Shiva extensions to replace EGL - see the README in the shiva-vg +-- archive. +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.ShivaExtensions ( + -- * ShivaVG extensions + + withContextSH, + + createContextSH, + resizeSurfaceSH, + destroyContextSH +) where + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( vg_TRUE ) +import Graphics.Rendering.OpenVG.VG.CFunDecls ( + vgCreateContextSH, vgResizeSurfaceSH, vgDestroyContextSH ) + +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 + + + +-- | Create an OpenVG context on top of an already created OpenGL context. +createContextSH :: Size -> IO Bool +createContextSH (Size w h) = do + vgbool <- vgCreateContextSH w h + if vgbool == vg_TRUE then return True else return False + +-- | @resizeSurfaceSH@ should be called whenever the size of the +-- surface changes. +resizeSurfaceSH :: Size -> IO () +resizeSurfaceSH (Size w h) = vgResizeSurfaceSH w h + +-- | Destroy the OpenVG context. +destroyContextSH :: IO () +destroyContextSH = vgDestroyContextSH + + diff --git a/src/Graphics/Rendering/OpenVG/VG/Utils.hs b/src/Graphics/Rendering/OpenVG/VG/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VG/Utils.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Utils +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Utility functions. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VG.Utils ( + Marshal(..), Unmarshal(..), enumValue, unmarshalIntegral, + bitwiseOr, unbits +) where + + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGint, VGenum, VGbitfield, + marshalBool ) +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 + + +unmarshalIntegral :: (Integral a, Unmarshal b) => a -> b +unmarshalIntegral = unmarshal . fromIntegral + + +bitwiseOr :: Marshal a => [a] -> VGbitfield +bitwiseOr = sum . map (fromIntegral . marshal) + + +-- 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) + + + diff --git a/src/Graphics/Rendering/OpenVG/VGU.hs b/src/Graphics/Rendering/OpenVG/VGU.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VGU.hs @@ -0,0 +1,23 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VGU +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- A Haskell binding for the OpenVG vector and raster graphics API. +-- +-------------------------------------------------------------------------------- + +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/CInternals.hsc b/src/Graphics/Rendering/OpenVG/VGU/CInternals.hsc new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VGU/CInternals.hsc @@ -0,0 +1,116 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VGU.CInternals +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- Internal module declaring all the datatypes and foreign declarations +-- defined in . +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VGU.CInternals where + +#include + +import Graphics.Rendering.OpenVG.VG.BasicTypes + +import Foreign.Ptr ( Ptr ) + +type VGUErrorCode' = VGenum + +-- | Enumerations + +#{enum VGenum, + , vgu_NO_ERROR = VGU_NO_ERROR + , vgu_BAD_HANDLE_ERROR = VGU_BAD_HANDLE_ERROR + , vgu_ILLEGAL_ARGUMENT_ERROR = VGU_ILLEGAL_ARGUMENT_ERROR + , vgu_OUT_OF_MEMORY_ERROR = VGU_OUT_OF_MEMORY_ERROR + , vgu_PATH_CAPABILITY_ERROR = VGU_PATH_CAPABILITY_ERROR + , vgu_BAD_WARP_ERROR = VGU_BAD_WARP_ERROR + } + +#{enum VGenum, + , vgu_ARC_OPEN = VGU_ARC_OPEN + , vgu_ARC_CHORD = VGU_ARC_CHORD + , vgu_ARC_PIE = VGU_ARC_PIE +} + + +foreign import ccall unsafe "vg/openvg.h vguLine" + vguLine :: VGPath + -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguPolygon" + vguPolygon :: VGPath + -> Ptr VGfloat -> VGint -> VGboolean + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguRect" + vguRect :: VGPath + -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguRoundRect" + vguRoundRect :: VGPath + -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguEllipse" + vguEllipse :: VGPath + -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguArc" + vguArc :: VGPath + -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGenum + -> IO VGUErrorCode' + +{- + +-- not implemented by shiva-vg + +foreign import ccall unsafe "vg/openvg.h vguComputeWarpQuadToSquare" + vguComputeWarpQuadToSquare :: VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> Ptr VGfloat + -> IO VGUErrorCode' + + +foreign import ccall unsafe "vg/openvg.h vguComputeWarpSquareToQuad" + vguComputeWarpSquareToQuad :: VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> Ptr VGfloat + -> IO VGUErrorCode' + +foreign import ccall unsafe "vg/openvg.h vguComputeWarpQuadToQuad" + vguComputeWarpQuadToQuad :: VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> Ptr VGfloat + -> IO VGUErrorCode' +-} + +-- end of file diff --git a/src/Graphics/Rendering/OpenVG/VGU/Errors.hs b/src/Graphics/Rendering/OpenVG/VGU/Errors.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VGU/Errors.hs @@ -0,0 +1,37 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Errors +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- 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 Graphics.Rendering.OpenGL.GL.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 new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VGU/ErrorsInternal.hs @@ -0,0 +1,240 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VG.Errors +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- 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.ErrorsInternal ( + Error(..), ErrorCategory(..), getErrors, + recordErrorCode, recordBadHandle, recordIllegalArgument, recordOutOfMemory +) 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.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 + +-------------------------------------------------------------------------------- +-- | 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 = + VGU_NoError + | VGU_BadHandle + | VGU_IllegalArgument + | VGU_OutOfMemory + | VGU_PathCapability + | 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) + + +-------------------------------------------------------------------------------- + +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 diff --git a/src/Graphics/Rendering/OpenVG/VGU/VGU.hs b/src/Graphics/Rendering/OpenVG/VGU/VGU.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/Rendering/OpenVG/VGU/VGU.hs @@ -0,0 +1,88 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Graphics.Rendering.OpenVG.VGU.VGU +-- Copyright : (c) Stephen Tetley 2008 +-- License : BSD-style (see the LICENSE file in the distribution) +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : GHC +-- +-- This module corresponds to section 16 (The VGU Utility Library) +-- of the OpenVG 1.0.1 specs. +-- +-- +-------------------------------------------------------------------------------- + +module Graphics.Rendering.OpenVG.VGU.VGU ( + line, + polygon, + rect, + roundRect, + ellipse, + ArcType(..), + arc +) where + + +import Graphics.Rendering.OpenVG.VG.BasicTypes ( + VGfloat, VGenum, VGPath, marshalBool ) +import Graphics.Rendering.OpenVG.VGU.CInternals +import Graphics.Rendering.OpenVG.VGU.ErrorsInternal ( recordErrorCode ) +import Foreign.Marshal.Array ( newArray ) + + +line :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat -> IO () +line path x0 y0 x1 y1 = withErrorCode $ vguLine path x0 y0 x1 y1 + + +polygon :: VGPath -> [VGfloat] -> Bool -> IO () +polygon path pts closed = do + pts' <- newArray pts + withErrorCode $ vguPolygon path pts' (fromIntegral $ length pts) + (marshalBool closed) + +rect :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> IO () +rect path x y w h = withErrorCode $ vguRect path x y w h + +roundRect :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> VGfloat -> VGfloat + -> IO () +roundRect path x y w h aw ah = withErrorCode $ vguRoundRect path x y w h aw ah + +ellipse :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> IO () +ellipse path cx cy w h = withErrorCode $ vguEllipse path cx cy w h + + +data ArcType = + ArcOpen + | ArcChord + | ArcPie + deriving ( Eq, Ord, Show ) + +arc :: VGPath -> VGfloat -> VGfloat -> VGfloat -> VGfloat + -> VGfloat -> VGfloat -> ArcType + -> IO () +arc path x y w h sa ae atyp = + withErrorCode $ vguArc path x y w h sa ae (marshalArcType atyp) + +-------------------------------------------------------------------------------- + +marshalArcType :: ArcType -> VGenum +marshalArcType x = case x of + ArcOpen -> vgu_ARC_OPEN + ArcChord -> vgu_ARC_CHORD + ArcPie -> vgu_ARC_PIE + +-- +withErrorCode :: IO VGenum -> IO () +withErrorCode f = do + a <- f + recordErrorCode a + return () + +