packages feed

hps 0.11 → 0.14

raw patch · 14 files changed

+139/−304 lines, 14 filesdep +hcg-minusPVP ok

version bump matches the API change (PVP)

Dependencies added: hcg-minus

API changes (from Hackage documentation)

- Graphics.PS.Bezier: bezier4 :: Pt -> Pt -> Pt -> Pt -> Double -> Pt
- Graphics.PS.Matrix: Matrix :: R -> R -> R -> R -> R -> R -> Matrix
- Graphics.PS.Matrix: data Matrix
- Graphics.PS.Matrix: identity :: Matrix
- Graphics.PS.Matrix: instance Eq Matrix
- Graphics.PS.Matrix: instance Num Matrix
- Graphics.PS.Matrix: instance Show Matrix
- Graphics.PS.Matrix: rotation :: R -> Matrix
- Graphics.PS.Matrix: scaling :: R -> R -> Matrix
- Graphics.PS.Matrix: translation :: R -> R -> Matrix
- Graphics.PS.Matrix: type R = Double
- Graphics.PS.Paper: a0, a10, a9, a8, a7, a6, a5, a4, a3, a2, a1 :: Paper
- Graphics.PS.Paper: b0, b10, b9, b8, b7, b6, b5, b4, b3, b2, b1 :: Paper
- Graphics.PS.Paper: broadsheet, tabloid, berliner :: Paper
- Graphics.PS.Paper: c0, c10, c9, c8, c7, c6, c5, c4, c3, c2, c1 :: Paper
- Graphics.PS.Pt: Pt :: Double -> Double -> Pt
- Graphics.PS.Pt: data Pt
- Graphics.PS.Pt: instance Eq Pt
- Graphics.PS.Pt: instance Num Pt
- Graphics.PS.Pt: instance Ord Pt
- Graphics.PS.Pt: instance Show Pt
- Graphics.PS.Pt: origin :: Pt
- Graphics.PS.Pt: polarToRectangular :: Pt -> Pt
- Graphics.PS.Pt: ptMax :: Pt -> Pt -> Pt
- Graphics.PS.Pt: ptMin :: Pt -> Pt -> Pt
- Graphics.PS.Pt: ptTransform :: Matrix -> Pt -> Pt
- Graphics.PS.Pt: ptXYs :: [Pt] -> [Double]
- Graphics.PS.Transform: instance Transformable Pt
+ Graphics.PS.Image: paths :: Image -> [Path]
+ Graphics.PS.Paper: a0 :: Paper
+ Graphics.PS.Paper: a1 :: Paper
+ Graphics.PS.Paper: a10 :: Paper
+ Graphics.PS.Paper: a2 :: Paper
+ Graphics.PS.Paper: a3 :: Paper
+ Graphics.PS.Paper: a4 :: Paper
+ Graphics.PS.Paper: a5 :: Paper
+ Graphics.PS.Paper: a6 :: Paper
+ Graphics.PS.Paper: a7 :: Paper
+ Graphics.PS.Paper: a8 :: Paper
+ Graphics.PS.Paper: a9 :: Paper
+ Graphics.PS.Paper: b0 :: Paper
+ Graphics.PS.Paper: b1 :: Paper
+ Graphics.PS.Paper: b10 :: Paper
+ Graphics.PS.Paper: b2 :: Paper
+ Graphics.PS.Paper: b3 :: Paper
+ Graphics.PS.Paper: b4 :: Paper
+ Graphics.PS.Paper: b5 :: Paper
+ Graphics.PS.Paper: b6 :: Paper
+ Graphics.PS.Paper: b7 :: Paper
+ Graphics.PS.Paper: b8 :: Paper
+ Graphics.PS.Paper: b9 :: Paper
+ Graphics.PS.Paper: berliner :: Paper
+ Graphics.PS.Paper: broadsheet :: Paper
+ Graphics.PS.Paper: c0 :: Paper
+ Graphics.PS.Paper: c1 :: Paper
+ Graphics.PS.Paper: c10 :: Paper
+ Graphics.PS.Paper: c2 :: Paper
+ Graphics.PS.Paper: c3 :: Paper
+ Graphics.PS.Paper: c4 :: Paper
+ Graphics.PS.Paper: c5 :: Paper
+ Graphics.PS.Paper: c6 :: Paper
+ Graphics.PS.Paper: c7 :: Paper
+ Graphics.PS.Paper: c8 :: Paper
+ Graphics.PS.Paper: c9 :: Paper
+ Graphics.PS.Paper: tabloid :: Paper
+ Graphics.PS.Statistics: imageStatistics :: Image -> Statistics
+ Graphics.PS.Statistics: instance Eq Statistics
+ Graphics.PS.Statistics: instance Monoid Statistics
+ Graphics.PS.Statistics: instance Show Statistics
+ Graphics.PS.Transform: instance Transformable (Pt Double)
- Graphics.PS.Image: ITransform :: Matrix -> Image -> Image
+ Graphics.PS.Image: ITransform :: (Matrix Double) -> Image -> Image
- Graphics.PS.Path: ClosePath :: Pt -> Path
+ Graphics.PS.Path: ClosePath :: (Pt Double) -> Path
- Graphics.PS.Path: CurveTo :: Pt -> Pt -> Pt -> Path
+ Graphics.PS.Path: CurveTo :: (Pt Double) -> (Pt Double) -> (Pt Double) -> Path
- Graphics.PS.Path: LineTo :: Pt -> Path
+ Graphics.PS.Path: LineTo :: (Pt Double) -> Path
- Graphics.PS.Path: MoveTo :: Pt -> Path
+ Graphics.PS.Path: MoveTo :: (Pt Double) -> Path
- Graphics.PS.Path: PTransform :: Matrix -> Path -> Path
+ Graphics.PS.Path: PTransform :: (Matrix Double) -> Path -> Path
- Graphics.PS.Path: annular :: Pt -> Double -> Double -> Double -> Double -> Path
+ Graphics.PS.Path: annular :: Pt Double -> Double -> Double -> Double -> Double -> Path
- Graphics.PS.Path: arc :: Pt -> Double -> Double -> Double -> Path
+ Graphics.PS.Path: arc :: Pt Double -> Double -> Double -> Double -> Path
- Graphics.PS.Path: arcNegative :: Pt -> Double -> Double -> Double -> Path
+ Graphics.PS.Path: arcNegative :: Pt Double -> Double -> Double -> Double -> Path
- Graphics.PS.Path: line :: [Pt] -> Path
+ Graphics.PS.Path: line :: [Pt Double] -> Path
- Graphics.PS.Path: polygon :: [Pt] -> Path
+ Graphics.PS.Path: polygon :: [Pt Double] -> Path
- Graphics.PS.Path: rectangle :: Pt -> Double -> Double -> Path
+ Graphics.PS.Path: rectangle :: Pt Double -> Double -> Double -> Path
- Graphics.PS.Path: renderLines :: [(Pt, Pt)] -> Path
+ Graphics.PS.Path: renderLines :: [Ln Double] -> Path
- Graphics.PS.Path: renderLines' :: [(Pt, Pt)] -> Path
+ Graphics.PS.Path: renderLines' :: [Ln Double] -> Path
- Graphics.PS.Path.Graphs: erat :: Pt -> Double -> Path
+ Graphics.PS.Path.Graphs: erat :: Pt Double -> Double -> Path
- Graphics.PS.Path.Graphs: fractal_sqr_pt :: Pt -> Pt -> Int -> [(Pt, Pt)]
+ Graphics.PS.Path.Graphs: fractal_sqr_pt :: Pt Double -> Pt Double -> Int -> [Ln Double]
- Graphics.PS.Path.Graphs: sierpinski :: Pt -> Double -> Double -> Path
+ Graphics.PS.Path.Graphs: sierpinski :: Pt Double -> Double -> Double -> Path
- Graphics.PS.Query: endPt :: Path -> Maybe Pt
+ Graphics.PS.Query: endPt :: Path -> Maybe (Pt Double)
- Graphics.PS.Query: startPt :: Path -> Maybe Pt
+ Graphics.PS.Query: startPt :: Path -> Maybe (Pt Double)

Files

Graphics/PS.hs view
@@ -1,7 +1,5 @@ -- | Top-level module for @hps@.-module Graphics.PS (module Graphics.PS.Pt,-                    module Graphics.PS.Bezier,-                    module Graphics.PS.Path,+module Graphics.PS (module Graphics.PS.Path,                     module Graphics.PS.Glyph,                     module Graphics.PS.Font,                     module Graphics.PS.Image,@@ -11,10 +9,10 @@                     module Graphics.PS.Paper,                     module Graphics.PS.Query,                     module Graphics.PS.PS,-                    module Graphics.PS.Unit) where+                    module Graphics.PS.Unit,+                    module Data.CG.Minus) where -import Graphics.PS.Pt-import Graphics.PS.Bezier+import Data.CG.Minus import Graphics.PS.Path import Graphics.PS.Glyph import Graphics.PS.Font
− Graphics/PS/Bezier.hs
@@ -1,25 +0,0 @@--- | Bezier functions.-module Graphics.PS.Bezier (bezier4) where--import Graphics.PS.Pt--{---bezier3 :: Pt -> Pt -> Pt -> Double -> Pt-bezier3 (Pt x1 y1) (Pt x2 y2) (Pt x3 y3) mu = (Pt x y)-    where a = mu*mu-          b = 1 - mu-          c = b*b-          x = x1*c + 2*x2*b*mu + x3*a-          y = y1*c + 2*y2*b*mu + y3*a---}---- | Four-point bezier curve interpolation.  The index /mu/ is---   in the range zero to one.-bezier4 :: Pt -> Pt -> Pt -> Pt -> Double -> Pt-bezier4 (Pt x1 y1) (Pt x2 y2) (Pt x3 y3) (Pt x4 y4) mu =-    let a = 1 - mu-        b = a*a*a-        c = mu*mu*mu-        x = b*x1 + 3*mu*a*a*x2 + 3*mu*mu*a*x3 + c*x4-        y = b*y1 + 3*mu*a*a*y2 + 3*mu*mu*a*y3 + c*y4-    in Pt x y
Graphics/PS/Image.hs view
@@ -1,14 +1,14 @@ -- | Image type and functions.-module Graphics.PS.Image (Image(..),over) where+module Graphics.PS.Image where -import Graphics.PS.Matrix+import Data.CG.Minus {- hcg-minus -} import Graphics.PS.Path import Graphics.PS.GS  -- | An image is a rendering of a graph of 'Path's. data Image = Stroke GS Path            | Fill GS Path-           | ITransform Matrix Image+           | ITransform (Matrix Double) Image            | Over Image Image            | Empty              deriving (Eq, Show)@@ -16,6 +16,21 @@ -- | Layer one 'Image' over another. over :: Image -> Image -> Image over = Over++-- | List of 'Path's at 'Image'.+paths :: Image -> [Path]+paths =+    let rec m i =+            let f = maybe id PTransform m+            in case i of+                 Stroke _ p -> [f p]+                 Fill _ p -> [f p]+                 ITransform m' i' ->+                     let m'' = maybe m' (* m') m+                     in rec (Just m'') i'+                 Over l r -> rec m l ++ rec m r+                 Empty -> []+    in rec Nothing  {- -- | Apply a function to leaf nodes.
− Graphics/PS/Matrix.hs
@@ -1,90 +0,0 @@--- | Matrix type and functions.-module Graphics.PS.Matrix (R,Matrix(Matrix)-                          ,identity-                          ,translation,scaling,rotation) where---- | Synonym for 'Double'.-type R = Double---- | Transformation matrix data type.-data Matrix = Matrix R R R R R R deriving (Eq,Show)---- | Enumeration of 'Matrix' indices.-data Matrix_Index = I0 | I1 | I2--row :: Matrix -> Matrix_Index -> (R,R,R)-row (Matrix a b _ _ _ _) I0 = (a,b,0)-row (Matrix _ _ c d _ _) I1 = (c,d,0)-row (Matrix _ _ _ _ e f) I2 = (e,f,1)--col :: Matrix -> Matrix_Index -> (R,R,R)-col (Matrix a _ c _ e _) I0 = (a,c,e)-col (Matrix _ b _ d _ f) I1 = (b,d,f)-col (Matrix _ _ _ _ _ _) I2 = (0,0,1)--multiply :: Matrix -> Matrix -> Matrix-multiply a b =-    let f i j = let (r1,r2,r3) = row a i-                    (c1,c2,c3) = col b j-                in r1 * c1 + r2 * c2 + r3 * c3-        m = Matrix-    in m (f I0 I0) (f I0 I1) (f I1 I0) (f I1 I1) (f I2 I0) (f I2 I1)--pointwise :: (R -> R) -> Matrix -> Matrix-pointwise g (Matrix a b c d e f) =-    Matrix (g a) (g b) (g c) (g d) (g e) (g f)--pointwise2 :: (R -> R -> R) -> Matrix -> Matrix -> Matrix-pointwise2 g (Matrix a b c d e f) (Matrix a' b' c' d' e' f') =-    Matrix (g a a') (g b b') (g c c') (g d d') (g e e') (g f f')--instance Num Matrix where-    (*) = multiply-    (+) = pointwise2 (+)-    (-) = pointwise2 (-)-    abs = pointwise abs-    signum = pointwise signum-    fromInteger n = let n' = fromInteger n-                    in Matrix n' 0 0 n' 0 0---- | A translation matrix with independent x and y offsets.-translation :: R -> R -> Matrix-translation = Matrix 1 0 0 1---- | A scaling matrix with independent x and y scalars.-scaling :: R -> R -> Matrix-scaling x y = Matrix x 0 0 y 0 0---- | A rotation matrix through the indicated angle (in radians).-rotation :: R -> Matrix-rotation a =-    let c = cos a-        s = sin a-        t = negate s-    in Matrix c s t c 0 0---- | The identity matrix.-identity :: Matrix-identity = Matrix 1 0 0 1 0 0--{---translate :: R -> R -> M -> M-translate x y m = m * (translation x y)--scale :: R -> R -> M -> M-scale x y m = m * (scaling x y)--rotate :: R -> M -> M-rotate r m = m * (rotation r)--scalarMultiply :: R -> M -> M-scalarMultiply scalar = pointwise (* scalar)--adjoint :: M -> M-adjoint (Matrix a b c d x y) = M d (-b) (-c) a (c * y - d * x) (b * x - a * y)--invert :: M -> M-invert m = scalarMultiply (recip d) (adjoint m)-  where (Matrix xx yx xy yy _ _) = m-        d = xx*yy - yx*xy---}
Graphics/PS/PS.hs view
@@ -1,19 +1,18 @@ -- | Postscript generator. module Graphics.PS.PS (ps,eps,stringFromPS) where -import Graphics.PS.Pt-import qualified Graphics.PS.Matrix as M+import Data.CG.Minus {- hcg-minus -}+import Data.List+import Data.Monoid (Monoid, mappend, mempty, mconcat, Endo(Endo,appEndo), )+import System.IO+ import Graphics.PS.Path import Graphics.PS.Font import Graphics.PS.Unit import Graphics.PS.GS import qualified Graphics.PS.Paper as P import qualified Graphics.PS.Image as I-import Data.List-import System.IO-import Data.Monoid (Monoid, mappend, mempty, mconcat, Endo(Endo,appEndo), ) - data PS = Name String         | LName String         | Op String@@ -21,7 +20,7 @@         | Int Int         | Double Double         | String String-        | Matrix M.Matrix+        | Transform (Matrix Double)         | Array [PS]         | Proc [PS]         | Dict [(PS,PS)]@@ -132,19 +131,19 @@ miterLimit :: Double -> PS miterLimit m = Seq [Double m, Op "M"] -moveTo :: Pt -> PS+moveTo :: Pt Double -> PS moveTo (Pt x y) = Seq [Double x, Double y, Op "m"] -lineTo :: Pt -> PS+lineTo :: Pt Double -> PS lineTo (Pt x y) = Seq [Double x, Double y, Op "l"] -transform :: M.Matrix -> PS-transform m = Seq [Matrix m, Op "cm"]+transform :: Matrix Double -> PS+transform m = Seq [Transform m, Op "cm"] -curveTo :: Pt -> Pt -> Pt -> PS-curveTo a b c = Seq (map Double (ptXYs [a,b,c]) ++ [Op "c"])+curveTo :: Pt Double -> Pt Double -> Pt Double -> PS+curveTo a b c = Seq (map Double (ls_xy [a,b,c]) ++ [Op "c"]) -closePath :: Pt -> PS+closePath :: Pt Double -> PS closePath (Pt x y) = Seq [Double x, Double y, Op "h"]  selectFont :: Font -> PS@@ -181,9 +180,6 @@                          ,restore                          ,image a] -mlist :: M.Matrix -> [Double]-mlist (M.Matrix a b c d e f) = [a,b,c,d,e,f]- infixl 1 >+>  (>+>) :: Monoid m => m -> m -> m@@ -208,7 +204,7 @@ put f (String s) = f "(" >+> f (escape s) >+> f ") " put f (Array a) = bracket f "[" "]" a (put f) put f (Proc p) = bracket f "{" "}" p (put f)-put f (Matrix m) = put f (Array (map Double (mlist m)))+put f (Transform m) = put f (Array (map Double (mx_list m))) put f (Dict d) =     let g = concatMap (\(a,b) -> [a,b])     in bracket f "<<" ">>" (g d) (put f)
Graphics/PS/Path.hs view
@@ -5,19 +5,18 @@                         ,flatten                         ,renderLines,renderLines') where -import Data.List-import Graphics.PS.Pt-import Graphics.PS.Matrix+import Data.List {- base -}+import Data.CG.Minus {- hcg-minus -} import Graphics.PS.Glyph import Graphics.PS.Font  -- | Path data type,in cartesian space.-data Path = MoveTo Pt-          | LineTo Pt-          | CurveTo Pt Pt Pt-          | ClosePath Pt+data Path = MoveTo (Pt Double)+          | LineTo (Pt Double)+          | CurveTo (Pt Double) (Pt Double) (Pt Double)+          | ClosePath (Pt Double)           | Text Font [Glyph]-          | PTransform Matrix Path+          | PTransform (Matrix Double) Path           | Join Path Path             deriving (Eq,Show) @@ -30,22 +29,22 @@ combine = foldl1 Join  -- | Line segments though list of 'Pt'.-line :: [Pt] -> Path+line :: [Pt Double] -> Path line x =     case x of       [] -> error "line: illegal data"       (p:ps) -> combine (MoveTo p : map LineTo ps)  -- | Variant of 'line' connecting the last 'Pt' to the first.-polygon :: [Pt] -> Path+polygon :: [Pt Double] -> Path polygon x =     case x of       [] -> error "polygon: illegal data"       (p:ps) -> line (p:ps) +++ ClosePath p  -- | Rectangle with lower left at 'Pt' and of specified width and--- height.  Polygon is oredered anticlockwise from lower left.-rectangle :: Pt -> Double -> Double -> Path+-- height.  Polygon is ordered anticlockwise from lower left.+rectangle :: Pt Double -> Double -> Double -> Path rectangle (Pt x y) w h =     let ll = Pt x y         lr = Pt (x + w) y@@ -53,12 +52,12 @@         ul = Pt x (y + h)     in polygon [ll,lr,ur,ul] -type ArcP = (Pt,Pt,Pt,Pt)+type ArcP = (Pt Double,Pt Double,Pt Double,Pt Double) data Arc = Arc1 ArcP          | Arc2 ArcP ArcP  -- (x,y) = center,r = radius,a = start angle,b = end angle-arcp :: Pt -> Double -> Double -> Double -> ArcP+arcp :: Pt Double -> Double -> Double -> Double -> ArcP arcp (Pt x y) r a b =     let ca = cos a         sa = sin a@@ -73,7 +72,7 @@  -- c = center,r = radius,a = start angle,b = end angle -- if the arc angle is greater than pi the arc must be drawn in two-arca :: Pt -> Double -> Double -> Double -> Arc+arca :: Pt Double -> Double -> Double -> Double -> Arc arca c r a b =     let d = abs (b - a)         b' = b - (d / 2)@@ -94,13 +93,13 @@     in m +++ c1 +++ c2  -- | Arc given by a central point,a radius,and start and end angles.-arc :: Pt -> Double -> Double -> Double -> Path+arc :: Pt Double -> Double -> Double -> Double -> Path arc c r a b =     let f n = if n < a then f (n + 2 * pi) else n     in arc' (arca c r a (f b))  -- | Negative arc.-arcNegative :: Pt -> Double -> Double -> Double -> Path+arcNegative :: Pt Double -> Double -> Double -> Double -> Path arcNegative c r a b =     let f n = if n > a then f (n - 2 * pi) else n     in arc' (arca c r (f b) a)@@ -109,7 +108,7 @@ -- angle,a = angle,ea = end angle  -- | Annular segment.-annular :: Pt -> Double -> Double -> Double -> Double -> Path+annular :: Pt Double -> Double -> Double -> Double -> Double -> Path annular (Pt x y) ir xr sa a =     let ea = sa + a         x2 = x + ir * cos sa -- ll@@ -124,39 +123,39 @@                ,LineTo (Pt x4 y4)                ,arcNegative (Pt x y) ir ea sa] -flatten' :: Matrix -> Path -> Path+flatten' :: Matrix Double -> Path -> Path flatten' m path =     case path of-      MoveTo p -> MoveTo (ptTransform m p)-      LineTo p -> LineTo (ptTransform m p)-      ClosePath p -> ClosePath (ptTransform m p)+      MoveTo p -> MoveTo (pt_transform m p)+      LineTo p -> LineTo (pt_transform m p)+      ClosePath p -> ClosePath (pt_transform m p)       PTransform m' p -> flatten' (m' * m) p       Join a b -> Join (flatten' m a) (flatten' m b)-      CurveTo p q r -> let f = ptTransform m+      CurveTo p q r -> let f = pt_transform m                        in CurveTo (f p) (f q) (f r)       Text _ _ -> error "cannot flatten text"  -- | Apply any transformations at path.  The resulting path will not --   have any 'PTransform' nodes. flatten :: Path -> Path-flatten = flatten' identity+flatten = flatten' mx_identity  -- | Render each (p1,p2) as a distinct line.-renderLines :: [(Pt,Pt)] -> Path+renderLines :: [Ln Double] -> Path renderLines =-    let f pth (p1,p2) = pth +++ MoveTo p1 +++ LineTo p2-    in foldl f (MoveTo origin)+    let f pth (Ln p1 p2) = pth +++ MoveTo p1 +++ LineTo p2+    in foldl f (MoveTo pt_origin)  -- | Collapse line sequences into a single line.-renderLines' :: [(Pt,Pt)] -> Path+renderLines' :: [Ln Double] -> Path renderLines' =-    let g p (a,b) = if p == a-                    then (b,Right b)-                    else (b,Left (a,b))+    let g p (Ln a b) = if p == a+                       then (b,Right b)+                       else (b,Left (Ln a b))         f path e = case e of-                     Left (p1,p2) -> path +++ MoveTo p1 +++ LineTo p2+                     Left (Ln p1 p2) -> path +++ MoveTo p1 +++ LineTo p2                      Right p2 -> path +++ LineTo p2-    in foldl f (MoveTo origin) . snd . mapAccumL g origin+    in foldl f (MoveTo pt_origin) . snd . mapAccumL g pt_origin  {-- 
Graphics/PS/Path/Graphs.hs view
@@ -1,16 +1,16 @@ -- | Set of predefined 'Path's. module Graphics.PS.Path.Graphs where +import Data.CG.Minus {- hcg-minus -} import Graphics.PS.Path-import Graphics.PS.Pt import Graphics.PS.Transform import Graphics.PS.Unit  -- | See <ftp.scsh.net/pub/scsh/contrib/fps/doc/examples/fractal-sqr.html>-fractal_sqr_pt :: Pt -> Pt -> Int -> [(Pt,Pt)]+fractal_sqr_pt :: Pt Double -> Pt Double -> Int -> [Ln Double] fractal_sqr_pt p1 p2 d =     case d of-      0 -> [(p1,p2)]+      0 -> [Ln p1 p2]       _ -> let (Pt x1 y1) = p1                (Pt x2 y2) = p2                x3 = ((x1 + x2) / 2) + ((y2 - y1) / 2)@@ -48,11 +48,11 @@     in (translate x y . scale h h) a  -- | Isosceles right angled triangle-erat :: Pt -> Double -> Path+erat :: Pt Double -> Double -> Path erat (Pt x y) n = polygon [Pt x y,Pt (x+n) y,Pt x (y+n)]  -- | Sierpinski triangle.-sierpinski :: Pt -> Double -> Double -> Path+sierpinski :: Pt Double -> Double -> Double -> Path sierpinski p n limit =     let m = n / 2         (Pt x y) = p
− Graphics/PS/Pt.hs
@@ -1,80 +0,0 @@--- | Point type and associated functions.-module Graphics.PS.Pt (Pt(Pt)-                      ,polarToRectangular-                      ,ptMin, ptMax, ptXYs, origin-                      ,ptTransform) where--import Graphics.PS.Matrix---- | Cartesian co-ordinate with real valued /x/ and /y/ fields.-data Pt = Pt Double Double-          deriving (Eq, Show)--instance Num Pt where-    negate (Pt x y) = Pt (- x) (- y)-    Pt x0 y0 + Pt x1 y1 = Pt (x0 + x1) (y0 + y1)-    Pt x0 y0 - Pt x1 y1 = Pt (x0 - x1) (y0 - y1)-    Pt x0 y0 * Pt x1 y1 = Pt (x0 * x1) (y0 * y1)-    abs (Pt x y) = Pt (abs x) (abs y)-    signum _ = 0-    fromInteger a = let a' = fromInteger a-                    in Pt a' a'--instance Ord Pt where-    (Pt x0 y0) <= (Pt x1 y1) = x0 <= x1 && y0 <= y1---- | Origin, ie. (Pt 0 0).-origin :: Pt-origin = Pt 0 0---- | /x/ and /y/ elements of a set of 'Pt's.-ptXYs :: [Pt] -> [Double]-ptXYs [] = []-ptXYs (Pt x y : ps) = x : y : ptXYs ps--ptOp :: (Double -> Double -> Double) -> Pt -> Pt -> Pt-ptOp op (Pt x1 y1) (Pt x2 y2) = Pt (op x1 x2) (op y1 y2)---- | 'Pt' at /x/ and /y/ minima of inputs.-ptMin :: Pt -> Pt -> Pt-ptMin = ptOp min---- | 'Pt' at /x/ and /y/ maxima of inputs.-ptMax :: Pt -> Pt -> Pt-ptMax = ptOp max---- | Convert from polar to rectangular co-ordinates.-polarToRectangular :: Pt -> Pt-polarToRectangular (Pt r t) = Pt (r * cos t) (r * sin t)---- | Apply a transformation matrix to a point.-ptTransform :: Matrix -> Pt -> Pt-ptTransform (Matrix a b c d e f) (Pt x y) =-    let x' = x * a + y * c + e-        y' = x * b + y * d + f-    in  Pt x' y'--{----pt :: (Double, Double) -> Pt-pt (x,y) = Pt x y--ptX :: Pt -> Double-ptX (Pt x _) = x--ptY :: Pt -> Double-ptY (Pt _ y) = y--hypot :: (Floating a) => a -> a -> a-hypot x y = sqrt (x * x + y * y)--distance :: Pt -> Pt -> Double-distance (Pt x1 y1) (Pt x2 y2) = hypot (x2 - x1) (y2 - y1)--rectangularToPolar :: Pt -> Pt-rectangularToPolar (Pt x y)-    | (x == 0) && (y == 0) = Pt 0 t-    | otherwise = Pt (atan2 y x) t-    where t = hypot x y----}
Graphics/PS/Query.hs view
@@ -3,13 +3,12 @@                          ,mkValid                          ,approx, close) where -import Graphics.PS.Pt-import Graphics.PS.Bezier+import Data.CG.Minus {- hcg-minus -} import Graphics.PS.Path  -- | Locate the starting point of the path, which must begin with a -- 'MoveTo' node.-startPt :: Path -> Maybe Pt+startPt :: Path -> Maybe (Pt Double) startPt path =     case path of       MoveTo p -> Just p@@ -18,7 +17,7 @@  -- | Variant that allows the initial node to be a 'LineTo' or -- 'CurveTo' node.-startPt' :: Path -> Maybe Pt+startPt' :: Path -> Maybe (Pt Double) startPt' path =     case path of       MoveTo p -> Just p@@ -35,7 +34,7 @@       Nothing -> path  -- | Locate the end point of the path.-endPt :: Path -> Maybe Pt+endPt :: Path -> Maybe (Pt Double) endPt path =     case path of       MoveTo p -> Just p
Graphics/PS/Statistics.hs view
@@ -1,7 +1,8 @@ -- | 'Path' statistics.-module Graphics.PS.Statistics (Statistics(..)-                              ,pathStatistics) where+module Graphics.PS.Statistics where +import Data.Monoid {- base -}+import Graphics.PS.Image import Graphics.PS.Path  -- | Path statistics data type.@@ -11,12 +12,14 @@                              ,nClosePath :: Integer                              ,nGlyph :: Integer                              ,nTransform :: Integer}+                  deriving (Eq,Show) -plus :: Statistics -> Statistics -> Statistics-plus p q =-    let (Statistics m1 l1 c1 f1 g1 t1) = p-        (Statistics m2 l2 c2 f2 g2 t2) = q-    in Statistics (m1+m2) (l1+l2) (c1+c2) (f1+f2) (g1+g2) (t1+t2)+instance Monoid Statistics where+    mempty = Statistics 0 0 0 0 0 0+    mappend p q =+        let (Statistics m1 l1 c1 f1 g1 t1) = p+            (Statistics m2 l2 c2 f2 g2 t2) = q+        in Statistics (m1+m2) (l1+l2) (c1+c2) (f1+f2) (g1+g2) (t1+t2)  -- | Determine number of path components of each type. pathStatistics :: Path -> Statistics@@ -27,6 +30,9 @@       CurveTo _ _ _ -> Statistics 0 0 1 0 0 0       ClosePath _ -> Statistics 0 0 0 1 0 0       Text _ s -> Statistics 0 0 0 0 (fromIntegral (length s)) 0-      PTransform _ p -> Statistics 0 0 0 0 0 1 `plus` pathStatistics p-      Join p1 p2 -> pathStatistics p1 `plus` pathStatistics p2+      PTransform _ p -> Statistics 0 0 0 0 0 1 <> pathStatistics p+      Join p1 p2 -> pathStatistics p1 <> pathStatistics p2 +-- | Statistics for all 'paths' at 'Image'.+imageStatistics :: Image -> Statistics+imageStatistics = mconcat . map pathStatistics . paths
Graphics/PS/Transform.hs view
@@ -1,27 +1,27 @@+{-# Language FlexibleInstances #-} -- | Class and associated functions for 'Matrix' transformations. module Graphics.PS.Transform (Transformable                              ,translate, scale, rotate) where -import Graphics.PS.Matrix-import Graphics.PS.Pt+import Data.CG.Minus {- hcg-minus -} import qualified Graphics.PS.Path as P import qualified Graphics.PS.Image as I  -- | Values that can be transformed in relation to a 'Matrix'. class Transformable a where-    transform :: Matrix -> a -> a+    transform :: Matrix Double -> a -> a  -- | Translation in /x/ and /y/. translate :: (Transformable a) => Double -> Double -> a -> a-translate x = transform . translation x+translate x = transform . mx_translation x  -- | Scaling in /x/ and /y/. scale :: (Transformable a) => Double -> Double -> a -> a-scale x = transform . scaling x+scale x = transform . mx_scaling x  -- | Rotation, in radians. rotate :: (Transformable a) => Double -> a -> a-rotate = transform . rotation+rotate = transform . mx_rotation  instance Transformable I.Image where     transform = I.ITransform@@ -29,8 +29,8 @@ instance Transformable P.Path where     transform = P.PTransform -instance Transformable Pt where-    transform = ptTransform+instance Transformable (Pt Double) where+    transform = pt_transform  {-- import Graphics.PS.Pt
Help/fractals.hs view
@@ -60,7 +60,7 @@         y' = y * 500         z' = z * 64         shift = translate x' y' . scale z' z'-    in gfill g (shift (rectangle origin 1 1))+    in gfill g (shift (rectangle pt_origin 1 1)) rectangle_ _ = error "illegal rectangle_"  -- | A random scattering of filled grey rectangles.@@ -78,7 +78,7 @@         y' = y * 500         z' = z * 64         shift = translate x' y' . scale z' z'-    in (gstroke' g . shift . mkValid) (arc origin 1 0 (1.5 * pi))+    in (gstroke' g . shift . mkValid) (arc pt_origin 1 0 (1.5 * pi)) semiarc _ = error "illegal semiarc"  -- | A random scattering of stroked arcs.@@ -97,7 +97,7 @@         ir' = min ir xr         xr' = max ir xr         shift = translate x y . scale z z-    in f g $ shift $ mkValid $ annular origin ir' xr' sa' a'+    in f g $ shift $ mkValid $ annular pt_origin ir' xr' sa' a' semiann _ _ = error "illegal semiann"  -- | A random set of annular sections.@@ -121,14 +121,14 @@         s n = gstroke' n . normalize     in s 0 c `over` s 0.5 l -startPt_ :: Path -> Pt+startPt_ :: Path -> Pt Double startPt_ = fromJust . startPt -endPt_ :: Path -> Pt+endPt_ :: Path -> Pt Double endPt_ = fromJust . endPt  --arcd_ex :: Image-arcd_ex :: (Pt -> Double -> Double -> Double -> Path) -> Image+arcd_ex :: (Pt Double -> Double -> Double -> Double -> Path) -> Image arcd_ex arcd =     let c = Pt 0.5 0.5         r = 0.4@@ -162,7 +162,7 @@        , gstroke 0 fractal_sqr'        , gstroke 0 arrows        , gstroke 0 (flatten arrows)-       , f 0 (sierpinski origin 0.5 0.01)+       , f 0 (sierpinski pt_origin 0.5 0.01)        , simpleText        , rectangles        , semiarcs
README view
@@ -1,8 +1,22 @@-hps - haskell postscript+hps+--- -partial and trivial postcript rendering+[haskell][hs] [postscript][ps] -(c) rohan drape and others, 2006-2011-    gpl.2, http://gnu.org/copyleft/-    with contributions by declan murphy & henning thielemann-    see darcs history for details+partial and trivial rendering of the post script drawing model.++[hs]: http://haskell.org+[ps]: http://adobe.com/products/postscript/++© [rohan drape][rd] and others, 2006-2012,+[gpl][gpl]. with contributions by:++- declan murphy+- henning thielemann++see the [darcs][darcs] [history][history] for details++[rd]:  http://rd.slavepianos.org/+[gpl]: http://gnu.org/copyleft/+[darcs]: http://darcs.net/+[history]:  http://rd.slavepianos.org/r/d/darcsweb.cgi?r=hps
hps.cabal view
@@ -1,28 +1,25 @@ Name:              hps-Version:           0.11+Version:           0.14 Synopsis:          Haskell Postscript Description:       Haskell library partially implementing the                    postscript drawing model. License:           GPL Category:          Graphics-Copyright:         Rohan Drape, 2006-2011+Copyright:         Rohan Drape, 2006-2013 Author:            Rohan Drape and others Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://slavepianos.org/rd/?t=hps-Tested-With:       GHC == 7.2.2+Homepage:          http://rd.slavepianos.org/?t=hps+Tested-With:       GHC == 7.6.1 Build-Type:	   Simple Cabal-Version:     >= 1.8  Data-files:        README  Library-  Build-Depends:   base == 4.*+  Build-Depends:   base == 4.*, hcg-minus == 0.14   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Graphics.PS-                   Graphics.PS.Pt-                   Graphics.PS.Matrix-                   Graphics.PS.Bezier                    Graphics.PS.Path                    Graphics.PS.Path.Graphs                    Graphics.PS.Glyph@@ -36,11 +33,17 @@                    Graphics.PS.PS                    Graphics.PS.Unit +Flag build-exec+ default:          False+ Executable hps-fractals+  If !flag(build-exec)+   buildable:      False   hs-source-dirs:  . Help   Build-Depends:   base == 4.*,                    directory,                    filepath,+                   hcg-minus == 0.14,                    random   Main-Is:         fractals.hs   Ghc-Options:     -Wall -fwarn-tabs@@ -48,4 +51,4 @@  Source-Repository  head   Type:            darcs-  Location:        http://slavepianos.org/rd/sw/hps+  Location:        http://rd.slavepianos.org/sw/hps