Arrow.hs

-- | Rendering of "Data.CG.Minus.Arrow".
module Render.CG.Minus.Arrow where

import Data.CG.Minus
import Data.CG.Minus.Arrow
import Data.CG.Minus.Colour
import qualified Graphics.Rendering.Cairo as C
import Render.CG.Minus

arrow_strk :: Ca -> C.Render ()
arrow_strk c = do
  C.setLineCap C.LineCapRound
  pen 0.01 c
  C.stroke

-- | Render 'Ln' with solid arrow tip at endpoint.  Arrow tip
-- co-ordinates are given by 'arrow_coord'.
arrow_ep :: R -> R -> Ca -> Ln R -> C.Render ()
arrow_ep n a c l = do
  let (p0,p1) = ln_pt l
      (p2,p3) = arrow_coord l n a
  line [p0,ln_midpoint (ln p2 p3)]
  arrow_strk c
  polygon [p2,p1,p3]
  C.fill

-- | Variant of 'arrow_ep' to render 'Ls' as sequence of arrows.
arrows_ep :: R -> R -> Ca -> Ls R -> C.Render ()
arrows_ep n a c xs = mapM_ (arrow_ep n a c) (zipWith ln xs (tail xs))

-- | Variant of 'arrow_ep' with draws tip at mid-point of 'Ln'.
arrow_mp :: R -> R -> Ca -> Ln R -> C.Render ()
arrow_mp n a c l = do
  let (p0,p1) = ln_pt l
      p1' = ln_midpoint (ln p0 (pt_linear_extension n l))
      (p2,p3) = arrow_coord (ln p0 p1') n a
  line [p0,p1]
  arrow_strk c
  polygon [p2,p1',p3]
  C.fill

-- | Variant of 'arrow_mp' to render 'Ls' as sequence of arrows.
arrows_mp :: R -> R -> Ca -> Ls R -> C.Render ()
arrows_mp n a c xs = mapM_ (arrow_mp n a c) (zipWith ln xs (tail xs))