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;