Picture.hs

-- | Very simple picture model.
module Data.CG.Minus.Picture where

import Data.List {- base -}
import Data.Maybe {- base -}

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

type Line_Width = R

type Dash = ([R],R)

data Pen = Pen Line_Width Ca Dash
           deriving (Eq,Show)

data Mark = Line Pen (Ln R)
          | Polygon (Either Pen Ca) [Pt R]
          | Circle (Either Pen Ca) (Pt R,R)
          | Dot Ca (Pt R,R)
            deriving (Eq,Show)

type Picture = [Mark]

no_dash :: Dash
no_dash = ([],0)

line_seq :: Pen -> [Pt R] -> [Mark]
line_seq pen =
    let adj l = zip l (tail l)
    in map (Line pen . uncurry Ln) . adj

polygon_l :: Pen -> [Pt R] -> Mark
polygon_l pen = Polygon (Left pen)

polygon_f :: Ca -> [Pt R] -> Mark
polygon_f clr = Polygon (Right clr)

circle_l :: Pen -> (Pt R,R) -> Mark
circle_l pen = Circle (Left pen)

circle_f :: Ca -> (Pt R,R) -> Mark
circle_f clr = Circle (Right clr)

mark_wn :: Mark -> Wn R
mark_wn m =
    case m of
      Line _ ln -> CG.ln_wn ln
      Polygon _ p -> CG.pts_window p
      Circle _ (c,r) -> CG.wn_square c r
      Dot _ (c,r) -> CG.wn_square c r

mark_normal :: Mark -> Mark
mark_normal m =
    case m of
      Line p ln -> Line p (CG.ln_sort ln)
      Polygon _ _ -> m -- should ensure CCW
      Circle _ _ -> m
      Dot _ _ -> m

mark_pt_set :: Mark -> [Pt R]
mark_pt_set m =
    case m of
      Line _ (Ln p q) -> [p,q]
      Polygon _ p -> p
      Circle _ (p,_) -> [p]
      Dot _ (p,_) -> [p]

mark_ln :: Mark -> Maybe (Ln R)
mark_ln m =
    case m of
      Line _ l -> Just l
      _ -> Nothing

mark_circle :: Mark -> Maybe (Pt R,R)
mark_circle m =
    case m of
      Circle _ c -> Just c
      _ -> Nothing

picture_pt_set :: Picture -> [Pt R]
picture_pt_set = concatMap mark_pt_set

picture_ln_set :: Picture -> [Ln R]
picture_ln_set = mapMaybe mark_ln

picture_ln_intersections :: Picture -> [Pt R]
picture_ln_intersections p =
    let l = picture_ln_set p
    in catMaybes [CG.ln_intersection l0 l1 | l0 <- l, l1 <- l, l0 /= l1]

picture_ln_circle_intersections :: Picture -> [Pt R]
picture_ln_circle_intersections p =
    let l_set = picture_ln_set p
        c_set = mapMaybe mark_circle p
    in concat [CG.ln_circle_intersection_set l c | l <- l_set, c <- c_set]

picture_normalise :: Picture -> Picture
picture_normalise = nub . map mark_normal

picture_wn :: Picture -> Wn R
picture_wn = foldl1 CG.wn_join . map mark_wn