diff options
| author | Lars-Dominik Braun <lars@6xq.net> | 2019-02-04 13:09:03 +0100 |
|---|---|---|
| committer | Lars-Dominik Braun <lars@6xq.net> | 2019-02-04 13:09:03 +0100 |
| commit | 04e68443040c7abad84d66477e98f93bed701760 (patch) | |
| tree | 2b6202afae659e773bf6916157d23e83edfa44e3 /system/base/1.7.5/src/editor | |
| download | eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.gz eumel-src-04e68443040c7abad84d66477e98f93bed701760.tar.bz2 eumel-src-04e68443040c7abad84d66477e98f93bed701760.zip | |
Initial import
Diffstat (limited to 'system/base/1.7.5/src/editor')
| -rw-r--r-- | system/base/1.7.5/src/editor | 2959 |
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; + |