1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
module Graph where
import Parse
import StdLib
import PSlib
import GRIP
paperX = 280::Int
paperY = 190::Int
fromInt :: Num a => Int -> a
fromInt = fromInteger . toInteger
gspostscript str = initialise stdheader ++ portrait ++ str ++ "showpage\n"
postscript str = initialise stdheader ++ landscape ++ str ++ "showpage\n"
ePostscript (reqdx,reqdy) str = initialise (stdheader++
"%%BoundingBox: 0 0 "++show (cms2pts reqdx)++" "++show (cms2pts reqdy)++"\n"
++ "%%EndComments\n")
++ scale (fromInt reqdx*10/fromInt paperX) (fromInt reqdy*10/fromInt paperY) ++ str ++
showpage
initGraph title pedata (topX,topY) (xlabel,ylabel) keys =
drawBox (Pt 0 0) paperX paperY ++
drawBox (Pt 1 1) (paperX-2) 5 ++
drawBox (Pt 1 (paperY-7)) (paperX-2) 6 ++
setfont "BOLD" ++ moveto (Pt (paperX `div` 2) (paperY-6)) ++ cjustify (title) ++
setfont "NORM" ++
placePEs pedata ++
translate 20 25 ++
newpath ++ moveto (Pt 0 (-5)) ++ lineto (Pt 0 dimY) ++
moveto (Pt (-5) 0) ++ lineto (Pt dimX 0) ++ stroke ++
setfont "SMALL" ++
markXAxis dimX topX++
markYAxis dimY topY++
moveto (Pt 0 (dimY+4)) ++ rjustify ylabel ++ stroke ++
moveto (Pt dimX (-8)) ++ rjustify xlabel ++ stroke ++
setfont "NORM" ++
dokeys dimX keys
placePEs (pes,on) | checkPEs (tail pes) on =
showActive (length pes) (length used) ++
showUsed pes used ++ setfont "NORM"
where used = if on==[] then tail pes else on
cms2pts :: Int -> Int
cms2pts x = round (28.4584 * fromInt x)
plotCurve :: Int -> [Point] -> Postscript
plotCurve x pts = setgray x ++ fillObject pts
plot :: [Point] -> Postscript
plot points = plotCurve 5 (Pt 0 0:points)
dokeys left keys = concat (map2 format (places 0) keys)
where
format pt@(Pt x y) (col,tex,pc) = fillBox pt 16 9 col ++ stroke ++ moveto (Pt (x+17) (y+3))
++ text tex ++ stroke ++ moveto (Pt (x+8) (y+3)) ++
inv col ++ setfont "BOLD" ++ cjustify (pc) ++
stroke ++ setfont "NORM" ++ setgray 10
no=left `div` length keys
places n | n == no = []
places n = (Pt (n*no) (-17)):places (n+1)
showActive t f =
setfont "LARGE" ++ moveto (Pt 10 16) ++ cjustify (show f) ++
setfont "SMALL" ++ moveto (Pt 10 12) ++ cjustify "PE(s)" ++ stroke ++
setfont "SMALL" ++ moveto (Pt 10 8) ++ cjustify "displayed" ++ stroke ++
setfont "NORM"
showUsed (m:pes) on = moveto (Pt 2 2) ++ setfont "SMALL" ++ text "Configuration:" ++
dopes (paperX-27) (("SMALLITALIC",showPE m):map f pes) ++ stroke
where
f pe | elem pe on = ("SMALLBOLD",showPE pe)
| otherwise = ("SMALL",showPE pe)
dopes left pes = concat (map2 format (places 0) pes)
where
format pt@(Pt x y) (font,tex) = setfont font ++ moveto pt ++ text tex ++ stroke
no=left `div` ((length pes*2)+1)
f x = (no*((x*2)+1)) + 27
places n | n>2*no = []
places n = (Pt (f n) 2):places (n+1)
checkPEs pes [] = True
checkPEs pes (p:ps) | elem p pes = checkPEs pes ps
| otherwise = error ("Attempt to gather information from inactive PE - "++ showPE p)
showPE :: PElement -> String
showPE (PE str no) = str++"."++show no
inv x | x>=5 = setgray 0
| otherwise = setgray 10
dimX = paperX-30
dimY = paperY-40
markXAxis :: Int -> Int -> Postscript
markXAxis dimX maxX = label 10 ++ markOnX 100
where
label 0 = ""
label x = newpath ++ moveto (Pt (notch x) 0) ++ rlineto 0 (-2) ++
moveto (Pt (notch x) (-5)) ++
cjustify (printFloat (t x)) ++ stroke ++ label (x-1)
t x = fromInt x*(fromInt maxX / fromInt 10)
notch x = x*(dimX `div` 10)
markOnX n = mapcat notches [1..n] ++ stroke
where
notches n = movetofloat (m*fromInt n) 0 ++ (rlineto 0 (-1)) ++ stroke
m = fromInt dimX/fromInt n
markYAxis :: Int -> Int -> Postscript
markYAxis dimY maxY = label 10 ++ markOnY (calibrate maxY)
where
label 0 = ""
label x = newpath ++ moveto (Pt 0 (notch x)) ++ rlineto (-2) 0 ++
moveto (Pt (-3) (notch x)) ++
rjustify (printFloat (t x)) ++ stroke ++ label (x-1)
t x = fromInt x*(fromInt maxY / fromInt 10)
notch x = x*(dimY `div` 10)
calibrate x | x<=1 = 1
| x<=100 = x
| otherwise = calibrate (x `div` 10)
markOnY n = mapcat notches [1..n] ++ stroke
where
notches n = movetofloat 0 (m*fromInt n) ++ (rlineto (-1) 0)
m = fromInt dimY/fromInt n
movetofloat x y = show x ++ " " ++ show y ++ " moveto\n"
determineScale :: [Point] -> (Int,Int)
determineScale pts = (axisScale x, axisScale y)
where (min,Pt x y) = minandmax pts
axisScale :: Int -> Int
axisScale x = axisScale' x 1
axisScale' x m | x <= m = m
| x <= m*2 = m*2
| x <= m*5 = m*5
| x <= m*10 = m*10
| otherwise = axisScale' x (m*10)
minandmax :: [Point] -> (Point,Point)
minandmax [] = error "No points"
minandmax (p:ps) = f (p,p) ps
where
f p [] = p
f (Pt minx miny,Pt maxx maxy) (Pt x y:ps) = f (Pt minx' miny',Pt maxx' maxy') ps
where minx' = min x minx
miny' = min y miny
maxx' = max x maxx
maxy' = max y maxy
printFloat :: Float -> String
printFloat x = f (show (round (x*10)))
where
f "0" = "0"
f r | x<1 = "0."++r
f (r:"0") | x<10 = [r]
f (r:m) | x<10 = r:'.':m
f _ = show (round x)
|
