summaryrefslogtreecommitdiff
path: root/app/gs.dialog/1.2/src/ls-DIALOG 3
blob: dce650701ad8cc12f568c3cb729144431a99835c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                     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;{}