summaryrefslogtreecommitdiff
path: root/testsuite/tests/programs/lex/lex.stdin
blob: dcd009c41b39a12b924366ed29f685e77667d978 (plain)
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)