From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/conversion/1.0/source-disk | 1 + app/conversion/1.0/src/AGFA2ASC.TBL | 19 + app/conversion/1.0/src/ASKCNVRS.PAC | 349 ++++++++++++++ app/conversion/1.0/src/DOSCNVRS.PAC | 203 ++++++++ app/conversion/1.0/src/EU_CNVRS.DOC | 150 ++++++ app/conversion/1.0/src/FILEUTIL.PAC | 142 ++++++ app/conversion/1.0/src/FONTANAL.PAC | 261 ++++++++++ app/conversion/1.0/src/PSEUDOWP.WPM | Bin 0 -> 1437 bytes app/conversion/1.0/src/PS_WP_DT.WPM | Bin 0 -> 1439 bytes app/conversion/1.0/src/SEQU2CUM.TBL | 1 + app/conversion/1.0/src/WP_CNVRS.PAC | 905 +++++++++++++++++++++++++++++++++++ app/conversion/1.0/src/WP_KNVRS.PAC | 915 ++++++++++++++++++++++++++++++++++++ 12 files changed, 2946 insertions(+) create mode 100644 app/conversion/1.0/source-disk create mode 100644 app/conversion/1.0/src/AGFA2ASC.TBL create mode 100644 app/conversion/1.0/src/ASKCNVRS.PAC create mode 100644 app/conversion/1.0/src/DOSCNVRS.PAC create mode 100644 app/conversion/1.0/src/EU_CNVRS.DOC create mode 100644 app/conversion/1.0/src/FILEUTIL.PAC create mode 100644 app/conversion/1.0/src/FONTANAL.PAC create mode 100644 app/conversion/1.0/src/PSEUDOWP.WPM create mode 100644 app/conversion/1.0/src/PS_WP_DT.WPM create mode 100644 app/conversion/1.0/src/SEQU2CUM.TBL create mode 100644 app/conversion/1.0/src/WP_CNVRS.PAC create mode 100644 app/conversion/1.0/src/WP_KNVRS.PAC (limited to 'app/conversion') 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"")#", ""); + change all (t, "#off(""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 Binary files /dev/null and b/app/conversion/1.0/src/PSEUDOWP.WPM 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 Binary files /dev/null and b/app/conversion/1.0/src/PS_WP_DT.WPM 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; -- cgit v1.2.3