----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Annotation -- Copyright : (c) A. V. H. McPhail 2010 -- License : BSD3 -- -- Maintainer : haskell.vivian.mcphail gmail com -- Stability : provisional -- Portability : portable -- -- Rendering 'Figure's -- ----------------------------------------------------------------------------- module Graphics.Rendering.Plot.Render.Plot.Annotation ( -- * Rendering renderAnnotations ) where ----------------------------------------------------------------------------- import qualified Graphics.Rendering.Cairo as C import Control.Monad.Reader import Control.Monad.State import Graphics.Rendering.Plot.Types --import Graphics.Rendering.Plot.Defaults --import Graphics.Rendering.Plot.Figure.Text import Graphics.Rendering.Plot.Render.Types import Graphics.Rendering.Plot.Render.Text import Graphics.Rendering.Plot.Render.Plot.Glyph import Graphics.Rendering.Plot.Render.Plot.Format --import Prelude hiding(min,max) --import qualified Prelude(max) ----------------------------------------------------------------------------- renderAnnotations :: Ranges -> Annotations -> Render () renderAnnotations r an = do (BoundingBox x y w h) <- get let (xsc,xmin',xmax') = getRanges XAxis Lower r let (xmin,xmax) = if xsc == Log then (logBase 10 xmin',logBase 10 xmax') else (xmin',xmax') let xscale = w/(xmax-xmin) cairo $ C.save let (yscl,yminl',ymaxl') = getRanges YAxis Lower r let (yminl,ymaxl) = if yscl == Log then (logBase 10 yminl',logBase 10 ymaxl') else (yminl',ymaxl') let yscalel = h/(ymaxl-yminl) -- transform to data coordinates cairo $ do C.translate x (y+h) --C.scale xscale yscalel C.translate (-xmin*xscale) (yminl*yscalel) flipVertical put (BoundingBox (-xmin) (yminl) (xmax-xmin) (ymaxl-yminl)) mapM_ (renderAnnotation xscale yscalel) an put (BoundingBox x y w h) cairo $ C.restore ----------------------------------------------------------------------------- renderAnnotation :: Double -> Double -> Annotation -> Render () renderAnnotation xscale yscale (AnnArrow h lt (x1',y1') (x2',y2')) = do formatLineSeries lt let (x1,y1) = (x1'*xscale,y1'*yscale) let (x2,y2) = (x2'*xscale,y2'*yscale) cairo $ do C.moveTo x1 y1 C.lineTo x2 y2 C.stroke when h (do C.moveTo x2 y2 let theta = atan2 (y2-y1) (x2-x1) lw <- C.getLineWidth let ln = lw*10 cx = x2 - ln * cos theta cy = y2 - ln * sin theta xl = cx + (ln/2) * sin (theta + pi/2) yl = cy + (ln/2) * cos (theta + pi/2) xu = cx + (ln/2) * sin (theta - pi/2) yu = cy + (ln/2) * cos (theta - pi/2) C.lineTo xl yl C.lineTo xu yu C.closePath C.fill ) C.stroke renderAnnotation xscale yscale (AnnOval f b (x1',y1') (x2',y2')) = do (_,bc,c) <- formatBarSeries b let (x1,y1) = (x1'*xscale,y1'*yscale) let (x2,y2) = (x2'*xscale,y2'*yscale) let width = x2 - x1 height = y2 - y1 x = x1 + width/2 y = y1 + height/2 cairo $ do C.save setColour c C.translate (x + width / 2) (y + height / 2) C.scale (1 / (height / 2)) (1 / (width / 2)) C.arc 0 0 1 0 (2 * pi) C.restore C.strokePreserve when f (do setColour bc C.fill) C.newPath renderAnnotation xscale yscale (AnnRect f b (x1',y1') (x2',y2')) = do (_,bc,c) <- formatBarSeries b let (x1,y1) = (x1'*xscale,y1'*yscale) let (x2,y2) = (x2'*xscale,y2'*yscale) cairo $ do C.save setColour c C.rectangle x1 y1 x2 y2 C.restore C.strokePreserve when f (do setColour bc C.fill) C.newPath renderAnnotation xscale yscale (AnnGlyph pt (x1',y1')) = do (pw,g) <- formatPointSeries pt let (x1,y1) = (x1'*xscale,y1'*yscale) cairo $ do C.moveTo x1 y1 renderGlyph pw g renderAnnotation xscale yscale (AnnText te (x1',y1')) = do -- (x,y) <- cairo $ C.userToDevice x1 y1 let (x1,y1) = (x1'*xscale,y1'*yscale) cairo $ do C.save --C.scale (recip xscale) (recip (-yscale)) flipVertical -- _ <- renderText te TRight TTop (x1') (y1') _ <- renderText te TRight TTop (x1) (y1) cairo $ C.restore return () renderAnnotation _ _ (AnnCairo r) = do (BoundingBox x y w h) <- get cairo $ do C.save r x y w h C.restore -----------------------------------------------------------------------------