Safe Haskell | None |
---|---|
Language | Haskell2010 |
Main module of Rasterific, an Haskell rasterization engine.
Creating an image is rather simple, here is a simple example of a drawing and saving it in a PNG file:
import Codec.Picture( PixelRGBA8( .. ), writePng ) import Graphics.Rasterific import Graphics.Rasterific.Texture main :: IO () main = do let white = PixelRGBA8 255 255 255 255 drawColor = PixelRGBA8 0 0x86 0xc1 255 recColor = PixelRGBA8 0xFF 0x53 0x73 255 img = renderDrawing 400 200 white $ withTexture (uniformTexture drawColor) $ do fill $ circle (V2 0 0) 30 stroke 4 JoinRound (CapRound, CapRound) $ circle (V2 400 200) 40 withTexture (uniformTexture recColor) . fill $ rectangle (V2 100 100) 200 100 writePng "yourimage.png" img
The coordinate system is the picture classic one, with the origin in the upper left corner; with the y axis growing to the bottom and the x axis growing to the right:
Synopsis
- fill :: Geometry geom => geom -> Drawing px ()
- fillWithMethod :: Geometry geom => FillMethod -> geom -> Drawing px ()
- renderMeshPatch :: PatchInterpolation -> MeshPatch px -> Drawing px ()
- stroke :: Geometry geom => Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
- dashedStroke :: Geometry geom => DashPattern -> Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
- dashedStrokeWithOffset :: Geometry geom => Float -> DashPattern -> Float -> Join -> (Cap, Cap) -> geom -> Drawing px ()
- printTextAt :: Font -> PointSize -> Point -> String -> Drawing px ()
- printTextRanges :: Point -> [TextRange px] -> Drawing px ()
- withTexture :: Texture px -> Drawing px () -> Drawing px ()
- withClipping :: (forall innerPixel. Drawing innerPixel ()) -> Drawing px () -> Drawing px ()
- withGroupOpacity :: PixelBaseComponent px -> Drawing px () -> Drawing px ()
- withTransformation :: Transformation -> Drawing px () -> Drawing px ()
- withPathOrientation :: Path -> Float -> Drawing px () -> Drawing px ()
- data TextRange px = TextRange {}
- newtype PointSize = PointSize {}
- type ModulablePixel px = (Pixel px, PackeablePixel px, InterpolablePixel px, InterpolablePixel (PixelBaseComponent px), Storable (PackedRepresentation px), Modulable (PixelBaseComponent px))
- type RenderablePixel px = (ModulablePixel px, Pixel (PixelBaseComponent px), PackeablePixel (PixelBaseComponent px), Num (PackedRepresentation px), Num (PackedRepresentation (PixelBaseComponent px)), Num (Holder px Float), Num (Holder (PixelBaseComponent px) Float), Storable (PackedRepresentation (PixelBaseComponent px)), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px)
- renderDrawing :: forall px. RenderablePixel px => Int -> Int -> px -> Drawing px () -> Image px
- renderDrawingAtDpi :: forall px. RenderablePixel px => Int -> Int -> Dpi -> px -> Drawing px () -> Image px
- renderDrawingAtDpiToPDF :: Int -> Int -> Dpi -> Drawing PixelRGBA8 () -> ByteString
- renderDrawingsAtDpiToPDF :: Int -> Int -> Dpi -> [Drawing PixelRGBA8 ()] -> ByteString
- renderOrdersAtDpiToPdf :: Int -> Int -> Dpi -> [DrawOrder PixelRGBA8] -> ByteString
- pathToPrimitives :: Path -> [Primitive]
- data Texture (px :: Type)
- type Drawing px = F (DrawCommand px)
- class (Ord a, Num a) => Modulable a
- data V2 a = V2 !a !a
- type Point = V2 Float
- type Vector = V2 Float
- data CubicBezier = CubicBezier {
- _cBezierX0 :: !Point
- _cBezierX1 :: !Point
- _cBezierX2 :: !Point
- _cBezierX3 :: !Point
- data Line = Line {}
- data Bezier = Bezier {}
- data Primitive
- data Path = Path {}
- data PathCommand
- class Primitivable a where
- class Geometry a where
- toPrimitives :: a -> [Primitive]
- listToPrims :: Foldable f => f a -> [Primitive]
- class Transformable a where
- class PointFoldable a where
- foldPoints :: (b -> Point -> b) -> b -> a -> b
- class PlaneBoundable a where
- planeBounds :: a -> PlaneBound
- data PlaneBound = PlaneBound {
- _planeMinBound :: !Point
- _planeMaxBound :: !Point
- boundWidth :: PlaneBound -> Float
- boundHeight :: PlaneBound -> Float
- boundLowerLeftCorner :: PlaneBound -> Point
- line :: Point -> Point -> [Primitive]
- rectangle :: Point -> Float -> Float -> [Primitive]
- roundedRectangle :: Point -> Float -> Float -> Float -> Float -> [Primitive]
- circle :: Point -> Float -> [Primitive]
- ellipse :: Point -> Float -> Float -> [Primitive]
- polyline :: [Point] -> [Primitive]
- polygon :: [Point] -> [Primitive]
- drawImageAtSize :: Image px -> StrokeWidth -> Point -> Float -> Float -> Drawing px ()
- drawImage :: Image px -> StrokeWidth -> Point -> Drawing px ()
- cacheDrawing :: forall px. RenderablePixel px => Int -> Int -> Dpi -> Drawing px () -> Drawing px ()
- clip :: Point -> Point -> Primitive -> Container Primitive
- bezierFromPath :: [Point] -> [Bezier]
- lineFromPath :: [Point] -> [Line]
- cubicBezierFromPath :: [Point] -> [CubicBezier]
- firstTangeantOf :: Primitive -> Vector
- lastTangeantOf :: Primitive -> Vector
- firstPointOf :: Primitive -> Point
- lastPointOf :: Primitive -> Point
- data Direction
- arcInDirection :: Point -> Float -> Direction -> Float -> Float -> Float -> [PathCommand]
- data Join
- data Cap
- data SamplerRepeat
- data FillMethod
- data PatchInterpolation
- type DashPattern = [Float]
- drawOrdersOfDrawing :: forall px. RenderablePixel px => Int -> Int -> Dpi -> px -> Drawing px () -> [DrawOrder px]
- dumpDrawing :: (Show px, Show (PixelBaseComponent px), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px) => Drawing px () -> String
Rasterization command
Filling
fill :: Geometry geom => geom -> Drawing px () Source #
Fill some geometry. The geometry should be "looping", ie. the last point of the last primitive should be equal to the first point of the first primitive.
The primitive should be connected.
fill $ circle (V2 100 100) 75
fillWithMethod :: Geometry geom => FillMethod -> geom -> Drawing px () Source #
This function let you choose how to fill the primitives
in case of self intersection. See FillMethod
documentation
for more information.
renderMeshPatch :: PatchInterpolation -> MeshPatch px -> Drawing px () Source #
Render a mesh patch as an object. Warning, there is no antialiasing on mesh patch objects!
Stroking
:: Geometry geom | |
=> Float | Stroke width |
-> Join | Which kind of join will be used |
-> (Cap, Cap) | Start and end capping. |
-> geom | List of elements to render |
-> Drawing px () |
Will stroke geometry with a given stroke width. The elements should be connected
stroke 5 JoinRound (CapRound, CapRound) $ circle (V2 100 100) 75
:: Geometry geom | |
=> DashPattern | Dashing pattern to use for stroking |
-> Float | Stroke width |
-> Join | Which kind of join will be used |
-> (Cap, Cap) | Start and end capping. |
-> geom | List of elements to render |
-> Drawing px () |
With stroke geometry with a given stroke width, using a dash pattern.
dashedStroke [5, 10, 5] 3 JoinRound (CapRound, CapStraight 0) $ line (V2 0 100) (V2 200 100)
dashedStrokeWithOffset Source #
:: Geometry geom | |
=> Float | Starting offset |
-> DashPattern | Dashing pattern to use for stroking |
-> Float | Stroke width |
-> Join | Which kind of join will be used |
-> (Cap, Cap) | Start and end capping. |
-> geom | List of elements to render |
-> Drawing px () |
With stroke geometry with a given stroke width, using a dash pattern. The offset is there to specify the starting point into the pattern, the value can be negative.
dashedStrokeWithOffset 3 [5, 10, 5] 3 JoinRound (CapRound, CapStraight 0) $ line (V2 0 100) (V2 200 100)
Text rendering
:: Font | Drawing font |
-> PointSize | font Point size |
-> Point | Drawing starting point (base line) |
-> String | String to print |
-> Drawing px () |
Draw a string at a given position. Text printing imply loading a font, there is no default font (yet). Below an example of font rendering using a font installed on Microsoft Windows.
import Graphics.Text.TrueType( loadFontFile ) import Codec.Picture( PixelRGBA8( .. ), writePng ) import Graphics.Rasterific import Graphics.Rasterific.Texture main :: IO () main = do fontErr <- loadFontFile "test_fonts/DejaVuSans.ttf" case fontErr of Left err -> putStrLn err Right font -> writePng "text_example.png" . renderDrawing 300 70 (PixelRGBA8 255 255 255 255) . withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $ printTextAt font (PointSize 12) (V2 20 40) "A simple text test!"
You can use any texture, like a gradient while rendering text.
:: Point | Starting point of the base line |
-> [TextRange px] | Ranges description to be printed |
-> Drawing px () |
Print complex text, using different texture font and point size for different parts of the text.
let blackTexture = Just . uniformTexture $ PixelRGBA8 0 0 0 255 redTexture = Just . uniformTexture $ PixelRGBA8 255 0 0 255 in printTextRanges (V2 20 40) [ TextRange font1 (PointSize 12) "A complex " blackTexture , TextRange font2 (PointSize 8) "text test" redTexture]
Texturing
withTexture :: Texture px -> Drawing px () -> Drawing px () Source #
Define the texture applyied to all the children draw call.
withTexture (uniformTexture $ PixelRGBA8 0 0x86 0xc1 255) $ do fill $ circle (V2 50 50) 20 fill $ circle (V2 100 100) 20 withTexture (uniformTexture $ PixelRGBA8 0xFF 0x53 0x73 255) $ circle (V2 150 150) 20
:: (forall innerPixel. Drawing innerPixel ()) | The clipping path |
-> Drawing px () | The actual geometry to clip |
-> Drawing px () |
Draw some geometry using a clipping path.
withClipping (fill $ circle (V2 100 100) 75) $ mapM_ (stroke 7 JoinRound (CapRound, CapRound)) [line (V2 0 yf) (V2 200 (yf + 10)) | y <- [5 :: Int, 17 .. 200] , let yf = fromIntegral y ]
withGroupOpacity :: PixelBaseComponent px -> Drawing px () -> Drawing px () Source #
Will render the whole subaction with a given group opacity, after each element has been rendered. That means that completly opaque overlapping shapes will be rendered transparently, not one after another.
withTexture (uniformTexture $ PixelRGBA8 0xFF 0x53 0x73 255) $ stroke 3 JoinRound (CapRound, CapRound) $ line (V2 0 100) (V2 200 100) withGroupOpacity 128 $ do withTexture (uniformTexture $ PixelRGBA8 0 0x86 0xc1 255) . fill $ circle (V2 70 100) 60 withTexture (uniformTexture $ PixelRGBA8 0xff 0xf4 0xc1 255) . fill $ circle (V2 120 100) 60
To be compared to the item opacity
withTexture (uniformTexture $ PixelRGBA8 0xFF 0x53 0x73 255) $ stroke 3 JoinRound (CapRound, CapRound) $ line (V2 0 100) (V2 200 100) withTexture (uniformTexture $ PixelRGBA8 0 0x86 0xc1 128) . fill $ circle (V2 70 100) 60 withTexture (uniformTexture $ PixelRGBA8 0xff 0xf4 0xc1 128) . fill $ circle (V2 120 100) 60
Transformations
withTransformation :: Transformation -> Drawing px () -> Drawing px () Source #
Draw all the sub drawing commands using a transformation.
:: Path | Path directing the orientation. |
-> Float | Basline Y axis position, used to align text properly. |
-> Drawing px () | The sub drawings. |
-> Drawing px () |
This command allows you to draw primitives on a given curve, for example, you can draw text on a curve:
let path = Path (V2 100 180) False [PathCubicBezierCurveTo (V2 20 20) (V2 170 20) (V2 300 200)] in stroke 3 JoinRound (CapStraight 0, CapStraight 0) path withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $ withPathOrientation path 0 $ printTextAt font (PointSize 24) (V2 0 0) "Text on path"
You can note that the position of the baseline match the size of the characters.
You are not limited to text drawing while using this function, you can draw arbitrary geometry like in the following example:
let path = Path (V2 100 180) False [PathCubicBezierCurveTo (V2 20 20) (V2 170 20) (V2 300 200)] withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $ stroke 3 JoinRound (CapStraight 0, CapStraight 0) path withPathOrientation path 0 $ do printTextAt font (PointSize 24) (V2 0 0) "TX" fill $ rectangle (V2 (-10) (-10)) 30 20 fill $ rectangle (V2 45 0) 10 20 fill $ rectangle (V2 60 (-10)) 20 20 fill $ rectangle (V2 100 (-15)) 20 50
Structure defining how to render a text range
Font size expressed in points. You must convert size expressed in pixels to point using the DPI information. See pixelSizeInPointAtDpi
Generating images
type ModulablePixel px = (Pixel px, PackeablePixel px, InterpolablePixel px, InterpolablePixel (PixelBaseComponent px), Storable (PackedRepresentation px), Modulable (PixelBaseComponent px)) Source #
This constraint ensure that a type is a pixel and we're allowed to modulate it's color components generically.
type RenderablePixel px = (ModulablePixel px, Pixel (PixelBaseComponent px), PackeablePixel (PixelBaseComponent px), Num (PackedRepresentation px), Num (PackedRepresentation (PixelBaseComponent px)), Num (Holder px Float), Num (Holder (PixelBaseComponent px) Float), Storable (PackedRepresentation (PixelBaseComponent px)), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px) Source #
This constraint tells us that pixel component must also be pixel and be the "bottom" of component, we cannot go further than a PixelBaseComponent level.
Tested pixel types are PixelRGBA8 & Pixel8
:: forall px. RenderablePixel px | |
=> Int | Rendering width |
-> Int | Rendering height |
-> px | Background color |
-> Drawing px () | Rendering action |
-> Image px |
Function to call in order to start the image creation. Tested pixels type are PixelRGBA8 and Pixel8, pixel types in other colorspace will probably produce weird results. Default DPI is 96
:: forall px. RenderablePixel px | |
=> Int | Rendering width |
-> Int | Rendering height |
-> Dpi | Current DPI used for text rendering. |
-> px | Background color |
-> Drawing px () | Rendering action |
-> Image px |
Function to call in order to start the image creation. Tested pixels type are PixelRGBA8 and Pixel8, pixel types in other colorspace will probably produce weird results.
renderDrawingAtDpiToPDF Source #
:: Int | Rendering width |
-> Int | Rendering height |
-> Dpi | Current DPI used for text rendering. |
-> Drawing PixelRGBA8 () | Rendering action |
-> ByteString |
renderDrawingsAtDpiToPDF Source #
:: Int | Rendering width |
-> Int | Rendering height |
-> Dpi | Current DPI used for text rendering. |
-> [Drawing PixelRGBA8 ()] | Rendering actions |
-> ByteString |
renderOrdersAtDpiToPdf Source #
:: Int | Rendering width |
-> Int | Rendering height |
-> Dpi | Current DPI used for text rendering. |
-> [DrawOrder PixelRGBA8] | Drawing Orders |
-> ByteString |
pathToPrimitives :: Path -> [Primitive] Source #
Transform a path description into a list of renderable primitives.
Rasterization types
class (Ord a, Num a) => Modulable a Source #
Typeclass intented at pixel value modulation. May be throwed out soon.
emptyValue, fullValue, clampCoverage, modulate, modiv, alphaOver, alphaCompose
Instances
Modulable Float Source # | |
Defined in Graphics.Rasterific.Compositor | |
Modulable Word8 Source # | |
Defined in Graphics.Rasterific.Compositor |
Geometry description
A 2-dimensional vector
>>>
pure 1 :: V2 Int
V2 1 1
>>>
V2 1 2 + V2 3 4
V2 4 6
>>>
V2 1 2 * V2 3 4
V2 3 8
>>>
sum (V2 1 2)
3
V2 !a !a |
Instances
data CubicBezier Source #
Describe a cubic bezier spline, described using 4 points.
stroke 4 JoinRound (CapRound, CapRound) $ CubicBezier (V2 0 10) (V2 205 250) (V2 (-10) 250) (V2 160 35)
CubicBezier | |
|
Instances
Describe a simple 2D line between two points.
fill [ Line (V2 10 10) (V2 190 10) , Line (V2 190 10) (V2 95 170) , Line (V2 95 170) (V2 10 10)]
Instances
Eq Line Source # | |
Show Line Source # | |
Geometry Line Source # | |
Defined in Graphics.Rasterific.Types | |
Primitivable Line Source # | toPrim = LinePrim |
PointFoldable Line Source # | |
Defined in Graphics.Rasterific.Types foldPoints :: (b -> Point -> b) -> b -> Line -> b Source # | |
Transformable Line Source # | |
PlaneBoundable Line Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Line -> PlaneBound Source # |
Describe a quadratic bezier spline, described using 3 points.
fill [Bezier (V2 10 10) (V2 200 50) (V2 200 100) ,Bezier (V2 200 100) (V2 150 200) (V2 120 175) ,Bezier (V2 120 175) (V2 30 100) (V2 10 10)]
Instances
Eq Bezier Source # | |
Show Bezier Source # | |
Geometry Bezier Source # | |
Defined in Graphics.Rasterific.Types | |
Primitivable Bezier Source # | toPrim = BezierPrim |
PointFoldable Bezier Source # | |
Defined in Graphics.Rasterific.Types foldPoints :: (b -> Point -> b) -> b -> Bezier -> b Source # | |
Transformable Bezier Source # | |
PlaneBoundable Bezier Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Bezier -> PlaneBound Source # |
This datatype gather all the renderable primitives, they are kept separated otherwise to allow specialization on some specific algorithms. You can mix the different primitives in a single call :
fill [ toPrim $ CubicBezier (V2 50 20) (V2 90 60) (V2 5 100) (V2 50 140) , toPrim $ Line (V2 50 140) (V2 120 80) , toPrim $ Line (V2 120 80) (V2 50 20) ]
LinePrim !Line | Primitive used for lines |
BezierPrim !Bezier | Primitive used for quadratic beziers curves |
CubicBezierPrim !CubicBezier | Primitive used for cubic bezier curve |
Instances
Eq Primitive Source # | |
Show Primitive Source # | |
Geometry Primitive Source # | |
Defined in Graphics.Rasterific.Types | |
Primitivable Primitive Source # | toPrim = id |
PointFoldable Primitive Source # | |
Defined in Graphics.Rasterific.Types foldPoints :: (b -> Point -> b) -> b -> Primitive -> b Source # | |
Transformable Primitive Source # | |
PlaneBoundable Primitive Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Primitive -> PlaneBound Source # |
Describe a path in a way similar to many graphical packages, using a "pen" position in memory and reusing it for the next "move" For example the example from Primitive could be rewritten:
fill $ Path (V2 50 20) True [ PathCubicBezierCurveTo (V2 90 60) (V2 5 100) (V2 50 140) , PathLineTo (V2 120 80) ]
Path | |
|
data PathCommand Source #
Actions to create a path
PathLineTo Point | Draw a line from the current point to another point |
PathQuadraticBezierCurveTo Point Point | Draw a quadratic bezier curve from the current point through the control point to the end point. |
PathCubicBezierCurveTo Point Point Point | Draw a cubic bezier curve using 2 control points. |
Instances
Eq PathCommand Source # | |
Defined in Graphics.Rasterific.Types (==) :: PathCommand -> PathCommand -> Bool # (/=) :: PathCommand -> PathCommand -> Bool # | |
Show PathCommand Source # | |
Defined in Graphics.Rasterific.Types showsPrec :: Int -> PathCommand -> ShowS # show :: PathCommand -> String # showList :: [PathCommand] -> ShowS # | |
PointFoldable PathCommand Source # | |
Defined in Graphics.Rasterific.Types foldPoints :: (b -> Point -> b) -> b -> PathCommand -> b Source # | |
Transformable PathCommand Source # | |
Defined in Graphics.Rasterific.Types transform :: (Point -> Point) -> PathCommand -> PathCommand Source # transformM :: Monad m => (Point -> m Point) -> PathCommand -> m PathCommand Source # |
Generic geometry description
class Primitivable a where Source #
Generalizing constructors of the Primitive
type to work
generically.
Instances
Primitivable Primitive Source # | toPrim = id |
Primitivable CubicBezier Source # | toPrim = CubicBezierPrim |
Defined in Graphics.Rasterific.Types toPrim :: CubicBezier -> Primitive Source # | |
Primitivable Bezier Source # | toPrim = BezierPrim |
Primitivable Line Source # | toPrim = LinePrim |
class Geometry a where Source #
All the rasterization works on lists of primitives, in order to ease the use of the library, the Geometry type class provides conversion facility, which help generalising the geometry definition and avoid applying Primitive constructor.
Also streamline the Path conversion.
toPrimitives :: a -> [Primitive] Source #
Convert an element to a list of primitives to be rendered.
listToPrims :: Foldable f => f a -> [Primitive] Source #
Helper method to avoid overlaping instances. You shouldn't use it directly.
Instances
Geometry Path Source # | |
Defined in Graphics.Rasterific.Types | |
Geometry Primitive Source # | |
Defined in Graphics.Rasterific.Types | |
Geometry CubicBezier Source # | |
Defined in Graphics.Rasterific.Types toPrimitives :: CubicBezier -> [Primitive] Source # listToPrims :: Foldable f => f CubicBezier -> [Primitive] Source # | |
Geometry Bezier Source # | |
Defined in Graphics.Rasterific.Types | |
Geometry Line Source # | |
Defined in Graphics.Rasterific.Types | |
(Foldable f, Geometry a) => Geometry (f a) Source # | Generalize the geometry to any foldable container,
so you can throw any container to the the |
Defined in Graphics.Rasterific.Types toPrimitives :: f a -> [Primitive] Source # listToPrims :: Foldable f0 => f0 (f a) -> [Primitive] Source # |
Generic geometry manipulation
class Transformable a where Source #
This typeclass is there to help transform the geometry, by applying a transformation on every point of a geometric element.
transform :: (Point -> Point) -> a -> a Source #
Apply a transformation function for every point in the element.
transformM :: Monad m => (Point -> m Point) -> a -> m a Source #
Transform but monadic
Instances
class PointFoldable a where Source #
Typeclass helper gathering all the points of a given geometry.
foldPoints :: (b -> Point -> b) -> b -> a -> b Source #
Fold an accumulator on all the points of the primitive.
Instances
class PlaneBoundable a where Source #
Class used to calculate bounds of various geometrical primitives. The calculated is precise, the bounding should be minimal with respect with drawn curve.
planeBounds :: a -> PlaneBound Source #
Given a graphical elements, calculate it's bounds.
Instances
PlaneBoundable Point Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Point -> PlaneBound Source # | |
PlaneBoundable Primitive Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Primitive -> PlaneBound Source # | |
PlaneBoundable CubicBezier Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: CubicBezier -> PlaneBound Source # | |
PlaneBoundable Bezier Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Bezier -> PlaneBound Source # | |
PlaneBoundable Line Source # | |
Defined in Graphics.Rasterific.PlaneBoundable planeBounds :: Line -> PlaneBound Source # | |
PlaneBoundable (DrawOrder px) Source # | |
Defined in Graphics.Rasterific.Immediate planeBounds :: DrawOrder px -> PlaneBound Source # |
data PlaneBound Source #
Represent the minimal axis aligned rectangle in which some primitives can be drawn. Should fit to bezier curve and not use directly their control points.
PlaneBound | |
|
Instances
Eq PlaneBound Source # | |
Defined in Graphics.Rasterific.PlaneBoundable (==) :: PlaneBound -> PlaneBound -> Bool # (/=) :: PlaneBound -> PlaneBound -> Bool # | |
Show PlaneBound Source # | |
Defined in Graphics.Rasterific.PlaneBoundable showsPrec :: Int -> PlaneBound -> ShowS # show :: PlaneBound -> String # showList :: [PlaneBound] -> ShowS # | |
Semigroup PlaneBound Source # | |
Defined in Graphics.Rasterific.PlaneBoundable (<>) :: PlaneBound -> PlaneBound -> PlaneBound # sconcat :: NonEmpty PlaneBound -> PlaneBound # stimes :: Integral b => b -> PlaneBound -> PlaneBound # | |
Monoid PlaneBound Source # | |
Defined in Graphics.Rasterific.PlaneBoundable mempty :: PlaneBound # mappend :: PlaneBound -> PlaneBound -> PlaneBound # mconcat :: [PlaneBound] -> PlaneBound # |
boundWidth :: PlaneBound -> Float Source #
Extract the width of the bounds
boundHeight :: PlaneBound -> Float Source #
Extract the height of the bound
boundLowerLeftCorner :: PlaneBound -> Point Source #
Extract the position of the lower left corner of the bounds.
Helpers
line
line :: Point -> Point -> [Primitive] Source #
Return a simple line ready to be stroked.
stroke 17 JoinRound (CapRound, CapRound) $ line (V2 10 10) (V2 180 170)
Rectangle
Generate a list of primitive representing a rectangle
fill $ rectangle (V2 30 30) 150 100
:: Point | Corner upper left |
-> Float | Width in pixel |
-> Float | Height in pixel. |
-> Float | Radius along the x axis of the rounded corner. In pixel. |
-> Float | Radius along the y axis of the rounded corner. In pixel. |
-> [Primitive] |
Generate a list of primitive representing a rectangle with rounded corner.
fill $ roundedRectangle (V2 10 10) 150 150 20 10
Circles
Generate a list of primitive representing a circle.
fill $ circle (V2 100 100) 75
ellipse :: Point -> Float -> Float -> [Primitive] Source #
Generate a list of primitive representing an ellipse.
fill $ ellipse (V2 100 100) 75 30
Polygons
polyline :: [Point] -> [Primitive] Source #
Generate a strokable line out of points list.
Just an helper around lineFromPath
.
stroke 4 JoinRound (CapRound, CapRound) $ polyline [V2 10 10, V2 100 70, V2 190 190]
polygon :: [Point] -> [Primitive] Source #
Generate a fillable polygon out of points list.
Similar to the polyline
function, but close the
path.
fill $ polygon [V2 30 30, V2 100 70, V2 80 170]
Images
:: Image px | Image to be drawn |
-> StrokeWidth | Border size, drawn with current texture. |
-> Point | Position of the corner upper left of the image. |
-> Float | Width of the drawn image |
-> Float | Height of the drawn image |
-> Drawing px () |
Draw an image with the desired size
drawImageAtSize textureImage 2 (V2 30 30) 128 128
:: Image px | Image to be drawn |
-> StrokeWidth | Border size, drawn with current texture. |
-> Point | Position of the corner upper left of the image. |
-> Drawing px () |
Simply draw an image into the canvas. Take into account any previous transformation performed on the geometry.
drawImage textureImage 0 (V2 30 30)
:: forall px. RenderablePixel px | |
=> Int | Max rendering width |
-> Int | Max rendering height |
-> Dpi | |
-> Drawing px () | |
-> Drawing px () |
This function perform an optimisation, it will render a drawing to an image interanlly and create a new order to render this image instead of the geometry, effectively cuting the geometry generation part.
It can save execution time when drawing complex elements multiple times.
Geometry Helpers
:: Point | Minimum point (corner upper left) |
-> Point | Maximum point (corner bottom right) |
-> Primitive | Primitive to be clipped |
-> Container Primitive |
Clip the geometry to a rectangle.
bezierFromPath :: [Point] -> [Bezier] Source #
Create a list of bezier patch from a list of points,
bezierFromPath [a, b, c, d, e] == [Bezier a b c, Bezier c d e] bezierFromPath [a, b, c, d, e, f] == [Bezier a b c, Bezier c d e] bezierFromPath [a, b, c, d, e, f, g] == [Bezier a b c, Bezier c d e, Bezier e f g]
lineFromPath :: [Point] -> [Line] Source #
Transform a list a point to a list of lines
lineFromPath [a, b, c, d] = [Line a b, Line b c, Line c d]
cubicBezierFromPath :: [Point] -> [CubicBezier] Source #
Create a list of cubic bezier patch from a list of points.
cubicBezierFromPath [a, b, c, d, e] = [CubicBezier a b c d] cubicBezierFromPath [a, b, c, d, e, f, g] = [CubicBezier a b c d, CubicBezier d e f g]
firstTangeantOf :: Primitive -> Vector Source #
Gives the orientation vector for the start of the primitive.
lastTangeantOf :: Primitive -> Vector Source #
Gives the orientation vector at the end of the primitive.
firstPointOf :: Primitive -> Point Source #
Extract the first point of the primitive.
lastPointOf :: Primitive -> Point Source #
Return the last point of a given primitive.
Arc traduction
:: Point | center |
-> Float | Radius |
-> Direction | |
-> Float | Tolerance |
-> Float | Angle minimum |
-> Float | Angle maximum |
-> [PathCommand] |
Translate an arc with a definition similar to the one given in Cairo to a list of bezier path command
Rasterization control
Describe how to display the join of broken lines while stroking.
Describe how we will "finish" the stroking that don't loop.
CapStraight Float | Create a straight caping on the stroke. Cap value should be positive and represent the distance from the end of curve to the actual cap
|
CapRound | Create a rounded caping on the stroke. |
data SamplerRepeat Source #
Describe the behaviour of samplers and texturers when they are out of the bounds of image and/or gradient.
SamplerPad | Will clamp (ie. repeat the last pixel) when out of bound |
SamplerRepeat | Will loop on it's definition domain |
SamplerReflect | Will loop inverting axises |
Instances
Enum SamplerRepeat Source # | |
Defined in Graphics.Rasterific.Types succ :: SamplerRepeat -> SamplerRepeat # pred :: SamplerRepeat -> SamplerRepeat # toEnum :: Int -> SamplerRepeat # fromEnum :: SamplerRepeat -> Int # enumFrom :: SamplerRepeat -> [SamplerRepeat] # enumFromThen :: SamplerRepeat -> SamplerRepeat -> [SamplerRepeat] # enumFromTo :: SamplerRepeat -> SamplerRepeat -> [SamplerRepeat] # enumFromThenTo :: SamplerRepeat -> SamplerRepeat -> SamplerRepeat -> [SamplerRepeat] # | |
Eq SamplerRepeat Source # | |
Defined in Graphics.Rasterific.Types (==) :: SamplerRepeat -> SamplerRepeat -> Bool # (/=) :: SamplerRepeat -> SamplerRepeat -> Bool # | |
Show SamplerRepeat Source # | |
Defined in Graphics.Rasterific.Types showsPrec :: Int -> SamplerRepeat -> ShowS # show :: SamplerRepeat -> String # showList :: [SamplerRepeat] -> ShowS # |
data FillMethod Source #
Tell how to fill complex shapes when there is self
intersections. If the filling mode is not specified,
then it's the FillWinding
method which is used.
The examples used are produced with the following function:
fillingSample :: FillMethod -> Drawing px () fillingSample fillMethod = fillWithMethod fillMethod geometry where geometry = transform (applyTransformation $ scale 0.35 0.4 <> translate (V2 (-80) (-180))) [ Path (V2 484 499) True [ PathCubicBezierCurveTo (V2 681 452) (V2 639 312) (V2 541 314) , PathCubicBezierCurveTo (V2 327 337) (V2 224 562) (V2 484 499) ] , Path (V2 136 377) True [ PathCubicBezierCurveTo (V2 244 253) (V2 424 420) (V2 357 489) , PathCubicBezierCurveTo (V2 302 582) (V2 47 481) (V2 136 377) ] , Path (V2 340 265) True [ PathCubicBezierCurveTo (V2 64 371) (V2 128 748) (V2 343 536) , PathCubicBezierCurveTo (V2 668 216) (V2 17 273) (V2 367 575) , PathCubicBezierCurveTo (V2 589 727) (V2 615 159) (V2 340 265) ] ]
FillWinding | Also known as nonzero rule. To determine if a point falls inside the curve, you draw an imaginary line through that point. Next you will count how many times that line crosses the curve before it reaches that point. For every clockwise rotation, you subtract 1 and for every counter-clockwise rotation you add 1. |
FillEvenOdd | This rule determines the insideness of a point on the canvas by drawing a ray from that point to infinity in any direction and counting the number of path segments from the given shape that the ray crosses. If this number is odd, the point is inside; if even, the point is outside. |
Instances
Enum FillMethod Source # | |
Defined in Graphics.Rasterific.Types succ :: FillMethod -> FillMethod # pred :: FillMethod -> FillMethod # toEnum :: Int -> FillMethod # fromEnum :: FillMethod -> Int # enumFrom :: FillMethod -> [FillMethod] # enumFromThen :: FillMethod -> FillMethod -> [FillMethod] # enumFromTo :: FillMethod -> FillMethod -> [FillMethod] # enumFromThenTo :: FillMethod -> FillMethod -> FillMethod -> [FillMethod] # | |
Eq FillMethod Source # | |
Defined in Graphics.Rasterific.Types (==) :: FillMethod -> FillMethod -> Bool # (/=) :: FillMethod -> FillMethod -> Bool # | |
Show FillMethod Source # | |
Defined in Graphics.Rasterific.Types showsPrec :: Int -> FillMethod -> ShowS # show :: FillMethod -> String # showList :: [FillMethod] -> ShowS # |
data PatchInterpolation Source #
How do we want to perform color/image interpolation within the patch.
PatchBilinear | Bilinear interpolation import qualified Data.Vector as V let colorCycle = cycle [ PixelRGBA8 0 0x86 0xc1 255 , PixelRGBA8 0xff 0xf4 0xc1 255 , PixelRGBA8 0xFF 0x53 0x73 255 , PixelRGBA8 0xff 0xf4 0xc1 255 , PixelRGBA8 0 0x86 0xc1 255] colors = V.fromListN (4 * 4) colorCycle renderMeshPatch PatchBilinear $ generateLinearGrid 3 3 (V2 10 10) (V2 60 60) colors |
PatchBicubic | Bicubic interpolation import qualified Data.Vector as V let colorCycle = cycle [ PixelRGBA8 0 0x86 0xc1 255 , PixelRGBA8 0xff 0xf4 0xc1 255 , PixelRGBA8 0xFF 0x53 0x73 255 , PixelRGBA8 0xff 0xf4 0xc1 255 , PixelRGBA8 0 0x86 0xc1 255] colors = V.fromListN (4 * 4) colorCycle renderMeshPatch PatchBicubic $ generateLinearGrid 3 3 (V2 10 10) (V2 60 60) colors |
Instances
Eq PatchInterpolation Source # | |
Defined in Graphics.Rasterific.PatchTypes (==) :: PatchInterpolation -> PatchInterpolation -> Bool # (/=) :: PatchInterpolation -> PatchInterpolation -> Bool # | |
Show PatchInterpolation Source # | |
Defined in Graphics.Rasterific.PatchTypes showsPrec :: Int -> PatchInterpolation -> ShowS # show :: PatchInterpolation -> String # showList :: [PatchInterpolation] -> ShowS # |
type DashPattern = [Float] Source #
Dash pattern to use
:: forall px. RenderablePixel px | |
=> Int | Rendering width |
-> Int | Rendering height |
-> Dpi | Current assumed DPI |
-> px | Background color |
-> Drawing px () | Rendering action |
-> [DrawOrder px] |
Transform a drawing into a serie of low-level drawing orders.
Debugging helper
dumpDrawing :: (Show px, Show (PixelBaseComponent px), PixelBaseComponent (PixelBaseComponent px) ~ PixelBaseComponent px) => Drawing px () -> String Source #
This function will spit out drawing instructions to help debugging.
The outputted code looks like Haskell, but there is no guarantee that it is compilable.