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

import qualified Data.Colour as Colour {- colour -}
import qualified Graphics.Rendering.Cairo as Cairo {- cairo -}
import System.FilePath {- filepath -}

import Data.CG.Minus.Types {- hcg-minus -}
import qualified Data.CG.Minus.Colour as CG {- hcg-minus -}
import qualified Data.CG.Minus.Core as CG {- hcg-minus -}

-- * Paths

-- | Render nothing.
nil :: Cairo.Render ()
nil = return ()

line2 :: Pt R -> Pt R -> Cairo.Render ()
line2 (Pt x1 y1) (Pt x2 y2) = Cairo.moveTo x1 y1 >> Cairo.lineTo x2 y2

-- | Render 'Ls' as 'Cairo.moveTo' then sequence of 'Cairo.lineTo'.
line :: Ls R -> Cairo.Render ()
line (Ls l) =
  case l of
    [] -> nil
    Pt x0 y0 : pp ->
        do Cairo.moveTo x0 y0
           let f (Pt x y) = Cairo.lineTo x y
           mapM_ f pp

-- | Variant of 'line' that runs 'Cairo.closePath'.
polygon :: Ls R -> Cairo.Render ()
polygon l = if CG.ls_null l then nil else line l >> Cairo.closePath

-- | Render 'Ls' as set of square points with 'R' dimension.
-- Runs 'Cairo.fill' on each square.
points :: R -> Ls R -> Cairo.Render ()
points n (Ls l) = do
  let f (Pt x y) = Cairo.rectangle x y n n >> Cairo.fill
  mapM_ f l

-- | Circle centred at 'Pt' with radius 'R'.
circle :: Pt R -> R -> Cairo.Render ()
circle (Pt x y) z = Cairo.arc x y z 0 (2 * pi)

-- * Context & drawing

-- | Greyscale call to 'Cairo.setSourceRGBA'.
grey :: R -> Cairo.Render ()
grey x = Cairo.setSourceRGBA x x x 1

-- | 'Ca' call to 'Cairo.setSourceRGBA'.
colour :: Ca -> Cairo.Render ()
colour c =
  let (r,g,b,a) = CG.ca_to_rgba c
  in Cairo.setSourceRGBA r g b a

-- | Set line width 'R' and 'Ca'.
pen :: R -> Ca -> ([R],R) -> Cairo.Render ()
pen lw c (d,d0) = do
  Cairo.setLineWidth lw
  Cairo.setDash d d0
  colour c

-- * Composite

-- | Run 'polygon' on 'Ls' then 'fill' and 'stroke'.
area :: R -> Ca -> Ca -> Ls R -> Cairo.Render ()
area lw sc fc a = do
  polygon a
  colour fc
  Cairo.fill
  pen lw sc ([],0)
  Cairo.stroke

-- | Variant of 'area' with default border of width @0.005@ and
-- grey @0.15@.
area_def :: Ca -> Ls R -> Cairo.Render ()
area_def = area 0.005 (Colour.opaque (CG.mk_grey 0.15))

-- | Run 'polygon' on 'Ls' then 'pen' and 'Cairo.stroke'.
outline :: R -> Ca -> Ls R -> Cairo.Render ()
outline lw c l = polygon l >> pen lw c ([],0) >> Cairo.stroke

-- | Outline rectangle given colour line width 'R', 'Ca', upper-left 'Pt' and
-- /(width,height)/.
rect :: R -> Ca -> Pt R -> (R,R) -> Cairo.Render ()
rect lw c (Pt x y) (w,h) = do
  Cairo.rectangle x y w h
  pen lw c ([],0)
  Cairo.stroke

-- | Solid variant of 'rect'.
rect_fill :: Ca -> Pt R -> (R,R) -> Cairo.Render ()
rect_fill c (Pt x y) (w,h) = do
  Cairo.rectangle x y w h
  colour c
  Cairo.fill

-- * Text

-- | Render text 'String' in colour 'Ca' at 'Pt' in font size /sz/.
text :: Ca -> Pt R -> R -> String -> Cairo.Render ()
text c (Pt x y) sz txt = do
  let (r,g,b,_) = CG.ca_to_rgba c
  Cairo.save
  Cairo.selectFontFace "Times" Cairo.FontSlantNormal Cairo.FontWeightNormal
  Cairo.setFontSize sz
  Cairo.setSourceRGBA r g b 1
  Cairo.moveTo x y
  Cairo.showText txt
  Cairo.restore

-- * Rendering

-- | Enumeration of file types.
data File_Type = F_PDF | F_SVG

-- | If /nm/ does not have /ext/ append it.
--
-- > map (maybe_add_extension ".pdf") ["x.pdf","x.y"] == ["x.pdf","x.y.pdf"]
maybe_add_extension :: String -> FilePath -> FilePath
maybe_add_extension ext nm = if takeExtension nm == ext then nm else nm <.> ext

-- | Render to 'File_Type'.
-- \(w,h)\ gives the page size.
-- The appropriate extension is appended to 'FilePath' if required.
render_to_file :: File_Type -> (R,R) -> FilePath -> Cairo.Render () -> IO ()
render_to_file ty (w,h) nm f = do
  let r_fn = case ty of
               F_PDF -> Cairo.withPDFSurface (maybe_add_extension ".pdf" nm)
               F_SVG -> Cairo.withSVGSurface (maybe_add_extension ".svg" nm)
  r_fn w h (`Cairo.renderWith` f)

-- | Render to @PDF@ file.
render_to_pdf :: (R,R) -> FilePath -> Cairo.Render () -> IO ()
render_to_pdf = render_to_file F_PDF

-- | Render to @SVG@ file.
render_to_svg :: (R,R) -> FilePath -> Cairo.Render () -> IO ()
render_to_svg = render_to_file F_SVG