-- | CG (minus) rendering in terms of 'C.Render'. module Render.CG.Minus where import qualified Codec.Binary.UTF8.String as U {- utf8-string -} import Data.CG.Minus {- hcg-minus -} import Data.CG.Minus.Colour {- hcg-minus -} import Data.Colour {- colour -} import qualified Graphics.Rendering.Cairo as C {- cairo -} import System.FilePath {- filepath -} -- * Paths -- | Render nothing. nil :: C.Render () nil = return () -- | Render 'Ls' as 'C.moveTo' then sequence of 'C.lineTo'. line :: Ls R -> C.Render () line l = case l of [] -> nil Pt x0 y0 : pp -> do C.moveTo x0 y0 let f (Pt x y) = C.lineTo x y mapM_ f pp -- | Variant of 'line' that runs 'C.closePath'. polygon :: Ls R -> C.Render () polygon l = case l of [] -> nil _ -> line l >> C.closePath -- | Render 'Ls' as set of square points with 'R' dimension. -- Runs 'C.fill' on each square. points :: R -> Ls R -> C.Render () points n l = do let f (Pt x y) = C.rectangle x y n n >> C.fill mapM_ f l -- | Circle centred at 'Pt' with radius 'R'. circle :: Pt R -> R -> C.Render () circle (Pt x y) z = C.arc x y z 0 (2 * pi) -- * Context & drawing -- | Greyscale call to 'C.setSourceRGBA'. grey :: R -> C.Render () grey x = C.setSourceRGBA x x x 1 -- | 'Ca' call to 'C.setSourceRGBA'. colour :: Ca -> C.Render () colour c = let (r,g,b,a) = unCa c in C.setSourceRGBA r g b a -- | Set line width 'R' and 'Ca'. pen :: R -> Ca -> C.Render () pen lw c = C.setLineWidth lw >> colour c -- * Composite -- | Run 'polygon' on 'Ls' then 'fill' and 'stroke'. area :: R -> Ca -> Ca -> Ls R -> C.Render () area lw sc fc a = do polygon a colour fc C.fill pen lw sc C.stroke -- | Variant of 'area' with fixed grey border of width @0.005@ and -- grey @0.15@. area' :: Ca -> Ls R -> C.Render () area' = area 0.005 (opaque (mk_grey 0.15)) -- | Run 'polygon' on 'Ls' then 'pen' and 'C.stroke'. outline :: R -> Ca -> Ls R -> C.Render () outline lw c l = polygon l >> pen lw c >> C.stroke -- | Render rectangle given colour 'Ca', upper-left 'Pt' and -- /(width,height)/. rect :: Ca -> Pt R -> (R,R) -> C.Render () rect c (Pt x y) (w,h) = do C.rectangle x y w h pen 0.05 c C.stroke -- * Text -- | Render text 'String' in colour 'Ca' at 'Pt' in font size /sz/. text :: Ca -> Pt R -> R -> String -> C.Render () text c (Pt x y) sz txt = do let (r,g,b,_) = unCa c C.save C.selectFontFace "Times" C.FontSlantNormal C.FontWeightNormal C.setFontSize sz C.setSourceRGBA r g b 1 C.moveTo x y C.showText (U.utf8Encode txt) C.restore -- * Rendering -- | Enumeration of file types. data File_Type = F_PDF | F_SVG -- | Render to 'File_Type'. \(w,h)\ give the page size. The -- appropriate extension is appended to 'FilePath'. render_to_file :: File_Type -> (R,R) -> FilePath -> C.Render () -> IO () render_to_file ty (w,h) nm f = do let r_fn = case ty of F_PDF -> C.withPDFSurface (nm <.> "pdf") F_SVG -> C.withSVGSurface (nm <.> "svg") r_fn w h (`C.renderWith` f)