module Graphics.PS.Statistics ( Statistics(..)
                              , pathStatistics ) where

import Graphics.PS.Path

-- | Path statistics data type.
data Statistics = Statistics {
      nMoveTo :: Integer
    , nLineTo :: Integer
    , nCurveTo :: Integer
    , nGlyph :: Integer
    , nTransform :: Integer }

plus :: Statistics -> Statistics -> Statistics
plus p q =
    let (Statistics m1 l1 c1 g1 t1) = p
        (Statistics m2 l2 c2 g2 t2) = q
    in Statistics (m1 + m2) (l1 + l2) (c1 + c2) (g1 + g2) (t1 + t2)

st :: Path -> Statistics
st (MoveTo _) = Statistics 1 0 0 0 0
st (LineTo _) = Statistics 0 1 0 0 0
st (CurveTo _ _ _) = Statistics 0 0 1 0 0
st (Text _ s) = Statistics 0 0 0 (fromIntegral (length s)) 0
st (PTransform _ p) = Statistics 0 0 0 0 1 `plus` st p
st (Join p1 p2) = st p1 `plus` st p2

-- | Determine number of path components of each type.
pathStatistics :: Path -> Statistics
pathStatistics = st