Rasterific 0.7.4.4 → 0.7.5

raw patch · 5 files changed

+41/−18 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Rasterific.cabal +1/−1
• changelog +8/−0
• src/Graphics/Rasterific.hs +26/−16
• src/Graphics/Rasterific/Operators.hs +5/−1
• src/Graphics/Rasterific/StrokeInternal.hs +1/−0

@@ -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.7.4.4
+version:             0.7.5
 synopsis:            A pure haskell drawing engine.
 -- A longer description of the package.
 description:

@@ -1,6 +1,14 @@ Change log
 ==========
 
+v0.7.5 November 2019
+--------------------
+
+ * Adding better sanitization of geometry in presence of NaN
+   and infinity.
+ * Better handling of max width and height of caching (related
+   to weird clip issue combined with caching)
+
 v0.7.4.3 May 2019
 -----------------
 

@@ -471,21 +471,27 @@           $ drawOrdersOfDrawing width height dpi background drawing
 
 cacheOrders :: forall px. (RenderablePixel px)
-            => Maybe (Image px -> ImageTransformer px) -> [DrawOrder px] -> Drawing px ()
-cacheOrders imageFilter orders = case imageFilter of
-    Nothing -> drawImage resultImage 0 cornerUpperLeft
+            => Maybe (Image px -> ImageTransformer px)
+            -> Int -- ^ width
+            -> Int -- ^ Height
+            -> [DrawOrder px] -> Drawing px ()
+cacheOrders imageFilter maxWidth maxHeight orders = case imageFilter of
+    Nothing -> drawImageAtSize resultImage 0 cornerUpperLeft width height
     Just f -> drawImage (pixelMapXY (f resultImage) resultImage) 0 cornerUpperLeft
   where
    PlaneBound mini maxi = foldMap planeBounds orders
    cornerUpperLeftInt = floor <$> mini :: V2 Int
    cornerUpperLeft = fromIntegral <$> cornerUpperLeftInt
 
-   V2 width height = maxi ^-^ cornerUpperLeft ^+^ V2 1 1
+   V2 width height = min <$> (maxi ^-^ cornerUpperLeft ^+^ V2 1 1)
+                         <*> (V2 (fromIntegral maxWidth) (fromIntegral maxHeight))
    
    shiftOrder order@DrawOrder { _orderPrimitives = prims } =
        order { _orderPrimitives = fmap (transform (^-^ cornerUpperLeft)) <$> prims 
              , _orderTexture =
                  WithTextureTransform (translate cornerUpperLeft) $ _orderTexture order
+             , _orderMask =
+                 WithTextureTransform (translate cornerUpperLeft) <$> _orderMask order
              }
    
    resultImage =
@@ -507,7 +513,8 @@     -> Drawing px ()
     -> Drawing px ()
 cacheDrawing maxWidth maxHeight dpi sub =
-  cacheOrders Nothing $ drawOrdersOfDrawing maxWidth maxHeight dpi emptyPx sub
+  cacheOrders Nothing maxWidth maxHeight $
+    drawOrdersOfDrawing maxWidth maxHeight dpi emptyPx sub
 
 {-  
 preComputeTexture :: (RenderablePixel px)
@@ -575,6 +582,14 @@     stupidDefaultTexture =
         SolidTexture $ colorMap (const clipBackground) background
 
+    orderOf ctxt method primitives = DrawOrder 
+        { _orderPrimitives = primitives
+        , _orderTexture    = textureOf ctxt
+        , _orderFillMethod = method
+        , _orderMask       = currentClip ctxt
+        , _orderDirect     = return ()
+        }
+
     go :: RenderContext px -> Free (DrawCommand px) () -> [DrawOrder px]
        -> [DrawOrder px]
     go _ (Pure ()) rest = rest
@@ -589,7 +604,7 @@     go ctxt (Free (WithImageEffect effect sub next)) rest =
         go freeContext (fromF cached) after
       where
-        cached = cacheOrders (Just effect) $ go ctxt (fromF sub) []
+        cached = cacheOrders (Just effect) maxBound maxBound $ go ctxt (fromF sub) []
         after = go ctxt next rest
         freeContext = ctxt { currentClip = Nothing, currentTransformation = Nothing }
 
@@ -670,17 +685,12 @@ 
     go ctxt (Free (Fill method prims next)) rest = order : after where
       after = go ctxt next rest
-      order = DrawOrder 
-            { _orderPrimitives = [geometryOf ctxt prims]
-            , _orderTexture    = textureOf ctxt
-            , _orderFillMethod = method
-            , _orderMask       = currentClip ctxt
-            , _orderDirect     = return ()
-            }
+      order = orderOf ctxt method [geometryOf ctxt prims >>= listOfContainer . sanitize]
 
-    go ctxt (Free (Stroke w j cap prims next)) rest =
-        go ctxt (Free $ Fill FillWinding prim' next) rest
-            where prim' = listOfContainer $ strokize w j cap prims
+    go ctxt (Free (Stroke w j cap prims next)) rest = order : after where
+      after = go ctxt next rest
+      order = orderOf ctxt FillWinding [prim']
+      prim' = listOfContainer $ strokize w j cap prims
 
     go ctxt (Free (SetTexture tx sub next)) rest =
         go (ctxt { currentTexture = tx }) (fromF sub) $

@@ -147,9 +147,13 @@ -- | Tell if two points are nearly indistinguishable.
 -- If indistinguishable, we can treat them as the same
 -- point.
+-- point with degenerate coordinates (Infinity/NaN) will be considered
+-- as nearby.
 isNearby :: Point -> Point -> Bool
 {-# INLINE isNearby #-}
-isNearby p1 p2 = squareDist < 0.1
+isNearby p1 p2 =
+    squareDist < 0.1 ||
+    isNaN squareDist || isInfinite squareDist -- degenerate case protection
   where vec = p1 ^-^ p2
         squareDist = vec `dot` vec
 

@@ -6,6 +6,7 @@     , splitPrimitiveUntil
     , approximatePathLength
     , isPrimitivePoint
+    , sanitize
     )  where
 
 import Data.Monoid( (<>) )