Rasterific 0.4.2 → 0.5

raw patch · 8 files changed

+120/−33 lines, 8 filesdep ~FontyFruityPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: FontyFruity

API changes (from Hackage documentation)

Files

• Rasterific.cabal +3/−3
• changelog +8/−0
• docimages/aaaa.png binary
• docimages/sampled_texture_reflect.png binary
• exec-src/rastertest.hs +25/−4
• src/Graphics/Rasterific.hs +42/−9
• src/Graphics/Rasterific/PathWalker.hs +0/−16
• src/Graphics/Rasterific/Types.hs +42/−1

@@ -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.4.2
+version:             0.5
 synopsis:            A pure haskell drawing engine.
 -- A longer description of the package.
 description:
@@ -34,7 +34,7 @@ Source-Repository this
     Type:      git
     Location:  git://github.com/Twinside/Rasterific.git
-    Tag:       v0.4.2
+    Tag:       v0.5
 
 flag embed_linear
   description: Embed a reduced version of Linear avoiding a (huge) dep
@@ -71,7 +71,7 @@   build-depends: base        >= 4.6     && < 4.9
                , free        >= 4.7
                , JuicyPixels >= 3.2
-               , FontyFruity >= 0.4     && < 0.5
+               , FontyFruity >= 0.5     && < 0.6
                , vector      >= 0.9
                , mtl         >= 1.9
                , dlist       >= 0.6

@@ -1,5 +1,13 @@ -*-change-log-*-
 
+v0.5 February 2015
+ * Breaking Change: Font size is now a newtype in FontyFruity,
+   propagating the changes.
+ * Allowing to specify DPI at the top level of the rendering
+   request.
+ * Adding: an helper function to retrieve the distance to the
+ * Changed: font size switched to float.
+
 v0.4.2 February 2015
  * Fix: Cubic bezier clipping
 

binary file changed (8 → absent bytes)

binary file changed (64673 → 64698 bytes)

@@ -1,9 +1,14 @@ {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
+
+#if !MIN_VERSION_base(4,8,0)
+import Data.Foldable( foldMap )
+#endif
+
 import System.FilePath( (</>) )
 import System.Directory( createDirectoryIfMissing )
 
-import Data.Foldable( foldMap )
 import Data.Monoid( (<>) )
 import Control.Applicative( (<$>) )
 import Graphics.Rasterific hiding ( fill
@@ -320,7 +325,7 @@         writePng (outFolder </> filename) .
             renderDrawing 300 70 white
                 . withTexture (uniformTexture black) $
-                        printTextAt font 12 (V2 20 40) txt
+                        printTextAt font (PointSize 12) (V2 20 40) txt
 
 textStrokeTest :: String -> String -> String -> IO ()
 textStrokeTest fontName filename txt = do
@@ -329,8 +334,8 @@     case fontErr of
       Left err -> putStrLn err
       Right font -> do
-        let drawing = printTextAt font 20 (V2 30 30) txt
-            orders = drawOrdersOfDrawing 300 300 (PixelRGBA8 0 0 0 0) drawing
+        let drawing = printTextAt font (PointSize 20) (V2 30 30) txt
+            orders = drawOrdersOfDrawing 300 300 96 (PixelRGBA8 0 0 0 0) drawing
         writePng (outFolder </> filename) .
             renderDrawing 300 70 white .
                 withTexture (uniformTexture black) .
@@ -624,6 +629,21 @@       withTexture (uniformTexture drawColor) $
         stroke 4 JoinRound (CapRound, CapRound) [CubicBezierPrim bez]
 
+clipFail :: IO ()
+clipFail = writePng (outFolder </> "cubicbezier_clipError.png") img
+  where
+    trans = applyTransformation $ translate (V2 0 (-20))
+    img = renderDrawing 512 256 white .
+            withTexture (uniformTexture red) $ fill geometry
+
+    geometry = transform trans $ CubicBezierPrim <$>
+      [ CubicBezier (V2 104.707344 88.55418) (V2 153.00671 140.66666)
+                    (V2 201.30609 192.77914) (V2 249.60547 244.89162)
+      , CubicBezier (V2 249.60547 244.89162) (V2 349.59445 206.46687)
+                    (V2 449.58347 168.04214) (V2 549.57245 129.6174)
+      , CubicBezier (V2 549.57245 129.6174)  (V2 401.28406 115.92966)
+                    (V2 252.99573 102.24192) (V2 104.707344 88.55418)
+      ]
   
 testSuite :: IO ()
 testSuite = do
@@ -646,6 +666,7 @@             triColor (V2 200 200) 70 (V2 150 170)
 
   createDirectoryIfMissing True outFolder
+  clipFail
   pledgeTest
   strokeBad 
   strokeBad2

@@ -53,11 +53,13 @@     , printTextAt
     , printTextRanges
     , TextRange( .. )
+    , PointSize( .. )
 
       -- * Generating images
     , ModulablePixel
     , RenderablePixel
     , renderDrawing
+    , renderDrawingAtDpi
     , pathToPrimitives
 
       -- * Rasterization types
@@ -99,6 +101,10 @@     , bezierFromPath
     , lineFromPath
     , cubicBezierFromPath
+    , firstTangeantOf
+    , lastTangeantOf
+    , firstPointOf
+    , lastPointOf
 
       -- * Rasterization control
     , Join( .. )
@@ -145,7 +151,10 @@ import Graphics.Rasterific.Command
 {-import Graphics.Rasterific.TensorPatch-}
 
-import Graphics.Text.TrueType( Font, getStringCurveAtPoint )
+import Graphics.Text.TrueType( Font
+                             , Dpi
+                             , PointSize( .. )
+                             , getStringCurveAtPoint )
 
 {-import Debug.Trace-}
 {-import Text.Printf-}
@@ -183,7 +192,7 @@ -- >     pathToPrimitives path
 -- > withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $
 -- >   withPathOrientation path 0 $
--- >     printTextAt font 24 (V2 0 0) "Text on path"
+-- >     printTextAt font (PointSize 24) (V2 0 0) "Text on path"
 --
 -- <<docimages/text_on_path.png>>
 --
@@ -200,7 +209,7 @@ -- >       pathToPrimitives path
 -- > 
 -- > withPathOrientation path 0 $ do
--- >   printTextAt font 24 (V2 0 0) "TX"
+-- >   printTextAt font (PointSize 24) (V2 0 0) "TX"
 -- >   fill $ rectangle (V2 (-10) (-10)) 30 20
 -- >   fill $ rectangle (V2 45 0) 10 20
 -- >   fill $ rectangle (V2 60 (-10)) 20 20
@@ -286,7 +295,7 @@ -- >       writePng "text_example.png" .
 -- >           renderDrawing 300 70 (PixelRGBA8 255 255 255 255)
 -- >               . withTexture (uniformTexture $ PixelRGBA8 0 0 0 255) $
--- >                       printTextAt font 12 (V2 20 40)
+-- >                       printTextAt font (PointSize 12) (V2 20 40)
 -- >                            "A simple text test!"
 --
 -- <<docimages/text_example.png>>
@@ -294,7 +303,7 @@ -- You can use any texture, like a gradient while rendering text.
 --
 printTextAt :: Font            -- ^ Drawing font
-            -> Int             -- ^ font Point size
+            -> PointSize       -- ^ font Point size
             -> Point           -- ^ Drawing starting point (base line)
             -> String          -- ^ String to print
             -> Drawing px ()
@@ -311,6 +320,15 @@ -- | Print complex text, using different texture font and
 -- point size for different parts of the text.
 --
+-- > let blackTexture =
+-- >       Just . uniformTexture $ PixelRGBA8 0 0 0 255
+-- >     redTexture =
+-- >       Just . uniformTexture $ PixelRGBA8 255 0 0 255
+-- > in
+-- > printTextRanges (V2 20 40)
+-- >   [ TextRange font1 (PointSize 12) "A complex " blackTexture
+-- >   , TextRange font2 (PointSize 8) "text test" redTexture]
+--
 -- <<docimages/text_complex_example.png>>
 --
 printTextRanges :: Point            -- ^ Starting point of the base line
@@ -327,6 +345,7 @@ -- | Function to call in order to start the image creation.
 -- Tested pixels type are PixelRGBA8 and Pixel8, pixel types
 -- in other colorspace will probably produce weird results.
+-- Default DPI is 96
 renderDrawing
     :: forall px . (RenderablePixel px)
     => Int -- ^ Rendering width
@@ -334,20 +353,34 @@     -> px  -- ^ Background color
     -> Drawing px () -- ^ Rendering action
     -> Image px
-renderDrawing width height background drawing =
+renderDrawing width height = renderDrawingAtDpi width height 96
+
+-- | Function to call in order to start the image creation.
+-- Tested pixels type are PixelRGBA8 and Pixel8, pixel types
+-- in other colorspace will probably produce weird results.
+renderDrawingAtDpi
+    :: forall px . (RenderablePixel px)
+    => Int -- ^ Rendering width
+    -> Int -- ^ Rendering height
+    -> Dpi -- ^ Current DPI used for text rendering.
+    -> px  -- ^ Background color
+    -> Drawing px () -- ^ Rendering action
+    -> Image px
+renderDrawingAtDpi width height dpi background drawing =
     runST $ runDrawContext width height background
           $ mapM_ fillOrder
-          $ drawOrdersOfDrawing width height background drawing
+          $ drawOrdersOfDrawing width height dpi background drawing
 
 -- | Transform a drawing into a serie of low-level drawing orders.
 drawOrdersOfDrawing
     :: forall px . (RenderablePixel px) 
     => Int -- ^ Rendering width
     -> Int -- ^ Rendering height
+    -> Dpi -- ^ Current assumed DPI
     -> px  -- ^ Background color
     -> Drawing px () -- ^ Rendering action
     -> [DrawOrder px]
-drawOrdersOfDrawing width height background drawing =
+drawOrdersOfDrawing width height dpi background drawing =
     go initialContext (fromF drawing) []
   where
     initialContext = RenderContext Nothing stupidDefaultTexture Nothing
@@ -421,7 +454,7 @@         go ctxt (sequence_ drawCalls) $ go ctxt next rest
       where
         floatCurves =
-          getStringCurveAtPoint 90 (x, y)
+          getStringCurveAtPoint dpi (x, y)
             [(_textFont d, _textSize d, _text d) | d <- descriptions]
 
         linearDescriptions =

@@ -10,7 +10,6 @@                                      , advanceBy
                                      , currentPosition
                                      , currentTangeant
-
                                      , drawOrdersOnPath
                                      ) where
 
@@ -70,13 +69,6 @@   let (_, leftPrimitives) = splitPrimitiveUntil by $ _walkerPrims s in
   s { _walkerPrims = leftPrimitives }
 
--- | Extract the first point of the primitive.
-firstPointOf :: Primitive -> Point
-firstPointOf p = case p of
-  LinePrim (Line p0 _) -> p0
-  BezierPrim (Bezier p0 _ _) -> p0
-  CubicBezierPrim (CubicBezier p0 _ _ _) -> p0
-
 -- | Obtain the current position if we are still on the
 -- path, if not, return Nothing.
 currentPosition :: (Monad m) => PathWalkerT m (Maybe Point)
@@ -84,14 +76,6 @@   where
     currPos [] = Nothing
     currPos (prim:_) = Just $ firstPointOf prim
-
--- | Gives the orientation vector for the current point on
--- the path.
-firstTangeantOf :: Primitive -> Vector
-firstTangeantOf p = case p of
-  LinePrim (Line p0 p1) -> p1 ^-^ p0
-  BezierPrim (Bezier p0 p1 _) -> p1 ^-^ p0
-  CubicBezierPrim (CubicBezier p0 p1 _ _) -> p1 ^-^ p0
 
 -- | Obtain the current tangeant of the path if we're still
 -- on it. Return Nothing otherwise.

@@ -33,6 +33,12 @@       -- * Internal type
     , EdgeSample( .. )
     , pathToPrimitives
+
+      -- * Little geometry helpers
+    , firstTangeantOf
+    , lastTangeantOf
+    , firstPointOf
+    , lastPointOf
     ) where
 
 import Data.DList( DList, fromList, toList  )
@@ -41,7 +47,7 @@ import Data.Foldable( Foldable )
 #endif
 import Data.Foldable( foldl' )
-import Graphics.Rasterific.Linear( V2( .. ) )
+import Graphics.Rasterific.Linear( V2( .. ), (^-^), nearZero )
 
 import Foreign.Ptr( castPtr )
 import Foreign.Storable( Storable( sizeOf
@@ -438,4 +444,39 @@         BezierPrim (Bezier prev c1 to) : go to xs
     go prev (PathCubicBezierCurveTo c1 c2 to : xs) =
         CubicBezierPrim (CubicBezier prev c1 c2 to) : go to xs
+
+-- | Gives the orientation vector for the start of the
+-- primitive.
+firstTangeantOf :: Primitive -> Vector
+firstTangeantOf p = case p of
+  LinePrim (Line p0 p1) -> p1 ^-^ p0
+  BezierPrim (Bezier p0 p1 p2) ->
+      (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1)
+  CubicBezierPrim (CubicBezier p0 p1 p2 _) -> 
+       (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1)
+ where
+   ifBigEnough a b | nearZero a = b
+                   | otherwise = a
+
+-- | Gives the orientation vector at the end of the
+-- primitive.
+lastTangeantOf :: Primitive -> Vector
+lastTangeantOf p = case p of
+  LinePrim (Line p0 p1) -> p1 ^-^ p0
+  BezierPrim (Bezier _ p1 p2) -> p2 ^-^ p1
+  CubicBezierPrim (CubicBezier _ _ p2 p3) -> p3 ^-^ p2
+
+-- | Extract the first point of the primitive.
+firstPointOf :: Primitive -> Point
+firstPointOf p = case p of
+  LinePrim (Line p0 _) -> p0
+  BezierPrim (Bezier p0 _ _) -> p0
+  CubicBezierPrim (CubicBezier p0 _ _ _) -> p0
+
+-- | Return the last point of a given primitive.
+lastPointOf :: Primitive -> Point
+lastPointOf p = case p of
+  LinePrim (Line _ p0) -> p0
+  BezierPrim (Bezier _ _ p0) -> p0
+  CubicBezierPrim (CubicBezier _ _ _ p0) -> p0