packages feed

hcg-minus-0.11: Render/CG/Minus.hs

-- | CG (minus) rendering in terms of 'C.Render'.
module Render.CG.Minus where

import Data.CG.Minus
import Data.CG.Minus.Colour
import Data.Colour
import qualified Graphics.Rendering.Cairo as C {- cairo -}

-- | 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
    (p0:pp) -> do let (x0,y0) = pt_xy p0
                  C.moveTo x0 y0
                  let f p = let (x,y) = pt_xy p in 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.
points :: R -> Ls R -> C.Render ()
points n l = do
  let f p = let (x,y) = pt_xy p in C.rectangle x y n n >> C.fill
  mapM_ f l

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

-- | Run 'colour' then 'C.fillPreserve'.
fill :: Ca -> C.Render ()
fill c = colour c >> C.fillPreserve

-- | Run 'C.stroke' with line width 'R' and 'Ca'.
stroke :: R -> Ca -> C.Render ()
stroke lw c = C.setLineWidth lw >> colour c >> C.stroke

-- | Run 'polygon' on 'Ls' then 'fill' and 'stroke'.
area :: R -> Ca -> Ca -> Ls R -> C.Render ()
area lw sc fc a = do
  polygon a
  fill fc
  stroke lw sc

-- | 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 'stroke'.
outline :: R -> Ca -> Ls R -> C.Render ()
outline lw c l = polygon l >> stroke lw c