Rasterific 0.2.1 → 0.3

raw patch · 57 files changed

+2224/−742 lines, 57 filesdep +QuickCheckdep +Rasterificdep +binarydep ~FontyFruitydep ~JuicyPixelsdep ~basebinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, Rasterific, binary, criterion, deepseq, directory, dlist, filepath, statistics, vector-algorithms

Dependency ranges changed: FontyFruity, JuicyPixels, base, free, linear, mtl, vector

API changes (from Hackage documentation)

Files

• Rasterific.cabal +43/−9
• changelog +16/−0
• docimages/cap_round.png binary
• docimages/cap_straight.png binary
• docimages/cap_straight_1.png binary
• docimages/coordinate.png binary
• docimages/fill_evenodd.png binary
• docimages/fill_polygon.png binary
• docimages/fill_winding.png binary
• docimages/image_resize.png binary
• docimages/image_simple.png binary
• docimages/join_miter.png binary
• docimages/join_miter_5.png binary
• docimages/join_round.png binary
• docimages/linear_gradient.png binary
• docimages/module_example.png binary
• docimages/path_example.png binary
• docimages/primitive_mixed.png binary
• docimages/radial_gradient.png binary
• docimages/radial_gradient_focus.png binary
• docimages/sampled_texture_pad.png binary
• docimages/sampled_texture_reflect.png binary
• docimages/sampled_texture_repeat.png binary
• docimages/sampled_texture_rotate.png binary
• docimages/sampled_texture_scaled.png binary
• docimages/sampler_pad.png binary
• docimages/sampler_reflect.png binary
• docimages/sampler_repeat.png binary
• docimages/simple_line.png binary
• docimages/stroke_line.png binary
• docimages/stroke_polyline.png binary
• docimages/stroke_roundedRectangle.png binary
• docimages/strokize_dashed_path.png binary
• docimages/strokize_path.png binary
• docimages/transform_rotate.png binary
• docimages/transform_rotate_center.png binary
• docimages/transform_skewx.png binary
• docimages/transform_skewy.png binary
• docimages/with_clipping.png binary
• exec-src/rastertest.hs +628/−0
• src/Graphics/Rasterific.hs +97/−144
• src/Graphics/Rasterific/Compositor.hs +35/−4
• src/Graphics/Rasterific/CubicBezier.hs +95/−54
• src/Graphics/Rasterific/Line.hs +53/−4
• src/Graphics/Rasterific/Linear.hs +227/−0
• src/Graphics/Rasterific/Operators.hs +2/−8
• src/Graphics/Rasterific/Outline.hs +28/−0
• src/Graphics/Rasterific/PlaneBoundable.hs +64/−0
• src/Graphics/Rasterific/QuadraticBezier.hs +34/−34
• src/Graphics/Rasterific/QuadraticFormula.hs +53/−0
• src/Graphics/Rasterific/Rasterize.hs +39/−20
• src/Graphics/Rasterific/Shading.hs +455/−0
• src/Graphics/Rasterific/Stroke.hs +0/−258
• src/Graphics/Rasterific/StrokeInternal.hs +278/−0
• src/Graphics/Rasterific/Texture.hs +18/−201
• src/Graphics/Rasterific/Transformations.hs +48/−3
• src/Graphics/Rasterific/Types.hs +11/−3

@@ -1,7 +1,7 @@ -- Initial Rasterific.cabal generated by cabal init.  For further 
 -- documentation, see http://haskell.org/cabal/users-guide/
 name:                Rasterific
-version:             0.2.1
+version:             0.3
 synopsis:            A pure haskell drawing engine.
 -- A longer description of the package.
 description:
@@ -34,31 +34,65 @@ Source-Repository this
     Type:      git
     Location:  git://github.com/Twinside/Rasterific.git
-    Tag:       v0.2.1
+    Tag:       v0.3
 
+flag embed_linear
+  description: Embed a reduced version of Linear avoiding a (huge) dep
+  Default: True
+
 library
   hs-source-dirs: src
   exposed-modules: Graphics.Rasterific
+                 , Graphics.Rasterific.Outline
                  , Graphics.Rasterific.Texture
+                 , Graphics.Rasterific.Linear
                  , Graphics.Rasterific.Transformations
 
   other-modules: Graphics.Rasterific.Line
-               , Graphics.Rasterific.QuadraticBezier
                , Graphics.Rasterific.CubicBezier
-               , Graphics.Rasterific.Stroke
+               , Graphics.Rasterific.QuadraticBezier
                , Graphics.Rasterific.Operators
                , Graphics.Rasterific.Rasterize
+               , Graphics.Rasterific.StrokeInternal
                , Graphics.Rasterific.Types
                , Graphics.Rasterific.Compositor
+               , Graphics.Rasterific.Shading
+               , Graphics.Rasterific.PlaneBoundable
+               , Graphics.Rasterific.QuadraticFormula
 
   ghc-options: -O2 -Wall
   ghc-prof-options: -Wall -prof -auto-all
   default-language: Haskell2010
   build-depends: base        >= 4.6     && < 4.9
-               , JuicyPixels >= 3.1.5   && < 3.2
-               , linear      >= 1.3.1   && < 1.9
-               , free        >= 4.5     && < 4.7
-               , FontyFruity >= 0.2     && < 0.3
+               , JuicyPixels >= 3.1.5.2 && < 3.2
+               , FontyFruity >= 0.3     && < 0.4
                , vector      >= 0.9
-               , mtl         >= 2.1
+               , vector-algorithms >= 0.3
+               , free        >= 4.7
+               , mtl         >= 1.9
+               , dlist       >= 0.6
+
+  if !flag(embed_linear)
+      build-depends: linear >= 1.3
+      cpp-options: -DEXTERNAL_LINEAR
+  
+Test-Suite test
+    type: exitcode-stdio-1.0
+    default-language:    Haskell2010
+    Main-Is: rastertest.hs
+    ghc-options: -Wall -O2
+    ghc-prof-options: -rtsopts -Wall -prof -auto-all
+    Hs-Source-Dirs: exec-src
+    Build-Depends: base >= 4.6
+                 , Rasterific
+                 , JuicyPixels
+                 , directory   >= 1.2
+                 , filepath
+                 , vector
+                 , FontyFruity
+                 , binary
+                 , QuickCheck >= 2.7
+                 , deepseq
+                 , criterion >= 0.8 && < 0.9
+                 , statistics >= 0.10 && < 0.11
 

@@ -1,5 +1,21 @@ -*-change-log-*-
 
+v0.3 2014
+ * Switching main free monad type to the church encoded one.
+ * Optimized the bezier decomposition, strictness annotations
+   made wonders. May require forward differencing in the future.
+ * Implementing specific decomposition for lines.
+ * Reworked texture system, now allowing some specialized
+   filler (hoping faster computation). For now only the
+   solid color has been optimized, and all the transformed
+   textures.
+ * Fixing space leak in combineEdgeSamples, avoiding many
+   allocations.
+ * Adding bounding box calculation facility.
+ * Exposing outline creation capability
+ * Adding a skewX & skewY transformation function.
+ * Fixing some numerical stability with the mitter join.
+
 v0.2.1 April 2014
  * Fixing transparency in gradients.
  * Fixing alpha composition on top of translucent

binary file changed (1070 → 1129 bytes)

binary file changed (986 → 1077 bytes)

binary file changed (1082 → 1137 bytes)

binary file changed (1870 → 1868 bytes)

binary file changed (3775 → 3774 bytes)

binary file changed (1392 → 1371 bytes)

binary file changed (2782 → 2781 bytes)

binary file changed (22315 → 21960 bytes)

binary file changed (8387 → 7646 bytes)

binary file changed (1322 → 1416 bytes)

binary file changed (1239 → 1343 bytes)

binary file changed (1277 → 1377 bytes)

binary file changed (3778 → 4139 bytes)

binary file changed (1046 → 1047 bytes)

binary file changed (1316 → 1355 bytes)

binary file changed (1316 → 1355 bytes)

binary file changed (10158 → 10038 bytes)

binary file changed (11747 → 11755 bytes)

binary file changed (8287 → 7587 bytes)

binary file changed (34615 → 46327 bytes)

binary file changed (25162 → 23294 bytes)

binary file changed (84457 → 84500 bytes)

binary file changed (56580 → 56543 bytes)

binary file changed (1097 → 1683 bytes)

binary file changed (1437 → 4708 bytes)

binary file changed (1459 → 3864 bytes)

binary file changed (1960 → 1887 bytes)

binary file changed (1567 → 1449 bytes)

binary file changed (1451 → 1594 bytes)

binary file changed (571 → 571 bytes)

binary file changed (absent → 9361 bytes)

binary file changed (absent → 3199 bytes)

binary file changed (1873 → 1824 bytes)

binary file changed (1890 → 1828 bytes)

binary file changed (absent → 1022 bytes)

binary file changed (absent → 907 bytes)

binary file changed (1707 → 1796 bytes)

@@ -0,0 +1,628 @@+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+import System.FilePath( (</>) )
+import System.Directory( createDirectoryIfMissing )
+
+import Data.Foldable( foldMap )
+import Data.Monoid( (<>) )
+import Control.Applicative( (<$>) )
+import Graphics.Rasterific hiding ( fill
+                                  , dashedStrokeWithOffset
+                                  , dashedStroke
+                                  , fillWithMethod, stroke)
+import qualified Graphics.Rasterific as R
+import Graphics.Rasterific.Texture
+import Graphics.Rasterific.Linear( (^+^), (^-^) )
+import Graphics.Rasterific.Transformations
+
+import Graphics.Text.TrueType( loadFontFile )
+import Codec.Picture
+import Arbitrary
+import System.Environment( getArgs )
+import Criterion.Config( defaultConfig )
+import Criterion.Main( parseArgs
+                     , defaultOptions
+                     , defaultMainWith
+                     , bench
+                     )
+import qualified Sample as Sample
+
+type Stroker =
+    Float -> Join -> (Cap, Cap) -> [Primitive]
+        -> Drawing PixelRGBA8 ()
+
+type DashStroker = DashPattern -> Stroker
+
+outFolder :: FilePath
+outFolder = "test_results"
+
+logo :: Int -> Bool -> Vector -> [Primitive]
+logo size inv offset = map BezierPrim . bezierFromPath . way $ map (^+^ offset)
+    [ (V2   0  is)
+    , (V2   0   0)
+    , (V2  is   0)
+    , (V2 is2   0)
+    , (V2 is2  is)
+    , (V2 is2 is2)
+    , (V2  is is2)
+    , (V2  0  is2)
+    , (V2  0   is)
+    ]
+  where is = fromIntegral size
+        is2 = is + is
+
+        way | inv = reverse
+            | otherwise = id
+
+
+background, blue, black, yellow, red, white :: PixelRGBA8
+background = PixelRGBA8 128 128 128 255
+blue = PixelRGBA8 0 020 150 255
+red = PixelRGBA8 255 0 0 255
+black = PixelRGBA8 0 0 0 255
+{-grey = PixelRGBA8 128 128 128 255-}
+yellow = PixelRGBA8 255 255 0 255
+{-brightblue = PixelRGBA8 0 255 255 255-}
+white = PixelRGBA8 255 255 255 255
+
+biColor, triColor :: Gradient PixelRGBA8
+biColor = [ (0.0, black) , (1.0, yellow) ]
+triColor = [ (0.0, blue), (0.5, white) , (1.0, red) ]
+
+fill :: [Primitive] -> Drawing PixelRGBA8 ()
+fill = fillWithMethod FillWinding
+
+drawBoundingBox :: [Primitive] -> Drawing PixelRGBA8 ()
+drawBoundingBox prims = do
+  let PlaneBound mini maxi = foldMap planeBounds prims
+      V2 width height = maxi ^-^ mini
+  withTexture (uniformTexture red) $
+      R.stroke 2 (JoinMiter 0) (CapStraight 0, CapStraight 0) $
+        rectangle mini width height
+
+stroke :: Float -> Join -> (Cap, Cap) -> [Primitive]
+       -> Drawing PixelRGBA8 ()
+stroke w j cap prims =
+    R.stroke w j cap prims >> drawBoundingBox prims
+
+dashedStroke :: DashPattern -> Float -> Join -> (Cap, Cap) -> [Primitive]
+            -> Drawing PixelRGBA8 ()
+dashedStroke p w j c prims =
+    R.dashedStroke p w j c prims >> drawBoundingBox prims
+
+dashedStrokeWithOffset
+    :: Float -> DashPattern -> Float -> Join -> (Cap, Cap) -> [Primitive]
+    -> Drawing PixelRGBA8 ()
+dashedStrokeWithOffset o p w j c prims =
+    R.dashedStrokeWithOffset o p w j c prims >> drawBoundingBox prims
+
+fillWithMethod :: FillMethod -> [Primitive] -> Drawing PixelRGBA8 ()
+fillWithMethod method prims =
+  R.fillWithMethod method prims >> drawBoundingBox prims
+
+logoTest :: Texture PixelRGBA8 -> String -> IO ()
+logoTest texture prefix =
+    writePng (outFolder </> (prefix ++ "logo.png")) img
+  where 
+    beziers = logo 40 False $ V2 10 10
+    inverse = logo 20 True $ V2 20 20
+    drawing = withTexture texture . fill $ beziers ++ inverse
+    img = renderDrawing 100 100 background drawing
+
+makeBox :: Point -> Point -> [Primitive]
+makeBox (V2 sx sy) (V2 ex ey) = map LinePrim $ lineFromPath
+    [ V2 sx sy
+    , V2 ex sy
+    , V2 ex ey
+    , V2 sx ey
+    , V2 sx sy
+    ]
+
+bigBox :: Texture PixelRGBA8 -> String -> IO ()
+bigBox texture prefix =
+    writePng (outFolder </> (prefix ++ "box.png")) img
+  where 
+    drawing = withTexture texture . fill $ makeBox (V2 10 10) (V2 390 390)
+    img = renderDrawing 400 400 background drawing
+
+circleTest :: Texture PixelRGBA8 -> String -> IO ()
+circleTest texture prefix =
+    writePng (outFolder </> (prefix ++ "circle.png")) img
+  where 
+    drawing = withTexture texture . fill $ circle (V2 100 100) 90
+    img = renderDrawing 200 200 background drawing
+
+cubicTest :: [Primitive]
+cubicTest = map CubicBezierPrim $ cubicBezierFromPath 
+    [ V2 50 20 
+    , V2 90 60
+    , V2  5 100
+    , V2 50 140
+
+    , V2 70 120
+    , V2 80 100
+    , V2 120 80
+
+    , V2 100 60
+    , V2 70  20
+    , V2 50  20
+    ]
+
+cubicTest1 :: IO ()
+cubicTest1 = writePng (outFolder </> "cubic1.png") img
+  where texture = uniformTexture blue
+        drawing = withTexture texture $ fill cubicTest
+        img = renderDrawing 150 150 background drawing
+
+clipTest :: IO ()
+clipTest = writePng (outFolder </> "clip.png") img
+  where texture = uniformTexture blue
+        beziers =
+            [ logo 20 False $ V2 (-10) (-10)
+            , logo 20 False $ V2 80 80
+            , logo 20 False $ V2 0 80
+            , logo 20 False $ V2 80 0
+            ]
+
+        drawing = withTexture texture $ mapM_ fill beziers
+        img = renderDrawing 100 100 background drawing
+
+strokeTest2 :: Stroker -> String -> IO ()
+strokeTest2 stroker prefix =
+    writePng (outFolder </> (prefix ++ "stroke2.png")) img
+  where texture = uniformTexture blue
+        points = 
+            [ V2 10 10, V2 100 100
+            , V2 200 20, V2 300 100, V2 450 50]
+        
+        drawing = withTexture texture . sequence_ . concat $
+            [ []
+            , [stroker 9 JoinRound (CapRound, CapStraight 0)
+                    . map LinePrim . lineFromPath $
+                (^+^ (V2 15 (20 * (ix + 5)))) <$> points
+                    | ix <- [-5 .. -1] ]
+            , [stroker 9 (JoinMiter $ ix * 3) (CapStraight 0, CapRound)
+                . map LinePrim . lineFromPath $
+                (^+^ (V2 15 (20 * (ix + 5)))) <$> points
+                    | ix <- [0 .. 5] ]
+            ]
+
+        img = renderDrawing 500 500 background drawing
+
+strokeTestCliping :: Stroker -> String -> IO ()
+strokeTestCliping stroker prefix =
+    writePng (outFolder </> (prefix ++ "stroke_clipping.png")) img
+  where texture = uniformTexture blue
+        points = 
+            [ V2 10 10, V2 100 100
+            , V2 200 20, V2 300 100, V2 450 50]
+
+        clipShape = R.fill $ circle (V2 250 250) 200
+        
+        drawing = do
+          withClipping clipShape .
+            withTexture texture . sequence_ . concat $
+            [ []
+            , [stroker 9 JoinRound (CapRound, CapStraight 0)
+                    . map LinePrim . lineFromPath $
+                (^+^ (V2 15 (20 * (ix + 5)))) <$> points
+                    | ix <- [-5 .. -1] ]
+            , [stroker 9 (JoinMiter $ ix * 3) (CapStraight 0, CapRound)
+                . map LinePrim . lineFromPath $
+                (^+^ (V2 15 (20 * (ix + 5)))) <$> points
+                    | ix <- [0 .. 5] ]
+            ]
+          withTexture (uniformTexture $ PixelRGBA8 255 128 100 128)
+                    . fill $ circle (V2 150 150) 40
+
+        img = renderDrawing 500 500 background drawing
+
+strokeLogo :: Stroker -> String -> IO ()
+strokeLogo stroker prefix =
+  writePng (outFolder </> (prefix ++ "stroke_logo.png")) img
+    where texture = uniformTexture blue
+          beziers = logo 40 False $ V2 10 10
+          inverse = logo 20 True $ V2 20 20
+          img = renderDrawing 100 100 background 
+              . withTexture texture
+              . stroker 4 JoinRound (CapRound, CapRound)
+              $ beziers ++ inverse
+
+strokeQuadraticIntersection ::
+    Stroker -> Texture PixelRGBA8 -> String -> IO ()
+strokeQuadraticIntersection stroker texture prefix =
+  writePng (outFolder </> (prefix ++ "stroke_quad_intersection.png")) img
+    where img = renderDrawing 500 500 background 
+              . withTexture texture
+              . stroker 40 JoinRound (CapRound, CapRound)
+              . map BezierPrim
+              $ bezierFromPath
+                [ V2 30 30
+                , V2 150 200
+                , V2 450 450
+
+                , V2 450 90
+                , V2 30  450
+                ]
+
+strokeCubic :: Stroker -> Texture PixelRGBA8 -> String
+            -> IO ()
+strokeCubic stroker texture prefix =
+    writePng (outFolder </> (prefix ++ "cubicStroke.png")) img
+  where img = renderDrawing 500 500 background drawing
+        cusp = CubicBezier
+            (V2 10 230)
+            (V2 350 570)
+            (V2 10 570)
+            (V2 350 230)
+
+        loop = CubicBezier
+            (V2 160 20)
+            (V2 770 500)
+            (V2 140 500)
+            (V2 480 70)
+
+        drawing = withTexture texture . sequence_ . concat $
+            [ []
+            , [stroker 4 JoinRound (CapRound, CapRound)
+                    $ take 1 cubicTest ]
+
+            , [stroker 15 (JoinMiter 0)
+                    (CapStraight 0, CapStraight 0)
+                    [CubicBezierPrim cusp]]
+
+            , [stroker 25 (JoinMiter 0)
+                    (CapStraight 0, CapStraight 0)
+                    [CubicBezierPrim loop]]
+            ]
+
+strokeCubicDashed :: DashStroker -> Texture PixelRGBA8 -> String
+                  -> IO ()
+strokeCubicDashed stroker texture prefix =
+    writePng (outFolder </> (prefix ++ "cubicStrokeDashed.png")) img
+  where img = renderDrawing 500 500 background drawing
+        cusp = CubicBezier
+            (V2 10 230)
+            (V2 350 570)
+            (V2 10 570)
+            (V2 350 230)
+
+        loop = CubicBezier
+            (V2 160 20)
+            (V2 770 500)
+            (V2 140 500)
+            (V2 480 70)
+
+        dashPattern = [10, 5, 20, 10]
+
+        drawing = withTexture texture . sequence_ . concat $
+            [ []
+            , [stroker dashPattern 4 JoinRound (CapRound, CapRound)
+                    $ take 1 cubicTest ]
+
+            , [stroker dashPattern 15 (JoinMiter 0)
+                    (CapStraight 0, CapStraight 0)
+                    [CubicBezierPrim cusp]]
+
+            , [stroker dashPattern 25 (JoinMiter 0)
+                    (CapStraight 0, CapStraight 0)
+                    [CubicBezierPrim loop]]
+            ]
+
+textAlignStringTest :: String -> String -> String -> IO ()
+textAlignStringTest fontName filename txt = do
+    putStrLn $ "Rendering " ++ fontName
+    fontErr <- loadFontFile $ "C:/Windows/Fonts/" ++ fontName ++ ".ttf"
+    case fontErr of
+      Left err -> putStrLn err
+      Right font ->
+        writePng (outFolder </> filename) .
+            renderDrawing 300 70 white
+                . withTexture (uniformTexture black) $
+                        printTextAt font 12 (V2 20 40) txt
+
+strokeTest :: Stroker -> Texture PixelRGBA8 -> String
+           -> IO ()
+strokeTest stroker texture prefix =
+    writePng (outFolder </> (prefix ++ "stroke.png")) img
+  where beziers base = take 1 <$>
+            take 3 [ logo 100 False $ V2 ix ix | ix <- [base, base + 20 ..] ]
+        drawing = withTexture texture $ sequence_ . concat $
+          [ []
+          , [stroker (6 + ix) (JoinMiter ix)
+                    (CapStraight 0, CapRound) b
+                    | (ix, b) <- zip [1 ..] (beziers 10)]
+          , [stroker ix
+                    (JoinMiter 1) (CapRound, CapStraight 1) b
+                    | (ix, b) <- zip [1 ..] (beziers 60)]
+          , [stroker ix (JoinMiter 1) (CapRound, CapRound) b
+                    | (ix, b) <- zip [1 ..] (beziers 110)]
+          , [stroker 15
+                    (JoinMiter 1) (CapStraight 1, CapStraight 0)
+                    . take 1 $
+                    logo 150 False $ V2 200 200]
+          , [stroker 5
+                    (JoinMiter 1) (CapStraight 0, CapStraight 0) $
+                   logo 100 False $ V2 240 240]
+          ]
+        img = renderDrawing 500 500 background drawing
+
+complexEvenOddTest :: Int -> Texture PixelRGBA8 -> IO ()
+complexEvenOddTest size texture = mapM_ tester [(filling, ix)
+                                              | filling <- [(FillEvenOdd, "evenodd")
+                                                           ,(FillWinding, "winding")]
+                                              , ix <- [1 :: Int .. 3]] where
+  command =
+     [ 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)
+         ]
+     ]
+
+  tester ((method, name), i) =
+    writePng (outFolder </> ("complex_" ++ name ++ "_" ++ show i ++ "_" ++ show size ++ "px.png"))
+        . renderDrawing size size white
+        . withTexture texture
+        . fillWithMethod method
+        . fmap (transform . applyTransformation $
+                            rotateCenter (fromIntegral i / 6) (V2 (350) (350)))
+        $ concatMap pathToPrimitives command
+
+evenOddTest :: Texture PixelRGBA8 -> IO ()
+evenOddTest texture = mapM_ tester [1 :: Int .. 3] where
+  command =
+    Path (V2 250 75) True
+      [ PathLineTo (V2 323 301)
+      , PathLineTo (V2 131 161)
+      , PathLineTo (V2 369 161)
+      , PathLineTo (V2 177 301)
+      ]
+  tester i =
+    writePng (outFolder </> ("even_odd" ++ show i ++ ".png"))
+        . renderDrawing 300 300 white
+        . withTexture texture
+        . fillWithMethod FillEvenOdd
+        . fmap (transform . applyTransformation $
+                            translate (V2 (-80) (-40))
+                            <> rotateCenter (fromIntegral i / 6) (V2 (250) (200)))
+        $ pathToPrimitives command
+
+crash :: Texture PixelRGBA8 -> IO ()
+crash texture = do
+    writePng (outFolder </> "crash00.png") $
+        renderDrawing 600 600 background $
+            withTexture texture $ fill geom
+  where
+    geom = concat
+        [line (V2 572.7273 572.7273) (V2 572.7273 27.272766)
+        ,line (V2 572.7273 27.272728) (V2 27.272766 27.272728)
+        ,line (V2 27.272728 27.272728) (V2 27.272728 572.72723)
+        ,line (V2 27.272728 572.7273) (V2 572.72723 572.7273)
+
+        ,line (V2 481.81818 481.81818) (V2 118.18182 481.81818)
+        ,line (V2 118.181816 481.81818) (V2 118.181816 118.18182)
+        ,line (V2 118.181816 118.181816) (V2 481.81818 118.181816)
+        ,line (V2 481.81818 118.181816) (V2 481.81818 481.81818)
+        ]
+strokeCrash :: IO ()
+strokeCrash = do
+ let drawColor = PixelRGBA8 0 0x86 0xc1 255
+     img = renderDrawing 600 600 white $
+        withTexture (uniformTexture drawColor) $ do
+           stroke 5 (JoinMiter 0) (CapStraight 0, CapStraight 0)
+            [LinePrim (Line (V2 572.7273 572.7273) (V2 572.7273 27.272766))
+            ,LinePrim (Line (V2 572.7273 27.272728) (V2 27.272766 27.272728))
+            ,LinePrim (Line (V2 27.272728 27.272728) (V2 27.272728 572.72723))
+            ,LinePrim (Line (V2 27.272728 572.7273) (V2 572.72723 572.7273))
+            ]
+           stroke 5 (JoinMiter 0) (CapStraight 0, CapStraight 0)
+            [LinePrim (Line (V2 481.81818 481.81818) (V2 118.18182 481.81818))
+            ,LinePrim (Line (V2 118.181816 481.81818) (V2 118.181816 118.18182))
+            ,LinePrim (Line (V2 118.181816 118.181816) (V2 481.81818 118.181816))
+            ,LinePrim (Line (V2 481.81818 118.181816) (V2 481.81818 481.81818))
+            ]
+
+ writePng (outFolder </> "stroke_crash.png") img
+
+dashTest :: IO ()
+dashTest = writePng (outFolder </> "dashed_wheel.png")
+         . renderDrawing 550 550 white
+         $ withTexture (uniformTexture black) drawing
+  where
+    drawing =
+        dashedStrokeWithOffset 0.0 [4.0,4.0] 10.0
+            (JoinMiter 0.0) (CapStraight 0.0,CapStraight 0.0) 
+            [CubicBezierPrim
+                (CubicBezier (V2 525.0 275.0) (V2 525.0 136.92882)
+                             (V2 413.0712 25.0) (V2 275.0 25.0))
+            ]
+
+weirdCircle :: IO ()
+weirdCircle = writePng (outFolder </> "bad_circle.png")
+            . renderDrawing 400 200 white
+            $ withTexture (uniformTexture black) drawing
+  where
+    drawing =
+        fill [CubicBezierPrim $ CubicBezier (V2 375.0 125.0)
+                                            (V2 375.0 55.96441)
+                                            (V2 319.03558 0.0)
+                                            (V2 250.0 0.0)
+             ,CubicBezierPrim $ CubicBezier (V2 250.0 (-1.4210855e-14))
+                                            (V2 180.96442 (-1.8438066e-14))
+                                            (V2 125.0 55.964405)
+                                            (V2 125.0 125.0)
+             ,CubicBezierPrim $ CubicBezier (V2 125.0 125.0)
+                                            (V2 125.0 194.03558)
+                                            (V2 180.9644 250.0)
+                                            (V2 250.0 250.0)
+             ,CubicBezierPrim $ CubicBezier (V2 250.0 250.0)
+                                            (V2 319.03558 250.0)
+                                            (V2 375.0 194.0356)
+                                            (V2 375.0 125.0)
+             ]
+
+transparentGradient :: IO ()
+transparentGradient =
+    writePng (outFolder </> "transparent_gradient.png") $ renderDrawing 400 200 white img
+  where img = withTexture (withSampler SamplerPad
+                          (linearGradientTexture gradDef
+                          (V2 40 40) (V2 130 130))) $
+                          fill $ circle (V2 100 100) 100
+        gradDef = [(0, PixelRGBA8 0 0x86 0xc1 255)
+                  ,(0.5, PixelRGBA8 0xff 0xf4 0xc1 255)
+                  ,(1, PixelRGBA8 0xFF 0x53 0x73 50)]
+  
+gradientRadial :: String -> PixelRGBA8 -> IO ()
+gradientRadial name back =
+    writePng (outFolder </> ("rad_opacity" ++ name ++ ".png")) $
+        renderDrawing 500 500 back img
+  where img = withTexture (withSampler SamplerRepeat
+                          (radialGradientTexture gradDef
+                          (V2 250 250) 100)) $
+                          fill $ rectangle (V2 0 0) 500 500
+        gradDef = 
+            [(0  , PixelRGBA8 255 165 0 102)
+            ,(0.5, PixelRGBA8 255 165 0 102)
+            ,(0.5, PixelRGBA8 255 165 0 102)
+            ,(0.525, PixelRGBA8 255 165 0 255)
+            ,(0.675, PixelRGBA8 128 128 128 64)
+            ,(0.75, PixelRGBA8 0 128 128 255)
+            ,(1, PixelRGBA8 0 128 128 255)
+            ]
+strokeBad :: IO ()
+strokeBad =
+    writePng (outFolder </> ("bad_stroke_tiger.png")) $
+        renderDrawing 500 500 white drawing
+  where 
+    drawing =
+        withTransformation (Transformation { _transformA = 1.6
+                                      , _transformC = 0.0
+                                      , _transformE = 350.0
+                                      , _transformB = 0.0
+                                      , _transformD = 1.6
+                                      , _transformF = 300.0}) $
+            withTexture (uniformTexture (PixelRGBA8 76 0 0 255)) $
+                stroke 2.0 (JoinMiter 1.0) (CapStraight 0.0
+                                           ,CapStraight 0.0) $
+                    CubicBezierPrim <$>
+                        [CubicBezier (V2 21.2 63.0)
+                                     (V2 21.2 63.0)
+                                     (V2 4.200001 55.8)
+                                     (V2 (-10.599998) 53.6)
+                        ,CubicBezier (V2 (-10.599998) 53.6)
+                                     (V2 (-10.599998) 53.6)
+                                     (V2 (-27.199999) 51.0)
+                                     (V2 (-43.8) 58.199997)
+                        ,CubicBezier (V2 (-43.8) 58.199997)
+                                     (V2 (-43.8) 58.199997)
+                                     (V2 (-56.0) 64.2)
+                                     (V2 (-61.4) 74.399994)]
+
+testSuite :: IO ()
+testSuite = do
+  let uniform = uniformTexture blue
+      biGradient =
+        linearGradientTexture biColor (V2 10 10) (V2 90 90)
+      radBiGradient =
+        radialGradientTexture biColor (V2 45 45) 60
+      bigBiGradient =
+        linearGradientTexture biColor (V2 0 10) (V2 0 390)
+      triGradient =
+        linearGradientTexture triColor (V2 0 10) (V2 0 390)
+      radTriGradient =
+        radialGradientTexture triColor (V2 250 250) 200
+      radFocusTriGradient =
+        radialGradientWithFocusTexture
+            triColor (V2 200 200) 70 (V2 250 200)
+      radFocusTriGradient2 =
+        radialGradientWithFocusTexture
+            triColor (V2 200 200) 70 (V2 150 170)
+
+  createDirectoryIfMissing True outFolder
+  strokeBad 
+  evenOddTest uniform
+  complexEvenOddTest 700 uniform
+  complexEvenOddTest 350 uniform
+
+  weirdCircle
+  dashTest
+
+  strokeCrash
+  logoTest uniform ""
+  logoTest biGradient "gradient_"
+  crash uniform
+  transparentGradient 
+  gradientRadial "white_opaque" white
+  gradientRadial "black_opaque" black
+  gradientRadial "white_transparent" (PixelRGBA8 255 255 255 0)
+  gradientRadial "white_semi" (PixelRGBA8 255 255 255 128)
+  gradientRadial "black_transparent" (PixelRGBA8 0 0 0 0)
+  gradientRadial "gray_opaque" (PixelRGBA8 128 128 128 255)
+  gradientRadial "gray_transparent" (PixelRGBA8 128 128 128 0)
+  gradientRadial "gray_semi" (PixelRGBA8 128 128 128 128)
+
+  bigBox uniform ""
+  bigBox biGradient "gradient_"
+  bigBox bigBiGradient "gradient_big_"
+  bigBox triGradient "gradient_tri_"
+  bigBox radBiGradient "rad_gradient_"
+  bigBox radTriGradient "rad_trigradient_"
+  bigBox radFocusTriGradient "rad_focus_trigradient_"
+  bigBox radFocusTriGradient2 "rad_focus_trigradient_2_"
+
+  circleTest uniform ""
+  strokeTestCliping stroke ""
+
+  cubicTest1
+  clipTest
+  strokeTest stroke uniform ""
+  strokeTest stroke bigBiGradient "gradient_"
+  strokeTest stroke radTriGradient "rad_gradient_"
+  strokeLogo stroke ""
+
+  strokeQuadraticIntersection stroke uniform ""
+  strokeQuadraticIntersection stroke triGradient "gradient_"
+  strokeQuadraticIntersection stroke radBiGradient "rad_gradient_"
+
+  strokeTest2 stroke ""
+
+  strokeCubic stroke uniform ""
+  strokeCubic stroke bigBiGradient "gradient_"
+  strokeCubic stroke radTriGradient "rad_gradient_"
+
+  strokeCubicDashed dashedStroke uniform ""
+
+  let testText =
+        "Test of a text! It seems to be; à é è ç, working? () {} [] \" '"
+
+  textAlignStringTest "CONSOLA" "alignedConsola.png" testText
+  textAlignStringTest "arial" "alignedArial.png"
+        "Just a simple test, gogo !!! Yay ; quoi ?"
+  -- -}
+
+benchTest :: [String] -> IO ()
+benchTest args = do
+  (config, _) <-
+      parseArgs defaultConfig defaultOptions args
+  defaultMainWith config (return ())
+        [bench "testsuite" testSuite,
+         bench "Triangles" Sample.triangles]
+
+main :: IO ()
+main = do
+    args <- getArgs
+    case args of
+         "random":_ -> randomTests
+         "bench":rest -> benchTest rest
+         "prof":_ -> Sample.triangles
+         _ -> testSuite
+

@@ -4,6 +4,8 @@ {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
 -- | Main module of Rasterific, an Haskell rasterization engine.
 --
 -- Creating an image is rather simple, here is a simple example
@@ -49,6 +51,9 @@     , dashedStrokeWithOffset
     , printTextAt
 
+      -- * Generating images
+    , ModulablePixel
+    , RenderablePixel
     , renderDrawing
     , pathToPrimitives
 
@@ -69,6 +74,8 @@     , PathCommand( .. )
     , Transformable( .. )
     , PointFoldable( .. )
+    , PlaneBoundable( .. )
+    , PlaneBound( .. )
 
       -- * Helpers
     , line
@@ -99,11 +106,14 @@ 
     ) where
 
+import qualified Data.Foldable as F
 import Control.Applicative( (<$>) )
 import Control.Monad( forM_ )
 import Control.Monad.Free( Free( .. ), liftF )
+import Control.Monad.Free.Church( F, fromF )
 import Control.Monad.ST( ST, runST )
 import Control.Monad.State( StateT, execStateT, get, lift )
+import Data.Maybe( fromMaybe )
 import Data.Monoid( Monoid( .. ), (<>) )
 import Codec.Picture.Types( Image( .. )
                           , Pixel( .. )
@@ -114,18 +124,19 @@                           , unsafeFreezeImage )
 
 import qualified Data.Vector.Unboxed as VU
-import Linear( V2( .. ), (^+^), (^*) )
-
 import Graphics.Rasterific.Compositor
-{-import Graphics.Rasterific.Operators-}
+import Graphics.Rasterific.Linear( V2( .. ), (^+^), (^*) )
 import Graphics.Rasterific.Rasterize
 import Graphics.Rasterific.Texture
+import Graphics.Rasterific.Shading
 import Graphics.Rasterific.Types
 import Graphics.Rasterific.Line
 import Graphics.Rasterific.QuadraticBezier
 import Graphics.Rasterific.CubicBezier
-import Graphics.Rasterific.Stroke
+import Graphics.Rasterific.StrokeInternal
 import Graphics.Rasterific.Transformations
+import Graphics.Rasterific.PlaneBoundable
+{-import Graphics.Rasterific.TensorPatch-}
 
 import Graphics.Text.TrueType( Font, PointSize, getStringCurveAtPoint )
 
@@ -141,7 +152,7 @@ ------------------------------------------------
 
 -- | Monad used to record the drawing actions.
-type Drawing px = Free (DrawCommand px)
+type Drawing px = F (DrawCommand px)
 
 data DrawCommand px next
     = Fill FillMethod [Primitive] next
@@ -159,37 +170,50 @@ --
 -- The outputted code looks like Haskell, but there is no
 -- guarantee that it is compilable.
-dumpDrawing :: (Show px) => Drawing px () -> String
-dumpDrawing (Pure ()) = "return ()"
-dumpDrawing (Free (Fill _ prims next)) =
-    "fill " ++ show prims ++ " >>=\n" ++ dumpDrawing next
-dumpDrawing (Free (TextFill _ _ _ text next)) =
-    "-- Text : " ++ text ++ "\n" ++ dumpDrawing next
-dumpDrawing (Free (SetTexture _tx drawing next)) =
-    "withTexture ({- texture -}) (" ++
-            dumpDrawing drawing ++ ") >>=\n" ++ dumpDrawing next
-dumpDrawing (Free (DashedStroke o pat w j cap prims next)) =
+dumpDrawing :: ( Show px
+               , Show (PixelBaseComponent px)
+               , PixelBaseComponent (PixelBaseComponent px)
+                    ~ (PixelBaseComponent px)
+
+               ) => Drawing px () -> String
+dumpDrawing = go . fromF where
+  go ::
+        ( Show px
+        , Show (PixelBaseComponent px)
+        , PixelBaseComponent (PixelBaseComponent px)
+                    ~ (PixelBaseComponent px)
+
+        ) => Free (DrawCommand px) () -> String
+  go (Pure ()) = "return ()"
+  go (Free (Fill _ prims next)) =
+    "fill " ++ show prims ++ " >>=\n" ++   go next
+  go (Free (TextFill _ _ _ text next)) =
+    "-- Text : " ++ text ++ "\n" ++   go next
+  go (Free (SetTexture tx drawing next)) =
+    "withTexture (" ++ dumpTexture tx ++ ") (" ++
+              go (fromF drawing) ++ ") >>=\n" ++ go next
+  go (Free (DashedStroke o pat w j cap prims next)) =
     "dashedStrokeWithOffset "
               ++ show o ++ " "
               ++ show pat ++ " "
               ++ show w ++ " ("
               ++ show j ++ ") "
               ++ show cap ++ " "
-              ++ show prims ++ " >>=\n" ++ dumpDrawing next
-dumpDrawing (Free (Stroke w j cap prims next)) =
+              ++ show prims ++ " >>=\n" ++   go next
+  go (Free (Stroke w j cap prims next)) =
     "stroke " ++ show w ++ " ("
               ++ show j ++ ") "
               ++ show cap ++ " "
-              ++ show prims ++ " >>=\n" ++ dumpDrawing next
-dumpDrawing (Free (WithTransform trans sub next)) =
-    "withTransform (" ++ show trans ++ ") (" 
-                      ++ dumpDrawing sub ++ ") >>=\n "
-                      ++ dumpDrawing next
-dumpDrawing (Free (WithCliping clipping draw next)) =
-    "withClipping (" ++ dumpDrawing (withTexture clipTexture clipping)
+              ++ show prims ++ " >>=\n" ++   go next
+  go (Free (WithTransform trans sub next)) =
+    "withTransform (" ++ show trans ++ ") ("
+                      ++ go (fromF sub) ++ ") >>=\n "
+                      ++ go next
+  go (Free (WithCliping clipping draw next)) =
+    "withClipping (" ++ go (fromF $ withTexture clipTexture clipping)
                      ++ ")\n" ++
-            "         (" ++ dumpDrawing draw++ ")\n >>= " ++
-            dumpDrawing next
+        "         (" ++ go (fromF draw) ++ ")\n >>= " ++
+              go next
         where clipTexture = uniformTexture (0xFF :: Pixel8)
 
 
@@ -209,9 +233,6 @@ 
 instance Monoid (Drawing px ()) where
     mempty = return ()
-
-    mappend (Pure ()) b = b
-    mappend a (Pure ()) = a
     mappend a b = a >> b
 
 -- | Define the texture applyied to all the children
@@ -329,12 +350,7 @@ -- Tested pixels type are PixelRGBA8 and Pixel8, pixel types
 -- in other colorspace will probably produce weird results.
 renderDrawing
-    :: forall px
-     . ( Pixel px
-       , Pixel (PixelBaseComponent px)
-       , Modulable (PixelBaseComponent px)
-       , PixelBaseComponent (PixelBaseComponent px) ~ (PixelBaseComponent px)
-       )
+    :: forall px . (RenderablePixel px)
     => Int -- ^ Rendering width
     -> Int -- ^ Rendering height
     -> px  -- ^ Background color
@@ -342,7 +358,7 @@     -> Image px
 renderDrawing width height background drawing = runST $
   createMutableImage width height background
-        >>= execStateT (go initialContext drawing)
+        >>= execStateT (go initialContext $ fromF drawing)
         >>= unsafeFreezeImage
   where
     initialContext = RenderContext Nothing stupidDefaultTexture Nothing
@@ -364,15 +380,17 @@     geometryOf _ = id
 
     go :: RenderContext px
-       -> Drawing px ()
+       -> Free (DrawCommand px) ()
        -> DrawContext s px ()
     go _ (Pure ()) = return ()
     go ctxt (Free (WithTransform trans sub next)) = do
         let trans'
               | Just (t, _) <- currentTransformation ctxt = t <> trans
               | otherwise = trans
+            invTrans = 
+                fromMaybe mempty $ inverseTransformation trans'
         go ctxt { currentTransformation =
-                        Just (trans', inverseTransformation trans') } sub
+                        Just (trans', invTrans) } $ fromF sub
         go ctxt next
     go ctxt@RenderContext { currentClip = Nothing }
        (Free (Fill method prims next)) = do
@@ -380,15 +398,15 @@         go ctxt next
     go ctxt@RenderContext { currentClip = Just moduler }
        (Free (Fill method prims next)) = do
-        fillWithTextureAndMask method (currentTexture ctxt)
+        fillWithTextureAndMask method (textureOf ctxt)
             moduler $ geometryOf ctxt prims
         go ctxt next
 
     go ctxt (Free (Stroke w j cap prims next)) =
         go ctxt . Free $ Fill FillWinding prim' next
-            where prim' = strokize w j cap prims
+            where prim' = listOfContainer $ strokize w j cap prims
     go ctxt (Free (SetTexture tx sub next)) = do
-        go (ctxt { currentTexture = tx }) sub
+        go (ctxt { currentTexture = tx }) $ fromF sub
         go ctxt next
     go ctxt (Free (DashedStroke o d w j cap prims next)) = do
         let recurse sub =
@@ -411,11 +429,11 @@                               $ VU.toList c | c <- curves]
 
     go ctxt (Free (WithCliping clipPath path next)) = do
-        go (ctxt { currentClip = newModuler }) path
+        go (ctxt { currentClip = newModuler }) $ fromF path
         go ctxt next
       where
         modulationTexture :: Texture (PixelBaseComponent px)
-        modulationTexture = imageTexture $ clipRender clipPath
+        modulationTexture = RawTexture $ clipRender clipPath
 
         newModuler = Just . subModuler $ currentClip ctxt
 
@@ -466,32 +484,53 @@ clip :: Point     -- ^ Minimum point (corner upper left)
      -> Point     -- ^ Maximum point (corner bottom right)
      -> Primitive -- ^ Primitive to be clipped
-     -> [Primitive]
+     -> Container Primitive
 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
 
+isCoverageDrawable :: MutableImage s px -> CoverageSpan -> Bool
+isCoverageDrawable img coverage =
+    _coverageVal coverage > 0 && x >= 0 && y >= 0 && x < imgWidth && y < imgHeight
+  where
+    !imgWidth = fromIntegral $ mutableImageWidth img
+    !imgHeight = fromIntegral $ mutableImageHeight img
+    x = _coverageX coverage
+    y = _coverageY coverage
+
 -- | 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.
-fillWithTexture :: (Pixel px, Modulable (PixelBaseComponent px))
+fillWithTexture :: RenderablePixel px
                 => FillMethod
                 -> Texture px  -- ^ Color/Texture used for the filling
                 -> [Primitive] -- ^ Primitives to fill
                 -> DrawContext s px ()
+{-# SPECIALIZE fillWithTexture
+    :: FillMethod -> Texture PixelRGBA8 -> [Primitive]
+    -> DrawContext s PixelRGBA8 () #-}
+{-# SPECIALIZE fillWithTexture
+    :: FillMethod -> Texture Pixel8 -> [Primitive]
+    -> DrawContext s Pixel8 () #-}
 fillWithTexture fillMethod texture els = do
     img@(MutableImage width height _) <- get
-    let mini = V2 0 0
-        maxi = V2 (fromIntegral width) (fromIntegral height)
-        spans = rasterize fillMethod $ els >>= clip mini maxi
-    lift $ mapM_ (composeCoverageSpan texture img) spans
+    let !mini = V2 0 0
+        !maxi = V2 (fromIntegral width) (fromIntegral height)
+        !filler = transformTextureToFiller texture img
+        clipped = F.foldMap (clip mini maxi) els
+        spans = rasterize fillMethod clipped
+    lift . mapExec filler $ filter (isCoverageDrawable img) spans
 
+mapExec :: Monad m => (a -> m ()) -> [a] -> m ()
+mapExec f = go
+  where
+    go [] = return ()
+    go (x : xs) = f x >> go xs
+
 fillWithTextureAndMask
-    :: ( Pixel px
-       , Pixel (PixelBaseComponent px)
-       , Modulable (PixelBaseComponent px))
+    :: RenderablePixel px
     => FillMethod
     -> Texture px  -- ^ Color/Texture used for the filling
     -> Texture (PixelBaseComponent px)
@@ -499,97 +538,11 @@     -> DrawContext s px ()
 fillWithTextureAndMask fillMethod texture mask els = do
     img@(MutableImage width height _) <- get
-    let mini = V2 0 0
-        maxi = V2 (fromIntegral width) (fromIntegral height)
-        spans = rasterize fillMethod $ els >>= clip mini maxi
-    lift $ mapM_ (composeCoverageSpanWithMask texture mask img) spans
-
-composeCoverageSpan :: forall s px .
-                      ( Pixel px, Modulable (PixelBaseComponent px) )
-                    => Texture px
-                    -> MutableImage s px
-                    -> CoverageSpan
-                    -> ST s ()
-{-# SPECIALIZE
-    composeCoverageSpan
-        :: forall s. 
-           Texture PixelRGBA8
-        -> MutableImage s PixelRGBA8
-        -> CoverageSpan -> ST s () #-}
-{-# SPECIALIZE
-    composeCoverageSpan
-        :: forall s. 
-           Texture Pixel8
-        -> MutableImage s Pixel8
-        -> CoverageSpan -> ST s () #-}
-composeCoverageSpan texture img coverage
-  | initialCov == 0 || initialX < 0 || y < 0 || imgWidth < initialX || imgHeight < y = return ()
-  | otherwise = go 0 initialX initIndex
-  where compCount = componentCount (undefined :: px)
-        maxi = _coverageLength coverage
-        imgData = mutableImageData img
-        y = floor $ _coverageY coverage
-        initialX = floor $ _coverageX coverage
-        imgWidth = mutableImageWidth img
-        imgHeight = mutableImageHeight img
-        initIndex = (initialX + y * imgWidth) * compCount
-        (initialCov, _) =
-            clampCoverage $ _coverageVal coverage
-
-        shader = texture SamplerPad
-
-        go count _   _ | count >= maxi = return ()
-        go count x idx = do
-          oldPixel <- unsafeReadPixel imgData idx
-          let px = shader (fromIntegral x) (fromIntegral y)
-              opacity = pixelOpacity px
-              (cov, icov) = coverageModulate initialCov opacity
-          unsafeWritePixel imgData idx
-            $ compositionAlpha cov icov oldPixel px
-
-          go (count + 1) (x + 1) $ idx + compCount
-
-composeCoverageSpanWithMask
-    :: forall s px
-     . ( Pixel px
-       , Pixel (PixelBaseComponent px)
-       , Modulable (PixelBaseComponent px) )
-    => Texture px
-    -> Texture (PixelBaseComponent px)
-    -> MutableImage s px
-    -> CoverageSpan
-    -> ST s ()
-{-# INLINE composeCoverageSpanWithMask #-}
-composeCoverageSpanWithMask texture mask img coverage
-  | initialCov == 0 || initialX < 0 || y < 0 || imgWidth < initialX || imgHeight < y = return ()
-  | otherwise = go 0 initialX initIndex
-  where compCount = componentCount (undefined :: px)
-        maxi = _coverageLength coverage
-        imgData = mutableImageData img
-        y = floor $ _coverageY coverage
-        initialX = floor $ _coverageX coverage
-        imgWidth = mutableImageWidth img
-        imgHeight = mutableImageHeight img
-        initIndex = (initialX + y * imgWidth) * compCount
-        (initialCov, _) =
-            clampCoverage $ _coverageVal coverage
-
-        maskShader = mask SamplerPad
-        shader = texture SamplerPad
-
-        go count _   _ | count >= maxi = return ()
-        go count x idx = do
-          oldPixel <- unsafeReadPixel imgData idx
-          let fx = fromIntegral x
-              fy = fromIntegral y
-              maskValue = maskShader fx fy
-              px = shader fx fy
-              (coeffMasked, _) = coverageModulate initialCov maskValue
-              (cov, icov) = coverageModulate coeffMasked $ pixelOpacity px
-          unsafeWritePixel imgData idx
-            $ compositionAlpha cov icov oldPixel px
-          go (count + 1) (x + 1) $ idx + compCount
-
+    let !mini = V2 0 0
+        !maxi = V2 (fromIntegral width) (fromIntegral height)
+        spans = rasterize fillMethod $ F.foldMap (clip mini maxi) els
+        !shader = transformTextureToFiller (modulateTexture texture mask) img
+    lift . mapM_ shader $ filter (isCoverageDrawable img) spans
 
 -- | Generate a list of primitive representing a circle.
 --
@@ -664,7 +617,7 @@ --
 -- <<docimages/image_simple.png>>
 --
-drawImage :: (Pixel px, Modulable (PixelBaseComponent px))
+drawImage :: ModulablePixel px
           => Image px       -- ^ Image to be drawn
           -> StrokeWidth    -- ^ Border size, drawn with current texture.
           -> Point          -- ^ Position of the corner upper left of the image.

@@ -1,10 +1,13 @@ {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ConstraintKinds #-}
 -- | Compositor handle the pixel composition, which
 -- leads to texture composition.
 -- Very much a work in progress
 module Graphics.Rasterific.Compositor
     ( Compositor
     , Modulable( .. )
+    , ModulablePixel
+    , RenderablePixel
     , compositionDestination
     , compositionAlpha
     ) where
@@ -18,6 +21,24 @@     (PixelBaseComponent px) ->
         (PixelBaseComponent px) -> px -> px -> px
 
+-- | This constraint ensure that a type is a pixel
+-- and we're allowed to modulate it's color components
+-- generically.
+type ModulablePixel px =
+    (Pixel px, Modulable (PixelBaseComponent px))
+
+-- | 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.
+--
+-- All pixel instances of JuicyPixels should be usable.
+type RenderablePixel px =
+    ( ModulablePixel px
+    , Pixel (PixelBaseComponent px)
+    , PixelBaseComponent (PixelBaseComponent px)
+            ~ (PixelBaseComponent px)
+    )
+
 -- | Typeclass intented at pixel value modulation.
 -- May be throwed out soon.
 class (Ord a, Num a) => Modulable a where
@@ -58,31 +79,41 @@   alphaOver coverage inverseCoverage background painted =
       coverage * painted + background * inverseCoverage
 
+div255 :: Word32 -> Word32
+{-# INLINE div255 #-}
+div255 v = (v + (v `unsafeShiftR` 8)) `unsafeShiftR` 8
+
 instance Modulable Word8 where
+  {-# INLINE emptyValue #-}
   emptyValue = 0
+  {-# INLINE fullValue #-}
   fullValue = 255
+  {-# INLINE clampCoverage #-}
   clampCoverage f = (fromIntegral c, fromIntegral $ 255 - c)
      where c = toWord8 f
 
-  modulate c a = fromIntegral $ (v + (v `unsafeShiftR` 8)) `unsafeShiftR` 8
+  {-# INLINE modulate #-}
+  modulate c a = fromIntegral . div255 $ fi c * fi a + 128
     where fi :: Word8 -> Word32
           fi = fromIntegral
-          v = fi c * fi a + 128
 
+  {-# INLINE modiv #-}
   modiv c 0 = c
   modiv c a = fromIntegral . min 255 $ (fi c * 255) `div` fi a
     where fi :: Word8 -> Word32
           fi = fromIntegral
 
+  {-# INLINE alphaCompose #-}
   alphaCompose coverage inverseCoverage backgroundAlpha _ =
-      fromIntegral $ (v + (v `unsafeShiftR` 8)) `unsafeShiftR` 8
+      fromIntegral $ div255 v
         where fi :: Word8 -> Word32
               fi = fromIntegral
               v = fi coverage * 255
                 + fi backgroundAlpha * fi inverseCoverage + 128
 
+  {-# INLINE alphaOver #-}
   alphaOver coverage inverseCoverage background painted =
-      fromIntegral $ (v + (v `unsafeShiftR` 8)) `unsafeShiftR` 8
+      fromIntegral $ div255 v
     where fi :: Word8 -> Word32
           fi = fromIntegral
           v = fi coverage * fi painted + fi background * fi inverseCoverage + 128

@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE BangPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Graphics.Rasterific.CubicBezier
     ( cubicBezierCircle
@@ -11,25 +12,29 @@     , offsetCubicBezier
     , flattenCubicBezier
     , cubicBezierLengthApproximation
+    , cubicBezierBounds
     ) where
 
 import Prelude hiding( or )
-import Control.Applicative( Applicative
-                          , liftA2
+import Control.Applicative( liftA2
                           , (<$>)
                           , (<*>)
                           , pure
                           )
-import Linear( V1( .. )
+import Graphics.Rasterific.Linear
+             ( V1( .. )
              , V2( .. )
              , (^-^)
              , (^+^)
              , (^*)
              , norm
+             , lerp
              )
-import Data.Monoid( Monoid, mempty, (<>) )
+import Data.List( nub )
+import Data.Monoid( mempty, (<>) )
 import Graphics.Rasterific.Operators
 import Graphics.Rasterific.Types
+import Graphics.Rasterific.QuadraticFormula
 import Graphics.Rasterific.QuadraticBezier( sanitizeBezier )
 
 -- | Create a list of cubic bezier patch from a list of points.
@@ -107,6 +112,44 @@ -- y(t) = (1 - t) ∙y     + 3∙t∙(1 - t) ∙y     + 3∙t ∙(1 - t)∙y     + t ∙y
 --                   0                    1                    2          3
 
+-- | Represent the cubic bezier curve as a vector ready
+-- for matrix multiplication
+data CachedBezier = CachedBezier !Float !Float !Float !Float
+
+cacheBezier :: CubicBezier -> (CachedBezier, CachedBezier)
+cacheBezier (CubicBezier p0@(V2 x0 y0) p1 p2 p3) =
+
+    (CachedBezier x0 bX cX dX, CachedBezier y0 bY cY dY)
+  where
+   V2 bX bY = p1 ^* 3 ^-^ p0 ^* 3
+   V2 cX cY = p2 ^* 3 ^-^ p1 ^* 6 + p0 ^* 3
+   V2 dX dY = p3 ^-^ p2 ^* 3 ^+^ p1 ^* 3 ^-^ p0
+
+cachedBezierAt :: CachedBezier -> Float -> Float
+cachedBezierAt (CachedBezier a b c d) t =
+    a + b * t + c * tSquare + tCube * d
+  where
+    tSquare = t * t
+    tCube = tSquare * t
+
+cachedBezierDerivative :: CachedBezier -> QuadraticFormula Float
+cachedBezierDerivative (CachedBezier _ b c d) =
+    QuadraticFormula (3 * d) (2 * c) b
+
+-- | Find the coefficient of the extremum points
+extremums :: CachedBezier -> [Float]
+extremums cached =
+ nub [ root | root <- formulaRoots $ cachedBezierDerivative cached
+            , 0 <= root && root <= 1.0 ]
+
+extremumPoints :: (CachedBezier, CachedBezier) -> [Point]
+extremumPoints (onX, onY) = toPoints <$> nub (extremums onX <> extremums onY)
+  where toPoints at = V2 (cachedBezierAt onX at) (cachedBezierAt onY at)
+
+cubicBezierBounds :: CubicBezier -> [Point]
+cubicBezierBounds bez@(CubicBezier p0 _ _ p3) =
+    p0 : p3 : extremumPoints (cacheBezier bez)
+
 offsetCubicBezier :: Float -> CubicBezier -> Container Primitive
 offsetCubicBezier offset bezier@(CubicBezier a b c d)
     | isSufficientlyFlat 1 bezier =
@@ -212,61 +255,59 @@ cubicBezierBreakAt (CubicBezier a b c d) val =
     (CubicBezier a ab abbc abbcbccd, CubicBezier abbcbccd bccd cd d)
   where
-    ab = lerpPoint a b val
-    bc = lerpPoint b c val
-    cd = lerpPoint c d val
+    ab = lerp val a b
+    bc = lerp val b c
+    cd = lerp val c d
 
-    abbc = lerpPoint ab bc val
-    bccd = lerpPoint bc cd val
-    abbcbccd = lerpPoint abbc bccd val
+    abbc = lerp val ab bc
+    bccd = lerp val bc cd
+    abbcbccd = lerp val abbc bccd
 
 decomposeCubicBeziers :: CubicBezier -> Container EdgeSample
-decomposeCubicBeziers (CubicBezier a@(V2 ax ay) b c d@(V2 dx dy))
-    | insideX && insideY =
-        pure $ EdgeSample (px + 0.5) (py + 0.5) (w * h) h
-    | otherwise =
-        recurse (CubicBezier a ab abbc m) <>
-            recurse (CubicBezier m bccd cd d)
-  where recurse = decomposeCubicBeziers
-        floorA = vfloor a
-        floorD = vfloor d
-        V2 px py  = fromIntegral <$> vmin floorA floorD
-        V1 w = (px + 1 -) <$>  (V1 dx `midPoint` V1 ax)
-        h = dy - ay
-
-        V2 insideX insideY =
-            floorA ^==^ floorD ^||^ vceil a ^==^ vceil d
+decomposeCubicBeziers (CubicBezier aR bR cR dR) = go aR bR cR dR where
+  go a@(V2 ax ay) _b _c d@(V2 dx dy) | insideX && insideY =
+    pure $ EdgeSample (px + 0.5) (py + 0.5) (w * h) h
+    where
+      !floorA = vfloor a
+      !floorD = vfloor d
+      !(V2 px py)  = fromIntegral <$> vmin floorA floorD
+      !(V1 w) = (px + 1 -) <$>  (V1 dx `midPoint` V1 ax)
+      !h = dy - ay
+      !(V2 insideX insideY) =
+          floorA ^==^ floorD ^||^ vceil a ^==^ vceil d
 
-        --                     BC
-        --         B X----------X---------X C
-        --          /      ___/   \___     \
-        --         /   __X------X------X_   \
-        --        /___/ ABBC       BCCD  \___\
-        --    AB X/                          \X CD
-        --      /                              \
-        --     /                                \
-        --    /                                  \
-        -- A X                                    X D
-        ab = a `midPoint` b
-        bc = b `midPoint` c
-        cd = c `midPoint` d
-        abbc = ab `midPoint` bc
-        bccd = bc `midPoint` cd
+  go a b c d = go a ab abbc m <> go m bccd cd d
+    where 
+      --                     BC
+      --         B X----------X---------X C
+      --          /      ___/   \___     \
+      --         /   __X------X------X_   \
+      --        /___/ ABBC       BCCD  \___\
+      --    AB X/                          \X CD
+      --      /                              \
+      --     /                                \
+      --    /                                  \
+      -- A X                                    X D
+      !ab = a `midPoint` b
+      !bc = b `midPoint` c
+      !cd = c `midPoint` d
+      !abbc = ab `midPoint` bc
+      !bccd = bc `midPoint` cd
 
-        abbcbccd = abbc `midPoint` bccd
+      !abbcbccd = abbc `midPoint` bccd
 
-        mini = fromIntegral <$> vfloor abbcbccd
-        maxi = fromIntegral <$> vceil abbcbccd
-        nearmin = vabs (abbcbccd ^-^ mini) ^< 0.1
-        nearmax = vabs (abbcbccd ^-^ maxi) ^< 0.1
+      mini = fromIntegral <$> vfloor abbcbccd
+      maxi = fromIntegral <$> vceil abbcbccd
+      !nearmin = vabs (abbcbccd ^-^ mini) ^< 0.1
+      !nearmax = vabs (abbcbccd ^-^ maxi) ^< 0.1
 
-        minMaxing mi nearmi ma nearma p
-          | nearmi = mi
-          | nearma = ma
-          | otherwise = p
+      minMaxing mi nearmi ma nearma p
+        | nearmi = mi
+        | nearma = ma
+        | otherwise = p
 
-        m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax
-                      <*> abbcbccd
+      !m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax
+                     <*> abbcbccd
 
 sanitizeCubicBezier :: CubicBezier -> Container Primitive
 sanitizeCubicBezier bezier@(CubicBezier a b c d)
@@ -274,9 +315,9 @@   | a `isDistingableFrom` b &&
     c `isDistingableFrom` d =
        pure . CubicBezierPrim $ bezier
-  | ac `isDistingableFrom` b && 
-     bd `isDistingableFrom` c =
-      pure . CubicBezierPrim $ CubicBezier a ac bd d
+  | (ac `isDistingableFrom` b && 
+     bd `isDistingableFrom` c) =
+      pure . CubicBezierPrim $ bezier
   | ac `isDistingableFrom` b =
       pure . CubicBezierPrim $ CubicBezier a ac c d
   | bd `isDistingableFrom` c =

@@ -1,16 +1,26 @@+{-# LANGUAGE BangPatterns #-}
 -- | Handle straight lines polygon.
 module Graphics.Rasterific.Line
     ( lineFromPath
+    , decomposeLine
     , clipLine
     , sanitizeLine
     , lineBreakAt
     , flattenLine
     , lineLength
+    , offsetLine
     ) where
 
-import Control.Applicative( Applicative, (<$>), pure )
-import Data.Monoid( Monoid, (<>), mempty )
-import Linear( V2( .. ), (^-^), norm )
+import Control.Applicative( (<$>), (<*>), pure )
+import Data.Monoid( (<>), mempty )
+import Graphics.Rasterific.Linear
+             ( V1( .. )
+             , V2( .. )
+             , (^-^)
+             , (^+^)
+             , (^*)
+             , lerp
+             , norm )
 
 import Graphics.Rasterific.Operators
 import Graphics.Rasterific.Types
@@ -34,11 +44,18 @@ 
 lineBreakAt :: Line -> Float -> (Line, Line)
 lineBreakAt (Line a b) t = (Line a ab, Line ab b)
-  where ab = lerpPoint a b t
+  where ab = lerp t a b
 
 flattenLine :: Line -> Container Primitive
 flattenLine = pure . LinePrim
 
+offsetLine :: Float -> Line -> Container Primitive
+offsetLine offset (Line a b) = pure . LinePrim $ Line shiftedA shiftedB
+  where
+   u = a `normal` b
+   shiftedA = a ^+^ (u ^* offset)
+   shiftedB = b ^+^ (u ^* offset)
+
 -- | Clamp the bezier curve inside a rectangle
 -- given in parameter.
 clipLine :: Point     -- ^ Point representing the "minimal" point for cliping
@@ -97,4 +114,36 @@         -- If we're near an edge, snap the component to the
         -- edge.
         m = vpartition (vabs (ab ^-^ edge) ^< 0.1) edge ab
+
+-- TODO: implement better algorithm for lines, should
+-- be doable.
+decomposeLine :: Line -> Container EdgeSample
+decomposeLine (Line aRoot bRoot) = go aRoot bRoot where
+  go !a@(V2 ax ay) !b@(V2 bx by)
+    | insideX && insideY = pure $ EdgeSample (px + 0.5) (py + 0.5) (w * h) h
+      where
+        !floorA = vfloor a
+        !floorB = vfloor b
+        !(V2 insideX insideY) =
+            floorA ^==^ floorB ^||^ vceil a ^==^ vceil b
+
+        !(V2 px py)  = fromIntegral <$> vmin floorA floorB
+        !(V1 w) = (px + 1 -) <$>  (V1 bx `midPoint` V1 ax)
+        !h = by - ay
+
+  go a b = go a m <> go m b
+    where
+      !ab = a `midPoint` b
+
+      !mini = fromIntegral <$> vfloor ab
+      !maxi = fromIntegral <$> vceil ab
+      !nearmin = vabs (ab ^-^ mini) ^< 0.1
+      !nearmax = vabs (ab ^-^ maxi) ^< 0.1
+
+      minMaxing mi nearmi ma nearma p
+        | nearmi = mi
+        | nearma = ma
+        | otherwise = p
+
+      !m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax <*> ab
 

@@ -0,0 +1,227 @@+-- | This module is a reduction of the `Linear` package
+-- from Edward Kmett to match just the need of Rasterific.
+--
+-- If the flag `embed_linear` is disabled, this module is
+-- just a reexport from the real linear package.
+--
+{-# LANGUAGE CPP #-}
+module Graphics.Rasterific.Linear
+    ( V2( .. )
+    , V1( .. )
+    , Additive( .. )
+    , Epsilon( .. )
+    , Metric( .. )
+    , (^*)
+    , (^/)
+    , normalize
+    ) where
+
+#ifdef EXTERNAL_LINEAR
+-- We just reexport
+import Linear
+#else
+
+import Control.Applicative( Applicative, pure, (<*>) )
+
+infixl 6 ^+^, ^-^
+infixl 7 ^*, ^/
+
+-- | 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
+data V2 a = V2 !a !a
+    deriving (Eq, Show)
+
+newtype V1 a = V1 a
+    deriving (Eq, Show)
+
+instance Functor V2 where
+    {-# INLINE fmap #-}
+    fmap f (V2 a b) = V2 (f a) (f b)
+
+instance Num a => Num (V2 a) where
+  (V2 a b) + (V2 a' b') = V2 (a + a') (b + b')
+  {-# INLINE (+) #-}
+  (V2 a b) - (V2 a' b') = V2 (a - a') (b - b')
+  {-# INLINE (-) #-}
+  (V2 a b) * (V2 a' b') = V2 (a * a') (b * b')
+  {-# INLINE (*) #-}
+  negate (V2 a b) = V2 (negate a) (negate b)
+  {-# INLINE negate #-}
+  abs (V2 a b) = V2 (abs a) (abs b)
+  {-# INLINE abs #-}
+  signum (V2 a b) = V2 (signum a) (signum b)
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+instance Functor V1 where
+    {-# INLINE fmap #-}
+    fmap f (V1 a) = V1 $ f a
+
+instance Applicative V2 where
+    {-# INLINE pure #-}
+    pure a = V2 a a
+    {-# INLINE (<*>) #-}
+    (V2 f1 f2) <*> (V2 a b) = V2 (f1 a) (f2 b)
+
+instance Applicative V1 where
+    {-# INLINE pure #-}
+    pure = V1 
+    {-# INLINE (<*>) #-}
+    (V1 f) <*> (V1 v) = V1 $ f v
+
+-- | A vector is an additive group with additional structure.
+class Functor f => Additive f where
+  -- | The zero vector
+  zero :: Num a => f a
+  -- | Compute the sum of two vectors
+  --
+  -- >>> V2 1 2 ^+^ V2 3 4
+  -- V2 4 6
+  (^+^) :: Num a => f a -> f a -> f a
+
+  -- | Compute the difference between two vectors
+  --
+  -- >>> V2 4 5 - V2 3 1
+  -- V2 1 4
+  (^-^) :: Num a => f a -> f a -> f a
+
+  -- | Linearly interpolate between two vectors.
+  lerp :: Num a => a -> f a -> f a -> f a
+
+-- | Provides a fairly subjective test to see if a quantity is near zero.
+--
+-- >>> nearZero (1e-11 :: Double)
+-- False
+--
+-- >>> nearZero (1e-17 :: Double)
+-- True
+--
+-- >>> nearZero (1e-5 :: Float)
+-- False
+--
+-- >>> nearZero (1e-7 :: Float)
+-- True
+class Num a => Epsilon a where
+  -- | Determine if a quantity is near zero.
+  nearZero :: a -> Bool
+
+-- | @'abs' a '<=' 1e-6@
+instance Epsilon Float where
+  nearZero a = abs a <= 1e-6
+  {-# INLINE nearZero #-}
+
+-- | @'abs' a '<=' 1e-12@
+instance Epsilon Double where
+  nearZero a = abs a <= 1e-12
+  {-# INLINE nearZero #-}
+
+instance Epsilon a => Epsilon (V2 a) where
+  nearZero = nearZero . quadrance
+  {-# INLINE nearZero #-}
+
+instance Additive V2 where
+    zero = V2 0 0
+    {-# INLINE zero #-}
+
+    (V2 a b) ^+^ (V2 a' b') = V2 (a + a') (b + b')
+    {-# INLINE (^+^) #-}
+
+    (V2 a b) ^-^ (V2 a' b') = V2 (a - a') (b - b')
+    {-# INLINE (^-^) #-}
+
+    lerp v a b = a ^+^ (b ^-^ a) ^* v
+    {-# INLINE lerp #-}
+
+instance Additive V1 where
+    zero = V1 0
+    {-# INLINE zero #-}
+
+    (V1 a) ^+^ (V1 a') = V1 (a + a')
+    {-# INLINE (^+^) #-}
+
+    (V1 a) ^-^ (V1 a') = V1 (a - a')
+    {-# INLINE (^-^) #-}
+
+    lerp v a b = a ^+^ (b ^-^ a) ^* v
+    {-# INLINE lerp #-}
+
+-- | Free and sparse inner product/metric spaces.
+class Additive f => Metric f where
+  -- | Compute the inner product of two vectors or (equivalently)
+  -- convert a vector @f a@ into a covector @f a -> a@.
+  --
+  -- >>> V2 1 2 `dot` V2 3 4
+  -- 11
+  dot :: Num a => f a -> f a -> a
+
+  -- | Compute the squared norm. The name quadrance arises from
+  -- Norman J. Wildberger's rational trigonometry.
+  quadrance :: Num a => f a -> a
+  {-# INLINE quadrance #-}
+  quadrance v = dot v v
+
+  -- | Compute the quadrance of the difference
+  qd :: Num a => f a -> f a -> a
+  {-# INLINE qd #-}
+  qd f g = quadrance (f ^-^ g)
+
+  -- | Compute the distance between two vectors in a metric space
+  distance :: Floating a => f a -> f a -> a
+  {-# INLINE distance #-}
+  distance f g = norm (f ^-^ g)
+
+  -- | Compute the norm of a vector in a metric space
+  norm :: Floating a => f a -> a
+  {-# INLINE norm #-}
+  norm v = sqrt (quadrance v)
+
+  -- | Convert a non-zero vector to unit vector.
+  signorm :: Floating a => f a -> f a
+  signorm v = fmap (/ m) v where
+    m = norm v
+
+instance Metric V2 where
+    dot (V2 a b) (V2 a' b') = a * a' + b * b'
+    {-# INLINE dot #-}
+
+    quadrance (V2 a b) = a * a + b * b
+    {-# INLINE quadrance #-}
+
+    norm v = sqrt (quadrance v)
+    {-# INLINE norm #-}
+
+-- | Compute the right scalar product
+--
+-- >>> V2 3 4 ^* 2
+-- V2 6 8
+(^*) :: (Functor f, Num a) => f a -> a -> f a
+{-# INLINE (^*) #-}
+(^*) f n = fmap (* n) f
+
+-- | Compute division by a scalar on the right.
+(^/) :: (Functor f, Floating a) => f a -> a -> f a
+{-# INLINE (^/) #-}
+(^/) f n = fmap (/ n) f
+
+-- | Normalize a 'Metric' functor to have unit 'norm'. This function
+-- does not change the functor if its 'norm' is 0 or 1.
+normalize :: (Floating a, Metric f, Epsilon a) => f a -> f a
+{-# INLINE normalize #-}
+normalize v = if nearZero l || nearZero (1-l) then v
+             else fmap (/ sqrt l) v
+  where l = quadrance v
+
+#endif
+

@@ -18,7 +18,6 @@     , vceil
     , clampPoint
     , midPoint
-    , lerpPoint
     , vpartition 
     , normal
     , ifZero
@@ -32,12 +31,11 @@                           , (<$>)
                           )
 
-import Linear( V2( .. )
+import Graphics.Rasterific.Linear
+             ( V2( .. )
              , Additive( .. )
-             {-, Metric( .. )-}
              , Epsilon( nearZero )
              , (^+^)
-             {-, (^/)-}
              , (^*)
              , dot
              , normalize
@@ -122,10 +120,6 @@ midPoint :: (Additive a) => a Float -> a Float -> a Float
 {-# INLINE midPoint #-}
 midPoint a b = (a ^+^ b) ^* 0.5
-
-lerpPoint :: (Additive a) => a Float -> a Float -> Float -> a Float
-{-# INLINE lerpPoint #-}
-lerpPoint a b v = a ^+^ (b ^-^ a) ^* v
 
 -- | Given a boolean choice vector, return elements of
 -- the first one if true, of the second one otherwise.

@@ -0,0 +1,28 @@+-- | This module provide helper functions to create outline
+-- of  shapes.
+module Graphics.Rasterific.Outline
+    ( strokize
+    , S.dashedStrokize 
+    ) where
+
+import Graphics.Rasterific.Types
+import qualified Graphics.Rasterific.StrokeInternal as S
+
+-- | This function will create the outline of a given geometry
+-- given a path. You can then stroke it.
+--
+-- > stroke 3 (JoinMiter 0) (CapStraight 0, CapStraight 0) $
+-- >     strokize 40 JoinRound (CapRound, CapRound)
+-- >       [CubicBezierPrim $
+-- >            CubicBezier (V2  40 160) (V2 40   40)
+-- >                        (V2 160  40) (V2 160 160)]
+--
+-- <<docimages/strokize_path.png>>
+--
+strokize :: StrokeWidth -- ^ Stroke width
+         -> Join        -- ^ Which kind of join will be used
+         -> (Cap, Cap)  -- ^ Start and end capping.
+         -> [Primitive] -- ^ List of elements to strokize
+         -> [Primitive]
+strokize w j c = listOfContainer . S.strokize w j c
+

@@ -0,0 +1,64 @@+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+-- | Module implementing types used for geometry
+-- bound calculations.
+module Graphics.Rasterific.PlaneBoundable ( PlaneBound( .. )
+                                          , PlaneBoundable( .. ) ) where
+
+import Control.Applicative( (<$>), (<*>) )
+import Data.Monoid( Monoid( .. ), (<>) )
+import Data.Foldable( foldMap )
+
+import Graphics.Rasterific.Linear( V2( .. ) )
+import Graphics.Rasterific.Types
+import Graphics.Rasterific.CubicBezier
+
+-- | 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.
+data PlaneBound = PlaneBound
+    { -- | Corner upper left of the bounding box of
+      -- the considered primitives.
+      _planeMinBound :: !Point
+      -- | Corner lower right of the bounding box of
+      -- the considered primitives.
+    , _planeMaxBound :: !Point
+    }
+    deriving (Eq, Show)
+
+instance Monoid PlaneBound where
+  mempty = PlaneBound infPoint negInfPoint
+    where
+      infPoint = V2 (1 / 0) (1 / 0)
+      negInfPoint = V2 (negate 1 / 0) (negate 1 / 0)
+
+  mappend (PlaneBound mini1 maxi1) (PlaneBound mini2 maxi2) =
+    PlaneBound (min <$> mini1 <*> mini2)
+               (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.
+class PlaneBoundable a where
+    -- | Given a graphical elements, calculate it's bounds.
+    planeBounds :: a -> PlaneBound
+
+instance PlaneBoundable Point where
+    planeBounds a = PlaneBound a a
+
+instance PlaneBoundable Line where
+    planeBounds (Line p1 p2) = planeBounds p1 <> planeBounds p2
+
+instance PlaneBoundable Bezier where
+    planeBounds (Bezier p0 p1 p2) =
+        planeBounds (CubicBezier p0 p1 p1 p2)
+
+instance PlaneBoundable CubicBezier where
+    planeBounds = foldMap planeBounds . cubicBezierBounds
+
+instance PlaneBoundable Primitive where
+    planeBounds (LinePrim l) = planeBounds l
+    planeBounds (BezierPrim b) = planeBounds b
+    planeBounds (CubicBezierPrim c) = planeBounds c
+

@@ -1,5 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns #-}
 -- | Module handling math regarding the handling of quadratic
 -- and cubic bezier curve.
 module Graphics.Rasterific.QuadraticBezier
@@ -15,17 +16,16 @@     , bezierLengthApproximation
     ) where
 
-import Control.Applicative( (<$>)
-                          , (<*>)
-                          , Applicative
-                          , pure )
-import Linear( V2( .. )
+import Control.Applicative( (<$>), (<*>), pure )
+import Graphics.Rasterific.Linear
+             ( V2( .. )
              , V1( .. )
              , (^-^)
              , (^+^)
              , (^*)
              , dot
              , norm
+             , lerp
              )
 import Data.Monoid( Monoid( mempty ), (<>) )
 import Graphics.Rasterific.Operators
@@ -48,38 +48,38 @@ bezierLengthApproximation (Bezier a _ c) =
     norm $ c ^-^ a
 
-decomposeBeziers :: Bezier -> [EdgeSample]
-decomposeBeziers (Bezier a@(V2 ax ay) b c@(V2 cx cy))
-    | insideX && insideY = [EdgeSample (px + 0.5) (py + 0.5) (w * h) h]
-    | otherwise = recurse (Bezier a ab m) <>
-                        recurse (Bezier m bc c)
-  where floorA = vfloor a
-        floorC = vfloor c
-        V2 px py  = fromIntegral <$> vmin floorA floorC
-        V1 w = (px + 1 -) <$>  (V1 cx `midPoint` V1 ax)
-        h = cy - ay
-
-        recurse = decomposeBeziers
-
-        V2 insideX insideY =
+decomposeBeziers :: Bezier -> Container EdgeSample
+decomposeBeziers (Bezier aRoot bRoot cRoot) = go aRoot bRoot cRoot where
+  go !a@(V2 ax ay) !_ !c@(V2 cx cy)
+    | insideX && insideY = pure $ EdgeSample (px + 0.5) (py + 0.5) (w * h) h
+      where
+        !floorA = vfloor a
+        !floorC = vfloor c
+        !(V2 insideX insideY) =
             floorA ^==^ floorC ^||^ vceil a ^==^ vceil c
 
-        ab = a `midPoint` b
-        bc = b `midPoint` c
-        abbc = ab `midPoint` bc
+        !(V2 px py)  = fromIntegral <$> vmin floorA floorC
+        !(V1 w) = (px + 1 -) <$>  (V1 cx `midPoint` V1 ax)
+        !h = cy - ay
 
-        mini = fromIntegral <$> vfloor abbc
-        maxi = fromIntegral <$> vceil abbc
-        nearmin = vabs (abbc ^-^ mini) ^< 0.1
-        nearmax = vabs (abbc ^-^ maxi) ^< 0.1
+  go a b c = go a ab m <> go m bc c
+    where
+      !ab = a `midPoint` b
+      !bc = b `midPoint` c
+      !abbc = ab `midPoint` bc
 
-        minMaxing mi nearmi ma nearma p
-          | nearmi = mi
-          | nearma = ma
-          | otherwise = p
+      !mini = fromIntegral <$> vfloor abbc
+      !maxi = fromIntegral <$> vceil abbc
+      !nearmin = vabs (abbc ^-^ mini) ^< 0.1
+      !nearmax = vabs (abbc ^-^ maxi) ^< 0.1
 
-        m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax <*> abbc
+      minMaxing mi nearmi ma nearma p
+        | nearmi = mi
+        | nearma = ma
+        | otherwise = p
 
+      !m = minMaxing <$> mini <*> nearmin <*> maxi <*> nearmax <*> abbc
+
 -- | Create a quadratic bezier curve representing
 -- a straight line.
 straightLine :: Point -> Point -> Bezier
@@ -193,9 +193,9 @@     --     / abbc  \
     --    /         \
     -- A X           X C
-    ab = lerpPoint a b t
-    bc = lerpPoint b c t
-    abbc = lerpPoint ab bc t
+    ab = lerp t a b
+    bc = lerp t b c
+    abbc = lerp t ab bc
 
 flattenBezier :: Bezier -> Container Primitive
 flattenBezier bezier@(Bezier a b c)

@@ -0,0 +1,53 @@+module Graphics.Rasterific.QuadraticFormula( QuadraticFormula( .. )
+                                           , discriminant
+                                           , formulaRoots
+                                           ) where
+
+import Control.Applicative( Applicative( .. ) )
+
+-- | Represent an equation `a * x^2 + b * x + c = 0`
+data QuadraticFormula a = QuadraticFormula
+    { _coeffA :: !a -- ^ Coefficient for the square part (x^2)
+    , _coeffB :: !a -- ^ Coefficient the linear part (x)
+    , _coeffC :: !a -- ^ Constant
+    }
+
+instance Functor QuadraticFormula where
+    {-# INLINE fmap #-}
+    fmap f (QuadraticFormula a b c) =
+        QuadraticFormula (f a) (f b) (f c)
+
+
+
+instance Applicative QuadraticFormula where
+  pure a = QuadraticFormula a a a
+  {-# INLINE pure #-}
+
+  QuadraticFormula a b c <*> QuadraticFormula d e f =
+      QuadraticFormula (a d) (b e) (c f)
+  {-# INLINE (<*>) #-}
+
+-- | Discriminant equation, if the result is:
+--
+--  * Below 0, then the formula doesn't have any solution
+--
+--  * Equal to 0, then the formula has an unique root.
+--
+--  * Above 0, the formula has two solutions
+--
+discriminant :: Num a => QuadraticFormula a -> a
+discriminant (QuadraticFormula a b c) = b * b - 4 * a *c
+
+-- | Extract all the roots of the formula ie. where the
+-- unknown gives a result of 0
+formulaRoots :: (Ord a, Floating a) => QuadraticFormula a -> [a]
+formulaRoots formula@(QuadraticFormula a b _)
+  | disc < 0 = []
+  | disc == 0 = [positiveResult]
+  | otherwise = [positiveResult, negativeResult]
+  where
+    disc = discriminant formula
+    squarePart = sqrt disc
+    positiveResult = (negate b + squarePart) / (2 * a)
+    negativeResult = (negate b - squarePart) / (2 * a)
+

@@ -1,13 +1,18 @@+{-# LANGUAGE BangPatterns #-}
 module Graphics.Rasterific.Rasterize
     ( CoverageSpan( .. )
     , rasterize
     ) where
 
+import Control.Monad.ST( runST )
 import Data.Fixed( mod' )
-import Data.List( mapAccumL, sortBy )
+import Data.Foldable( foldMap )
 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
 
 data CoverageSpan = CoverageSpan
     { _coverageX      :: {-# UNPACK #-} !Float
@@ -17,31 +22,45 @@     }
     deriving Show
 
-combineEdgeSamples :: (Float -> Float) -> [EdgeSample] -> [CoverageSpan]
+combineEdgeSamples :: (Float -> Float) -> V.Vector EdgeSample
+                   -> [CoverageSpan]
 {-# INLINE combineEdgeSamples #-}
-combineEdgeSamples prepareCoverage = append . mapAccumL go (0, 0, 0, 0)
-  where append ((x, y, a, _), lst) =
-            concat lst ++ [CoverageSpan x y (prepareCoverage a) 1]
-
-        go (x, y, a, h) (EdgeSample x' y' a' h')
-          | y == y' && x == x' = ((x', y', a + a', h + h'), [])
-          | y == y' = ((x', y', h + a', h + h'), [p1, p2])
-          | otherwise =
-             ((x', y', a', h'), [CoverageSpan x y (prepareCoverage a) 1])
-               where p1 = CoverageSpan x y (prepareCoverage a) 1
-                     p2 = CoverageSpan (x + 1) y (prepareCoverage h) (x' - x - 1)
+combineEdgeSamples prepareCoverage vec = go 0 0 0 0 0
+  where
+    !maxi = V.length vec
+    go !ix !x !y !a !_h | ix >= maxi = [CoverageSpan x y (prepareCoverage a) 1]
+    go !ix !x !y !a !h = sub (vec `V.unsafeIndex` ix) where
+      sub (EdgeSample x' y' a' h')
+        | y == y' && x == x' = go (ix + 1) x' y' (a + a') (h + h')
+        | y == y' = p1 : p2 : go (ix + 1) x' y' (h + a') (h + h')
+        | otherwise =
+           CoverageSpan x y (prepareCoverage a) 1 : go (ix + 1) x' y' a' h'
+             where p1 = CoverageSpan x y (prepareCoverage a) 1
+                   p2 = CoverageSpan (x + 1) y (prepareCoverage h) (x' - x - 1)
 
-decompose :: Primitive -> [EdgeSample]
-decompose (LinePrim (Line x1 x2)) = decomposeBeziers $ straightLine x1 x2
+decompose :: Primitive -> Container EdgeSample
+decompose (LinePrim l) = decomposeLine l
 decompose (BezierPrim b) = decomposeBeziers b
 decompose (CubicBezierPrim c) = decomposeCubicBeziers c
 
-rasterize :: FillMethod -> [Primitive] -> [CoverageSpan]
+sortEdgeSamples :: [EdgeSample] -> V.Vector EdgeSample
+sortEdgeSamples samples = runST $ do
+    mutableVector <- V.unsafeThaw $ V.fromList samples
+    let xy a b = compare (_sampleY a, _sampleX a) (_sampleY b, _sampleX b)
+    VS.sortBy xy mutableVector
+    V.unsafeFreeze mutableVector
+
+rasterize :: FillMethod -> Container Primitive -> [CoverageSpan]
 rasterize method = 
   case method of
-    FillWinding -> combineEdgeSamples combineWinding . sortBy xy . concatMap decompose
-    FillEvenOdd -> combineEdgeSamples combineEvenOdd . sortBy xy . concatMap decompose
-  where xy a b = compare (_sampleY a, _sampleX a) (_sampleY b, _sampleX b)
-        combineWinding = min 1 . abs
+    FillWinding -> combineEdgeSamples combineWinding 
+                        . sortEdgeSamples
+                        . listOfContainer
+                        . foldMap decompose
+    FillEvenOdd -> combineEdgeSamples combineEvenOdd
+                        . sortEdgeSamples
+                        . listOfContainer
+                        . foldMap decompose
+  where combineWinding = min 1 . abs
         combineEvenOdd cov = abs $ abs (cov - 1) `mod'` 2 - 1
 

@@ -0,0 +1,455 @@+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds #-}
+module Graphics.Rasterific.Shading
+    ( Texture( .. )
+    , Gradient
+    , ShaderFunction
+    , transformTextureToFiller
+    , dumpTexture
+    ) where
+
+import Data.Fixed( mod' )
+import Data.Monoid( (<>) )
+import Graphics.Rasterific.Linear
+             ( V2( .. )
+             , (^-^)
+             , (^/)
+             , dot
+             , norm
+             )
+
+import Control.Monad.ST( ST )
+import qualified Data.Vector as V
+
+import Codec.Picture.Types( Pixel( .. )
+                          , Image( .. )
+                          , MutableImage( .. )
+                          , Pixel8
+                          , PixelRGBA8
+                          )
+import Graphics.Rasterific.Types( Point
+                                , Vector
+                                , Line( .. )
+                                , SamplerRepeat( .. ) )
+import Graphics.Rasterific.Transformations
+import Graphics.Rasterific.Rasterize
+import Graphics.Rasterific.Compositor( Modulable( .. )
+                                     , ModulablePixel
+                                     , RenderablePixel
+                                     , compositionAlpha )
+
+type ShaderFunction px = Float -> Float -> px
+
+-- | Reification of texture type
+data Texture px
+  = SolidTexture !px
+  | LinearGradientTexture !(Gradient px) !Line 
+  | RadialGradientTexture !(Gradient px) !Point !Float
+  | RadialGradientWithFocusTexture !(Gradient px) !Point !Float !Point
+  | WithSampler    !SamplerRepeat (Texture px)
+  | WithTextureTransform !Transformation (Texture px)
+  | SampledTexture !(Image px)
+  | RawTexture     !(Image px)
+  | ShaderTexture  !(ShaderFunction px)
+  | ModulateTexture (Texture px) (Texture (PixelBaseComponent px))
+
+dumpTexture :: ( Show px
+               , Show (PixelBaseComponent px)
+               , PixelBaseComponent (PixelBaseComponent px)
+                    ~ (PixelBaseComponent px)
+               ) => Texture px -> String
+dumpTexture (SolidTexture px) = "uniformTexture (" ++ show px++ ")"
+dumpTexture (LinearGradientTexture grad (Line a b)) =
+    "linearGradientTexture " ++ show grad ++ " (" ++ show a ++ ") (" ++ show b ++ ")"
+dumpTexture (RadialGradientTexture grad p rad) =
+    "radialGradientTexture " ++ show grad ++ " (" ++ show p ++ ") " ++ show rad
+dumpTexture (RadialGradientWithFocusTexture grad center rad focus) =
+    "radialGradientWithFocusTexture " ++ show grad ++ " (" ++ show center 
+                                      ++ ") " ++ show rad ++ " (" ++ show focus ++ ")"
+dumpTexture (WithSampler sampler sub) =
+    "withSampler " ++ show sampler ++ " (" ++ dumpTexture sub ++ ")"
+dumpTexture (WithTextureTransform trans sub) =
+    "transformTexture (" ++ show trans ++ ") (" ++ dumpTexture sub ++ ")"
+dumpTexture (SampledTexture _) = "sampledImageTexture <IMG>"
+dumpTexture (RawTexture _) = "<RAWTEXTURE>"
+dumpTexture (ShaderTexture _) = "shaderFunction <FUNCTION>"
+dumpTexture (ModulateTexture sub mask) =
+    "modulateTexture (" ++ dumpTexture sub ++ ") ("
+                        ++ dumpTexture mask ++ ")"
+
+
+data TextureSpaceInfo = TextureSpaceInfo
+    { _tsStart     :: {-# UNPACK #-} !Point
+    , _tsDelta     :: {-# UNPACK #-} !Vector
+    , _tsCoverage  :: {-# UNPACK #-} !Float
+    , _tsRepeat    :: {-# UNPACK #-} !Int
+    , _tsBaseIndex :: {-# UNPACK #-} !Int
+    }
+    deriving (Eq, Show)
+
+type CoverageFiller s px =
+    MutableImage s px -> CoverageSpan -> ST s ()
+
+type Filler s =
+    TextureSpaceInfo -> ST s ()
+
+solidColor :: forall s px . ModulablePixel px
+           => px -> MutableImage s px -> Filler s
+{-# SPECIALIZE solidColor :: PixelRGBA8 -> MutableImage s PixelRGBA8
+                          -> Filler s #-}
+{-# SPECIALIZE solidColor :: Pixel8 -> MutableImage s Pixel8
+                          -> Filler s #-}
+solidColor color _ tsInfo
+    | pixelOpacity color == emptyValue || _tsCoverage tsInfo <= 0 =
+        return ()
+solidColor color img tsInfo
+    -- We are in the case fully opaque, so we can
+    -- just overwrite what was there before
+    | pixelOpacity color == fullOpacity && _tsCoverage tsInfo >= 1 =
+        go 0 $ _tsBaseIndex tsInfo
+  where
+    !fullOpacity = fullValue :: PixelBaseComponent px
+    !maxi = _tsRepeat tsInfo
+    !compCount = componentCount (undefined :: px)
+    !vectorData = mutableImageData img
+
+    go count _ | count >= maxi = return ()
+    go count writeIndex = do
+      (vectorData `unsafeWritePixel` writeIndex) color
+      go (count + 1) $ writeIndex + compCount
+
+-- We can be transparent, so perform alpha blending.
+solidColor color img tsInfo = go 0 $ _tsBaseIndex tsInfo
+  where
+    !opacity = pixelOpacity color
+    !(scanCoverage,_) = clampCoverage $_tsCoverage tsInfo
+    !(cov, icov) = coverageModulate scanCoverage opacity
+    !maxi = _tsRepeat tsInfo
+    !imgData = mutableImageData img
+    !compCount = componentCount (undefined :: px)
+
+    go count  _ | count >= maxi = return ()
+    go !count !idx = do
+      oldPixel <- unsafeReadPixel imgData idx
+      unsafeWritePixel imgData idx
+        $ compositionAlpha cov icov oldPixel color
+      go (count + 1) $ idx + compCount
+
+shaderFiller :: forall s px . ModulablePixel px
+             => ShaderFunction px -> MutableImage s px
+             -> Filler s
+{-# SPECIALIZE shaderFiller :: ShaderFunction PixelRGBA8
+                            -> MutableImage s PixelRGBA8
+                            -> Filler s #-}
+{-# SPECIALIZE shaderFiller :: ShaderFunction Pixel8
+                            -> MutableImage s Pixel8
+                            -> Filler s #-}
+shaderFiller shader img tsInfo =
+    go 0 (_tsBaseIndex tsInfo) xStart yStart
+  where
+    !(scanCoverage,_) = clampCoverage $_tsCoverage tsInfo
+    !maxi = _tsRepeat tsInfo
+    !imgData = mutableImageData img
+    !compCount = componentCount (undefined :: px)
+    !(V2 xStart yStart) = _tsStart tsInfo
+    !(V2 dx dy) = _tsDelta tsInfo
+
+    go count  _ _ _ | count >= maxi = return ()
+    go !count !idx !x !y = do
+      let !color = shader x y
+          !opacity = pixelOpacity color
+          (cov, icov) = coverageModulate scanCoverage opacity
+      oldPixel <- unsafeReadPixel imgData idx
+      unsafeWritePixel imgData idx
+        $ compositionAlpha cov icov oldPixel color
+      go (count + 1) (idx + compCount) (x + dx) (y + dy)
+
+prepareInfoNoTransform :: (Pixel px)
+                       => MutableImage s px -> CoverageSpan
+                       -> TextureSpaceInfo
+prepareInfoNoTransform img coverage = TextureSpaceInfo
+    { _tsStart     = V2 (_coverageX coverage) (_coverageY coverage)
+    , _tsDelta     = V2 1 0
+    , _tsCoverage  = _coverageVal coverage
+    , _tsRepeat    = floor $ _coverageLength coverage
+    , _tsBaseIndex =
+        mutablePixelBaseIndex img (floor $ _coverageX coverage)
+                                  (floor $ _coverageY coverage)
+    }
+
+prepareInfo :: (Pixel px)
+            => Maybe Transformation -> MutableImage s px -> CoverageSpan
+            -> TextureSpaceInfo
+prepareInfo Nothing img covSpan = prepareInfoNoTransform img covSpan
+prepareInfo (Just t) img covSpan = TextureSpaceInfo
+    { _tsStart     = applyTransformation t
+                   $ V2 (_coverageX covSpan) (_coverageY covSpan)
+    , _tsDelta     = applyVectorTransformation t $ V2 1 0
+    , _tsCoverage  = _coverageVal covSpan
+    , _tsRepeat    = floor $ _coverageLength covSpan
+    , _tsBaseIndex =
+        mutablePixelBaseIndex img (floor $ _coverageX covSpan)
+                                  (floor $ _coverageY covSpan)
+    }
+
+combineTransform :: Maybe Transformation -> Transformation
+                 -> Maybe Transformation
+combineTransform Nothing a = Just a
+combineTransform (Just v) a = Just $ v <> a
+
+withTrans :: Maybe Transformation -> ShaderFunction px
+          -> ShaderFunction px
+withTrans Nothing shader = shader
+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,
+-- like already done for the solid colors.
+shaderOfTexture :: forall px . RenderablePixel px
+                => Maybe Transformation -> SamplerRepeat -> Texture px
+                -> ShaderFunction px
+shaderOfTexture _ _ (SolidTexture px) = \_ _ -> px
+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 
+                                                    radius focus) =
+  withTrans trans
+             $ radialGradientWithFocusShader grad center radius focus
+                                              sampling
+shaderOfTexture trans _ (WithSampler sampler sub) =
+  shaderOfTexture trans sampler sub
+shaderOfTexture trans sampling (WithTextureTransform transform sub) =
+  shaderOfTexture (combineTransform trans transform) sampling sub
+shaderOfTexture trans sampling (SampledTexture img) =
+  withTrans trans $ sampledImageShader img sampling
+shaderOfTexture trans _ (ShaderTexture func) =
+  withTrans trans func
+shaderOfTexture trans _ (RawTexture img) =
+  withTrans trans $ imageShader img
+shaderOfTexture trans sampling (ModulateTexture texture modulation) =
+  modulateTexture (shaderOfTexture trans sampling texture)
+                  (shaderOfTexture trans sampling modulation)
+
+
+-- | This function will interpret the texture description, helping
+-- prepare and optimize the real calculation
+transformTextureToFiller
+    :: RenderablePixel px
+    => Texture px -> CoverageFiller s px
+{-# SPECIALIZE transformTextureToFiller
+        :: Texture PixelRGBA8 -> CoverageFiller s PixelRGBA8 #-}
+transformTextureToFiller texture = go Nothing SamplerPad texture
+  where
+    go _ _ (SolidTexture px) =
+        \img -> solidColor px img . prepareInfoNoTransform img
+    go trans sampling (WithTextureTransform transform sub) =
+        go (combineTransform trans transform) sampling sub
+    go trans _ (WithSampler sampler sub) =
+        go trans sampler sub
+    go trans sampling tex =
+        \img -> shaderFiller shader img . prepareInfo trans img
+            where shader = shaderOfTexture Nothing sampling tex
+
+-- | A gradient definition is just a list of stop
+-- and pixel values. For instance for a simple gradient
+-- of black to white, the finition would be :
+--
+-- > [(0, PixelRGBA8 0 0 0 255), (1, PixelRGBA8 255 255 255 255)]
+-- 
+-- the first stop value must be zero and the last, one.
+--
+type Gradient px = [(Float, px)]
+type GradientArray px = V.Vector (Float, px)
+
+repeatGradient :: Float -> Float
+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
+ 	gradientColorAt :: GradientArray PixelRGBA8 -> Float -> PixelRGBA8 #-}
+gradientColorAt grad at
+    | at <= 0 = snd $ V.head grad
+    | at >= 1.0 = snd $ V.last grad
+    | otherwise = go (0, snd $ V.head grad) 0
+  where
+    !maxi = V.length grad
+    go (prevCoeff, prevValue) ix
+      | ix >= maxi = snd $ V.last grad
+      | at < coeff = mixWith (\_ -> alphaOver cov icov) prevValue px
+      | otherwise = go value $ ix + 1
+      where value@(coeff, px) = grad `V.unsafeIndex` ix
+            zeroToOne = (at - prevCoeff) / (coeff - prevCoeff)
+            (cov, icov) = clampCoverage zeroToOne
+
+gradientColorAtRepeat :: ModulablePixel px
+                      => SamplerRepeat -> GradientArray px -> Float -> px
+{-# SPECIALIZE INLINE
+	gradientColorAtRepeat ::
+		SamplerRepeat -> GradientArray PixelRGBA8 -> Float -> PixelRGBA8 #-}
+gradientColorAtRepeat SamplerPad grad = gradientColorAt grad
+gradientColorAtRepeat SamplerRepeat grad =
+    gradientColorAt grad . repeatGradient
+gradientColorAtRepeat SamplerReflect grad =
+    gradientColorAt grad . reflectGradient
+
+linearGradientShader :: ModulablePixel px
+                     => Gradient px -- ^ Gradient description.
+                     -> Point       -- ^ Linear gradient start point.
+                     -> Point       -- ^ Linear gradient end point.
+                     -> SamplerRepeat
+                     -> ShaderFunction px
+linearGradientShader gradient start end repeating =
+    \x y -> colorAt $ ((V2 x y) `dot` d) - s00
+  where
+    colorAt = gradientColorAtRepeat repeating gradArray
+    gradArray = V.fromList gradient
+    vector = end ^-^ start
+    d = vector ^/ (vector `dot` vector)
+    s00 = start `dot` d
+
+-- | Use another image as a texture for the filling.
+-- Contrary to `imageTexture`, this function perform a bilinear
+-- filtering on the texture.
+--
+sampledImageShader :: forall px.  ModulablePixel px
+                   => Image px -> SamplerRepeat -> ShaderFunction px
+{-# SPECIALIZE
+ 	sampledImageShader :: Image Pixel8 -> SamplerRepeat
+ 	                   -> ShaderFunction Pixel8 #-}
+{-# SPECIALIZE
+ 	sampledImageShader :: Image PixelRGBA8 -> SamplerRepeat
+ 	                   -> ShaderFunction PixelRGBA8 #-}
+sampledImageShader img sampling x y =
+  (at px  py `interpX` at pxn py)
+             `interpY`
+  (at px pyn `interpX` at pxn pyn)
+  where
+   coordSampler SamplerPad maxi v =
+      min (maxi - 1) . max 0 $ floor v
+   coordSampler SamplerReflect maxi v =
+      floor $ abs (abs (v - maxif - 1) `mod'` (2 * maxif) - maxif - 1)
+        where maxif = fromIntegral maxi
+   coordSampler SamplerRepeat maxi v = floor v `mod` maxi
+
+   w = fromIntegral $ imageWidth img
+   h = fromIntegral $ imageHeight img
+
+   clampedX = coordSampler sampling w
+   clampedY = coordSampler sampling h
+
+   px = clampedX x
+   pxn = clampedX $ x + 1
+   py = clampedY y
+   pyn = clampedY $ y + 1
+
+   dx, dy :: Float
+   dx = x - fromIntegral (floor x :: Int)
+   dy = y - fromIntegral (floor y :: Int)
+
+   at :: Int -> Int -> px
+   at xx yy =
+        unsafePixelAt rawData $ (yy * w + xx) * compCount
+
+   (covX, icovX) = clampCoverage dx
+   (covY, icovY) = clampCoverage dy
+
+   interpX = mixWith (const $ alphaOver covX icovX)
+   interpY = mixWith (const $ alphaOver covY icovY)
+
+   compCount = componentCount (undefined :: px)
+   rawData = imageData img
+
+-- | Use another image as a texture for the filling.
+-- This texture use the "nearest" filtering, AKA no
+-- filtering at all.
+imageShader :: forall px. (Pixel px) => Image px -> ShaderFunction px
+{-# SPECIALIZE
+	imageShader :: Image PixelRGBA8 -> ShaderFunction PixelRGBA8 #-}
+{-# SPECIALIZE
+	imageShader :: Image Pixel8 -> ShaderFunction Pixel8 #-}
+imageShader img x y =
+    unsafePixelAt rawData $ (clampedY * w + clampedX) * compCount
+  where
+   clampedX = min (w - 1) . max 0 $ floor x
+   clampedY = min (h - 1) . max 0 $ floor y
+   !compCount = componentCount (undefined :: px)
+   !w = imageWidth img
+   !h = imageHeight img
+   !rawData = imageData img
+
+radialGradientShader :: ModulablePixel px
+                     => Gradient px -- ^ Gradient description
+                     -> Point       -- ^ Radial gradient center
+                     -> Float       -- ^ Radial gradient radius
+                     -> SamplerRepeat
+                     -> ShaderFunction px
+radialGradientShader gradient center radius repeating =
+    \x y -> colorAt $ norm ((V2 x y) ^-^ center) / radius
+  where
+    !colorAt = gradientColorAtRepeat repeating gradArray
+    !gradArray = V.fromList gradient
+
+radialGradientWithFocusShader
+    :: ModulablePixel px
+    => Gradient px -- ^ Gradient description
+    -> Point      -- ^ Radial gradient center
+    -> Float      -- ^ Radial gradient radius
+    -> Point      -- ^ Radial gradient focus point
+    -> SamplerRepeat
+    -> ShaderFunction px
+radialGradientWithFocusShader gradient center radius focusScreen repeating =
+    \x y -> colorAt . go $ (V2 x y) ^-^ center
+  where
+    focus@(V2 origFocusX origFocusY) = focusScreen ^-^ center
+    colorAt = gradientColorAtRepeat repeating gradArray
+    gradArray = V.fromList gradient
+    radiusSquared = radius * radius
+    dist = sqrt $ focus `dot` focus
+    clampedFocus@(V2 focusX focusY)
+        | dist <= r = focus
+        | otherwise = V2 (r * cos a) (r * sin a)
+           where a = atan2 origFocusY origFocusX
+                 r = radius * 0.99
+    trivial = sqrt $ radiusSquared - origFocusX * origFocusX
+
+    solutionOf (V2 x y) | x == focusX =
+        V2 focusX (if y > focusY then trivial else negate trivial)
+    solutionOf (V2 x y) = V2 xSolution $ slope * xSolution + yint
+      where
+        slope = (y - focusY) / (x - focusX)
+        yint = y - (slope * x)
+
+        a = slope * slope + 1
+        b = 2 * slope * yint
+        c = yint * yint - radiusSquared
+        det = sqrt $ b * b - 4 * a * c
+        xSolution = (-b + (if x < focusX then negate det else det)) / (2 * a)
+
+    go pos = sqrt $ curToFocus / distSquared
+      where
+        solution = solutionOf pos ^-^ clampedFocus
+        toFocus = pos ^-^ clampedFocus
+        distSquared = solution `dot` solution
+        curToFocus = toFocus `dot` toFocus
+
+-- | Perform a multiplication operation between a full color texture
+-- and a greyscale one, used for clip-path implementation.
+modulateTexture :: ModulablePixel px
+                => ShaderFunction px
+                -> ShaderFunction (PixelBaseComponent px)
+                -> ShaderFunction px
+modulateTexture fullTexture modulator = \x y ->
+    colorMap (modulate $ modulator x y) $ fullTexture x y
+

@@ -1,258 +0,0 @@-module Graphics.Rasterific.Stroke
-    ( flatten
-    , dashize
-    , strokize
-    , dashedStrokize
-    )  where
-
-import Control.Applicative( Applicative, (<$>), pure )
-import Data.Monoid( Monoid, (<>), mempty )
-import Data.Foldable( Foldable, foldMap )
-import Linear( V2( .. )
-             , (^-^)
-             , (^+^)
-             , (^*)
-             , dot
-             )
-
-import Graphics.Rasterific.Operators
-import Graphics.Rasterific.Types
-import Graphics.Rasterific.QuadraticBezier
-import Graphics.Rasterific.CubicBezier
-import Graphics.Rasterific.Line
-
-lastPoint :: Primitive -> Point
-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 (CubicBezierPrim (CubicBezier _ _ c d)) = (d, c `normal` d)
-
-firstPointAndNormal :: Primitive -> (Point, Vector)
-firstPointAndNormal (LinePrim (Line a b)) = (a, a `normal` b)
-firstPointAndNormal (BezierPrim (Bezier a b _)) = (a, a `normal` b)
-firstPointAndNormal (CubicBezierPrim (CubicBezier a b _ _)) = (a, a `normal` b)
-
-reversePrimitive :: Primitive -> Primitive
-reversePrimitive (LinePrim (Line a b)) = (LinePrim (Line b a))
-reversePrimitive (BezierPrim (Bezier a b c)) =
-    (BezierPrim (Bezier c b a))
-reversePrimitive (CubicBezierPrim (CubicBezier a b c d)) =
-    (CubicBezierPrim (CubicBezier d c b a))
-
--- | Create a "rounded" join or cap
-roundJoin :: Float -> Point -> Vector -> Vector -> Container Primitive
-roundJoin offset p = go
-  where go u v
-          -- If we're already on a nice curvature,
-          -- don't bother doing anything
-          | u `dot` w >= 0.9 = pure . BezierPrim $ Bezier a b c
-          | otherwise = go w v <> go u w
-          where --     ^
-                --     |w
-                -- a X---X c
-                --    \ /
-                --     Xp
-                -- ^  / \  ^
-                -- u\/   \/v
-                --  /     \
-                a = p ^+^ u ^* offset
-                c = p ^+^ v ^* offset
-
-                w = (a `normal` c) `ifZero` u
-
-                -- Same as offseting
-                n = p ^+^ w ^* offset
-                b = n ^* 2 ^-^ (a `midPoint` c)
-
--- | Put a cap at the end of a bezier curve, depending
--- on the kind of cap wanted.
-cap :: Float -> Cap -> Primitive -> Container Primitive
-cap offset CapRound prim = roundJoin offset p u (- u)
-  where (p, u) = lastPointAndNormal prim
-
-cap offset (CapStraight cVal) prim =
-   pure (d `lineFromTo` e) <> pure (e `lineFromTo` f)
-                           <> pure (f `lineFromTo` g)
-  where -- The usual "normal"
-        (p, u@(V2 ux uy)) = lastPointAndNormal prim
-        -- Vector pointing in the direction of the curve
-        -- of norm 1
-        v = V2 uy $ negate ux
-
-        -- Finishing points around the edge
-        -- -u*offset u*offset
-        --       <-><->
-        --     d/  /  /g
-        --     /  /  /
-        --    /  /  /
-        --      /
-        --     / curve
-        --
-        d = p ^+^ u ^* offset
-        g = p ^-^ u ^* offset
-
-        -- Create the "far" points
-        --
-        --       e        f
-        --        /     /   ^
-        --       /     /   / v * offset * cVal
-        --     d/  /  /g
-        --     /  /  /
-        --    /  /  /
-        --      /
-        --     / curve
-        --
-        e = d ^+^ v ^* (offset * cVal)
-        f = g ^+^ v ^* (offset * cVal)
-
-lineFromTo :: Point -> Point -> Primitive
-lineFromTo a b = LinePrim (Line a b)
-
-miterJoin :: Float -> Float -> Point -> Vector -> Vector
-          -> Container Primitive
-miterJoin offset l point u v
-  | uDotW > l / max 1 l && uDotW > 0 =
-      pure (m `lineFromTo` c) <> pure (a `lineFromTo` m)
-  -- A simple straight junction
-  | otherwise = pure $ a `lineFromTo` c
-  where --      X m
-        --     /\
-        --    /|w\
-        -- a X---X c
-        --    \ /
-        --     Xp
-        -- ^  / \  ^
-        -- u\/   \/v
-        --  /     \
-        a = point ^+^ u ^* offset
-        c = point ^+^ v ^* offset
-        w = (a `normal` c) `ifZero` u
-
-        uDotW =  u `dot` w
-
-        -- Calculate the maximum distance on the
-        -- u axis
-        p = offset / uDotW
-        -- middle point for "straight joining"
-        m = point + w ^* p
-
-joinPrimitives :: StrokeWidth -> Join -> Primitive -> Primitive
-               -> Container Primitive
-joinPrimitives offset join prim1 prim2  =
-  case join of
-    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 (Line x1 x2)) =
-    offsetPrimitives offset . BezierPrim $ straightLine x1 x2
-offsetPrimitives offset (BezierPrim b) = offsetBezier offset b
-offsetPrimitives offset (CubicBezierPrim c) = offsetCubicBezier offset c
-
-offsetAndJoin :: Float -> Join -> Cap -> [Primitive]
-              -> Container Primitive
-offsetAndJoin _ _ _ [] = mempty
-offsetAndJoin offset join caping (firstShape:rest) = go firstShape rest
-  where joiner = joinPrimitives offset join
-        offseter = offsetPrimitives offset
-        (firstPoint, _) = firstPointAndNormal firstShape
-
-        go prev []
-           | firstPoint `isNearby` lastPoint prev = joiner prev firstShape <> offseter prev
-           | otherwise = cap offset caping prev <> offseter prev
-        go prev (x:xs) =
-             joiner prev x <> offseter prev <> go x xs
-
-approximateLength :: Primitive -> Float
-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 (CubicBezierPrim c) = sanitizeCubicBezier c
-
-strokize :: StrokeWidth -> Join -> (Cap, Cap) -> [Primitive]
-         -> [Primitive]
-strokize width join (capStart, capEnd) beziers =
-    offseter capEnd sanitized <>
-        offseter capStart (reverse $ reversePrimitive <$> sanitized)
-  where sanitized = foldMap sanitize beziers
-        offseter = offsetAndJoin (width / 2) join
-
-flattenPrimitive :: Primitive -> Container Primitive
-flattenPrimitive (BezierPrim bezier) = flattenBezier bezier
-flattenPrimitive (CubicBezierPrim bezier) = flattenCubicBezier bezier
-flattenPrimitive (LinePrim line) = flattenLine line
-
-breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive)
-breakPrimitiveAt (BezierPrim bezier) at = (BezierPrim a, BezierPrim b)
-  where (a, b) = bezierBreakAt bezier at
-breakPrimitiveAt (CubicBezierPrim bezier) at = (CubicBezierPrim a, CubicBezierPrim b)
-  where (a, b) = cubicBezierBreakAt bezier at
-breakPrimitiveAt (LinePrim line) at = (LinePrim a, LinePrim b)
-  where (a, b) = lineBreakAt line at
-
-
-flatten :: Container Primitive -> Container Primitive
-flatten = foldMap flattenPrimitive
-
-splitPrimitiveUntil :: Float -> [Primitive] -> ([Primitive], [Primitive])
-splitPrimitiveUntil at = go at
-  where
-    go _ [] = ([], [])
-    go left lst
-      | left <= 0 = ([], lst)
-    go left (x : xs)
-      | left > primLength = (x : inInterval, afterInterval)
-      | otherwise = ([beforeStop], afterStop : xs)
-      where
-        primLength = approximateLength x
-        (inInterval, afterInterval) = go (left - primLength) xs
-
-        (beforeStop, afterStop) =
-            breakPrimitiveAt x $ left / primLength
-
-dropPattern :: Float -> DashPattern -> DashPattern
-dropPattern = go
-  where
-    go _ [] = []
-    go offset (x:xs)
-        | x < 0 = (x:xs) -- sanitizing
-        | offset < x = x - offset : xs
-        | otherwise {- offset >= x -} = go (offset - x) xs
-
-dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]]
-dashize offset pattern =
-    taker infinitePattern . concatMap flattenPrimitive . concatMap sanitize
-  where
-    realOffset | offset >= 0 = offset
-               | otherwise = offset + sum pattern
-
-    infinitePattern =
-        dropPattern realOffset . cycle $ filter (> 0) pattern
-
-    taker _ [] = []
-    taker [] _ = [] -- Impossible by construction, pattern is infinite
-    taker (atValue:atRest) stream = toKeep : droper atRest next
-      where (toKeep, next) = splitPrimitiveUntil atValue stream
-
-    droper _ [] = []
-    droper [] _ = [] -- Impossible by construction, pattern is infinite
-    droper (atValue:atRest) stream = taker atRest next
-      where (_toKeep, next) = splitPrimitiveUntil atValue stream
-
-dashedStrokize :: Float -> DashPattern -> StrokeWidth
-               -> Join -> (Cap, Cap) -> [Primitive]
-               -> [[Primitive]]
-dashedStrokize offset dashPattern width join capping beziers =
-    strokize width join capping <$> dashize offset dashPattern beziers
-

@@ -0,0 +1,278 @@+module Graphics.Rasterific.StrokeInternal
+    ( flatten
+    , dashize
+    , strokize
+    , dashedStrokize
+    )  where
+
+import Control.Applicative( (<$>), pure )
+import Data.Monoid( (<>), mempty )
+import Data.Foldable( foldMap )
+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
+
+lastPoint :: Primitive -> Point
+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 (CubicBezierPrim (CubicBezier _ _ c d)) = (d, c `normal` d)
+
+firstPointAndNormal :: Primitive -> (Point, Vector)
+firstPointAndNormal (LinePrim (Line a b)) = (a, a `normal` b)
+firstPointAndNormal (BezierPrim (Bezier a b _)) = (a, a `normal` b)
+firstPointAndNormal (CubicBezierPrim (CubicBezier a b _ _)) = (a, a `normal` b)
+
+reversePrimitive :: Primitive -> Primitive
+reversePrimitive (LinePrim (Line a b)) = (LinePrim (Line b a))
+reversePrimitive (BezierPrim (Bezier a b c)) =
+    (BezierPrim (Bezier c b a))
+reversePrimitive (CubicBezierPrim (CubicBezier a b c d)) =
+    (CubicBezierPrim (CubicBezier d c b a))
+
+-- | Create a "rounded" join or cap
+roundJoin :: Float -> Point -> Vector -> Vector -> Container Primitive
+roundJoin offset p = go
+  where go u v
+          -- If we're already on a nice curvature,
+          -- don't bother doing anything
+          | u `dot` w >= 0.9 = pure . BezierPrim $ Bezier a b c
+          | otherwise = go u w <> go w v
+          where --     ^
+                --     |w
+                -- a X---X c
+                --    \ /
+                --     Xp
+                -- ^  / \  ^
+                -- u\/   \/v
+                --  /     \
+                a = p ^+^ u ^* offset
+                c = p ^+^ v ^* offset
+
+                w = (a `normal` c) `ifZero` u
+
+                -- Same as offseting
+                n = p ^+^ w ^* offset
+                b = n ^* 2 ^-^ (a `midPoint` c)
+
+-- | Put a cap at the end of a bezier curve, depending
+-- on the kind of cap wanted.
+cap :: Float -> Cap -> Primitive -> Container Primitive
+cap offset CapRound prim = roundJoin offset p u (- u)
+  where (p, u) = lastPointAndNormal prim
+
+cap offset (CapStraight cVal) prim =
+   pure (d `lineFromTo` e) <> pure (e `lineFromTo` f)
+                           <> pure (f `lineFromTo` g)
+  where -- The usual "normal"
+        (p, u@(V2 ux uy)) = lastPointAndNormal prim
+        -- Vector pointing in the direction of the curve
+        -- of norm 1
+        v = V2 uy $ negate ux
+
+        -- Finishing points around the edge
+        -- -u*offset u*offset
+        --       <-><->
+        --     d/  /  /g
+        --     /  /  /
+        --    /  /  /
+        --      /
+        --     / curve
+        --
+        d = p ^+^ u ^* offset
+        g = p ^-^ u ^* offset
+
+        -- Create the "far" points
+        --
+        --       e        f
+        --        /     /   ^
+        --       /     /   / v * offset * cVal
+        --     d/  /  /g
+        --     /  /  /
+        --    /  /  /
+        --      /
+        --     / curve
+        --
+        e = d ^+^ v ^* (offset * cVal)
+        f = g ^+^ v ^* (offset * cVal)
+
+lineFromTo :: Point -> Point -> Primitive
+lineFromTo a b = LinePrim (Line a b)
+
+miterJoin :: Float -> Float -> Point -> Vector -> Vector
+          -> Container Primitive
+miterJoin offset l point u v
+  | uDotW > l / max 1 l && uDotW > 0.001 =
+      pure (m `lineFromTo` c) <> pure (a `lineFromTo` m)
+  -- A simple straight junction
+  | otherwise = pure $ a `lineFromTo` c
+  where --      X m
+        --     /\
+        --    /|w\
+        -- a X---X c
+        --    \ /
+        --     Xp
+        -- ^  / \  ^
+        -- u\/   \/v
+        --  /     \
+        a = point ^+^ u ^* offset
+        c = point ^+^ v ^* offset
+        w = (a `normal` c) `ifZero` u
+
+        uDotW =  u `dot` w
+
+        -- Calculate the maximum distance on the
+        -- u axis
+        p = offset / uDotW
+        -- middle point for "straight joining"
+        m = point + w ^* p
+
+joinPrimitives :: StrokeWidth -> Join -> Primitive -> Primitive
+               -> Container Primitive
+joinPrimitives offset join prim1 prim2  =
+  case join of
+    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 (CubicBezierPrim c) = offsetCubicBezier offset c
+
+offsetAndJoin :: Float -> Join -> Cap -> [Primitive]
+              -> Container Primitive
+offsetAndJoin _ _ _ [] = mempty
+offsetAndJoin offset join caping (firstShape:rest) = go firstShape rest
+  where joiner = joinPrimitives offset join
+        offseter = offsetPrimitives offset
+        (firstPoint, _) = firstPointAndNormal firstShape
+
+        go prev []
+           | firstPoint `isNearby` lastPoint prev = joiner prev firstShape <> offseter prev
+           | otherwise = offseter prev <> cap offset caping prev
+        go prev (x:xs) =
+             joiner prev x <> offseter prev <> go x xs
+
+approximateLength :: Primitive -> Float
+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 (CubicBezierPrim c) = sanitizeCubicBezier c
+
+strokize :: StrokeWidth -> Join -> (Cap, Cap) -> [Primitive]
+         -> Container Primitive
+strokize width join (capStart, capEnd) beziers =
+    offseter capEnd sanitized <>
+        offseter capStart (reverse $ reversePrimitive <$> sanitized)
+  where 
+        sanitized = foldMap (listOfContainer . sanitize) $ beziers
+        offseter = offsetAndJoin (width / 2) join
+
+flattenPrimitive :: Primitive -> Container Primitive
+flattenPrimitive (BezierPrim bezier) = flattenBezier bezier
+flattenPrimitive (CubicBezierPrim bezier) = flattenCubicBezier bezier
+flattenPrimitive (LinePrim line) = flattenLine line
+
+breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive)
+breakPrimitiveAt (BezierPrim bezier) at = (BezierPrim a, BezierPrim b)
+  where (a, b) = bezierBreakAt bezier at
+breakPrimitiveAt (CubicBezierPrim bezier) at = (CubicBezierPrim a, CubicBezierPrim b)
+  where (a, b) = cubicBezierBreakAt bezier at
+breakPrimitiveAt (LinePrim line) at = (LinePrim a, LinePrim b)
+  where (a, b) = lineBreakAt line at
+
+
+flatten :: Container Primitive -> Container Primitive
+flatten = foldMap flattenPrimitive
+
+splitPrimitiveUntil :: Float -> [Primitive] -> ([Primitive], [Primitive])
+splitPrimitiveUntil at = go at
+  where
+    go _ [] = ([], [])
+    go left lst
+      | left <= 0 = ([], lst)
+    go left (x : xs)
+      | left > primLength = (x : inInterval, afterInterval)
+      | otherwise = ([beforeStop], afterStop : xs)
+      where
+        primLength = approximateLength x
+        (inInterval, afterInterval) = go (left - primLength) xs
+
+        (beforeStop, afterStop) =
+            breakPrimitiveAt x $ left / primLength
+
+dropPattern :: Float -> DashPattern -> DashPattern
+dropPattern = go
+  where
+    go _ [] = []
+    go offset (x:xs)
+        | x < 0 = (x:xs) -- sanitizing
+        | offset < x = x - offset : xs
+        | otherwise {- offset >= x -} = go (offset - x) xs
+
+dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]]
+dashize offset pattern =
+    taker infinitePattern . listOfContainer 
+                          . foldMap flattenPrimitive
+                          . foldMap sanitize
+  where
+    realOffset | offset >= 0 = offset
+               | otherwise = offset + sum pattern
+
+    infinitePattern =
+        dropPattern realOffset . cycle $ filter (> 0) pattern
+
+    taker _ [] = []
+    taker [] _ = [] -- Impossible by construction, pattern is infinite
+    taker (atValue:atRest) stream = toKeep : droper atRest next
+      where (toKeep, next) = splitPrimitiveUntil atValue stream
+
+    droper _ [] = []
+    droper [] _ = [] -- Impossible by construction, pattern is infinite
+    droper (atValue:atRest) stream = taker atRest next
+      where (_toKeep, next) = splitPrimitiveUntil atValue stream
+
+-- | Create a list of outlines corresponding to all the
+-- dashed elements. They can be then stroked
+--
+-- > mapM_ (stroke 3 (JoinMiter 0) (CapStraight 0, CapStraight 0)) $
+-- >     dashedStrokize 0 [10, 5]
+-- >                    40 JoinRound (CapStraight 0, CapStraight 0)
+-- >       [CubicBezierPrim $
+-- >            CubicBezier (V2  40 160) (V2 40   40)
+-- >                        (V2 160  40) (V2 160 160)]
+--
+-- <<docimages/strokize_dashed_path.png>>
+--
+dashedStrokize :: Float       -- ^ Starting offset
+               -> DashPattern -- ^ Dashing pattern to use for stroking
+               -> StrokeWidth -- ^ Stroke width
+               -> Join        -- ^ Which kind of join will be used
+               -> (Cap, Cap)  -- ^ Start and end capping.
+               -> [Primitive] -- ^ List of elements to transform
+               -> [[Primitive]]
+dashedStrokize offset dashPattern width join capping beziers =
+    listOfContainer . strokize width join capping
+        <$> dashize offset dashPattern beziers
+

@@ -14,7 +14,6 @@     , linearGradientTexture
     , radialGradientTexture
     , radialGradientWithFocusTexture
-    , imageTexture
     , sampledImageTexture
 
       -- * Texture manipulation
@@ -22,31 +21,14 @@     , transformTexture 
     ) where
 
-import Data.Fixed( mod' )
-import Linear( V2( .. )
-             , (^-^)
-             , (^/)
-             , dot
-             , norm
-             )
 
-import qualified Data.Vector as V
-
 import Codec.Picture.Types( Pixel( .. )
                           , Image( .. )
-                          , Pixel8
-                          , PixelRGBA8
                           )
-import Graphics.Rasterific.Types( Point, SamplerRepeat( .. ) )
+import Graphics.Rasterific.Types( Point, SamplerRepeat( .. ), Line( .. ) )
+import Graphics.Rasterific.Shading
 import Graphics.Rasterific.Transformations
-import Graphics.Rasterific.Compositor( Modulable( clampCoverage, modulate, alphaOver ) )
 
--- | A texture is just a function which given pixel coordinate
--- give back a pixel.
--- The float coordinate type allow for transformations
--- to happen in the pixel space.
-type Texture px = SamplerRepeat -> Float -> Float -> px
-
 -- | Set the repeat pattern of the texture (if any).
 -- With padding:
 --
@@ -72,7 +54,7 @@ -- <<docimages/sampled_texture_reflect.png>>
 --
 withSampler :: SamplerRepeat -> Texture px -> Texture px
-withSampler repeating texture _ = texture repeating
+withSampler = WithSampler
 
 -- | Transform the coordinates used for texture before applying
 -- it, allow interesting transformations.
@@ -86,62 +68,13 @@ -- <<docimages/sampled_texture_scaled.png>>
 --
 transformTexture :: Transformation -> Texture px -> Texture px
-transformTexture trans tx samp x y = tx samp x' y'
-  where
-    (V2 x' y') = applyTransformation trans (V2 x y)
+transformTexture = WithTextureTransform
 
 -- | The uniform texture is the simplest texture of all:
 -- an uniform color.
 uniformTexture :: px -- ^ The color used for all the texture.
                -> Texture px
-uniformTexture px _ _ _ = px
-
--- | A gradient definition is just a list of stop
--- and pixel values. For instance for a simple gradient
--- of black to white, the finition would be :
---
--- > [(0, PixelRGBA8 0 0 0 255), (1, PixelRGBA8 255 255 255 255)]
--- 
--- the first stop value must be zero and the last, one.
---
-type Gradient px = [(Float, px)]
-type GradientArray px = V.Vector (Float, px)
-
-repeatGradient :: Float -> Float
-repeatGradient s = s - fromIntegral (floor s :: Int)
-
-reflectGradient :: Float -> Float
-reflectGradient s =
-    abs (abs (s - 1) `mod'` 2 - 1)
-   
-gradientColorAt :: (Pixel px, Modulable (PixelBaseComponent px))
-                => GradientArray px -> Float -> px
-{-# SPECIALIZE
- 	gradientColorAt :: GradientArray PixelRGBA8 -> Float -> PixelRGBA8 #-}
-gradientColorAt grad at
-    | at <= 0 = snd $ V.head grad
-    | at >= 1.0 = snd $ V.last grad
-    | otherwise = go (0, snd $ V.head grad) 0
-  where
-    maxi = V.length grad
-    go (prevCoeff, prevValue) ix
-      | ix >= maxi = snd $ V.last grad
-      | at < coeff = mixWith (\_ -> alphaOver cov icov) prevValue px
-      | otherwise = go value $ ix + 1
-      where value@(coeff, px) = grad `V.unsafeIndex` ix
-            zeroToOne = (at - prevCoeff) / (coeff - prevCoeff)
-            (cov, icov) = clampCoverage zeroToOne
-
-gradientColorAtRepeat :: (Pixel px, Modulable (PixelBaseComponent px))
-                      => SamplerRepeat -> GradientArray px -> Float -> px
-{-# SPECIALIZE INLINE
-	gradientColorAtRepeat ::
-		SamplerRepeat -> GradientArray PixelRGBA8 -> Float -> PixelRGBA8 #-}
-gradientColorAtRepeat SamplerPad grad = gradientColorAt grad
-gradientColorAtRepeat SamplerRepeat grad =
-    gradientColorAt grad . repeatGradient
-gradientColorAtRepeat SamplerReflect grad =
-    gradientColorAt grad . reflectGradient
+uniformTexture = SolidTexture
 
 -- | Linear gradient texture.
 --
@@ -154,177 +87,61 @@ --
 -- <<docimages/linear_gradient.png>>
 --
-linearGradientTexture :: (Pixel px, Modulable (PixelBaseComponent px))
-                      => Gradient px -- ^ Gradient description.
+linearGradientTexture :: Gradient px -- ^ Gradient description.
                       -> Point       -- ^ Linear gradient start point.
                       -> Point       -- ^ Linear gradient end point.
                       -> Texture px
-{-# SPECIALIZE
-	linearGradientTexture
-		:: Gradient PixelRGBA8 -> Point -> Point
-        -> Texture PixelRGBA8 #-}
-linearGradientTexture gradient start end repeating =
-    \x y -> colorAt $ ((V2 x y) `dot` d) - s00
-  where
-    colorAt = gradientColorAtRepeat repeating gradArray
-    gradArray = V.fromList gradient
-    vector = end ^-^ start
-    d = vector ^/ (vector `dot` vector)
-    s00 = start `dot` d
+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
 -- filtering on the texture.
 --
-sampledImageTexture :: forall px.
-                       ( Pixel px, Modulable (PixelBaseComponent px))
-                    => Image px -> Texture px
-{-# SPECIALIZE
- 	sampledImageTexture :: Image Pixel8 -> Texture Pixel8 #-}
-{-# SPECIALIZE
- 	sampledImageTexture :: Image PixelRGBA8 -> Texture PixelRGBA8 #-}
-sampledImageTexture img sampling x y =
-  (at px  py `interpX` at pxn py)
-             `interpY`
-  (at px pyn `interpX` at pxn pyn)
-  where
-   coordSampler SamplerPad maxi v =
-      min (maxi - 1) . max 0 $ floor v
-   coordSampler SamplerReflect maxi v =
-      floor $ abs (abs (v - maxif - 1) `mod'` (2 * maxif) - maxif - 1)
-        where maxif = fromIntegral maxi
-   coordSampler SamplerRepeat maxi v = floor v `mod` maxi
-
-   w = fromIntegral $ imageWidth img
-   h = fromIntegral $ imageHeight img
-
-   clampedX = coordSampler sampling w
-   clampedY = coordSampler sampling h
-
-   px = clampedX x
-   pxn = clampedX $ x + 1
-   py = clampedY y
-   pyn = clampedY $ y + 1
-
-   dx, dy :: Float
-   dx = x - fromIntegral (floor x :: Int)
-   dy = y - fromIntegral (floor y :: Int)
-
-   at :: Int -> Int -> px
-   at xx yy =
-        unsafePixelAt rawData $ (yy * w + xx) * compCount
-
-   (covX, icovX) = clampCoverage dx
-   (covY, icovY) = clampCoverage dy
-
-   interpX = mixWith (const $ alphaOver covX icovX)
-   interpY = mixWith (const $ alphaOver covY icovY)
-
-   compCount = componentCount (undefined :: px)
-   rawData = imageData img
-
--- | Use another image as a texture for the filling.
--- This texture use the "nearest" filtering, AKA no
--- filtering at all.
-imageTexture :: forall px. (Pixel px) => Image px -> Texture px
-{-# SPECIALIZE
-	imageTexture :: Image PixelRGBA8 -> Texture PixelRGBA8 #-}
-{-# SPECIALIZE
-	imageTexture :: Image Pixel8 -> Texture Pixel8 #-}
-imageTexture img _ x y =
-    unsafePixelAt rawData $ (clampedY * w + clampedX) * compCount
-  where
-   clampedX = min (w - 1) . max 0 $ floor x
-   clampedY = min (h - 1) . max 0 $ floor y
-   compCount = componentCount (undefined :: px)
-   w = imageWidth img
-   h = imageHeight img
-   rawData = imageData img
+sampledImageTexture :: Image px -> Texture px
+sampledImageTexture = SampledTexture
 
 -- | Radial gradient texture
 --
 -- > let gradDef = [(0, PixelRGBA8 0 0x86 0xc1 255)
 -- >               ,(0.5, PixelRGBA8 0xff 0xf4 0xc1 255)
 -- >               ,(1, PixelRGBA8 0xFF 0x53 0x73 255)] in
--- > withTexture (radialGradientTexture SamplerPad gradDef
+-- > withTexture (radialGradientTexture gradDef
 -- >                    (V2 100 100) 75) $
 -- >    fill $ circle (V2 100 100) 100
 --
 -- <<docimages/radial_gradient.png>>
 --
-radialGradientTexture :: (Pixel px, Modulable (PixelBaseComponent px))
-                      => Gradient px -- ^ Gradient description
+radialGradientTexture :: Gradient px -- ^ Gradient description
                       -> Point       -- ^ Radial gradient center
                       -> Float       -- ^ Radial gradient radius
                       -> Texture px
-radialGradientTexture gradient center radius repeating =
-    \x y -> colorAt $ norm ((V2 x y) ^-^ center) / radius
-  where
-    colorAt = gradientColorAtRepeat repeating gradArray
-    gradArray = V.fromList gradient
-
+radialGradientTexture = RadialGradientTexture
 
 -- | Radial gradient texture with a focus point.
 --
 -- > let gradDef = [(0, PixelRGBA8 0 0x86 0xc1 255)
 -- >               ,(0.5, PixelRGBA8 0xff 0xf4 0xc1 255)
 -- >               ,(1, PixelRGBA8 0xFF 0x53 0x73 255)] in
--- > withTexture (radialGradientWithFocusTexture SamplerPad gradDef
+-- > withTexture (radialGradientWithFocusTexture gradDef
 -- >                    (V2 100 100) 75 (V2 70 70) ) $
 -- >    fill $ circle (V2 100 100) 100
 --
 -- <<docimages/radial_gradient_focus.png>>
 --
 radialGradientWithFocusTexture
-    :: (Pixel px, Modulable (PixelBaseComponent px))
-    => Gradient px -- ^ Gradient description
+    :: Gradient px -- ^ Gradient description
     -> Point      -- ^ Radial gradient center
     -> Float      -- ^ Radial gradient radius
     -> Point      -- ^ Radial gradient focus point
     -> Texture px
-radialGradientWithFocusTexture gradient center radius focusScreen repeating =
-    \x y -> colorAt . go $ (V2 x y) ^-^ center
-  where
-    focus@(V2 origFocusX origFocusY) = focusScreen ^-^ center
-    colorAt = gradientColorAtRepeat repeating gradArray
-    gradArray = V.fromList gradient
-    radiusSquared = radius * radius
-    dist = sqrt $ focus `dot` focus
-    clampedFocus@(V2 focusX focusY)
-        | dist <= r = focus
-        | otherwise = V2 (r * cos a) (r * sin a)
-           where a = atan2 origFocusY origFocusX
-                 r = radius * 0.99
-    trivial = sqrt $ radiusSquared - origFocusX * origFocusX
-
-    solutionOf (V2 x y) | x == focusX =
-        V2 focusX (if y > focusY then trivial else negate trivial)
-    solutionOf (V2 x y) = V2 xSolution $ slope * xSolution + yint
-      where
-        slope = (y - focusY) / (x - focusX)
-        yint = y - (slope * x)
-
-        a = slope * slope + 1
-        b = 2 * slope * yint
-        c = yint * yint - radiusSquared
-        det = sqrt $ b * b - 4 * a * c
-        xSolution = (-b + (if x < focusX then negate det else det)) / (2 * a)
-
-    go pos = sqrt $ curToFocus / distSquared
-      where
-        solution = solutionOf pos ^-^ clampedFocus
-        toFocus = pos ^-^ clampedFocus
-        distSquared = solution `dot` solution
-        curToFocus = toFocus `dot` toFocus
+radialGradientWithFocusTexture = RadialGradientWithFocusTexture
 
 -- | Perform a multiplication operation between a full color texture
 -- and a greyscale one, used for clip-path implementation.
-modulateTexture :: (Pixel px, Modulable (PixelBaseComponent px))
+modulateTexture :: (Pixel px)
                 => Texture px                       -- ^ The full blown texture.
                 -> Texture (PixelBaseComponent px)  -- ^ A greyscale modulation texture.
                 -> Texture px                       -- ^ The resulting texture.
-modulateTexture fullTexture modulator repeating = \x y ->
-    colorMap (modulate $ modulationTexture x y) $ full x y
-  where modulationTexture = modulator repeating
-        full = fullTexture repeating
+modulateTexture = ModulateTexture
 

@@ -7,16 +7,19 @@ module Graphics.Rasterific.Transformations
     ( Transformation( .. )
     , applyTransformation
+    , applyVectorTransformation
     , translate
     , scale
     , rotate
     , rotateCenter
+    , skewX
+    , skewY
     , inverseTransformation
     ) where
 
 import Data.Monoid( Monoid( .. ), (<>) )
 import Graphics.Rasterific.Types
-import Linear( V2( .. ) )
+import Graphics.Rasterific.Linear( V2( .. ) )
 
 -- | Represent a 3*3 matrix for homogenous coordinates.
 --
@@ -60,7 +63,15 @@                                     b d f) (V2 x y) =
     V2 (a * x + y * c + e) (b * x + d * y + f)
 
+-- | Effectively transform a vector given a transformation.
+-- The translation part won't be applied.
+applyVectorTransformation :: Transformation -> Vector -> Vector
+applyVectorTransformation
+    (Transformation a c _e
+                    b d _f) (V2 x y) =
+    V2 (a * x + y * c) (b * x + d * y)
 
+
 -- | Create a transformation representing a rotation
 -- on the plane.
 --
@@ -115,11 +126,44 @@     Transformation 1 0 x
                    0 1 y
 
+-- | Skew transformation along the
+-- X axis.
+--
+-- > fill . transform (applyTransformation $ skewX 0.3)
+-- >      $ rectangle (V2 50 50) 80 80
+--
+-- <<docimages/transform_skewx.png>>
+--
+skewX :: Float -> Transformation
+skewX v =
+    Transformation 1 t 0
+                   0 1 0
+  where t = tan v
+
+-- | Skew transformation along the Y axis.
+--
+-- > fill . transform (applyTransformation $ skewY 0.3)
+-- >      $ rectangle (V2 50 50) 80 80
+--
+-- <<docimages/transform_skewy.png>>
+--
+skewY :: Float -> Transformation
+skewY v =
+    Transformation 1 0 0
+                   t 1 0
+  where t = tan v
+
+transformationDeterminant :: Transformation -> Float
+transformationDeterminant (Transformation a c _e
+                                          b d _f) = a * d - c * b
+
 -- | Inverse a transformation (if possible)
-inverseTransformation :: Transformation -> Transformation
+inverseTransformation :: Transformation -> Maybe Transformation
+inverseTransformation trans
+    | transformationDeterminant trans == 0 = Nothing
 inverseTransformation (Transformation a c e
                                       b d f) =
-    Transformation a' c' e' b' d' f'
+    Just $ Transformation a' c' e' b' d' f'
   where det = a * d - b * c
         a' = d / det
         c' = (- c) / det
@@ -128,3 +172,4 @@         b' = (- b) / det
         d' = a / det
         f' = (e * b - a * f) / det
+

@@ -13,6 +13,8 @@     , CubicBezier( .. )
     , Primitive( .. )
     , Container
+    , containerOfList
+    , listOfContainer
     , PathCommand( .. )
     , Path( .. )
     , Transformable( .. )
@@ -31,8 +33,9 @@     , pathToPrimitives
     ) where
 
+import Data.DList( DList, fromList, toList  )
 import Data.Foldable( Foldable, foldl' )
-import Linear( V2( .. ) )
+import Graphics.Rasterific.Linear( V2( .. ) )
 
 -- | Represent a vector
 type Vector = V2 Float
@@ -168,7 +171,6 @@     -- the primitive.
     foldPoints :: (b -> Point -> b) -> b -> a -> b
 
-
 instance Transformable Point where
     {-# INLINE transform #-}
     transform f p = f p
@@ -316,7 +318,13 @@       => PointFoldable (f a) where
     foldPoints f = foldl' (foldPoints f)
 
-type Container a = [a]
+type Container a = DList a
+
+containerOfList :: [a] -> Container a
+containerOfList = fromList
+
+listOfContainer :: Container a -> [a]
+listOfContainer = toList
 
 -- | Describe a path in a way similar to many graphical
 -- packages, using a "pen" position in memory and reusing