summaryrefslogtreecommitdiff
path: root/system/base/1.7.5/src/editor
diff options
context:
space:
mode:
Diffstat (limited to 'system/base/1.7.5/src/editor')
-rw-r--r--system/base/1.7.5/src/editor2959
1 files changed, 2959 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/editor b/system/base/1.7.5/src/editor
new file mode 100644
index 0000000..62af2db
--- /dev/null
+++ b/system/base/1.7.5/src/editor
@@ -0,0 +1,2959 @@
+PACKET editor paket DEFINES (* EDITOR 121 *)
+ (**********) (* 19.07.85 -bk- *)
+ (* 10.09.85 -ws- *)
+ (* 25.04.86 -sh- *)
+ edit, editget, (* 06.06.86 -wk- *)
+ quit, quit last, (* 04.06.86 -jl- *)
+ push, type,
+ word wrap, margin,
+ write permission,
+ set busy indicator,
+ two bytes,
+ is kanji esc,
+ within kanji,
+ rubin mode,
+ is editget,
+ getchar, nichts neu,
+ getcharety, satznr neu,
+ is incharety, ueberschrift neu,
+ get window, zeile neu,
+ get editcursor, abschnitt neu,
+ get editline, bildabschnitt neu,
+ put editline, bild neu,
+ aktueller editor, alles neu,
+ groesster editor, satznr zeigen,
+ open editor, ueberschrift zeigen,
+ editfile, bild zeigen:
+
+
+LET hop = ""1"", right = ""2"",
+ up char = ""3"", clear eop = ""4"",
+ clear eol = ""5"", cursor pos = ""6"",
+ piep = ""7"", left = ""8"",
+ down char = ""10"", rubin = ""11"",
+ rubout = ""12"", cr = ""13"",
+ mark key = ""16"", abscr = ""17"",
+ inscr = ""18"", dezimal = ""19"",
+ backcr = ""20"", esc = ""27"",
+ dach = ""94"", blank = " ";
+
+
+LET no output = 0, out zeichen = 1,
+ out feldrest = 2, out feld = 3,
+ clear feldrest = 4;
+
+LET FELDSTATUS = STRUCT (INT stelle, alte stelle, rand, limit,
+ anfang, marke, laenge, verschoben,
+ BOOL einfuegen, fliesstext, write access,
+ TEXT tabulator);
+FELDSTATUS VAR feldstatus;
+
+TEXT VAR begin mark := ""15"",
+ end mark := ""14"";
+
+TEXT VAR separator := "", kommando := "", audit := "", zeichen := "",
+ satzrest := "", merksatz := "", alter editsatz := "";
+
+INT VAR kommando zeiger := 1, umbruchstelle, umbruch verschoben,
+ zeile, spalte, output mode := no output, postblanks := 0,
+ min schreibpos, max schreibpos, cpos, absatz ausgleich;
+
+BOOL VAR lernmodus := FALSE, separator eingestellt := FALSE,
+ invertierte darstellung := FALSE, absatzmarke steht,
+ cursor diff := FALSE, editget modus := FALSE,
+ two byte mode := FALSE, std fliesstext := TRUE;.
+
+schirmbreite : x size - 1 .
+schirmhoehe : y size .
+maxbreite : schirmbreite - 2 .
+maxlaenge : schirmhoehe - 1 .
+marklength : mark size .;
+
+initialisiere editor;
+
+.initialisiere editor :
+ anfang := 1; zeile := 0; verschoben := 0; tabulator := "";
+ einfuegen := FALSE; fliesstext := TRUE; zeileneinfuegen := FALSE;
+ marke := 0; bildmarke := 0; feldmarke := 0.;
+
+(******************************** editget ********************************)
+
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge,
+ TEXT CONST sep, res, TEXT VAR exit char) :
+ IF editlaenge < 1 THEN errorstop ("Fenster zu klein") FI;
+ separator := ""13""; separator CAT sep;
+ separator eingestellt := TRUE;
+ TEXT VAR reservierte editget tasten := ""11""12"" ;
+ reservierte editget tasten CAT res ;
+ disable stop;
+ absatz ausgleich := 0; exit char := ""; get cursor;
+ FELDSTATUS CONST alter feldstatus := feldstatus;
+ feldstatus := FELDSTATUS : (1, 1, spalte - 1, editlimit,
+ 1, 0, editlaenge, 0,
+ FALSE, FALSE, TRUE, "");
+ konstanten neu berechnen;
+ output mode := out feld;
+ feld editieren;
+ zeile verlassen;
+ feldstatus := alter feldstatus;
+ konstanten neu berechnen;
+ separator := "";
+ separator eingestellt := FALSE .
+
+feld editieren :
+ REP
+ feldeditor (editsatz, reservierte editget tasten);
+ IF is error
+ THEN kommando zeiger := 1; kommando := ""; LEAVE feld editieren
+ FI ;
+ TEXT VAR t, zeichen; getchar (zeichen);
+ IF zeichen ist separator
+ THEN exit char := zeichen; LEAVE feld editieren
+ ELIF zeichen = hop
+ THEN feldout (editsatz, stelle); getchar (zeichen)
+ ELIF zeichen = mark key
+ THEN output mode := out feld
+ ELIF zeichen = abscr
+ THEN exit char := cr; LEAVE feld editieren
+ ELIF zeichen = esc
+ THEN getchar (zeichen); auf exit pruefen;
+ IF zeichen = rubout (*sh*)
+ THEN IF marke > 0
+ THEN merksatz := subtext (editsatz, marke, stelle - 1);
+ change (editsatz, marke, stelle - 1, "");
+ stelle := marke; marke := 0; konstanten neu berechnen
+ FI
+ ELIF zeichen = rubin
+ THEN t := subtext (editsatz, 1, stelle - 1);
+ t CAT merksatz;
+ satzrest := subtext (editsatz, stelle);
+ t CAT satzrest;
+ stelle INCR LENGTH merksatz;
+ merksatz := ""; editsatz := t
+ ELIF zeichen ist kein esc kommando (*wk*)
+ AND
+ kommando auf taste (zeichen) <> ""
+ THEN editget kommando ausfuehren
+ FI ;
+ output mode := out feld
+ FI
+ PER .
+
+zeichen ist kein esc kommando : (*wk*)
+ pos (hop + left + right, zeichen) = 0 .
+
+zeile verlassen :
+ IF marke > 0 OR verschoben <> 0
+ THEN stelle DECR verschoben; verschoben := 0; feldout (editsatz, 0)
+ ELSE cursor (rand + 1 + min (LENGTH editsatz, editlaenge), zeile)
+ FI .
+
+zeichen ist separator : pos (separator, zeichen) > 0 .
+
+auf exit pruefen :
+ IF pos (res, zeichen) > 0
+ THEN exit char := esc + zeichen; LEAVE feld editieren
+ FI .
+
+editget kommando ausfuehren :
+ editget zustaende sichern ;
+ do (kommando auf taste (zeichen)) ;
+ alte editget zustaende wieder herstellen ;
+ IF stelle < marke THEN stelle := marke FI;
+ konstanten neu berechnen .
+
+editget zustaende sichern : (*wk*)
+ BOOL VAR alter editget modus := editget modus;
+ FELDSTATUS VAR feldstatus vor do kommando := feldstatus ;
+ INT VAR zeile vor do kommando := zeile ;
+ TEXT VAR separator vor do kommando := separator ;
+ BOOL VAR separator eingestellt vor do kommando := separator eingestellt ;
+ editget modus := TRUE ;
+ alter editsatz := editsatz .
+
+alte editget zustaende wieder herstellen :
+ editget modus := alter editget modus ;
+ editsatz := alter editsatz;
+ feldstatus := feldstatus vor do kommando ;
+ zeile := zeile vor do kommando ;
+ separator := separator vor do kommando ;
+ separator eingestellt := separator eingestellt vor do kommando .
+
+END PROC editget;
+
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, TEXT VAR exit char) :
+ editget (editsatz, editlimit, x size - x cursor, "", "", exit char)
+END PROC editget; (* 05.07.84 -bk- *)
+
+PROC editget (TEXT VAR editsatz, TEXT CONST sep, res, TEXT VAR exit char) :
+ editget (editsatz, max text length, x size - x cursor, sep, res, exit char)
+END PROC editget; (* 05.07.84 -bk- *)
+
+PROC editget (TEXT VAR editsatz) :
+ TEXT VAR exit char; (* 05.07.84 -bk- *)
+ editget (editsatz, max text length, x size - x cursor, "", "", exit char)
+END PROC editget;
+
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editlaenge) :
+ TEXT VAR exit char;
+ editget (editsatz, editlimit, editlaenge, "", "", exit char)
+ENDPROC editget;
+
+(******************************* feldeditor ******************************)
+
+TEXT VAR reservierte feldeditor tasten ; (*jl*)
+
+PROC feldeditor (TEXT VAR satz, TEXT CONST res) :
+ enable stop;
+ reservierte feldeditor tasten := ""1""2""8"" ;
+ reservierte feldeditor tasten CAT res;
+ absatzmarke steht := (satz SUB LENGTH satz) = blank;
+ alte stelle merken;
+ cursor diff bestimmen und ggf ausgleichen;
+ feld editieren;
+ absatzmarke updaten .
+
+alte stelle merken : alte stelle := stelle .
+
+cursor diff bestimmen und ggf ausgleichen :
+ IF cursor diff
+ THEN stelle INCR 1; cursor diff := FALSE
+ FI ;
+ IF stelle auf zweitem halbzeichen
+ THEN stelle DECR 1; cursor diff := TRUE
+ FI .
+
+feld editieren :
+ REP
+ feld optisch aufbereiten;
+ kommando annehmen und ausfuehren
+ PER .
+
+absatzmarke updaten :
+ IF absatzmarke soll stehen
+ THEN IF NOT absatzmarke steht THEN absatzmarke schreiben (TRUE) FI
+ ELSE IF absatzmarke steht THEN absatzmarke schreiben (FALSE) FI
+ FI .
+
+absatzmarke soll stehen : (satz SUB LENGTH satz) = blank .
+
+feld optisch aufbereiten :
+ stelle korrigieren;
+ verschieben wenn erforderlich;
+ randausgleich fuer doppelzeichen;
+ output mode behandeln;
+ ausgabe verhindern .
+
+randausgleich fuer doppelzeichen :
+ IF stelle = max schreibpos CAND stelle auf erstem halbzeichen
+ THEN verschiebe (1)
+ FI .
+
+stelle korrigieren :
+ IF stelle auf zweitem halbzeichen THEN stelle DECR 1 FI .
+
+stelle auf erstem halbzeichen : within kanji (satz, stelle + 1) .
+
+stelle auf zweitem halbzeichen : within kanji (satz, stelle) .
+
+output mode behandeln :
+ SELECT output mode OF
+ CASE no output : im markiermode markierung anpassen
+ CASE out zeichen : zeichen ausgeben; LEAVE output mode behandeln
+ CASE out feldrest : feldrest neu schreiben
+ CASE out feld : feldout (satz, stelle)
+ CASE clear feldrest : feldrest loeschen
+ END SELECT;
+ schreibmarke positionieren (stelle) .
+
+ausgabe verhindern : output mode := no output .
+
+im markiermode markierung anpassen :
+ IF markiert THEN markierung anpassen FI .
+
+markierung anpassen :
+ IF stelle > alte stelle
+ THEN markierung verlaengern
+ ELIF stelle < alte stelle
+ THEN markierung verkuerzen
+ FI .
+
+markierung verlaengern :
+ invers out (satz, alte stelle, stelle, "", end mark) .
+
+markierung verkuerzen :
+ invers out (satz, stelle, alte stelle, end mark, "") .
+
+zeichen ausgeben :
+ IF NOT markiert
+ THEN out (zeichen)
+ ELIF mark refresh line mode
+ THEN feldout (satz, stelle); schreibmarke positionieren (stelle)
+ ELSE out (begin mark); markleft; out (zeichen); out (end mark); markleft
+ FI .
+
+markleft :
+ marklength TIMESOUT left .
+
+feldrest neu schreiben :
+ IF NOT markiert
+ THEN feldrest unmarkiert neu schreiben
+ ELSE feldrest markiert neu schreiben
+ FI ;
+ WHILE postblanks > 0 CAND x cursor <= rand + laenge REP
+ out (blank); postblanks DECR 1
+ PER ; postblanks := 0 .
+
+feldrest unmarkiert neu schreiben :
+ schreibmarke positionieren (alte stelle);
+ out subtext mit randbehandlung (satz, alte stelle, stelle am ende) .
+
+feldrest markiert neu schreiben :
+ markierung verlaengern; out subtext mit randbehandlung
+ (satz, stelle, stelle am ende - 2 * marklength) .
+
+kommando annehmen und ausfuehren :
+ kommando annehmen; kommando ausfuehren .
+
+kommando annehmen :
+ getchar (zeichen); kommando zurueckweisen falls noetig .
+
+kommando zurueckweisen falls noetig :
+ IF NOT write access CAND zeichen ist druckbar
+ THEN benutzer warnen; kommando ignorieren
+ FI .
+
+benutzer warnen : out (piep) .
+
+kommando ignorieren :
+ zeichen := ""; LEAVE kommando annehmen und ausfuehren .
+
+kommando ausfuehren :
+ neue satzlaenge bestimmen;
+ alte stelle merken;
+ IF zeichen ist separator
+ THEN feldeditor verlassen
+ ELIF zeichen ist druckbar
+ THEN fortschreiben
+ ELSE funktionstasten behandeln
+ FI .
+
+neue satzlaenge bestimmen : INT VAR satzlaenge := LENGTH satz .
+
+feldeditor verlassen :
+ IF NOT absatzmarke steht THEN blanks abschneiden FI; (*sh*)
+ push (zeichen); LEAVE feld editieren .
+
+blanks abschneiden :
+ INT VAR letzte non blank pos := satzlaenge;
+ WHILE letzte non blank pos > 0 CAND (satz SUB letzte non blank pos) = blank REP
+ letzte non blank pos DECR 1
+ PER; satz := subtext (satz, 1, letzte non blank pos) .
+
+zeichen ist druckbar : zeichen >= blank .
+
+zeichen ist separator :
+ separator eingestellt CAND pos (separator, zeichen) > 0 .
+
+fortschreiben :
+ zeichen in satz eintragen;
+ IF is kanji esc (zeichen) THEN kanji zeichen schreiben FI;
+ bei erreichen von limit ueberlauf behandeln .
+
+zeichen in satz eintragen :
+ IF hinter dem satz
+ THEN satz mit leerzeichen auffuellen und zeichen anfuegen
+ ELIF einfuegen
+ THEN zeichen vor aktueller position einfuegen
+ ELSE altes zeichen ersetzen
+ FI .
+
+hinter dem satz : stelle > satzlaenge .
+
+satz mit leerzeichen auffuellen und zeichen anfuegen :
+ satz AUFFUELLENMIT blank;
+ zeichen anfuegen;
+ output mode := out zeichen .
+
+zeichen anfuegen : satz CAT zeichen; neue satzlaenge bestimmen .
+zeichen ignorieren : benutzer warnen; LEAVE kommando ausfuehren .
+
+zeichen vor aktueller position einfuegen :
+ insert char (satz, zeichen, stelle);
+ neue satzlaenge bestimmen;
+ output mode := out feldrest .
+
+altes zeichen ersetzen :
+ replace (satz, stelle, zeichen);
+ IF stelle auf erstem halbzeichen
+ THEN output mode := out feldrest; replace (satz, stelle + 1, blank)
+ ELSE output mode := out zeichen
+ FI .
+
+kanji zeichen schreiben :
+ alte stelle merken;
+ stelle INCR 1; getchar (zeichen);
+ IF zeichen < ""64"" THEN zeichen := ""64"" FI;
+ IF hinter dem satz
+ THEN zeichen anfuegen
+ ELIF einfuegen
+ THEN zeichen vor aktueller position einfuegen
+ ELSE replace (satz, stelle, zeichen)
+ FI ;
+ output mode := out feldrest .
+
+bei erreichen von limit ueberlauf behandeln : (*sh*)
+ IF satzlaenge kritisch
+ THEN in naechste zeile falls moeglich
+ ELSE stelle INCR 1
+ FI .
+
+satzlaenge kritisch :
+ IF stelle >= satzlaenge
+ THEN satzlaenge = limit
+ ELSE satzlaenge = limit + 1
+ FI .
+
+in naechste zeile falls moeglich :
+ IF fliesstext AND umbruch moeglich OR NOT fliesstext AND stelle >= satzlaenge
+ THEN in naechste zeile
+ ELSE stelle INCR 1
+ FI .
+
+umbruch moeglich :
+ INT CONST st := stelle; stelle := limit;
+ INT CONST ltzt wortanf := letzter wortanfang (satz);
+ stelle := st; einrueckposition (satz) < ltzt wortanf .
+
+in naechste zeile :
+ IF fliesstext
+ THEN ueberlauf und oder umbruch
+ ELSE ueberlauf ohne umbruch
+ FI .
+
+ueberlauf und oder umbruch :
+ INT VAR umbruchpos := 1;
+ umbruchposition bestimmen;
+ loeschposition bestimmen;
+ IF stelle = satzlaenge
+ THEN ueberlauf mit oder ohne umbruch
+ ELSE umbruch mit oder ohne ueberlauf
+ FI .
+
+umbruchposition bestimmen :
+ umbruchstelle := stelle;
+ stelle := satzlaenge;
+ umbruchpos := max (umbruchpos, letzter wortanfang (satz));
+ stelle := umbruchstelle .
+
+loeschposition bestimmen :
+ INT VAR loeschpos := umbruchpos;
+ WHILE davor noch blank REP loeschpos DECR 1 PER .
+
+davor noch blank :
+ loeschpos > ganz links CAND (satz SUB (loeschpos - 1)) = blank .
+
+ganz links : max (1, marke) .
+
+ueberlauf mit oder ohne umbruch :
+ IF zeichen = blank OR loeschpos = ganz links
+ THEN stelle := 1; ueberlauf ohne umbruch
+ ELSE ueberlauf mit umbruch
+ FI .
+
+ueberlauf ohne umbruch : push (cr) .
+
+ueberlauf mit umbruch :
+ ausgabe verhindern;
+ umbruchkommando aufbereiten;
+ auf loeschposition positionieren .
+
+umbruchkommando aufbereiten :
+ zeichen := hop + rubout + inscr;
+ satzrest := subtext (satz, umbruchpos);
+ zeichen CAT satzrest;
+ IF stelle ist im umgebrochenen teil
+ THEN insert char (zeichen, backcr, max (stelle - umbruchpos + 1, 0) + 4);
+ zeichen CAT backcr
+ FI ;
+ push (zeichen) .
+
+stelle ist im umgebrochenen teil : stelle >= loeschpos .
+
+auf loeschposition positionieren : stelle := loeschpos .
+
+umbruch mit oder ohne ueberlauf :
+ umbruchposition anpassen;
+ IF stelle ist im umgebrochenen teil
+ THEN umbruch mit ueberlauf
+ ELSE umbruch ohne ueberlauf
+ FI .
+
+umbruchposition anpassen :
+ IF zeichen = blank
+ THEN umbruchpos := stelle + 1;
+ umbruchposition bestimmen;
+ neue loeschposition bestimmen
+ FI .
+
+neue loeschposition bestimmen :
+ loeschpos := umbruchpos;
+ WHILE davor noch blank AND stelle noch nicht erreicht REP loeschpos DECR 1 PER .
+
+stelle noch nicht erreicht : loeschpos > stelle + 1 .
+
+umbruch mit ueberlauf : ueberlauf mit umbruch .
+
+umbruch ohne ueberlauf :
+ zeichen := inscr;
+ satzrest := subtext (satz, umbruchpos);
+ zeichen CAT satzrest;
+ zeichen CAT up char + backcr;
+ umbruchstelle INCR 1; umbruch verschoben := verschoben;
+ satz := subtext (satz, 1, loeschpos - 1);
+ schreibmarke positionieren (loeschpos); feldrest loeschen;
+ output mode := out feldrest;
+ push (zeichen) .
+
+funktionstasten behandeln :
+ SELECT pos (kommandos, zeichen) OF
+ CASE c hop : hop kommandos behandeln
+ CASE c esc : esc kommandos behandeln
+ CASE c right : nach rechts oder ueberlauf
+ CASE c left : wenn moeglich ein schritt nach links
+ CASE c tab : zur naechsten tabulator position
+ CASE c dezimal : dezimalen schreiben
+ CASE c rubin : einfuegen umschalten
+ CASE c rubout : ein zeichen loeschen
+ CASE c abscr, c inscr, c down : feldeditor verlassen
+ CASE c up : eine zeile nach oben (*sh*)
+ CASE c cr : ggf absatz erzeugen
+ CASE c mark : markieren umschalten
+ CASE c backcr : zurueck zur umbruchstelle
+ OTHERWISE : sondertaste behandeln
+ END SELECT .
+
+kommandos :
+ LET c hop = 1, c right = 2,
+ c up = 3, c left = 4,
+ c tab = 5, c down = 6,
+ c rubin = 7, c rubout = 8,
+ c cr = 9, c mark = 10,
+ c abscr = 11, c inscr = 12,
+ c dezimal = 13, c esc = 14,
+ c backcr = 15;
+
+ ""1""2""3""8""9""10""11""12""13""16""17""18""19""27""20"" .
+
+dezimalen schreiben : IF write access THEN dezimaleditor (satz) FI .
+
+zurueck zur umbruchstelle:
+ IF umbruch stelle > 0 THEN stelle := umbruch stelle FI;
+ IF verschoben <> umbruch verschoben
+ THEN verschoben := umbruch verschoben; output mode := out feld
+ FI .
+
+hop kommandos behandeln :
+ TEXT VAR zweites zeichen; getchar (zweites zeichen);
+ zeichen CAT zweites zeichen;
+ SELECT pos (hop kommandos, zweites zeichen) OF
+ CASE h hop : nach links oben
+ CASE h right : nach rechts blaettern
+ CASE h left : nach links blaettern
+ CASE h tab : tab position definieren oder loeschen
+ CASE h rubin : zeile splitten
+ CASE h rubout : loeschen oder rekombinieren
+ CASE h cr, h up, h down : feldeditor verlassen
+ OTHERWISE : zeichen ignorieren
+ END SELECT .
+
+hop kommandos :
+ LET h hop = 1, h right = 2,
+ h up = 3, h left = 4,
+ h tab = 5, h down = 6,
+ h rubin = 7, h rubout = 8,
+ h cr = 9;
+
+ ""1""2""3""8""9""10""11""12""13"" .
+
+nach links oben :
+ stelle := max (marke, anfang) + verschoben; feldeditor verlassen .
+
+nach rechts blaettern :
+ INT CONST rechter rand := stelle am ende - markierausgleich;
+ IF stelle ist am rechten rand
+ THEN stelle INCR laenge - 2 * markierausgleich + ausgleich fuer doppelzeichen
+ ELSE stelle := rechter rand
+ FI ;
+ IF satzlaenge <= limit THEN stelle := min (stelle, limit) FI;
+ alte einrueckposition mitziehen .
+
+stelle ist am rechten rand :
+ stelle auf erstem halbzeichen CAND stelle = rechter rand - 1
+ COR stelle = rechter rand .
+
+ausgleich fuer doppelzeichen : stelle - rechter rand .
+
+nach links blaettern :
+ INT CONST linker rand := stelle am anfang;
+ IF stelle = linker rand
+ THEN stelle DECR laenge - 2 * markierausgleich
+ ELSE stelle := linker rand
+ FI ;
+ stelle := max (ganz links, stelle);
+ alte einrueckposition mitziehen .
+
+tab position definieren oder loeschen :
+ IF stelle > LENGTH tabulator
+ THEN tabulator AUFFUELLENMIT right; tabulator CAT dach
+ ELSE replace (tabulator, stelle, neues tab zeichen)
+ FI ;
+ feldeditor verlassen .
+
+neues tab zeichen :
+ IF (tabulator SUB stelle) = right THEN dach ELSE right FI .
+
+zeile splitten :
+ IF write access THEN feldeditor verlassen ELSE zeichen ignorieren FI .
+
+loeschen oder rekombinieren :
+ IF NOT write access
+ THEN zeichen ignorieren
+ ELIF hinter dem satz
+ THEN zeilen rekombinieren
+ ELIF auf erstem zeichen
+ THEN ganze zeile loeschen
+ ELSE zeilenrest loeschen
+ FI .
+
+zeilen rekombinieren : feldeditor verlassen .
+auf erstem zeichen : stelle = 1 .
+ganze zeile loeschen : satz := ""; feldeditor verlassen .
+
+zeilenrest loeschen :
+ change (satz, stelle, satzlaenge, "");
+ output mode := clear feldrest .
+
+esc kommandos behandeln :
+ getchar (zweites zeichen);
+ zeichen CAT zweites zeichen;
+ auf exit pruefen;
+ SELECT pos (esc kommandos, zweites zeichen) OF
+ CASE e hop : lernmodus umschalten
+ CASE e right : zum naechsten wort
+ CASE e left : zum vorigen wort
+ OTHERWISE : belegte taste ausfuehren
+ END SELECT .
+
+auf exit pruefen :
+ IF pos (res, zweites zeichen) > 0 THEN feldeditor verlassen FI .
+
+esc kommandos :
+ LET e hop = 1,
+ e right = 2,
+ e left = 3;
+
+ ""1""2""8"" .
+
+lernmodus umschalten :
+ IF lernmodus THEN lernmodus ausschalten ELSE lernmodus einschalten FI;
+ feldeditor verlassen .
+
+lernmodus ausschalten :
+ lernmodus := FALSE;
+ belegbare taste erfragen;
+ audit := subtext (audit, 1, LENGTH audit - 2);
+ IF taste = hop
+ THEN (* lernsequenz nicht auf taste legen *) (* 16.08.85 -ws- *)
+ ELSE lernsequenz auf taste legen (taste, audit)
+ FI ;
+ audit := "" .
+
+belegbare taste erfragen :
+ TEXT VAR taste; getchar (taste);
+ WHILE taste ist reserviert REP
+ benutzer warnen; getchar (taste)
+ PER .
+
+taste ist reserviert : (* 16.08.85 -ws- *)
+ taste <> hop CAND pos (reservierte feldeditor tasten, taste) > 0 .
+
+lernmodus einschalten : audit := ""; lernmodus := TRUE .
+
+zum vorigen wort :
+ IF stelle > 1
+ THEN stelle DECR 1; stelle := letzter wortanfang (satz);
+ alte einrueckposition mitziehen;
+ IF (satz SUB stelle) <> blank THEN LEAVE zum vorigen wort FI
+ FI ;
+ feldeditor verlassen .
+
+zum naechsten wort :
+ IF kein naechstes wort THEN feldeditor verlassen FI .
+
+kein naechstes wort :
+ BOOL VAR im alten wort := TRUE;
+ INT VAR i;
+ FOR i FROM stelle UPTO satzlaenge REP
+ IF im alten wort
+ THEN im alten wort := (satz SUB i) <> blank
+ ELIF (satz SUB i) <> blank
+ THEN stelle := i; LEAVE kein naechstes wort WITH FALSE
+ FI
+ PER;
+ TRUE .
+
+belegte taste ausfuehren :
+ IF ist kommando taste
+ THEN feldeditor verlassen
+ ELSE gelerntes ausfuehren
+ FI .
+
+ist kommando taste : taste enthaelt kommando (zweites zeichen) .
+
+gelerntes ausfuehren :
+ push (lernsequenz auf taste (zweites zeichen)) . (*sh*)
+
+nach rechts oder ueberlauf :
+ IF fliesstext COR stelle < limit OR satzlaenge > limit
+ THEN nach rechts
+ ELSE auf anfang der naechsten zeile
+ FI .
+
+nach rechts :
+ IF stelle auf erstem halbzeichen THEN stelle INCR 2 ELSE stelle INCR 1 FI;
+ alte einrueckposition mitziehen .
+
+auf anfang der naechsten zeile : push (abscr) .
+
+nach links : stelle DECR 1; alte einrueckposition mitziehen .
+
+alte einrueckposition mitziehen :
+ IF satz ist leerzeile
+ THEN alte einrueckposition := stelle
+ ELSE alte einrueckposition := min (stelle, einrueckposition (satz))
+ FI .
+
+satz ist leerzeile :
+ satz = "" OR satz = blank .
+
+wenn moeglich ein schritt nach links :
+ IF stelle = ganz links
+ THEN zeichen ignorieren
+ ELSE nach links
+ FI .
+
+zur naechsten tabulator position :
+ bestimme naechste explizite tabulator position;
+ IF tabulator gefunden
+ THEN explizit tabulieren
+ ELIF stelle <= satzlaenge
+ THEN implizit tabulieren
+ ELSE auf anfang der naechsten zeile
+ FI .
+
+bestimme naechste explizite tabulator position :
+ INT VAR tab position := pos (tabulator, dach, stelle + 1);
+ IF tab position > limit AND satzlaenge <= limit
+ THEN tab position := 0
+ FI .
+
+tabulator gefunden : tab position <> 0 .
+
+explizit tabulieren : stelle := tab position; push (dezimal) .
+
+implizit tabulieren :
+ tab position := einrueckposition (satz);
+ IF stelle < tab position
+ THEN stelle := tab position
+ ELSE stelle := satzlaenge + 1
+ FI .
+
+einfuegen umschalten :
+ IF NOT write access THEN zeichen ignorieren FI; (*sh*)
+ einfuegen := NOT einfuegen;
+ IF einfuegen THEN einfuegen optisch anzeigen FI;
+ feldeditor verlassen .
+
+einfuegen optisch anzeigen :
+ IF markiert
+ THEN out (begin mark); markleft; out (dach left); warten;
+ out (end mark); markleft
+ ELSE out (dach left); warten;
+ IF stelle auf erstem halbzeichen
+ THEN out text (satz, stelle, stelle + 1)
+ ELSE out text (satz, stelle, stelle)
+ FI
+ FI .
+
+markiert : marke > 0 .
+dach left : ""94""8"" .
+
+warten :
+ TEXT VAR t := incharety (2);
+ kommando CAT t; IF lernmodus THEN audit CAT t FI .
+
+ein zeichen loeschen :
+ IF NOT write access THEN zeichen ignorieren FI; (*sh*)
+ IF zeichen davor soll geloescht werden
+ THEN nach links oder ignorieren
+ FI ;
+ IF NOT hinter dem satz THEN aktuelles zeichen loeschen FI .
+
+zeichen davor soll geloescht werden :
+ hinter dem satz COR markiert .
+
+nach links oder ignorieren :
+ IF stelle > ganz links
+ THEN nach links (*sh*)
+ ELSE zeichen ignorieren
+ FI .
+
+aktuelles zeichen loeschen :
+ stelle korrigieren; alte stelle merken;
+ IF stelle auf erstem halbzeichen
+ THEN delete char (satz, stelle);
+ postblanks INCR 1
+ FI ;
+ delete char (satz, stelle);
+ postblanks INCR 1;
+ neue satzlaenge bestimmen;
+ output mode := out feldrest .
+
+eine zeile nach oben : (*sh*)
+ IF NOT absatzmarke steht CAND NOT ist teil eines umbruchkommandos
+ THEN blanks abschneiden
+ FI ;
+ push (zeichen); LEAVE feld editieren .
+
+ist teil eines umbruchkommandos : (kommando SUB kommandozeiger) = backcr .
+
+ggf absatz erzeugen : (*sh*)
+ IF write access
+ THEN IF NOT absatzmarke steht THEN blanks abschneiden FI;
+ IF stelle > LENGTH satz AND fliesstext AND NOT absatzmarke steht
+ THEN satz CAT blank
+ FI
+ FI ; push (zeichen); LEAVE feld editieren .
+
+markieren umschalten :
+ IF markiert
+ THEN marke := 0; maxschreibpos INCR marklength; cpos DECR marklength
+ ELSE marke := stelle; maxschreibpos DECR marklength; cpos INCR marklength;
+ verschieben wenn erforderlich
+ FI ;
+ feldeditor verlassen .
+
+sondertaste behandeln : push (esc + zeichen) .
+END PROC feldeditor;
+
+PROC dezimaleditor (TEXT VAR satz) :
+ INT VAR dezimalanfang := stelle;
+ zeichen einlesen;
+ IF dezimalstartzeichen CAND ueberschreibbar THEN dezimalen schreiben FI;
+ push (zeichen) .
+
+zeichen einlesen : TEXT VAR zeichen; getchar (zeichen) .
+dezimalzeichen : pos (dezimalen, zeichen) > 0 AND nicht separator .
+dezimalstartzeichen : pos (startdezimalen, zeichen) > 0 AND nicht separator .
+dezimalen : "0123456789" .
+startdezimalen : "+-0123456789" .
+nicht separator : pos (separator, zeichen) = 0 .
+
+ueberschreibbar :
+ dezimalanfang > LENGTH satz OR
+ pos (ueberschreibbare zeichen, satz SUB dezimalanfang) > 0 .
+
+ueberschreibbare zeichen : " ,.+-0123456789" .
+
+dezimalen schreiben :
+ REP
+ dezimale in satz eintragen;
+ dezimalen zeigen;
+ zeichen einlesen;
+ dezimalanfang DECR 1
+ UNTIL dezimaleditor beendet PER;
+ stelle INCR 1 .
+
+dezimale in satz eintragen :
+ IF dezimalanfang > LENGTH satz
+ THEN satz AUFFUELLENMIT blank; satz CAT zeichen
+ ELSE delete char (satz, dezimalanfang); insert char (satz, zeichen, stelle)
+ FI .
+
+dezimalen zeigen :
+ INT VAR min dezimalschreibpos := max (min schreibpos, dezimalanfang);
+ IF markiert THEN markiert zeigen ELSE unmarkiert zeigen FI;
+ schreibmarke positionieren (stelle) .
+
+markiert : marke > 0 .
+
+markiert zeigen :
+ invers out (satz, min dezimalschreibpos, stelle, "", end mark);
+ out (zeichen) .
+
+unmarkiert zeigen :
+ schreibmarke positionieren (min dezimalschreibpos);
+ out subtext (satz, min dezimalschreibpos, stelle) .
+
+dezimaleditor beendet :
+ NOT dezimalzeichen OR
+ dezimalanfang < max (min schreibpos, marke) OR
+ NOT ueberschreibbar .
+END PROC dezimaleditor;
+
+BOOL PROC is editget :
+ editget modus
+END PROC is editget ;
+
+PROC get editline (TEXT VAR editline, INT VAR editpos, editmarke) :
+ IF editget modus
+ THEN editline := alter editsatz;
+ editpos := stelle
+ FI ;
+ editmarke := marke
+END PROC get editline;
+
+PROC put editline (TEXT CONST editline, INT CONST editpos, editmarke) :
+ IF editget modus
+ THEN alter editsatz := editline;
+ stelle := max (editpos, 1);
+ marke := max (editmarke, 0)
+ FI
+END PROC put editline;
+
+BOOL PROC within kanji (TEXT CONST satz, INT CONST stelle) :
+ count directly prefixing kanji esc bytes;
+ number of kanji esc bytes is odd .
+
+count directly prefixing kanji esc bytes :
+ INT VAR pos := stelle - 1, kanji esc bytes := 0;
+ WHILE pos > 0 CAND is kanji esc (satz SUB pos) REP
+ kanji esc bytes INCR 1; pos DECR 1
+ PER .
+
+number of kanji esc bytes is odd :
+ (kanji esc bytes AND 1) <> 0 .
+END PROC within kanji;
+
+BOOL PROC is kanji esc (TEXT CONST char) : (*sh*)
+ two byte mode CAND
+ (char >= ""129"" AND char <= ""159"" OR char >= ""224"" AND char <= ""239"")
+END PROC is kanji esc;
+
+BOOL PROC two bytes : two byte mode END PROC two bytes;
+
+PROC two bytes (BOOL CONST new mode) :
+ two byte mode := new mode
+END PROC two bytes;
+
+PROC outtext (TEXT CONST source, INT CONST from, to) :
+ out subtext mit randbehandlung (source, from, to);
+ INT VAR trailing;
+ IF from <= LENGTH source
+ THEN trailing := to - LENGTH source
+ ELSE trailing := to - from + 1
+ FI ; trailing TIMESOUT blank
+END PROC outtext;
+
+PROC out subtext mit randbehandlung (TEXT CONST satz, INT CONST von, bis) :
+ IF von > bis
+ THEN
+ ELIF bis >= LENGTH satz COR NOT within kanji (satz, bis + 1)
+ THEN out subtext mit anfangsbehandlung (satz, von, bis)
+ ELSE out subtext mit anfangsbehandlung (satz, von, bis - 1); out (blank)
+ FI
+END PROC out subtext mit randbehandlung;
+
+PROC out subtext mit anfangsbehandlung (TEXT CONST satz, INT CONST von, bis) :
+ IF von > bis
+ THEN
+ ELIF von = 1 COR NOT within kanji (satz, von)
+ THEN out subtext (satz, von, bis)
+ ELSE out (blank); out subtext (satz, von + 1, bis)
+ FI
+END PROC out subtext mit anfangsbehandlung;
+
+PROC get cursor : get cursor (spalte, zeile) END PROC get cursor;
+
+INT PROC x cursor : get cursor; spalte END PROC x cursor;
+
+BOOL PROC write permission : write access END PROC write permission;
+
+PROC push (TEXT CONST ausfuehrkommando) :
+ IF ausfuehrkommando = "" (*sh*)
+ THEN
+ ELIF kommando = ""
+ THEN kommando := ausfuehrkommando
+ ELIF (kommando SUB kommando zeiger - 1) = ausfuehrkommando
+ THEN kommando zeiger DECR 1
+ ELIF replace moeglich
+ THEN kommando zeiger DECR laenge des ausfuehrkommandos;
+ replace (kommando, kommando zeiger, ausfuehrkommando)
+ ELSE insert char (kommando, ausfuehrkommando, kommando zeiger)
+ FI .
+
+replace moeglich :
+ INT CONST laenge des ausfuehrkommandos := LENGTH ausfuehrkommando;
+ kommando zeiger > laenge des ausfuehrkommandos .
+END PROC push;
+
+PROC type (TEXT CONST ausfuehrkommando) :
+ kommando CAT ausfuehrkommando
+END PROC type;
+
+INT PROC stelle am anfang : anfang + verschoben END PROC stelle am anfang;
+
+INT PROC stelle am ende : stelle am anfang+laenge-1 END PROC stelle am ende;
+
+INT PROC markierausgleich : SIGN marke * marklength END PROC markierausgleich;
+
+PROC verschieben wenn erforderlich :
+ IF stelle > max schreibpos
+ THEN verschiebe (stelle - max schreibpos)
+ ELIF stelle < min schreibpos
+ THEN verschiebe (stelle - min schreibpos)
+ FI
+END PROC verschieben wenn erforderlich;
+
+PROC verschiebe (INT CONST i) :
+ verschoben INCR i;
+ min schreibpos INCR i;
+ max schreibpos INCR i;
+ cpos DECR i;
+ output mode := out feld;
+ schreibmarke positionieren (stelle) (* 11.05.85 -ws- *)
+END PROC verschiebe;
+
+PROC konstanten neu berechnen :
+ min schreibpos := anfang + verschoben;
+ IF min schreibpos < 0 (* 17.05.85 -ws- *)
+ THEN min schreibpos DECR verschoben; verschoben := 0
+ FI ;
+ max schreibpos := min schreibpos + laenge - 1 - markierausgleich;
+ cpos := rand + laenge - max schreibpos
+END PROC konstanten neu berechnen;
+
+PROC schreibmarke positionieren (INT CONST sstelle) :
+ cursor (cpos + sstelle, zeile)
+END PROC schreibmarke positionieren;
+
+PROC simple feldout (TEXT CONST satz, INT CONST dummy) :
+ (* PRECONDITION : NOT markiert AND verschoben = 0 *)
+ (* AND feldrest schon geloescht *)
+ schreibmarke an feldanfang positionieren;
+ out subtext mit randbehandlung (satz, anfang, anfang + laenge - 1);
+ IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI .
+
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+END PROC simple feldout;
+
+PROC feldout (TEXT CONST satz, INT CONST sstelle) :
+ schreibmarke an feldanfang positionieren;
+ feld ausgeben;
+ feldrest loeschen;
+ IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben (TRUE) FI .
+
+schreibmarke an feldanfang positionieren : cursor (rand + 1, zeile) .
+
+feld ausgeben :
+ INT VAR von := anfang + verschoben, bis := von + laenge - 1;
+ IF nicht markiert
+ THEN unmarkiert ausgeben
+ ELIF markiertes nicht sichtbar
+ THEN unmarkiert ausgeben
+ ELSE markiert ausgeben
+ FI .
+
+nicht markiert : marke <= 0 .
+
+markiertes nicht sichtbar :
+ bis DECR marklength * (1 + SIGN sstelle); marke > bis + 1 .
+
+unmarkiert ausgeben :
+ out subtext mit randbehandlung (satz, von, bis) .
+
+markiert ausgeben :
+ INT VAR smarke := max (von, marke);
+ out text (satz, von, smarke - 1); out (begin mark);
+ verschiedene feldout modes behandeln .
+
+verschiedene feldout modes behandeln :
+ IF sstelle = 0
+ THEN out subtext mit randbehandlung (satz, smarke, bis); out (end mark)
+ ELSE out text (satz, smarke, zeilenrand); out (end mark); (*sh*)
+ out subtext mit randbehandlung (satz, sstelle, bis)
+ FI .
+
+zeilenrand : min (bis, sstelle - 1) .
+END PROC feldout;
+
+PROC absatzmarke schreiben (BOOL CONST schreiben) :
+ IF fliesstext AND nicht markiert
+ THEN cursor (rand + 1 + laenge, zeile);
+ out (absatzmarke) ;
+ absatzmarke steht := TRUE
+ FI .
+
+nicht markiert : marke <= 0 .
+
+absatzmarke :
+ IF NOT schreiben
+ THEN " "
+ ELIF marklength > 0
+ THEN ""15""14""
+ ELSE ""15" "14" "
+ FI .
+END PROC absatzmarke schreiben;
+
+PROC invers out (TEXT CONST satz, INT CONST von, bis, TEXT CONST pre, post) :
+ IF mark refresh line mode
+ THEN feldout (satz, stelle)
+ ELSE schreibmarke positionieren (von);
+ out (begin mark); markleft; out (pre);
+ out text (satz, von, bis - 1); out (post)
+ FI .
+
+markleft :
+ marklength TIMESOUT left .
+
+END PROC invers out;
+
+PROC feldrest loeschen :
+ IF rand + laenge < maxbreite COR invertierte darstellung
+ THEN INT VAR x; get cursor (x, zeile);
+ (rand + laenge - x + 1 + absatz ausgleich) TIMESOUT blank; (*sh*)
+ cursor (x, zeile)
+ ELSE out (clear eol); absatzmarke steht := FALSE
+ FI
+END PROC feldrest loeschen;
+
+OP AUFFUELLENMIT (TEXT VAR satz, TEXT CONST fuellzeichen) :
+ INT VAR i;
+ FOR i FROM stelle - LENGTH satz DOWNTO 2 REP
+ satz CAT fuellzeichen
+ PER
+END OP AUFFUELLENMIT;
+
+INT PROC einrueckposition (TEXT CONST satz) : (*sh*)
+ IF fliesstext AND satz = blank
+ THEN anfang
+ ELSE max (pos (satz, ""33"", ""254"", 1), 1)
+ FI
+END PROC einrueckposition;
+
+INT PROC letzter wortanfang (TEXT CONST satz) : (*sh*)
+ INT CONST ganz links := max (1, marke);
+ BOOL VAR noch nicht im neuen wort := TRUE;
+ INT VAR i;
+ FOR i FROM stelle DOWNTO ganz links REP
+ IF noch nicht im neuen wort
+ THEN noch nicht im neuen wort := char = blank
+ ELIF is kanji esc (char)
+ THEN LEAVE letzter wortanfang WITH i
+ ELIF nicht mehr im neuen wort
+ THEN LEAVE letzter wortanfang WITH i + 1
+ FI
+ PER ;
+ ganz links .
+
+char : satz SUB i .
+
+nicht mehr im neuen wort : char = blank COR within kanji (satz, i) .
+END PROC letzter wortanfang;
+
+PROC getchar (TEXT VAR zeichen) :
+ IF kommando = ""
+ THEN inchar (zeichen); IF lernmodus THEN audit CAT zeichen FI
+ ELSE zeichen := kommando SUB kommando zeiger;
+ kommando zeiger INCR 1;
+ IF kommando zeiger > LENGTH kommando
+ THEN kommando zeiger := 1; kommando := ""
+ FI ;
+ IF LENGTH kommando - kommando zeiger < 3
+ THEN kommando CAT inchety
+ FI
+ FI .
+END PROC getchar;
+
+TEXT PROC inchety :
+ IF lernmodus
+ THEN TEXT VAR t := incharety; audit CAT t; t
+ ELSE incharety
+ FI
+END PROC inchety;
+
+BOOL PROC is incharety (TEXT CONST muster) :
+ IF kommando = ""
+ THEN TEXT CONST t := inchety;
+ IF t = muster THEN TRUE ELSE kommando := t; FALSE FI
+ ELIF (kommando SUB kommando zeiger) = muster
+ THEN kommando zeiger INCR 1;
+ IF kommando zeiger > LENGTH kommando
+ THEN kommando zeiger := 1; kommando := ""
+ FI ;
+ TRUE
+ ELSE FALSE
+ FI
+END PROC is incharety;
+
+TEXT PROC getcharety :
+ IF kommando = ""
+ THEN inchety
+ ELSE TEXT CONST t := kommando SUB kommando zeiger;
+ kommando zeiger INCR 1;
+ IF kommando zeiger > LENGTH kommando
+ THEN kommando zeiger := 1; kommando := ""
+ FI ; t
+ FI
+END PROC getcharety;
+
+PROC get editcursor (INT VAR x, y) : (*sh*)
+ IF actual editor > 0 THEN aktualisiere bildparameter FI;
+ x := rand - (anfang + verschoben - 1 - markierausgleich) + stelle;
+ y := zeile .
+
+ aktualisiere bildparameter :
+ INT VAR old x, old y; get cursor (old x, old y);
+ dateizustand holen; bildausgabe steuern; satznr zeigen;
+ fenster zeigen; zeile := bildrand + zeilennr; cursor (old x, old y) .
+END PROC get editcursor;
+
+(************************* Zugriff auf Feldstatus *************************).
+
+stelle : feldstatus.stelle .
+alte stelle : feldstatus.alte stelle .
+rand : feldstatus.rand .
+limit : feldstatus.limit .
+anfang : feldstatus.anfang .
+marke : feldstatus.marke .
+laenge : feldstatus.laenge .
+verschoben : feldstatus.verschoben .
+einfuegen : feldstatus.einfuegen .
+fliesstext : feldstatus.fliesstext .
+write access : feldstatus.write access .
+tabulator : feldstatus.tabulator .
+
+(***************************************************************************)
+
+LET undefinierter bereich = 0, nix = 1,
+ bildzeile = 2, akt satznr = 2,
+ abschnitt = 3, ueberschrift = 3,
+ bild = 4, fehlermeldung = 4;
+
+LET BILDSTATUS = STRUCT (INT feldlaenge, kurze feldlaenge,
+ bildrand, bildlaenge, kurze bildlaenge,
+ ueberschriftbereich, bildbereich,
+ erster neusatz, letzter neusatz,
+ old zeilennr, old lineno, old mark lineno,
+ BOOL zeileneinfuegen, old line update,
+ TEXT satznr pre, ueberschrift pre,
+ ueberschrift text, ueberschrift post, old satz,
+ FRANGE old range,
+ FILE file),
+ EDITSTATUS = STRUCT (FELDSTATUS feldstatus, BILDSTATUS bildstatus),
+ max editor = 10,
+ EDITSTACK = ROW max editor EDITSTATUS;
+
+BILDSTATUS VAR bildstatus ;
+EDITSTACK VAR editstack;
+
+ROW max editor INT VAR einrueckstack;
+
+BOOL VAR markiert;
+TEXT VAR filename, tab, bildsatz, bildzeichen, fehlertext,
+ akt bildsatz ;
+INT VAR zeilennr, satznr, bildanfang, bildmarke, feldmarke,
+ actual editor := 0, max used editor := 0,
+ letzer editor auf dieser datei,
+ alte einrueckposition := 1;
+
+INT PROC aktueller editor : actual editor END PROC aktueller editor;
+
+INT PROC groesster editor : max used editor END PROC groesster editor;
+
+(****************************** bildeditor *******************************)
+
+PROC bildeditor (TEXT CONST res, PROC (TEXT CONST) kommando interpreter) :
+ evtl fehler behandeln;
+ enable stop;
+ TEXT VAR reservierte tasten := ""11""12""27"bf" ;
+ reservierte tasten CAT res ;
+ INT CONST my highest editor := max used editor;
+ laenge := feldlaenge;
+ konstanten neu berechnen;
+ REP
+ markierung justieren;
+ altes feld nachbereiten;
+ feldlaenge einstellen;
+ ueberschrift zeigen;
+ fenster zeigen ;
+ zeile bereitstellen;
+ zeile editieren;
+ kommando ausfuehren
+ PER .
+
+evtl fehler behandeln :
+ IF is error
+ THEN fehlertext := errormessage;
+ IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+ clear error
+ ELSE fehlertext := ""
+ FI .
+
+markierung justieren :
+ IF bildmarke > 0
+ THEN IF satznr <= bildmarke
+ THEN bildmarke := satznr;
+ stelle := max (stelle, feldmarke);
+ marke := feldmarke
+ ELSE marke := 1
+ FI
+ FI .
+
+zeile bereitstellen : IF hinter letztem satz THEN insert record (file) FI .
+hinter letztem satz : lineno (file) > lines (file) .
+
+altes feld nachbereiten :
+ IF old line update AND lineno (file) <> old lineno
+ THEN IF verschoben <> 0
+ THEN verschoben := 0; konstanten neu berechnen;
+ FI ;
+ INT CONST alte zeilennr := old lineno - bildanfang + 1;
+ IF alte zeilennr > 0 AND alte zeilennr <= aktuelle bildlaenge
+ THEN INT CONST m := marke;
+ IF lineno (file) < old lineno
+ THEN marke := 0
+ ELIF old lineno = bildmarke
+ THEN marke := min (feldmarke, LENGTH old satz + 1)
+ ELSE marke := min (marke, LENGTH old satz + 1)
+ FI ;
+ zeile := bildrand + alte zeilennr;
+ feldout (old satz, 0); marke := m
+ FI
+ FI ;
+ old line update := FALSE; old satz := "" .
+
+feldlaenge einstellen :
+ INT CONST alte laenge := laenge;
+ IF zeilennr > kurze bildlaenge
+ THEN laenge := kurze feldlaenge
+ ELSE laenge := feldlaenge
+ FI ;
+ IF laenge <> alte laenge
+ THEN konstanten neu berechnen
+ FI .
+
+zeile editieren :
+ zeile := bildrand + zeilennr;
+ exec (PROC (TEXT VAR, TEXT CONST) feldeditor, file, reservierte tasten);
+ old lineno := satznr;
+ IF markiert oder verschoben
+ THEN old line update := TRUE; read record (file, old satz)
+ FI .
+
+markiert oder verschoben : markiert COR verschoben <> 0 .
+
+kommando ausfuehren :
+ getchar (bildzeichen);
+ SELECT pos (kommandos, bildzeichen) OF
+ CASE x hop : hop kommando verarbeiten
+ CASE x esc : esc kommando verarbeiten
+ CASE x up : zum vorigen satz
+ CASE x down : zum folgenden satz
+ CASE x rubin : zeicheneinfuegen umschalten
+ CASE x mark : markierung umschalten
+ CASE x cr : eingerueckt mit cr (* 08.06.85 -ws- *)
+ CASE x inscr : eingerueckt zum folgenden satz
+ CASE x abscr : zum anfang des folgenden satzes
+ END SELECT .
+
+kommandos :
+ LET x hop = 1, x up = 2,
+ x down = 3, x rubin = 4,
+ x cr = 5, x mark = 6,
+ x abscr = 7, x inscr = 8,
+ x esc = 9;
+
+ ""1""3""10""11""13""16""17""18""27"" .
+
+zeicheneinfuegen umschalten :
+ rubin segment in ueberschrift eintragen;
+ neu (ueberschrift, nix) .
+
+rubin segment in ueberschrift eintragen :
+ replace (ueberschrift text, 9, rubin segment) .
+
+rubin segment :
+ IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+hop kommando verarbeiten :
+ getchar (bildzeichen);
+ read record (file, bildsatz);
+ SELECT pos (hop kommandos, bildzeichen) OF
+ CASE y hop : nach oben
+ CASE y cr : neue seite
+ CASE y up : zurueckblaettern
+ CASE y down : weiterblaettern
+ CASE y tab : put tabs (file, tabulator); neu (ueberschrift, nix)
+ CASE y rubout : zeile loeschen
+ CASE y rubin : zeileneinfuegen umschalten
+ END SELECT .
+
+hop kommandos :
+ LET y hop = 1, y up = 2,
+ y tab = 3, y down = 4,
+ y rubin = 5, y rubout = 6,
+ y cr = 7;
+
+ ""1""3""9""10""11""12""13"" .
+
+zeileneinfuegen umschalten :
+ zeileneinfuegen := NOT zeileneinfuegen;
+ IF zeileneinfuegen
+ THEN zeile aufspalten; logisches eof setzen
+ ELSE leere zeile am ende loeschen; logisches eof loeschen
+ FI ; restbild zeigen .
+
+zeile aufspalten :
+ IF stelle <= LENGTH bildsatz OR stelle = 1
+ THEN loesche ggf trennende blanks und spalte zeile
+ FI .
+
+loesche ggf trennende blanks und spalte zeile: (* 26.06.84 -bk- *)
+ INT VAR first non blank pos := stelle;
+ WHILE first non blank pos <= length (bildsatz) CAND
+ (bildsatz SUB first non blank pos) = blank REP
+ first non blank pos INCR 1
+ PER ;
+ split line and indentation; (*sh*)
+ first non blank pos := stelle - 1;
+ WHILE first non blank pos >= 1 CAND
+ (bildsatz SUB first non blank pos) = blank REP
+ first non blank pos DECR 1
+ PER;
+ bildsatz := subtext (bildsatz, 1, first non blank pos);
+ write record (file, bildsatz) .
+
+split line and indentation :
+ split line (file, first non blank pos, TRUE) .
+
+logisches eof setzen :
+ down (file); col (file, 1);
+ set range (file, 1, 1, old range); up (file) .
+
+leere zeile am ende loeschen :
+ to line (file, lines (file));
+ IF len (file) = 0 THEN delete record (file) FI;
+ to line (file, satznr) .
+
+logisches eof loeschen :
+ col (file, stelle); set range (file, old range) .
+
+restbild zeigen :
+ erster neusatz := satznr;
+ letzter neusatz := bildanfang + bildlaenge - 1;
+ rest segment in ueberschrift eintragen;
+ neu (ueberschrift, abschnitt) .
+
+rest segment in ueberschrift eintragen :
+ replace (ueberschrift text, feldlaenge - 25, rest segment) .
+
+rest segment :
+ IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+esc kommando verarbeiten :
+ getchar (bildzeichen);
+ eventuell zeichen zurueckweisen; (* 04.05.85 -ws- *)
+ IF taste ist reserviert
+ THEN belegte taste ausfuehren
+ ELSE fest vordefinierte esc funktion
+ FI ; ende nach quit .
+
+eventuell zeichen zurueckweisen : (* 04.05.85 -ws- *)
+ IF NOT write access CAND NOT erlaubte taste
+ THEN benutzer warnen; LEAVE kommando ausfuehren
+ FI .
+
+erlaubte taste : pos (zulaessige zeichen, bildzeichen) > 0 .
+zulaessige zeichen : res + ""1""2""8""27"bfq" .
+benutzer warnen : out (piep) .
+
+ende nach quit :
+ IF max used editor < my highest editor THEN LEAVE bildeditor FI .
+
+taste ist reserviert : pos (res, bildzeichen) > 0 .
+
+fest vordefinierte esc funktion :
+ read record (file, bildsatz);
+ SELECT pos (esc kommandos, bildzeichen) OF
+ CASE z hop : lernmodus umschalten
+ CASE z esc : kommandodialog versuchen
+ CASE z left : zum vorigen wort
+ CASE z right : zum naechsten wort
+ CASE z b : bild an aktuelle zeile angleichen
+ CASE z f : belegte taste ausfuehren
+ CASE z rubout : markiertes vorsichtig loeschen
+ CASE z rubin : vorsichtig geloeschtes einfuegen
+ OTHERWISE : belegte taste ausfuehren
+ END SELECT .
+
+esc kommandos :
+ LET z hop = 1, z right = 2,
+ z left = 3, z rubin = 4,
+ z rubout = 5, z esc = 6,
+ z b = 7, z f = 8;
+
+ ""1""2""8""11""12""27"bf" .
+
+zum vorigen wort :
+ IF vorgaenger erlaubt
+ THEN vorgaenger; read record (file, bildsatz);
+ stelle := LENGTH bildsatz + 1; push (esc + left)
+ FI .
+
+vorgaenger erlaubt :
+ satznr > max (1, bildmarke) .
+
+zum naechsten wort :
+ IF nicht auf letztem satz THEN weitersuchen wenn nicht gefunden FI .
+
+nicht auf letztem satz : line no (file) < lines (file) .
+
+weitersuchen wenn nicht gefunden :
+ nachfolgenden satz holen;
+ IF (nachfolgender satz SUB anfang) = blank
+ THEN push (abscr + esc + right)
+ ELSE push (abscr)
+ FI .
+
+nachfolgenden satz holen :
+ down (file); read record (file, nachfolgender satz); up (file) .
+
+bild an aktuelle zeile angleichen :
+ anfang INCR verschoben; verschoben := 0;
+ margin segment in ueberschrift eintragen;
+ neu (ueberschrift, bild) .
+
+margin segment in ueberschrift eintragen :
+ replace (ueberschrift text, 2, margin segment) .
+
+margin segment :
+ IF anfang <= 1
+ THEN "......"
+ ELSE TEXT VAR margin text := "M" + text (anfang);
+ (6 - LENGTH margin text) * "." + margin text
+ FI .
+
+belegte taste ausfuehren :
+ kommando analysieren (bildzeichen, PROC(TEXT CONST) kommando interpreter) .
+
+kommandodialog versuchen:
+ IF fenster ist zu schmal fuer dialog
+ THEN kommandodialog ablehnen
+ ELSE kommandodialog fuehren
+ FI .
+
+fenster ist zu schmal fuer dialog : laenge < 20 .
+
+kommandodialog ablehnen :
+ fehlertext := "zu schmal fuer ESC ESC"; neu (fehlermeldung, nix) .
+
+kommandodialog fuehren:
+ INT VAR x0, x1, x2, x3, y;
+ get cursor (x0, y);
+ cursor (rand + 1, bildrand + zeilennr);
+ get cursor (x1, y);
+ out (begin mark); out (monitor meldung);
+ get cursor (x2, y);
+ (laenge - LENGTH monitor meldung - marklength) TIMESOUT blank;
+ get cursor (x3, y);
+ out (end mark); out (blank);
+ kommandozeile editieren;
+ ueberschrift zeigen;
+ absatz ausgleich := 2; (*sh*)
+ IF kommandotext = "" THEN LEAVE kommandodialog fuehren FI;
+ kommando auf taste legen ("f", kommandotext);
+ kommando analysieren ("f", PROC(TEXT CONST) kommando interpreter);
+ IF fehlertext <> ""
+ THEN push (esc + esc + esc + "k")
+ ELIF markiert
+ THEN zeile neu
+ FI .
+
+kommandozeile editieren :
+ TEXT VAR kommandotext := "";
+ cursor (x1, y); out (begin mark);
+ disable stop;
+ darstellung invertieren;
+ editget schleife;
+ darstellung invertieren;
+ enable stop;
+ cursor (x3, y); out (end mark);
+ exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+ cursor (x0, y) .
+
+darstellung invertieren :
+ TEXT VAR dummy := begin mark; begin mark := end mark; end mark := dummy;
+ invertierte darstellung := NOT invertierte darstellung .
+
+editget schleife :
+ TEXT VAR exit char;
+ REP
+ cursor (x2, y);
+ editget (kommandotext, max textlength, rand + laenge - x cursor,
+ "", "k?!", exit char);
+ neu (ueberschrift, nix);
+ IF exit char = ""27"k"
+ THEN kommando text := kommando auf taste ("f")
+ ELIF exit char = ""27"?"
+ THEN TEXT VAR taste; getchar (taste);
+ kommando text := kommando auf taste (taste)
+ ELIF exit char = ""27"!"
+ THEN getchar (taste);
+ IF ist reservierte taste
+ THEN set busy indicator; (*sh*)
+ out ("FEHLER: """ + taste + """ ist reserviert"7"")
+ ELSE kommando auf taste legen (taste, kommandotext);
+ kommandotext := ""; LEAVE editget schleife
+ FI
+ ELSE LEAVE editget schleife
+ FI
+ PER .
+
+ist reservierte taste : pos (res, taste) > 0 .
+monitor meldung : "gib kommando : " .
+
+neue seite : bildanfang := satznr; zeilennr := 1; neu (akt satznr, bild) .
+
+weiterblaettern :
+ INT CONST akt bildlaenge := aktuelle bildlaenge;
+ IF nicht auf letztem satz
+ THEN erster neusatz := satznr;
+ IF zeilennr >= akt bildlaenge
+ THEN bildanfang INCR akt bildlaenge; neu (akt satznr, bild)
+ FI ;
+ satznr := min (lines (file), bildanfang + akt bildlaenge - 1);
+ letzter neusatz := satznr;
+ toline (file, satznr);
+ stelle DECR verschoben;
+ neu (akt satznr, nix);
+ zeilennr := satznr - bildanfang + 1;
+ IF markiert THEN neu (nix, abschnitt) FI;
+ einrueckposition bestimmen
+ FI .
+
+zurueckblaettern :
+ IF vorgaenger erlaubt
+ THEN IF zeilennr <= 1
+ THEN bildanfang := max (1, bildanfang - aktuelle bildlaenge);
+ neu (akt satznr, bild)
+ FI ;
+ nach oben; einrueckposition bestimmen
+ FI .
+
+zeile loeschen :
+ IF stelle = 1
+ THEN delete record (file);
+ erster neusatz := satznr;
+ letzter neusatz := bildanfang + bildlaenge - 1;
+ neu (nix, abschnitt)
+ ELSE zeilen rekombinieren
+ FI .
+
+zeilen rekombinieren :
+ IF nicht auf letztem satz
+ THEN aktuellen satz mit blanks auffuellen;
+ delete record (file);
+ nachfolgenden satz lesen;
+ bildsatz CAT nachfolgender satz ohne fuehrende blanks;
+ write record (file, bildsatz);
+ erster neusatz := satznr;
+ letzter neusatz := bildanfang + bildlaenge - 1;
+ neu (nix, abschnitt)
+ FI .
+
+aktuellen satz mit blanks auffuellen :
+ bildsatz AUFFUELLENMIT blank .
+
+nachfolgenden satz lesen :
+ TEXT VAR nachfolgender satz;
+ read record (file, nachfolgender satz) .
+
+nachfolgender satz ohne fuehrende blanks :
+ satzrest := subtext (nachfolgender satz,
+ einrueckposition (nachfolgender satz)); satzrest .
+
+zeile aufsplitten :
+ nachfolgender satz := "";
+ INT VAR i;
+ FOR i FROM 2 UPTO min (stelle, einrueckposition (bildsatz)) REP
+ nachfolgender satz CAT blank
+ PER;
+ satzrest := subtext (bildsatz, naechste non blank position);
+ nachfolgender satz CAT satzrest;
+ bildsatz := subtext (bildsatz, 1, stelle - 1);
+ write record (file, bildsatz);
+ down (file); insert record (file);
+ write record (file, nachfolgender satz); up (file) .
+
+naechste non blank position :
+ INT VAR non blank pos := stelle;
+ WHILE (bildsatz SUB non blank pos) = blank REP
+ non blank pos INCR 1
+ PER; non blank pos .
+
+zum vorigen satz :
+ IF vorgaenger erlaubt THEN vorgaenger; einrueckposition bestimmen FI .
+
+zum folgenden satz : (* 12.09.85 -ws- *)
+ IF nachfolger erlaubt THEN nachfolger; einrueckposition bestimmen
+ ELSE col (file, len (file) + 1); neu (nix, nix)
+ FI .
+
+einrueckposition bestimmen : (* 27.08.85 -ws- *)
+ read record (file, akt bildsatz);
+ INT VAR neue einrueckposition := einrueckposition (akt bildsatz);
+ IF akt bildsatz ist leerzeile
+ THEN alte einrueckposition := max (stelle, neue einrueckposition)
+ ELSE alte einrueckposition := min (stelle, neue einrueckposition)
+ FI .
+
+akt bildsatz ist leerzeile :
+ akt bildsatz = "" OR akt bildsatz = blank .
+
+zum anfang des folgenden satzes :
+ IF nachfolger erlaubt THEN nachfolger; stelle := anfang FI .
+
+nachfolger erlaubt :
+ write access COR nicht auf letztem satz .
+
+eingerueckt mit cr :
+ IF NOT nachfolger erlaubt THEN LEAVE eingerueckt mit cr FI; (*sh*)
+ read record (file, bildsatz);
+ INT VAR epos := einrueckposition (bildsatz);
+ nachfolger; col (file, 1);
+ IF eof (file)
+ THEN IF LENGTH bildsatz <= epos
+ THEN stelle := alte einrueckposition
+ ELSE stelle := epos
+ FI
+ ELSE read record (file, bildsatz);
+ stelle := einrueckposition (bildsatz);
+ IF bildsatz ist leerzeile (* 29.08.85 -ws- *)
+ THEN stelle := alte einrueckposition;
+ aktuellen satz mit blanks auffuellen
+ FI
+ FI ;
+ alte einrueckposition := stelle .
+
+bildsatz ist leerzeile :
+ bildsatz = "" OR bildsatz = blank .
+
+eingerueckt zum folgenden satz : (*sh*)
+ IF NOT nachfolger erlaubt OR NOT write access
+ THEN LEAVE eingerueckt zum folgenden satz
+ FI;
+ alte einrueckposition merken;
+ naechsten satz holen;
+ neue einrueckposition bestimmen;
+ alte einrueckposition := stelle .
+
+alte einrueckposition merken :
+ read record (file, bildsatz);
+ epos := einrueckposition (bildsatz);
+ auf aufzaehlung pruefen;
+ IF epos > LENGTH bildsatz THEN epos := anfang FI.
+
+auf aufzaehlung pruefen :
+ BOOL CONST aufzaehlung gefunden :=
+ ist aufzaehlung CAND vorher absatzzeile CAND wort folgt;
+ IF aufzaehlung gefunden THEN epos := anfang des naechsten wortes FI .
+
+ist aufzaehlung :
+ INT CONST wortende := pos (bildsatz, blank, epos, epos + 20) - 1;
+ SELECT pos ("-*).:" , bildsatz SUB wortende) OF
+ CASE 1,2 : wortende = epos
+ CASE 3,4 : wortende <= epos + 7
+ CASE 5 : TRUE
+ OTHERWISE: FALSE
+ ENDSELECT .
+
+vorher absatzzeile :
+ IF satznr = 1
+ THEN TRUE
+ ELSE up (file);
+ INT CONST vorige satzlaenge := len (file);
+ BOOL CONST vorher war absatzzeile :=
+ subtext (file, vorige satzlaenge, vorige satzlaenge) = blank;
+ down (file); vorher war absatzzeile
+ FI .
+
+wort folgt :
+ INT CONST anfang des naechsten wortes :=
+ pos (bildsatz, ""33"", ""254"", wortende + 1);
+ anfang des naechsten wortes > wortende .
+
+naechsten satz holen :
+ nachfolger; col (file, 1);
+ IF eof (file)
+ THEN bildsatz := ""
+ ELSE IF neue zeile einfuegen erforderlich
+ THEN insert record (file); bildsatz := "";
+ letzter neusatz := bildanfang + bildlaenge - 1
+ ELSE read record (file, bildsatz);
+ letzter neusatz := satznr;
+ ggf trennungen zurueckwandeln und umbruch indikator einfuegen
+ FI ;
+ erster neusatz := satznr;
+ neu (nix, abschnitt)
+ FI .
+
+neue zeile einfuegen erforderlich :
+ BOOL CONST war absatz := war absatzzeile;
+ war absatz COR neuer satz ist zu lang .
+
+war absatzzeile :
+ INT VAR wl := pos (kommando, up backcr, kommando zeiger);
+ wl = 0 COR (kommando SUB (wl - 1)) = blank .
+
+neuer satz ist zu lang : laenge des neuen satzes >= limit .
+
+laenge des neuen satzes :
+ IF len (file) > 0
+ THEN len (file) + wl
+ ELSE wl + epos
+ FI .
+
+up backcr : ""3""20"" .
+
+ggf trennungen zurueckwandeln und umbruch indikator einfuegen :
+ LET trenn k = ""220"",
+ trenn strich = ""221"";
+ TEXT VAR umbruch indikator;
+ IF letztes zeichen ist trenn strich
+ THEN entferne trenn strich;
+ IF letztes zeichen = trenn k
+ THEN wandle trenn k um
+ FI ;
+ umbruch indikator := up backcr
+ ELIF letztes umgebrochenes zeichen ist kanji
+ THEN umbruch indikator := up backcr
+ ELSE umbruch indikator := blank + up backcr
+ FI ;
+ change (kommando, wl, wl+1, umbruch indikator) .
+
+letztes umgebrochenes zeichen ist kanji : within kanji (kommando, wl-1) .
+
+letztes zeichen ist trenn strich :
+ TEXT CONST last char := letztes zeichen;
+ last char = trenn strich COR
+ last char = "-" CAND wl > 2 CAND (kommando SUB (wl-2)) <> blank .
+
+letztes zeichen : kommando SUB (wl-1) .
+entferne trenn strich : delete char (kommando, wl-1); wl DECR 1 .
+wandle trenn k um : replace (kommando, wl-1, "c") .
+loesche indikator : delete char (kommando, wl) .
+
+neue einrueckposition bestimmen :
+ IF aufzaehlung gefunden CAND bildsatz ist leerzeile
+ THEN stelle := epos
+ ELIF NOT bildsatz ist leerzeile
+ THEN stelle := einrueckposition (bildsatz)
+ ELIF war absatz COR auf letztem satz
+ THEN stelle := epos
+ ELSE down (file); read record (file, nachfolgender satz);
+ up (file); stelle := einrueckposition (nachfolgender satz)
+ FI ;
+ IF ist einfuegender aber nicht induzierter umbruch
+ THEN loesche indikator;
+ umbruchstelle := stelle + wl - kommando zeiger - anzahl der stz;
+ umbruchverschoben := 0
+ FI .
+
+auf letztem satz : NOT nicht auf letztem satz .
+
+ist einfuegender aber nicht induzierter umbruch :
+ wl := pos (kommando, backcr, kommando zeiger);
+ wl > 0 CAND (kommando SUB (wl - 1)) <> up char .
+
+anzahl der stz :
+ TEXT CONST umgebrochener anfang := subtext (kommando, kommando zeiger, wl-1);
+ INT VAR anz := 0, anf := pos (umgebrochener anfang, ""1"", ""31"", 1);
+ WHILE anf > 0 REP
+ anz INCR 1; anf := pos (umgebrochener anfang, ""1"", ""31"", anf + 1)
+ PER; anz .
+
+markiertes vorsichtig loeschen :
+ IF write access CAND markiert
+ THEN clear removed (file);
+ IF nur im satz markiert
+ THEN behandle einen satz
+ ELSE behandle mehrere saetze
+ FI
+ FI .
+
+nur im satz markiert : line no (file) = bildmarke .
+
+behandle einen satz :
+ insert record (file);
+ satzrest := subtext (bildsatz, marke, stelle - 1);
+ write record (file, satzrest);
+ remove (file, 1);
+ change (bildsatz, marke, stelle - 1, "");
+ stelle := marke;
+ marke := 0; bildmarke := 0; feldmarke := 0;
+ markiert := FALSE; mark (file, 0, 0);
+ konstanten neu berechnen;
+ IF bildsatz = ""
+ THEN delete record (file);
+ erster neusatz := satznr;
+ letzter neusatz := bildanfang + bildlaenge - 1;
+ neu (nix, abschnitt)
+ ELSE write record (file, bildsatz);
+ neu (nix, bildzeile)
+ FI .
+
+behandle mehrere saetze :
+ erster neusatz := bildmarke;
+ letzter neusatz := bildanfang + bildlaenge - 1;
+ zeile an aktueller stelle auftrennen;
+ ersten markierten satz an markieranfang aufspalten;
+ markierten bereich entfernen;
+ bild anpassen .
+
+zeile an aktueller stelle auftrennen :
+ INT VAR markierte saetze := line no (file) - bildmarke + 1;
+ IF nicht am ende der zeile
+ THEN IF nicht am anfang der zeile
+ THEN zeile aufsplitten
+ ELSE up (file); markierte saetze DECR 1
+ FI
+ FI .
+
+nicht am anfang der zeile : stelle > 1 .
+nicht am ende der zeile : stelle <= LENGTH bildsatz .
+
+ersten markierten satz an markieranfang aufspalten :
+ to line (file, line no (file) - (markierte saetze - 1));
+ read record (file, bildsatz);
+ stelle := feldmarke;
+ IF nicht am anfang der zeile
+ THEN IF nicht am ende der zeile
+ THEN zeile aufsplitten
+ ELSE markierte saetze DECR 1
+ FI ;
+ to line (file, line no (file) + markierte saetze)
+ ELSE to line (file, line no (file) + markierte saetze - 1)
+ FI ;
+ read record (file, bildsatz) .
+
+markierten bereich entfernen :
+ zeilen nr := line no (file) - markierte saetze - bildanfang + 2;
+ remove (file, markierte saetze);
+ marke := 0; bildmarke := 0; feldmarke := 0;
+ markiert := FALSE; mark (file, 0, 0);
+ konstanten neu berechnen;
+ stelle := 1 .
+
+bild anpassen :
+ satz nr := line no (file);
+ IF zeilen nr <= 1
+ THEN bildanfang := line no (file); zeilen nr := 1;
+ neu (akt satznr, bild)
+ ELSE neu (akt satznr, abschnitt)
+ FI .
+
+vorsichtig geloeschtes einfuegen :
+ IF NOT write access OR removed lines (file) = 0
+ THEN LEAVE vorsichtig geloeschtes einfuegen
+ FI ;
+ IF nur ein satz
+ THEN in aktuellen satz einfuegen
+ ELSE aktuellen satz aufbrechen und einfuegen
+ FI .
+
+nur ein satz : removed lines (file) = 1 .
+
+in aktuellen satz einfuegen :
+ reinsert (file);
+ read record (file, nachfolgender satz);
+ delete record (file);
+ TEXT VAR t := bildsatz;
+ bildsatz := subtext (t, 1, stelle - 1);
+ aktuellen satz mit blanks auffuellen; (*sh*)
+ bildsatz CAT nachfolgender satz;
+ satzrest := subtext (t, stelle);
+ bildsatz CAT satzrest;
+ write record (file, bildsatz);
+ stelle INCR LENGTH nachfolgender satz;
+ neu (nix, bildzeile) .
+
+aktuellen satz aufbrechen und einfuegen :
+ INT CONST alter bildanfang := bildanfang;
+ old lineno := satznr;
+ IF stelle = 1
+ THEN reinsert (file);
+ read record (file, bildsatz)
+ ELIF stelle > LENGTH bildsatz
+ THEN down (file);
+ reinsert (file);
+ read record (file, bildsatz)
+ ELSE INT VAR von := stelle;
+ WHILE (bildsatz SUB von) = blank REP von INCR 1 PER;
+ satzrest := subtext (bildsatz, von, LENGTH bildsatz);
+ INT VAR bis := stelle - 1;
+ WHILE (bildsatz SUB bis) = blank REP bis DECR 1 PER;
+ bildsatz := subtext (bildsatz, 1, bis);
+ write record (file, bildsatz);
+ down (file);
+ reinsert (file);
+ read record (file, bildsatz);
+ nachfolgender satz := einrueckposition (bildsatz) * blank;
+ nachfolgender satz CAT satzrest;
+ down (file); insert record (file);
+ write record (file, nachfolgender satz); up (file)
+ FI ;
+ stelle := max (1, LENGTH bildsatz); (* 22.06.84 -bk- *)
+ satz nr := line no (file);
+ zeilennr INCR satznr - old lineno;
+ zeilennr := min (zeilennr, aktuelle bildlaenge);
+ bildanfang := satznr - zeilennr + 1;
+ IF bildanfang veraendert
+ THEN abschnitt neu (bildanfang, 9999)
+ ELSE abschnitt neu (old lineno, 9999)
+ FI ;
+ neu (akt satznr, nix).
+
+bildanfang veraendert : bildanfang <> alter bildanfang .
+
+lernmodus umschalten :
+ learn segment in ueberschrift eintragen; neu (ueberschrift, nix) .
+
+learn segment in ueberschrift eintragen :
+ replace (ueberschrift text, feldlaenge - 19, learn segment) .
+
+learn segment :
+ IF lernmodus THEN "LEARN" ELSE "....." FI .
+
+markierung umschalten :
+ IF markiert THEN markierung ausschalten ELSE markierung einschalten FI .
+
+markierung einschalten :
+ bildmarke := satznr; feldmarke := marke; markiert := TRUE;
+ mark (file, bildmarke, feldmarke);
+ neu (nix, bildzeile) .
+
+markierung ausschalten :
+ erster neusatz := max (bildmarke, bildanfang);
+ letzter neusatz := satznr;
+ bildmarke := 0; feldmarke := 0; markiert := FALSE;
+ mark (file, 0, 0);
+ IF erster neusatz = letzter neusatz
+ THEN neu (nix, bildzeile)
+ ELSE neu (nix, abschnitt)
+ FI .
+END PROC bildeditor;
+
+PROC neu (INT CONST ue bereich, b bereich) :
+ ueberschriftbereich := max (ueberschriftbereich, ue bereich);
+ bildbereich := max (bildbereich, b bereich)
+END PROC neu;
+
+
+PROC nach oben :
+ letzter neusatz := satznr;
+ satznr := max (bildanfang, bildmarke);
+ toline (file, satznr);
+ stelle DECR verschoben;
+ zeilennr := satznr - bildanfang + 1;
+ erster neusatz := satznr;
+ IF markiert
+ THEN neu (akt satznr, abschnitt)
+ ELSE neu (akt satznr, nix)
+ FI
+END PROC nach oben;
+
+INT PROC aktuelle bildlaenge :
+ IF stelle - stelle am anfang < kurze feldlaenge
+ AND feldlaenge > 0
+ THEN bildlaenge (*wk*)
+ ELSE kurze bildlaenge
+ FI
+END PROC aktuelle bildlaenge;
+
+PROC vorgaenger :
+ up (file); satznr DECR 1;
+ marke := 0; stelle DECR verschoben;
+ IF zeilennr = 1
+ THEN bildanfang DECR 1; neu (ueberschrift, bild)
+ ELSE zeilennr DECR 1; neu (akt satznr, nix); (*sh*)
+ IF markiert THEN neu (nix, bildzeile) FI
+ FI
+END PROC vorgaenger;
+
+PROC nachfolger :
+ down (file); satznr INCR 1;
+ stelle DECR verschoben;
+ IF zeilennr = aktuelle bildlaenge
+ THEN bildanfang INCR 1;
+ IF rollup erlaubt
+ THEN rollup
+ ELSE neu (ueberschrift, bild)
+ FI
+ ELSE neu (akt satznr, nix); zeilennr INCR 1 (*sh*)
+ FI ;
+ IF markiert THEN neu (nix, bildzeile) FI .
+
+rollup erlaubt :
+ kurze bildlaenge = maxlaenge AND kurze feldlaenge = maxbreite .
+
+rollup :
+ out (down char);
+ IF bildzeichen = inscr
+ THEN neu (ueberschrift, nix)
+ ELIF is cr or down CAND (write access COR nicht auf letztem satz) (*sh*)
+ THEN neu (nix, bildzeile)
+ ELSE neu (ueberschrift, bildzeile)
+ FI .
+
+is cr or down :
+ IF kommando = "" THEN kommando := inchety FI;
+ kommando char = down char COR kommando char = cr .
+
+kommando char : kommando SUB kommando zeiger .
+
+nicht auf letztem satz : line no (file) < lines (file) .
+END PROC nachfolger;
+
+BOOL PROC next incharety is (TEXT CONST muster) :
+ INT CONST klen := LENGTH kommando - kommando zeiger + 1,
+ mlen := LENGTH muster;
+ INT VAR i; FOR i FROM 1 UPTO mlen - klen REP kommando CAT inchety PER;
+ subtext (kommando, kommando zeiger, kommando zeiger + mlen - 1) = muster
+END PROC next incharety is;
+
+PROC quit last: (* 22.06.84 -bk- *)
+ IF actual editor > 0 AND actual editor < max used editor
+ THEN verlasse alle groesseren editoren
+ FI .
+
+verlasse alle groesseren editoren :
+ open editor (actual editor + 1); quit .
+END PROC quit last;
+
+PROC quit :
+ IF actual editor > 0 THEN verlasse aktuellen editor FI .
+
+verlasse aktuellen editor :
+ disable stop;
+ INT CONST aktueller editor := actual editor;
+ in innersten editor gehen;
+ REP
+ IF zeileneinfuegen THEN hop rubin simulieren FI;
+ ggf bildschirmdarstellung korrigieren;
+ innersten editor schliessen
+ UNTIL aktueller editor > max used editor PER;
+ actual editor := max used editor .
+
+in innersten editor gehen : open editor (max used editor) .
+
+hop rubin simulieren :
+ zeileneinfuegen := FALSE;
+ leere zeilen am dateiende loeschen; (*sh*)
+ ggf bildschirmdarstellung korrigieren;
+ logisches eof loeschen .
+
+innersten editor schliessen :
+ max used editor DECR 1;
+ IF max used editor > 0
+ THEN open editor (max used editor);
+ bildeinschraenkung aufheben
+ FI .
+
+logisches eof loeschen :
+ col (file, stelle); set range (file, old range) .
+
+leere zeilen am dateiende loeschen : (* 15.08.85 -ws- *)
+ satz nr := line no (file) ;
+ to line (file, lines (file)) ;
+ WHILE lines (file) > 1 AND bildsatz ist leerzeile REP
+ delete record (file);
+ to line (file, lines (file))
+ PER;
+ toline (file, satznr) .
+
+bildsatz ist leerzeile :
+ TEXT VAR bildsatz;
+ read record (file, bildsatz);
+ ist leerzeile .
+
+ist leerzeile :
+ bildsatz = "" OR bildsatz = blank .
+
+ggf bildschirmdarstellung korrigieren :
+ satz nr DECR 1; (* für Bildschirmkorrektur *)
+ IF satznr > lines (file)
+ THEN zeilen nr DECR satz nr - lines (file);
+ satz nr := lines (file);
+ dateizustand retten
+ FI .
+
+bildeinschraenkung aufheben :
+ laenge := feldlaenge;
+ kurze feldlaenge := feldlaenge;
+ kurze bildlaenge := bildlaenge;
+ neu (nix, bild) .
+END PROC quit;
+
+PROC nichts neu : neu (nix, nix) END PROC nichts neu;
+
+PROC satznr neu : neu (akt satznr, nix) END PROC satznr neu;
+
+PROC ueberschrift neu : neu (ueberschrift, nix) END PROC ueberschrift neu;
+
+PROC zeile neu :
+ INT CONST zeile := line no (file);
+ abschnitt neu (zeile, zeile)
+END PROC zeile neu;
+
+PROC abschnitt neu (INT CONST von satznr, bis satznr) :
+ IF von satznr <= bis satznr
+ THEN erster neusatz := min (erster neusatz, von satznr);
+ letzter neusatz := max (letzter neusatz, bis satznr);
+ neu (nix, abschnitt)
+ ELSE abschnitt neu (bis satznr, von satznr)
+ FI
+END PROC abschnitt neu;
+
+PROC bildabschnitt neu (INT CONST von zeile, bis zeile) : (*sh*)
+ IF von zeile <= bis zeile
+ THEN erster neusatz := max (1, von zeile + bildanfang - 1);
+ letzter neusatz := min (bildlaenge, bis zeile + bildanfang - 1);
+ IF von zeile < 1
+ THEN neu (ueberschrift, abschnitt)
+ ELSE neu (nix , abschnitt)
+ FI
+ ELSE bildabschnitt neu (bis zeile, von zeile)
+ FI
+END PROC bildabschnitt neu;
+
+PROC bild neu : neu (nix, bild) END PROC bild neu; (*sh*)
+
+PROC bild neu (FILE VAR f) :
+ INT CONST editor no := abs (editinfo (f)) DIV 256;
+ IF editor no > 0 AND editor no <= max used editor
+ THEN IF editor no = actual editor
+ THEN bild neu
+ ELSE editstack (editor no).bildstatus.bildbereich := bild
+ FI
+ FI
+END PROC bild neu;
+
+PROC alles neu :
+ neu (ueberschrift, bild);
+ INT VAR i;
+ FOR i FROM 1 UPTO max used editor REP
+ editstack (i).bildstatus.bildbereich := bild;
+ editstack (i).bildstatus.ueberschriftbereich := ueberschrift
+ PER
+END PROC alles neu;
+
+PROC satznr zeigen :
+ out (satznr pre); out (text (text (lineno (file)), 4))
+END PROC satznr zeigen;
+
+PROC ueberschrift zeigen :
+ SELECT ueberschriftbereich OF
+ CASE akt satznr : satznr zeigen;
+ ueberschriftbereich := nix
+ CASE ueberschrift : ueberschrift schreiben;
+ ueberschriftbereich := nix
+ CASE fehlermeldung : fehlermeldung schreiben;
+ ueberschriftbereich := ueberschrift
+ END SELECT
+END PROC ueberschrift zeigen;
+
+PROC fenster zeigen :
+ SELECT bildbereich OF
+ CASE bildzeile :
+ zeile := bildrand + zeilennr;
+ IF line no (file) > lines (file)
+ THEN feldout ("", stelle)
+ ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle)
+ FI
+ CASE abschnitt :
+ bild ausgeben
+ CASE bild :
+ erster neusatz := 1;
+ letzter neusatz := 9999;
+ bild ausgeben
+ OTHERWISE :
+ LEAVE fenster zeigen
+ END SELECT;
+ erster neusatz := 9999;
+ letzter neusatz := 0;
+ bildbereich := nix
+END PROC fenster zeigen ;
+
+PROC bild ausgeben :
+ BOOL CONST schreiben ist ganz einfach := NOT markiert AND verschoben = 0;
+ INT CONST save marke := marke,
+ save verschoben := verschoben,
+ save laenge := laenge,
+ act lineno := lineno (file),
+ von := max (1, erster neusatz - bildanfang + 1);
+ INT VAR bis := min (letzter neusatz - bildanfang + 1, bildlaenge);
+ IF kurze feldlaenge <= 0 THEN bis := min (bis, kurze bildlaenge) FI;
+ IF von > bis THEN LEAVE bild ausgeben FI;
+ verschoben := 0;
+ IF markiert
+ THEN IF mark lineno (file) < bildanfang + von - 1
+ THEN marke := anfang
+ ELSE marke := 0
+ FI
+ FI ;
+ abschnitt loeschen und neuschreiben;
+ to line (file, act lineno);
+ laenge := save laenge;
+ verschoben := save verschoben;
+ marke := save marke .
+
+markiert : mark lineno (file) > 0 .
+
+abschnitt loeschen und neuschreiben :
+ abschnitt loeschen;
+ INT VAR line number := bildanfang + von - 1;
+ to line (file, line number);
+ abschnitt schreiben .
+
+abschnitt loeschen :
+ cursor (rand + 1, bildrand + von);
+ IF bildrest darf komplett geloescht werden
+ THEN out (clear eop)
+ ELSE zeilenweise loeschen
+ FI .
+
+bildrest darf komplett geloescht werden :
+ bis = maxlaenge AND kurze bildlaenge = maxlaenge
+ AND kurze feldlaenge = maxbreite .
+
+zeilenweise loeschen :
+ INT VAR i;
+ FOR i FROM von UPTO bis REP
+ check for interrupt;
+ feldlaenge einstellen;
+ feldrest loeschen;
+ IF i < bis THEN out (down char) FI
+ PER .
+
+feldlaenge einstellen :
+ IF ganze zeile sichtbar
+ THEN laenge := feldlaenge
+ ELSE laenge := kurze feldlaenge
+ FI .
+
+ganze zeile sichtbar : i <= kurze bildlaenge .
+
+abschnitt schreiben :
+ INT CONST last line := lines (file);
+ FOR i FROM von UPTO bis
+ WHILE line number <= last line REP
+ check for interrupt;
+ feldlaenge einstellen;
+ zeile schreiben;
+ down (file);
+ line number INCR 1
+ PER .
+
+check for interrupt :
+ kommando CAT inchety;
+ IF kommando <> ""
+ THEN IF zeilen nr = 1 CAND up command CAND vorgaenger erlaubt
+ THEN LEAVE abschnitt loeschen und neuschreiben
+ ELIF zeilen nr = bildlaenge CAND down command CAND nicht letzter satz
+ THEN LEAVE abschnitt loeschen und neuschreiben
+ FI
+ FI .
+
+vorgaenger erlaubt :
+ satznr > max (1, bildmarke) .
+
+up command : next incharety is (""3"") COR next incharety is (""1""3"") .
+
+down command :
+ next incharety is (""10"") CAND bildlaenge < maxlaenge
+ COR next incharety is (""1""10"") .
+
+nicht letzter satz : act lineno < lines (file) .
+
+zeile schreiben :
+ zeile := bildrand + i;
+ IF schreiben ist ganz einfach
+ THEN exec (PROC (TEXT CONST, INT CONST) simple feldout, file, 0)
+ ELSE zeile kompliziert schreiben
+ FI ;
+ IF line number = old lineno THEN old line update := FALSE FI .
+
+zeile kompliziert schreiben :
+ IF line number = mark lineno (file) THEN marke := mark col (file) FI;
+ IF line number = act lineno
+ THEN verschoben := save verschoben;
+ exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
+ verschoben := 0; marke := 0
+ ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, 0);
+ IF line number = mark lineno (file) THEN marke := anfang FI
+ FI .
+END PROC bild ausgeben;
+
+PROC bild zeigen : (* wk *)
+
+ dateizustand holen ;
+ ueberschrift zeigen ;
+ bildausgabe steuern ;
+ bild neu ;
+ fenster zeigen ;
+ oldline no := satznr ;
+ old line update := FALSE ;
+ old satz := "" ;
+ old zeilennr := satznr - bildanfang + 1 ;
+ dateizustand retten .
+
+ENDPROC bild zeigen ;
+
+PROC ueberschrift initialisieren : (*sh*)
+ satznr pre :=
+ cursor pos + code (bildrand - 1) + code (rand + feldlaenge - 6);
+ ueberschrift pre :=
+ cursor pos + code (bildrand - 1) + code (rand) + mark anf;
+ ueberschrift text := ""; INT VAR i;
+ FOR i FROM 16 UPTO feldlaenge REP ueberschrift text CAT "." PER;
+ ueberschrift post := blank + mark end + "Zeile " + mark anf;
+ ueberschrift post CAT blank + mark end + " ";
+ filename := headline (file);
+ filename := subtext (filename, 1, feldlaenge - 24);
+ insert char (filename, blank, 1); filename CAT blank;
+ replace (ueberschrift text, filenamepos, filename);
+ rubin segment in ueberschrift eintragen;
+ margin segment in ueberschrift eintragen;
+ rest segment in ueberschrift eintragen;
+ learn segment in ueberschrift eintragen .
+
+filenamepos : (LENGTH ueberschrift text - LENGTH filename + 3) DIV 2 .
+mark anf : begin mark + mark ausgleich.
+mark end : end mark + mark ausgleich.
+mark ausgleich : (1 - sign (max (mark size, 0))) * blank .
+
+rubin segment in ueberschrift eintragen :
+ replace (ueberschrift text, 9, rubin segment) .
+
+rubin segment :
+ IF einfuegen THEN "RUBIN" ELSE "....." FI .
+
+margin segment in ueberschrift eintragen :
+ replace (ueberschrift text, 2, margin segment) .
+
+margin segment :
+ IF anfang <= 1
+ THEN "......"
+ ELSE TEXT VAR margin text := "M" + text (anfang);
+ (6 - LENGTH margin text) * "." + margin text
+ FI .
+
+rest segment in ueberschrift eintragen :
+ replace (ueberschrift text, feldlaenge - 25, rest segment) .
+
+rest segment :
+ IF zeileneinfuegen THEN "REST" ELSE "...." FI .
+
+learn segment in ueberschrift eintragen :
+ replace (ueberschrift text, feldlaenge - 19, learn segment) .
+
+learn segment :
+ IF lernmodus THEN "LEARN" ELSE "....." FI .
+
+END PROC ueberschrift initialisieren;
+
+PROC ueberschrift schreiben :
+ replace (ueberschrift post, satznr pos, text (text (lineno (file)), 4));
+ out (ueberschrift pre); out (ueberschrift text); out (ueberschrift post);
+ get tabs (file, tab);
+ IF pos (tab, dach) > 0
+ THEN out (ueberschrift pre);
+ out subtext (tab, anfang + 1, anfang + feldlaenge - 1);
+ cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+ FI .
+
+ satznr pos : IF mark size > 0 THEN 9 ELSE 10 FI . (*sh*)
+END PROC ueberschrift schreiben;
+
+PROC fehlermeldung schreiben :
+ ueberschrift schreiben;
+ out (ueberschrift pre);
+ out ("FEHLER: ");
+ out subtext (fehlertext, 1, feldlaenge - 21);
+ out (blank);
+ out (piep);
+ cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
+END PROC fehlermeldung schreiben;
+
+PROC set busy indicator :
+ cursor (rand + 2, bildrand)
+END PROC set busy indicator;
+
+PROC kommando analysieren (TEXT CONST taste,
+ PROC (TEXT CONST) kommando interpreter) :
+ disable stop;
+ bildausgabe normieren;
+ zustand in datei sichern;
+ editfile modus setzen;
+ kommando interpreter (taste);
+ editfile modus zuruecksetzen;
+ IF actual editor <= 0 THEN LEAVE kommando analysieren FI;
+ absatz ausgleich := 2; (*sh*)
+ konstanten neu berechnen;
+ neues bild bei undefinierter benutzeraktion;
+ evtl fehler behandeln;
+ zustand aus datei holen;
+ bildausgabe steuern .
+
+editfile modus setzen :
+ BOOL VAR alter editget modus := editget modus ;
+ editget modus := FALSE .
+
+editfile modus zuruecksetzen :
+ editget modus := alter editget modus .
+
+evtl fehler behandeln :
+ IF is error
+ THEN fehlertext := errormessage;
+ IF fehlertext <> "" THEN neu (fehlermeldung, nix) FI;
+ clear error
+ ELSE fehlertext := ""
+ FI .
+
+zustand in datei sichern :
+ old zeilennr := zeilennr;
+ old mark lineno := bildmarke;
+ dateizustand retten .
+
+zustand aus datei holen :
+ dateizustand holen;
+ IF letzer editor auf dieser datei <> actual editor
+ THEN zurueck auf alte position; neu (ueberschrift, bild)
+ FI .
+
+zurueck auf alte position :
+ to line (file, old lineno);
+ col (file, alte stelle);
+ IF fliesstext
+ THEN editinfo (file, old zeilennr)
+ ELSE editinfo (file, - old zeilennr)
+ FI ; dateizustand holen .
+
+bildausgabe normieren :
+ bildbereich := undefinierter bereich;
+ erster neusatz := 9999;
+ letzter neusatz := 0 .
+
+neues bild bei undefinierter benutzeraktion :
+ IF bildbereich = undefinierter bereich THEN alles neu FI .
+END PROC kommando analysieren;
+
+PROC bildausgabe steuern :
+ IF markiert
+ THEN IF old mark lineno = 0
+ THEN abschnitt neu (bildmarke, satznr);
+ konstanten neu berechnen
+ ELIF stelle veraendert (*sh*)
+ THEN zeile neu
+ FI
+ ELIF old mark lineno > 0
+ THEN abschnitt neu (old mark lineno, (max (satznr, old lineno)));
+ konstanten neu berechnen
+ FI ;
+ IF satznr <> old lineno
+ THEN neu (akt satznr, nix);
+ neuen bildaufbau bestimmen
+ ELSE zeilennr := old zeilennr
+ FI ;
+ zeilennr := min (min (zeilennr, satznr), aktuelle bildlaenge);
+ bildanfang := satznr - zeilennr + 1 .
+
+stelle veraendert : stelle <> alte stelle .
+
+neuen bildaufbau bestimmen :
+ zeilennr := old zeilennr + satznr - old lineno;
+ IF 1 <= zeilennr AND zeilennr <= aktuelle bildlaenge
+ THEN im fenster springen
+ ELSE bild neu aufbauen
+ FI .
+
+im fenster springen :
+ IF markiert THEN abschnitt neu (old lineno, satznr) FI .
+
+bild neu aufbauen :
+ neu (nix, bild); zeilennr := max (1, aktuelle bildlaenge DIV 2) .
+END PROC bildausgabe steuern;
+
+PROC word wrap (BOOL CONST b) :
+ IF actual editor = 0
+ THEN std fliesstext := b
+ ELSE fliesstext in datei setzen
+ FI .
+
+fliesstext in datei setzen :
+ fliesstext := b;
+ IF fliesstext veraendert THEN editinfo (file, - editinfo (file)) FI;
+ neu (ueberschrift, bild) .
+
+fliesstext veraendert :
+ fliesstext AND editinfo (file) < 0 OR
+ NOT fliesstext AND editinfo (file) > 0 .
+END PROC word wrap;
+
+BOOL PROC word wrap : (*sh*)
+ IF actual editor = 0
+ THEN std fliesstext
+ ELSE fliesstext
+ FI
+END PROC word wrap;
+
+INT PROC margin : anfang END PROC margin;
+
+PROC margin (INT CONST i) : (*sh*)
+ IF anfang <> i CAND i > 0 AND i < 16001
+ THEN anfang := i; neu (ueberschrift, bild);
+ margin segment in ueberschrift eintragen
+ ELSE IF i >= 16001 OR i < 0
+ THEN errorstop ("ungueltige Anfangsposition (1 - 16000)")
+ FI
+ FI .
+
+margin segment in ueberschrift eintragen :
+ replace (ueberschrift text, 2, margin segment) .
+
+margin segment :
+ IF anfang <= 1
+ THEN "......"
+ ELSE TEXT VAR margin text := "M" + text (anfang);
+ (6 - LENGTH margin text) * "." + margin text
+ FI .
+
+END PROC margin;
+
+BOOL PROC rubin mode : rubin mode (actual editor) END PROC rubin mode;
+
+BOOL PROC rubin mode (INT CONST editor nr) : (*sh*)
+ IF editor nr < 1 OR editor nr > max used editor
+ THEN errorstop ("Editor nicht eroeffnet")
+ FI ;
+ IF editor nr = actual editor
+ THEN einfuegen
+ ELSE editstack (editor nr).feldstatus.einfuegen
+ FI
+END PROC rubin mode;
+
+PROC edit (INT CONST i, TEXT CONST res,
+ PROC (TEXT CONST) kommando interpreter) :
+ edit (i, i, i, res, PROC (TEXT CONST) kommando interpreter)
+END PROC edit;
+
+PROC edit (INT CONST von, bis, start, TEXT CONST res,
+ PROC (TEXT CONST) kommando interpreter) :
+ disable stop;
+ IF von < bis
+ THEN edit (von+1, bis, start, res, PROC (TEXT CONST) kommando interpreter);
+ IF max used editor < von THEN LEAVE edit FI;
+ open editor (von)
+ ELSE open editor (start)
+ FI ;
+ absatz ausgleich := 2;
+ bildeditor (res, PROC (TEXT CONST) kommando interpreter);
+ cursor (1, schirmhoehe);
+ IF is error
+ THEN kommando zeiger := 1; kommando := ""; quit
+ FI ;
+ IF lernmodus CAND actual editor = 0 THEN warnung ausgeben FI . (*sh*)
+
+ warnung ausgeben :
+ out (clear eop); out ("WARNUNG: Lernmodus nicht ausgeschaltet"13""10"") .
+END PROC edit;
+
+PROC dateizustand holen :
+ modify (file);
+ get tabs (file, tabulator);
+ zeilennr und fliesstext und letzter editor aus editinfo decodieren;
+ limit := max line length (file);
+ stelle := col (file);
+ markiert := mark (file);
+ IF markiert
+ THEN markierung holen
+ ELSE keine markierung
+ FI ;
+ satz nr := lineno (file);
+ IF zeilennr > aktuelle bildlaenge (*sh*)
+ THEN zeilennr := min (satznr, aktuelle bildlaenge); bild neu
+ ELIF zeilennr > satznr
+ THEN zeilennr := min (satznr, aktuelle bildlaenge)
+ FI ; zeilennr := max (zeilennr, 1);
+ bildanfang := satz nr - zeilennr + 1 .
+
+zeilennr und fliesstext und letzter editor aus editinfo decodieren :
+ zeilennr := edit info (file);
+ IF zeilennr = 0
+ THEN zeilennr := 1;
+ fliesstext := std fliesstext
+ ELIF zeilennr > 0
+ THEN fliesstext := TRUE
+ ELSE zeilennr := - zeilennr;
+ fliesstext := FALSE
+ FI ;
+ letzer editor auf dieser datei := zeilennr DIV 256;
+ zeilennr := zeilennr MOD 256 .
+
+markierung holen :
+ bildmarke := mark lineno (file);
+ feldmarke := mark col (file);
+ IF line no (file) <= bildmarke
+ THEN to line (file, bildmarke);
+ marke := feldmarke;
+ stelle := max (stelle, feldmarke)
+ ELSE marke := 1
+ FI .
+
+keine markierung :
+ bildmarke := 0;
+ feldmarke := 0;
+ marke := 0 .
+END PROC dateizustand holen;
+
+PROC dateizustand retten :
+ put tabs (file, tabulator);
+ IF fliesstext
+ THEN editinfo (file, zeilennr + actual editor * 256)
+ ELSE editinfo (file, - (zeilennr + actual editor * 256))
+ FI ;
+ max line length (file, limit);
+ col (file, stelle);
+ IF markiert
+ THEN mark (file, bildmarke, feldmarke)
+ ELSE mark (file, 0, 0)
+ FI
+END PROC dateizustand retten;
+
+PROC open editor (FILE CONST new file, BOOL CONST access) :
+ disable stop; quit last;
+ neue bildparameter bestimmen;
+ open editor (actual editor + 1, new file, access, x, y, x len, y len).
+
+neue bildparameter bestimmen :
+ INT VAR x, y, x len, y len;
+ IF actual editor > 0
+ THEN teilbild des aktuellen editors
+ ELSE volles bild
+ FI .
+
+teilbild des aktuellen editors :
+ get editcursor (x, y); bildgroesse bestimmen;
+ IF fenster zu schmal (*sh*)
+ THEN enable stop; errorstop ("Fenster zu klein")
+ ELIF fenster zu kurz
+ THEN verkuerztes altes bild nehmen
+ FI .
+
+bildgroesse bestimmen :
+ x len := rand + feldlaenge - x + 3;
+ y len := bildrand + bildlaenge - y + 1 .
+
+fenster zu schmal : x > schirmbreite - 17 .
+fenster zu kurz : y > schirmhoehe - 1 .
+
+verkuerztes altes bild nehmen :
+ x := rand + 1; y := bildrand + 1;
+ IF fenster zu kurz THEN enable stop; errorstop ("Fenster zu klein") FI;
+ x len := feldlaenge + 2;
+ y len := bildlaenge;
+ kurze feldlaenge := 0;
+ kurze bildlaenge := 1 .
+
+volles bild :
+ x := 1; y := 1; x len := schirmbreite; y len := schirmhoehe .
+END PROC open editor;
+
+PROC open editor (INT CONST editor nr,
+ FILE CONST new file, BOOL CONST access,
+ INT CONST x start, y, x len start, y len) :
+ INT VAR x := x start,
+ x len := x len start;
+ IF editor nr > max editor
+ THEN errorstop ("zu viele Editor-Fenster")
+ ELIF editor nr > max used editor + 1 OR editor nr < 1
+ THEN errorstop ("Editor nicht eroeffnet")
+ ELIF fenster ungueltig
+ THEN errorstop ("Fenster ungueltig")
+ ELSE neuen editor stacken
+ FI .
+
+fenster ungueltig :
+ x < 1 COR x > schirmbreite COR y < 1 COR y > schirmhoehe COR
+ x len - 2 <= 15 COR y len - 1 < 1 COR
+ x + x len - 1 > schirmbreite COR y + y len - 1 > schirmhoehe .
+
+neuen editor stacken :
+ disable stop;
+ IF actual editor > 0 AND ist einschraenkung des alten bildes
+ THEN dateizustand holen;
+ aktuelles editorbild einschraenken;
+ arbeitspunkt in das restbild positionieren;
+ abgrenzung beruecksichtigen
+ FI ;
+ aktuellen zustand retten;
+ neuen zustand setzen;
+ neues editorbild zeigen;
+ actual editor := editor nr;
+ IF actual editor > max used editor
+ THEN max used editor := actual editor
+ FI .
+
+ist einschraenkung des alten bildes :
+ x > rand CAND x + x len = rand + feldlaenge + 3 CAND
+ y > bildrand CAND y + y len = bildrand + bildlaenge + 1 .
+
+aktuelles editorbild einschraenken :
+ kurze feldlaenge := x - rand - 3;
+ kurze bildlaenge := y - bildrand - 1 .
+
+arbeitspunkt in das restbild positionieren :
+ IF stelle > 3
+ THEN stelle DECR 3; alte stelle := stelle
+ ELSE WHILE zeilennr > 1 AND zeilennr > kurze bildlaenge REP
+ vorgaenger
+ PER; old lineno := satznr
+ FI .
+
+abgrenzung beruecksichtigen :
+ IF x - rand > 1
+ THEN balken malen;
+ x INCR 2;
+ x len DECR 2
+ FI .
+
+balken malen :
+ INT VAR i;
+ FOR i FROM 0 UPTO y len-1 REP
+ cursor (x, y+i); out (kloetzchen) (*sh*)
+ PER .
+
+kloetzchen : IF mark size > 0 THEN ""15""14"" ELSE ""15" "14" " FI .
+
+aktuellen zustand retten :
+ IF actual editor > 0
+ THEN dateizustand retten;
+ editstack (actual editor).feldstatus := feldstatus;
+ editstack (actual editor).bildstatus := bildstatus;
+ einrueckstack (actual editor) := alte einrueckposition
+ FI .
+
+neuen zustand setzen :
+ FRANGE VAR frange;
+ feldstatus := FELDSTATUS :
+ (1, 1, x-1, 0, 1, 0, x len-2, 0, FALSE, TRUE, access, "");
+ bildstatus := BILDSTATUS :
+ (x len-2, x len-2, y, y len-1, y len-1, ueberschrift, bild,
+ 0, 0, 1, 0, 0, FALSE, FALSE, "", "", "", "", "", frange, new file);
+ alte einrueckposition := 1;
+ dateizustand holen;
+ ueberschrift initialisieren .
+
+neues editorbild zeigen :
+ ueberschrift zeigen; fenster zeigen
+END PROC open editor;
+
+PROC open editor (INT CONST i) :
+ IF i < 1 OR i > max used editor
+ THEN errorstop ("Editor nicht eroeffnet")
+ ELIF actual editor <> i
+ THEN switch editor
+ FI .
+
+switch editor :
+ aktuellen zustand retten;
+ actual editor := i;
+ neuen zustand setzen;
+ IF kein platz mehr fuer restfenster
+ THEN eingeschachtelte editoren vergessen;
+ bildeinschraenkung aufheben
+ ELSE neu (nix, nix)
+ FI .
+
+aktuellen zustand retten :
+ IF actual editor > 0
+ THEN editstack (actual editor).feldstatus := feldstatus;
+ editstack (actual editor).bildstatus := bildstatus;
+ einrueckstack (actual editor) := alte einrueckposition;
+ dateizustand retten
+ FI .
+
+neuen zustand setzen :
+ feldstatus := editstack (i).feldstatus;
+ bildstatus := editstack (i).bildstatus;
+ alte einrueckposition := einrueckstack (i);
+ dateizustand holen .
+
+kein platz mehr fuer restfenster :
+ kurze feldlaenge < 1 AND kurze bildlaenge < 1 .
+
+eingeschachtelte editoren vergessen :
+ IF actual editor < max used editor
+ THEN open editor (actual editor + 1) ;
+ quit
+ FI ;
+ open editor (i) .
+
+bildeinschraenkung aufheben :
+ laenge := feldlaenge;
+ kurze feldlaenge := feldlaenge;
+ kurze bildlaenge := bildlaenge;
+ neu (ueberschrift, bild) .
+END PROC open editor;
+
+FILE PROC editfile :
+ IF actual editor = 0 OR editget modus
+ THEN errorstop ("Editor nicht eroeffnet")
+ FI ; file
+END PROC editfile;
+
+PROC get window (INT VAR x, y, x size, y size) :
+ x := rand + 1;
+ y := bildrand;
+ x size := feldlaenge + 2;
+ y size := bildlaenge + 1
+ENDPROC get window;
+
+(************************* Zugriff auf Bildstatus *************************).
+
+feldlaenge : bildstatus.feldlaenge .
+kurze feldlaenge : bildstatus.kurze feldlaenge .
+bildrand : bildstatus.bildrand .
+bildlaenge : bildstatus.bildlaenge .
+kurze bildlaenge : bildstatus.kurze bildlaenge .
+ueberschriftbereich : bildstatus.ueberschriftbereich .
+bildbereich : bildstatus.bildbereich .
+erster neusatz : bildstatus.erster neusatz .
+letzter neusatz : bildstatus.letzter neusatz .
+old zeilennr : bildstatus.old zeilennr .
+old lineno : bildstatus.old lineno .
+old mark lineno : bildstatus.old mark lineno .
+zeileneinfuegen : bildstatus.zeileneinfuegen .
+old line update : bildstatus.old line update .
+satznr pre : bildstatus.satznr pre .
+ueberschrift pre : bildstatus.ueberschrift pre .
+ueberschrift text : bildstatus.ueberschrift text .
+ueberschrift post : bildstatus.ueberschrift post .
+old satz : bildstatus.old satz .
+old range : bildstatus.old range .
+file : bildstatus.file .
+
+END PACKET editor paket;
+