11 fromInt :: Num a => Int -> a
12 fromInt = fromInteger . toInteger
14 gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n"
15 postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n"
17 ePostscript (reqdx,reqdy) str = initialise (stdheader++
18 "%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n"
20 ++ scale (fromInt reqdx*10/fromInt paperX) (fromInt reqdy*10/fromInt paperY) ++ str ++
23 initGraph title pedata (topX,topY) (xlabel,ylabel) keys =
24 drawBox (Pt 0 0) paperX paperY ++
25 drawBox (Pt 1 1) (paperX-2) 5 ++
26 drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++
27 setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++
31 newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++
32 moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++
36 moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++
37 moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++
41 placePEs (pes,on) | checkPEs (tail pes) on =
42 showActive (length pes) (length used) ++
43 showUsed pes used ++ setfont "NORM"
44 where used = if on==[] then tail pes else on
48 cms2pts x = round (28.4584 * fromInt x)
50 plotCurve :: Int -> [Point] -> Postscript
51 plotCurve x pts = setgray x ++ fillObject pts
53 plot :: [Point] -> Postscript
54 plot points = plotCurve 5 (Pt 0 0:points)
56 dokeys left keys = concat (map2 format (places 0) keys)
58 format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3))
59 ++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++
60 inv col ++ setfont "BOLD" ++ cjustify (pc) ++
61 stroke ++ setfont "NORM" ++ setgray 10
62 no=left `div` length keys
63 places n | n == no = []
64 places n = (Pt (n*no) (-17)):places (n+1)
67 setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++
68 setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++
69 setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++
72 showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++
73 dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke
75 f pe | elem pe on = ("SMALLBOLD",showPE pe)
76 | otherwise = ("SMALL",showPE pe)
78 dopes left pes = concat (map2 format (places 0) pes)
80 format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt ++ text tex ++ stroke
81 no=left `div` ((length pes*2)+1)
82 f x = (no*((x*2)+1)) + 27
83 places n | n>2*no = []
84 places n = (Pt (f n) 2):places (n+1)
88 checkPEs pes [] = True
89 checkPEs pes (p:ps) | elem p pes = checkPEs pes ps
90 | otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p)
92 showPE :: PElement -> String
93 showPE (PE str no) = str++"."++show no
95 inv x | x>=5 = setgray 0
96 | otherwise = setgray 10
101 markXAxis :: Int -> Int -> Postscript
102 markXAxis dimX maxX = label 10 ++ markOnX 100
105 label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++
106 moveto (Pt (notch x) (-5)) ++
107 cjustify (printFloat (t x)) ++ stroke ++ label (x-1)
108 t x = fromInt x*(fromInt maxX / fromInt 10)
109 notch x = x*(dimX `div` 10)
111 markOnX n = mapcat notches [1..n] ++ stroke
113 notches n = movetofloat (m*fromInt n) 0 ++ (rlineto 0 (-1)) ++ stroke
114 m = fromInt dimX/fromInt n
117 markYAxis :: Int -> Int -> Postscript
118 markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY)
121 label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++
122 moveto (Pt (-3) (notch x)) ++
123 rjustify (printFloat (t x)) ++ stroke ++ label (x-1)
124 t x = fromInt x*(fromInt maxY / fromInt 10)
125 notch x = x*(dimY `div` 10)
127 calibrate x | x<=1 = 1
129 | otherwise = calibrate (x `div` 10)
131 markOnY n = mapcat notches [1..n] ++ stroke
133 notches n = movetofloat 0 (m*fromInt n) ++ (rlineto (-1) 0)
134 m = fromInt dimY/fromInt n
136 movetofloat x y = show x ++ " " ++ show y ++ " moveto\n"
139 determineScale :: [Point] -> (Int,Int)
140 determineScale pts = (axisScale x, axisScale y)
141 where (min,Pt x y) = minandmax pts
143 axisScale :: Int -> Int
144 axisScale x = axisScale' x 1
145 axisScale' x m | x <= m = m
149 | otherwise = axisScale' x (m*10)
151 minandmax :: [Point] -> (Point,Point)
152 minandmax [] = error "No points"
153 minandmax (p:ps) = f (p,p) ps
156 f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps
157 where minx' = min x minx
163 printFloat :: Float -> String
164 printFloat x = f (show (round (x*10)))
168 f (r:"0") | x<10 = [r]
169 f (r:m) | x<10 = r:'.':m