diff options
Diffstat (limited to 'app/conversion/1.0/src/DOSCNVRS.PAC')
| -rw-r--r-- | app/conversion/1.0/src/DOSCNVRS.PAC | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/app/conversion/1.0/src/DOSCNVRS.PAC b/app/conversion/1.0/src/DOSCNVRS.PAC new file mode 100644 index 0000000..e9ac2d4 --- /dev/null +++ b/app/conversion/1.0/src/DOSCNVRS.PAC @@ -0,0 +1,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;
|