diff options
Diffstat (limited to 'system/base/unknown/src/feldeditor')
| -rw-r--r-- | system/base/unknown/src/feldeditor | 747 |
1 files changed, 747 insertions, 0 deletions
diff --git a/system/base/unknown/src/feldeditor b/system/base/unknown/src/feldeditor new file mode 100644 index 0000000..4156111 --- /dev/null +++ b/system/base/unknown/src/feldeditor @@ -0,0 +1,747 @@ +
+PACKET f e l d e d i t o r DEFINES (* Autor: P.Heyderhoff *)
+ (*****************) (* Stand: 12.04.82 *)
+ (* Vers.: 1.6.0 *)
+ editget,
+ feldeditor,
+ feldout,
+ feldposition,
+ feldeinruecken,
+ feldtab,
+ feldtabulator,
+ feldseparator,
+ feldmarke,
+ feldstelle,
+ feldwortweise,
+ feldanfang,
+ feldende,
+ feldrand,
+ feldlimit,
+ feldaudit,
+ feldzeichen,
+ feldkommando,
+ feldeinfuegen,
+ feldlernmodus,
+ is incharety,
+ getchar,
+ min :
+
+
+TEXT VAR tabulator :: "", separator :: "", fzeichen ::"",
+ kommando :: "", audit :: "";
+
+INT VAR fmarke :: 0, fstelle :: 1, frand :: 0, limit :: 77,
+ fanfang :: 1, dyn fanfang :: fanfang, flaenge, fj,
+ fende :: 77, dyn fende :: fende, dezimalen :: 0;
+
+BOOL VAR wortweise :: FALSE, feinfuegen :: FALSE,
+ blankseparator :: FALSE, lernmodus :: FALSE,
+ war absatz;
+
+LET blank = " ", hop=""1"", right=""2"", up=""3"", clear eop=""4"",
+ clear eol=""5"", bell=""7"", left=""8"", tab=""9"", down=""10"",
+ rubin=""11"", rubout=""12"", cr=""13"", mark=""16"", escape=""27"",
+ hoechstes steuerzeichen=""31"", dach=""94"", end mark=""14"", begin
+ mark=""15"", clear=""1""4"", hop tab=""1""9"", hop rubin=""1""11"",
+ hop rubout=""1""12"", hop cr=""1""13"", cr down=""13""10"",
+ right left tab rubout escape = ""2""8""9""12""27"", hop escape=""1""27"",
+ left left=""8""8"", left endmark=""8""14"", endmark left=""14""8"",
+ left right=""8""2"", blank left=" "8"",
+ blank left rubout=" "8""12"", absatzmarke=""15""14"",
+ hop esc right left tab rubin rubout cr = ""1""27""2""8""9""11""12""13"",
+ hop esc right left tab down cr = ""1""27""2""8""9""10""13"";
+
+(*************************** p r o z e d u r e n *************************)
+
+PROC editget (TEXT VAR editsatz, INT CONST editlimit, editfende):
+
+ disable stop ; (* J.Liedtke 10.02.82 *)
+
+ INT CONST altflaenge :: LENGTH editsatz, altfrand :: frand,
+ altfmarke :: fmarke, altfstelle :: fstelle,
+ altfanfang :: fanfang, altfende :: fende, altlimit :: limit;
+ BOOL CONST altwortweise :: wortweise, altfeinfuegen :: feinfuegen;
+ fmarke := 0; fstelle := 1; fanfang := 1; dyn fanfang := 1;
+ fende := editfende MOD 256; dyn fende := fende;
+ limit := editlimit MOD 256; wortweise := FALSE;
+ feinfuegen := FALSE;
+ INT VAR x, y; get cursor (x,y); frand := x-1;
+ out (editsatz); cursor (x,y);
+ REP
+ feldeditor (editsatz);
+ IF (kommando SUB 1) = escape OR (kommando SUB 1) = hop
+ THEN delete char (kommando, 1)
+ FI;
+ delete char (kommando, 1)
+ UNTIL fzeichen = cr OR (fzeichen SUB 1) = separator OR is error
+ PER;
+ cursor (x + 1 + editflaenge - dyn fanfang, y);
+ fmarke := altfmarke; fstelle := altfstelle; fanfang := altfanfang;
+ dyn fanfang := fanfang; fende := altfende; dyn fende := fende;
+ limit := altlimit; wortweise := altwortweise; frand := altfrand;
+ feinfuegen := altfeinfuegen .
+
+editflaenge :
+ min (dyn fende, flaenge) .
+
+END PROC editget;
+
+PROC editget (TEXT VAR editsatz) :
+ INT VAR x, y; get cursor (x,y);
+ editget (editsatz, 255, fende-fanfang+2+frand-x)
+END PROC editget;
+
+PROC feldout (TEXT CONST satz) :
+ INT VAR x, y;
+ flaenge := min (fende, LENGTH satz);
+ out (cr);
+ frand TIMESOUT right; feldrest loeschen (fanfang);
+ IF fmarke > 0
+ THEN outsubtext (satz, fanfang, fmarke-1); out (begin mark);
+ outsubtext (satz, fmarke, min (fstelle-1,flaenge));
+ out (end mark); outsubtext (satz, fstelle, flaenge);
+ ELIF absatzmarke noetig (satz)
+ THEN get cursor (x,y); outsubtext (satz, fanfang, flaenge);
+ cursor (x + fende + 1 - fanfang, y); out (absatzmarke)
+ ELSE outsubtext (satz, fanfang, flaenge)
+ FI
+END PROC feldout;
+
+
+PROC feld einruecken (TEXT CONST satz) :
+
+ IF fstelle = fanfang
+ THEN fstelle := neue einrueckposition;
+ (fstelle-fanfang) TIMESOUT right
+ FI .
+
+neue einrueckposition :
+ INT VAR suchindex;
+ FOR suchindex FROM fanfang UPTO min (LENGTH satz, fende)
+ REP IF (satz SUB suchindex) <> blank
+ THEN LEAVE neue einrueckposition WITH suchindex
+ FI
+ PER;
+ fanfang .
+
+END PROC feld einruecken;
+
+TEXT PROC feldzeichen :
+ fzeichen
+END PROC feldzeichen;
+
+TEXT PROC feldkommando :
+ kommando
+END PROC feldkommando;
+
+PROC feldkommando (TEXT CONST t) :
+ kommando := t
+END PROC feldkommando;
+
+PROC feldtab (TEXT VAR t) :
+ t := tabulator
+END PROC feldtab;
+
+PROC feldtabulator (TEXT CONST t) :
+ tabulator := t
+END PROC feldtabulator;
+
+TEXT PROC feldseparator :
+ separator
+END PROC feldseparator;
+
+PROC feldseparator (TEXT CONST t) :
+ separator := t; blankseparator := t = blank
+END PROC feldseparator;
+
+TEXT PROC feldaudit :
+ audit
+END PROC feldaudit;
+
+PROC feldaudit (TEXT CONST a) :
+ audit := a
+END PROC feldaudit;
+
+BOOL PROC feldlernmodus :
+ lernmodus
+END PROC feldlernmodus;
+
+PROC feldlernmodus (BOOL CONST b) :
+ lernmodus := b
+END PROC feldlernmodus;
+
+BOOL PROC feldeinfuegen :
+ feinfuegen
+END PROC feldeinfuegen;
+
+PROC feldeinfuegen (BOOL CONST b):
+ feinfuegen := b
+END PROC feldeinfuegen;
+
+BOOL PROC feldwortweise :
+ wortweise
+END PROC feldwortweise;
+
+PROC feldwortweise (BOOL CONST b) :
+ wortweise := b
+END PROC feldwortweise;
+
+INT PROC feldmarke :
+ fmarke
+END PROC feldmarke;
+
+PROC feldmarke (INT CONST i) :
+ fmarke := i MOD 256
+END PROC feldmarke;
+
+INT PROC feldstelle :
+ fstelle
+END PROC feldstelle;
+
+PROC feldstelle (INT CONST i) :
+ fstelle := i MOD 256
+END PROC feldstelle;
+
+INT PROC feldanfang :
+ fanfang
+END PROC feldanfang;
+
+PROC feldanfang (INT CONST i) :
+ fanfang := i MOD 256; dyn fanfang := fanfang
+END PROC feldanfang;
+
+INT PROC feldende :
+ fende
+END PROC feldende;
+
+PROC feldende (INT CONST i) :
+ fende := i MOD 256; dyn fende := fende
+END PROC feldende;
+
+INT PROC feldrand :
+ frand
+END PROC feldrand;
+
+PROC feldrand (INT CONST i) :
+ frand := i MOD 256
+END PROC feldrand;
+
+INT PROC feldlimit :
+ limit
+END PROC feldlimit;
+
+PROC feldlimit (INT CONST i) :
+ limit := i MOD 256
+END PROC feldlimit;
+
+PROC feldposition :
+ INT VAR x, y;
+ IF fstelle <= fende
+ THEN IF fstelle < fanfang
+ THEN fstelle := fanfang;
+ IF fanfang > fende
+ THEN fende := fanfang; dyn fende := fanfang
+ FI
+ FI
+ ELSE fstelle := fende;
+ IF fanfang > fende
+ THEN fanfang := fende; dyn fanfang := fende
+ FI
+ FI;
+ get cursor(x,y); cursor(1+frand+fstelle-fanfang+fmarke oder fstelle, y).
+
+fmarke oder fstelle :
+ IF fmarke > 0 THEN 1 ELSE 0 FI .
+
+END PROC feldposition;
+
+PROC feldposition (INT CONST i) :
+ fstelle := i; feldposition
+END PROC feldposition;
+
+BOOL PROC absatzmarke noetig (TEXT CONST satz) :
+
+ IF wortweise
+ THEN (satz SUB LENGTH satz) = blank
+ ELSE FALSE
+ FI
+END PROC absatzmarke noetig;
+
+PROC zeile neu schreiben (TEXT CONST satz) :
+ INT VAR x,y; get cursor (x,y);
+ flaenge := min (dyn fende, LENGTH satz);
+ cursor (1+frand, y);
+ feldrest loeschen (dyn fanfang);
+ outsubtext (satz, dyn fanfang, flaenge);
+ cursor (x,y)
+END PROC zeile neu schreiben;
+
+PROC feldrest loeschen (INT CONST fstelle):
+ INT VAR x,y;
+ IF frand + fende <= 76
+ THEN get cursor (x,y); (1 + dyn fende - fstelle) TIMESOUT blank;
+ cursor (x,y)
+ ELSE out (clear eol); war absatz := FALSE
+ FI
+END PROC feldrest loeschen;
+
+TEXT OP SUBB (TEXT CONST t, INT CONST i) :
+ IF i <= LENGTH t THEN t SUB i ELSE blank FI
+END OP SUBB;
+
+INT PROC min (INT CONST a, b):
+ IF a < b THEN a ELSE b FI
+END PROC min;
+
+BOOL PROC is incharety (TEXT CONST muster) :
+
+ fzeichen := incharety;
+ IF fzeichen = ""
+ THEN FALSE
+ ELSE IF lernmodus
+ THEN audit CAT fzeichen;
+ IF fzeichen = """" THEN audit CAT fzeichen
+ FI FI ;
+ IF fzeichen = muster
+ THEN kommando := ""; TRUE
+ ELSE kommando CAT fzeichen; FALSE
+ FI FI
+END PROC is incharety;
+
+PROC getchar (TEXT VAR fzeichen) :
+
+ IF kommando = ""
+ THEN inchar (fzeichen)
+ ELSE fzeichen := kommando SUB 1;
+ delete char (kommando, 1);
+ kommando CAT incharety
+ FI;
+ IF lernmodus
+ THEN audit CAT fzeichen;
+ IF fzeichen = """"
+ THEN audit CAT fzeichen
+ FI
+ FI .
+END PROC getchar;
+
+
+(************************** f e l d e d i t o r **************************)
+
+PROC feldeditor (TEXT VAR satz) :
+
+ enable stop ; (* J. Liedtke 10.02.82 *)
+
+ INT VAR x, y;
+ BOOL VAR inkompetent :: FALSE; war absatz := absatzmarke noetig (satz);
+ IF fstelle <= fende
+ THEN IF fstelle < fanfang THEN feldposition FI
+ ELSE feldposition
+ FI;
+ flaenge := min (fende, LENGTH satz);
+
+ REP e i n g a b e UNTIL inkompetent PER;
+
+ blanks abschneiden;
+ IF dyn fanfang <> fanfang THEN zurechtruecken FI;
+ IF NOT war absatz AND absatzmarke noetig (satz)
+ THEN absatzmarke schreiben
+ ELIF war absatz AND NOT absatzmarke noetig (satz)
+ THEN absatzmarke loeschen
+ FI .
+
+absatzmarke schreiben :
+ get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (absatzmarke);
+ cursor (x,y) .
+
+absatzmarke loeschen :
+ get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (" ");
+ cursor (x,y) .
+
+zurechtruecken :
+ fstelle DECR (dyn fanfang - fanfang);
+ dyn fanfang := fanfang; dyn fende := fende;
+ zeile neu schreiben (satz) .
+
+blanks abschneiden :
+ flaenge := LENGTH satz;
+ FOR fj FROM flaenge DOWNTO 0 WHILE (satz SUB fj) = blank
+ REP delete char (satz, fj) PER;
+ IF fj < flaenge THEN satz CAT blank FI .
+
+eingabe :
+ IF fmarke <= 0
+ THEN s c h r e i b e d i t o r;
+ IF ueberlaufbedingung
+ THEN ueberlauf
+ ELSE a u s f u e h r e n
+ FI
+ ELSE m a r k e d i t o r
+ FI .
+
+ueberlaufbedingung :
+ IF fstelle <= dyn fende
+ THEN IF fstelle <= limit
+ THEN FALSE
+ ELSE fzeichen > hoechstes steuerzeichen
+ FI
+ ELSE TRUE
+ FI .
+
+ueberlauf :
+ IF fstelle > limit
+ THEN IF wortweise OR fstelle > LENGTH satz
+ THEN ueberlauf in naechste zeile; LEAVE ueberlauf
+ FI
+ FI;
+ IF fstelle > dyn fende
+ THEN fstelle := dyn fende; out (left);
+ zeile um eins nach links verschieben
+ FI .
+
+ueberlauf in naechste zeile :
+ IF wortweise
+ THEN umbrechen
+ ELSE out (bell); kommando := cr
+ FI;
+ inkompetent := TRUE .
+
+umbrechen :
+ IF LENGTH satz > limit
+ THEN kommando CAT subtext (satz, limit+1);
+ FOR fj FROM LENGTH satz DOWNTO fstelle
+ REP kommando CAT left PER;
+ satz := subtext (satz, 1, limit)
+ FI;
+ fj := limit;
+ zeichen zuruecknehmen;
+ (fstelle-fj) TIMESOUT left; fstelle := fj; feldrest loeschen (fstelle);
+ IF kommando = "" THEN kommando := blank left rubout FI;
+ blanks loeschen.
+
+blanks loeschen:
+ REP fj DECR 1;
+ IF (satz SUB fj) <> blank THEN LEAVE blanks loeschen FI;
+ delete char (satz, fj)
+ PER .
+
+zeichen zuruecknehmen:
+ REP fzeichen := satz SUB fj; delete char (satz, fj);
+ IF fzeichen = blank THEN LEAVE zeichen zuruecknehmen FI;
+ insert char (kommando, fzeichen, 1);
+ IF fj = fanfang THEN LEAVE zeichen zuruecknehmen FI;
+ fj DECR1
+ PER.
+
+ausfuehren :
+ dezimalen := 0;
+ SELECT pos (hop esc right left tab rubin rubout cr, fzeichen) OF
+ CASE 1 : getchar (fzeichen);
+ SELECT pos (right left tab rubout escape, fzeichen) OF
+ CASE 1 : zum rechten frand
+ CASE 2 : zum linken frand
+ CASE 3 : tabulator setzen
+ CASE 4 : zeile loeschen
+ CASE 5 : bei lernmodus ein zeichen lesen
+ OTHERWISE hop return
+ END SELECT
+ CASE 2 : escape aktion
+ CASE 3 : nach rechts
+ CASE 4 : nach links
+ CASE 5 : nach tabulator
+ CASE 6 : feinfuegen umschalten
+ CASE 7 : ausfuegen
+ CASE 8 : ggf absatz erzeugen; return
+ OTHERWISE return
+ END SELECT .
+
+ggf absatz erzeugen :
+ IF wortweise
+ THEN IF fstelle > LENGTH satz
+ THEN IF (satz SUB LENGTH satz) <> blank
+ THEN satz CAT blank; fstelle INCR 1
+ FI
+ FI
+ FI .
+
+nach rechts :
+ IF fstelle < dyn fende AND (fstelle < limit OR fstelle < flaenge)
+ THEN out (right); fstelle INCR1
+ ELIF LENGTH satz > dyn fende
+ THEN zeile um eins nach links verschieben
+ ELSE return
+ FI .
+
+nach links :
+ IF fstelle > dyn fanfang
+ THEN out (left); fstelle DECR1
+ ELIF dyn fanfang = fanfang
+ THEN out (bell)
+ ELSE zeile um eins nach rechts verschieben
+ FI .
+
+bei lernmodus ein zeichen lesen :
+ IF lernmodus
+ THEN getchar (fzeichen); return;
+ fzeichen := escape
+ FI;
+ hop return; fzeichen := hop escape .
+
+zeile um eins nach links verschieben :
+ dyn fanfang INCR 1; dyn fende INCR 1;
+ fstelle := dyn fende; zeile neu schreiben (satz) .
+
+zeile um eins nach rechts verschieben :
+ dyn fanfang DECR 1; dyn fende DECR 1;
+ fstelle := dyn fanfang; zeile neu schreiben (satz) .
+
+feinfuegen umschalten :
+ IF feinfuegen
+ THEN feinfuegen := FALSE
+ ELSE feinfuegen := TRUE; get cursor (x,y); out (dach);
+ outsubtext (satz, fstelle, flaenge);
+ cursor (x,y); pause (1);
+ feldrest loeschen (fstelle);
+ outsubtext (satz, fstelle, flaenge);
+ cursor (x,y)
+ FI;
+ return .
+
+ausfuegen :
+ IF flaenge < dyn fanfang OR fstelle > flaenge
+ THEN IF fstelle = flaenge + 1 AND fstelle > dyn fanfang
+ THEN fstelle := flaenge; out (left)
+ ELSE out (bell);
+ LEAVE ausfuegen
+ FI
+ FI;
+ ausfuegeoperation; delete char (satz, fstelle);
+ flaenge := min (dyn fende, LENGTH satz) .
+
+ausfuegeoperation :
+ get cursor (x,y); outsubtext (satz, fstelle+1, flaenge+1);
+ out (blank); cursor (x,y) .
+
+zum linken frand :
+ IF fstelle > fanfang
+ THEN get cursor (x,y); cursor (1+frand, y);
+ IF dyn fanfang = fanfang
+ THEN fstelle := fanfang
+ ELSE verschieben an linken frand
+ FI
+ FI .
+
+zum rechten frand :
+ fj := min (dyn fende, limit); get cursor (x,y);
+ IF LENGTH satz > fj
+ THEN IF fstelle >= LENGTH satz
+ THEN out (bell)
+ ELIF LENGTH satz > dyn fende
+ THEN verschieben an rechten frand
+ ELSE cursor (x + LENGTH satz - fstelle, y);
+ fstelle := LENGTH satz
+ FI
+ ELIF fstelle < fj
+ THEN cursor (x + fj-fstelle, y); fstelle := fj
+ FI .
+
+verschieben an linken frand :
+ dyn fanfang := fanfang; dyn fende := fende;
+ fstelle := fanfang; zeile neu schreiben (satz).
+
+verschieben an rechten frand :
+ (dyn fende - fstelle) TIMESOUT right;
+ dyn fanfang INCR (LENGTH satz - dyn fende); dyn fende := LENGTH satz;
+ fstelle := dyn fende; zeile neu schreiben (satz).
+
+nach tabulator :
+ fj := pos (tabulator, "^", fstelle+1);
+ IF fj = 0
+ THEN IF (satz SUB fstelle) = blank AND fstelle = fanfang
+ THEN IF satz = blank
+ THEN fstelle INCR 1; out (right)
+ ELSE out (blank left); feld einruecken (satz);
+ FI;
+ LEAVE nach tabulator
+ ELIF flaenge < dyn fende AND fstelle <= flaenge
+ THEN fj := flaenge + 1
+ FI
+ ELSE dezimalen := 1
+ FI;
+ IF fj > 0 AND fj <= dyn fende
+ THEN outsubtext (satz, fstelle, fj-1); fstelle := fj
+ ELSE (fstelle-dyn fanfang) TIMESOUT left;
+ fstelle := dyn fanfang; insert char (kommando, down, 1)
+ FI .
+
+tabulator setzen :
+ IF (tabulator SUB fstelle) = "^"
+ THEN fzeichen := right
+ ELSE fzeichen := "^"
+ FI;
+ WHILE fstelle > LENGTH tabulator
+ REP tabulator CAT right PER;
+ replace (tabulator, fstelle, fzeichen);
+ insert char (kommando, tab, 1);
+ insert char (kommando, hop, 1);
+ inkompetent := TRUE .
+
+zeile loeschen :
+ IF fstelle = 1
+ THEN satz := ""; feldrest loeschen (fstelle); hop return
+ ELIF fstelle <= flaenge
+ THEN REP delete char (satz, LENGTH satz)
+ UNTIL fstelle > LENGTH satz
+ PER;
+ flaenge := fstelle - 1; feldrest loeschen (fstelle)
+ ELSE hop return
+ FI .
+
+(*********************** s c h r e i b e d i t o r ***********************)
+
+schreibeditor :
+ REP getchar (fzeichen);
+ IF fzeichen <= hoechstes steuerzeichen THEN LEAVE schreibeditor
+ ELIF separator bedingung THEN LEAVE schreibeditor
+ ELSE f o r t s c h r e i b e n FI
+ PER .
+
+separatorbedingung :
+ IF blankseparator
+ THEN IF flaenge + 2 <= fstelle
+ THEN insert char (kommando, fzeichen, 1);
+ fzeichen := blank
+ FI
+ FI;
+ fzeichen = separator .
+
+fortschreiben :
+ IF dezimalen > 0 THEN dezimaltabulator FI;
+ out (fzeichen);
+ IF fstelle > flaenge
+ THEN anhaengen
+ ELIF dezimalen = 0 AND feinfuegen
+ THEN insert char (satz, fzeichen, fstelle)
+ ELSE replace (satz, fstelle, fzeichen)
+ FI;
+ flaenge := min (dyn fende, LENGTH satz);
+ fstelle INCR 1;
+ IF feinfuegen AND dezimalen = 0 AND fstelle <= flaenge
+ THEN zeilenrest neu schreiben
+ FI;
+ IF fstelle > dyn fende
+ OR fstelle > limit AND (wortweise OR fstelle > flaenge)
+ THEN LEAVE schreibeditor
+ FI .
+
+zeilenrest neu schreiben :
+ get cursor (x,y); outsubtext (satz, fstelle, flaenge); cursor (x,y) .
+
+dezimaltabulator :
+ IF fzeichen < "0" OR fzeichen > "9"
+ THEN dezimalen := 0
+ ELIF dezimalen = 1
+ THEN IF (satz SUB fstelle) = blank OR fstelle > flaenge
+ THEN dezimalen := 2
+ ELSE dezimalen := 0
+ FI
+ ELIF (satz SUB fstelle-dezimalen) = blank
+ THEN replace (satz, fstelle-dezimalen,
+ subtext (satz, fstelle-dezimalen+1, fstelle-1)) ;
+ dezimalen TIMESOUT left;
+ outsubtext (satz, fstelle-dezimalen, fstelle-2);
+ dezimalen INCR 1; fstelle DECR 1
+ ELSE dezimalen := 0
+ FI .
+
+anhaengen :
+ FOR fj FROM flaenge+2 UPTO fstelle
+ REP satz CAT blank PER;
+ satz CAT fzeichen .
+
+
+(************************** m a r k e d i t o r **************************)
+
+markeditor :
+ getchar (fzeichen);
+ SELECT pos (hop esc right left tab down cr, fzeichen) OF
+ CASE 1 : getchar (fzeichen);
+ IF fzeichen = right THEN markierung maximal
+ ELIF fzeichen = left THEN markierung minimal
+ ELSE hop return
+ FI
+ CASE 2 : escape aktion
+ CASE 3 : markierung verlaengern
+ CASE 4 : markierung verkuerzen
+ CASE 5 : markierung bis tab verlaengern
+ CASE 6,7 : zeilenrest markieren
+ OTHERWISE IF fzeichen <= hoechstes steuerzeichen
+ THEN return
+ ELSE out (bell)
+ FI
+ END SELECT .
+
+markierung verlaengern :
+ IF fstelle <= flaenge
+ THEN out (satz SUB fstelle, end mark left); fstelle INCR 1
+ ELSE return
+ FI .
+
+markierung maximal :
+ IF fstelle <= flaenge
+ THEN outsubtext (satz, fstelle, flaenge); out (end mark left);
+ fstelle := flaenge + 1
+ FI .
+
+zeilenrest markieren :
+ IF fstelle <= flaenge
+ THEN outsubtext (satz, fstelle, flaenge);
+ out (end mark left);
+ (flaenge-fstelle+2) TIMESOUT left
+ FI;
+ return .
+
+markierung verkuerzen :
+ IF fstelle > fmarke
+ THEN fstelle DECR 1;
+ out (left end mark, satz SUBB fstelle, left left)
+ ELSE out (bell)
+ FI .
+
+markierung minimal :
+ IF fstelle > fmarke
+ THEN (fstelle-fmarke) TIMESOUT left; out (end mark);
+ outsubtext (satz, fmarke, fstelle-1);
+ (fstelle-fmarke+1) TIMESOUT left; fstelle := fmarke
+ FI .
+
+markierung bis tab verlaengern :
+ fj := pos (tabulator, "^", fstelle + 1);
+ IF fj = 0
+ THEN fj := flaenge - fstelle + 1; IF fj <= 0 THEN return FI
+ ELSE fj DECR fstelle
+ FI;
+ IF fj > 0
+ THEN outsubtext (satz, fstelle, min (fstelle+fj-1, flaenge));
+ out (end mark left)
+ FI;
+ fstelle INCR fj;
+ IF fstelle > (dyn fende+1) THEN return FI .
+
+
+(******************* allgemein verwendete refinements *********************)
+
+return :
+ insert char (kommando, fzeichen, 1);
+ inkompetent := TRUE .
+
+hop return :
+ return; insert char (kommando, hop, 1) .
+
+escape aktion :
+ getchar (fzeichen); return;
+ insert char (kommando, escape, 1);
+ insert char (fzeichen, escape, 1) .
+
+END PROC feldeditor;
+
+END PACKET feldeditor;
|