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;