hps 0.15 → 0.16

raw patch · 17 files changed

+513/−588 lines, 17 filesdep +processdep −directorydep −randomdep ~hcg-minusPVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependencies removed: directory, random

Dependency ranges changed: hcg-minus

API changes (from Hackage documentation)

Files

• Graphics/PS/Font.hs +1/−1
• Graphics/PS/GS.hs +10/−10
• Graphics/PS/Glyph.hs +1/−1
• Graphics/PS/Image.hs +9/−1
• Graphics/PS/PS.hs +169/−166
• Graphics/PS/Paper.hs +61/−80
• Graphics/PS/Paper/Names.hs +94/−0
• Graphics/PS/Path.hs +65/−47
• Graphics/PS/Path/Graphs.hs +2/−2
• Graphics/PS/Query.hs +35/−20
• Graphics/PS/Statistics.hs +1/−0
• Graphics/PS/Transform.hs +15/−15
• Graphics/PS/Unit.hs +16/−8
• Graphics/PS/Util.hs +19/−0
• Help/fractals.hs +0/−205
• README +6/−11
• hps.cabal +9/−21

@@ -1,5 +1,5 @@ -- | Font type and functions.-module Graphics.PS.Font (Font(..)) where+module Graphics.PS.Font where  -- | Font data type. data Font = Font {fontName :: String

@@ -1,10 +1,5 @@ -- | PS graphics state.-module Graphics.PS.GS (GS(..)-                      ,LineCap(..)-                      ,LineJoin(..)-                      ,LineWidth-                      ,Color(..)-                      ,defaultGS, greyGS) where+module Graphics.PS.GS where  -- | Line cap enumeration. data LineCap = ButtCap@@ -21,12 +16,17 @@               | BevelJoin                 deriving (Eq, Show, Enum) --- | Colour model.-data Color = RGB Double Double Double+-- | Colour model.  Postscript doesn't support alpha, but store it for PDF rendering etc.+data Color = RGBA Double Double Double Double              deriving (Eq, Show)  -- | Graphics state.-data GS = GS Color LineWidth LineCap LineJoin ([Int], Int) Double+data GS = GS {gs_color :: Color+             ,gs_line_width :: LineWidth+             ,gs_line_cap :: LineCap+             ,gs_line_join :: LineJoin+             ,gs_dash :: ([Int], Int)+             ,gs_miter_limit :: Double}           deriving (Eq, Show)  -- | Default 'GS' of indicated 'Color'.@@ -35,7 +35,7 @@  -- | Default 'GS' of indicated shade of grey. greyGS :: Double -> GS-greyGS g = defaultGS (RGB g g g)+greyGS g = defaultGS (RGBA g g g 1)  {-- blackGS :: GS

@@ -1,5 +1,5 @@ -- | Glyph data type.-module Graphics.PS.Glyph (Glyph) where+module Graphics.PS.Glyph where  -- | Character data type. type Glyph = Char

@@ -1,7 +1,10 @@ -- | Image type and functions. module Graphics.PS.Image where -import Data.CG.Minus {- hcg-minus -}+import Data.Monoid (Monoid, mappend, mconcat, mempty) {- base (obsolete) -}++import Data.CG.Minus.Types {- hcg-minus -}+ import Graphics.PS.Path import Graphics.PS.GS @@ -12,6 +15,11 @@            | Over Image Image            | Empty              deriving (Eq, Show)++instance Monoid Image where+    mempty = Empty+    mappend = Over+    mconcat = foldr Over Empty  -- | Layer one 'Image' over another. over :: Image -> Image -> Image

@@ -1,14 +1,13 @@ -- | Postscript generator.-module Graphics.PS.PS (ps,eps,stringFromPS) where+module Graphics.PS.PS where  import Data.CG.Minus {- hcg-minus -}-import Data.List-import Data.Monoid (Monoid, mappend, mempty, mconcat, Endo(Endo,appEndo), )-import System.IO+import Data.List {- base -}+import Data.Monoid {- base -}+import System.IO {- base -}  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@@ -26,50 +25,56 @@         | Dict [(PS,PS)]         | Seq [PS] -dsc :: String -> [String] -> PS-dsc k [] = Comment ('%' : k)-dsc k v = Comment (concat ("%" : k : ": " : intersperse " " v))+dscPS :: String -> [String] -> PS+dscPS k v =+    case v of+      [] -> Comment ('%' : k)+      _ ->Comment (concat ("%" : k : ": " : intersperse " " v)) -header,headerEps :: PS-header = Comment "!PS-Adobe-3.0"-headerEps = Comment "!PS-Adobe-3.0 EPSF-3.0"+headerPS :: PS+headerPS = Comment "!PS-Adobe-3.0" -title :: String -> PS-title t = dsc "Title" [t]+headerEPS :: PS+headerEPS = Comment "!PS-Adobe-3.0 EPSF-3.0" -creator :: String -> PS-creator t = dsc "Creator" [t]+titlePS :: String -> PS+titlePS t = dscPS "Title" [t] -languageLevel :: Int -> PS-languageLevel n = dsc "LanguageLevel" [show n]+creatorPS :: String -> PS+creatorPS t = dscPS "Creator" [t] -pages :: Int -> PS-pages n = dsc "Pages" [show n]+languageLevelPS :: Int -> PS+languageLevelPS n = dscPS "LanguageLevel" [show n] -bbox :: P.BBox -> PS-bbox (P.BBox i j k l) = dsc "BoundingBox" [show i,show j,show k,show l]-bbox (P.HRBBox i j k l i' j' k' l') =-    Seq [dsc "BoundingBox" [show i,show j,show k,show l],-         dsc "HiResBoundingBox" [show i',show j',show k',show l']]+pagesPS :: Int -> PS+pagesPS n = dscPS "Pages" [show n] -endComments :: PS-endComments = dsc "EndComments" []+bboxPS :: P.BBox -> PS+bboxPS b =+    case b of+      P.BBox i j k l -> dscPS "BoundingBox" [show i,show j,show k,show l]+      P.HRBBox i j k l i' j' k' l' ->+          Seq [dscPS "BoundingBox" [show i,show j,show k,show l],+               dscPS "HiResBoundingBox" [show i',show j',show k',show l']] -page :: (Show a) => String -> a -> PS-page t n = dsc "Page" [t, show n]+endCommentsPS :: PS+endCommentsPS = dscPS "EndComments" [] -trailer :: PS-trailer = dsc "Trailer" []+pagePS :: (Show a) => String -> a -> PS+pagePS t n = dscPS "Page" [t, show n] -eof :: PS-eof = dsc "EOF" []+trailerPS :: PS+trailerPS = dscPS "Trailer" [] -documentMedia :: String -> Int -> Int -> PS-documentMedia tag w h = dsc "DocumentMedia" [tag, show w, show h, "0", "()", "()"]+eofPS :: PS+eofPS = dscPS "EOF" [] -alias :: String -> String -> PS-alias o a = Seq [LName a, Proc [Name o], Op "def"]+documentMediaPS :: String -> Int -> Int -> PS+documentMediaPS tag w h = dscPS "DocumentMedia" [tag, show w, show h, "0", "()", "()"] +aliasPS :: String -> String -> PS+aliasPS o a = Seq [LName a, Proc [Name o], Op "def"]+ pdfCompat :: [(String, String)] pdfCompat = [("gsave",                "q"),              ("grestore",             "Q"),@@ -90,159 +95,157 @@              ("selectfont",           "Tf"),              ("clip",                 "W")] -prolog :: PS-prolog =-    let f (a,b) = alias a b+prologPS :: PS+prologPS =+    let f (a,b) = aliasPS a b     in Seq (map f pdfCompat) -stroke :: PS-stroke = Op "S"+strokePS :: PS+strokePS = Op "S" -fill :: PS-fill = Op "f"+fillPS :: PS+fillPS = Op "f" -false :: PS-false = Name "false"+falsePS :: PS+falsePS = Name "false" -save :: PS-save = Op "q"+savePS :: PS+savePS = Op "q" -restore :: PS-restore = Op "Q"+restorePS :: PS+restorePS = Op "Q" -showPage :: PS-showPage = Op "showpage"+showPagePS :: PS+showPagePS = Op "showpage" -rgb :: Color -> PS-rgb (RGB r g b) = Seq [Double r, Double g, Double b, Op "RG"]+rgbaPS :: Color -> PS+rgbaPS (RGBA r g b _) = Seq [Double r, Double g, Double b, Op "RG"] -lineWidth :: Double -> PS-lineWidth w = Seq [Double w, Op "w"]+lineWidthPS :: Double -> PS+lineWidthPS w = Seq [Double w, Op "w"] -lineCap :: (Enum a) => a -> PS-lineCap c = Seq [Int (fromEnum c), Op "j"]+lineCapPS :: (Enum a) => a -> PS+lineCapPS c = Seq [Int (fromEnum c), Op "j"] -lineJoin :: (Enum a) => a -> PS-lineJoin j = Seq [Int (fromEnum j), Op "J"]+lineJoinPS :: (Enum a) => a -> PS+lineJoinPS j = Seq [Int (fromEnum j), Op "J"] -dash :: [Int] -> Int -> PS-dash d o = Seq [Array (map Int d), Int o, Op "d"]+dashPS :: [Int] -> Int -> PS+dashPS d o = Seq [Array (map Int d), Int o, Op "d"] -miterLimit :: Double -> PS-miterLimit m = Seq [Double m, Op "M"]+miterLimitPS :: Double -> PS+miterLimitPS m = Seq [Double m, Op "M"] -moveTo :: Pt Double -> PS-moveTo (Pt x y) = Seq [Double x, Double y, Op "m"]+moveToPS :: Pt Double -> PS+moveToPS (Pt x y) = Seq [Double x, Double y, Op "m"] -lineTo :: Pt Double -> PS-lineTo (Pt x y) = Seq [Double x, Double y, Op "l"]+lineToPS :: Pt Double -> PS+lineToPS (Pt x y) = Seq [Double x, Double y, Op "l"] -transform :: Matrix Double -> PS-transform m = Seq [Transform m, Op "cm"]+transformPS :: Matrix Double -> PS+transformPS m = Seq [Transform m, Op "cm"] -curveTo :: Pt Double -> Pt Double -> Pt Double -> PS-curveTo a b c = Seq (map Double (ls_xy [a,b,c]) ++ [Op "c"])+curveToPS :: Pt Double -> Pt Double -> Pt Double -> PS+curveToPS a b c = Seq (map Double (ls_xy (Ls [a,b,c])) ++ [Op "c"]) -closePath :: Pt Double -> PS-closePath (Pt x y) = Seq [Double x, Double y, Op "h"]+closePathPS :: Pt Double -> PS+closePathPS (Pt x y) = Seq [Double x, Double y, Op "h"] -selectFont :: Font -> PS-selectFont (Font f n) = Seq [LName f, Double n, Op "Tf"]+selectFontPS :: Font -> PS+selectFontPS (Font f n) = Seq [LName f, Double n, Op "Tf"] -charPath :: String -> PS-charPath g = Seq [String g, false, Op "charpath"]+charPathPS :: String -> PS+charPathPS g = Seq [String g, falsePS, Op "charpath"] -gs :: GS -> PS-gs (GS c w k j (d, o) m) =-    Seq [rgb c-        ,lineWidth w-        ,lineCap k-        ,lineJoin j-        ,dash d o-        ,miterLimit m]+gsPS :: GS -> PS+gsPS (GS c w k j (d, o) m) =+    Seq [rgbaPS c+        ,lineWidthPS w+        ,lineCapPS k+        ,lineJoinPS j+        ,dashPS d o+        ,miterLimitPS m] -path :: Path -> PS-path (MoveTo p) = moveTo p-path (LineTo p) = lineTo p-path (Text f g) = Seq [selectFont f, charPath g]-path (CurveTo c1 c2 p) = curveTo c1 c2 p-path (ClosePath p) = closePath p-path (PTransform m p) = Seq [transform m, path p]-path (Join a b) = Seq [path a, path b]+pathPS :: Path -> PS+pathPS path =+    case path of+      MoveTo p -> moveToPS p+      LineTo p -> lineToPS p+      Text f g -> Seq [selectFontPS f, charPathPS g]+      CurveTo c1 c2 p -> curveToPS c1 c2 p+      ClosePath p -> closePathPS p+      PTransform m p -> Seq [transformPS m, pathPS p]+      Join a b -> Seq [pathPS a, pathPS b] -image :: I.Image -> PS-image I.Empty = Comment "Empty"-image (I.Stroke g p) = Seq [path p, gs g, stroke]-image (I.Fill g p) = Seq [path p, gs g, fill]-image (I.ITransform m i) = Seq [transform m, image i]-image (I.Over a b) = Seq [save-                         ,image b-                         ,restore-                         ,image a]+imagePS :: I.Image -> PS+imagePS img =+    case img of+      I.Empty -> Comment "Empty"+      I.Stroke g p -> Seq [pathPS p, gsPS g, strokePS]+      I.Fill g p -> Seq [pathPS p, gsPS g, fillPS]+      I.ITransform m i -> Seq [transformPS m, imagePS i]+      I.Over a b -> Seq [savePS+                        ,imagePS b+                        ,restorePS+                        ,imagePS a]  infixl 1 >+>  (>+>) :: Monoid m => m -> m -> m (>+>) = mappend -bracket :: (Monoid m) =>-    (String -> m) -> String -> String -> [a] -> (a -> m) -> m-bracket f o c p g =+ps_bracket :: (Monoid m) => (String -> m) -> String -> String -> [a] -> (a -> m) -> m+ps_bracket f o c p g =     let h a = f a >+> f " "     in h o >+> mconcat (map g p) >+> h c -escape :: String -> String-escape = concatMap (\c -> if elem c "()" then ['\\', c] else [c])--put :: (Monoid m) => (String -> m) -> PS -> m-put f (Name n) = f n >+> f " "-put f (LName n) = f "/" >+> f n >+> f " "-put f (Op o) = f o >+> f "\n"-put f (Comment o) = f "%" >+> f o >+> f "\n"-put f (Int n) = f (show n) >+> f " "-put f (Double n) = f (show n) >+> f " "-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 (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)-put f (Seq a) = mconcat (map (put f) a)+ps_escape :: String -> String+ps_escape = concatMap (\c -> if elem c "()" then ['\\', c] else [c]) -ps' :: (I.Image, Int) -> PS-ps' (p, n) = Seq [page "Graphics.PS" n,  image p, showPage]+ps_put :: (Monoid m) => (String -> m) -> PS -> m+ps_put f x =+    case x of+      Name n -> f n >+> f " "+      LName n -> f "/" >+> f n >+> f " "+      Op o -> f o >+> f "\n"+      Comment o -> f "%" >+> f o >+> f "\n"+      Int n -> f (show n) >+> f " "+      Double n -> f (show n) >+> f " "+      String s -> f "(" >+> f (ps_escape s) >+> f ") "+      Array a -> ps_bracket f "[" "]" a (ps_put f)+      Proc p -> ps_bracket f "{" "}" p (ps_put f)+      Transform m -> ps_put f (Array (map Double (mx_list m)))+      Dict d -> let g = concatMap (\(a,b) -> [a,b]) in ps_bracket f "<<" ">>" (g d) (ps_put f)+      Seq a -> mconcat (map (ps_put f) a) -paper_ps :: P.Paper -> P.Paper-paper_ps (P.Paper w h) =-    let f n = floor (mm_pt (fromIntegral n)::Double)-    in P.Paper (f w) (f h)+to_page_seq :: (I.Image, Int) -> PS+to_page_seq (p, n) = Seq [pagePS "Graphics.PS" n, imagePS p, showPagePS] --- | Write a postscript file.  The list of images are written---   one per page.+-- | Write a postscript file.  The list of images are written one per page. ps :: FilePath -> P.Paper -> [I.Image] -> IO ()-ps f d p =-  writeFile f (stringFromPS f d p)+ps f d p = writeFile f (stringFromPS f d p) --- | Generate postscript data given /title/, page size, and a set of--- page 'I.Images'.-stringFromPS :: String -> P.Paper -> [I.Image] -> String-stringFromPS t d p =-  let g = put (\s -> Endo (s++))-      (P.Paper width height) = paper_ps d-  in  flip appEndo "" $-      g header >+>-      g (title t) >+>-      g (creator "Graphics.PS") >+>-      g (languageLevel 2) >+>-      g (pages (length p)) >+>-      g (documentMedia "Default" width height) >+>-      g endComments >+>-      g prolog >+>-      mconcat (map (g . ps') (zip p [1..])) >+>-      g trailer >+>-      g eof+-- | Variant with page (paper) size in points.+stringFromPS_pt :: String -> (Int,Int) -> [I.Image] -> String+stringFromPS_pt t (width,height) p =+  let g = ps_put (\s -> Endo (s++))+  in flip appEndo "" $+     g headerPS >+>+     g (titlePS t) >+>+     g (creatorPS "Graphics.PS") >+>+     g (languageLevelPS 2) >+>+     g (pagesPS (length p)) >+>+     g (documentMediaPS "Default" width height) >+>+     g endCommentsPS >+>+     g prologPS >+>+     mconcat (map (g . to_page_seq) (zip p [1..])) >+>+     g trailerPS >+>+     g eofPS +-- | Generate postscript data given /title/, page size, and a+-- set of page 'I.Images'.+stringFromPS :: String -> P.Paper -> [I.Image] -> String+stringFromPS t p = stringFromPS_pt t (P.paper_size_pt p)  newtype MonadMonoid m = MonadMonoid {appMonadMonoid :: m ()} @@ -252,21 +255,21 @@       MonadMonoid (a >> b)    mconcat = MonadMonoid . mapM_ appMonadMonoid --- | Write an encapsulated postscript file.  The single image---   is written.-eps :: String -> P.BBox -> I.Image -> IO ()-eps f d p =-  withFile f WriteMode $ \h ->-     let g = put (MonadMonoid . hPutStr h)-     in  mapM_ (appMonadMonoid . g) $-            [headerEps-            ,title ("Graphics.PS: " ++ f)-            ,creator "Graphics.PS"-            ,languageLevel 2-            ,bbox d-            ,endComments-            ,prolog-            ,image p]+-- | Write an encapsulated postscript file.  The 'P.BBox' is in+-- points.  The single image is written.+eps :: FilePath -> P.BBox -> I.Image -> IO ()+eps fn d p =+  withFile fn WriteMode $ \h ->+     let g = ps_put (MonadMonoid . hPutStr h)+     in mapM_ (appMonadMonoid . g) $+            [headerEPS+            ,titlePS ("Graphics.PS: " ++ fn)+            ,creatorPS "Graphics.PS"+            ,languageLevelPS 2+            ,bboxPS d+            ,endCommentsPS+            ,prologPS+            ,imagePS p]  {-- 

@@ -1,12 +1,28 @@--- | Paper sizes.--- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.+-- | Paper and BBox. module Graphics.PS.Paper where --- | Paper size data type.-data Paper = Paper {width :: Int+import Graphics.PS.Unit++-- | Enumeration type for Units.+data Units = MM | PT deriving (Eq,Show)++-- | Paper size data type, the units are specified in the type.+-- The units in postscript are points, we often work in millimeters.+data Paper = Paper {units :: Units+                   ,width :: Int                    ,height :: Int}              deriving (Eq,Show) +-- | Translate 'Paper' from mm to points.+--+-- > let a4 = Paper MM 210 297+-- > paper_size_pt a4 == (595,841)+paper_size_pt :: Paper -> (Int,Int)+paper_size_pt (Paper unit w h) =+    case unit of+      MM -> (mm_pt_int w,mm_pt_int h)+      PT -> (w,h)+ -- | BoundingBox for an EPSF file with an optional HiResBoundingBox data BBox = BBox {llx :: Int -- ^ lower left x (x-min)                  ,lly :: Int -- ^ lower left y (y-min)@@ -26,89 +42,54 @@  -- | Swap width and height of 'Paper'. landscape :: Paper -> Paper-landscape (Paper w h) = Paper h w+landscape (Paper u w h) = Paper u h w --- | A 'div' variant that rounds rather than truncates.+-- | Proportion of 'Paper'. ----- > let f (Paper _ h) = h `div` 2 == h `divRound` 2--- > in all id (map f [b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]) == False-divRound :: Int -> Int -> Int-divRound x y =-    let x' = (fromIntegral x)::Double-        y' = (fromIntegral y)::Double-    in round (x' / y')+-- > import Graphics.PS.Paper.Names+-- > proportion broadsheet == 1.25+-- > map (round . (* 1e3) . proportion) [a0,b0,c0] == [1414,1414,1414]+-- > map proportion [usLetter,berliner,tabloid]+proportion :: Paper -> Double+proportion (Paper _ w h) = i_to_d h / i_to_d w --- | ISO size downscaling, ie. from @A0@ to @A1@.------ > iso_down_scale a4 == a5-iso_down_scale :: Paper -> Paper-iso_down_scale (Paper w h) = Paper (h `divRound` 2) w+-- | The margin given by placing paper size /p/ within /q/.+inset_margin :: Paper -> Paper -> (Units,Int,Int)+inset_margin (Paper u1 w1 h1) (Paper u2 w2 h2) =+    if u1 /= u2+    then error "inset_margin: unequal units"+    else (u2,(w2 - w1) `div` 2,(h2 - h1) `div` 2) --- | ISO A sizes in millimeters.------ > a4 == Paper 210 297-a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 :: Paper-a0 = Paper 841 1189-a1 = iso_down_scale a0-a2 = iso_down_scale a1-a3 = iso_down_scale a2-a4 = iso_down_scale a3-a5 = iso_down_scale a4-a6 = iso_down_scale a5-a7 = iso_down_scale a6-a8 = iso_down_scale a7-a9 = iso_down_scale a8-a10 = iso_down_scale a9+-- * BBox --- | ISO B sizes in millimeters.+-- | Sum of 'BBox'. ----- > b4 == Paper 250 354-b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10 :: Paper-b0 = Paper 1000 1414-b1 = iso_down_scale b0-b2 = iso_down_scale b1-b3 = iso_down_scale b2-b4 = iso_down_scale b3-b5 = iso_down_scale b4-b6 = iso_down_scale b5-b7 = iso_down_scale b6-b8 = iso_down_scale b7-b9 = iso_down_scale b8-b10 = iso_down_scale b9+-- > bbox_sum (BBox 5 5 10 10) (BBox 0 0 2 20) == BBox 0 0 10 20+bbox_sum :: BBox -> BBox -> BBox+bbox_sum p q =+    case (p,q) of+      (BBox x0 y0 x1 y1,BBox x2 y2 x3 y3) ->+          BBox (min x0 x2) (min y0 y2) (max x1 x3) (max y1 y3)+      _ -> error "bbox_sum: HR not handled" --- | ISO C sizes in millimeters.------ > c4 == Paper 229 324-c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10 :: Paper-c0 = Paper 917 1297-c1 = iso_down_scale c0-c2 = iso_down_scale c1-c3 = iso_down_scale c2-c4 = iso_down_scale c3-c5 = iso_down_scale c4-c6 = iso_down_scale c5-c7 = iso_down_scale c6-c8 = iso_down_scale c7-c9 = iso_down_scale c8-c10 = iso_down_scale c9+-- | Translate 'BBox' from mm to points.+bbox_mm_to_pt :: BBox -> BBox+bbox_mm_to_pt bb =+    case bb of+      BBox x y x' y' ->+          BBox (mm_pt_int x) (mm_pt_int y) (mm_pt_int x') (mm_pt_int y')+      HRBBox x y x' y' hx hy hx' hy' ->+          HRBBox (mm_pt_int x) (mm_pt_int y) (mm_pt_int x') (mm_pt_int y')+                 (mm_pt hx) (mm_pt hy) (mm_pt hx') (mm_pt hy') --- | US Letter size in millimeters (ie 'Paper' @216 279@).-usLetter :: Paper-usLetter = Paper 216 279+{- | A 'div' variant that rounds rather than truncates. --- | Newspaper sizes in millimeters.--- See <http://www.papersizes.org/newspaper-sizes.htm>.-broadsheet,berliner,tabloid :: Paper-broadsheet = Paper 600 750-berliner = Paper 315 470-tabloid = Paper 280 430+> let f (Paper _ h _) = h `div` 2 == h `divRound` 2+> in all id (map f [b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]) == False --- | Proportion of 'Paper'.------ > proportion broadsheet == 1.25--- > map (round . (* 1e3) . proportion) [a0,b0,c0] == [1414,1414,1414]--- > map proportion [usLetter,berliner,tabloid]-proportion :: Paper -> Double-proportion p =-    let f = fromIntegral-    in f (height p) / f (width p)+-}+divRound :: Int -> Int -> Int+divRound x y =+    let x' = (fromIntegral x)::Double+        y' = (fromIntegral y)::Double+    in round (x' / y')

@@ -0,0 +1,94 @@+-- | Names of paper sizes.+-- For ISO sizes see <http://www.cl.cam.ac.uk/~mgk25/iso-paper.html>.+module Graphics.PS.Paper.Names where++import Graphics.PS.Paper++-- | ISO size downscaling, ie. from @A0@ to @A1@.+--+-- > iso_down_scale a4 == a5+iso_down_scale :: Paper -> Paper+iso_down_scale (Paper u w h) = Paper u (h `divRound` 2) w++-- | JIS size downscaling, truncates instead of rounding.+jis_down_scale :: Paper -> Paper+jis_down_scale (Paper u w h) = Paper u (h `div` 2) w++-- | ISO A sizes in millimeters.+--+-- > a4 == Paper 210 297+a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10 :: Paper+a0 = Paper MM 841 1189+a1 = iso_down_scale a0+a2 = iso_down_scale a1+a3 = iso_down_scale a2+a4 = iso_down_scale a3+a5 = iso_down_scale a4+a6 = iso_down_scale a5+a7 = iso_down_scale a6+a8 = iso_down_scale a7+a9 = iso_down_scale a8+a10 = iso_down_scale a9++-- | ISO B sizes in millimeters.+--+-- > b4 == Paper 250 354+-- > inset_margin b4 a3 == (23,33)+b0,b1,b2,b3,b4,b5,b6,b7,b8,b9,b10 :: Paper+b0 = Paper MM 1000 1414+b1 = iso_down_scale b0+b2 = iso_down_scale b1+b3 = iso_down_scale b2+b4 = iso_down_scale b3+b5 = iso_down_scale b4+b6 = iso_down_scale b5+b7 = iso_down_scale b6+b8 = iso_down_scale b7+b9 = iso_down_scale b8+b10 = iso_down_scale b9++-- | JIS B sizes+--+-- > jis_b4 == Paper 257 364+-- > (proportion b0,proportion jis_b0) == (1.414,1.4135922330097088)+--+-- > inset_margin jis_b4 a3 == (20,28)+jis_b0,jis_b1,jis_b2,jis_b3,jis_b4,jis_b5,jis_b6,jis_b7,jis_b8,jis_b9,jis_b10 :: Paper+jis_b0 = Paper MM 1030 1456+jis_b1 = jis_down_scale jis_b0+jis_b2 = jis_down_scale jis_b1+jis_b3 = jis_down_scale jis_b2+jis_b4 = jis_down_scale jis_b3+jis_b5 = jis_down_scale jis_b4+jis_b6 = jis_down_scale jis_b5+jis_b7 = jis_down_scale jis_b6+jis_b8 = jis_down_scale jis_b7+jis_b9 = jis_down_scale jis_b8+jis_b10 = jis_down_scale jis_b9++-- | ISO C sizes in millimeters.+--+-- > c4 == Paper 229 324+c0,c1,c2,c3,c4,c5,c6,c7,c8,c9,c10 :: Paper+c0 = Paper MM 917 1297+c1 = iso_down_scale c0+c2 = iso_down_scale c1+c3 = iso_down_scale c2+c4 = iso_down_scale c3+c5 = iso_down_scale c4+c6 = iso_down_scale c5+c7 = iso_down_scale c6+c8 = iso_down_scale c7+c9 = iso_down_scale c8+c10 = iso_down_scale c9++-- | US Letter size in millimeters (ie 'Paper' @216 279@).+usLetter :: Paper+usLetter = Paper MM 216 279++-- | Newspaper sizes in millimeters.+-- See <http://www.papersizes.org/newspaper-sizes.htm>.+broadsheet,berliner,tabloid :: Paper+broadsheet = Paper MM 600 750+berliner = Paper MM 315 470+tabloid = Paper MM 280 430

@@ -1,12 +1,11 @@ -- | Path type and functions.-module Graphics.PS.Path (Path(..),(+++)-                        ,line,polygon,rectangle-                        ,arc,arcNegative,annular-                        ,flatten-                        ,renderLines,renderLines') where+module Graphics.PS.Path where  import Data.List {- base -}+import Data.Monoid (Monoid, mappend, mconcat, mempty) {- base (obsolete) -}+ import Data.CG.Minus {- hcg-minus -}+ import Graphics.PS.Glyph import Graphics.PS.Font @@ -20,6 +19,12 @@           | Join Path Path             deriving (Eq,Show) +instance Monoid Path where+    mempty = MoveTo (Pt 0 0)+    mappend = Join+    mconcat [] = mempty+    mconcat paths = combine paths+ -- | Infix notation for 'Join'. (+++) :: Path -> Path -> Path (+++) = Join@@ -52,12 +57,15 @@         ul = Pt x (y + h)     in polygon [ll,lr,ur,ul] -type ArcP = (Pt Double,Pt Double,Pt Double,Pt Double)-data Arc = Arc1 ArcP-         | Arc2 ArcP ArcP+-- | An arc segment, as starting point and values for the curveto operator.+type Arc_Seg n = (Pt n,Pt n,Pt n,Pt n) --- (x,y) = center,r = radius,a = start angle,b = end angle-arcp :: Pt Double -> Double -> Double -> Double -> ArcP+-- | An arc, given as either one or two segments.+data Arc n = Arc1 (Arc_Seg n)+           | Arc2 (Arc_Seg n) (Arc_Seg n)++-- | Arc segment, (x,y) = center,r = radius,a = start angle,b = end angle.+arcp :: Pt Double -> Double -> Double -> Double -> Arc_Seg Double arcp (Pt x y) r a b =     let ca = cos a         sa = sin a@@ -70,9 +78,10 @@         p3 = Pt (x + r * cb) (y + r * sb)     in (p0,p1,p2,p3) --- 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 -> Double -> Arc+-- | Arc, 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 segments.+arca :: Pt Double -> Double -> Double -> Double -> Arc Double arca c r a b =     let d = abs (b - a)         b' = b - (d / 2)@@ -80,36 +89,39 @@        then Arc2 (arcp c r a b') (arcp c r b' b)        else Arc1 (arcp c r a b) ----arc' :: Arc -> Path-arc' (Arc1 (p0,p1,p2,p3)) =-    let m = MoveTo p0-        c = CurveTo p1 p2 p3-    in m +++ c-arc' (Arc2 (p0,p1,p2,p3) (_,p5,p6,p7)) =-    let m = MoveTo p0-        c1 = CurveTo p1 p2 p3-        c2 = CurveTo p5 p6 p7-    in m +++ c1 +++ c2+-- | 'Path' of 'Arc'.+arc_to_path :: Arc Double -> Path+arc_to_path a =+    case a of+      Arc1 (p0,p1,p2,p3) -> MoveTo p0 +++ CurveTo p1 p2 p3+      Arc2 (p0,p1,p2,p3) (_,p5,p6,p7) -> MoveTo p0 +++ CurveTo p1 p2 p3 +++ CurveTo p5 p6 p7 +-- | Variant of 'arca' allowing b to be less than a.+arca_udir :: Pt Double -> Double -> Double -> Double -> Arc Double+arca_udir c r a b =+    let b' = if b < a then b + 2 * pi else b+    in arca c r a b'++-- | 'arca_udir' with a and b reversed.+arcNegative_udir :: Pt Double -> Double -> Double -> Double -> Arc Double+arcNegative_udir c r a b =+    let b' = if b > a then b - 2 * pi else b+    in arca c r b' a+ -- | Arc given by a central point,a radius,and start and end angles. 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))+arc c r a = arc_to_path . arca_udir c r a  -- | Negative arc. 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)+arcNegative c r a = arc_to_path . arcNegative_udir c r a --- (x,y) = center,ir = inner radius,xr = outer radius,sa = start--- angle,a = angle,ea = end angle+type Annular n = (Pt n,Pt n,Arc n,Pt n,Arc n) --- | Annular segment.-annular :: Pt Double -> Double -> Double -> Double -> Double -> Path-annular (Pt x y) ir xr sa a =+-- | (x,y) = center,ir = inner radius,xr = outer radius,sa = start+-- angle,a = angle,ea = end angle+annular_f :: Pt Double -> Double -> Double -> Double -> Double -> Annular Double+annular_f (Pt x y) ir xr sa a =     let ea = sa + a         x2 = x + ir * cos sa -- ll         y2 = y + ir * sin sa@@ -117,20 +129,26 @@         y3 = y + xr * sin sa         x4 = x + ir * cos ea -- lr         y4 = y + ir * sin ea-    in combine [MoveTo (Pt x2 y2)-               ,LineTo (Pt x3 y3)-               ,arc (Pt x y) xr sa ea-               ,LineTo (Pt x4 y4)-               ,arcNegative (Pt x y) ir ea sa]+    in (Pt x2 y2+       ,Pt x3 y3+       ,arca_udir (Pt x y) xr sa ea+       ,Pt x4 y4+       ,arcNegative_udir (Pt x y) ir ea sa) -flatten' :: Matrix Double -> Path -> Path-flatten' m path =+-- | Annular segment.+annular :: Pt Double -> Double -> Double -> Double -> Double -> Path+annular c ir xr sa a =+    let (p1,p2,a1,p3,a2) = annular_f c ir xr sa a+    in combine [MoveTo p1,LineTo p2,arc_to_path a1,LineTo p3,arc_to_path a2]++flatten_f :: Matrix Double -> Path -> Path+flatten_f m path =     case path of       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)+      PTransform m' p -> flatten_f (m' * m) p+      Join a b -> Join (flatten_f m a) (flatten_f m b)       CurveTo p q r -> let f = pt_transform m                        in CurveTo (f p) (f q) (f r)       Text _ _ -> error "cannot flatten text"@@ -138,7 +156,7 @@ -- | Apply any transformations at path.  The resulting path will not --   have any 'PTransform' nodes. flatten :: Path -> Path-flatten = flatten' mx_identity+flatten = flatten_f mx_identity  -- | Render each (p1,p2) as a distinct line. renderLines :: [Ln Double] -> Path@@ -147,8 +165,8 @@     in foldl f (MoveTo pt_origin)  -- | Collapse line sequences into a single line.-renderLines' :: [Ln Double] -> Path-renderLines' =+renderLines_jn :: [Ln Double] -> Path+renderLines_jn =     let g p (Ln a b) = if p == a                        then (b,Right b)                        else (b,Left (Ln a b))

@@ -22,9 +22,9 @@ fractal_sqr :: Path fractal_sqr = renderLines (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12) --- | 'renderLines'' variant of 'fractal_sqr'.+-- | 'renderLines_jn' variant of 'fractal_sqr'. fractal_sqr' :: Path-fractal_sqr' = renderLines' (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)+fractal_sqr' = renderLines_jn (fractal_sqr_pt (Pt 250 250) (Pt 175 175) 12)  -- | A /unit/ arrow. unitArrow :: Int -> Path

@@ -1,13 +1,14 @@ -- | 'Path' query functions and related operations.-module Graphics.PS.Query (startPt, endPt-                         ,mkValid-                         ,approx, close) where+module Graphics.PS.Query where -import Data.CG.Minus {- hcg-minus -}+import Data.CG.Minus.Types {- hcg-minus -}+import qualified Data.CG.Minus as CG {- hcg-minus -}+import qualified Data.CG.Minus.Bezier as CG {- hcg-minus -}++import Graphics.PS.Paper import Graphics.PS.Path --- | Locate the starting point of the path, which must begin with a--- 'MoveTo' node.+-- | Locate the starting point of the path, which must begin with a 'MoveTo' node. startPt :: Path -> Maybe (Pt Double) startPt path =     case path of@@ -15,8 +16,7 @@       Join p _ -> startPt p       _ -> Nothing --- | Variant that allows the initial node to be a 'LineTo' or--- 'CurveTo' node.+-- | Variant that allows the initial node to be a 'LineTo' or 'CurveTo' node. startPt' :: Path -> Maybe (Pt Double) startPt' path =     case path of@@ -59,26 +59,41 @@       Join a (CurveTo p2 p3 p4) ->           let is = [0, (1.0/n) .. 1.0]               l = case endPt a of-                    Just p1 -> map (bezier4 p1 p2 p3 p4) is+                    Just p1 -> map (CG.bezier4 p1 p2 p3 p4) is                     Nothing -> []           in a +++ line l       _ -> path -{--+-- | Rectangle, given as lower left and upper right points.+data Rect a = Rect {rect_ll :: Pt a+                   ,rect_ur :: Pt a}+              deriving (Eq,Show) -data BBox = BBox Pt Pt-            deriving (Eq, Show)+-- | Sum (join) of two 'Rect'.+rect_sum :: Ord a => Rect a -> Rect a -> Rect a+rect_sum (Rect a b) (Rect c d) = Rect (CG.pt_min a c) (CG.pt_max b d) -import Graphics.PS.Transform+-- | Rectangle bounding a (simple) 'Path'.+path_rect :: Path -> Rect Double+path_rect path =+    case path of+      MoveTo p -> Rect p p+      LineTo p -> Rect p p+      CurveTo c0 c1 p0 -> Rect (foldl1 CG.pt_min [c0,c1,p0]) (foldl1 CG.pt_max [c0,c1,p0])+      Join p q -> path_rect p `rect_sum` path_rect q+      _ -> error "path_rect: illegal query" -bboxSum :: BBox -> BBox -> BBox-bboxSum (BBox a b) (BBox c d) = BBox (ptMin a c) (ptMax b d)+-- | Translate 'Rect' to 'BBox'.+rect_to_bbox :: RealFrac a => Rect a -> BBox+rect_to_bbox (Rect (Pt x0 y0) (Pt x1 y1)) = BBox (floor x0) (floor y0) (ceiling x1) (ceiling y1) -bbox :: Path -> BBox-bbox (MoveTo p) = BBox p p-bbox (LineTo p) = BBox p p-bbox (Join a b) = bbox a `bboxSum` bbox b-bbox _ = error "illegal Query"+path_to_bbox :: Path -> BBox+path_to_bbox = rect_to_bbox . path_rect++{--+++import Graphics.PS.Transform  join :: Path -> Path -> Path join a b = a +++ translate x y b

@@ -2,6 +2,7 @@ module Graphics.PS.Statistics where  import Data.Monoid {- base -}+ import Graphics.PS.Image import Graphics.PS.Path 

@@ -1,36 +1,36 @@ {-# Language FlexibleInstances #-} -- | Class and associated functions for 'Matrix' transformations.-module Graphics.PS.Transform (Transformable-                             ,translate, scale, rotate) where+module Graphics.PS.Transform where -import Data.CG.Minus {- hcg-minus -}+import qualified Data.CG.Minus as CG {- 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 Double -> a -> a+class Transformable t where+    mtransform :: CG.Matrix Double -> t -> t  -- | Translation in /x/ and /y/.-translate :: (Transformable a) => Double -> Double -> a -> a-translate x = transform . mx_translation x+translate :: Transformable t => Double -> Double -> t -> t+translate x = mtransform . CG.mx_translation x  -- | Scaling in /x/ and /y/.-scale :: (Transformable a) => Double -> Double -> a -> a-scale x = transform . mx_scaling x+scale :: Transformable t => Double -> Double -> t -> t+scale x = mtransform . CG.mx_scaling x  -- | Rotation, in radians.-rotate :: (Transformable a) => Double -> a -> a-rotate = transform . mx_rotation+rotate :: Transformable t => Double -> t -> t+rotate = mtransform . CG.mx_rotation  instance Transformable I.Image where-    transform = I.ITransform+    mtransform = I.ITransform  instance Transformable P.Path where-    transform = P.PTransform+    mtransform = P.PTransform -instance Transformable (Pt Double) where-    transform = pt_transform+instance Transformable (CG.Pt Double) where+    mtransform = CG.pt_transform  {-- import Graphics.PS.Pt

@@ -1,17 +1,25 @@ -- | Unit definitions and conversions.-module Graphics.PS.Unit (radians, mm_pt) where+module Graphics.PS.Unit where  -- | Convert degrees to radians.-radians :: (Floating a) => a -> a+radians :: Floating a => a -> a radians n = n / (360 / (2 * pi))  -- | Convert millimeters to PS points.-mm_pt :: (Floating a) => a -> a+mm_pt :: Floating a => a -> a mm_pt = (* 2.8346456664) +-- | Type specialised 'fromIntegral'.+i_to_d :: Int -> Double+i_to_d = fromIntegral++-- | 'Int' variant of 'mm_pt'.+mm_pt_int :: Int -> Int+mm_pt_int = floor . mm_pt . i_to_d+ {-- -- | Convert PS points to millimeters.-pt_mm :: (Floating a) => a -> a+pt_mm :: Floating a => a -> a pt_mm = (/ 2.8346456664)  -- | Postscript makes a point exactly 1/72 of an inch.@@ -19,15 +27,15 @@ inch n = 72 * n  -- | 1 cm = 0.393700787 inches-cm :: (Floating a) => a -> a+cm :: Floating a => a -> a cm n = 28.346456664 * n -twopi :: (Floating a) => a+twopi :: Floating a => a twopi = 2 * pi -halfpi :: (Floating a) => a+halfpi :: Floating a => a halfpi = pi / 2 -degrees :: (Floating a) => a -> a+degrees :: Floating a => a -> a degrees n = n * (360 / twopi) --}

@@ -0,0 +1,19 @@+module Graphics.PS.Util where++import Control.Monad {- base -}+import System.FilePath {- filepath -}+import System.Process {- process -}++type Cmd = (String,[String])++run_cmd :: Cmd -> IO ()+run_cmd (c,a) = void (rawSystem c a)++eps_to_pdf_cmd :: FilePath -> Cmd+eps_to_pdf_cmd fn = ("ps2pdf",["-dEPSCrop",fn,replaceExtension fn ".pdf"])++-- | Run ps2pdf to translate an EPS file to a PDF file.+--+-- > eps_to_pdf "/tmp/t.0.eps"+eps_to_pdf :: FilePath -> IO ()+eps_to_pdf = run_cmd . eps_to_pdf_cmd

@@ -1,205 +0,0 @@-module Main where--import Data.Maybe {- base -}-import System.Directory {- directory -}-import System.Environment {- base -}-import System.FilePath {- filepath -}-import System.Random {- random -}--import Graphics.PS hiding (a0, a1)-import qualified Graphics.PS.Path.Graphs as G---- | Group a list into a list of /n/ element lists.-clump :: Int -> [a] -> [[a]]-clump n l =-    case l of-      [] -> []-      _ -> let (i,j) = splitAt n l-           in i : clump n j---- | Given seed /s/ generate a list of /n/ random numbers in the range--- [/l,r/].-randn :: Int -> Int -> Double -> Double -> [Double]-randn s n l r =-    let f i = i * (r - l) + l-    in (map f . take n . randoms . mkStdGen) s---- | Grey fill operator.-gfill :: Double -> Path -> Image-gfill g = Fill (greyGS g)---- | Grey stroke operator.-gstroke :: Double -> Path -> Image-gstroke g = Stroke (greyGS g)---- | Thin grey stroke operator.-gstroke' :: Double -> Path -> Image-gstroke' g = Stroke (GS (RGB g g g) 0.01 RoundCap RoundJoin ([],0) 10.0)---- | Bold blue stroke operator.-bstroke :: Path -> Image-bstroke = Stroke (GS (RGB 0.0 0.0 1.0) 16.0 RoundCap RoundJoin ([],0) 10.0)---- | Crappy normalizer, ought to do bounds checks and take paper size.-normalize :: Path -> Path-normalize p =-    let s = 250-        z = 250-    in (translate s s . scale z z) p---- | Text is a path constructor.  The first argument is a Font, the---   second a list of Glyphs.  Ordinarly a Text path is filled, however---   it can be stroked as below.-simpleText :: Image-simpleText =-    let t = Text (Font "Times" 72) "SimpleText"-    in gstroke 0.25 (MoveTo (Pt 100 400) +++ t)--rectangle_ :: [Double] -> Image-rectangle_ [g,x,y,z] =-    let x' = x * 500-        y' = y * 500-        z' = z * 64-        shift = translate x' y' . scale z' z'-    in gfill g (shift (rectangle pt_origin 1 1))-rectangle_ _ = error "illegal rectangle_"---- | A random scattering of filled grey rectangles.-rectangles :: Image-rectangles = (foldl1 over . map rectangle_ . clump 4) (randn 1 240 0 1)---- Angles in Hps are in radians and counter-clockwise.---- A Path must begin with a MoveTo operator.---- | 'arc' makes a path composed of bezier curves.-semiarc :: [Double] -> Image-semiarc [g,x,y,z] =-    let x' = x * 500-        y' = y * 500-        z' = z * 64-        shift = translate x' y' . scale z' z'-    in (gstroke' g . shift . mkValid) (arc pt_origin 1 0 (1.5 * pi))-semiarc _ = error "illegal semiarc"---- | A random scattering of stroked arcs.-semiarcs :: Image-semiarcs = (foldl1 over . map semiarc . clump 4) (randn 1 120 0 1)---- | 'annular' makes a path composed of arcs and lines.  g = grey, ir =--- inner radius, xr = outer radius, sa = start angle, a = angle.-semiann :: (Double -> Path -> Image) -> [Double] -> Image-semiann f [g,ir,xr,sa,a] =-    let x = 250-        y = 250-        z = 250-        sa' = sa * 2.0 * pi-        a' = a * pi-        ir' = min ir xr-        xr' = max ir xr-        shift = translate x y . scale z z-    in f g $ shift $ mkValid $ annular pt_origin ir' xr' sa' a'-semiann _ _ = error "illegal semiann"---- | A random set of annular sections.-semiannsS :: Image-semiannsS = foldl1 over $ map (semiann gstroke') $ clump 5 $ randn 1 50 0 1--semiannsF :: Image-semiannsF = foldl1 over $ map (semiann gfill) $ clump 5 $ randn 1 50 0 1---- |flatten| applies all tranformations on a path generating a new--- path.--curve_ex :: Image-curve_ex =-    let p0 = Pt 0.1 0.5-        p1 = Pt 0.4 0.9-        p2 = Pt 0.6 0.1-        p3 = Pt 0.9 0.5-        c = MoveTo p0 +++ CurveTo p1 p2 p3-        l = MoveTo p0 +++ LineTo p1 +++ MoveTo p2 +++ LineTo p3-        s n = gstroke' n . normalize-    in s 0 c `over` s 0.5 l--startPt_ :: Path -> Pt Double-startPt_ = fromJust . startPt--endPt_ :: Path -> Pt Double-endPt_ = fromJust . endPt----arcd_ex :: Image-arcd_ex :: (Pt Double -> Double -> Double -> Double -> Path) -> Image-arcd_ex arcd =-    let c = Pt 0.5 0.5-        r = 0.4-        a0 = radians 45-        a1 = radians 180-        e0 = mkValid $ arcd c r a0 a1-        e1 = mkValid $ arc c 0.05 0 (2 * pi)-        e2 = MoveTo c +++ LineTo (startPt_ e0) +++ MoveTo c +++ LineTo (endPt_ e0)-        s n = gstroke' n . normalize-        f n = gfill n . normalize-    in s 0 e0 `over` f 0.9 e1 `over` s 0.5 e2--path_ex' :: Path-path_ex' = MoveTo (Pt 0.5 0.1)-           +++ LineTo (Pt 0.9 0.9)-           +++ LineTo (Pt 0.5 0.9)-           +++ CurveTo (Pt 0.2 0.9) (Pt 0.2 0.5) (Pt 0.5 0.5)--hps :: [Image]-hps =-    let arrows = G.fractalArrow 200 9-        arc_ex = arcd_ex arc-        arcNegative_ex = arcd_ex arcNegative-        path_ex = s 0 path_ex'-        approx_ex n = s 0 (approx n path_ex')-        fs_ex = let e = close path_ex'-                in s 0 e `over` f 0.9 e-        s n = gstroke' n . normalize-        f n = gfill n . normalize-    in [ gstroke 0 G.fractal_sqr-       , gstroke 0 G.fractal_sqr'-       , gstroke 0 arrows-       , gstroke 0 (flatten arrows)-       , f 0 (G.sierpinski pt_origin 0.5 0.01)-       , simpleText-       , rectangles-       , semiarcs-       , semiannsS-       , semiannsF-       , curve_ex-       , arc_ex-       , arcNegative_ex-       , path_ex-       , approx_ex 100-       , approx_ex 10-       , fs_ex-       ]--heps_img :: Image-heps_img = bstroke (G.erat (Pt 48 32) 120)--heps_bb :: BBox-heps_bb = HRBBox 35 19 180 164 40.0 24.0 176.0 160.0--writing :: String -> IO ()-writing fn = print ("writing output to: " ++ fn)---- | Usage: main [ps_file_path] [eps_file_path]---   Defaults are used for unsupplied args-main :: IO ()-main = do-  a <- getArgs-  u <- getUserDocumentsDirectory-  let ofn = case a of-              x:_ -> x-              _ -> u </> "hps.ps"-      epsfn = case a of-                [_,x] -> x-                _ -> u </> "heps.eps"-  writing ofn-  ps ofn a4 hps-  writing epsfn-  eps epsfn heps_bb heps_img

@@ -1,21 +1,16 @@ hps --- -[haskell][hs] [postscript][ps]+[haskell](http://haskell.org) [postscript](http://adobe.com/products/postscript/)  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-2014,-[gpl][gpl]. with contributions by:+© [rohan drape](http://rd.slavepianos.org/) and others,+2006-2017,+[gpl](http://gnu.org/copyleft/).+with contributions by:  - declan murphy - henning thielemann -see the [darcs][darcs] [history](?t=hps&q=history) for details--[rd]:  http://rd.slavepianos.org/-[gpl]: http://gnu.org/copyleft/-[darcs]: http://darcs.net/+see the [darcs](http://darcs.net/) [history](?t=hps&q=history) for details

@@ -1,16 +1,16 @@ Name:              hps-Version:           0.15+Version:           0.16 Synopsis:          Haskell Postscript Description:       Haskell library partially implementing the                    postscript drawing model. License:           GPL Category:          Graphics-Copyright:         Rohan Drape, 2006-2014+Copyright:         Rohan Drape, 2006-2017 Author:            Rohan Drape and others Maintainer:        rd@slavepianos.org Stability:         Experimental-Homepage:          http://rd.slavepianos.org/?t=hps-Tested-With:       GHC == 7.6.1+Homepage:          http://rd.slavepianos.org/t/hps+Tested-With:       GHC == 8.0.1 Build-Type:	   Simple Cabal-Version:     >= 1.8 @@ -18,7 +18,9 @@  Library   Build-Depends:   base == 4.*,-                   hcg-minus == 0.15.*+                   hcg-minus == 0.16.*,+                   filepath,+                   process   GHC-Options:     -Wall -fwarn-tabs   Exposed-modules: Graphics.PS                    Graphics.PS.Path@@ -31,24 +33,10 @@                    Graphics.PS.GS                    Graphics.PS.Query                    Graphics.PS.Paper+                   Graphics.PS.Paper.Names                    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.15.*,-                   random-  Main-Is:         fractals.hs-  Ghc-Options:     -Wall -fwarn-tabs-  Other-Modules:   Graphics.PS+                   Graphics.PS.Util  Source-Repository  head   Type:            darcs