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;