diff --git a/src/Graphics/Rasterific.hs b/src/Graphics/Rasterific.hs index 1598b6b..a06110b 100644 --- a/src/Graphics/Rasterific.hs +++ b/src/Graphics/Rasterific.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ConstraintKinds #-} --- | Main module of Rasterific, an Haskell rasterization engine. +-- | Main module of Rasterific, a Haskell rasterization engine. -- --- Creating an image is rather simple, here is a simple example --- of a drawing and saving it in a PNG file: +-- Creating an image is rather simple, here is an example +-- of creating one and saving it as a PNG file: -- -- > import Codec.Picture( PixelRGBA8( .. ), writePng ) -- > import Graphics.Rasterific @@ -45,7 +45,7 @@ module Graphics.Rasterific fill , fillWithMethod , renderMeshPatch - -- ** Stroking + -- ** Strokes , stroke , dashedStroke , dashedStrokeWithOffset @@ -68,7 +68,7 @@ module Graphics.Rasterific , renderDrawing , renderDrawingAtDpi , renderDrawingAtDpiToPDF - , renderOrdersAtDpiToPdf + , renderOrdersAtDpiToPdf , pathToPrimitives -- * Rasterization types @@ -144,47 +144,43 @@ module Graphics.Rasterific , dumpDrawing ) where -import Data.Monoid( (<>) ) - -import Control.Monad.Free( Free( .. ), liftF ) -import Control.Monad.Free.Church( fromF ) -import Control.Monad.ST( ST, runST ) -import Control.Monad.State( modify, execState ) -import Data.Maybe( fromMaybe ) -import Codec.Picture.Types( Image( .. ) - , Pixel( .. ) - , PixelRGBA8 - , pixelMapXY ) - -import qualified Data.ByteString.Lazy as LB -import qualified Data.Vector as V - -import Graphics.Rasterific.Compositor -import Graphics.Rasterific.Linear( V2( .. ), (^+^), (^-^) ) -import Graphics.Rasterific.Rasterize -import Graphics.Rasterific.MicroPdf +import Data.Monoid ((<>)) + +import Codec.Picture.Types (Image (..), Pixel (..), + PixelRGBA8, pixelMapXY) +import Control.Monad.Free (Free (..), liftF) +import Control.Monad.Free.Church (fromF) +import Control.Monad.ST (ST, runST) +import Control.Monad.State (execState, modify) +import Data.Maybe (fromMaybe) + +import qualified Data.ByteString.Lazy as LB +import qualified Data.Vector as V + +import Graphics.Rasterific.Compositor +import Graphics.Rasterific.Linear (V2 (..), (^+^), (^-^)) +import Graphics.Rasterific.MicroPdf +import Graphics.Rasterific.Rasterize {-import Graphics.Rasterific.Texture-} -import Graphics.Rasterific.ComplexPrimitive -import Graphics.Rasterific.Types -import Graphics.Rasterific.Line -import Graphics.Rasterific.QuadraticBezier -import Graphics.Rasterific.CubicBezier -import Graphics.Rasterific.StrokeInternal -import Graphics.Rasterific.Transformations -import Graphics.Rasterific.PlaneBoundable -import Graphics.Rasterific.Immediate -import Graphics.Rasterific.PathWalker -import Graphics.Rasterific.Arc -import Graphics.Rasterific.Command -import Graphics.Rasterific.PatchTypes -import Graphics.Rasterific.Patch -import Graphics.Rasterific.MeshPatch +import Graphics.Rasterific.Arc +import Graphics.Rasterific.Command +import Graphics.Rasterific.ComplexPrimitive +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.Immediate +import Graphics.Rasterific.Line +import Graphics.Rasterific.MeshPatch +import Graphics.Rasterific.Patch +import Graphics.Rasterific.PatchTypes +import Graphics.Rasterific.PathWalker +import Graphics.Rasterific.PlaneBoundable +import Graphics.Rasterific.QuadraticBezier +import Graphics.Rasterific.StrokeInternal +import Graphics.Rasterific.Transformations +import Graphics.Rasterific.Types {-import Graphics.Rasterific.TensorPatch-} -import Graphics.Text.TrueType( Font - , Dpi - , PointSize( .. ) - ) +import Graphics.Text.TrueType (Dpi, Font, + PointSize (..)) {-import Debug.Trace-} {-import Text.Printf-} @@ -193,8 +189,8 @@ import Graphics.Text.TrueType( Font ---- Free Monad DSL section ------------------------------------------------ --- | Define the texture applyied to all the children --- draw call. +-- | Define the texture applied to all the children +-- draw calls. -- -- > withTexture (uniformTexture $ PixelRGBA8 0 0x86 0xc1 255) $ do -- > fill $ circle (V2 50 50) 20 @@ -256,17 +252,17 @@ withTransformation trans sub = -- -- <> -- --- You can note that the position of the baseline match the size of the +-- Note that the position of the baseline matches 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: +-- you can draw arbitrary geometry as 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 @@ -296,7 +292,7 @@ withPathOrientation path p sub = fill :: Geometry geom => geom -> Drawing px () fill prims = liftF $ Fill FillWinding (toPrimitives prims) () --- | This function let you choose how to fill the primitives +-- | This function lets you choose how to fill the primitives -- in case of self intersection. See `FillMethod` documentation -- for more information. fillWithMethod :: Geometry geom @@ -321,7 +317,7 @@ withClipping withClipping clipPath drawing = liftF $ WithCliping clipPath drawing () --- | Will stroke geometry with a given stroke width. +-- | Fill stroke geometry with a given stroke width. -- The elements should be connected -- -- > stroke 5 JoinRound (CapRound, CapRound) $ circle (V2 100 100) 75 @@ -338,8 +334,8 @@ stroke width join caping prims = liftF $ Stroke width join caping (toPrimitives prims) () -- | 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 +-- Text printing implies loading a font, there is no default +-- font (yet). Below is an example of font rendering using a -- font installed on Microsoft Windows. -- -- > import Graphics.Text.TrueType( loadFontFile ) @@ -361,10 +357,10 @@ stroke width join caping prims = -- -- <> -- --- You can use any texture, like a gradient while rendering text. +-- You can use any texture - like a gradient - while rendering text. -- printTextAt :: Font -- ^ Drawing font - -> PointSize -- ^ font Point size + -> PointSize -- ^ font point size -> Point -- ^ Drawing starting point (base line) -> String -- ^ String to print -> Drawing px () @@ -383,7 +379,7 @@ printTextAt font pointSize point string = renderMeshPatch :: PatchInterpolation -> MeshPatch px -> Drawing px () renderMeshPatch i mesh = liftF $ MeshPatchRender i mesh () --- | Print complex text, using different texture font and +-- | Print complex text, using a different texture font and -- point size for different parts of the text. -- -- > let blackTexture = @@ -410,8 +406,8 @@ data RenderContext px = RenderContext -- | 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 +-- in other colorspaces will probably produce weird results. +-- The default DPI is 96 renderDrawing :: forall px . (RenderablePixel px) => Int -- ^ Rendering width @@ -421,7 +417,7 @@ renderDrawing -> Image px renderDrawing width height = renderDrawingAtDpi width height 96 -renderOrdersAtDpiToPdf +renderOrdersAtDpiToPdf :: Int -- ^ Rendering width -> Int -- ^ Rendering height -> Dpi -- ^ Current DPI used for text rendering. @@ -472,20 +468,20 @@ cacheOrders imageFilter orders = case imageFilter of cornerUpperLeft = fromIntegral <$> cornerUpperLeftInt V2 width height = maxi ^-^ cornerUpperLeft ^+^ V2 1 1 - + shiftOrder order@DrawOrder { _orderPrimitives = prims } = - order { _orderPrimitives = fmap (transform (^-^ cornerUpperLeft)) <$> prims + order { _orderPrimitives = fmap (transform (^-^ cornerUpperLeft)) <$> prims , _orderTexture = WithTextureTransform (translate cornerUpperLeft) $ _orderTexture order } - + resultImage = runST $ runDrawContext (ceiling width) (ceiling height) emptyPx $ mapM_ (fillOrder . shiftOrder) orders -- | 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 +-- to an image internally and create a new order to render this image +-- instead of the geometry, effectively cutting the geometry generation -- part. -- -- It can save execution time when drawing complex elements multiple @@ -500,7 +496,7 @@ cacheDrawing cacheDrawing maxWidth maxHeight dpi sub = cacheOrders Nothing $ drawOrdersOfDrawing maxWidth maxHeight dpi emptyPx sub -{- +{- preComputeTexture :: (RenderablePixel px) => Int -> Int -> Texture px -> Texture px preComputeTexture w h = go where @@ -522,9 +518,9 @@ preComputeTexture w h = go where RawTexture $ renderDrawing w h emptyPx $ renderMeshPatch i m -- -} --- | Transform a drawing into a serie of low-level drawing orders. +-- | Transform a drawing into a series of low-level drawing orders. drawOrdersOfDrawing - :: forall px . (RenderablePixel px) + :: forall px . (RenderablePixel px) => Int -- ^ Rendering width -> Int -- ^ Rendering height -> Dpi -- ^ Current assumed DPI @@ -539,10 +535,10 @@ drawOrdersOfDrawing width height dpi background drawing = clipForeground = fullValue :: PixelBaseComponent px clipRender ctxt = - renderDrawing width height clipBackground . + renderDrawing width height clipBackground . transformer . withTexture (SolidTexture clipForeground) - where + where transformer = maybe id (withTransformation . fst) $ currentTransformation ctxt @@ -571,7 +567,7 @@ drawOrdersOfDrawing width height dpi background drawing = go _ (Pure ()) rest = rest go ctxt (Free (WithGlobalOpacity opa sub next)) rest = go ctxt (Free (WithImageEffect opacifier sub next)) rest - where + where -- Todo: a colorMapWithAlpha is really needed in JP API. opacifier _ _ _ px = mixWithAlpha ignore alphaModulate px px ignore _ _ a = a @@ -607,7 +603,7 @@ drawOrdersOfDrawing width height dpi background drawing = go ctxt (Free (CustomRender cust next)) rest = order : after where after = go ctxt next rest - order = DrawOrder + order = DrawOrder { _orderPrimitives = [] , _orderTexture = textureOf ctxt , _orderFillMethod = FillWinding @@ -619,11 +615,11 @@ drawOrdersOfDrawing width height dpi background drawing = after = go ctxt next rest rendering :: DrawContext (ST s) px () rendering = case i of - PatchBilinear -> mapM_ rasterizeCoonPatch $ coonPatchesOf $ geometryOf ctxt opaqueMesh + PatchBilinear -> mapM_ rasterizeCoonPatch $ coonPatchesOf $ geometryOf ctxt opaqueMesh PatchBicubic -> mapM_ rasterizeCoonPatch - . cubicCoonPatchesOf - $ calculateMeshColorDerivative $ geometryOf ctxt opaqueMesh + . cubicCoonPatchesOf + $ calculateMeshColorDerivative $ geometryOf ctxt opaqueMesh hasTransparency = V.any ((/= fullValue) . pixelOpacity) $ _meshColors mesh @@ -640,11 +636,11 @@ drawOrdersOfDrawing width height dpi background drawing = newMask = clipRender ctxt $ renderMeshPatch i transparencyMesh in case currentClip ctxt of Nothing -> Just $ RawTexture newMask - Just v -> Just $ ModulateTexture v (RawTexture newMask) + Just v -> Just $ ModulateTexture v (RawTexture newMask) order = case clipPath of -- Good, we can directly render on the final canvas - Nothing -> DrawOrder + Nothing -> DrawOrder { _orderPrimitives = [] , _orderTexture = textureOf ctxt , _orderFillMethod = FillWinding @@ -661,7 +657,7 @@ drawOrdersOfDrawing width height dpi background drawing = go ctxt (Free (Fill method prims next)) rest = order : after where after = go ctxt next rest - order = DrawOrder + order = DrawOrder { _orderPrimitives = [geometryOf ctxt prims] , _orderTexture = textureOf ctxt , _orderFillMethod = method @@ -742,8 +738,8 @@ dashedStrokeWithOffset _ [] width join caping prims = dashedStrokeWithOffset offset dashing width join caping prims = liftF $ DashedStroke offset dashing width join caping (toPrimitives prims) () --- | Generate a strokable line out of points list. --- Just an helper around `lineFromPath`. +-- | Generate a strokable line out of a points list. +-- Just a helper around `lineFromPath`. -- -- > stroke 4 JoinRound (CapRound, CapRound) $ -- > polyline [V2 10 10, V2 100 70, V2 190 190] @@ -753,7 +749,7 @@ dashedStrokeWithOffset offset dashing width join caping prims = polyline :: [Point] -> [Primitive] polyline = map LinePrim . lineFromPath --- | Generate a fillable polygon out of points list. +-- | Generate a fillable polygon out of a points list. -- Similar to the `polyline` function, but close the -- path. -- @@ -762,9 +758,9 @@ polyline = map LinePrim . lineFromPath -- <> -- polygon :: [Point] -> [Primitive] -polygon [] = [] -polygon [_] = [] -polygon [_,_] = [] +polygon [] = [] +polygon [_] = [] +polygon [_,_] = [] polygon lst@(p:_) = polyline $ lst ++ [p] -- | Simply draw an image into the canvas. Take into account @@ -815,7 +811,7 @@ drawImageAtSize img@Image { imageWidth = w, imageHeight = h } borderSize ip scaleY | reqHeight == 0 = 1 | otherwise = reqHeight / rh --- | Return a simple line ready to be stroked. +-- | Return a simple line, easily turned into a stroke. -- -- > stroke 17 JoinRound (CapRound, CapRound) $ -- > line (V2 10 10) (V2 180 170) diff --git a/src/Graphics/Rasterific/ComplexPrimitive.hs b/src/Graphics/Rasterific/ComplexPrimitive.hs index 015cb3e..5d0ea1d 100644 --- a/src/Graphics/Rasterific/ComplexPrimitive.hs +++ b/src/Graphics/Rasterific/ComplexPrimitive.hs @@ -1,4 +1,4 @@ --- | Provide definition for some higher level objects (only slightly) +-- | Provides definitions for some higher level objects (only slightly) module Graphics.Rasterific.ComplexPrimitive( rectangle , roundedRectangle , circle @@ -22,7 +22,7 @@ isCoordValid v isPointValid :: RealFloat a => V2 a -> Maybe ArithException isPointValid (V2 x y) = isCoordValid x <|> isCoordValid y --- | Generate a list of primitive representing a circle. +-- | Generate a list of primitives representing a circle. -- -- > fill $ circle (V2 100 100) 75 -- @@ -38,7 +38,7 @@ circle center radius = where mv p = (p ^* radius) ^+^ center --- | Generate a list of primitive representing an ellipse. +-- | Generate a list of primitives representing an ellipse. -- -- > fill $ ellipse (V2 100 100) 75 30 -- @@ -52,7 +52,7 @@ ellipse center rx ry = where mv (V2 x y) = V2 (x * rx) (y * ry) ^+^ center --- | Generate a list of primitive representing a +-- | Generate a list of primitives representing a -- rectangle -- -- > fill $ rectangle (V2 30 30) 150 100 @@ -69,8 +69,8 @@ rectangle p@(V2 px py) w h = LinePrim <$> lineFromPath [ p, V2 (px + w) py, V2 (px + w) (py + h), V2 px (py + h), p ] --- | Generate a list of primitive representing a rectangle --- with rounded corner. +-- | Generate a list of primitives representing a rectangle +-- with rounded corners. -- -- > fill $ roundedRectangle (V2 10 10) 150 150 20 10 -- diff --git a/src/Graphics/Rasterific/Compositor.hs b/src/Graphics/Rasterific/Compositor.hs index 7bc9ce6..fe1e081 100644 --- a/src/Graphics/Rasterific/Compositor.hs +++ b/src/Graphics/Rasterific/Compositor.hs @@ -1,7 +1,7 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TypeFamilies #-} --- | Compositor handle the pixel composition, which +{-# LANGUAGE TypeFamilies #-} +-- | Compositor handles the pixel composition, which -- leads to texture composition. -- Very much a work in progress module Graphics.Rasterific.Compositor @@ -16,24 +16,21 @@ module Graphics.Rasterific.Compositor , emptyPx ) where -import Foreign.Storable( Storable ) -import Data.Bits( unsafeShiftR ) -import Data.Word( Word8, Word32 ) +import Data.Bits (unsafeShiftR) +import Data.Word (Word32, Word8) +import Foreign.Storable (Storable) -import Codec.Picture.Types - ( Pixel( .. ) - , PixelRGB8( .. ) - , PixelRGBA8( .. ) - , PackeablePixel( .. ) ) +import Codec.Picture.Types (PackeablePixel (..), Pixel (..), + PixelRGB8 (..), PixelRGBA8 (..)) -import Graphics.Rasterific.Linear -import Graphics.Rasterific.Types +import Graphics.Rasterific.Linear +import Graphics.Rasterific.Types type Compositor px = PixelBaseComponent px -> PixelBaseComponent px -> px -> px -> px --- | Used for Coon patch rendering +-- | Used for Coons patch rendering class ( Applicative (Holder a) , Functor (Holder a) , Foldable (Holder a) @@ -72,8 +69,8 @@ instance InterpolablePixel PixelRGBA8 where where to = floor maxRepresentable Proxy = 255 --- | This constraint ensure that a type is a pixel --- and we're allowed to modulate it's color components +-- | This constraint ensures that a type is a pixel +-- and we're allowed to modulate its color components -- generically. type ModulablePixel px = ( Pixel px @@ -83,8 +80,8 @@ type ModulablePixel px = , Storable (PackedRepresentation px) , Modulable (PixelBaseComponent px)) --- | This constraint tells us that pixel component --- must also be pixel and be the "bottom" of component, +-- | This constraint tells us that a pixel component +-- must also be a pixel and be the "bottom" of component, -- we cannot go further than a PixelBaseComponent level. -- -- Tested pixel types are PixelRGBA8 & Pixel8 @@ -101,8 +98,8 @@ type RenderablePixel px = ~ (PixelBaseComponent px) ) --- | Typeclass intented at pixel value modulation. --- May be throwed out soon. +-- | Typeclass intented for pixel value modulation. +-- May be thrown out soon. class (Ord a, Num a) => Modulable a where -- | Empty value representing total transparency for the given type. emptyValue :: a diff --git a/src/Graphics/Rasterific/CubicBezier.hs b/src/Graphics/Rasterific/CubicBezier.hs index f69555b..da490dd 100644 --- a/src/Graphics/Rasterific/CubicBezier.hs +++ b/src/Graphics/Rasterific/CubicBezier.hs @@ -200,18 +200,18 @@ offsetCubicBezier offset bezier@(CubicBezier a b c d) -- | Clamp the cubic bezier curve inside a rectangle -- given in parameter. clipCubicBezier - :: Point -- ^ Point representing the "minimal" point for cliping - -> Point -- ^ Point representing the "maximal" point for cliping + :: Point -- ^ Point representing the "minimal" point for clipping + -> Point -- ^ Point representing the "maximal" point for clipping -> CubicBezier -- ^ The cubic bezier curve to be clamped -> Container Primitive clipCubicBezier mini maxi bezier@(CubicBezier a b c d) -- If we are in the range bound, return the curve -- unaltered | insideX && insideY = pure $ CubicBezierPrim bezier - -- If one of the component is outside, clamp + -- If one of the components is outside, clamp -- the components on the boundaries and output a -- straight line on this boundary. Useful for the - -- filing case, to clamp the polygon drawing on + -- filling case, to clamp the polygon drawing on -- the edge | outsideX || outsideY = pure . CubicBezierPrim $ clampedA `straightLine` clampedD diff --git a/src/Graphics/Rasterific/CubicBezier/FastForwardDifference.hs b/src/Graphics/Rasterific/CubicBezier/FastForwardDifference.hs index 5c3064e..0fe8b13 100644 --- a/src/Graphics/Rasterific/CubicBezier/FastForwardDifference.hs +++ b/src/Graphics/Rasterific/CubicBezier/FastForwardDifference.hs @@ -97,7 +97,7 @@ isCubicBezierInImage img (CubicBezier a b c d) = isIn a && isIn b && isIn c && isIn d where isIn = isPointInImage img --- | Rasterize a cubic bezier curve using the Fast Forward Diffrence +-- | Rasterize a cubic bezier curve using the Fast Forward Difference -- algorithm. rasterizerCubicBezier :: (PrimMonad m, ModulablePixel px, BiSampleable src px) => src -> CubicBezier @@ -149,7 +149,7 @@ rasterizerCubicBezier source bez uStart vStart uEnd vEnd = do else lift $ go 0 ax' bx' ay' by' xStart yStart vStart --- | Rasterize a coon patch using the Fast Forward Diffrence algorithm, +-- | Rasterize a Coons patch using the Fast Forward Difference algorithm, -- likely to be faster than the subdivision one. rasterizeCoonPatch :: (PrimMonad m, ModulablePixel px, BiSampleable src px) => CoonPatch src -> DrawContext m px () @@ -157,7 +157,7 @@ rasterizeCoonPatch :: (PrimMonad m, ModulablePixel px, BiSampleable src px) -> DrawContext (ST s) PixelRGBA8 () #-} rasterizeCoonPatch = rasterizeTensorPatch . toTensorPatch --- | Rasterize a tensor patch using the Fast Forward Diffrence algorithm, +-- | Rasterize a tensor patch using the Fast Forward Difference algorithm, -- likely to be faster than the subdivision one. rasterizeTensorPatch :: (PrimMonad m, ModulablePixel px, BiSampleable src px) => TensorPatch src -> DrawContext m px () diff --git a/src/Graphics/Rasterific/Immediate.hs b/src/Graphics/Rasterific/Immediate.hs index 88e9b15..1760955 100644 --- a/src/Graphics/Rasterific/Immediate.hs +++ b/src/Graphics/Rasterific/Immediate.hs @@ -123,7 +123,7 @@ fillOrder o@DrawOrder { _orderMask = Just mask } = do lift $ primToPrim $ flip evalStateT img $ _orderDirect o -- | Start an image rendering. See `fillWithTexture` for --- an usage example. This function can work with either +-- a usage example. This function can work with either -- `IO` or `ST`. runDrawContext :: forall m px . (PrimMonad m, RenderablePixel px) => Int -- ^ Rendering width diff --git a/src/Graphics/Rasterific/Lenses.hs b/src/Graphics/Rasterific/Lenses.hs index 2578202..2f383e8 100644 --- a/src/Graphics/Rasterific/Lenses.hs +++ b/src/Graphics/Rasterific/Lenses.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-} --- | This module provide lenses compatible with the `lens` --- module but without the dependency to it. +-- | This module provides lenses compatible with the `lens` +-- module, without depending on it. module Graphics.Rasterific.Lenses ( -- * Line lenses lineX0 @@ -36,7 +36,7 @@ module Graphics.Rasterific.Lenses import Graphics.Rasterific.Types --- | Does it look familiar? yes it's the official +-- | Does it look familiar? Yes, it's the official -- Lens type. type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t diff --git a/src/Graphics/Rasterific/Line.hs b/src/Graphics/Rasterific/Line.hs index d3fc7e0..b49d88b 100644 --- a/src/Graphics/Rasterific/Line.hs +++ b/src/Graphics/Rasterific/Line.hs @@ -26,7 +26,7 @@ import Graphics.Rasterific.Linear import Graphics.Rasterific.Operators import Graphics.Rasterific.Types --- | Transform a list a point to a list of lines +-- | Transform a list of points to a list of lines -- -- > lineFromPath [a, b, c, d] = [Line a b, Line b c, Line c d] -- @@ -62,22 +62,22 @@ offsetLine offset (Line a b) = pure . LinePrim $ Line shiftedA shiftedB -- | Clamp the bezier curve inside a rectangle -- given in parameter. -clipLine :: Point -- ^ Point representing the "minimal" point for cliping - -> Point -- ^ Point representing the "maximal" point for cliping +clipLine :: Point -- ^ Point representing the "minimal" point for clipping + -> Point -- ^ Point representing the "maximal" point for clipping -> Line -- ^ The line -> Container Primitive clipLine mini maxi poly@(Line a b) -- If we are in the range bound, return the curve -- unaltered | insideX && insideY = pure . LinePrim $ poly - -- If one of the component is outside, clamp + -- If one of the components is outside, clamp -- the components on the boundaries and output a -- straight line on this boundary. Useful for the - -- filing case, to clamp the polygon drawing on + -- filling case, to clamp the polygon drawing on -- the edge | outsideX || outsideY = pure . LinePrim $ Line clampedA clampedB - -- Not completly inside nor outside, just divide + -- Not completely inside nor outside, just divide -- and conquer. | otherwise = recurse (Line a m) <> recurse (Line m b) where -- Minimal & maximal dimension of the bezier curve @@ -119,7 +119,7 @@ clipLine mini maxi poly@(Line a b) -- edge. m = vpartition (vabs (ab ^-^ edge) ^< 0.1) edge ab --- TODO: implement better algorithm for lines, should +-- TODO: implement a better algorithm for lines, should -- be doable. decomposeLine :: Line -> Producer EdgeSample decomposeLine (Line (V2 aRx aRy) (V2 bRx bRy)) = go aRx aRy bRx bRy where diff --git a/src/Graphics/Rasterific/Linear.hs b/src/Graphics/Rasterific/Linear.hs index 2e6c21c..692eda2 100644 --- a/src/Graphics/Rasterific/Linear.hs +++ b/src/Graphics/Rasterific/Linear.hs @@ -1,11 +1,11 @@ -- | This module is a reduction of the `Linear` package --- from Edward Kmett to match just the need of Rasterific. +-- from Edward Kmett to match just the needs of Rasterific. -- -- If the flag `embed_linear` is disabled, this module is -- just a reexport from the real linear package. -- +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE CPP #-} module Graphics.Rasterific.Linear ( V1( .. ) , V2( .. ) @@ -23,10 +23,10 @@ module Graphics.Rasterific.Linear #ifdef EXTERNAL_LINEAR -- We just reexport -import Linear +import Linear #else -import Graphics.Rasterific.MiniLens +import Graphics.Rasterific.MiniLens infixl 6 ^+^, ^-^ infixl 7 ^*, ^/ @@ -202,7 +202,7 @@ instance Applicative V2 where instance Applicative V1 where {-# INLINE pure #-} - pure = V1 + pure = V1 {-# INLINE (<*>) #-} (V1 f) <*> (V1 v) = V1 $ f v @@ -349,7 +349,7 @@ class Additive f => Metric f where {-# INLINE norm #-} norm v = sqrt (quadrance v) - -- | Convert a non-zero vector to unit vector. + -- | Convert a non-zero vector to a unit vector. signorm :: Floating a => f a -> f a signorm v = fmap (/ m) v where m = norm v diff --git a/src/Graphics/Rasterific/MeshPatch.hs b/src/Graphics/Rasterific/MeshPatch.hs index 6a47277..f31a635 100644 --- a/src/Graphics/Rasterific/MeshPatch.hs +++ b/src/Graphics/Rasterific/MeshPatch.hs @@ -254,7 +254,7 @@ freezeMesh MutableMesh { .. } = do _meshColors <- V.freeze _meshMutColors return MeshPatch { .. } --- | Retrieve a mesh primary vertice purely +-- | Retrieve a mesh primary vertex purely verticeAt :: MeshPatch px -> Int -- ^ Between 0 and _meshPatchWidth + 1 (excluded) -> Int -- ^ Between 0 and _meshPatchHeight + 1 (excluded) @@ -274,7 +274,7 @@ withMesh mesh act = runST $ do final <- freezeMesh mut return (v, final) --- | Set the vertice of a mesh at a given coordinate +-- | Set the vertex of a mesh at a given coordinate setVertice :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) => Int -- ^ x coordinate in [0, w] -> Int -- ^ y coordinate in [0, h] @@ -285,7 +285,7 @@ setVertice x y p = do let idx = y * (_meshMutWidth + 1) + x MV.write _meshMutPrimaryVertices idx p --- | Get the position of vertice +-- | Get the position of vertex getVertice :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) => Int -> Int -> m Point getVertice x y = do @@ -310,7 +310,7 @@ setVertPoints x y p = do MV.write _meshMutVertSecondary idx p --- | Set the value associated to a vertex +-- | Set the value associated with a vertex setColor :: (MonadReader (MutableMesh (PrimState m) px) m, PrimMonad m) => Int -> Int -> px -> m () setColor x y p = do @@ -319,7 +319,7 @@ setColor x y p = do MV.write _meshMutColors idx p -- | Generate a meshpatch at the size given by the image and --- a number of cell in a mesh +-- a number of cells in a mesh generateImageMesh :: Int -- ^ Horizontal cell count -> Int -- ^ Vertical cell count -> Point -- ^ Position of the corner upper left @@ -380,7 +380,7 @@ generateLinearGrid w h base (V2 dx dy) colors = MeshPatch type ColorPreparator px pxt = ParametricValues px -> pxt --- | Extract a coon patch at a given position. +-- | Extract a Coons patch at a given position. coonPatchAt :: MeshPatch px -> Int -- ^ x -> Int -- ^ y @@ -410,7 +410,7 @@ tensorImagePatchAt :: MeshPatch (ImageMesh px) -> TensorPatch (ImageMesh px) tensorImagePatchAt = tensorPatchAt' _northValue --- | Extract a coon patch for cubic interpolation at a given position +-- | Extract a Coons patch for cubic interpolation at a given position -- see `calculateMeshColorDerivative` coonPatchAtWithDerivative :: (InterpolablePixel px) => MeshPatch (Derivative px) @@ -564,7 +564,7 @@ coonPatchAt' preparator mesh x y = CoonPatch InterBezier p10 p20 = vInter ! baseV InterBezier p13 p23 = vInter ! (baseV + 1) --- | Extract a list of all the coon patches of the mesh. +-- | Extract a list of all the Coons patches of the mesh. coonPatchesOf :: MeshPatch px -> [CoonPatch (ParametricValues px)] coonPatchesOf mesh@MeshPatch { .. } = [coonPatchAt mesh x y | y <- [0 .. _meshPatchHeight - 1], x <- [0 .. _meshPatchWidth - 1]] @@ -574,17 +574,17 @@ tensorPatchesOf :: MeshPatch px -> [TensorPatch (ParametricValues px)] tensorPatchesOf mesh@MeshPatch { .. } = [tensorPatchAt mesh x y | y <- [0 .. _meshPatchHeight - 1], x <- [0 .. _meshPatchWidth - 1]] --- | Extract all the coon patch of a mesh using an image interpolation. +-- | Extract all the Coons patches of a mesh using an image interpolation. imagePatchesOf :: MeshPatch (ImageMesh px) -> [CoonPatch (ImageMesh px)] imagePatchesOf mesh@MeshPatch { .. } = [coonImagePatchAt mesh x y | y <- [0 .. _meshPatchHeight - 1], x <- [0 .. _meshPatchWidth - 1]] --- | Extract all the tensor patch of a mesh using an image interpolation. +-- | Extract all the tensor patches of a mesh using an image interpolation. tensorImagePatchesOf :: MeshPatch (ImageMesh px) -> [TensorPatch (ImageMesh px)] tensorImagePatchesOf mesh@MeshPatch { .. } = [tensorImagePatchAt mesh x y | y <- [0 .. _meshPatchHeight - 1], x <- [0 .. _meshPatchWidth - 1]] --- | Extract all the coon patch of a mesh using cubic interpolation. +-- | Extract all the Coons patches of a mesh using cubic interpolation. cubicCoonPatchesOf :: (InterpolablePixel px) => MeshPatch (Derivative px) -> [CoonPatch (CubicCoefficient px)] @@ -593,7 +593,7 @@ cubicCoonPatchesOf mesh@MeshPatch { .. } = | y <- [0 .. _meshPatchHeight - 1] , x <- [0 .. _meshPatchWidth - 1] ] --- | Extract all the tensor patch of a mesh using cubic interpolation. +-- | Extract all the tensor patches of a mesh using cubic interpolation. cubicTensorPatchesOf :: (InterpolablePixel px) => MeshPatch (Derivative px) -> [TensorPatch (CubicCoefficient px)] diff --git a/src/Graphics/Rasterific/MiniLens.hs b/src/Graphics/Rasterific/MiniLens.hs index 656b776..476a23d 100644 --- a/src/Graphics/Rasterific/MiniLens.hs +++ b/src/Graphics/Rasterific/MiniLens.hs @@ -32,7 +32,7 @@ infixl 8 .^ infixr 4 .~ infix 4 .=,%=,+= --- | Does it look familiar? yes it's the official +-- | Does it look familiar? Yes, it's the official -- Lens type. type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t @@ -47,7 +47,7 @@ type Traversal s t a b = type Traversal' s a = Traversal s s a a --- | Create a full lens out of setter and getter +-- | Create a full lens out of a setter and a getter lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b diff --git a/src/Graphics/Rasterific/Outline.hs b/src/Graphics/Rasterific/Outline.hs index 0eb8d61..86beff4 100644 --- a/src/Graphics/Rasterific/Outline.hs +++ b/src/Graphics/Rasterific/Outline.hs @@ -1,5 +1,5 @@ --- | This module provide helper functions to create outline --- of shapes. +-- | This module provides helper functions to create outlines +-- of shapes. module Graphics.Rasterific.Outline ( StrokeWidth , strokize diff --git a/src/Graphics/Rasterific/Patch.hs b/src/Graphics/Rasterific/Patch.hs index 1a6567a..80562c7 100644 --- a/src/Graphics/Rasterific/Patch.hs +++ b/src/Graphics/Rasterific/Patch.hs @@ -1,15 +1,15 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} -- | Implementation using --- "An efficient algorithm for subdivising linear Coons surfaces" +-- "An efficient algorithm for subdividing linear Coons surfaces" -- C.Yao and J.Rokne -- Computer aided design 8 (1991) 291-303 module Graphics.Rasterific.Patch @@ -25,7 +25,7 @@ module Graphics.Rasterific.Patch -- * Rendering functions -- ** Using Fast Forward Differences - , rasterizeTensorPatch + , rasterizeTensorPatch , rasterizeCoonPatch , renderImageMesh , renderCoonMesh @@ -52,25 +52,26 @@ module Graphics.Rasterific.Patch , transposePatch ) where -import Control.Monad.Free( liftF ) -import Control.Monad( when, forM_ ) -import Control.Monad.Primitive( PrimMonad ) -import Data.Monoid( Sum( .. ) ) -import Graphics.Rasterific.Types -import Graphics.Rasterific.CubicBezier -import Graphics.Rasterific.CubicBezier.FastForwardDifference -import Graphics.Rasterific.Operators -import Graphics.Rasterific.Linear -import Graphics.Rasterific.Compositor -import Graphics.Rasterific.ComplexPrimitive -import Graphics.Rasterific.Line( lineFromPath ) -import Graphics.Rasterific.Immediate -import Graphics.Rasterific.BiSampleable -import Graphics.Rasterific.PatchTypes -import Graphics.Rasterific.MeshPatch -import Graphics.Rasterific.Command - -import Codec.Picture.Types( PixelRGBA8( .. ) ) +import Control.Monad (forM_, + when) +import Control.Monad.Free (liftF) +import Control.Monad.Primitive (PrimMonad) +import Data.Monoid (Sum (..)) +import Graphics.Rasterific.BiSampleable +import Graphics.Rasterific.Command +import Graphics.Rasterific.ComplexPrimitive +import Graphics.Rasterific.Compositor +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.CubicBezier.FastForwardDifference +import Graphics.Rasterific.Immediate +import Graphics.Rasterific.Line (lineFromPath) +import Graphics.Rasterific.Linear +import Graphics.Rasterific.MeshPatch +import Graphics.Rasterific.Operators +import Graphics.Rasterific.PatchTypes +import Graphics.Rasterific.Types + +import Codec.Picture.Types (PixelRGBA8 (..)) -- @ -- North -----> East @@ -89,7 +90,7 @@ import Codec.Picture.Types( PixelRGBA8( .. ) ) maxColorDeepness :: forall px. InterpolablePixel px => ParametricValues px -> Int maxColorDeepness values = ceiling $ log (maxDelta * range) / log 2 where range = maxRepresentable (Proxy :: Proxy px) - maxDelta = + maxDelta = maximum [ maxDistance north east , maxDistance east south , maxDistance south west @@ -189,7 +190,7 @@ subdivideWeights values = Subdivided { .. } where , _southValue = midSoutValue , _westValue = west } - + _southEast = ParametricValues { _northValue = gridMidValue , _eastValue = midEastValue @@ -282,8 +283,8 @@ horizontalTensorSubdivide p = (TensorPatch l0 l1 l2 l3 vl, TensorPatch r0 r1 r2 (l3, r3) = divideCubicBezier $ _curve3 p (vl, vr) = subdivideHorizontal $ _tensorValues p --- | Subdivide a tensor patch into 4 new quadrant. --- Perform twice the horizontal subdivision with a transposition. +-- | Subdivide a tensor patch into 4 new quadrants. +-- Perform the horizontal subdivision with a transposition twice. subdivideTensorPatch :: TensorPatch UVPatch -> Subdivided (TensorPatch UVPatch) subdivideTensorPatch p = subdivided where (west, east) = horizontalTensorSubdivide p @@ -320,7 +321,7 @@ data Subdivided a = Subdivided , _southEast :: !a -- ^ Lower right } --- | Split a coon patch into four new quadrants +-- | Split a Coons patch into four new quadrants subdividePatch :: CoonPatch UVPatch -> Subdivided (CoonPatch UVPatch) subdividePatch patch = Subdivided { _northWest = northWest @@ -342,9 +343,9 @@ subdividePatch patch = Subdivided (westBottom, westTop@(CubicBezier midWest _ _ _)) = divideCubicBezier $ _west patch (eastTop@(CubicBezier _ _ _ midEast), eastBottom) = divideCubicBezier $ _east patch - -- This points are to calculate S_B + -- These points are to calculate S_B midNorthSouth = north `midCurve` south - midEastWest = _east patch `midCurve` _west patch + midEastWest = _east patch `midCurve` _west patch (splitNorthSouthTop, splitNorthSouthBottom) = divideCubicBezier $ combine @@ -415,7 +416,7 @@ straightLine a b = CubicBezier a p1 p2 b where p2 = lerp (2/3) b a --- | The curves in the coon patch are inversed! +-- | The curves in the Coons patch are inversed! midCurve :: CubicBezier -> CubicBezier -> CubicBezier midCurve (CubicBezier a b c d) (CubicBezier d' c' b' a') = CubicBezier @@ -434,7 +435,7 @@ drawCoonPatchOutline CoonPatch { .. } = pointsOf :: PointFoldable v => v -> [Point] pointsOf = foldPoints (flip (:)) [] --- | Used to describe how to debug print a coon/tensort patch. +-- | Used to describe how to debug print a Coons/tensor patch. data DebugOption = DebugOption { _drawControlMesh :: !Bool , _drawBaseVertices :: !Bool @@ -461,7 +462,7 @@ defaultDebug = DebugOption , _controlColor = PixelRGBA8 20 20 40 255 } --- | Helper function drawing many information about a coon patch. +-- | Helper function that draws a lot of information about a Coons patch. debugDrawCoonPatch :: DebugOption -> CoonPatch (ParametricValues PixelRGBA8) -> Drawing PixelRGBA8 () debugDrawCoonPatch DebugOption { .. } patch@(CoonPatch { .. }) = do @@ -488,7 +489,7 @@ debugDrawCoonPatch DebugOption { .. } patch@(CoonPatch { .. }) = do setColor' _controlMeshColor $ do mapM_ controlDraw [_north, _east, _west, _south] --- | Helper function drawing many information about a tensor patch. +-- | Helper function that draws a lot of information about a tensor patch. debugDrawTensorPatch :: DebugOption -> TensorPatch (ParametricValues px) -> Drawing PixelRGBA8 () debugDrawTensorPatch DebugOption { .. } p = do @@ -523,13 +524,13 @@ parametricBase = ParametricValues , _westValue = V2 0 1 } --- | Render a simple coon mesh, with only color on the vertices. +-- | Render a simple Coons mesh, with only color on the vertices. renderCoonMesh :: forall m px. (PrimMonad m, RenderablePixel px, BiSampleable (ParametricValues px) px) => MeshPatch px -> DrawContext m px () renderCoonMesh = mapM_ (rasterizeTensorPatch . toTensorPatch) . coonPatchesOf --- | Render a coon mesh but using cubic interpolation for the color. +-- | Render a Coons mesh but using cubic interpolation for the color. renderCoonMeshBicubic :: forall m px. ( PrimMonad m , RenderablePixel px @@ -540,24 +541,24 @@ renderCoonMeshBicubic = . cubicCoonPatchesOf . calculateMeshColorDerivative --- | Render an mesh patch by interpolating accross an image. +-- | Render a mesh patch by interpolating accross an image. renderImageMesh :: PrimMonad m => MeshPatch (ImageMesh PixelRGBA8) -> DrawContext m PixelRGBA8 () renderImageMesh = mapM_ (rasterizeTensorPatch . toTensorPatch) . imagePatchesOf --- | Render a coon patch using the subdivision algorithm (potentially slower --- and less precise in case of image mesh. +-- | Render a Coons patch using the subdivision algorithm (potentially slower +-- and less precise in case of an image mesh. renderCoonPatch :: forall m interp px. (PrimMonad m, RenderablePixel px, BiSampleable interp px) => CoonPatch interp -> DrawContext m px () renderCoonPatch p = renderCoonPatchAtDeepness (estimateCoonSubdivision p) p --- | Render a coon patch using the subdivision algorithm (potentially slower --- and less precise in case of image mesh). You can provide a max deepness +-- | Render a Coons patch using the subdivision algorithm (potentially slower +-- and less precise in case of an image mesh). You can provide a max depth. renderCoonPatchAtDeepness :: forall m interp px. (PrimMonad m, RenderablePixel px, BiSampleable interp px) - => Int -- ^ Maximum subdivision deepness + => Int -- ^ Maximum subdivision depth. -> CoonPatch interp -> DrawContext m px () renderCoonPatchAtDeepness maxDeepness originalPatch = go maxDeepness basePatch where @@ -575,15 +576,15 @@ renderCoonPatchAtDeepness maxDeepness originalPatch = go maxDeepness basePatch w let d = depth - (1 :: Int) in go d _northWest >> go d _northEast >> go d _southWest >> go d _southEast -renderTensorPatch :: forall m sampled px. +renderTensorPatch :: forall m sampled px. (PrimMonad m, RenderablePixel px, BiSampleable sampled px) => TensorPatch sampled -> DrawContext m px () renderTensorPatch p = renderTensorPatchAtDeepness (estimateTensorSubdivision p) p -- | Render a tensor patch using the subdivision algorithm (potentially slower --- and less precise in case of image mesh. +-- and less precise in case of an image mesh. renderTensorPatchAtDeepness - :: forall m sampled px. + :: forall m sampled px. (PrimMonad m, RenderablePixel px, BiSampleable sampled px) => Int -> TensorPatch sampled -> DrawContext m px () renderTensorPatchAtDeepness maxDeepness originalPatch = go maxDeepness basePatch where diff --git a/src/Graphics/Rasterific/PatchTypes.hs b/src/Graphics/Rasterific/PatchTypes.hs index 0ff1972..4377c92 100644 --- a/src/Graphics/Rasterific/PatchTypes.hs +++ b/src/Graphics/Rasterific/PatchTypes.hs @@ -1,12 +1,12 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Graphics.Rasterific.PatchTypes ( -- * New geometry CoonPatch( .. ) @@ -26,7 +26,7 @@ module Graphics.Rasterific.PatchTypes , ImageMesh( .. ) -- * Helper functions - , transposeParametricValues + , transposeParametricValues , coonPointAt , toTensorPatch , foldMeshPoints @@ -37,17 +37,17 @@ module Graphics.Rasterific.PatchTypes , yDerivative ) where -import Data.Monoid( (<>) ) -import qualified Data.Vector as V +import Data.Monoid ((<>)) +import qualified Data.Vector as V -import Codec.Picture( Image ) +import Codec.Picture (Image) -import Graphics.Rasterific.CubicBezier -import Graphics.Rasterific.MiniLens -import Graphics.Rasterific.Linear -import Graphics.Rasterific.Types -import Graphics.Rasterific.Compositor -import Graphics.Rasterific.Transformations +import Graphics.Rasterific.Compositor +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.Linear +import Graphics.Rasterific.MiniLens +import Graphics.Rasterific.Transformations +import Graphics.Rasterific.Types -- | Type of coordinate interpolation type CoonColorWeight = Float @@ -116,9 +116,9 @@ data ParametricValues a = ParametricValues -- | Store the derivative necessary for cubic interpolation in -- the gradient mesh. data Derivative px = Derivative - { _derivValues :: !(Holder px Float) - , _xDerivative :: !(Holder px Float) - , _yDerivative :: !(Holder px Float) + { _derivValues :: !(Holder px Float) + , _xDerivative :: !(Holder px Float) + , _yDerivative :: !(Holder px Float) , _xyDerivative :: !(Holder px Float) } @@ -129,7 +129,7 @@ xDerivative :: Lens' (Derivative px) (Holder px Float) xDerivative = lens _xDerivative setter where setter o v = o { _xDerivative = v } --- | Help lens +-- | Helping lens yDerivative :: Lens' (Derivative px) (Holder px Float) yDerivative = lens _yDerivative setter where setter o v = o { _yDerivative = v } @@ -148,10 +148,10 @@ transposeParametricValues (ParametricValues n e s w) = ParametricValues n w s e -- | Describe a tensor patch data TensorPatch weight = TensorPatch - { _curve0 :: !CubicBezier - , _curve1 :: !CubicBezier - , _curve2 :: !CubicBezier - , _curve3 :: !CubicBezier + { _curve0 :: !CubicBezier + , _curve1 :: !CubicBezier + , _curve2 :: !CubicBezier + , _curve3 :: !CubicBezier , _tensorValues :: !weight } @@ -181,7 +181,7 @@ instance {-# OVERLAPPING #-} PointFoldable (TensorPatch px) where foldPoints f acc (TensorPatch c0 c1 c2 c3 _) = g c3 . g c2 . g c1 $ g c0 acc where g v a = foldPoints f a v --- | Define the boundary and interpolated values of a coon patch. +-- | Define the boundary and interpolated values of a Coons patch. -- -- @ -- -----> @@ -200,17 +200,17 @@ instance {-# OVERLAPPING #-} PointFoldable (TensorPatch px) where -- @ -- data CoonPatch weight = CoonPatch - { _north :: !CubicBezier -- ^ North border, from left to right at top - , _east :: !CubicBezier -- ^ East obrder, from top to bottom - , _south :: !CubicBezier -- ^ South border from right to left - , _west :: !CubicBezier -- ^ West border from bottom to top + { _north :: !CubicBezier -- ^ North border, from left to right at top + , _east :: !CubicBezier -- ^ East obrder, from top to bottom + , _south :: !CubicBezier -- ^ South border from right to left + , _west :: !CubicBezier -- ^ West border from bottom to top , _coonValues :: !weight -- ^ The patch values } deriving Show instance {-# OVERLAPPING #-} Transformable (CoonPatch px) where transformM = transformCoonM - transform = transformCoon + transform = transformCoon instance {-# OVERLAPPING #-} PointFoldable (CoonPatch px) where foldPoints f acc (CoonPatch n e s w _) = g n . g e . g s $ g w acc @@ -235,12 +235,12 @@ transformCoon f (CoonPatch n e s w v) = -- patches but with shared edges data MeshPatch px = MeshPatch { -- | Count of horizontal of *patch* - _meshPatchWidth :: !Int + _meshPatchWidth :: !Int -- | Count of vertical of *patch* - , _meshPatchHeight :: !Int + , _meshPatchHeight :: !Int -- | Main points defining the patch, of size -- (_meshPatchWidth + 1) * (_meshPatchHeight + 1) - , _meshPrimaryVertices :: !(V.Vector Point) + , _meshPrimaryVertices :: !(V.Vector Point) -- | For each line, store the points in between each -- vertex. There is two points between each vertex, so -- _meshPatchWidth * (_meshPatchHeight + 1) points @@ -248,18 +248,18 @@ data MeshPatch px = MeshPatch -- | For each colun, store the points in between each -- vertex. Two points between each vertex, so -- _meshPatchHeight * (_meshPatchWidth + 1) - , _meshVerticalSecondary :: !(V.Vector InterBezier) + , _meshVerticalSecondary :: !(V.Vector InterBezier) -- | Colors for each vertex points - , _meshColors :: !(V.Vector px) + , _meshColors :: !(V.Vector px) -- | Points used to define tensor patch, if not define, -- the rest of the data structure describes a Coon patch. -- size must be equal to `_meshPatchWidth*_meshPatchHeight` - , _meshTensorDerivatives :: !(Maybe (V.Vector Derivatives)) + , _meshTensorDerivatives :: !(Maybe (V.Vector Derivatives)) } deriving (Eq, Show, Functor) -- | Store the two bezier control points of a bezier. -data InterBezier = InterBezier +data InterBezier = InterBezier { _inter0 :: !Point , _inter1 :: !Point } @@ -278,10 +278,10 @@ transformMeshM f MeshPatch { .. } = do hSecondary <- mapM (transformM f) _meshHorizontalSecondary vSecondary <- mapM (transformM f) _meshVerticalSecondary return $ MeshPatch - { _meshPatchWidth = _meshPatchWidth + { _meshPatchWidth = _meshPatchWidth , _meshPatchHeight = _meshPatchHeight - , _meshPrimaryVertices = vertices - , _meshHorizontalSecondary = hSecondary + , _meshPrimaryVertices = vertices + , _meshHorizontalSecondary = hSecondary , _meshVerticalSecondary = vSecondary , _meshColors = _meshColors , _meshTensorDerivatives = Nothing @@ -300,7 +300,7 @@ foldMeshPoints f acc m = acc4 where acc3 = foldPoints f acc2 (_meshVerticalSecondary m) acc4 = case _meshTensorDerivatives m of Nothing -> acc3 - Just v -> foldPoints f acc3 v + Just v -> foldPoints f acc3 v -- | Store the inner points of a tensor patch. data Derivatives = Derivatives @@ -335,7 +335,7 @@ newtype CubicCoefficient px = CubicCoefficient -- | Type storing the information to be able to interpolate -- part of an image in a patch. data ImageMesh px = ImageMesh - { _meshImage :: !(Image px) + { _meshImage :: !(Image px) , _meshTransform :: !Transformation } @@ -344,7 +344,7 @@ data ImageMesh px = ImageMesh -- D1: left _west -- D2: right _east --- | Return a postion of a point in the coon patch. +-- | Return a postion of a point in the Coons patch. coonPointAt :: CoonPatch a -> UV -> Point coonPointAt CoonPatch { .. } (V2 u v) = sc ^+^ sd ^-^ sb where @@ -362,7 +362,7 @@ coonPointAt CoonPatch { .. } (V2 u v) = sc ^+^ sd ^-^ sb CubicBezier _ _ _ d2 = fst $ cubicBezierBreakAt _east v CubicBezier _ _ _ d1 = fst $ cubicBezierBreakAt _west (1 - v) --- | Convert a coon patch in +-- | Convert a Coons patch to a TensorPatch toTensorPatch :: CoonPatch a -> TensorPatch a toTensorPatch CoonPatch { .. } = TensorPatch { _curve0 = _north diff --git a/src/Graphics/Rasterific/PathWalker.hs b/src/Graphics/Rasterific/PathWalker.hs index 0812521..9f71bc8 100644 --- a/src/Graphics/Rasterific/PathWalker.hs +++ b/src/Graphics/Rasterific/PathWalker.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} --- | This module help the walking of path of any shape, +-- | This module allows us to walk along paths of any shape, -- being able to return the current position and the -- actual orientation. module Graphics.Rasterific.PathWalker( PathWalkerT @@ -12,23 +12,20 @@ module Graphics.Rasterific.PathWalker( PathWalkerT , drawOrdersOnPath ) where -import Data.Monoid( (<>) ) +import Data.Monoid ((<>)) -import Control.Monad.Identity( Identity ) -import Control.Monad.State( StateT - , MonadTrans - , lift - , evalStateT - , modify - , gets ) -import Data.Maybe( fromMaybe ) +import Control.Monad.Identity (Identity) +import Control.Monad.State (MonadTrans, StateT, + evalStateT, gets, lift, + modify) +import Data.Maybe (fromMaybe) -import Graphics.Rasterific.Types -import Graphics.Rasterific.Linear -import Graphics.Rasterific.Transformations -import Graphics.Rasterific.StrokeInternal -import Graphics.Rasterific.PlaneBoundable -import Graphics.Rasterific.Immediate +import Graphics.Rasterific.Immediate +import Graphics.Rasterific.Linear +import Graphics.Rasterific.PlaneBoundable +import Graphics.Rasterific.StrokeInternal +import Graphics.Rasterific.Transformations +import Graphics.Rasterific.Types -- | The walking transformer monad. newtype PathWalkerT m a = PathWalkerT (StateT WalkerState m a) @@ -40,7 +37,7 @@ type PathWalker a = PathWalkerT Identity a -- | State of the path walker, just a bunch of primitives -- with continuity guarantee. The continuity is guaranteed --- by the Path used to derive this primitives. +-- by the Path used to derive these primitives. data WalkerState = WalkerState { _walkerPrims :: ![Primitive] } @@ -66,18 +63,18 @@ advanceBy by = PathWalkerT . modify $ \s -> currentPosition :: (Monad m) => PathWalkerT m (Maybe Point) currentPosition = PathWalkerT $ gets (currPos . _walkerPrims) where - currPos [] = Nothing + currPos [] = Nothing currPos (prim:_) = Just $ firstPointOf prim --- | Obtain the current tangeant of the path if we're still +-- | Obtain the current tangent of the path if we're still -- on it. Return Nothing otherwise. currentTangeant :: (Monad m) => PathWalkerT m (Maybe Vector) currentTangeant = PathWalkerT $ gets (currTangeant . _walkerPrims) where - currTangeant [] = Nothing + currTangeant [] = Nothing currTangeant (prim:_) = Just . normalize $ firstTangeantOf prim --- | Callback function in charge to transform the DrawOrder +-- | Callback function in charge of transforming the DrawOrder -- given the transformation to place it on the path. type PathDrawer m px = Transformation -> PlaneBound -> DrawOrder px -> m () diff --git a/src/Graphics/Rasterific/PlaneBoundable.hs b/src/Graphics/Rasterific/PlaneBoundable.hs index 1cf2507..aecadde 100644 --- a/src/Graphics/Rasterific/PlaneBoundable.hs +++ b/src/Graphics/Rasterific/PlaneBoundable.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE FlexibleInstances #-} -- | Module implementing types used for geometry -- bound calculations. module Graphics.Rasterific.PlaneBoundable ( PlaneBound( .. ) @@ -9,21 +9,21 @@ module Graphics.Rasterific.PlaneBoundable ( PlaneBound( .. ) , boundLowerLeftCorner ) where -import Data.Monoid( (<>) ) +import Data.Monoid ((<>)) -import Graphics.Rasterific.Linear( V2( .. ) ) -import Graphics.Rasterific.Types -import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.Linear (V2 (..)) +import Graphics.Rasterific.Types -- | 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. +-- fit to a bezier curve and not use their +-- control points directly. data PlaneBound = PlaneBound - { -- | Corner upper left of the bounding box of + { -- | Upper left corner of the bounding box of -- the considered primitives. _planeMinBound :: !Point - -- | Corner lower right of the bounding box of + -- | Lower right corner of the bounding box of -- the considered primitives. , _planeMaxBound :: !Point } @@ -53,10 +53,10 @@ instance Monoid PlaneBound where (max <$> maxi1 <*> maxi2) -- | Class used to calculate bounds of various geometrical --- primitives. The calculated is precise, the bounding should --- be minimal with respect with drawn curve. +-- primitives. The calculation is precise, the bounding should +-- be minimal with respect to the drawn curve. class PlaneBoundable a where - -- | Given a graphical elements, calculate it's bounds. + -- | Given a graphical element, calculate its bounds. planeBounds :: a -> PlaneBound instance PlaneBoundable Point where @@ -73,7 +73,7 @@ instance PlaneBoundable CubicBezier where planeBounds = foldMap planeBounds . cubicBezierBounds instance PlaneBoundable Primitive where - planeBounds (LinePrim l) = planeBounds l - planeBounds (BezierPrim b) = planeBounds b + planeBounds (LinePrim l) = planeBounds l + planeBounds (BezierPrim b) = planeBounds b planeBounds (CubicBezierPrim c) = planeBounds c diff --git a/src/Graphics/Rasterific/QuadraticBezier.hs b/src/Graphics/Rasterific/QuadraticBezier.hs index 3d80472..bbf19c7 100644 --- a/src/Graphics/Rasterific/QuadraticBezier.hs +++ b/src/Graphics/Rasterific/QuadraticBezier.hs @@ -2,7 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE BangPatterns #-} -- | Module handling math regarding the handling of quadratic --- and cubic bezier curve. +-- and cubic bezier curves. module Graphics.Rasterific.QuadraticBezier ( -- * Helper functions straightLine @@ -31,7 +31,7 @@ import Data.Monoid( (<>) ) import Graphics.Rasterific.Operators import Graphics.Rasterific.Types --- | Create a list of bezier patch from a list of points, +-- | Create a list of bezier patches 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] @@ -47,7 +47,7 @@ isBezierPoint (Bezier a b c) = not $ a `isDistingableFrom` b || b `isDistingableFrom` c --- | Only work if the quadratic bezier curve +-- | Only works if the quadratic bezier curve -- is nearly flat bezierLengthApproximation :: Bezier -> Float bezierLengthApproximation (Bezier a _ c) = @@ -116,10 +116,10 @@ clipBezier mini maxi bezier@(Bezier a b c) -- If we are in the range bound, return the curve -- unaltered | insideX && insideY = pure $ BezierPrim bezier - -- If one of the component is outside, clamp + -- If one of the components is outside, clamp -- the components on the boundaries and output a -- straight line on this boundary. Useful for the - -- filing case, to clamp the polygon drawing on + -- filling case, to clamp the polygon drawing on -- the edge | outsideX || outsideY = pure . BezierPrim $ clampedA `straightLine` clampedC @@ -159,9 +159,9 @@ clipBezier mini maxi bezier@(Bezier a b c) -- | | -- +-------------+ -- maxi - -- the edgeSeparator vector encode which edge - -- is te nearest to the midpoint. - -- if True then it's the 'min' edges which are + -- the edgeSeparator vector encodes which edge + -- is the nearest to the midpoint. + -- if True then it's the 'min' edge that is -- the nearest, otherwise it's the maximum edge edgeSeparator = vabs (abbc ^-^ mini) ^<^ vabs (abbc ^-^ maxi) @@ -178,23 +178,23 @@ clipBezier mini maxi bezier@(Bezier a b c) -- | Rewrite the bezier curve to avoid degenerate cases. sanitizeBezier :: Bezier -> Container Primitive sanitizeBezier bezier@(Bezier a b c) - -- If the two normals vector are far apart (cos nearly -1) + -- If the two normal vectors are far apart (cos is nearly -1) -- -- u v -- <---------- ------------> -- because u dot v = ||u|| * ||v|| * cos(uv) -- - -- This imply that AB and BC are nearly parallel + -- This implies that AB and BC are nearly parallel | u `dot` v < -0.9999 = -- divide in to halves with sanitizeBezier (Bezier a (a `midPoint` abbc) abbc) <> sanitizeBezier (Bezier abbc (abbc `midPoint` c) c) - -- b is far enough of b and c, (it's not a point) + -- b is far enough from b and c, (it's not a point) | a `isDistingableFrom` b && b `isDistingableFrom` c = pure . BezierPrim $ bezier - -- if b is to nearby a or c, take the midpoint as new reference. + -- if b is too close to a or c, take the midpoint as the new reference. | ac `isDistingableFrom` b = sanitizeBezier (Bezier a ac c) | otherwise = mempty where u = a `normal` b diff --git a/src/Graphics/Rasterific/QuadraticFormula.hs b/src/Graphics/Rasterific/QuadraticFormula.hs index 9014c2a..595ab45 100644 --- a/src/Graphics/Rasterific/QuadraticFormula.hs +++ b/src/Graphics/Rasterific/QuadraticFormula.hs @@ -25,9 +25,9 @@ instance Applicative QuadraticFormula where -- | Discriminant equation, if the result is: -- --- * Below 0, then the formula doesn't have any solution +-- * Below 0, then the formula doesn't have any solutions -- --- * Equal to 0, then the formula has an unique root. +-- * Equal to 0, then the formula has a unique root. -- -- * Above 0, the formula has two solutions -- diff --git a/src/Graphics/Rasterific/Rasterize.hs b/src/Graphics/Rasterific/Rasterize.hs index 07504fd..7220967 100644 --- a/src/Graphics/Rasterific/Rasterize.hs +++ b/src/Graphics/Rasterific/Rasterize.hs @@ -6,15 +6,15 @@ module Graphics.Rasterific.Rasterize , clip ) where -import Control.Monad.ST( runST ) -import Data.Fixed( mod' ) -import Data.Monoid( Endo( Endo, appEndo ) ) -import Graphics.Rasterific.Types -import Graphics.Rasterific.QuadraticBezier -import Graphics.Rasterific.CubicBezier -import Graphics.Rasterific.Line -import qualified Data.Vector as V -import qualified Data.Vector.Algorithms.Intro as VS +import Control.Monad.ST (runST) +import Data.Fixed (mod') +import Data.Monoid (Endo (Endo, appEndo)) +import qualified Data.Vector as V +import qualified Data.Vector.Algorithms.Intro as VS +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.Line +import Graphics.Rasterific.QuadraticBezier +import Graphics.Rasterific.Types data CoverageSpan = CoverageSpan { _coverageX :: {-# UNPACK #-} !Float @@ -45,12 +45,12 @@ combineEdgeSamples prepareCoverage vec = go 0 0 0 0 0 p2 = CoverageSpan (x + 1) y (prepareCoverage h) (x' - x - 1) -- | Clip the geometry to a rectangle. -clip :: Point -- ^ Minimum point (corner upper left) - -> Point -- ^ Maximum point (corner bottom right) +clip :: Point -- ^ Minimum point (upper left corner) + -> Point -- ^ Maximum point (bottom right corner) -> Primitive -- ^ Primitive to be clipped -> Container Primitive -clip mini maxi (LinePrim l) = clipLine mini maxi l -clip mini maxi (BezierPrim b) = clipBezier mini maxi b +clip mini maxi (LinePrim l) = clipLine mini maxi l +clip mini maxi (BezierPrim b) = clipBezier mini maxi b clip mini maxi (CubicBezierPrim c) = clipCubicBezier mini maxi c decompose :: Primitive -> Producer EdgeSample @@ -66,7 +66,7 @@ xyCompare !(EdgeSample { _sampleY = ay, _sampleX = ax }) !(EdgeSample { _sampleY = by, _sampleX = bx }) = case compare ay by of EQ -> compare ax bx - c -> c + c -> c sortEdgeSamples :: [EdgeSample] -> V.Vector EdgeSample sortEdgeSamples samples = runST $ do @@ -77,9 +77,9 @@ sortEdgeSamples samples = runST $ do V.unsafeFreeze mutableVector rasterize :: FillMethod -> Container Primitive -> [CoverageSpan] -rasterize method = +rasterize method = case method of - FillWinding -> combineEdgeSamples combineWinding + FillWinding -> combineEdgeSamples combineWinding . sortEdgeSamples . (($ []) . appEndo) . foldMap (Endo . decompose) diff --git a/src/Graphics/Rasterific/Shading.hs b/src/Graphics/Rasterific/Shading.hs index 6912e64..d891b55 100644 --- a/src/Graphics/Rasterific/Shading.hs +++ b/src/Graphics/Rasterific/Shading.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} module Graphics.Rasterific.Shading ( transformTextureToFiller , sampledImageShader @@ -10,46 +10,35 @@ module Graphics.Rasterific.Shading , unsafePlotOpaquePixel ) where -import Control.Monad.ST( ST ) -import Control.Monad.Primitive( PrimState - -- one day (GHC >= 7.10 ?) - , PrimMonad - ) -import Data.Fixed( mod' ) -import Data.Monoid( (<>) ) -import Graphics.Rasterific.Command -import Graphics.Rasterific.BiSampleable -import Graphics.Rasterific.Linear - ( V2( .. ) - , (^-^) - , (^/) - , dot - , norm - ) - -import qualified Data.Vector as V - -import Codec.Picture.Types( Pixel( .. ) - , Image( .. ) - , MutableImage( .. ) - , Pixel8 - , PixelRGBA8 - , unsafeWritePixelBetweenAt - , readPackedPixelAt - , writePackedPixelAt - ) - -import Graphics.Rasterific.Types( Point - , Vector - , Line( .. ) - , SamplerRepeat( .. ) ) -import Graphics.Rasterific.Transformations -import Graphics.Rasterific.Rasterize -import Graphics.Rasterific.PatchTypes -import Graphics.Rasterific.Compositor( Modulable( .. ) - , ModulablePixel - , RenderablePixel - , compositionAlpha ) +import Control.Monad.Primitive (PrimMonad, PrimState) +import Control.Monad.ST (ST) +import Data.Fixed (mod') +import Data.Monoid ((<>)) +import Graphics.Rasterific.BiSampleable +import Graphics.Rasterific.Command +import Graphics.Rasterific.Linear (V2 (..), dot, norm, (^-^), + (^/)) + +import qualified Data.Vector as V + +import Codec.Picture.Types (Image (..), + MutableImage (..), + Pixel (..), Pixel8, + PixelRGBA8, + readPackedPixelAt, + unsafeWritePixelBetweenAt, + writePackedPixelAt) + +import Graphics.Rasterific.Compositor (Modulable (..), + ModulablePixel, + RenderablePixel, + compositionAlpha) +import Graphics.Rasterific.PatchTypes +import Graphics.Rasterific.Rasterize +import Graphics.Rasterific.Transformations +import Graphics.Rasterific.Types (Line (..), Point, + SamplerRepeat (..), + Vector) data TextureSpaceInfo = TextureSpaceInfo @@ -111,13 +100,13 @@ plotOpaquePixel :: forall m px. (ModulablePixel px, PrimMonad m) -> m () {-# INLINE plotOpaquePixel #-} plotOpaquePixel img _color x y - | x < 0 || y < 0 || + | x < 0 || y < 0 || x >= mutableImageWidth img || y >= mutableImageHeight img = return () plotOpaquePixel img color x y = do let !idx = (y * mutableImageWidth img + x) * (componentCount (undefined :: px)) writePackedPixelAt img idx color --- | Plot a single pixel on the resulting image, no bounds check are +-- | Plot a single pixel on the resulting image, no bounds check is -- performed, ensure index is correct! unsafePlotOpaquePixel :: forall m px. (ModulablePixel px, PrimMonad m) => MutableImage (PrimState m) px -> px -> Int -> Int @@ -185,7 +174,7 @@ prepareInfo (Just t) img covSpan = TextureSpaceInfo combineTransform :: Maybe Transformation -> Transformation -> Maybe Transformation -combineTransform Nothing a = Just a +combineTransform Nothing a = Just a combineTransform (Just v) a = Just $ v <> a withTrans :: Maybe Transformation -> ShaderFunction px @@ -195,8 +184,8 @@ withTrans (Just v) shader = \x y -> let V2 x' y' = applyTransformation v (V2 x y) in shader x' y' --- | The intent of shader texture is to provide ease of implementation --- If possible providing a custom filler will be more efficient, +-- | The intent of shader textures is to provide ease of implementation. +-- If possible, providing a custom filler will be more efficient, -- like already done for the solid colors. shaderOfTexture :: forall px . RenderablePixel px => Maybe Transformation -> SamplerRepeat -> Texture px @@ -213,7 +202,7 @@ shaderOfTexture trans sampling (LinearGradientTexture grad (Line a b)) = withTrans trans $ linearGradientShader grad a b sampling shaderOfTexture trans sampling (RadialGradientTexture grad center radius) = withTrans trans $ radialGradientShader grad center radius sampling -shaderOfTexture trans sampling (RadialGradientWithFocusTexture grad center +shaderOfTexture trans sampling (RadialGradientWithFocusTexture grad center radius focus) = withTrans trans $ radialGradientWithFocusShader grad center radius focus @@ -262,7 +251,7 @@ transformTextureToFiller renderMesh = go Nothing SamplerPad m in go Nothing sampling (RawTexture newImg) img - + go trans sampling tex = \img -> shaderFiller shader img . prepareInfo trans img where shader = shaderOfTexture Nothing sampling tex @@ -275,7 +264,7 @@ repeatGradient s = s - fromIntegral (floor s :: Int) reflectGradient :: Float -> Float reflectGradient s = abs (abs (s - 1) `mod'` 2 - 1) - + gradientColorAt :: ModulablePixel px => GradientArray px -> Float -> px {-# SPECIALIZE @@ -355,11 +344,11 @@ radialGradientShader :: ModulablePixel px -> Float -- ^ Radial gradient radius -> SamplerRepeat -> ShaderFunction px -{-# SPECIALIZE +{-# SPECIALIZE radialGradientShader :: Gradient PixelRGBA8 -> Point -> Float -> SamplerRepeat -> ShaderFunction PixelRGBA8 #-} -{-# SPECIALIZE +{-# SPECIALIZE radialGradientShader :: Gradient Pixel8 -> Point -> Float -> SamplerRepeat -> ShaderFunction Pixel8 #-} diff --git a/src/Graphics/Rasterific/StrokeInternal.hs b/src/Graphics/Rasterific/StrokeInternal.hs index 1c998df..3f8c67e 100644 --- a/src/Graphics/Rasterific/StrokeInternal.hs +++ b/src/Graphics/Rasterific/StrokeInternal.hs @@ -8,30 +8,25 @@ module Graphics.Rasterific.StrokeInternal , isPrimitivePoint ) where -import Data.Monoid( (<>) ) - -import Graphics.Rasterific.Linear - ( V2( .. ) - , (^-^) - , (^+^) - , (^*) - , dot - ) - -import Graphics.Rasterific.Operators -import Graphics.Rasterific.Types -import Graphics.Rasterific.QuadraticBezier -import Graphics.Rasterific.CubicBezier -import Graphics.Rasterific.Line +import Data.Monoid ((<>)) + +import Graphics.Rasterific.Linear (V2 (..), dot, (^*), (^+^), + (^-^)) + +import Graphics.Rasterific.CubicBezier +import Graphics.Rasterific.Line +import Graphics.Rasterific.Operators +import Graphics.Rasterific.QuadraticBezier +import Graphics.Rasterific.Types lastPoint :: Primitive -> Point -lastPoint (LinePrim (Line _ x1)) = x1 -lastPoint (BezierPrim (Bezier _ _ x2)) = x2 +lastPoint (LinePrim (Line _ x1)) = x1 +lastPoint (BezierPrim (Bezier _ _ x2)) = x2 lastPoint (CubicBezierPrim (CubicBezier _ _ _ x3)) = x3 lastPointAndNormal :: Primitive -> (Point, Vector) -lastPointAndNormal (LinePrim (Line a b)) = (b, a `normal` b) -lastPointAndNormal (BezierPrim (Bezier _ b c)) = (c, b `normal` c) +lastPointAndNormal (LinePrim (Line a b)) = (b, a `normal` b) +lastPointAndNormal (BezierPrim (Bezier _ b c)) = (c, b `normal` c) lastPointAndNormal (CubicBezierPrim (CubicBezier _ _ c d)) = (d, c `normal` d) firstPointAndNormal :: Primitive -> (Point, Vector) @@ -41,8 +36,8 @@ firstPointAndNormal (CubicBezierPrim (CubicBezier a b _ _)) = (a, a `normal` b) isPrimitivePoint :: Primitive -> Bool isPrimitivePoint p = case p of - LinePrim l -> isLinePoint l - BezierPrim b -> isBezierPoint b + LinePrim l -> isLinePoint l + BezierPrim b -> isBezierPoint b CubicBezierPrim c -> isCubicBezierPoint c reversePrimitive :: Primitive -> Primitive @@ -153,14 +148,14 @@ joinPrimitives :: StrokeWidth -> Join -> Primitive -> Primitive -> Container Primitive joinPrimitives offset join prim1 prim2 = case join of - JoinRound -> roundJoin offset p u v + JoinRound -> roundJoin offset p u v JoinMiter l -> miterJoin offset l p u v where (p, u) = lastPointAndNormal prim1 (_, v) = firstPointAndNormal prim2 offsetPrimitives :: Float -> Primitive -> Container Primitive -offsetPrimitives offset (LinePrim l) = offsetLine offset l -offsetPrimitives offset (BezierPrim b) = offsetBezier offset b +offsetPrimitives offset (LinePrim l) = offsetLine offset l +offsetPrimitives offset (BezierPrim b) = offsetBezier offset b offsetPrimitives offset (CubicBezierPrim c) = offsetCubicBezier offset c offsetAndJoin :: Float -> Join -> Cap -> [Primitive] @@ -178,30 +173,30 @@ offsetAndJoin offset join caping (firstShape:rest) = go firstShape rest offseter prev <> joiner prev x <> go x xs approximateLength :: Primitive -> Float -approximateLength (LinePrim l) = lineLength l -approximateLength (BezierPrim b) = bezierLengthApproximation b +approximateLength (LinePrim l) = lineLength l +approximateLength (BezierPrim b) = bezierLengthApproximation b approximateLength (CubicBezierPrim c) = cubicBezierLengthApproximation c sanitize :: Primitive -> Container Primitive -sanitize (LinePrim l) = sanitizeLine l -sanitize (BezierPrim b) = sanitizeBezier b +sanitize (LinePrim l) = sanitizeLine l +sanitize (BezierPrim b) = sanitizeBezier b sanitize (CubicBezierPrim c) = sanitizeCubicBezier c strokize :: Geometry geom => StrokeWidth -> Join -> (Cap, Cap) -> geom -> Container Primitive strokize width join (capStart, capEnd) geom = foldMap pathOffseter sanitized - where + where sanitized = foldMap (listOfContainer . sanitize) <$> resplit (toPrimitives geom) offseter = offsetAndJoin (width / 2) join pathOffseter v = offseter capEnd v <> offseter capStart (reverse $ reversePrimitive <$> v) flattenPrimitive :: Primitive -> Container Primitive -flattenPrimitive (BezierPrim bezier) = flattenBezier bezier +flattenPrimitive (BezierPrim bezier) = flattenBezier bezier flattenPrimitive (CubicBezierPrim bezier) = flattenCubicBezier bezier -flattenPrimitive (LinePrim line) = flattenLine line +flattenPrimitive (LinePrim line) = flattenLine line breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive) breakPrimitiveAt (BezierPrim bezier) at = (BezierPrim a, BezierPrim b) @@ -240,14 +235,14 @@ dropPattern = go | offset < x = x - offset : xs | otherwise {- offset >= x -} = go (offset - x) xs --- | Don't make them completly flat, but suficiently +-- | Don't make them completly flat, but sufficiently -- to assume they are. linearizePrimitives :: [Primitive] -> [Primitive] linearizePrimitives = listOfContainer . foldMap flattenPrimitive . foldMap sanitize -- | Return an approximation of the length of a given path. --- It's results is not precise but should be enough for +-- Its result is not precise but should be enough for -- rough calculations approximatePathLength :: Path -> Float approximatePathLength = approximatePrimitivesLength . pathToPrimitives @@ -257,7 +252,7 @@ approximatePrimitivesLength prims = sum $ approximateLength <$> linearizePrimitives prims dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]] -dashize offset pattern = taker infinitePattern . linearizePrimitives +dashize offset pattern = taker infinitePattern . linearizePrimitives where realOffset | offset >= 0 = offset | otherwise = offset + sum pattern diff --git a/src/Graphics/Rasterific/Texture.hs b/src/Graphics/Rasterific/Texture.hs index 431d5a7..c76f940 100644 --- a/src/Graphics/Rasterific/Texture.hs +++ b/src/Graphics/Rasterific/Texture.hs @@ -1,13 +1,13 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeFamilies #-} --- | Module describing the various filling method of the +-- | Module describing the various filling methods of the -- geometric primitives. -- --- All points coordinate given in this module are expressed --- final image pixel coordinates. +-- All coordinates given in this module are expressed +-- set final image pixel coordinates. module Graphics.Rasterific.Texture ( Texture , Gradient @@ -23,16 +23,16 @@ module Graphics.Rasterific.Texture -- * Texture manipulation , modulateTexture - , transformTexture + , transformTexture ) where -import Codec.Picture.Types( Pixel( .. ), Image( .. ) ) -import Graphics.Text.TrueType( Dpi ) -import Graphics.Rasterific -import Graphics.Rasterific.MeshPatch -import Graphics.Rasterific.Command -import Graphics.Rasterific.Transformations +import Codec.Picture.Types (Image (..), Pixel (..)) +import Graphics.Rasterific +import Graphics.Rasterific.Command +import Graphics.Rasterific.MeshPatch +import Graphics.Rasterific.Transformations +import Graphics.Text.TrueType (Dpi) -- | Set the repeat pattern of the texture (if any). -- With padding: @@ -61,11 +61,11 @@ import Graphics.Rasterific.Transformations withSampler :: SamplerRepeat -> Texture px -> Texture px withSampler = WithSampler --- | Transform the coordinates used for texture before applying --- it, allow interesting transformations. +-- | Transform the coordinates used for the texture before applying +-- it, allowing interesting transformations. -- -- > withTexture (withSampler SamplerRepeat $ --- > transformTexture (rotateCenter 1 (V2 0 0) <> +-- > transformTexture (rotateCenter 1 (V2 0 0) <> -- > scale 0.5 0.25) -- > $ sampledImageTexture textureImage) $ -- > fill $ rectangle (V2 0 0) 200 200 @@ -76,7 +76,7 @@ transformTexture :: Transformation -> Texture px -> Texture px transformTexture = WithTextureTransform -- | The uniform texture is the simplest texture of all: --- an uniform color. +-- a uniform color. uniformTexture :: px -- ^ The color used for all the texture. -> Texture px uniformTexture = SolidTexture @@ -105,7 +105,7 @@ linearGradientTexture gradient start end = LinearGradientTexture gradient (Line start end) -- | Use another image as a texture for the filling. --- Contrary to `imageTexture`, this function perform a bilinear +-- Contrary to `imageTexture`, this function performs a bilinear -- filtering on the texture. -- sampledImageTexture :: Image px -> Texture px diff --git a/src/Graphics/Rasterific/Transformations.hs b/src/Graphics/Rasterific/Transformations.hs index 5ad6d01..0cb0698 100644 --- a/src/Graphics/Rasterific/Transformations.hs +++ b/src/Graphics/Rasterific/Transformations.hs @@ -1,9 +1,9 @@ --- | This module provide some helpers in order +-- | This module provides some helpers in order -- to perform basic geometric transformation on -- the drawable primitives. -- --- You can combine the transformation is `mappend` or --- the `(\<\>)` operator from "Data.Monoid" . +-- You can combine the transformations with `mappend` or +-- the `(\<\>)` operator from "Data.Monoid". module Graphics.Rasterific.Transformations ( Transformation( .. ) , applyTransformation @@ -18,9 +18,9 @@ module Graphics.Rasterific.Transformations , inverseTransformation ) where -import Data.Monoid( (<>) ) -import Graphics.Rasterific.Types -import Graphics.Rasterific.Linear( V2( .. ), normalize ) +import Data.Monoid ((<>)) +import Graphics.Rasterific.Linear (V2 (..), normalize) +import Graphics.Rasterific.Types -- | Represent a 3*3 matrix for homogenous coordinates. -- @@ -46,12 +46,12 @@ transformCombine (Transformation a c e (Transformation a' c' e' b' d' f') = Transformation (a * a' + c * b' {- below b' is zero -}) - (a * c' + c * d' {- below d' is zero -}) - (a * e' + c * f' + e {- below f' is one -}) + (a * c' + c * d' {- below d' is zero -}) + (a * e' + c * f' + e {- below f' is one -}) - (b * a' + d * b' {- below b' is zero -}) - (b * c' + d * d' {- below d' is zero -}) - (b * e' + d * f' + f {- below f' is one -}) + (b * a' + d * b' {- below b' is zero -}) + (b * c' + d * d' {- below d' is zero -}) + (b * e' + d * f' + f {- below f' is one -}) instance Monoid Transformation where mappend = transformCombine @@ -89,7 +89,7 @@ rotate angle = Transformation ca (-sa) 0 sa = sin angle -- | Create a transformation representing a rotation --- on the plane. The rotation center is given in parameter +-- on the plane, around a given point. -- -- > fill . transform (applyTransformation $ rotateCenter 0.2 (V2 200 200)) -- > $ rectangle (V2 40 40) 120 120 @@ -167,7 +167,7 @@ transformationDeterminant :: Transformation -> Float transformationDeterminant (Transformation a c _e b d _f) = a * d - c * b --- | Inverse a transformation (if possible) +-- | Invert a transformation (if possible) inverseTransformation :: Transformation -> Maybe Transformation inverseTransformation trans | transformationDeterminant trans == 0 = Nothing diff --git a/src/Graphics/Rasterific/Types.hs b/src/Graphics/Rasterific/Types.hs index 186cdb1..0466bff 100644 --- a/src/Graphics/Rasterific/Types.hs +++ b/src/Graphics/Rasterific/Types.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} -- | Gather all the types used in the rasterization engine. module Graphics.Rasterific.Types ( -- * Geometry description @@ -48,20 +48,15 @@ module Graphics.Rasterific.Types , Proxy( Proxy ) ) where -import Data.DList( DList, fromList ) - -import Control.Monad.Identity( runIdentity ) -import Data.Foldable( foldl', toList ) -import qualified Data.Foldable as F -import Graphics.Rasterific.Linear( V2( .. ), (^-^), nearZero ) -import Graphics.Rasterific.Operators -import Foreign.Ptr( castPtr ) -import Foreign.Storable( Storable( sizeOf - , alignment - , peek - , poke - , peekElemOff - , pokeElemOff ) ) +import Data.DList (DList, fromList) + +import Control.Monad.Identity (runIdentity) +import Data.Foldable (foldl', toList) +import qualified Data.Foldable as F +import Foreign.Ptr (castPtr) +import Foreign.Storable (Storable (alignment, peek, peekElemOff, poke, pokeElemOff, sizeOf)) +import Graphics.Rasterific.Linear (V2 (..), nearZero, (^-^)) +import Graphics.Rasterific.Operators -- | Represent a vector type Vector = V2 Float @@ -75,10 +70,10 @@ type DashPattern = [Float] data Proxy p = Proxy --- | Describe how we will "finish" the stroking +-- | Describe how we will "finish" strokes -- that don't loop. data Cap - -- | Create a straight caping on the stroke. + -- | Create a straight capping on the stroke. -- Cap value should be positive and represent -- the distance from the end of curve to the actual cap -- @@ -88,18 +83,18 @@ data Cap -- = CapStraight Float - -- | Create a rounded caping on the stroke. + -- | Create a rounded capping on the stroke. -- <> | CapRound deriving (Eq, Show) --- | Describe how to display the join of broken lines --- while stroking. +-- | Describe how to display the joint of broken lines +-- in a series of strokes. data Join -- | Make a curved join. -- <> = JoinRound - -- | Make a mitter join. Value must be positive or null. + -- | Make a mitter join. Value must not be negative. -- Seems to make sense in [0;1] only -- -- * Miter join with 0 : <> @@ -109,7 +104,7 @@ data Join | JoinMiter Float deriving (Eq, Show) --- | Tell how to fill complex shapes when there is self +-- | Tell how to fill complex shapes when there are self -- intersections. If the filling mode is not specified, -- then it's the `FillWinding` method which is used. -- @@ -137,7 +132,7 @@ data Join -- > ] data FillMethod -- | Also known as nonzero rule. - -- To determine if a point falls inside the curve, you draw + -- 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 @@ -146,7 +141,7 @@ data FillMethod -- <> = FillWinding - -- | This rule determines the insideness of a point on + -- | 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 @@ -166,7 +161,7 @@ data SamplerRepeat -- | Will loop on it's definition domain -- <> | SamplerRepeat - -- | Will loop inverting axises + -- | Will loop inverting axes -- <> | SamplerReflect deriving (Eq, Enum, Show) @@ -193,7 +188,7 @@ instance Storable EdgeSample where sa <- peekElemOff q 2 sh <- peekElemOff q 3 return $ EdgeSample sx sy sa sh - + {-# INLINE poke #-} poke ptr (EdgeSample sx sy sa sh) = do let q = castPtr ptr @@ -260,8 +255,7 @@ instance PointFoldable Line where {-# INLINE foldPoints #-} foldPoints f acc (Line a b) = f (f acc b) a --- | Describe a quadratic bezier spline, described --- using 3 points. +-- | Describe a quadratic bezier spline, using 3 points. -- -- > fill [Bezier (V2 10 10) (V2 200 50) (V2 200 100) -- > ,Bezier (V2 200 100) (V2 150 200) (V2 120 175) @@ -272,7 +266,7 @@ instance PointFoldable Line where data Bezier = Bezier { -- | Origin points, the spline will pass through it. _bezierX0 :: {-# UNPACK #-} !Point - -- | Control point, the spline won't pass on it. + -- | Control point, the spline won't pass through it. , _bezierX1 :: {-# UNPACK #-} !Point -- | End point, the spline will pass through it. , _bezierX2 :: {-# UNPACK #-} !Point @@ -296,8 +290,7 @@ instance PointFoldable Bezier where foldPoints f acc (Bezier a b c) = foldl' f acc [a, b, c] --- | Describe a cubic bezier spline, described --- using 4 points. +-- | Describe a cubic bezier spline, using 4 points. -- -- > stroke 4 JoinRound (CapRound, CapRound) $ -- > CubicBezier (V2 0 10) (V2 205 250) (V2 (-10) 250) (V2 160 35) @@ -335,7 +328,7 @@ instance PointFoldable CubicBezier where foldPoints f acc (CubicBezier a b c d) = foldl' f acc [a, b, c, d] --- | This datatype gather all the renderable primitives, +-- | This datatype gathers 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 : @@ -370,11 +363,11 @@ instance Primitivable Bezier where toPrim = BezierPrim -- | @toPrim = CubicBezierPrim@ instance Primitivable CubicBezier where toPrim = CubicBezierPrim --- | All the rasterization works on lists of primitives, --- in order to ease the use of the library, the Geometry +-- | 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. +-- the Primitive constructor. -- -- Also streamline the Path conversion. class Geometry a where @@ -419,19 +412,19 @@ instance (Foldable f, Geometry a) => Geometry (f a) where instance Transformable Primitive where {-# INLINE transform #-} - transform f (LinePrim l) = LinePrim $ transform f l - transform f (BezierPrim b) = BezierPrim $ transform f b + transform f (LinePrim l) = LinePrim $ transform f l + transform f (BezierPrim b) = BezierPrim $ transform f b transform f (CubicBezierPrim c) = CubicBezierPrim $ transform f c - transformM f (LinePrim l) = LinePrim <$> transformM f l - transformM f (BezierPrim b) = BezierPrim <$> transformM f b + transformM f (LinePrim l) = LinePrim <$> transformM f l + transformM f (BezierPrim b) = BezierPrim <$> transformM f b transformM f (CubicBezierPrim c) = CubicBezierPrim <$> transformM f c instance PointFoldable Primitive where {-# INLINE foldPoints #-} foldPoints f acc = go - where go (LinePrim l) = foldPoints f acc l - go (BezierPrim b) = foldPoints f acc b + where go (LinePrim l) = foldPoints f acc l + go (BezierPrim b) = foldPoints f acc b go (CubicBezierPrim c) = foldPoints f acc c instance {-# OVERLAPPABLE #-} (Traversable f, Transformable a) @@ -471,7 +464,7 @@ data Path = Path { -- | Origin of the point, equivalent to the -- first "move" command. _pathOriginPoint :: Point - -- | Tell if we must close the path. + -- | Should we close the path? , _pathClose :: Bool -- | List of commands in the path , _pathCommand :: [PathCommand] @@ -545,7 +538,7 @@ firstTangeantOf p = case p of LinePrim (Line p0 p1) -> p1 ^-^ p0 BezierPrim (Bezier p0 p1 p2) -> (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1) - CubicBezierPrim (CubicBezier p0 p1 p2 _) -> + CubicBezierPrim (CubicBezier p0 p1 p2 _) -> (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1) where ifBigEnough a b | nearZero a = b @@ -555,22 +548,22 @@ firstTangeantOf p = case p of -- primitive. lastTangeantOf :: Primitive -> Vector lastTangeantOf p = case p of - LinePrim (Line p0 p1) -> p1 ^-^ p0 - BezierPrim (Bezier _ p1 p2) -> p2 ^-^ p1 + LinePrim (Line p0 p1) -> p1 ^-^ p0 + BezierPrim (Bezier _ p1 p2) -> p2 ^-^ p1 CubicBezierPrim (CubicBezier _ _ p2 p3) -> p3 ^-^ p2 -- | Extract the first point of the primitive. firstPointOf :: Primitive -> Point firstPointOf p = case p of - LinePrim (Line p0 _) -> p0 - BezierPrim (Bezier p0 _ _) -> p0 + LinePrim (Line p0 _) -> p0 + BezierPrim (Bezier p0 _ _) -> p0 CubicBezierPrim (CubicBezier p0 _ _ _) -> p0 -- | Return the last point of a given primitive. lastPointOf :: Primitive -> Point lastPointOf p = case p of - LinePrim (Line _ p0) -> p0 - BezierPrim (Bezier _ _ p0) -> p0 + LinePrim (Line _ p0) -> p0 + BezierPrim (Bezier _ _ p0) -> p0 CubicBezierPrim (CubicBezier _ _ _ p0) -> p0 resplit :: [Primitive] -> [[Primitive]]