diff --git a/Rasterific.cabal b/Rasterific.cabal --- a/Rasterific.cabal +++ b/Rasterific.cabal @@ -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 diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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 diff --git a/docimages/aaaa.png b/docimages/aaaa.png deleted file mode 100644 Binary files a/docimages/aaaa.png and /dev/null differ diff --git a/docimages/sampled_texture_reflect.png b/docimages/sampled_texture_reflect.png Binary files a/docimages/sampled_texture_reflect.png and b/docimages/sampled_texture_reflect.png differ diff --git a/exec-src/rastertest.hs b/exec-src/rastertest.hs --- a/exec-src/rastertest.hs +++ b/exec-src/rastertest.hs @@ -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 diff --git a/src/Graphics/Rasterific.hs b/src/Graphics/Rasterific.hs --- a/src/Graphics/Rasterific.hs +++ b/src/Graphics/Rasterific.hs @@ -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" -- -- <> -- @@ -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!" -- -- <> @@ -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] +-- -- <> -- 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 = diff --git a/src/Graphics/Rasterific/PathWalker.hs b/src/Graphics/Rasterific/PathWalker.hs --- a/src/Graphics/Rasterific/PathWalker.hs +++ b/src/Graphics/Rasterific/PathWalker.hs @@ -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. diff --git a/src/Graphics/Rasterific/Types.hs b/src/Graphics/Rasterific/Types.hs --- a/src/Graphics/Rasterific/Types.hs +++ b/src/Graphics/Rasterific/Types.hs @@ -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