summaryrefslogtreecommitdiff
path: root/app/conversion
diff options
context:
space:
mode:
Diffstat (limited to 'app/conversion')
-rw-r--r--app/conversion/1.0/source-disk1
-rw-r--r--app/conversion/1.0/src/AGFA2ASC.TBL19
-rw-r--r--app/conversion/1.0/src/ASKCNVRS.PAC349
-rw-r--r--app/conversion/1.0/src/DOSCNVRS.PAC203
-rw-r--r--app/conversion/1.0/src/EU_CNVRS.DOC150
-rw-r--r--app/conversion/1.0/src/FILEUTIL.PAC142
-rw-r--r--app/conversion/1.0/src/FONTANAL.PAC261
-rw-r--r--app/conversion/1.0/src/PSEUDOWP.WPMbin0 -> 1437 bytes
-rw-r--r--app/conversion/1.0/src/PS_WP_DT.WPMbin0 -> 1439 bytes
-rw-r--r--app/conversion/1.0/src/SEQU2CUM.TBL1
-rw-r--r--app/conversion/1.0/src/WP_CNVRS.PAC905
-rw-r--r--app/conversion/1.0/src/WP_KNVRS.PAC915
12 files changed, 2946 insertions, 0 deletions
diff --git a/app/conversion/1.0/source-disk b/app/conversion/1.0/source-disk
new file mode 100644
index 0000000..a14606d
--- /dev/null
+++ b/app/conversion/1.0/source-disk
@@ -0,0 +1 @@
+conversion/eumel-dos-konversion-1.0_1993-02-04.img
diff --git a/app/conversion/1.0/src/AGFA2ASC.TBL b/app/conversion/1.0/src/AGFA2ASC.TBL
new file mode 100644
index 0000000..4e171a5
--- /dev/null
+++ b/app/conversion/1.0/src/AGFA2ASC.TBL
@@ -0,0 +1,19 @@
+"ö" = "`" { linker Apostroph }
+"ô" = """" { linke Anfhrungszeichen }
+
+"½" = " "
+"¾" = "…"
+"À" = "~a"
+"Á" = "‚"
+"Â" = "Š"
+"Ã" = "ˆ"
+"¹" = "¡"
+"»" = "Œ"
+"Å" = "¢"
+"Æ" = "•"
+"Õ" = "í"
+"É" = "£"
+"Ê" = "—"
+"Ë" = "–"
+"Í" = "‡"
+
diff --git a/app/conversion/1.0/src/ASKCNVRS.PAC b/app/conversion/1.0/src/ASKCNVRS.PAC
new file mode 100644
index 0000000..7d9dddd
--- /dev/null
+++ b/app/conversion/1.0/src/ASKCNVRS.PAC
@@ -0,0 +1,349 @@
+PACKET asksam conversion DEFINES append asksam field,
+ append asksam record,
+ convert to asksam :
+LET card prefix = " +--",
+ bo field = "[ ",
+ eo field = " ]",
+ eo line = ""13""10"",
+ eo record = ""0"",
+ eo doc = ""0""0"",
+ dummy fn = "@";
+LET max fields = 50;
+TEXT VAR in l, out l, appended l, asksam record, buffer;
+INT VAR card no, in line no, out line no, last named field,
+ start pos, end pos, card lines, first line;
+FILE VAR f in, f out;
+THESAURUS VAR field names;
+ROW max fields BOOL VAR complex fields,
+ to be copied;
+PROC convert to asksam (TEXT CONST input file) :
+ IF NOT exists (input file) THEN errorstop ("") FI;
+ TEXT CONST output file := dos file name (input file, "sam");
+ forget (output file);
+ f out := sequential file (output, output file);
+ field names := empty thesaurus;
+ IF input is eudas
+ THEN convert eudas to asksam (input file)
+ ELIF input is cardbox
+ THEN convert cardbox to asksam
+ ELSE stop process
+ FI
+.
+input is eudas :
+ type (old (input file)) = 3243
+.
+input is cardbox :
+ IF type (old (input file)) = 1003
+ THEN f in := sequential file (modify, input file);
+ toline (f in, 1);
+ down (f in, ""26""26"");
+ pattern found
+ ELSE FALSE
+ FI
+.
+stop process :
+ forget (output file, quiet);
+ errorstop ("Konversion nur f"219"r EUDAS- und Cardbox-Dateien m"218"glich.")
+END PROC convert to asksam;
+PROC convert eudas to asksam (TEXT CONST file name) :
+ oeffne (file name, FALSE);
+ get field names;
+ WHILE NOT dateiende REP
+ transfer one record;
+ weiter (1)
+ PER;
+ dateien loeschen (FALSE)
+.
+get field names :
+ asksam record := "";
+ last named field := anzahl felder;
+ auf satz (1);
+ FOR in line no FROM 1 UPTO last named field REP
+ feld lesen (in line no, in l);
+ IF in l <> ""
+ THEN to be copied [in line no] := TRUE;
+ complex fields [in line no] := is complex field;
+ append field name (in l);
+ feldnamen lesen (in line no, in l);
+ append asksam field (in l)
+ ELSE to be copied [in line no] := FALSE;
+ append field name (dummy fn)
+ FI
+ PER;
+ append asksam record;
+ weiter (1)
+.
+is complex field :
+ end pos := pos (in l, "{");
+ IF end pos <> 0
+ THEN end pos DECR 1;
+ WHILE (in l SUB end pos) = " " REP
+ end pos DECR 1
+ PER;
+ in l := subtext (in l, 1, end pos);
+ TRUE
+ ELSE FALSE
+ FI
+.
+transfer one record :
+ cout (satznummer);
+ asksam record := "";
+ out line no := 0;
+ transfer fields;
+ append asksam record
+.
+transfer fields :
+ FOR in line no FROM 1 UPTO last named field REP
+ IF to be copied [in line no]
+ THEN feld lesen (in line no, in l);
+ IF in l <> ""
+ THEN IF complex fields [in line no]
+ THEN transfer complex field (in l)
+ ELSE append asksam field (in l)
+ FI
+ FI
+ FI
+ PER
+END PROC convert eudas to asksam;
+PROC transfer complex field (TEXT CONST l) :
+ TEXT VAR transfer buffer;
+ start pos := 1;
+ REP
+ start pos INCR 1;
+ end pos := pos (l, "{", start pos + 1);
+ IF end pos = 0
+ THEN end pos := LENGTH l
+ ELSE end pos DECR 1
+ FI;
+ WHILE (l SUB end pos) = " " REP
+ end pos DECR 1
+ PER;
+ transfer buffer := subtext (l, start pos, end pos);
+ change (transfer buffer, "}", "");
+ append asksam field (transfer buffer);
+ start pos := pos (l, "{", end pos)
+ UNTIL start pos = 0 PER
+END PROC transfer complex field;
+PROC convert cardbox to asksam :
+ BOOL VAR line end;
+ ascertain number lines per card;
+ convert file;
+.
+ascertain number lines per card :
+ toline (f in, 1);
+ col (f in, 1);
+ downety (f in, card prefix);
+ first line := line no (f in);
+ down (f in, card prefix);
+ card lines := line no (f in) - first line
+.
+convert file :
+ line;
+ input (f in);
+ get field names;
+ card no := 0;
+ WHILE NOT eof (f in) REP
+ transfer one card
+ UNTIL asksam record = "" PER
+.
+get field names :
+ last named field := 0;
+ getline (f in, in l);
+ get names from first lines;
+ get names from bulk;
+.
+get names from first lines :
+ FOR in line no FROM 1 UPTO card lines - 2 REP
+ get cardbox line (in l);
+ in l := compress (in l);
+ IF in l > ""
+ THEN append field name (in l);
+ last named field := in line no
+ ELSE append field name (dummy fn)
+ FI
+ PER;
+.
+get names from bulk :
+ in line no := card lines - 2;
+ get cardbox line (in l);
+ end pos := 0;
+ REP
+ get card line (appended l, line end);
+ IF line end
+ THEN LEAVE get names from bulk
+ ELIF appended l <> ""
+ THEN in line no INCR 1;
+ append field name (compress (appended l));
+ last named field INCR 1
+ FI;
+ PER
+END PROC convert cardbox to asksam;
+PROC transfer one card :
+ BOOL VAR line end;
+ card no INCR 1;
+ cout (card no);
+ asksam record := "";
+ transfer first lines;
+ transfer bulk line;
+ append asksam record
+.
+transfer first lines :
+ getline (f in, in l);
+ IF pos (in l, card prefix) <> 2
+ THEN errorstop ("Programmfehler 1")
+ ELIF pos (in l, "LAST CARD") <> 0
+ THEN LEAVE transfer one card
+ FI;
+ out line no := 0;
+ FOR in line no FROM 1 UPTO card lines - 2 REP
+ get cardbox line (in l);
+ IF pos (in l, ""25""25"") = 1
+ THEN process hypertext
+ ELSE append asksam field (in l)
+ FI;
+ PER
+.
+process hypertext :
+ asksam record CAT ":"13""10""9"";
+ end pos := pos (in l, ".card") - 1;
+ appended l := subtext (in l, 55, end pos);
+ asksam record CAT appended l;
+ asksam record CAT ""255""13""10""13""10"";
+ asksam record CAT "(Datei zum Thema `";
+ asksam record CAT appended l;
+ asksam record CAT "')"13""10"";
+ out line no := 4
+.
+transfer bulk line :
+ get cardbox line (in l);
+ end pos := 0;
+ first line := 0;
+ in line no DECR 1;
+ REP
+ get card line (appended l, line end);
+ IF line end
+ THEN LEAVE transfer bulk line
+ FI;
+ in line no INCR 1;
+ cout (in line no);
+ append asksam field (appended l)
+ PER
+END PROC transfer one card;
+PROC get cardbox line (TEXT VAR t) :
+ getline (f in, t);
+ start pos := pos (t, "|");
+ IF start pos = 0
+ THEN errorstop ("Programmfehler 2")
+ FI;
+ t := subtext (t, start pos + 1)
+END PROC get cardbox line;
+PROC get card line (TEXT VAR t, BOOL VAR end) :
+ start pos := pos (in l, ""32"", ""255"", endpos + 1);
+ IF start pos = 0
+ THEN end := TRUE;
+ LEAVE get card line
+ FI;
+ end pos := pos (in l, ""26"", start pos);
+ IF end pos = 0
+ THEN end := TRUE;
+ LEAVE get card line
+ FI;
+ end pos DECR 1;
+ t := subtext (in l, start pos, end pos);
+ end := FALSE
+END PROC get card line;
+PROC append asksam line (TEXT CONST t) :
+ asksam record CAT t;
+ out line no INCR 1;
+ IF out line no MOD 20 = 0
+ THEN asksam record CAT eo record
+ ELSE asksam record CAT eo line
+ FI
+END PROC append asksam line;
+PROC append asksam field (TEXT CONST t) :
+ BOOL VAR named field;
+ INT VAR s pos, e pos, length l;
+ IF t > " " CAND in line no <= last named field
+ THEN get field name (in line no, out l);
+ IF out l <> dummy fn
+ THEN out l CAT bo field;
+ named field := TRUE
+ ELSE out l := "";
+ named field := FALSE
+ FI
+ ELSE out l := "";
+ named field := FALSE
+ FI;
+ buffer := t;
+ prepare line for asksam (buffer);
+ out l CAT buffer;
+ transfer line
+.
+transfer line :
+ length l := LENGTH out l;
+ e pos := -1;
+ REP
+ s pos := e pos + 2;
+ IF (length l - s pos) > 79
+ THEN determine e pos;
+ transfer chunk
+ ELSE transfer rest
+ FI
+ PER
+.
+determine e pos :
+ e pos := s pos + 79;
+ move before last blank
+.
+move before last blank :
+ WHILE (out l SUB e pos) <> " " REP
+ e pos DECR 1
+ UNTIL e pos = s pos PER;
+ IF e pos = s pos
+ THEN e pos := s pos + 79
+ ELSE e pos DECR 1
+ FI
+.
+transfer chunk :
+ append asksam line (subtext (out l, s pos, e pos));
+.
+transfer rest :
+ buffer := subtext (out l, s pos);
+ IF named field
+ THEN buffer CAT eo field
+ FI;
+ append asksam line (buffer);
+ LEAVE transfer line
+END PROC append asksam field;
+PROC append asksam record :
+ IF was eo record
+ THEN asksam record CAT eo record
+ ELSE buffer := subtext (asksam record, 1, LENGTH asksam record - 2);
+ buffer CAT eo doc;
+ asksam record := buffer
+ FI;
+ putline (f out, asksam record)
+.
+was eo record :
+ out line no MOD 20 = 0
+END PROC append asksam record;
+PROC prepare line for asksam (TEXT VAR t) :
+ IF (t SUB LENGTH t) = " "
+ THEN t := subtext (t, 1, LENGTH t - 1)
+ FI;
+ replace eumel special characters (t);
+ change all (t, "[", ""174"");
+ change all (t, "]", ""175"");
+ change all (t, "#on(""i"")#", "<I>");
+ change all (t, "#off(""i"")#", "<i>")
+END PROC prepare line for asksam;
+PROC append field name (TEXT CONST fn) :
+ INT VAR index;
+ buffer := fn;
+ prepare line for asksam (buffer);
+ insert (field names, buffer, index)
+END PROC append field name;
+PROC get field name (INT CONST index, TEXT VAR fn) :
+ fn := name (field names, index)
+END PROC get field name;
+END PACKET asksam conversion;
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;
diff --git a/app/conversion/1.0/src/EU_CNVRS.DOC b/app/conversion/1.0/src/EU_CNVRS.DOC
new file mode 100644
index 0000000..fb71f95
--- /dev/null
+++ b/app/conversion/1.0/src/EU_CNVRS.DOC
@@ -0,0 +1,150 @@
+#type ("prop")##limit (16.0)#
+#pagelength (26.5)##pageblock##linefeed (1.15)#
+#head#
+#right#%#free(1.0)#
+#end#
+#type("10")##on("b")##center#EUMEL-DOS-Konversion
+#center#Konversion von Dateien des EUMEL-Systems nach DOS
+#type("prop")#
+
+Version 1.0, 06.02.93
+
+Copyright: Miquel Aguado
+ Christian Lehmann
+
+
+1. Leistungen
+EUMEL-Textdateien werden samt Textkosmetik nach WordPerfect konvertiert.
+EUDAS- und Cardboxdateien werden samt Feldstruktur nach AskSam konver-
+tiert.
+
+2. Installation
+2.1. EUMEL
+- DOS-Task im Ibm-Modus reservieren (`reserve ("file ibm", dostask)', wo
+ dostask = /"DOS" oder = /"DOS HD").
+- Die Pakete (mit *.pac-Extension) von der Diskette lesen und in folgender
+ Reihenfolge insertieren:
+ fileutil.pac
+ doscnvrs.pac
+ askcnvrs.pac
+ fontanal.pac
+ wp_knvrs.pac (fr die deutsche WordPerfect-Version) bzw.
+ wp_cnvrs.pac (fr die englische WordPerfect-Version).
+- Das Paket `askcnvrs.pac' kann nur unter EUDAS insertiert werden, wird
+ aber auch nur ben”tigt, wenn EUDAS- oder Cardbox-Dateien konvertiert
+ werden sollen. In dem Falle w„ren dann zuvor `fileutil.pac' und
+ `doscnvrs.pac' in derselben Task zu insertieren.
+- Alle Dateien mit *.pac-Extension wieder aus dem System l”schen.
+- Datei `agfa2asc.tbl' von der Diskette kopieren.
+
+2.2. DOS
+Die Datei
+ ps_wp_dt.wpm (fr die deutsche WordPerfect-Version) bzw.
+ pseudowp.wpm (fr die englische WordPerfect-Version)
+von der Diskette in das WordPerfect-Unterverzeichnis kopieren, in dem die
+Makros sind.
+
+3. Benutzung
+3.1. Text-Dateien
+3.1.1. EUMEL
+3.1.1.1. Vorbereitung
+- In der zu konvertierenden Datei enthaltene Makros und selbstdefinierte
+ Textkosmetikanweisungen aufl”sen.
+- Schrifttypen verschiedener Familien (z.B. `trium' und `modern') auf eine
+ Familie reduzieren, also z.B. `modern10' durch `trium12' ersetzen (vgl.
+ ü3.1.1.3).
+- Sicherstellen, daá die letzte Zeile der Datei ein Absatzzeichen hat.
+- Datei mit `lineform' formatieren. (Die Konversion nach WordPerfect f„ngt
+ keine Textkosmetikfehler ab!)
+- Solche Sonderzeichen, die nicht zum EUMEL-Standard geh”ren, in der zu
+ konvertierenden Datei an den Ascii-Code anpassen. Das geht z.B. mit
+ `filechange (TEXT CONST dateiname, umsetzungstabelle)'. Dazu ist die
+ Tabelle `agfa2asc.tbl' da. Sie muá gegebenenfalls erweitert werden.
+- Sicherstellen, daá die in der Datei benutzte Fonttabelle in der Task
+ `configurator' ist.
+
+3.1.1.2. Konversion
+- Datei mit
+ konvertiere nach wp (TEXT CONST dateiname)
+ (fr die deutsche WordPerfect-Version) bzw.
+ convert to wp (TEXT CONST dateiname)
+ (fr die englische WordPerfect-Version)
+ konvertieren.
+- DOS-Task im Transparent-Modus reservieren (`reserve ("file transparent",
+ dostask)').
+- Pr„konvertierte Datei (mit *.wpf-Extension) nach DOS schreiben.
+
+3.1.1.3. Bei der šbertragung geht Information verloren:
+- Makros und selbstdefinierte Textkosmetikanweisungen werden nicht
+ bertragen.
+- Einrckungen werden ungenau bertragen.
+- Schrifttypen verschiedener Familien (z.B. Times und Modern) werden
+ nicht auseinandergehalten, sondern zu einer Familie zusammengefaát.
+ Qualit„tsunterschiede werden dabei auf Gr”áenunterschiede reduziert.
+ Dabei entstehen sehr eng besetzte Gr”áenskalen, die sp„ter nach den
+ Standards von WordPerfect wieder auseinandergezogen werden.
+- Folgende Textkosmetik-Anweisungen werden in der aktuellen Version
+ ignoriert:
+ page nr
+ material
+ skip, skip end
+ head on
+ fillchar
+ mark cmd, mark end
+ pageblock
+ bsp
+ counter1/2
+ setcounter
+ putcounter0/1
+ storecounter
+ fb
+ fe
+ Die meisten davon haben kein Gegenstck in WordPerfect.
+
+3.1.2. DOS
+3.1.2.1. Vorbereitung
+- WordPerfect aufrufen.
+- Folgende Einstellungen machen:
+ - Drucker (SHIFT F7, d [deutsche Version] bzw. s [englische Version]);
+ - gewnschte Basis-Schrifttype (CTRL F8, 4);
+ - Maáeinheit: cm (SHIFT F1, 3, 8, 1, c);
+ - Standard-Tastatur (SHIFT F1, 5, 6) oder jedenfalls keine mit einer
+ anderen Funktionstastenbelegung.
+
+3.1.2.2. Konversion
+- Pr„konvertierte Datei laden.
+- Makro aufrufen (ALT F10), und zwar
+ ps_wp_dt.wpm (fr die deutsche WordPerfect-Version) bzw.
+ pseudowp.wpm (fr die englische WordPerfect-Version).
+ Geduld!
+
+3.1.2.3. Besonderheiten
+Alle in EUMEL mit `count()' und `value()' durchnumerierten Z„hler sind in
+der WP-Datei in solche von (leeren) `Endnotes' gewandelt. Letztere befin-
+den sich am Ende der Datei und brauchen erst beim Drucken unterdrckt
+zu werden. Zus„tzliche wirkliche Endnotes (im Gegensatz zu Fuánoten) sind
+dann natrlich nicht m”glich.
+
+3.2. Ascii-Dateien
+EUMEL-Dateien, die in einem gew”hnlichen Ascii-Editor weiterverarbeitet
+werden sollen (z.B. Programmdateien), werden mit
+ convert to dos file (TEXT CONST dateiname)
+konvertiert und im Transparent-Modus nach DOS geschrieben.
+
+3.3. Datenbank-Dateien
+3.3.1. EUMEL
+EUDAS- und Cardbox-Dateien werden nach AskSam konvertiert.
+- Solche Sonderzeichen, die nicht zum EUMEL-Standard geh”ren, in zu
+ konvertierenden Dateien an den Ascii-Code anpassen.
+- In den ersten Datensatz die neuen Feldnamen schreiben (in EUDAS neben
+ die zugeh”rigen alten Feldnamen, in Cardbox untereinander an den linken
+ Rand).
+- Datei mit `convert to asksam (TEXT CONST dateiname)' konvertieren.
+- DOS-Task im Transparent-Modus reservieren.
+- Datei nach DOS schreiben.
+
+3.3.2. DOS
+- AskSam aufrufen.
+- Neue Datei kreieren.
+- Sam-Modus, Flieátext (`free mode') und `Formatiert' (`stream') einstellen.
+- Konvertierte Datei importieren.
diff --git a/app/conversion/1.0/src/FILEUTIL.PAC b/app/conversion/1.0/src/FILEUTIL.PAC
new file mode 100644
index 0000000..f772a38
--- /dev/null
+++ b/app/conversion/1.0/src/FILEUTIL.PAC
@@ -0,0 +1,142 @@
+PACKET eumel file utilities
+ DEFINES sort,
+ in denoter,
+ even number of command delimiters,
+ extract command,
+ next text command pos,
+ word wrap,
+ enumerator,
+ enumeration offset :
+PROC sort (THESAURUS VAR th) :
+ disable stop;
+ FILE VAR d := sequential file (output, "dummy");
+ d FILLBY th;
+ sort ("dummy");
+ th := empty thesaurus;
+ input (d);
+ th FILLBY d;
+ forget ("dummy", quiet);
+ enable stop
+END PROC sort;
+BOOL PROC in denoter (TEXT CONST l, INT CONST p) :
+ INT VAR number of quotes := 0,
+ last quote pos,
+ quote pos := 0;
+ quote count loop;
+ number of quotes MOD 2 = 1
+.
+quote count loop :
+ REP
+ last quote pos := quote pos;
+ quote pos := pos (l, """", last quote pos + 1, p - 1);
+ IF quote pos <> 0
+ THEN number of quotes INCR 1
+ ELSE LEAVE quote count loop
+ FI
+ PER
+END PROC in denoter;
+BOOL PROC even number of command delimiters (TEXT CONST l, INT CONST end pos) :
+ INT VAR number := 0, current pos := 1, cross pos;
+ counting loop;
+ number MOD 2 = 0
+.
+ counting loop :
+ REP
+ cross pos := pos (l, "#", current pos, end pos);
+ IF cross pos <> 0
+ THEN number INCR 1;
+ current pos := cross pos + 1
+ FI
+ UNTIL cross pos = 0 PER
+END PROC even number of command delimiters;
+BOOL PROC even number of command delimiters (TEXT CONST l) :
+ even number of command delimiters (l, LENGTH l)
+END PROC even number of command delimiters;
+PROC extract command (TEXT CONST l, INT CONST start pos, INT VAR next pos,
+ TEXT VAR cmd) :
+ next pos := pos (l, "#", start pos + 1);
+ IF next pos = 0
+ THEN errorstop ("unkorrekte Textanweisung")
+ FI;
+ cmd := subtext (l, start pos + 1, next pos - 1);
+ next pos INCR 1
+END PROC extract command;
+PROC next text command pos (TEXT CONST t, INT CONST start pos,
+ INT VAR start cross pos, end cross pos) :
+ start cross pos := pos (t, "#", start pos);
+ IF start cross pos <> 0
+ THEN end cross pos := pos (t, "#", start cross pos + 1)
+ FI
+END PROC next text command pos;
+BOOL PROC word wrap (TEXT CONST file name) :
+ FILE VAR f := sequential file (input, file name);
+ word wrap (f)
+END PROC word wrap;
+BOOL PROC word wrap (FILE VAR f) :
+ TEXT VAR l;
+ modify (f);
+ toline (f, lines (f));
+ WHILE line no (f) > 1 REP
+ read record (f, l);
+ IF l <> ""
+ THEN LEAVE word wrap WITH (l SUB LENGTH l) = " "
+ ELSE up (f, 1)
+ FI
+ PER;
+ FALSE
+END PROC word wrap;
+INT PROC enumeration offset (TEXT CONST this line, next line,
+ BOOL CONST in enumeration, INT CONST start pos) :
+ TEXT VAR initial chunk, next line initial chunk;
+ INT VAR blank pos, next line blank pos,
+ text start pos := 0, next line text start pos;
+ IF NOT only command line (this line)
+ THEN ascertain text start pos
+ FI;
+ text start pos
+.
+ascertain text start pos :
+ blank pos := pos (this line, " ", start pos);
+ IF blank pos > 1 CAND blank pos < LENGTH this line
+ THEN text start pos := pos (this line, ""33"", ""255"", blank pos);
+ IF is enumeration
+ THEN text start pos DECR 1
+ ELSE text start pos := 0
+ FI
+ FI
+.
+is enumeration :
+ neighboring lines correspond CAND this line is enumerated
+.
+neighboring lines correspond :
+ in enumeration COR next line corresponds
+.
+next line corresponds :
+ next line blank pos := pos (next line, " ", start pos);
+ next line text start pos :=
+ pos (next line, ""33"", ""255"", next line blank pos);
+ text start pos = next line text start pos CAND
+ (next line indented COR also enumerated)
+.
+next line indented :
+ pos (next line, ""33"", ""255"", 1) = next line text start pos
+.
+also enumerated :
+ next line initial chunk
+ := subtext (next line, start pos, next line blank pos - 1);
+ enumerator (next line initial chunk)
+.
+this line is enumerated :
+ initial chunk := subtext (this line, start pos, blank pos - 1);
+ enumerator (initial chunk)
+END PROC enumeration offset;
+BOOL PROC enumerator (TEXT CONST t) :
+ t = "-" COR substantial enumerator
+.
+substantial enumerator :
+ INT CONST l := LENGTH t;
+ TEXT CONST last char := t SUB l;
+ l < 20 CAND last char = ":" COR
+ l < 7 CAND pos (".)", last char) <> 0
+END PROC enumerator;
+END PACKET eumel file utilities;
diff --git a/app/conversion/1.0/src/FONTANAL.PAC b/app/conversion/1.0/src/FONTANAL.PAC
new file mode 100644
index 0000000..c1dc502
--- /dev/null
+++ b/app/conversion/1.0/src/FONTANAL.PAC
@@ -0,0 +1,261 @@
+PACKET font analysis DEFINES find fonttable,
+ analyze fonts,
+ analyze indent levels :
+INT VAR th index, cmd index, no of params;
+TEXT VAR buffer line;
+TEXT PROC next type command (FILE VAR f, INT VAR line number, cont pos) :
+ INT VAR start pos;
+ TEXT VAR type cmd := "";
+ search loop;
+ line number := line no (f);
+ type cmd
+.
+ search loop :
+ REP
+ downety (f, "#type");
+ IF pattern found
+ THEN start pos := col (f);
+ read record (f, buffer line);
+ IF even number of command delimiters (buffer line, start pos - 1)
+ THEN extract command (buffer line, start pos, cont pos, type cmd);
+ col (f, cont pos);
+ LEAVE search loop
+ ELSE col (f, start pos + 1)
+ FI
+ FI
+ UNTIL NOT pattern found PER;
+ cont pos := col (f)
+END PROC next type command;
+PROC find fonttable (THESAURUS CONST used fonts th, TEXT VAR table name) :
+ LET old table type = 3009,
+ new table type = 3100;
+ TEXT VAR font name;
+ TEXT CONST users fonttable := fonttable;
+ INT VAR ds type, fonttable th index;
+ disable stop;
+ command dialogue (FALSE);
+ THESAURUS CONST fonttable th := ALL /"configurator";
+ try all fonttables;
+ fonttable (users fonttable);
+ command dialogue (TRUE);
+ enable stop;
+ IF table name = ""
+ THEN errorstop ("Keine zur Datei passende Fonttabelle gefunden")
+ FI
+.
+try all fonttables :
+ fonttable th index := 0;
+ get (fonttable th, table name, fonttable th index);
+ WHILE fonttable th index > 0 REP
+ fetch (table name, /"configurator");
+ ds type := type (old (table name));
+ forget (table name);
+ IF ds type = old table type COR ds type = new table type
+ THEN fonttable (table name);
+ IF is error
+ THEN put error;
+ putline ("Fonttabelle `" + table name + "' kann nicht eingestellt werden.");
+ IF yes ("Abbrechen")
+ THEN enable stop
+ ELSE clear error
+ FI
+ ELSE IF all used fonts present
+ THEN LEAVE try all fonttables
+ FI
+ FI
+ FI;
+ get (fonttable th, table name, fonttable th index)
+ PER;
+ table name := ""
+.
+all used fonts present :
+ th index := 0;
+ get (used fonts th, font name, th index);
+ WHILE th index > 0 REP
+ IF NOT font exists (font name)
+ THEN LEAVE all used fonts present WITH FALSE
+ FI;
+ get (used fonts th, font name, th index)
+ PER;
+ TRUE
+END PROC find fonttable;
+PROC analyze fonts (FILE VAR f, TEXT VAR fonttable name,
+ font numbers, INT VAR base font index) :
+ THESAURUS VAR font th;
+ TEXT VAR usage, base font;
+ fonttable name := "";
+ font numbers := "";
+ base font index := 0;
+ collect fonts (f, font th, usage);
+ IF highest entry (font th) <> 0
+ THEN analyze users fonts
+ FI;
+.
+analyze users fonts :
+ find fonttable (font th, fonttable name);
+ TEXT CONST users fonttable := fonttable;
+ fonttable (fonttable name);
+ provide font numbers (font th, font numbers, usage, base font);
+ sort fonts (font numbers);
+ base font index := pos (font numbers, base font);
+ IF users fonttable <> ""
+ THEN fonttable (users fonttable)
+ FI
+END PROC analyze fonts;
+PROC analyze fonts (TEXT CONST file name, TEXT VAR fonttable name,
+ font numbers, INT VAR base font index) :
+ FILE VAR f := sequential file (modify, file name);
+ analyze fonts (f, fonttable name, font numbers, base font index)
+END PROC analyze fonts;
+PROC collect fonts (FILE VAR f, THESAURUS VAR th, TEXT VAR line numbers) :
+ TEXT VAR cmd, font name, param2;
+ INT VAR current ln, last ln := 0,
+ act distance, current font lines,
+ next pos;
+ th := empty thesaurus;
+ line numbers := "";
+ toline (f, 1);
+ col (f, 1);
+ WHILE NOT eof (f) REP
+ cmd := next type command (f, current ln, next pos);
+ cout (current ln);
+ note text lines for last font;
+ process font cmd
+ PER
+.
+ note text lines for last font :
+ IF last ln <> 0
+ THEN act distance := current ln - last ln;
+ current font lines := line numbers ISUB th index;
+ current font lines INCR act distance;
+ replace (line numbers, th index, current font lines)
+ FI
+.
+process font cmd :
+ analyze command ("type:1.1", cmd, 0, cmd index, no of params,
+ font name, param2);
+ IF cmd index = 1
+ THEN th index := link (th, font name);
+ IF th index = 0
+ THEN add new font
+ FI;
+ last ln := current ln
+ FI
+.
+ add new font :
+ insert (th, font name, th index);
+ line numbers CAT ""0""0""
+END PROC collect fonts;
+PROC provide font numbers (THESAURUS CONST fonts th, TEXT VAR font numbers,
+ line numbers, base font name) :
+ TEXT VAR font name, font no, old line numbers := line numbers;
+ font numbers := "";
+ line numbers := "";
+ INT VAR font index, line number, last greatest;
+ th index := 0;
+ get (fonts th, font name, th index);
+ WHILE th index > 0 REP
+ font no := code (font (font name));
+ font index := pos (font numbers, font no);
+ IF font index = 0
+ THEN transfer font
+ ELSE sum text line number
+ FI;
+ get (fonts th, font name, th index)
+ PER;
+ determine font with most text
+.
+ transfer font :
+ font numbers CAT font no;
+ line numbers CAT (old line numbers ISUB th index)
+.
+ sum text line number :
+ line number := line numbers ISUB font index;
+ line number INCR (old line numbers ISUB th index);
+ replace (line numbers, font index, line number)
+.
+ determine font with most text :
+ last greatest := 0;
+ FOR font index FROM 1 UPTO (LENGTH line numbers) DIV 2 REP
+ line number := line numbers ISUB font index;
+ IF line number > last greatest
+ THEN last greatest := line number;
+ base font name := font numbers SUB font index
+ FI
+ PER;
+END PROC provide font numbers;
+PROC sort fonts (TEXT VAR fonts) :
+ TEXT VAR font name, spec font;
+ INT VAR font no, size;
+ th index := 0;
+ disable stop;
+ FILE VAR f := sequential file (output, "fonts");
+ get font sizes;
+ sort ("fonts");
+ restore fonts text;
+ forget ("fonts", quiet);
+ enable stop
+.
+ get font sizes :
+ FOR th index FROM 1 UPTO LENGTH fonts REP
+ font name := fonts SUB th index;
+ font no := code (font name);
+ specify size
+ PER
+.
+ specify size :
+ size := (indentation pitch (font no) DIV 2)
+ * (font height (font no) DIV 2);
+ rotate (size, 8);
+ spec font := ""223""223"";
+ replace (spec font, 1, size);
+ spec font CAT font name;
+ putline (f, spec font)
+.
+ restore fonts text :
+ fonts := "";
+ input (f);
+ WHILE NOT eof (f) REP
+ getline (f, spec font);
+ font name := spec font SUB 3;
+ fonts CAT font name
+ PER
+END PROC sort fonts;
+PROC analyze indent levels (TEXT CONST file name, TEXT VAR levels string) :
+ FILE VAR f := sequential file (input, file name);
+ analyze indent levels (f, levels string);
+ modify (f)
+END PROC analyze indent levels;
+PROC analyze indent levels (FILE VAR f, TEXT VAR levels string) :
+ INT VAR i;
+ TEXT VAR l, act blanks, current item;
+ levels string := "";
+ WHILE NOT eof (f) REP
+ getline (f, l);
+ i := pos (l, ""33"", ""255"", 1) - 1;
+ IF i > 0
+ THEN act blanks := code (i);
+ i := 1;
+ IF not yet remembered
+ THEN insert act blanks
+ FI
+ FI
+ PER;
+ modify (f)
+.
+not yet remembered :
+ WHILE i <= LENGTH levels string REP
+ current item := levels string SUB i;
+ IF current item < act blanks
+ THEN i INCR 1
+ ELIF current item = act blanks
+ THEN LEAVE not yet remembered WITH FALSE
+ ELSE LEAVE not yet remembered WITH TRUE
+ FI
+ PER;
+ TRUE
+.
+insert act blanks :
+ insert char (levels string, act blanks, i)
+END PROC analyze indent levels;
+END PACKET font analysis;
diff --git a/app/conversion/1.0/src/PSEUDOWP.WPM b/app/conversion/1.0/src/PSEUDOWP.WPM
new file mode 100644
index 0000000..8c83ed6
--- /dev/null
+++ b/app/conversion/1.0/src/PSEUDOWP.WPM
Binary files differ
diff --git a/app/conversion/1.0/src/PS_WP_DT.WPM b/app/conversion/1.0/src/PS_WP_DT.WPM
new file mode 100644
index 0000000..14fd586
--- /dev/null
+++ b/app/conversion/1.0/src/PS_WP_DT.WPM
Binary files differ
diff --git a/app/conversion/1.0/src/SEQU2CUM.TBL b/app/conversion/1.0/src/SEQU2CUM.TBL
new file mode 100644
index 0000000..616b76c
--- /dev/null
+++ b/app/conversion/1.0/src/SEQU2CUM.TBL
@@ -0,0 +1 @@
+"™" = "‘""ƒ" = "™" { AufwÙrtspfeil }"‰" = "š" { AbwÙrtspfeil }"§a" = " ""àa" = "…""^a" = "ƒ""§e" = "‚""àe" = "Š""^e" = "ˆ""§i" = "¡""ài" = """^i" = "Œ""§o" = "¢""ào" = "•""^o" = "“""§u" = "£""àu" = "—""^u" = "–""~n" = "¤""~N" = "¥""¬c" = "‡""¬C" = "€""@" = "ü""ã" = "‡""|" = "º""î" = "¤" \ No newline at end of file
diff --git a/app/conversion/1.0/src/WP_CNVRS.PAC b/app/conversion/1.0/src/WP_CNVRS.PAC
new file mode 100644
index 0000000..c057a2e
--- /dev/null
+++ b/app/conversion/1.0/src/WP_CNVRS.PAC
@@ -0,0 +1,905 @@
+PACKET wordperfect conversion DEFINES convert to wp :
+LET type1 = 1,
+ linefeed = 3,
+ limit = 4,
+ free = 5,
+ page cmd0 = 6,
+ page cmd1 = 7,
+ on = 8,
+ off = 9,
+ page nr = 10,
+ pagelength = 11,
+ start = 12,
+ foot = 13,
+ end = 14,
+ head = 15,
+ headeven = 16,
+ headodd = 17,
+ bottom = 18,
+ bottomeven = 19,
+ bottomodd = 20,
+ block = 21,
+ material = 22,
+ columns = 23,
+ columnsend = 24,
+ ib0 = 25,
+ ib1 = 26,
+ ib2 = 27,
+ ie0 = 28,
+ ie1 = 29,
+ ie2 = 30,
+ topage = 31,
+ goalpage = 32,
+ count0 = 33,
+ count1 = 34,
+ setcount = 35,
+ value0 = 36,
+ value1 = 37,
+ table = 38,
+ table end = 39,
+ r pos = 40,
+ l pos = 41,
+ c pos = 42,
+ d pos = 43,
+ b pos = 44,
+ clear pos0 = 45,
+ clear pos1 = 46,
+ right = 47,
+ center = 48,
+ skip = 49,
+ skip end = 50,
+ u cmd = 51,
+ d cmd = 52,
+ e cmd = 53,
+ head on = 54,
+ head off = 55,
+ bottom on = 56,
+ bottom off = 57,
+ count per page=58,
+ fillchar = 59,
+ mark cmd = 60,
+ mark end = 61,
+ pageblock = 62,
+ bsp = 63,
+ counter1 = 64,
+ counter2 = 65,
+ setcounter = 66,
+ putcounter0 = 67,
+ putcounter1 = 68,
+ storecounter = 69,
+ ub = 70,
+ ue = 71,
+ fb = 72,
+ fe = 73,
+ region = 74,
+ region end = 75;
+LET eumel line display pos = 1,
+ dos line display pos = 10,
+ default tab insert pos = 21;
+LET cont paper width = 20.88,
+ cont paper length = 30.48,
+ minimal margin = 0.5;
+LET eumel modifications = "ibur";
+LET wp cmd start = "<|",
+ wp cmd end = "|>";
+ROW 6 TEXT VAR wp types on off := ROW 6 TEXT :
+ ("p\K13",
+ "p\K14",
+ "",
+ "p\K15",
+ "p\K16",
+ "p\K17");
+ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT :
+ ("p\K24",
+ "p\%",
+ "p\'",
+ "p\K28");
+ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT :
+ ("p\K11", "p\K12");
+TEXT VAR cosmetic cmds :=
+ "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2
+ pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0
+ headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";
+cosmetic cmds CAT
+ "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1
+ goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0
+ rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";
+cosmetic cmds CAT
+ "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0
+ bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2
+ markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01
+ storecounter:69.1";
+cosmetic cmds CAT
+ "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0";
+TEXT VAR font number string,
+ users tabs cmd, no users tabs cmd,
+ param1, param2,
+ act l, next l, dos l,
+ eumel chunk,
+ wp cmd, buffer, index buffer, paired move cmd;
+TEXT CONST wp enter tab menu := wp cmd start + "s\318",
+ wp clear tabs := "0\\rt\\ri\\el",
+ wp quit tab menu := "\&00" + wp cmd end,
+ wp return := "\\rt",
+ global tabs cmd := wp enter tab menu + wp clear tabs
+ + "0,0.5c" + wp return + wp quit tab menu,
+ page no cmd := wp cmd start + "s\3263" + wp cmd end;
+INT VAR cmd index, no of params,
+ base font index, base font offset,
+ current wp size, current script value,
+ mod flags,
+ current index number,
+ act l no,
+ dos l length,
+ first cross pos, second cross pos,
+ act text start, next text start,
+ act indent level, next indent level,
+ current tab insert pos,
+ current font,
+ cursor x, cursor y;
+REAL VAR paper width,
+ paper length,
+ current top margin,
+ current bottom margin,
+ current left margin,
+ current right margin,
+ current limit,
+ current pagelength,
+ current indent pitch;
+BOOL VAR in footnote,
+ in table,
+ in index,
+ in header,
+ in bottom,
+ in enum,
+ is last line of paragraph,
+ text in dos l,
+ line contains number sign
+ ;
+PROC convert to wp (TEXT CONST eumel file name) :
+ TEXT VAR wp file name, file fonttable, users fonttable := "";
+ BOOL VAR errors found := FALSE;
+ IF word wrap (eumel file name)
+ THEN
+ ELSE refuse nonwrapped file
+ FI;
+ IF NOT errors found
+ THEN line;
+ say ("Schrifttypen werden analysiert ...");
+ analyze fonts (eumel file name, file fonttable,
+ font number string, base font index);
+ line;
+ say ("Fu"251"noten werden plaziert ...");
+ move footnotes (eumel file name);
+ wp file name := dos file name (eumel file name, "wpf");
+ forget (wp file name, quiet);
+ line;
+ say ("Datei wird konvertiert ...");
+ line;
+ IF file fonttable <> ""
+ THEN users fonttable := fonttable;
+ fonttable (file fonttable)
+ FI;
+ convert to wp file (eumel file name, wp file name);
+ forget (eumel file name, quiet);
+ rename (eumel file name + ".orig", eumel file name);
+ IF users fonttable <> ""
+ THEN fonttable (users fonttable)
+ FI
+ FI
+END PROC convert to wp;
+PROC convert to wp (THESAURUS CONST th) :
+ do (PROC (TEXT CONST) convert to wp, th)
+END PROC convert to wp;
+PROC convert to wp :
+ convert to wp (std)
+END PROC convert to wp;
+PROC move footnotes (TEXT CONST file name) :
+ copy (file name, file name + ".orig");
+ FILE VAR f := sequential file (modify, file name);
+ INT VAR count line no, count col no,
+ foot line no, foot col no,
+ end line no, end col no,
+ value line no, value col no,
+ footnote lines, line length;
+ TEXT VAR count line tail;
+ toline (f, 1);
+ WHILE NOT eof (f) REP
+ cout (line no (f));
+ down (f, "#count#");
+ IF pattern found
+ THEN process note
+ FI
+ PER
+.
+process note :
+ count line no := line no (f);
+ count col no := col (f);
+ down (f, "#foot#");
+ IF pattern found
+ THEN foot line no := line no (f);
+ foot col no := col (f);
+ IF foot line no - count line no > 20
+ THEN LEAVE process note
+ FI;
+ isolate foot cmd if necessary;
+ down (f, "#end#");
+ IF pattern found
+ THEN end line no := line no (f);
+ check for value;
+ isolate end cmd if necessary;
+ remove note;
+ split count line;
+ replace count by note
+ ELSE LEAVE process note
+ FI
+ ELSE LEAVE process note
+ FI
+.
+check for value :
+ toline (f, foot line no);
+ col (f, foot col no);
+ down (f, "#value#");
+ IF pattern found
+ THEN value line no := line no (f);
+ value col no := col (f);
+ IF value line no >= end line no
+ THEN LEAVE process note
+ ELSE delete value cmd
+ FI
+ ELSE LEAVE process note
+ FI;
+ toline (f, end line no)
+.
+delete value cmd :
+ read record (f, act l);
+ change (act l, "#u##value##e#", "");
+ change (act l, "#value#", "");
+ write record (f, act l)
+.
+isolate foot cmd if necessary :
+ read record (f, act l);
+ IF foot col no > 1
+ THEN next l := subtext (act l, foot col no);
+ IF (act l SUB (foot col no - 1)) = " "
+ THEN act l := subtext (act l, 1, foot col no - 2)
+ ELSE act l := subtext (act l, 1, foot col no - 1)
+ FI;
+ write record (f, act l);
+ down (f, 1);
+ insert record (f);
+ write record (f, next l)
+ FI
+.
+isolate end cmd if necessary :
+ read record (f, act l);
+ end col no INCR 5;
+ next l := subtext (act l, end col no);
+ IF next l > " "
+ THEN act l := subtext (act l, 1, end col no - 1);
+ write record (f, act l);
+ down (f, 1);
+ insert record (f);
+ write record (f, next l);
+ up (f, 1)
+ FI
+.
+remove note :
+ footnote lines := end line no - foot line no + 1;
+ remove (f, footnote lines)
+.
+split count line :
+ toline (f, count line no);
+ read record (f, act l);
+ cmd start := pos (act l, "#u##count##e#", count col no - 3);
+ IF cmd start = count col no - 3
+ THEN cmd end := cmd start + 12
+ ELSE cmd start := count col no;
+ cmd end := cmd start + 7
+ FI;
+ count line tail := subtext (act l, cmd end + 1);
+ IF (count line tail SUB LENGTH count line tail) = " "
+ CAND (only command line (count line tail) COR
+ LENGTH count line tail = 1)
+ THEN count line tail CAT " "
+ FI;
+ act l := subtext (act l, 1, cmd start - 1);
+ write record (f, act l)
+.
+replace count by note :
+ toline (f, count line no + 1);
+ reinsert (f);
+ append count line tail;
+ toline (f, count line no + 1);
+ read record (f, next l);
+ delete record (f);
+ up (f, 1);
+ read record (f, act l);
+ act l CAT next l;
+ line length := LENGTH act l;
+ IF pos (act l, "#foot#") = line length - 6 CAND
+ (act l SUB line length) = " "
+ THEN act l := subtext (act l, 1, line length - 1)
+ FI;
+ write record (f, act l)
+.
+append count line tail :
+ read record (f, act l);
+ end col no := pos (act l, "#end#");
+ act l := subtext (act l, 1, end col no + 4);
+ IF count line tail <> ""
+ THEN act l CAT count line tail
+ ELSE append next line
+ FI;
+ write record (f, act l)
+.
+append next line :
+ down (f, 1);
+ read record (f, next l);
+ IF next l > " "
+ THEN delete record (f);
+ up (f, 1);
+ act l CAT " ";
+ act l CAT next l;
+ write record (f, act l)
+ ELSE up (f, 1)
+ FI
+.
+cmd start : first cross pos
+.
+cmd end : second cross pos
+END PROC move footnotes;
+PROC initialize values :
+ act l no := 0;
+ current wp size := 3;
+ current script value := 0;
+ mod flags := 0;
+ current index number := 0;
+ current tab insert pos:= default tab insert pos;
+ paper length := cont paper length;
+ paper width := cont paper width;
+ current top margin := 2.5;
+ current bottom margin := 2.5;
+ current left margin := 3.0;
+ current right margin := 2.0;
+ current pagelength := paper length - current top margin - current bottom margin;
+ current limit := paper width - current left margin - current right margin;
+ current font := 1;
+ current indent pitch := xstep conversion (indentation pitch (current font));
+ in enum := FALSE;
+ in table := FALSE;
+ in footnote := FALSE;
+ in header := FALSE;
+ in bottom := FALSE;
+ in index := FALSE;
+ text in dos l := FALSE;
+ base font offset := base font index - 3;
+ wp cmd := "";
+ dos l := "";
+ dos l length := 0;
+ next indent level := 0;
+ no users tabs cmd := no users tabs command;
+ users tabs cmd := no users tabs cmd
+END PROC initialize values;
+TEXT PROC no users tabs command :
+ TEXT VAR t := wp enter tab menu;
+ t CAT wp clear tabs;
+ t CAT text (current limit - 2.0);
+ t CAT ",0.2c\\rt";
+ t CAT wp quit tab menu;
+ t
+END PROC no users tabs command;
+INT PROC indent level (INT CONST text start pos) :
+ LET tab distance = 0.5;
+ IF text start pos < 3
+ THEN 0
+ ELSE positive indent level
+ FI
+.
+positive indent level :
+ REAL VAR left margin distance
+ := real (text start pos - 1) * current indent pitch;
+ INT VAR ind level := int (round (left margin distance / tab distance, 0));
+ IF ind level = 0
+ THEN 1
+ ELSE ind level
+ FI
+END PROC indent level;
+PROC convert to wp file (TEXT CONST eumel file name, wp file name) :
+ get cursor (cursor x, cursor y);
+ FILE VAR eumel f := sequential file (input, eumel file name),
+ dos f := sequential file (output, wp file name);
+ max line length (dos f, max text length);
+ INT CONST file lines := lines (eumel f);
+ BOOL VAR is last file line := FALSE;
+ set file defaults;
+ getline (eumel f, next l);
+ next text start := pos (next l, ""33"", ""255"", 1);
+ REP
+ act l := next l;
+ act l no INCR 1;
+ cursor (eumel line display pos, cursor y);
+ cout (act l no);
+ act text start := next text start;
+ IF act l no >= file lines
+ THEN next l := "";
+ next text start := 1;
+ is last file line := TRUE
+ ELSE getline (eumel f, next l);
+ get next text start
+ FI;
+ act indent level := next indent level;
+ next indent level := indent level (next text start);
+ process act line;
+ IF is last line of paragraph
+ THEN IF is last file line
+ THEN complement pending paired commands
+ FI;
+ putline (dos f, dos l);
+ dos l := "";
+ dos l length := 0;
+ text in dos l := FALSE;
+ cursor (dos line display pos, cursor y);
+ cout (line no (dos f))
+ FI
+ UNTIL act l no >= file lines PER
+END PROC convert to wp file;
+PROC set file defaults :
+ initialize values;
+ set endnote options;
+ no pagination;
+ wp cmd CAT global tabs cmd
+.
+set endnote options :
+ cat to wp command ("s\J243\J22\\rt\&")
+.
+no pagination :
+ cat to wp command ("s\32649\&")
+END PROC set file defaults;
+PROC get next text start :
+ next text start := pos (next l, ""33"", ""255"", 1);
+ IF next text start = 2
+ THEN next text start := 1
+ FI
+END PROC get next text start;
+PROC process act line :
+ LET tab code = "<|s\\tb|>",
+ indent code = "<|s\\in|>",
+ margin rel code = "<|s\^|>";
+ INT VAR enum blanks, past enumerator pos;
+ trim end of line (act l, is last line of paragraph, in table);
+ replace eumel special characters (act l, line contains number sign);
+ trim start of line;
+ IF in table CAND NOT text in dos l
+ THEN replace multiple blanks by tab stops (act l, tab code)
+ FI;
+ transfer line in chunks
+.
+trim start of line :
+ IF NOT (text in dos l COR only command line (act l))
+ THEN IF NOT is last line of paragraph CAND
+ next indent level < act indent level
+ THEN cat to dos l (next indent level * indent code);
+ cat to dos l ((act indent level - next indent level) * tab code)
+ ELSE cat to dos l (act indent level * indent code)
+ FI;
+ enum blanks := enumeration offset (act l, next l, in enum, act text start);
+ IF enum blanks <> 0
+ THEN in enum := TRUE;
+ past enumerator pos := pos (act l, " ", act text start);
+ change (act l, past enumerator pos, enum blanks, indent code)
+ ELSE in enum := FALSE;
+ IF NOT is last line of paragraph CAND
+ next indent level > act indent level
+ THEN cat to dos l (indent code);
+ cat to dos l (margin rel code)
+ FI
+ FI
+ FI
+END PROC process act line;
+PROC complement pending paired commands :
+ reset modifications;
+ IF current wp size <> 3
+ THEN cat to wp command (wp types on off [current wp size]);
+ cat to dos l (wp cmd)
+ FI;
+END PROC complement pending paired commands;
+PROC transfer line in chunks :
+ WHILE act text start <= LENGTH act l REP
+ next text command pos (act l, act text start, first cross pos, second cross pos);
+ IF first cross pos <> 0
+ THEN IF first cross pos <> act text start
+ THEN process text chunk (act text start, first cross pos - 1)
+ FI;
+ process eumel command (first cross pos, second cross pos);
+ act text start := second cross pos + 1
+ ELSE process text chunk (act text start, LENGTH act l);
+ LEAVE transfer line in chunks
+ FI;
+ PER
+END PROC transfer line in chunks;
+PROC process text chunk (INT CONST start pos, end pos) :
+ eumel chunk := subtext (act l, start pos, end pos);
+ IF in header COR in bottom
+ THEN change all (eumel chunk, "%", page no cmd)
+ FI;
+ IF line contains number sign
+ THEN change all (eumel chunk, ""222"", "#")
+ FI;
+ cat to dos l (eumel chunk);
+ text in dos l := TRUE;
+ IF in index
+ THEN index buffer CAT eumel chunk
+ FI
+END PROC process text chunk;
+PROC process eumel command (INT CONST start pos, end pos) :
+ eumel chunk := subtext (act l, start pos + 1, end pos - 1);
+ IF (eumel chunk SUB 1) = "-"
+ THEN process comment (eumel chunk)
+ ELSE process command
+ FI;
+ cat to dos l (wp cmd);
+ wp cmd := ""
+.
+ process command :
+ analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params,
+ param1, param2);
+ customized command processing;
+ IF in index
+ THEN index buffer CAT wp cmd
+ FI
+.
+ customized command processing :
+ SELECT cmd index OF
+ CASE type1 : process type cmd (param1)
+ CASE linefeed : cat to wp command ("s\316" + param1 + "\\rt\&")
+ CASE limit : process limit (param1)
+ CASE free : process free (param1)
+ CASE page cmd0 : cat to wp command ("s\_")
+ CASE page cmd1 : cat to wp command ("s\_\3261" + param1 + "\\rt\&")
+ CASE on : process mod on (param1)
+ CASE off : process mod off (param1)
+ CASE page nr :
+ CASE pagelength : process pagelength (param1)
+ CASE start : process start (param1, param2)
+ CASE foot : process footnote
+ CASE end : process end
+ CASE head,
+ headeven,
+ headodd : process head (cmd index)
+ CASE bottom,
+ bottomeven,
+ bottomodd : process bottom (cmd index)
+ CASE block : cat to wp command ("s\3134\&")
+ CASE material :
+ CASE columns : process columns
+ CASE columnsend : cat to wp command ("s\>12")
+ CASE ib0,
+ ib1,
+ ib2 : process index on (param1, param2)
+ CASE ie0, ie1, ie2 : process index off (param 1)
+ CASE topage : cat to wp command ("s\<111" + param1 + wp return)
+ CASE goalpage : cat to wp command ("s\<12" + param1 + wp return)
+ CASE count0 : cat to wp command ("s\051\\rt")
+ CASE count1 : process reference target (param1)
+ CASE setcount : cat to wp command ("s\J13" + param1 + wp return)
+ CASE value0 :
+ CASE value1 : cat to wp command ("s\<114" + param1 + wp return)
+ CASE table : process table
+ CASE table end : process table end
+ CASE r pos, l pos, c pos, d pos,
+ b pos : process tab stop (eumel chunk SUB 1, param1)
+ CASE clear pos0 : process clear all tabs
+ CASE clear pos1 : process clear tab (param1)
+ CASE right : cat to wp command ("s\=")
+ CASE center : cat to wp command ("s\1")
+ CASE skip :
+ CASE skip end :
+ CASE u cmd : process script cmd (1)
+ CASE d cmd : process script cmd (2)
+ CASE e cmd : process e cmd
+ CASE head on :
+ CASE head off : cat to wp command ("s\32311\&")
+ CASE bottom on :
+ CASE bottom off : cat to wp command ("s\32411\&")
+ CASE count per page : cat to wp command ("s\J146y\&")
+ CASE fillchar :
+ CASE mark cmd :
+ CASE mark end :
+ CASE pageblock :
+ CASE bsp :
+ CASE counter1 :
+ CASE counter2 :
+ CASE setcounter :
+ CASE putcounter0:
+ CASE putcounter1:
+ CASE storecounter:
+ CASE ub : process mod on ("u")
+ CASE ue : process mod off ("u")
+ CASE fb :
+ CASE fe :
+ CASE region, region end : cat to wp command ("p\3y")
+ END SELECT
+END PROC process eumel command;
+PROC process comment (TEXT CONST t) :
+ buffer := "p\Hy";
+ cat to wp command (buffer);
+ wp cmd CAT subtext (t, 2);
+ cat to wp command (buffer)
+END PROC process comment;
+PROC cat to dos l (TEXT CONST t) :
+ LET mtl = 32000;
+ INT CONST t length := LENGTH t;
+ IF mtl - t length < dos l length
+ THEN report ("Absatz ist zu lang")
+ ELSE dos l CAT t;
+ dos l length INCR t length
+ FI
+END PROC cat to dos l;
+PROC cat to wp command (TEXT CONST t) :
+ IF t <> ""
+ THEN wp cmd CAT wp cmd start;
+ wp cmd CAT t;
+ wp cmd CAT wp cmd end
+ FI
+END PROC cat to wp command;
+PROC process mod on (TEXT CONST kind of mod) :
+ TEXT CONST mod char := kind of mod SUB 1;
+ INT CONST mod no := pos (eumel modifications, mod char);
+ cat to wp command (wp mods on off [mod no]);
+ set bit (mod flags, mod no)
+END PROC process mod on;
+PROC process mod off (TEXT CONST kind of mod) :
+ TEXT CONST mod char := kind of mod SUB 1;
+ INT CONST mod no := pos (eumel modifications, mod char);
+ process mod off (mod no)
+END PROC process mod off;
+PROC process mod off (INT CONST mod no) :
+ cat to wp command (wp mods on off [mod no]);
+ reset bit (mod flags, mod no)
+END PROC process mod off;
+PROC reset modifications :
+ INT VAR mod no;
+ IF mod flags > 0
+ THEN FOR mod no FROM 1 UPTO 4 REP
+ IF bit (mod flags, mod no)
+ THEN process mod off (mod no)
+ FI
+ PER
+ FI
+END PROC reset modifications;
+PROC process type cmd (TEXT CONST wanted type) :
+ reset modifications;
+ current wp size off;
+ process type change (wanted type)
+.
+ current wp size off :
+ cat to wp command (wp types on off [current wp size])
+END PROC process type cmd;
+PROC process type change (TEXT CONST eumel type) :
+ current font := font (eumel type);
+ current indent pitch := xstep conversion (indentation pitch (current font));
+ TEXT CONST eumel type no := code (current font);
+ INT CONST eumel size := pos (font number string, eumel type no);
+ current wp size := eumel size - base font offset;
+ IF current wp size < 1
+ THEN current wp size := 1
+ ELIF current wp size > 6
+ THEN current wp size := 6
+ FI;
+ cat to wp command (wp types on off [current wp size])
+END PROC process type change;
+PROC process script cmd (INT CONST script value) :
+ current script value := script value;
+ cat to wp command (wp scripts on off [script value])
+END PROC process script cmd;
+PROC process e cmd :
+ cat to wp command (wp scripts on off [current script value]);
+ current script value := 0
+END PROC process e cmd;
+PROC process free (TEXT CONST cm) :
+ IF NOT in header COR in bottom
+ THEN buffer := "s\3412";
+ buffer CAT cm;
+ buffer CAT "c\\rt\&";
+ cat to wp command (buffer)
+ FI
+END PROC process free;
+PROC process limit (TEXT CONST t limit) :
+ current limit := real (t limit);
+ current limit := min (current limit, paper width - 2.0 * minimal margin);
+ process horizontal margins
+END PROC process limit;
+PROC process horizontal margins :
+ current right margin := paper width - current limit - current left margin;
+ IF current right margin - minimal margin < 0.0
+ THEN current right margin := minimal margin;
+ current left margin := paper width - current limit - current right margin
+ FI;
+ wp cmd := wp cmd start;
+ wp cmd CAT "s\317";
+ wp cmd CAT text (current left margin);
+ wp cmd CAT "c\\rt";
+ wp cmd CAT text (current right margin);
+ wp cmd CAT "c\\rt\&";
+ wp cmd CAT wp cmd end;
+END PROC process horizontal margins;
+PROC process pagelength (TEXT CONST t length) :
+ current pagelength := real (t length);
+ current pagelength
+ := min (current pagelength, paper length - 2.0 * minimal margin);
+ process vertical margins
+END PROC process pagelength;
+PROC process vertical margins :
+ current bottom margin := paper length - current pagelength - current top margin;
+ IF current bottom margin - minimal margin < 0.0
+ THEN current bottom margin := minimal margin;
+ current top margin
+ := paper length - current pagelength - current bottom margin
+ FI;
+ wp cmd := wp cmd start;
+ wp cmd CAT "s\325";
+ wp cmd CAT text (current top margin);
+ wp cmd CAT "c\\rt";
+ wp cmd CAT text (current bottom margin);
+ wp cmd CAT "c\\rt\&";
+ wp cmd CAT wp cmd end;
+END PROC process vertical margins;
+PROC process start (TEXT CONST t x, t y) :
+ current left margin := real (t x);
+ process horizontal margins;
+ current top margin := real (t y);
+ process vertical margins
+END PROC process start;
+PROC process footnote :
+ IF in footnote
+ THEN report ("Fu"251"notenschachtelung")
+ FI;
+ paired move cmd := "f\J11 \\rt\&";
+ cat to wp command (paired move cmd);
+ in footnote := TRUE
+END PROC process footnote;
+PROC process head (INT CONST index) :
+ IF in header
+ THEN report ("Header-Schachtelung")
+ FI;
+ paired move cmd := "f\323";
+ IF index <= headeven
+ THEN paired move cmd CAT "1";
+ IF index = head
+ THEN paired move cmd CAT "2"
+ ELSE paired move cmd CAT "4"
+ FI
+ ELSE paired move cmd CAT "23"
+ FI;
+ paired move cmd CAT "\\rt\&00";
+ cat to wp command (paired move cmd);
+ in header := TRUE
+END PROC process head;
+PROC process bottom (INT CONST index) :
+ IF in bottom
+ THEN report ("Bottom-Schachtelung")
+ FI;
+ paired move cmd := "f\324";
+ IF index <= bottomeven
+ THEN paired move cmd CAT "1";
+ IF index = bottom
+ THEN paired move cmd CAT "2"
+ ELSE paired move cmd CAT "4"
+ FI
+ ELSE paired move cmd CAT "23"
+ FI;
+ paired move cmd CAT "\\rt\&00";
+ cat to wp command (paired move cmd);
+ in bottom := TRUE
+END PROC process bottom;
+PROC process end :
+ reset types and mods;
+ cat to wp command (paired move cmd);
+ IF in header
+ THEN in header := FALSE
+ ELIF in bottom
+ THEN in bottom := FALSE
+ ELIF in footnote
+ THEN in footnote := FALSE
+ ELSE report ("Unmotivierte End-Anweisung")
+ FI
+.
+reset types and mods :
+ reset modifications;
+ IF current wp size <> 3
+ THEN cat to wp command (wp types on off [current wp size]);
+ current wp size := 3;
+ FI
+END PROC process end;
+PROC process columns :
+ INT VAR fcp, scp;
+ cat to wp command ("s\>1301");
+ next text command pos (act l, act text start, fcp, scp);
+ IF fcp = second cross pos + 1
+ THEN eumel chunk := subtext (act l, fcp + 1, scp - 1);
+ analyze command (cosmetic cmds, eumel chunk, 3, cmd index,
+ no of params, param1, param2);
+ IF cmd index = limit
+ THEN second cross pos := scp
+ FI
+ FI
+END PROC process columns;
+PROC process index on (TEXT CONST index number, registered text) :
+ IF in index
+ THEN report ("Kann Indexschachtelung nicht verarbeiten")
+ FI;
+ current index number := int (index number);
+ index buffer := "<|s\<3";
+ IF registered text <> ""
+ THEN index buffer CAT registered text
+ ELSE in index := TRUE
+ FI
+END PROC process index on;
+PROC process index off (TEXT CONST index number) :
+ INT CONST index off number := int (index number);
+ IF current index number = index off number
+ THEN current index number := 0
+ ELSE report ("Kann Indexschachtelung nicht verarbeiten")
+ FI;
+ wp cmd := index buffer;
+ wp cmd CAT "\\rt\ |>";
+ in index := FALSE
+END PROC process index off;
+PROC process reference target (TEXT CONST marker) :
+ buffer := "s\J21\&\<12";
+ buffer CAT marker;
+ buffer CAT wp return;
+ cat to wp command (buffer)
+END PROC process reference target;
+PROC process table :
+ IF users tabs cmd <> no users tabs cmd
+ THEN wp cmd := users tabs cmd
+ FI;
+ in table := TRUE
+END PROC process table;
+PROC process table end :
+ wp cmd := global tabs cmd;
+ in table := FALSE
+END PROC process table end;
+PROC process tab stop (TEXT CONST tab type, tab pos) :
+ buffer := tab pos;
+ buffer CAT wp return;
+ IF pos ("rcd", tab type) <> 0
+ THEN buffer CAT tab type
+ FI;
+ insert new tab stop;
+ IF in table
+ THEN wp cmd CAT users tabs cmd
+ FI
+.
+insert new tab stop :
+ insert char (users tabs cmd, buffer, current tab insert pos);
+ current tab insert pos INCR LENGTH buffer
+END PROC process tab stop;
+PROC process clear all tabs :
+ users tabs cmd := no users tabs cmd;
+ current tab insert pos := default tab insert pos;
+END PROC process clear all tabs;
+PROC process clear tab (TEXT CONST tab pos) :
+ INT VAR del start, del end;
+ del start := pos (users tabs cmd, tab pos);
+ IF del start <> 0
+ THEN clear pos
+ FI
+.
+clear pos :
+ del end := pos (users tabs cmd, wp return, del start) + 4;
+ buffer := users tabs cmd SUB del end + 1;
+ IF pos ("rcd", buffer) <> 0
+ THEN del end INCR 1
+ FI;
+ change (users tabs cmd, del start, del end, "");
+ IF in table
+ THEN wp cmd CAT users tabs cmd
+ FI
+END PROC process clear tab;
+PROC report (TEXT CONST t) :
+ errorstop ("Zeile " + text (act l no) + ": " + t)
+END PROC report;
+END PACKET wordperfect conversion;
diff --git a/app/conversion/1.0/src/WP_KNVRS.PAC b/app/conversion/1.0/src/WP_KNVRS.PAC
new file mode 100644
index 0000000..993221c
--- /dev/null
+++ b/app/conversion/1.0/src/WP_KNVRS.PAC
@@ -0,0 +1,915 @@
+PACKET wordperfect conversion DEFINES konvertiere nach wp :
+LET type1 = 1,
+ linefeed = 3,
+ limit = 4,
+ free = 5,
+ page cmd0 = 6,
+ page cmd1 = 7,
+ on = 8,
+ off = 9,
+ page nr = 10,
+ pagelength = 11,
+ start = 12,
+ foot = 13,
+ end = 14,
+ head = 15,
+ headeven = 16,
+ headodd = 17,
+ bottom = 18,
+ bottomeven = 19,
+ bottomodd = 20,
+ block = 21,
+ material = 22,
+ columns = 23,
+ columnsend = 24,
+ ib0 = 25,
+ ib1 = 26,
+ ib2 = 27,
+ ie0 = 28,
+ ie1 = 29,
+ ie2 = 30,
+ topage = 31,
+ goalpage = 32,
+ count0 = 33,
+ count1 = 34,
+ setcount = 35,
+ value0 = 36,
+ value1 = 37,
+ table = 38,
+ table end = 39,
+ r pos = 40,
+ l pos = 41,
+ c pos = 42,
+ d pos = 43,
+ b pos = 44,
+ clear pos0 = 45,
+ clear pos1 = 46,
+ right = 47,
+ center = 48,
+ skip = 49,
+ skip end = 50,
+ u cmd = 51,
+ d cmd = 52,
+ e cmd = 53,
+ head on = 54,
+ head off = 55,
+ bottom on = 56,
+ bottom off = 57,
+ count per page=58,
+ fillchar = 59,
+ mark cmd = 60,
+ mark end = 61,
+ pageblock = 62,
+ bsp = 63,
+ counter1 = 64,
+ counter2 = 65,
+ setcounter = 66,
+ putcounter0 = 67,
+ putcounter1 = 68,
+ storecounter = 69,
+ ub = 70,
+ ue = 71,
+ fb = 72,
+ fe = 73,
+ region = 74,
+ region end = 75;
+LET eumel line display pos = 1,
+ dos line display pos = 10,
+ default tab insert pos = 21;
+LET cont paper width = 20.88,
+ cont paper length = 30.48,
+ minimal margin = 0.5;
+LET eumel modifications = "ibur";
+LET wp cmd start = "<|",
+ wp cmd end = "|>";
+ROW 6 TEXT VAR wp types on off := ROW 6 TEXT :
+ ("p\K13",
+ "p\K14",
+ "",
+ "p\K15",
+ "p\K16",
+ "p\K17");
+ROW 4 TEXT CONST wp mods on off := ROW 4 TEXT :
+ ("p\K24",
+ "p\%",
+ "p\'",
+ "p\K28");
+ROW 2 TEXT CONST wp scripts on off := ROW 2 TEXT :
+ ("p\K11", "p\K12");
+TEXT VAR cosmetic cmds :=
+ "type:1.1linefeed:3.1limit:4.1free:5.1page:6.01on:8.1off:9.1pagenr:10.2
+ pagelength:11.1start:12.2foot:13.0end:14.0head:15.0headeven:16.0
+ headodd:17.0bottom:18.0bottomeven:19.0bottomodd:20.0block:21.0";
+cosmetic cmds CAT
+ "material:22.1columns:23.2columnsend:24.0ib:25.012ie:28.012topage:31.1
+ goalpage:32.1count:33.01setcount:35.1value:36.01table:38.0tableend:39.0
+ rpos:40.1lpos:41.1cpos:42.1dpos:43.2bpos:44.2clearpos:45.01right:47.0";
+cosmetic cmds CAT
+ "center:48.0skip:49.0skipend:50.0u:51.0d:52.0e:53.0headon:54.0headoff:55.0
+ bottomon:56.0bottomoff:57.0countperpage:58.0fillchar:59.1mark:60.2
+ markend:61.0pageblock:62.0b:63.0counter:64.12setcounter:66.2putcounter:67.01
+ storecounter:69.1";
+cosmetic cmds CAT
+ "ub:70.0ue:71.0fb:72.0fe:73.0region:74.0regionend:75.0";
+TEXT VAR font number string,
+ users tabs cmd, no users tabs cmd,
+ param1, param2,
+ act l, next l, dos l,
+ eumel chunk,
+ wp cmd, buffer, index buffer, paired move cmd;
+TEXT CONST wp enter tab menu := wp cmd start + "s\318",
+ wp clear tabs := "0\\rt\\ri\\el",
+ wp quit tab menu := "\&00" + wp cmd end,
+ wp return := "\\rt",
+ global tabs cmd := wp enter tab menu + wp clear tabs
+ + "0.0,5c" + wp return + wp quit tab menu,
+ page no cmd := wp cmd start + "s\3263" + wp cmd end;
+INT VAR cmd index, no of params,
+ base font index, base font offset,
+ current wp size, current script value,
+ mod flags,
+ current index number,
+ act l no,
+ dos l length,
+ first cross pos, second cross pos,
+ act text start, next text start,
+ act indent level, next indent level,
+ current tab insert pos,
+ current font,
+ cursor x, cursor y;
+REAL VAR paper width,
+ paper length,
+ current top margin,
+ current bottom margin,
+ current left margin,
+ current right margin,
+ current limit,
+ current pagelength,
+ current indent pitch;
+BOOL VAR in footnote,
+ in table,
+ in index,
+ in header,
+ in bottom,
+ in enum,
+ is last line of paragraph,
+ text in dos l,
+ line contains number sign
+ ;
+PROC konvertiere nach wp (TEXT CONST eumel file name) :
+ TEXT VAR wp file name, file fonttable, users fonttable := "";
+ BOOL VAR errors found := FALSE;
+ IF word wrap (eumel file name)
+ THEN
+ ELSE refuse nonwrapped file
+ FI;
+ IF NOT errors found
+ THEN line;
+ say ("Schrifttypen werden analysiert ...");
+ analyze fonts (eumel file name, file fonttable,
+ font number string, base font index);
+ line;
+ say ("Fu"251"noten werden plaziert ...");
+ move footnotes (eumel file name);
+ wp file name := dos file name (eumel file name, "wpf");
+ forget (wp file name, quiet);
+ line;
+ say ("Datei wird konvertiert ...");
+ line;
+ IF file fonttable <> ""
+ THEN users fonttable := fonttable;
+ fonttable (file fonttable)
+ FI;
+ convert to wp file (eumel file name, wp file name);
+ forget (eumel file name, quiet);
+ rename (eumel file name + ".orig", eumel file name);
+ IF users fonttable <> ""
+ THEN fonttable (users fonttable)
+ FI
+ FI
+END PROC konvertiere nach wp;
+PROC konvertiere nach wp (THESAURUS CONST th) :
+ do (PROC (TEXT CONST) konvertiere nach wp, th)
+END PROC konvertiere nach wp;
+PROC konvertiere nach wp :
+ konvertiere nach wp (std)
+END PROC konvertiere nach wp;
+PROC move footnotes (TEXT CONST file name) :
+ copy (file name, file name + ".orig");
+ FILE VAR f := sequential file (modify, file name);
+ INT VAR count line no, count col no,
+ foot line no, foot col no,
+ end line no, end col no,
+ value line no, value col no,
+ footnote lines, line length;
+ TEXT VAR count line tail;
+ toline (f, 1);
+ WHILE NOT eof (f) REP
+ cout (line no (f));
+ down (f, "#count#");
+ IF pattern found
+ THEN process note
+ FI
+ PER
+.
+process note :
+ count line no := line no (f);
+ count col no := col (f);
+ down (f, "#foot#");
+ IF pattern found
+ THEN foot line no := line no (f);
+ foot col no := col (f);
+ IF foot line no - count line no > 20
+ THEN LEAVE process note
+ FI;
+ isolate foot cmd if necessary;
+ down (f, "#end#");
+ IF pattern found
+ THEN end line no := line no (f);
+ check for value;
+ isolate end cmd if necessary;
+ remove note;
+ split count line;
+ replace count by note
+ ELSE LEAVE process note
+ FI
+ ELSE LEAVE process note
+ FI
+.
+check for value :
+ toline (f, foot line no);
+ col (f, foot col no);
+ down (f, "#value#");
+ IF pattern found
+ THEN value line no := line no (f);
+ value col no := col (f);
+ IF value line no >= end line no
+ THEN LEAVE process note
+ ELSE delete value cmd
+ FI
+ ELSE LEAVE process note
+ FI;
+ toline (f, end line no)
+.
+delete value cmd :
+ read record (f, act l);
+ change (act l, "#u##value##e#", "");
+ change (act l, "#value#", "");
+ write record (f, act l)
+.
+isolate foot cmd if necessary :
+ read record (f, act l);
+ IF foot col no > 1
+ THEN next l := subtext (act l, foot col no);
+ IF (act l SUB (foot col no - 1)) = " "
+ THEN act l := subtext (act l, 1, foot col no - 2)
+ ELSE act l := subtext (act l, 1, foot col no - 1)
+ FI;
+ write record (f, act l);
+ down (f, 1);
+ insert record (f);
+ write record (f, next l)
+ FI
+.
+isolate end cmd if necessary :
+ read record (f, act l);
+ end col no INCR 5;
+ next l := subtext (act l, end col no);
+ IF next l > " "
+ THEN act l := subtext (act l, 1, end col no - 1);
+ write record (f, act l);
+ down (f, 1);
+ insert record (f);
+ write record (f, next l);
+ up (f, 1)
+ FI
+.
+remove note :
+ footnote lines := end line no - foot line no + 1;
+ remove (f, footnote lines)
+.
+split count line :
+ toline (f, count line no);
+ read record (f, act l);
+ cmd start := pos (act l, "#u##count##e#", count col no - 3);
+ IF cmd start = count col no - 3
+ THEN cmd end := cmd start + 12
+ ELSE cmd start := count col no;
+ cmd end := cmd start + 7
+ FI;
+ count line tail := subtext (act l, cmd end + 1);
+ IF (count line tail SUB LENGTH count line tail) = " "
+ CAND (only command line (count line tail) COR
+ LENGTH count line tail = 1)
+ THEN count line tail CAT " "
+ FI;
+ act l := subtext (act l, 1, cmd start - 1);
+ write record (f, act l)
+.
+replace count by note :
+ toline (f, count line no + 1);
+ reinsert (f);
+ append count line tail;
+ toline (f, count line no + 1);
+ read record (f, next l);
+ delete record (f);
+ up (f, 1);
+ read record (f, act l);
+ act l CAT next l;
+ line length := LENGTH act l;
+ IF pos (act l, "#foot#") = line length - 6 CAND
+ (act l SUB line length) = " "
+ THEN act l := subtext (act l, 1, line length - 1)
+ FI;
+ write record (f, act l)
+.
+append count line tail :
+ read record (f, act l);
+ end col no := pos (act l, "#end#");
+ act l := subtext (act l, 1, end col no + 4);
+ IF count line tail <> ""
+ THEN act l CAT count line tail
+ ELSE append next line
+ FI;
+ write record (f, act l)
+.
+append next line :
+ down (f, 1);
+ read record (f, next l);
+ IF next l > " "
+ THEN delete record (f);
+ up (f, 1);
+ act l CAT " ";
+ act l CAT next l;
+ write record (f, act l)
+ ELSE up (f, 1)
+ FI
+.
+cmd start : first cross pos
+.
+cmd end : second cross pos
+END PROC move footnotes;
+PROC initialize values :
+ act l no := 0;
+ current wp size := 3;
+ current script value := 0;
+ mod flags := 0;
+ current index number := 0;
+ current tab insert pos:= default tab insert pos;
+ paper length := cont paper length;
+ paper width := cont paper width;
+ current top margin := 2.5;
+ current bottom margin := 2.5;
+ current left margin := 3.0;
+ current right margin := 2.0;
+ current pagelength := paper length - current top margin - current bottom margin;
+ current limit := paper width - current left margin - current right margin;
+ current font := 1;
+ current indent pitch := xstep conversion (indentation pitch (current font));
+ in enum := FALSE;
+ in table := FALSE;
+ in footnote := FALSE;
+ in header := FALSE;
+ in bottom := FALSE;
+ in index := FALSE;
+ text in dos l := FALSE;
+ base font offset := base font index - 3;
+ wp cmd := "";
+ dos l := "";
+ dos l length := 0;
+ next indent level := 0;
+ no users tabs cmd := no users tabs command;
+ users tabs cmd := no users tabs cmd
+END PROC initialize values;
+TEXT PROC no users tabs command :
+ TEXT VAR t := wp enter tab menu;
+ t CAT wp clear tabs;
+ t CAT german real (current limit - 2.0);
+ t CAT ".0,2c\\rt";
+ t CAT wp quit tab menu;
+ t
+END PROC no users tabs command;
+INT PROC indent level (INT CONST text start pos) :
+ LET tab distance = 0.5;
+ IF text start pos < 3
+ THEN 0
+ ELSE positive indent level
+ FI
+.
+positive indent level :
+ REAL VAR left margin distance
+ := real (text start pos - 1) * current indent pitch;
+ INT VAR ind level := int (round (left margin distance / tab distance, 0));
+ IF ind level = 0
+ THEN 1
+ ELSE ind level
+ FI
+END PROC indent level;
+PROC convert to wp file (TEXT CONST eumel file name, wp file name) :
+ get cursor (cursor x, cursor y);
+ FILE VAR eumel f := sequential file (input, eumel file name),
+ dos f := sequential file (output, wp file name);
+ max line length (dos f, max text length);
+ INT CONST file lines := lines (eumel f);
+ BOOL VAR is last file line := FALSE;
+ set file defaults;
+ getline (eumel f, next l);
+ next text start := pos (next l, ""33"", ""255"", 1);
+ REP
+ act l := next l;
+ act l no INCR 1;
+ cursor (eumel line display pos, cursor y);
+ cout (act l no);
+ act text start := next text start;
+ IF act l no >= file lines
+ THEN next l := "";
+ next text start := 1;
+ is last file line := TRUE
+ ELSE getline (eumel f, next l);
+ get next text start
+ FI;
+ act indent level := next indent level;
+ next indent level := indent level (next text start);
+ process act line;
+ IF is last line of paragraph
+ THEN IF is last file line
+ THEN complement pending paired commands
+ FI;
+ putline (dos f, dos l);
+ dos l := "";
+ dos l length := 0;
+ text in dos l := FALSE;
+ cursor (dos line display pos, cursor y);
+ cout (line no (dos f))
+ FI
+ UNTIL act l no >= file lines PER
+END PROC convert to wp file;
+PROC set file defaults :
+ initialize values;
+ set endnote options;
+ no pagination;
+ wp cmd CAT global tabs cmd
+.
+set endnote options :
+ cat to wp command ("s\J243\J22\\rt\&")
+.
+no pagination :
+ cat to wp command ("s\32649\&")
+END PROC set file defaults;
+PROC get next text start :
+ next text start := pos (next l, ""33"", ""255"", 1);
+ IF next text start = 2
+ THEN next text start := 1
+ FI
+END PROC get next text start;
+PROC process act line :
+ LET tab code = "<|s\\tb|>",
+ indent code = "<|s\\in|>",
+ margin rel code = "<|s\^|>";
+ INT VAR enum blanks, past enumerator pos;
+ trim end of line (act l, is last line of paragraph, in table);
+ replace eumel special characters (act l, line contains number sign);
+ trim start of line;
+ IF in table CAND NOT text in dos l
+ THEN replace multiple blanks by tab stops (act l, tab code)
+ FI;
+ transfer line in chunks
+.
+trim start of line :
+ IF NOT (text in dos l COR only command line (act l))
+ THEN IF NOT is last line of paragraph CAND
+ next indent level < act indent level
+ THEN cat to dos l (next indent level * indent code);
+ cat to dos l ((act indent level - next indent level) * tab code)
+ ELSE cat to dos l (act indent level * indent code)
+ FI;
+ enum blanks := enumeration offset (act l, next l, in enum, act text start);
+ IF enum blanks <> 0
+ THEN in enum := TRUE;
+ past enumerator pos := pos (act l, " ", act text start);
+ change (act l, past enumerator pos, enum blanks, indent code)
+ ELSE in enum := FALSE;
+ IF NOT is last line of paragraph CAND
+ next indent level > act indent level
+ THEN cat to dos l (indent code);
+ cat to dos l (margin rel code)
+ FI
+ FI
+ FI
+END PROC process act line;
+PROC complement pending paired commands :
+ reset modifications;
+ IF current wp size <> 3
+ THEN cat to wp command (wp types on off [current wp size]);
+ cat to dos l (wp cmd)
+ FI;
+END PROC complement pending paired commands;
+PROC transfer line in chunks :
+ WHILE act text start <= LENGTH act l REP
+ next text command pos (act l, act text start, first cross pos, second cross pos);
+ IF first cross pos <> 0
+ THEN IF first cross pos <> act text start
+ THEN process text chunk (act text start, first cross pos - 1)
+ FI;
+ process eumel command (first cross pos, second cross pos);
+ act text start := second cross pos + 1
+ ELSE process text chunk (act text start, LENGTH act l);
+ LEAVE transfer line in chunks
+ FI;
+ PER
+END PROC transfer line in chunks;
+PROC process text chunk (INT CONST start pos, end pos) :
+ eumel chunk := subtext (act l, start pos, end pos);
+ IF in header COR in bottom
+ THEN change all (eumel chunk, "%", page no cmd)
+ FI;
+ IF line contains number sign
+ THEN change all (eumel chunk, ""222"", "#")
+ FI;
+ cat to dos l (eumel chunk);
+ text in dos l := TRUE;
+ IF in index
+ THEN index buffer CAT eumel chunk
+ FI
+END PROC process text chunk;
+PROC process eumel command (INT CONST start pos, end pos) :
+ eumel chunk := subtext (act l, start pos + 1, end pos - 1);
+ IF (eumel chunk SUB 1) = "-"
+ THEN process comment (eumel chunk)
+ ELSE process command
+ FI;
+ cat to dos l (wp cmd);
+ wp cmd := ""
+.
+ process command :
+ analyze command (cosmetic cmds, eumel chunk, 3, cmd index, no of params,
+ param1, param2);
+ customized command processing;
+ IF in index
+ THEN index buffer CAT wp cmd
+ FI
+.
+ customized command processing :
+ SELECT cmd index OF
+ CASE type1 : process type cmd (param1)
+ CASE linefeed : cat to wp command ("s\316" +
+ german real (param1) + "\\rt\&")
+ CASE limit : process limit (param1)
+ CASE free : process free (param1)
+ CASE page cmd0 : cat to wp command ("s\_")
+ CASE page cmd1 : cat to wp command ("s\_\3261" + param1 + "\\rt\&")
+ CASE on : process mod on (param1)
+ CASE off : process mod off (param1)
+ CASE page nr :
+ CASE pagelength : process pagelength (param1)
+ CASE start : process start (param1, param2)
+ CASE foot : process footnote
+ CASE end : process end
+ CASE head,
+ headeven,
+ headodd : process head (cmd index)
+ CASE bottom,
+ bottomeven,
+ bottomodd : process bottom (cmd index)
+ CASE block : cat to wp command ("s\3134\&")
+ CASE material :
+ CASE columns : process columns
+ CASE columnsend : cat to wp command ("s\>12")
+ CASE ib0,
+ ib1,
+ ib2 : process index on (param1, param2)
+ CASE ie0, ie1, ie2 : process index off (param 1)
+ CASE topage : cat to wp command ("s\<111" + param1 + wp return)
+ CASE goalpage : cat to wp command ("s\<12" + param1 + wp return)
+ CASE count0 : cat to wp command ("s\051\\rt")
+ CASE count1 : process reference target (param1)
+ CASE setcount : cat to wp command ("s\J13" + param1 + wp return)
+ CASE value0 :
+ CASE value1 : cat to wp command ("s\<114" + param1 + wp return)
+ CASE table : process table
+ CASE table end : process table end
+ CASE r pos, l pos, c pos, d pos,
+ b pos : process tab stop (eumel chunk SUB 1, param1)
+ CASE clear pos0 : process clear all tabs
+ CASE clear pos1 : process clear tab (param1)
+ CASE right : cat to wp command ("s\=")
+ CASE center : cat to wp command ("s\1")
+ CASE skip :
+ CASE skip end :
+ CASE u cmd : process script cmd (1)
+ CASE d cmd : process script cmd (2)
+ CASE e cmd : process e cmd
+ CASE head on :
+ CASE head off : cat to wp command ("s\32311\&")
+ CASE bottom on :
+ CASE bottom off : cat to wp command ("s\32411\&")
+ CASE count per page : cat to wp command ("s\J146y\&")
+ CASE fillchar :
+ CASE mark cmd :
+ CASE mark end :
+ CASE pageblock :
+ CASE bsp :
+ CASE counter1 :
+ CASE counter2 :
+ CASE setcounter :
+ CASE putcounter0:
+ CASE putcounter1:
+ CASE storecounter:
+ CASE ub : process mod on ("u")
+ CASE ue : process mod off ("u")
+ CASE fb :
+ CASE fe :
+ CASE region, region end : cat to wp command ("p\3y")
+ END SELECT
+END PROC process eumel command;
+PROC process comment (TEXT CONST t) :
+ buffer := "p\Hy";
+ cat to wp command (buffer);
+ wp cmd CAT subtext (t, 2);
+ cat to wp command (buffer)
+END PROC process comment;
+PROC cat to dos l (TEXT CONST t) :
+ LET mtl = 32000;
+ INT CONST t length := LENGTH t;
+ IF mtl - t length < dos l length
+ THEN report ("Absatz ist zu lang")
+ ELSE dos l CAT t;
+ dos l length INCR t length
+ FI
+END PROC cat to dos l;
+PROC cat to wp command (TEXT CONST t) :
+ IF t <> ""
+ THEN wp cmd CAT wp cmd start;
+ wp cmd CAT t;
+ wp cmd CAT wp cmd end
+ FI
+END PROC cat to wp command;
+PROC process mod on (TEXT CONST kind of mod) :
+ TEXT CONST mod char := kind of mod SUB 1;
+ INT CONST mod no := pos (eumel modifications, mod char);
+ cat to wp command (wp mods on off [mod no]);
+ set bit (mod flags, mod no)
+END PROC process mod on;
+PROC process mod off (TEXT CONST kind of mod) :
+ TEXT CONST mod char := kind of mod SUB 1;
+ INT CONST mod no := pos (eumel modifications, mod char);
+ process mod off (mod no)
+END PROC process mod off;
+PROC process mod off (INT CONST mod no) :
+ cat to wp command (wp mods on off [mod no]);
+ reset bit (mod flags, mod no)
+END PROC process mod off;
+PROC reset modifications :
+ INT VAR mod no;
+ IF mod flags > 0
+ THEN FOR mod no FROM 1 UPTO 4 REP
+ IF bit (mod flags, mod no)
+ THEN process mod off (mod no)
+ FI
+ PER
+ FI
+END PROC reset modifications;
+PROC process type cmd (TEXT CONST wanted type) :
+ reset modifications;
+ current wp size off;
+ process type change (wanted type)
+.
+ current wp size off :
+ cat to wp command (wp types on off [current wp size])
+END PROC process type cmd;
+PROC process type change (TEXT CONST eumel type) :
+ current font := font (eumel type);
+ current indent pitch := xstep conversion (indentation pitch (current font));
+ TEXT CONST eumel type no := code (current font);
+ INT CONST eumel size := pos (font number string, eumel type no);
+ current wp size := eumel size - base font offset;
+ IF current wp size < 1
+ THEN current wp size := 1
+ ELIF current wp size > 6
+ THEN current wp size := 6
+ FI;
+ cat to wp command (wp types on off [current wp size])
+END PROC process type change;
+PROC process script cmd (INT CONST script value) :
+ current script value := script value;
+ cat to wp command (wp scripts on off [script value])
+END PROC process script cmd;
+PROC process e cmd :
+ cat to wp command (wp scripts on off [current script value]);
+ current script value := 0
+END PROC process e cmd;
+PROC process free (TEXT CONST cm) :
+ IF NOT in header COR in bottom
+ THEN buffer := "s\3412";
+ buffer CAT german real (cm);
+ buffer CAT "c\\rt\&";
+ cat to wp command (buffer)
+ FI
+END PROC process free;
+PROC process limit (TEXT CONST t limit) :
+ current limit := real (t limit);
+ current limit := min (current limit, paper width - 2.0 * minimal margin);
+ process horizontal margins
+END PROC process limit;
+PROC process horizontal margins :
+ current right margin := paper width - current limit - current left margin;
+ IF current right margin - minimal margin < 0.0
+ THEN current right margin := minimal margin;
+ current left margin := paper width - current limit - current right margin
+ FI;
+ wp cmd := wp cmd start;
+ wp cmd CAT "s\317";
+ wp cmd CAT german real (current left margin);
+ wp cmd CAT "c\\rt";
+ wp cmd CAT german real (current right margin);
+ wp cmd CAT "c\\rt\&";
+ wp cmd CAT wp cmd end;
+END PROC process horizontal margins;
+PROC process pagelength (TEXT CONST t length) :
+ current pagelength := real (t length);
+ current pagelength
+ := min (current pagelength, paper length - 2.0 * minimal margin);
+ process vertical margins
+END PROC process pagelength;
+PROC process vertical margins :
+ current bottom margin := paper length - current pagelength - current top margin;
+ IF current bottom margin - minimal margin < 0.0
+ THEN current bottom margin := minimal margin;
+ current top margin
+ := paper length - current pagelength - current bottom margin
+ FI;
+ wp cmd := wp cmd start;
+ wp cmd CAT "s\325";
+ wp cmd CAT german real (current top margin);
+ wp cmd CAT "c\\rt";
+ wp cmd CAT german real (current bottom margin);
+ wp cmd CAT "c\\rt\&";
+ wp cmd CAT wp cmd end;
+END PROC process vertical margins;
+PROC process start (TEXT CONST t x, t y) :
+ current left margin := real (t x);
+ process horizontal margins;
+ current top margin := real (t y);
+ process vertical margins
+END PROC process start;
+PROC process footnote :
+ IF in footnote
+ THEN report ("Fu"251"notenschachtelung")
+ FI;
+ paired move cmd := "f\J11 \\rt\&";
+ cat to wp command (paired move cmd);
+ in footnote := TRUE
+END PROC process footnote;
+PROC process head (INT CONST index) :
+ IF in header
+ THEN report ("Header-Schachtelung")
+ FI;
+ paired move cmd := "f\323";
+ IF index <= headeven
+ THEN paired move cmd CAT "1";
+ IF index = head
+ THEN paired move cmd CAT "2"
+ ELSE paired move cmd CAT "4"
+ FI
+ ELSE paired move cmd CAT "23"
+ FI;
+ paired move cmd CAT "\\rt\&00";
+ cat to wp command (paired move cmd);
+ in header := TRUE
+END PROC process head;
+PROC process bottom (INT CONST index) :
+ IF in bottom
+ THEN report ("Bottom-Schachtelung")
+ FI;
+ paired move cmd := "f\324";
+ IF index <= bottomeven
+ THEN paired move cmd CAT "1";
+ IF index = bottom
+ THEN paired move cmd CAT "2"
+ ELSE paired move cmd CAT "4"
+ FI
+ ELSE paired move cmd CAT "23"
+ FI;
+ paired move cmd CAT "\\rt\&00";
+ cat to wp command (paired move cmd);
+ in bottom := TRUE
+END PROC process bottom;
+PROC process end :
+ reset types and mods;
+ cat to wp command (paired move cmd);
+ IF in header
+ THEN in header := FALSE
+ ELIF in bottom
+ THEN in bottom := FALSE
+ ELIF in footnote
+ THEN in footnote := FALSE
+ ELSE report ("Unmotivierte End-Anweisung")
+ FI
+.
+reset types and mods :
+ reset modifications;
+ IF current wp size <> 3
+ THEN cat to wp command (wp types on off [current wp size]);
+ current wp size := 3;
+ FI
+END PROC process end;
+PROC process columns :
+ INT VAR fcp, scp;
+ cat to wp command ("s\>1301");
+ next text command pos (act l, act text start, fcp, scp);
+ IF fcp = second cross pos + 1
+ THEN eumel chunk := subtext (act l, fcp + 1, scp - 1);
+ analyze command (cosmetic cmds, eumel chunk, 3, cmd index,
+ no of params, param1, param2);
+ IF cmd index = limit
+ THEN second cross pos := scp
+ FI
+ FI
+END PROC process columns;
+PROC process index on (TEXT CONST index number, registered text) :
+ IF in index
+ THEN report ("Kann Indexschachtelung nicht verarbeiten")
+ FI;
+ current index number := int (index number);
+ index buffer := "<|s\<3";
+ IF registered text <> ""
+ THEN index buffer CAT registered text
+ ELSE in index := TRUE
+ FI
+END PROC process index on;
+PROC process index off (TEXT CONST index number) :
+ INT CONST index off number := int (index number);
+ IF current index number = index off number
+ THEN current index number := 0
+ ELSE report ("Kann Indexschachtelung nicht verarbeiten")
+ FI;
+ wp cmd := index buffer;
+ wp cmd CAT "\\rt\ |>";
+ in index := FALSE
+END PROC process index off;
+PROC process reference target (TEXT CONST marker) :
+ buffer := "s\J21\&\<12";
+ buffer CAT marker;
+ buffer CAT wp return;
+ cat to wp command (buffer)
+END PROC process reference target;
+PROC process table :
+ IF users tabs cmd <> no users tabs cmd
+ THEN wp cmd := users tabs cmd
+ FI;
+ in table := TRUE
+END PROC process table;
+PROC process table end :
+ wp cmd := global tabs cmd;
+ in table := FALSE
+END PROC process table end;
+PROC process tab stop (TEXT CONST tab type, tab pos) :
+ buffer := german real (tab pos);
+ buffer CAT wp return;
+ IF pos ("rcd", tab type) <> 0
+ THEN buffer CAT tab type
+ FI;
+ insert new tab stop;
+ IF in table
+ THEN wp cmd CAT users tabs cmd
+ FI
+.
+insert new tab stop :
+ insert char (users tabs cmd, buffer, current tab insert pos);
+ current tab insert pos INCR LENGTH buffer
+END PROC process tab stop;
+PROC process clear all tabs :
+ users tabs cmd := no users tabs cmd;
+ current tab insert pos := default tab insert pos;
+END PROC process clear all tabs;
+PROC process clear tab (TEXT CONST tab pos) :
+ INT VAR del start, del end;
+ del start := pos (users tabs cmd, tab pos);
+ IF del start <> 0
+ THEN clear pos
+ FI
+.
+clear pos :
+ del end := pos (users tabs cmd, wp return, del start) + 4;
+ buffer := users tabs cmd SUB del end + 1;
+ IF pos ("rcd", buffer) <> 0
+ THEN del end INCR 1
+ FI;
+ change (users tabs cmd, del start, del end, "");
+ IF in table
+ THEN wp cmd CAT users tabs cmd
+ FI
+END PROC process clear tab;
+PROC report (TEXT CONST t) :
+ errorstop ("Zeile " + text (act l no) + ": " + t)
+END PROC report;
+TEXT PROC german real (TEXT CONST t) :
+ TEXT VAR t1 := t;
+ change (t1, ".", ",");
+ t1
+END PROC german real;
+TEXT PROC german real (REAL CONST r) :
+ TEXT VAR t := text (r);
+ german real (t)
+END PROC german real;
+END PACKET wordperfect conversion;