diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,4 @@ +0.2.0.1 (22 August 2014) +------------------------ + +- Allow lens-4.4 diff --git a/diagrams-canvas.cabal b/diagrams-canvas.cabal --- a/diagrams-canvas.cabal +++ b/diagrams-canvas.cabal @@ -1,5 +1,5 @@ Name: diagrams-canvas -Version: 0.2.0.3 +Version: 0.3 Synopsis: HTML5 canvas backend for diagrams drawing EDSL Description: This package provides a modular backend for rendering diagrams created with the diagrams EDSL using an @@ -7,13 +7,13 @@ Homepage: http://projects.haskell.org/diagrams/ License: BSD3 License-file: LICENSE -Author: Jeffrey Rosenbluth, Ryan Yates, Brent Yorgey, Andy Gill +Author: Jeffrey Rosenbluth, Ryan Yates, Brent Yorgey, Andy Gill, Daniel Bergey Maintainer: diagrams-discuss@googlegroups.com Bug-reports: http://github.com/diagrams/diagrams-canvas/issues Stability: Experimental Category: Graphics Build-type: Simple -Extra-source-files: README.md +Extra-source-files: README.md, CHANGES.md Cabal-version: >=1.10 Source-repository head type: git @@ -30,8 +30,8 @@ diagrams-core >= 1.2 && < 1.3, diagrams-lib >= 1.2 && < 1.3, cmdargs >= 0.6 && < 0.11, - blank-canvas >= 0.4 && < 0.5, - lens >= 3.8 && < 4.3, + blank-canvas >= 0.5 && < 0.6, + lens >= 4.0 && < 4.5, containers >= 0.3 && < 0.6, text >= 1.0 && < 1.3, data-default-class >= 0.0.1 && < 0.1, diff --git a/src/Diagrams/Backend/Canvas.hs b/src/Diagrams/Backend/Canvas.hs --- a/src/Diagrams/Backend/Canvas.hs +++ b/src/Diagrams/Backend/Canvas.hs @@ -43,7 +43,7 @@ -- backend type, @v@ the vector space, and @m@ the type of monoidal -- query annotations on the diagram. 'Options' and 'Result' are -- associated data and type families, respectively, which yield the --- type of option records and rendering results specific to any +-- type of option records and rendering results specific to any -- particular backend. For @b ~ Canvas@ and @v ~ R2@, we have -- -- > data Options Canvas R2 = CanvaseOptions @@ -75,7 +75,7 @@ ( Canvas(..) -- rendering token , B , Options(..) -- for rendering options specific to Canvas - + , renderCanvas ) where @@ -95,7 +95,7 @@ import Data.Typeable (Typeable) import Data.Word (Word8) -import Diagrams.Attributes +import Diagrams.Attributes import Diagrams.Prelude hiding (fillTexture, moveTo, stroke) import Diagrams.TwoD.Adjust (adjustDia2D) import Diagrams.TwoD.Attributes (splitTextureFills) @@ -110,7 +110,7 @@ import qualified Graphics.Blank as BC import qualified Graphics.Blank.Style as S --- | This data declaration is simply used as a token to distinguish +-- | This data declaration is simply used as a token to distinguish -- this rendering engine. data Canvas = Canvas deriving (Eq, Ord, Read, Show, Typeable) @@ -118,7 +118,7 @@ type B = Canvas data CanvasState = CanvasState { _accumStyle :: Style R2 - , _csPos :: (Float, Float) } + , _csPos :: (Double, Double) } makeLenses ''CanvasState @@ -145,7 +145,7 @@ { _canvasSize :: SizeSpec2D -- ^ the requested size } - renderRTree :: Canvas -> Options Canvas R2 -> RTree Canvas R2 Annotation + renderRTree :: Canvas -> Options Canvas R2 -> RTree Canvas R2 Annotation -> Result Canvas R2 renderRTree _ _ rt = evalState canvasOutput initialCanvasRenderState where @@ -188,7 +188,7 @@ size :: Lens' (Options Canvas R2) SizeSpec2D size = lens getSize setSize -move :: (Float, Float) -> RenderM () +move :: (Double, Double) -> RenderM () move p = do csPos .= p save :: RenderM () @@ -307,7 +307,7 @@ canvasTransform :: T2 -> RenderM () canvasTransform tr = liftC $ BC.transform vs - where + where [[ax, ay], [bx, by], [tx, ty]] = matrixHomRep tr vs = (realToFrac ax,realToFrac ay ,realToFrac bx,realToFrac by @@ -319,15 +319,15 @@ fillTexture :: Texture -> Double -> RenderM () fillTexture = texture Fill -fromLineCap :: LineCap -> T.Text -fromLineCap LineCapRound = "round" -fromLineCap LineCapSquare = "square" -fromLineCap _ = "butt" +fromLineCap :: LineCap -> BC.LineEndCap +fromLineCap LineCapRound = BC.RoundCap +fromLineCap LineCapSquare = BC.SquareCap +fromLineCap _ = BC.ButtCap -fromLineJoin :: LineJoin -> T.Text -fromLineJoin LineJoinRound = "round" -fromLineJoin LineJoinBevel = "bevel" -fromLineJoin _ = "miter" +fromLineJoin :: LineJoin -> BC.LineJoinCorner +fromLineJoin LineJoinRound = BC.RoundCorner +fromLineJoin LineJoinBevel = BC.BevelCorner +fromLineJoin _ = BC.MiterCorner showFontJS :: FontWeight -> FontSlant -> Double -> String -> T.Text showFontJS wgt slant sz fnt = T.concat [a, " ", b, " ", c, " ", d] @@ -347,7 +347,7 @@ canvasStyle :: Style v -> RenderM () canvasStyle s = sequence_ - . catMaybes $ [ handle clip' + . catMaybes $ [ handle clip' , handle lWidth , handle lCap , handle lJoin @@ -414,17 +414,17 @@ else sz fnt = showFontJS fw slant fSize tf vAlign = case al of - BaselineText -> T.pack "alphabetic" + BaselineText -> BC.AlphabeticBaseline BoxAlignedText _ h -> case h of - h' | h' <= 0.25 -> T.pack "bottom" - h' | h' >= 0.75 -> T.pack "top" - _ -> T.pack "middle" + h' | h' <= 0.25 -> BC.BottomBaseline + h' | h' >= 0.75 -> BC.TopBaseline + _ -> BC.MiddleBaseline hAlign = case al of - BaselineText -> T.pack "start" + BaselineText -> BC.StartAnchor BoxAlignedText w _ -> case w of - w' | w' <= 0.25 -> T.pack "start" - w' | w' >= 0.75 -> T.pack "end" - _ -> T.pack "center" + w' | w' <= 0.25 -> BC.StartAnchor + w' | w' >= 0.75 -> BC.EndAnchor + _ -> BC.CenterAnchor save liftC $ BC.textBaseline vAlign liftC $ BC.textAlign hAlign @@ -434,14 +434,14 @@ liftC $ BC.fillText (T.pack str, 0, 0) restore --- instance Renderable (DImage External) Canvas where - -- render _ (DImage path w h tr) = C $ do - -- let ImageRef file = path - -- C.save - -- C.canvasTransform (tr <> reflectionY) - -- img <- liftC $ BC.newImage (T.pack file) - -- liftC $ BC.drawImage (img, [0, 0, fromIntegral w, fromIntegral h]) - -- C.restore +instance Renderable (DImage External) Canvas where + render _ (DImage path w h tr) = C $ do + let ImageRef file = path + save + canvasTransform (tr <> reflectionY) + img <- liftC $ BC.newImage (T.pack file) + liftC $ BC.drawImage (img, [fromIntegral (-w) / 2, fromIntegral (-h) / 2, fromIntegral w, fromIntegral h]) + restore renderCanvas :: Int -> SizeSpec2D -> Diagram Canvas R2 -> IO () renderCanvas port sizeSpec d = BC.blankCanvas (fromIntegral port) . flip BC.send $ img