path: root/dialog/ls-DIALOG 3

(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                     ls-DIALOG 3                     ** 
          **                                                     ** 
          **                     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 3  DEFINES
       WINDOW, :=, window,
       show, page, erase,
       line, remaining lines,
       cursor, get cursor,
       out frame, out menuframe,
       out, put, putline, editget,
       get, getline, yes, no,
       edit, center, stop,
       area, areax, areay,
       areaxsize, areaysize:
LET piep          =      ""7"",
    cr            =     ""13"";
LET janeinkette   =   "jJyYnN",
    blank         =        " ",
    niltext       =         "";
TYPE WINDOW = STRUCT (AREA fenster,

                      INT cspalte, czeile, belegbare zeilen,
                      BOOL fensterende erreicht);
ROW 3 TEXT CONST aussage :: ROW 3 TEXT : (
  " 'Window' ungültig!",
  " (j/n) ?",
  " Zum Weitermachen bitte irgendeine Taste tippen!"
  );
TEXT VAR number word, exit char;
OP := (WINDOW VAR links, WINDOW CONST rechts):
  CONCR (links) := CONCR (rechts)
END OP :=;
WINDOW PROC window (INT CONST x, y, xsize, ysize):
  WINDOW VAR w;
  fill (w.fenster, x, y, xsize, ysize);
  IF fenster ungueltig (w)

     THEN errorstop (aussage [1])
  FI;
  initialize (w);
  w
END PROC window;
PROC initialize (WINDOW VAR w):
  w.czeile               := 1;
  w.cspalte              := 1;
  w.fensterende erreicht := FALSE;
  w.belegbare zeilen     := areaysize (w.fenster)
END PROC initialize;
BOOL PROC fenster ungueltig (WINDOW CONST w):
  IF     areax     (w.fenster) <  1  COR areax     (w.fenster) > 79
     COR areay     (w.fenster) <  1  COR areay     (w.fenster) > 24
     COR areaxsize (w.fenster) <  6  COR areaysize (w.fenster) <  3

     COR areax (w.fenster) + areaxsize (w.fenster) > 80
     COR areay (w.fenster) + areaysize (w.fenster) > 25
     THEN TRUE
     ELSE FALSE
  FI.
END PROC fenster ungueltig;
PROC show (WINDOW VAR w):
  zeige rahmen;
  fenster putzen.
  zeige rahmen:
    out frame (w.fenster).
  fenster putzen:
    page (w).
END PROC show;
PROC page (WINDOW VAR w):
  initialize (w);
  page (w, FALSE)
END PROC page;
PROC page (WINDOW CONST w, BOOL CONST mit rahmen ):
  IF areax     (w) = 1  AND areay     (w) =  1 AND

     areaxsize (w) = 79 AND areaysize (w) = 24
     THEN page;
     ELSE loesche bereich
  FI.
  loesche bereich:
    IF mit rahmen
       THEN page (areax     (w) - 1, areay     (w) - 1,
                  areaxsize (w) + 2, areaysize (w) + 2)
       ELSE page (area (w))
    FI
END PROC page;
PROC erase (WINDOW VAR w):
  page (w, TRUE)
END PROC erase;
PROC line (WINDOW VAR w):
  w.cspalte := 1;
  IF w.czeile < w.belegbare zeilen
     THEN w.czeile INCR 1;
     ELSE w.czeile  :=  1;

          w.fensterende erreicht := TRUE
  FI;
  cursor (w, w.cspalte, w.czeile)
END PROC line;
PROC line (WINDOW VAR w, INT CONST anzahl):
  INT VAR i; FOR i FROM 1 UPTO anzahl REP line (w) PER
END PROC line;
INT PROC remaining lines (WINDOW CONST w):
  INT VAR spalte, zeile;
  get cursor (w, spalte, zeile);
  IF spalte = 0 OR zeile = 0
     THEN 0
     ELSE w.belegbare zeilen - w.czeile
  FI
END PROC remaining lines;
PROC cursor (WINDOW VAR w, INT CONST spalte, zeile):
  IF spalte < 1 OR zeile < 1 OR spalte > areaxsize (w) OR zeile > areaysize (w)

     THEN page (w);
     ELSE w.cspalte := spalte; w.czeile  := zeile;
  FI;
  cursor (w.fenster, w.cspalte, w.czeile)
END PROC cursor;
PROC get cursor (WINDOW CONST w, INT VAR spalte, zeile):
  IF (w.cspalte < 1) OR (w.cspalte > areaxsize (w.fenster))
                          OR
     (w.czeile  < 1) OR (w.czeile  > areaysize (w.fenster))
     THEN spalte := 0;         zeile := 0
     ELSE spalte := w.cspalte; zeile := w.czeile
  FI
END PROC get cursor;
PROC out (WINDOW VAR w, TEXT CONST text):

  INT VAR restlaenge;
  IF (w.cspalte >= 1) AND (w.cspalte <= areaxsize (w.fenster))
                           AND
     (w.czeile  >= 1) AND (w.czeile  <= w.belegbare zeilen)
     THEN putze ggf fenster;
          cursor (w.fenster, w.cspalte, w.czeile);
          outtext (text, 1, textende);
          setze fenstercursor neu;
          setze ausgabe ggf in naechster zeile fort
  FI.
  putze ggf fenster:
    IF w.fensterende erreicht
       THEN page (w);
            w.fensterende erreicht := FALSE

    FI.
  textende:
    restlaenge := areaxsize (w.fenster) - w.cspalte + 1;
    min (length (text), restlaenge).
  setze fenstercursor neu:
    IF length (text) >= restlaenge
       THEN w.cspalte  := 1;
            w.czeile INCR 1;
            schlage ggf neue seite auf
       ELSE w.cspalte INCR length (text)
    FI.
  schlage ggf neue seite auf:
    IF w.czeile > w.belegbare zeilen
       THEN page (w);
            w.czeile := 1
    FI.
  setze ausgabe ggf in naechster zeile fort:

    IF length (text) > restlaenge
       THEN out (w, subtext (text, restlaenge + 1))
    FI.
END PROC out;
PROC out frame (WINDOW VAR w):
  out frame (area (w))
END PROC out frame;
PROC out menuframe (WINDOW VAR w):
  out menu frame (area (w))
END PROC out menuframe;
PROC put (WINDOW VAR w, TEXT CONST word):
  out (w, word); out (w, blank)
END PROC put;
PROC put (WINDOW VAR w, INT CONST number):
  put (w, text (number))
END PROC put;
PROC put (WINDOW VAR w, REAL VAR number):
  put (w, text (number))

END PROC put;
PROC putline (WINDOW VAR w, TEXT CONST textline):
  out (w, textline); line (w)
END PROC putline;
PROC editget (WINDOW VAR w, TEXT VAR ausgabe,
              INT CONST max laenge, scroll,
              TEXT CONST sep, res, TEXT VAR exit char):
  INT VAR spalte, zeile;
  ggf zur naechsten zeile;
  get cursor (spalte, zeile); cursor on; cursor (spalte, zeile);
  editget (ausgabe, max laenge, min (scroll, restlaenge),
           sep, res, exitchar);
  get cursor (spalte, zeile); cursor off; cursor (spalte, zeile).

  ggf zur naechsten zeile:
    IF restlaenge < 5 THEN line (w) FI.
  restlaenge:
    areaxsize (w.fenster) - w.cspalte - 1.
END PROC editget;
PROC editget (WINDOW VAR w, TEXT VAR ausgabe):
   TEXT VAR dummy;
   editget (w, ausgabe, 79, 79, "", "", dummy)
END PROC editget;
PROC get (WINDOW VAR w, TEXT VAR word):
  INT VAR spa, zei;
  ggf zur naechsten zeile;
  get cursor (spa, zei); cursor on; cursor (spa, zei);
  REP
    word := "";
    editget (word, maxtextlength, restlaenge, " ", "", exit char);

    out (w, subtext (word, 1, restlaenge));
    IF compress (word) <> ""
       THEN echoe exit char (w)
    FI
  UNTIL word <> niltext AND word <> blank PER;
  get cursor (spa, zei); cursor off; cursor (spa, zei);
  delete leading blanks.
  ggf zur naechsten zeile:
    IF restlaenge < 5 THEN line (w) FI.
  restlaenge:
    areaxsize (w.fenster) - w.cspalte - 1.
  delete leading blanks:
    WHILE (word SUB 1) = blank REP word := subtext (word, 2) PER.
END PROC get;
PROC get (WINDOW VAR w, TEXT VAR word, TEXT CONST separator):

  INT VAR spa, zei;
  ggf zur naechsten zeile;
  get cursor (spa, zei); cursor on; cursor (spa, zei);
  REP
    word := "";
    editget (word, maxtextlength, restlaenge, separator, "", exit char);
    out (w, subtext (word, 1, restlaenge));
    echoe exit char (w);
  UNTIL word <> niltext AND word <> blank PER;
  get cursor (spa, zei); cursor off; cursor (spa, zei).
  ggf zur naechsten zeile:
    IF restlaenge < 5 THEN line (w) FI.
  restlaenge:
    areaxsize (w.fenster) - w.cspalte - 1.

END PROC get;
PROC get (WINDOW VAR w, TEXT VAR word, INT CONST length):
  INT VAR spa, zei;
  ggf zur naechsten zeile;
  get cursor (spa, zei); cursor on; cursor (spa, zei);
  REP
    word := "";
    editget (word, maxtextlength, laenge, "", "", exit char);
    out (w, subtext (word, 1, laenge));
    echoe exit char (w)
  UNTIL word <> niltext AND word <> blank PER;
  get cursor (spa, zei); cursor off; cursor (spa, zei).
  ggf zur naechsten zeile:
    IF restlaenge < 5 THEN line (w) FI.

  restlaenge:
    areaxsize (w.fenster) - w.cspalte - 1.
  laenge:
    min (length, restlaenge).
END PROC get;
PROC get (WINDOW VAR w, INT VAR number):
  get (w, number word);
  number := int (number word)
END PROC get;
PROC get (WINDOW VAR w, REAL VAR number):
  get  (w, number word);
  number := real (number word)
END PROC get;
PROC getline (WINDOW VAR w, TEXT VAR textline):
  INT VAR spa, zei;
  ggf zur naechsten zeile;
  get cursor (spa, zei); cursor on; cursor (spa, zei);
  REP

    textline := "";
    editget (textline, maxtextlength, restlaenge, "", "", exit char);
    out (w, subtext (word, 1, restlaenge));
    echoe exit char (w);
  UNTIL textline <> niltext AND textline <> blank PER;
  get cursor (spa, zei); cursor off; cursor (spa, zei).
  ggf zur naechsten zeile:
    IF restlaenge < 5 THEN line (w) FI.
  restlaenge:
    areaxsize (w.fenster) - w.cspalte - 1.
END PROC getline;
PROC echoe exit char (WINDOW VAR fenster):
  IF exit char = cr
     THEN line (fenster)

     ELSE out (fenster, exit char)
  FI
END PROC echoe exit char;
TEXT PROC center (WINDOW CONST w, TEXT CONST text):
  IF length (text) >= areaxsize (w.fenster)
     THEN subtext (text, 1, areaxsize (w.fenster))
     ELSE center  (areaxsize (w.fenster), text)
  FI
END PROC center;
BOOL PROC yes (WINDOW VAR w, TEXT CONST frage):
  TEXT VAR   zeichen, interne frage :: frage;
  interne frage CAT aussage [2];
  wechsel ggf auf neue seite;
  out (w, interne frage);
  hole eingabezeichen;

  werte zeichen aus.
  wechsel ggf auf neue seite:
    IF remaining lines (w) < 1
       THEN page (w)
    FI.
  hole eingabezeichen:
    cursor on; clear buffer;
    REP
      inchar (zeichen);
      piepse ggf
    UNTIL pos (janeinkette, zeichen) > 0 PER;
    out (w, blank + zeichen);
    cursor off; line (w).
  piepse ggf:
    IF pos (janeinkette, zeichen) = 0 THEN out (piep) FI.
  werte zeichen aus:
    IF pos (janeinkette, zeichen) < 5
       THEN TRUE
       ELSE FALSE
    FI.

END PROC yes;
PROC edit (WINDOW VAR w, FILE VAR f):
  out frame (w.fenster);
  loesche rechte spalten (w);
  cursor on;
  edit (f, areax     (w.fenster),     areay     (w.fenster),
           areaxsize (w.fenster) - 1, areaysize (w.fenster));
  cursor off
END PROC edit;
PROC edit (WINDOW VAR w, TEXT CONST dateiname):
  FILE VAR f :: sequential file (modify, dateiname);
  to line (f, 1);
  edit (w, f)
END PROC edit;
PROC show (WINDOW VAR w, FILE VAR f):
  out frame (w.fenster);
  loesche rechte spalten (w);

  open editor (groesster editor + 1, f, FALSE,
               areax     (w.fenster),     areay     (w.fenster),
               areaxsize (w.fenster) - 1, areaysize (w.fenster));
  cursor on;
  edit (groesster editor, "eqvw19dpgn"9"",
                          PROC (TEXT CONST) std kommando interpreter);
  cursor off
END PROC show;
PROC show (WINDOW VAR w, TEXT CONST dateiname):
  FILE VAR f :: sequential file (modify, dateiname);
  to line (f, 1);
  show (w, f)
END PROC show;
PROC loesche rechte spalten (WINDOW VAR w):

  INT VAR i;
  FOR i FROM 1 UPTO areaysize (w.fenster) REP
    cursor (w, areaxsize (w.fenster) - 2, i); out (3 * blank)
  PER
END PROC loesche rechte spalten;
BOOL PROC no (WINDOW VAR w, TEXT CONST frage):
  NOT yes (w, frage)
END PROC no;
PROC stop (WINDOW VAR w):
  stop (w, 2)
END PROC stop;
PROC stop (WINDOW VAR w, INT CONST zeilenzahl):
  INT VAR i; FOR i FROM 1 UPTO zeilenzahl REP line (w) PER;
  out (w, aussage [3]);
  pause
END PROC stop;
AREA PROC area (WINDOW CONST w):

  w.fenster
END PROC area;
INT PROC areax (WINDOW CONST w):
  areax (w.fenster)
END PROC areax;
INT PROC areay (WINDOW CONST w):
  areay (w.fenster)
END PROC areay;
INT PROC areaxsize (WINDOW CONST w):
  areaxsize (w.fenster)
END PROC areaxsize;
INT PROC areaysize (WINDOW CONST w):
  areaysize (w.fenster)
END PROC areaysize;
END PACKET ls dialog 3;