path: root/system/base/1.7.5/src/editor

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;