summaryrefslogtreecommitdiff
path: root/app/mpg/1987/src/HRZPLOT.ELA
blob: b7881876e30a2e05ba8b749bf3fbd4a0b3775239 (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
PACKET hrz plot DEFINES drawing area,               {Autor: H. Indenbirken}
                        begin plot,                 {Stand: 16.01.85      }
                        end plot, 
                        clear, 
                        pen,
                        move, 
                        draw:
 
LET delete = 0,                         {Farbcodes}
    std    = 1,
    red    = 2,
    green  = 3,
    blue   = 4,
    black  = 5,
    white  = 6,

    nothing          = 0;               {Linientypen}

LET POS = STRUCT (INT x, y);

FILE VAR tr;
TEXT VAR dummy;
INT VAR act thick :: 0, i;
POS VAR pos :: POS : (0, 0);

PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : 
   x cm    := 39.1;    y cm    := 27.6; 
   x pixel := 3910;    y pixel := 2760
END PROC drawing area;

PROC begin plot : 
ENDPROC begin plot ;
 
PROC end plot : 
ENDPROC end plot ;

PROC clear :
  IF exists ("Plotter")
  THEN put line (tr, "NEXT 1;")
  ELSE init tr file FI;

  pos := POS : (0, 0);
  act thick := 0  .

init tr file:
  tr := sequential file (output, "Plotter");
  put line (tr, "#XBA,BEN=7800017 0029 UHRZS012 Graphik#.");
  put line (tr, "ECCO  ");
  put line (tr, "#ANFANG,GRAFIK");
  put line (tr, "#ZEICHNE,PL(1,9),MOD.=ZCH123,DINAF.=3.2,AUSS.=0'0'4200'2970,STIFTE=1'2'3'4'5'6,DATEI=/");
  put line (tr, "CLEAR;BOX;")  .

END PROC clear;

PROC pen (INT CONST background, foreground, thickness, linetype):
  set foreground;
  set thickness  .

set foreground:
  put line (tr, "PEN " + text (foreground) + ";")  .
 
set thickness:
  act thick := thickness * 2  .

END PROC pen;

PROC move (INT CONST x, y) :
  put (tr, text (x) + "!" + text (y) + ";"); 
  pos := POS  : (x, y)
END PROC move;
 
PROC draw (INT CONST x, y) :
  IF act thick <> 0
  THEN IF horizontal line
       THEN thick y
       ELSE thick x FI;
       x MOVE y
  ELSE put (tr, text (x) + "&" + text (y) + ";") FI;
  pos := POS : (x, y)   .

horizontal line:
  abs (pos.x-x) > abs (pos.y-y)  .

thick y:
  INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich;
  old x MOVE pos.y;
  new x DRAW     y;
  FOR dy FROM 1 UPTO act thick
  REP old x MOVE pos.y+dy;
      new x DRAW     y+dy;
      old x MOVE pos.y-dy;
      new x DRAW y-dy;
  PER  . 

x ausgleich:
  IF pos.x <= x
  THEN  act thick
  ELSE -act thick FI  .

thick x:
  INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich;
  pos.x MOVE old y;
      x DRAW new y; 
  FOR dx FROM 1 UPTO act thick
  REP pos.x+dx MOVE old y;
          x+dx DRAW new y;
      pos.x-dx MOVE old y;
          x-dx DRAW new y;
  PER  . 

y ausgleich:
  IF pos.y <= y
  THEN  act thick
  ELSE -act thick FI  .

END PROC draw;

PROC draw (TEXT CONST record, REAL CONST angle, height, width):
  put (tr, height symbol + angle symbol + " SYMB """ + double record + """;")  .

height symbol:
  IF height = 0.0
  THEN ""
  ELSE "H" + text (height) FI  .

angle symbol:
  IF angle = 0.0
  THEN ""
  ELSE "A" + text (angle) FI  .

double record:
  dummy := record;
  change all (dummy, """", """""");
  dummy  .

END PROC draw;

PROC draw (TEXT CONST record) :
  draw (record, 0.0, 0.0, 0.0)
END PROC draw;
 
OP MOVE (INT CONST x, y):
  put (tr, text (x) + "!" + text (y) + ";") 
END OP MOVE;

OP DRAW (INT CONST x, y):
  put (tr, text (x) + "&" + text (y) + ";")
END OP DRAW;

END PACKET hrz plot