hcg-minus-cairo-0.14: Render/CG/Minus.hs

-- | 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)