1 module PSlib where 2 3 -- This module implements provision of 4 -- control of postscript 5 6 type Postscript = String 7 8 data Point = Pt Int Int deriving (Eq,Show{-was:Text-}) 9 10 initialise header = header ++ "/SMALL /Helvetica findfont 4 scalefont def\n" ++ 11 "/SMALLBOLD /Helvetica-Bold findfont 4 scalefont def\n" ++ 12 "/SMALLITALIC /Helvetica-Oblique findfont 4 scalefont def\n" ++ 13 "/NORM /Helvetica findfont 5 scalefont def\n" ++ 14 "/BOLD /Helvetica-Bold findfont 5 scalefont def\n" ++ 15 "/LARGE /Helvetica-Bold findfont 11 scalefont def\n" ++ 16 "NORM setfont\n" 17 ++ setcms ++ stdProcedures ++ thinlines 18 19 setfont str = str ++ " setfont\n" 20 21 stdheader :: Postscript 22 stdheader = "%!PS-Adobe-2.0\n%%Created by Haskell Graph Package\n" 23 24 gslandscape = "" 25 landscape = translate 8 290 ++ rotate 270 ++ translate 20 10 ++ "0.9 0.9 scale\n" 26 portrait = "" 27 28 stdProcedures = rightshow ++ centreshow 29 30 31 drawObject :: [Point] -> Postscript 32 drawObject (pts) = newpath ++ moveto (Pt 0 0) ++ concat (map lineto pts) ++ 33 thinlines ++ stroke 34 35 fillObject :: [Point] -> Postscript 36 fillObject (pts) = newpath ++ moveto (Pt 0 0) ++ concat (map lineto pts) ++ 37 closepath ++ fill ++ stroke 38 39 fillBox :: Point -> Int -> Int -> Int -> Postscript 40 fillBox pt dx dy c = newpath ++ moveto pt ++ rlineto 0 dy ++ rlineto dx 0 ++ 41 rlineto 0 (-dy) ++ closepath ++ setgray c ++ fill 42 43 drawBox :: Point -> Int -> Int -> Postscript 44 drawBox pt dx dy = thinlines ++ newpath ++ moveto pt ++ rlineto 0 dy ++ rlineto dx 0 ++ 45 rlineto 0 (-dy) ++ closepath ++ stroke 46 47 rjustify str = "("++str++") rightshow\n" 48 cjustify str = "("++str++") centreshow\n" 49 50 -- basic prodedures 51 52 rightshow = "/rightshow\n{dup stringwidth pop\n0 exch sub\n0 rmoveto\nshow } def \n" 53 centreshow = "/centreshow\n{dup stringwidth pop\n0 exch sub\n2 div\n0 rmoveto\nshow } def \n" 54 55 -- basic functions. 56 57 58 59 fill = "fill\n" 60 stroke = "stroke\n" 61 closepath = "closepath\n" 62 newpath = "newpath\n" 63 showpage = "showpage\n\n" 64 gsave = "gsave\n" 65 grestore = "grestore\n" 66 67 text t = setgray 0 ++ "("++t++") show\n" 68 69 setgray 0 = "0 setgray\n" 70 setgray 10 = "1 setgray\n" 71 setgray n = "."++show n++" setgray\n" 72 73 moveto (Pt x y) = psCommand "moveto" [x,y] 74 75 rmoveto x y = psCommand "rmoveto" [x,y] 76 77 lineto :: Point -> Postscript 78 lineto (Pt x y) = psCommand "lineto" [x,y] 79 80 rlineto x y = psCommand "rlineto" [x,y] 81 82 setlinewidth n = psCommand "setlinewidth" [n] 83 84 thinlines = "0.2 setlinewidth\n" 85 86 rotate n = psCommand "rotate" [n] 87 88 psCommand c args = concat (map f args) ++c++"\n" 89 where f x = show x++" " 90 91 92 translate x y = psCommand "translate" [x,y] 93 94 scale x y = psCommand "scale" [x,y] 95 96 setcms = "2.84584 2.84584 scale\n" 97 98 99 100