path: root/dialog/ls-DIALOG 2

(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                     ls-DIALOG 2                     ** 
          **                                                     ** 
          **                     Version 1.2                     ** 
          **                                                     ** 
          **                  (Stand: 04.11.88)                  ** 
          **                                                     ** 
          **                                                     ** 
          **         Autor: Wolfgang Weber, Bielefeld            ** 
          **                                                     ** 
          **                                                     ** 
          ** Copyright (C) 1987, 1988 Eva Latta-Weber, Bielefeld ** 
          **                                                     ** 
          ** Copyright (C) 1988 ERGOS GmbH, Siegburg             ** 
          **                                                     ** 
          ********************************************************* 
          ********************************************************* 
 
                                                                           *) 
PACKET ls dialog 2  DEFINES                  
       some,
       one,
       infix namen,
       ohne praefix,
       not empty:
LET maxentries           = 200;
LET zeichenstring                           =  ""1""27""3""10""13""12"xo?",
    oben unten return rubout kreuz kringel  =  ""3""10""13""12"xo",
    q eins neun h                           =  "q19h";
LET zurueck    =   ""8"",
    piep       =   ""7"";
LET hop        =  1,
    esc        =  2,
    oben       =  3,
    unten      =  4,
    return     =  5,
    rubout     =  6,

    kreuz      =  7,
    kringel    =  8,
    frage      =  9;
LET punkt      =  ".",
    gleich     =  "=",
    blank      =  " ";
INT  VAR x,
         y,
         xsize,
         ysize,
         maxeintraege,
         anzahl,
         erste auswahlzeile,
         virtueller cursor,
         reeller cursor;
TEXT VAR kennzeile 1,
         kennzeile 2,
         registrierkette :: "";
BOOL VAR abbruch,
         auswahlende;
BOUND ROW max entries TEXT VAR eintrag;
ROW 2 TEXT CONST fehlermeldung :: ROW 2 TEXT : (

  "Unzulässige Cursorwerte bei der Auswahl",
  "Fenster für Auswahl zu klein (x < 56 / y < 15)");
ROW 24 TEXT CONST hinweis :: ROW 24 TEXT : (
  " Bitte warten... Ich sortiere und räume auf!",
  " Info: <?>  Fertig: <ESC><q>  Abbrechen: <ESC><h>",
  " Zum Weitermachen bitte irgendeine Taste tippen!",
  "Weitere Dateien!",
  "INFORMATIONEN: Auswahl  mehrerer  Dateien",
  "INFORMATIONEN: Auswahl  einer Datei",
  "                       "15"Positionierungen: "14"",
  "  hoch               : zum vorausgehenden Namen",

  "  runter             : zum folgenden   Namen",
  "  HOP hoch           : auf den ersten  Namen der Seite",  (***********)
  "  HOP runter         : auf den letzten Namen der Seite",  (*  bitte  *)
  "  ESC 1              : auf den ersten  Namen der Liste",  (*  diese  *)
  "  ESC 9              : auf den letzten Namen der Liste",  (*  Länge  *)
  "                       "15"Auswahl treffen: "14"",        (*  nicht  *)
  "  RETURN     / x     : diesen Namen ankreuzen ",          (*  über-  *)

  "  RUBOUT     / o     : Kreuz vor dem Namen loeschen",     (*  schrei-*)
  "  HOP RETURN / HOP x : alle folgende Namen ankreuzen",    (*  ten!   *)
  "  HOP RUBOUT / HOP o : alle folgende Kreuze loeschen",    (***********)
  "                       "15"Auswahl verlassen: "14"",
  "  ESC q              : Auswahl verlassen",
  "  ESC h              : Auswahl abbrechen",
  "  Auswahl   m e h r e r e r   Dateien durch Ankreuzen",
  "  Auswahl   e i n e r   Datei durch Ankreuzen",
  " Bitte warten... Ich breche die Auswahl ab!"

  );
THESAURUS PROC auswahl (THESAURUS CONST t,
                        BOOL CONST mehrere moeglich,
                        TEXT CONST t1, t2):
  werte initialisieren;
  namen besorgen;
  bildschirm aufbauen;
  auswaehlen lassen;
  abgang vorbereiten.
  werte initialisieren:
    THESAURUS VAR ausgabe :: empty thesaurus;
    DATASPACE VAR ds      := nilspace;
    eintrag               := ds;
    kennzeile 1           := t1;
    kennzeile 2           := t2;
    abbruch               := FALSE;

    erste auswahlzeile    := y + 7;
    anzahl                := 0;
    maxeintraege          := ysize - 11;
    virtueller cursor     := 1;
    reeller cursor        := 1.
  namen besorgen:
    fische die namen aus dem thesaurus;
    IF kein eintrag vorhanden
       THEN LEAVE auswahl WITH ausgabe
    FI.
  bildschirm aufbauen:
    schreibe kopfzeile;
    gib hinweis aus (kennzeile 1, kennzeile 2);
    gib erklaerungszeile aus (mehrere moeglich);
    baue bildschirm auf (1);
    footnote (x, y, xsize, ysize, hinweis [2]);

    schreibe fusszeile;
    reellen cursor setzen .
  schreibe kopfzeile:
    cursor (x, y);
    out(ecke oben links);
    (xsize - 2) TIMESOUT waagerecht;
    out(ecke oben rechts).
  schreibe fusszeile:
    cursor (x, y + ysize - 1);
    out (ecke unten links);
    (xsize - 2) TIMESOUT waagerecht;
    out (ecke unten rechts).
  auswaehlen lassen:
    kreuze an (mehrere moeglich).
  abgang vorbereiten:
    IF abbruch
       THEN change footnote (x, y, xsize, ysize, hinweis [24])

       ELSE change footnote (x, y, xsize, ysize, hinweis [ 1])
    FI;
    cursor (x + 1, y + ysize - 1);
    ausgabe erzeugen;
    forget (ds);
    ausgabe.
  fische die namen aus dem thesaurus:
    INT VAR zeiger;
    FOR zeiger FROM 1 UPTO highest entry (t) REP
      IF name (t, zeiger) <> ""
         THEN anzahl INCR 1;
              eintrag [anzahl] := name (t, zeiger)
      FI
    PER.
  kein eintrag vorhanden:
    anzahl = 0.
  ausgabe erzeugen:
    TEXT VAR nummer;
    WHILE registrierkette <> "" REP

      nummer          := subtext (registrierkette, 1, 3);
      registrierkette := subtext (registrierkette, 5);
      insert (ausgabe, eintrag [ int (nummer)])
    PER.
END PROC auswahl;
PROC reellen cursor setzen:
  cursor (x + 1, erste auswahlzeile + reeller cursor - 1);
  out (marke (virtueller cursor, TRUE) + (8 * zurueck))
END PROC reellen cursor setzen;
PROC baue bildschirm auf (INT CONST anfang):
  gib kopfzeile aus;
  gib namenstabelle aus;
  gib fusszeile aus;
  loesche ggf restbereich.

  gib kopfzeile aus:
    cursor (x, erste auswahlzeile - 1); out (senkrecht);
    IF reeller cursor = virtueller cursor
       THEN (xsize - 2) TIMESOUT punkt
       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
            out (invers (hinweis [4]))
    FI;
    out (senkrecht);
    line.
  gib namenstabelle aus:
    INT VAR zeiger, zaehler :: -1;
    FOR zeiger FROM anfang UPTO grenze REP
      zaehler INCR 1;
      cursor (x, erste auswahlzeile + zaehler);
      out (senkrecht); out (marke (zeiger, FALSE));

      outtext (subtext (eintrag [zeiger], 1, xsize - 10), 1, xsize - 10);
      out (senkrecht);
    PER.
  gib fusszeile aus:
    cursor (x, erste auswahlzeile + zaehler + 1);
    out (senkrecht);
    IF NOT ((virtueller cursor + maxeintraege - reeller cursor) < anzahl)
       THEN (xsize - 2) TIMESOUT punkt
       ELSE (xsize - length (hinweis [4]) - 5) TIMESOUT punkt;
            out (invers (hinweis [4]))
    FI;
    out (senkrecht).
  loesche ggf restbereich:
    IF zaehler + 1 < maxeintraege

       THEN loesche bildschirmrest
    FI.
  loesche bildschirmrest:
    FOR zeiger FROM restanfang UPTO restende REP
      cursor (x, zeiger); out (senkrecht);
                          (xsize - 2) TIMESOUT blank;
                          out (senkrecht)
    PER.
  restanfang:
    erste auswahlzeile + zaehler + 2.
  restende:
    erste auswahlzeile + maxeintraege.
  grenze:
    min (anzahl, anfang + max eintraege - 1).
END PROC baue bildschirm auf;
TEXT PROC marke (INT CONST zeiger, BOOL CONST mit cursor):

  INT VAR platz := nr (zeiger);
  IF platz = 0
     THEN leer
     ELSE mit zahl
  FI.
  mit zahl:
    IF mit cursor
       THEN "==>" + (3 - length (text (platz))) * blank + text (platz) + "x "
       ELSE "   " + (3 - length (text (platz))) * blank + text (platz) + "x "
    FI.
  leer:
    IF mit cursor
       THEN "==>   o "
       ELSE "      o "
    FI.
END PROC marke;
INT PROC nr (INT CONST zeiger):
  IF pos (registrierkette, textstring (zeiger)) = 0
     THEN 0
     ELSE (pos (registrierkette, textstring (zeiger)) DIV 4) + 1

  FI
END PROC nr;
TEXT PROC textstring (INT CONST nr):
  text (nr, 3) + "!"
END PROC textstring;
PROC info (BOOL CONST mehrere):
  notiere hinweisueberschrift;
  notiere positionierhinweise;
  IF noch platz vorhanden
     THEN  notiere auswahlmoeglichkeiten auf alter seite
     ELSE  wechsle auf naechste seite;
           notiere hinweisueberschrift;
           notiere auswahlmoeglichtkeiten auf neuer seite
  FI;
  stelle alten bildschirmzustand wieder her.
  notiere hinweisueberschrift:

    cursor (x + 1, y +  1);
    IF mehrere
       THEN out (center(xsize - 2, invers (hinweis [5])))
       ELSE out (center(xsize - 2, invers (hinweis [6])))
    FI;
    cursor (x + 1, y +  2); out ("", xsize - 2).
  notiere positionierhinweise:
    cursor (x + 1, y +  3); out (hinweis [ 7], xsize - 2);
    cursor (x + 1, y +  4); out (hinweis [ 8], xsize - 2);
    cursor (x + 1, y +  5); out (hinweis [ 9], xsize - 2);
    cursor (x + 1, y +  6); out (hinweis [10], xsize - 2);
    cursor (x + 1, y +  7); out (hinweis [11], xsize - 2);

    cursor (x + 1, y +  8); out (hinweis [12], xsize - 2);
    cursor (x + 1, y +  9); out (hinweis [13], xsize - 2).
  notiere auswahlmoeglichkeiten auf alter seite:
    cursor (x + 1, y + 10); out ("", xsize - 2);
    cursor (x + 1, y + 11); out (hinweis [14], xsize - 2);
    cursor (x + 1, y + 12); out (hinweis [15], xsize - 2);
    IF mehrere
       THEN  gib alle auswahlmoeglichkeiten auf der alten seite an
       ELSE  gib eine auswahlmoeglichkeit   auf der alten seite an
    FI;

    notiere verlassmoeglichkeiten auf der alten seite;
    loesche die restlichen zeilen;
    change footnote (x, y, xsize, ysize, hinweis [3]);
    cursor in ruhestellung;
    clear buffer.
  gib alle auswahlmoeglichkeiten auf der alten seite an:
    cursor (x + 1, y + 13); out (hinweis [16], xsize - 2);
    cursor (x + 1, y + 14); out (hinweis [17], xsize - 2);
    cursor (x + 1, y + 15); out (hinweis [18], xsize - 2).
  gib eine auswahlmoeglichkeit auf der alten seite an:
    cursor (x + 1, y + 13); out ("", xsize - 2);

    cursor (x + 1, y + 14); out ("", xsize - 2);
    cursor (x + 1, y + 15); out ("", xsize - 2).
  notiere verlassmoeglichkeiten auf der alten seite:
    cursor (x + 1, y + 16); out ("", xsize - 2);
    cursor (x + 1, y + 17); out (hinweis [19], xsize - 2);
    cursor (x + 1, y + 18); out (hinweis [20], xsize - 2);
    cursor (x + 1, y + 19); out (hinweis [21], xsize - 2).
  loesche die restlichen zeilen:
    IF ysize = 24
       THEN cursor (x + 1, y + 20); out ("", xsize - 2)
    FI.

  wechsle auf naechste seite:
    loesche seitenrest;
    change footnote (x, y, xsize, ysize, hinweis [3]);
    cursor in ruhestellung;
    clear buffer;
    pause.
  loesche seitenrest:
    INT VAR zaehler;
    FOR zaehler FROM 10 UPTO ysize - 4 REP
      cursor (x + 1, y + zaehler); out ("", xsize - 2)
    PER.
  notiere auswahlmoeglichtkeiten auf neuer seite:
    cursor (x + 1, y +  3); out (hinweis [14], xsize - 2);
    cursor (x + 1, y +  4); out (hinweis [15], xsize - 2);
    IF mehrere

       THEN  gib alle auswahlmoeglichkeiten auf der neuen seite an
       ELSE  gib eine auswahlmoeglichkeit   auf der neuen seite an
    FI;
    notiere verlassmoeglichkeiten auf der neuen seite.
  gib alle auswahlmoeglichkeiten auf der neuen seite an:
    cursor (x + 1, y +  5); out (hinweis [16], xsize - 2);
    cursor (x + 1, y +  6); out (hinweis [17], xsize - 2);
    cursor (x + 1, y +  7); out (hinweis [18], xsize - 2).
  gib eine auswahlmoeglichkeit auf der neuen seite an:
    cursor (x + 1, y +  5); out ("", xsize - 2);

    cursor (x + 1, y +  6); out ("", xsize - 2);
    cursor (x + 1, y +  7); out ("", xsize - 2).
  notiere verlassmoeglichkeiten auf der neuen seite:
    cursor (x + 1, y +  8); out ("", xsize - 2);
    cursor (x + 1, y +  9); out (hinweis [19], xsize - 2);
    cursor (x + 1, y + 10); out (hinweis [20], xsize - 2);
    cursor (x + 1, y + 11); out (hinweis [21], xsize - 2);
    cursor in ruhestellung.
  cursor in ruhestellung:
    cursor (x + 1, y + ysize - 2).
  stelle alten bildschirmzustand wieder her:

    clear buffer;
    pause;
    gib hinweis aus (kennzeile 1, kennzeile 2);
    gib erklaerungszeile aus (mehrere);
    virtueller cursor := 1;
    reeller    cursor := 1;
    baue bildschirm auf (1);
    change footnote (x, y, xsize, ysize, hinweis [2]);
    reellen cursor setzen.
  noch platz vorhanden:
    (ysize - 4) > 18.
END PROC info;
PROC kreuze an (BOOL CONST mehrere):
  auswahlende := FALSE;
  REP
    zeichen lesen; zeichen interpretieren
  UNTIL auswahlende PER.
  zeichen lesen:

    TEXT VAR zeichen;
    getchar (zeichen).
  zeichen interpretieren:
    SELECT pos (zeichenstring, zeichen) OF
      CASE hop      : hop kommando verarbeiten (mehrere)
      CASE esc      : esc kommando verarbeiten
      CASE oben     : nach oben
      CASE unten    : nach unten
      CASE kreuz    : ankreuzen; evtl aufhoeren
      CASE return   : ankreuzen weiter; evtl aufhoeren
      CASE rubout   : auskreuzen weiter
      CASE kringel  : auskreuzen
      CASE frage    : info (mehrere)

      OTHERWISE       out (piep)
    END SELECT.
  evtl aufhoeren:
    IF NOT mehrere
      THEN LEAVE kreuze an
    FI.
END PROC kreuze an;
PROC hop kommando verarbeiten (BOOL CONST mehrere):
  zweites zeichen lesen;
  zeichen interpretieren.
  zweites zeichen lesen:
    TEXT VAR zweites zeichen;
    getchar(zweites zeichen).
  zeichen interpretieren:
    SELECT pos (oben unten return rubout kreuz kringel, zweites zeichen) OF
      CASE 1    : hop nach oben
      CASE 2    : hop nach unten

      CASE 3, 5 : IF mehrere THEN alle darunter ankreuzen FI
      CASE 4, 6 : IF mehrere THEN alle darunter loeschen  FI
      OTHERWISE   out (piep)
    END SELECT.
  alle darunter ankreuzen:
    INT VAR i;
    FOR i FROM virtueller cursor UPTO anzahl REP
      IF nr (i) = 0
         THEN ankreuzen
      FI
    PER;
    bild aktualisieren ;
    reellen cursor setzen .
  ankreuzen:
    registrierkette CAT textstring (i).
  alle darunter loeschen:
    INT VAR j, position;
    FOR j FROM virtueller cursor UPTO anzahl REP

      position := nr (j);
      IF position > 0
         THEN rausschmeissen;
      FI
    PER;
    bild aktualisieren;
    reellen cursor setzen.
  rausschmeissen:
   registrierkette := subtext (registrierkette, 1, (4 * position) - 4) +
                      subtext (registrierkette, (4 * position) + 1).
  hop nach oben:
    IF   ganz oben
         THEN out (piep)
    ELIF oben auf der seite
         THEN raufblaettern
         ELSE top of page
    FI.
  ganz oben:
    virtueller cursor = 1.

  oben auf der seite:
    reeller cursor = 1.
  raufblaettern:
    virtueller cursor DECR max eintraege;
    virtueller cursor := max (virtueller cursor, 1);
    baue bildschirm auf (virtueller cursor);
    reellen cursor setzen.
  top of page:
    loesche marke;
    virtueller cursor DECR (reeller cursor - 1);
    reeller cursor := 1;
    reellen cursor setzen.
  hop nach unten:
    IF   ganz unten
         THEN out (piep)
    ELIF unten auf der seite
         THEN runterblaettern

         ELSE bottom of page
    FI.
  ganz unten:
    virtueller cursor = anzahl.
  unten auf der seite:
    reeller cursor > max eintraege - 1.
  runterblaettern:
    INT VAR alter virtueller cursor :: virtueller cursor;
    virtueller cursor INCR max eintraege;
    virtueller cursor := min (virtueller cursor, anzahl);
    reeller cursor    := virtueller cursor - alter virtueller cursor;
    baue bildschirm auf (alter virtueller cursor + 1);
    reellen cursor setzen.
  bottom of page:

    loesche marke;
    alter virtueller cursor := virtueller cursor;
    virtueller cursor INCR (max eintraege - reeller cursor);
    virtueller cursor := min (anzahl, virtueller cursor);
    reeller cursor INCR (virtueller cursor - alter virtueller cursor);
    reellen cursor setzen.
END PROC hop kommando verarbeiten;
PROC esc kommando verarbeiten:
  TEXT VAR zweites zeichen;
  getchar (zweites zeichen);
  SELECT pos (q eins neun h, zweites zeichen) OF
    CASE 1 :  auswahlende     := TRUE

    CASE 2 :  zeige anfang
    CASE 3 :  zeige ende
    CASE 4 :  abbruch         := TRUE;
              auswahlende     := TRUE;
              registrierkette := ""
    OTHERWISE out (piep)
  END SELECT.
  zeige anfang:
    IF   virtueller cursor = 1
         THEN out (piep)
    ELIF virtueller cursor = reeller cursor
         THEN loesche marke;
              virtueller cursor := 1;
              reeller cursor    := 1;
              reellen cursor setzen
         ELSE virtueller cursor := 1;

              reeller cursor    := 1;
              baue bildschirm auf (1);
              reellen cursor setzen
    FI.
  zeige ende:
    IF   virtueller cursor = anzahl
         THEN out (piep)
    ELIF ende auf bildschirm
         THEN loesche marke;
              reeller cursor INCR (anzahl - virtueller cursor);
              virtueller cursor := anzahl;
              reellen cursor setzen
         ELSE virtueller cursor := anzahl;
              reeller cursor    := max eintraege;

              baue bildschirm auf (anzahl - (max eintraege - 1));
              reellen cursor setzen
    FI.
  ende auf bildschirm:
    (reeller cursor + anzahl - virtueller cursor) < max eintraege + 1.
END PROC esc kommando verarbeiten;
PROC ankreuzen:
  INT VAR platz :: nr (virtueller cursor);
  IF platz <> 0
     THEN out (piep);
          LEAVE ankreuzen
  FI;
  registrierkette CAT textstring (virtueller cursor);
  reellen cursor setzen
END PROC ankreuzen;
PROC ankreuzen weiter:

  INT VAR platz :: nr (virtueller cursor);
  IF platz <> 0
     THEN out (piep);
          LEAVE ankreuzen weiter
  FI;
  registrierkette CAT textstring (virtueller cursor);
  IF virtueller cursor < anzahl
     THEN nach unten
  FI;
  IF virtueller cursor = anzahl
    THEN reellen cursor setzen
  FI
END PROC ankreuzen weiter;
PROC auskreuzen weiter:
  INT VAR position :: nr (virtueller cursor);
  IF position = 0
    THEN out (piep);
         LEAVE auskreuzen weiter
  FI;
  rausschmeissen;

  IF virtueller cursor < anzahl
     THEN nach unten
     ELSE loesche marke
  FI;
  bild aktualisieren;
  reellen cursor setzen.
  rausschmeissen:
    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
                       subtext (registrierkette, 4 * position + 1).
END PROC auskreuzen weiter;
PROC auskreuzen:
  INT VAR position :: nr (virtueller cursor);
  IF position = 0
    THEN out (piep);
         LEAVE auskreuzen
  FI;
  rausschmeissen;
  loesche marke;

  bild aktualisieren;
  reellen cursor setzen.
  rausschmeissen:
    registrierkette := subtext (registrierkette, 1, 4 * position - 4) +
                       subtext (registrierkette, 4 * position + 1).
END PROC auskreuzen;
PROC bild aktualisieren:
  INT VAR ob, un, i, zaehler :: -1;
  ob := virtueller cursor - reeller cursor + 1;
  un := min (ob + max eintraege - 1, anzahl);
  FOR i FROM ob UPTO un REP
  zaehler INCR 1;
  cursor (x + 1, erste auswahlzeile + zaehler);
  out (marke (i,FALSE)) PER

END PROC bild aktualisieren;
PROC nach oben:
  IF noch nicht oben       (*virtuell*)
     THEN gehe nach oben
     ELSE out (piep)
  FI.
  noch nicht oben:
    virtueller cursor > 1.
  gehe nach oben:
    IF reeller cursor = 1 THEN scroll down ELSE cursor up FI.
  scroll down:
    virtueller cursor DECR 1;
    baue bildschirm auf (virtueller cursor);
    reellen cursor setzen.
  cursor up:
    loesche marke;
    virtueller cursor DECR 1;
    reeller cursor DECR 1;
    reellen cursor setzen

END PROC nach oben;
PROC nach unten:
  IF noch nicht unten      (*virtuell*)
     THEN gehe nach unten
     ELSE out (piep)
  FI.
  noch nicht unten:
    virtueller cursor < anzahl.
  gehe nach unten:
    IF reeller cursor > max eintraege - 1 THEN scroll up ELSE cursor down FI.
  scroll up:
    virtueller cursor INCR 1;
    baue bildschirm auf (virtueller cursor - (max eintraege - 1));
    reellen cursor setzen.
  cursor down:
    loesche marke;
    virtueller cursor INCR 1;
    reeller cursor INCR 1;

    reellen cursor setzen
END PROC nach unten;
PROC loesche marke:
  out (marke (virtueller cursor, FALSE))
END PROC loesche marke;
PROC footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
  cursor (x, y + ysize - 3);
  out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts);
  change footnote (x, y, xsize, ysize, text)
END PROC footnote;
PROC change footnote (INT CONST x, y, xsize, ysize, TEXT CONST text):
  cursor (x, y + ysize - 2);
  out (senkrecht); outtext (text, 1, xsize - 2); out (senkrecht)

END PROC change footnote;
PROC gib hinweis aus (TEXT CONST t1, t2):
  cursor (x, y + 1); out (senkrecht);
                     out (center (xsize - 2, invers (t1)));
                     out (senkrecht);
  cursor (x, y + 2); out (senkrecht);
                     out ("", xsize - 2);
                     out (senkrecht);
  cursor (x, y + 3); out (senkrecht);
                     out (center (xsize - 2, t2));
                     out (senkrecht)
END PROC gib hinweis aus;
PROC gib erklaerungszeile aus (BOOL CONST mehrere):

  cursor (x, y + 4); out (senkrecht);
                     out ((xsize - 2) * gleich);
                     out (senkrecht);
  cursor (x, y + 5); out (senkrecht);
                     IF mehrere
                        THEN out (erklaerungszeile mehrere)
                        ELSE out (erklaerungszeile eine)
                     FI;
                     out (senkrecht).
  erklaerungszeile mehrere:
    invers (text 1 + (rest1 * blank)).
  erklaerungszeile eine:
    invers (text 2 + (rest2 * blank)).

  text1:
    hinweis [22].
  text2:
    hinweis [23].
  rest1:                                  (***************************)
    xsize - length (text1) - 5.           (* durch 'invers' wird ein *)
                                          (* Blank angehängt und zu- *)
  rest2:                                  (* sätzlich noch durch     *)
    xsize - length (text2) - 5.           (* 'relativcenter' - außer-*)
END PROC gib erklaerungszeile aus;        (* dem nimmt die Markierung*)
                                          (* selbst eine Position ein*)

                                          (***************************)
THESAURUS PROC infix namen (THESAURUS CONST t, TEXT CONST infix):
  THESAURUS VAR tt :: empty thesaurus;
  INT VAR i;
  FOR i FROM 1 UPTO highest entry (t) REP
    TEXT VAR eintrag :: name (t,i);
    IF eintrag enthaelt infix
       THEN insert (tt, eintrag)
    FI
  PER;
  tt.
  eintrag enthaelt infix:
    pos (eintrag, infix) <> 0
END PROC infix namen;
THESAURUS PROC infix namen (THESAURUS CONST t, INT CONST dateityp):

  THESAURUS VAR tt :: empty thesaurus;
  INT VAR i;
  FOR i FROM 1 UPTO highest entry (t) REP
    TEXT VAR eintrag :: name (t,i);
    IF eintrag enthaelt infix
       THEN insert (tt, eintrag)
    FI
  PER;
  tt.
  eintrag enthaelt infix:
    type (old (eintrag)) = dateityp.
END PROC infix namen;
THESAURUS PROC  infix namen (THESAURUS CONST t,
                             TEXT CONST infix 1, INT CONST dateityp):
  THESAURUS VAR tt :: empty thesaurus;
  INT VAR i;
  FOR i FROM 1 UPTO highest entry (t) REP

    TEXT VAR eintrag :: name (t,i);
    IF eintrag enthaelt infix
       THEN insert (tt, eintrag)
    FI
  PER;
  tt.
  eintrag enthaelt infix:
   (pos (eintrag, infix 1) <> 0) AND (type (old (eintrag)) = dateityp).
END PROC infix namen;
THESAURUS PROC  infix namen (THESAURUS CONST t,
                             TEXT CONST infix 1, infix 2):
  THESAURUS VAR tt :: empty thesaurus;
  INT VAR i;
  FOR i FROM 1 UPTO highest entry (t) REP
    TEXT VAR eintrag :: name (t,i);
    IF eintrag enthaelt infix

       THEN insert (tt, eintrag)
    FI
  PER;
  tt.
  eintrag enthaelt infix:
   (pos (eintrag, infix 1) <> 0) OR (pos (eintrag, infix 2) <> 0)
END PROC infix namen;
THESAURUS PROC infix namen (TEXT CONST infix):
  infix namen (ALL myself, infix)
END PROC infix namen;
THESAURUS PROC infix namen (TEXT CONST infix 1, infix 2):
  infix namen (ALL myself, infix 1, infix 2)
END PROC infix namen;
THESAURUS PROC ohne praefix (THESAURUS CONST thesaurus, TEXT CONST praefix):
  THESAURUS VAR t :: empty thesaurus;

  INT VAR zaehler;
  FOR zaehler FROM 1 UPTO highest entry (thesaurus) REP
    IF name (thesaurus, zaehler) <> ""
       AND pos (name (thesaurus, zaehler), praefix) = 1
       THEN insert (t, subtext (name (thesaurus, zaehler),
                                  length (praefix) + 1))
    FI;
  PER;
  t
END PROC ohne praefix;
BOOL PROC not empty (THESAURUS CONST t):
  INT VAR i;
  FOR i FROM 1 UPTO highest entry (t) REP
    IF name (t, i) <> ""
       THEN LEAVE not empty WITH TRUE

    FI
  PER;
  FALSE
END PROC not empty;
PROC untersuche bildschirmmasszahlen (TEXT CONST t1, t2):
  IF   unzulaessige cursorwerte
       THEN errorstop (fehlermeldung [1])
  ELIF fenster ist zu klein
       THEN errorstop (fehlermeldung [2])
  FI.
  unzulaessige cursorwerte:
    (x + xsize) > 80 COR (y + ysize) > 25 COR x < 1 COR y < 1
    COR xsize > 79 COR ysize > 24.
  fenster ist zu klein:
   (xsize) < 56 COR (ysize) < 15
   COR length (t1) > (xsize - 5) COR length (t2) > (xsize - 5).

END PROC untersuche bildschirmmasszahlen;
TEXT PROC ggf gekuerzter text (TEXT CONST text):
   IF length (text) > (xsize - 5)
      THEN subtext (text, 1, xsize - 7) + ".."
      ELSE text
   FI
END PROC ggf gekuerzter text;
THESAURUS PROC some (INT CONST spa, zei, breite, hoehe,
                     THESAURUS CONST t,
                     TEXT CONST t1, t2):
  TEXT VAR text 1, text 2;
  x := spa;
  y := zei;
  xsize := breite;
  ysize := hoehe;
  text 1 := ggf gekuerzter text (t1);

  text 2 := ggf gekuerzter text (t2);
  untersuche bildschirmmasszahlen (text 1, text 2);
  auswahl (t, TRUE, text 1, text 2)
END PROC some;
THESAURUS PROC some (INT CONST spa, zei,
                     THESAURUS CONST t,
                     TEXT CONST t1, t2):
  some (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)
END PROC some;
THESAURUS PROC some (THESAURUS CONST t,
                     TEXT CONST t1, t2):
  some (1, 1, 79, 24, t, t1, t2)
END PROC some;
TEXT PROC one (INT CONST spa, zei, breite, hoehe,

               THESAURUS CONST t,
               TEXT CONST t1, t2):
  TEXT VAR text 1, text 2;
  x := spa;
  y := zei;
  xsize := breite;
  ysize := hoehe;
  text 1 := ggf gekuerzter text (t1);
  text 2 := ggf gekuerzter text (t2);
  untersuche bildschirmmasszahlen (text 1, text 2);
  name (auswahl (t, FALSE, text 1, text 2), 1)
END PROC one;
TEXT PROC one (INT CONST spa, zei,
               THESAURUS CONST t,
               TEXT CONST t1, t2):
  one (spa, zei, 79 - spa + 1, 24 - zei + 1, t, t1, t2)

END PROC one;
TEXT PROC one  (THESAURUS CONST t, TEXT CONST t1, t2):
  one (1, 1, 79, 24, t, t1, t2)
END PROC one;
END PACKET ls dialog 2;