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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
|
PACKET dos conversion DEFINES
convert to dos file,
dos file name,
replace eumel special characters,
replace multiple blanks by tab stops,
trim end of line,
refuse nonwrapped file
:
LET eumel line display pos = 1,
dos line display pos = 10;
TEXT VAR in l, out l, next l, last char, buffer;
INT VAR act l no, cursor x, cursor y,
this line indentation, next line indentation;
PROC replace inadmissible characters (TEXT VAR t) :
LET inadmissible chars = """*+,./:;<=>?| ";
INT VAR i;
FOR i FROM 1 UPTO LENGTH inadmissible chars REP
last char := inadmissible chars SUB i;
change all (t, last char, "_")
PER
END PROC replace inadmissible characters;
TEXT PROC dos file name (TEXT CONST eumel file name) :
INT VAR p := rpos (eumel file name, ".");
IF p <> 0
THEN in l := subtext (eumel file name, p+1, p+3);
p := min (p, 9);
out l := subtext (eumel file name, 1, p-1);
ELSE in l := "dos";
out l := subtext (eumel file name, 1, 8)
FI;
dos fn (out l, in l)
END PROC dos file name;
TEXT PROC dos file name (TEXT CONST eumel name, extension) :
INT VAR p := rpos (eumel name, ".");
IF p <> 0
THEN p := min (p, 9);
out l := subtext (eumel name, 1, p-1);
ELSE out l := subtext (eumel name, 1, 8)
FI;
dos fn (out l, extension)
END PROC dos file name;
TEXT PROC dos fn (TEXT CONST name, extension) :
buffer := name;
replace inadmissible characters (buffer);
buffer CAT ".";
buffer CAT extension;
buffer
END PROC dos fn;
PROC convert to dos file (TEXT CONST eumel file name) :
LET tab char = ""9"";
TEXT CONST dfn := dos file name (eumel file name);
BOOL VAR is last line of paragraph,
in table := FALSE;
get cursor (cursor x, cursor y);
FILE VAR f := sequential file (input, eumel file name);
IF word wrap (f)
THEN input (f)
ELSE refuse nonwrapped file
FI;
forget (dfn, quiet);
FILE VAR g := sequential file (output, dfn);
max line length (g, max text length);
INT CONST file lines := lines (f);
act l no := 0;
out l := "";
getline (f, next l);
next line indentation := pos (next l, ""33"", ""255"", 1);
REP
in l := next l;
act l no INCR 1;
cursor (eumel line display pos, cursor y);
cout (act l no);
this line indentation := next line indentation;
IF act l no >= file lines
THEN next l := "";
next line indentation := 1
ELSE getline (f, next l);
next line indentation := pos (next l, ""33"", ""255"", 1)
FI;
trim act line;
out l CAT in l;
IF is last line of paragraph CAND
NOT only command line (in l)
THEN putline (g, out l);
out l := "";
cursor (dos line display pos, cursor y);
cout (line no (g))
FI
UNTIL act l no >= file lines PER
.
trim act line :
IF pos (in l, "#table#") <> 0
THEN in table := TRUE
ELIF pos (in l, "#table end") <> 0 COR
pos (in l, "#tableend") <> 0
THEN in table := FALSE
FI;
trim end of line (in l, is last line of paragraph, in table);
replace eumel special characters (in l);
trim start of line;
replace multiple blanks by tab stops (in l, tab char)
.
trim start of line :
IF this line indentation > 2
THEN IF is first line of paragraph
THEN change (in l, 1, this line indentation - 1, tab char)
ELSE in l := subtext (in l, this line indentation)
FI
FI
.
is first line of paragraph : out l = ""
END PROC convert to dos file;
PROC replace eumel special characters (TEXT VAR l) :
LET eumel chars = ""217""218""219""214""215""216""251""221""220""222""223""252"",
dos chars = ""132""148""129""142""153""154""225"-k# "21"";
INT VAR p;
FOR p FROM 1 UPTO LENGTH eumel chars REP
change all (l, eumel chars SUB p, dos chars SUB p)
PER
END PROC replace eumel special characters;
PROC replace eumel special characters (TEXT VAR l,
BOOL VAR contains number sign) :
LET eumel chars = ""217""218""219""214""215""216""251""221""220""223""252"",
dos chars = ""132""148""129""142""153""154""225"-k "21"";
INT VAR p;
FOR p FROM 1 UPTO LENGTH eumel chars REP
change all (l, eumel chars SUB p, dos chars SUB p)
PER;
contains number sign := pos (l, ""222"") <> 0
END PROC replace eumel special characters;
PROC replace multiple blanks by tab stops (TEXT VAR line, TEXT CONST tab char) :
TEXT VAR new line := "";
INT VAR double blank pos, transfer start pos := 1,
blank length;
line loop;
line := new line
.
line loop :
WHILE transfer start pos <> 0 REP
double blank pos := pos (line, " ", transfer start pos);
IF double blank pos = 0
THEN transfer rest of line
ELSE transfer text;
transfer tab
FI
UNTIL double blank pos = 0 PER
.
transfer rest of line :
buffer := subtext (line, transfer start pos);
new line CAT buffer
.
transfer text :
buffer := subtext (line, transfer start pos, double blank pos - 1);
new line CAT buffer
.
transfer tab :
transfer start pos := pos (line, ""33"", ""255"", double blank pos);
IF transfer start pos = 0
THEN new line CAT ""13""10""
ELSE blank length := transfer start pos - double blank pos;
new line CAT (blank length DIV 2) * tab char
FI
END PROC replace multiple blanks by tab stops;
PROC replace multiple blanks by tab stops (TEXT VAR l) :
replace multiple blanks by tab stops (l, ""9"")
END PROC replace multiple blanks by tab stops;
PROC trim end of line (TEXT VAR l, BOOL VAR last paragraph line,
BOOL CONST in table) :
LET syllabication hyphen = ""221"",
syllabication k = ""220"",
protected blank = ""223"";
INT CONST line end := LENGTH l;
last paragraph line := FALSE;
last char := l SUB line end;
IF last char = syllabication hyphen
THEN IF (l SUB (line end - 1)) = syllabication k
THEN l := subtext (l, 1, line end - 2);
l CAT "c"
ELSE l := subtext (l, 1, line end - 1)
FI
ELIF last char = " " COR
(in table CAND last char = protected blank) COR
line end = 0
THEN l := subtext (l, 1, line end - 1);
IF NOT only command line (l)
THEN l CAT ""13""10"";
last paragraph line := TRUE
FI
ELIF last char <> "-" CAND
NOT only command line (l) CAND
no footnote start at end of line
THEN l CAT " "
FI
.
no footnote start at end of line :
pos (l, "#foot#", line end - 5) <> line end - 5
END PROC trim end of line;
PROC refuse nonwrapped file :
putline (""13""10"F"219"r Dateien ohne `word wrap' (kein Leerzeichen am Absatzende)");
putline ("ist Konversion weder m"218"glich noch n"218"tig.");
errorstop ("Datei bitte direkt nach DOS schreiben.")
END PROC refuse nonwrapped file;
END PACKET dos conversion;
|
