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
|
INCLUDE "std primitives";
INCLUDE "terminal plot" ;
PLOTTER "HERCULES XT",1,1,720,348,24.5,18.5;
COLORS "000999";
PROC clear:
INT VAR return;
REP
control(-5,512+0,0,return);
UNTIL return <> -1
PER;
IF return <> 0
THEN errorstop("Graphik nicht ansprechbar!")
FI;
END PROC clear;
PROC prepare:
break(quiet);
REP disable stop;
continue (channel(plotter));
clear error;
enable stop;
IF NOT online
THEN pause(100)
FI
UNTIL online PER;
END PROC prepare;
PROC initplot:
END PROC initplot;
PROC endplot:
INT VAR dummy;
pause;
control (-5,2,0, dummy);
END PROC endplot;
PROC home:
moveto(0,347);
END PROC home;
PROC moveto(INT CONST x,y):
INT VAR dummy;
control (-7,x,(347-y),dummy); (* move nach SHARD-AT *)
END PROC moveto;
PROC set pixel(INT CONST x,y):
moveto(x,(347-y));
point;
END PROC set pixel;
PROC drawto(INT CONST x,y):
INT VAR dummy;
control(-6,x,(347-y),dummy); (* draw nach SHARD-AT *)
END PROC drawto;
PROC foreground (INT VAR type):
ROW 5 ROW 4 INT CONST nibble :: ROW 5 ROW 4 INT:
(ROW 4 INT : ( 4369, 4369, 4369, 4369), (* durhgezogene Linie *)
ROW 4 INT : ( 17, 17, 17, 17), (* gepunktete Linie *)
ROW 4 INT : ( 4369, 0, 4369, 0), (* kurz gestrichelt *)
ROW 4 INT : ( 4369, 4369, 0, 0), (* lang gestrichelt *)
ROW 4 INT : ( 4369, 4369, 4369, 0)); (* gestrichpunktet *);
INT VAR dummy;
IF type > 5 OR type < 0
THEN type := 0
FI;
IF type = 0
THEN control( -9, 0, 0, dummy);
control(-10, 0, 0, dummy); (* loeschen *)
ELSE control( -9, nibble[type][2], nibble[type][1], dummy);
control(-10, nibble[type][4], nibble[type][3], dummy)
FI;
END PROC foreground;
PROC background(INT VAR type):
type := 0
END PROC background;
PROC setpalette:
END PROC setpalette;
PROC circle (INT CONST x,y,rad,from,to):
std circle (x,y,rad,from,to)
END PROC circle;
PROC box (INT CONST x1,y1,x2,y2,pattern):
std box (x1,y1,x2,y2,pattern)
END PROC box;
PROC fill (INT CONST x,y,pattern):
END PROC fill;
|
