summaryrefslogtreecommitdiff
path: root/app/gs.dialog/1.2/src/ls-DIALOG 1
blob: 974bcda37a9453c9a3e54d73c9a984ca35890595 (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
49
50
51
52
53
54
55
56
57
58
59
60
(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                     ls-DIALOG 1                     ** 
          **                                                     ** 
          **                     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 1  DEFINES                  
       ecke oben  links,  balken oben,{}       ecke oben  rechts, balken rechts,{}       ecke unten links,  balken links,{}       ecke unten rechts, balken unten,{}       waagerecht, senkrecht, kreuz,{}       cursor on, cursor off,{}       clear buffer, clear buffer and count,{}       center, invers, page, page up,{}       out frame, out menuframe, erase frame,{}       std graphic char, ft20 graphic char,{}       ibm graphic char, AREA, :=, fill,{}       areax, areay, areaxsize, areaysize,{}       cursor, get cursor, out, out invers,{}
       out with beam, out invers with beam,{}       erase, erase invers, erase with beam:{}TYPE AREA = STRUCT (INT x, y, xsize, ysize);{}LET blank     =     " ",{}    mark ein  =  ""15"",{}    mark aus  =  ""14"",{}    cleol     =   ""5"";{}TEXT CONST fehlermeldung :: "Unzulässige Größen!";{}TEXT VAR eol  := "+", eor  := "+", eul  := "+", eur  := "+",{}         bo   := "+", br   := "+", bl   := "+", bu   := "+",{}         waa  := "-", sen  := "|", kr   := "+",{}         cursor sichtbar     :=  "", cursor unsichtbar   :=  "";{}
TEXT PROC ecke oben  links : eol END PROC ecke oben  links  ;{}TEXT PROC ecke oben  rechts: eor END PROC ecke oben  rechts ;{}TEXT PROC ecke unten links : eul END PROC ecke unten links  ;{}TEXT PROC ecke unten rechts: eur END PROC ecke unten rechts ;{}TEXT PROC balken oben      : bo  END PROC balken oben       ;{}TEXT PROC balken links     : bl  END PROC balken links      ;{}TEXT PROC balken rechts    : br  END PROC balken rechts     ;{}TEXT PROC balken unten     : bu  END PROC balken unten      ;{}
TEXT PROC waagerecht       : waa END PROC waagerecht        ;{}TEXT PROC senkrecht        : sen END PROC senkrecht         ;{}TEXT PROC kreuz            : kr  END PROC kreuz             ;{}PROC ecke oben  links  (TEXT CONST t): eol := t END PROC ecke oben  links  ;{}PROC ecke oben  rechts (TEXT CONST t): eor := t END PROC ecke oben  rechts ;{}PROC ecke unten links  (TEXT CONST t): eul := t END PROC ecke unten links  ;{}PROC ecke unten rechts (TEXT CONST t): eur := t END PROC ecke unten rechts ;{}
PROC balken oben       (TEXT CONST t): bo  := t END PROC balken oben       ;{}PROC balken links      (TEXT CONST t): bl  := t END PROC balken links      ;{}PROC balken rechts     (TEXT CONST t): br  := t END PROC balken rechts     ;{}PROC balken unten      (TEXT CONST t): bu  := t END PROC balken unten      ;{}PROC waagerecht        (TEXT CONST t): waa := t END PROC waagerecht        ;{}PROC senkrecht         (TEXT CONST t): sen := t END PROC senkrecht         ;{}PROC kreuz             (TEXT CONST t): kr  := t END PROC kreuz             ;{}
PROC std graphic char:{}  ecke oben  links  ("+"); ecke oben  rechts ("+");{}  ecke unten links  ("+"); ecke unten rechts ("+");{}  balken oben       ("+"); balken rechts     ("+");{}  balken links      ("+"); balken unten      ("+");{}  waagerecht        ("-"); senkrecht         ("|");{}  kreuz             ("+");{}  cursor sichtbar   := ""; cursor unsichtbar := ""{}END PROC std graphic char;{}PROC ft20 graphic char:{}  ecke oben  links (""27"R�"27"S"); ecke oben  rechts (""27"RD"27"S");{}  ecke unten links (""27"RH"27"S"); ecke unten rechts (""27"RL"27"S");{}
  balken oben      (""27"RP"27"S"); balken rechts     (""27"RT"27"S");{}  balken links     (""27"RX"27"S"); balken unten      (""27"R\"27"S");{}  waagerecht       (""27"R`"27"S"); senkrecht         (""27"Rd"27"S");{}  kreuz            (""27"Rh"27"S");{}  cursor sichtbar  := ""27"-1"    ; cursor unsichtbar := ""27"-0"    ;{}  ft20 statuszeilen aus{}END PROC ft20 graphic char;{}PROC ft 20 statuszeilen aus: out (""27".A") END PROC ft 20 statuszeilen aus;{}PROC ft 20 statuszeilen an : out (""27".�") END PROC ft 20 statuszeilen an ;{}
PROC ibm graphic char:{}  ecke oben  links (""201"");  ecke oben  rechts (""187"");{}  ecke unten links (""200"");  ecke unten rechts (""188"");{}  balken oben      (""203"");  balken rechts     (""185"");{}  balken links     (""204"");  balken unten      (""202"");{}  waagerecht       (""205"");  senkrecht         (""186"");{}  kreuz            (""206"");{}  cursor sichtbar  := ""    ;  cursor unsichtbar := ""{}END PROC ibm graphic char;{}PROC cursor on                : out (cursor sichtbar  ) END PROC cursor on ;{}
PROC cursor off               : out (cursor unsichtbar) END PROC cursor off;{}PROC cursor on  (TEXT CONST t): cursor sichtbar   := t  END PROC cursor on ;{}PROC cursor off (TEXT CONST t): cursor unsichtbar := t  END PROC cursor off;{}PROC clear buffer:{}  REP UNTIL incharety = "" PER{}END PROC clear buffer;{}INT PROC clear buffer and count (TEXT CONST zeichen):{}  INT  VAR zaehler :: 0;{}  TEXT VAR zeichenkette :: "", ch;{}  IF zeichen = "" THEN clear buffer; LEAVE clear buffer and count WITH 0 FI;{}
  ermittle die zeichenkette;{}  untersuche auf vorhandene zeichen;{}  zaehler.{}  ermittle die zeichenkette:{}    REP{}      ch := incharety (1);{}      zeichenkette CAT ch{}    UNTIL ch = "" PER.{}  untersuche auf vorhandene zeichen:{}    INT VAR i;{}    FOR i FROM 1 UPTO length (zeichenkette) REP{}      IF pos (subtext (zeichenkette, i), zeichen) = 1{}         THEN zaehler INCR 1{}      FI{}    PER.{}END PROC clear buffer and count;{}TEXT PROC center (INT CONST xsize, TEXT CONST t):{}  TEXT VAR zeile :: compress (t);{}
  zeile := ((xsize  - length (zeile)) DIV 2) * blank + zeile;{}  zeile CAT (xsize - length (zeile)) * blank;{}  zeile{}END PROC center;{}TEXT PROC center (TEXT CONST t):{}  center (79, t){}END PROC center;{}TEXT PROC invers (TEXT CONST t):{}  TEXT VAR neu :: mark ein; neu CAT t; neu CAT " "; neu CAT mark aus;{}  neu{}END PROC invers;{}PROC page (INT CONST x, y, xsize, ysize):{}    INT VAR zeiger;{}    IF x + xsize = 80{}       THEN in einem streich{}       ELSE putze vorsichtig{}    FI;{}    cursor (x, y).{}
    in einem streich:{}      FOR zeiger FROM y UPTO y + ysize - 1 REP{}        cursor (x, zeiger); out (cleol){}      PER.{}    putze vorsichtig:{}      FOR zeiger FROM y UPTO y + ysize - 1  REP{}        cursor (x, zeiger); xsize TIMESOUT blank{}      PER.{}END PROC page;{}PROC page (AREA CONST a):{}  page (a.x, a.y, a.xsize, a.ysize){}END PROC page;{}PROC page up (INT CONST x, y, xsize, ysize):{}    INT VAR zeiger;{}    IF x + xsize = 80{}       THEN in einem streich{}       ELSE putze vorsichtig{}
    FI.{}    in einem streich:{}      FOR zeiger FROM y + ysize - 1 DOWNTO y REP{}        cursor (x, zeiger); out (cleol){}      PER.{}    putze vorsichtig:{}      FOR zeiger FROM y + ysize - 1  DOWNTO y REP{}        cursor (x, zeiger); xsize TIMESOUT blank{}      PER.{}END PROC page up;{}PROC page up (AREA CONST a):{}  page up (a.x, a.y, a.xsize, a.ysize){}END PROC page up;{}PROC out frame (INT CONST x, y, xsize, ysize):{}  INT VAR zeiger;{}  IF x < 1 COR y < 1 COR xsize < 8 COR ysize < 3 COR{}     x + xsize > 80  COR y + ysize > 25{}
     THEN LEAVE out frame{}  FI;{}  male oben;{}  male seiten;{}  male unten.{}  male oben:{}    cursor (x, y);{}    out (ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke oben rechts).{}  male seiten:{}    FOR zeiger FROM 1 UPTO ysize - 2 REP{}      cursor (x,             y + zeiger); out (senkrecht);{}      cursor (x + xsize - 1, y + zeiger); out (senkrecht){}    PER.{}  male unten:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}
    out (ecke unten rechts){}END PROC out frame;{}PROC out frame (AREA CONST a):{}  IF    a.x - 1     <  1  OR a.y - 1     <  1{}     OR a.xsize + 2 > 79 OR a.ysize + 2 > 24{}     OR a.x + a.xsize + 1 > 80{}     OR a.y + a.ysize + 1 > 25{}     THEN LEAVE out frame{}  FI;{}  out frame (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out frame;{}PROC out menuframe (INT CONST x, y, xsize, ysize):{}  INT VAR i;{}  untersuche angaben;{}  schreibe rahmen.{}  untersuche angaben:{}    IF x < 0 COR y < 0 COR x + xsize > 81 COR y + ysize > 26{}
       THEN LEAVE out menuframe{}    FI.{}  schreibe rahmen:{}    IF x = 0 COR y = 0 COR xsize = 81 COR ysize = 26{}       THEN zeichne reduzierten rahmen{}       ELSE zeichne vollen rahmen{}    FI.{}  zeichne reduzierten rahmen:{}    zeichne oberlinie;{}    zeichne unterlinie.{}  zeichne oberlinie:{}    cursor (1, 2);{}    79 TIMESOUT waagerecht.{}  zeichne unterlinie:{}    cursor (1, 23);{}    79 TIMESOUT waagerecht.{}  zeichne vollen rahmen:{}    schreibe kopf; schreibe rumpf; schreibe fuss;{}
    schreibe kopfleiste; schreibe fussleiste.{}  schreibe kopf:{}    cursor (x, y);{}    out (ecke oben links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke oben rechts).{}  schreibe rumpf:{}    FOR i FROM y + 1 UPTO y + ysize - 2 REP{}      cursor (x,             i); out (senkrecht);{}      cursor (x + xsize - 1, i); out (senkrecht){}    PER.{}  schreibe fuss:{}    cursor (x, y + ysize - 1);{}    out (ecke unten links);{}    (xsize - 2) TIMESOUT waagerecht;{}    out (ecke unten rechts).{}
  schreibe kopfleiste:{}    cursor (x, y + 2        ); schreibe balkenlinie.{}  schreibe fussleiste:{}    cursor (x, y + ysize - 3); schreibe balkenlinie.{}  schreibe balkenlinie:{}    out (balken links); (xsize - 2) TIMESOUT waagerecht; out (balken rechts).{}END PROC out menuframe;{}PROC out menuframe (AREA CONST a):{} out menuframe (a.x - 1, a.y - 1, a.xsize + 2, a.ysize + 2){}END PROC out menuframe;{}PROC erase frame (INT CONST x, y, xsize, ysize):{}  INT VAR zeiger;{}  loesche oben; loesche seiten; loesche unten.{}
  loesche oben:{}    cursor (x, y); xsize TIMESOUT blank.{}  loesche seiten:{}    FOR zeiger FROM 1 UPTO ysize - 2 REP{}      cursor (x, y + zeiger); out (blank);{}      cursor (x + xsize - 1, y + zeiger); out (blank){}    PER.{}  loesche unten:{}    cursor (x, y + ysize - 1); xsize TIMESOUT blank.{}END PROC erase frame;{}OP := (AREA VAR ziel, AREA CONST quelle):{}  CONCR (ziel) := CONCR (quelle){}END OP :=;{}PROC fill (AREA VAR ziel, INT CONST a, b, c, d):{}  IF a < 1 COR b < 1 COR a > 79 COR b > 24 COR c < 8 COR d < 3{}
     COR c > 79 COR d > 24 COR a + c > 80 COR b + d > 25{}     THEN errorstop (fehlermeldung){}  FI;{}  ziel.x := a; ziel.y := b; ziel.xsize := c; ziel.ysize := d{}END PROC fill;{}INT PROC areax     (AREA CONST a): a.x      END PROC areax;{}INT PROC areay     (AREA CONST a): a.y      END PROC areay;{}INT PROC areaxsize (AREA CONST a): a.xsize  END PROC areaxsize;{}INT PROC areaysize (AREA CONST a): a.ysize  END PROC areaysize;{}PROC out (TEXT CONST t, INT CONST breite):{}  outtext (t, 1, breite){}
END PROC out;{}PROC erase (INT CONST breite):{}  breite TIMESOUT blank{}END PROC erase;{}PROC cursor (AREA CONST a, INT CONST spa, zei):{}  cursor (a.x + spa - 1, a.y + zei - 1){}END PROC cursor;{}PROC get cursor (AREA CONST a, INT VAR spalte, zeile):{}  INT VAR x, y;{}  get cursor (x, y);{}  spalte := x - a.x + 1; zeile  := y - a.y + 1{}END PROC get cursor;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}
     ELSE out (t){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE out{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    outsubtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC out (AREA CONST a, INT CONST spa, zei, TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}
     THEN verkuerzte ausgabe{}     ELSE outtext (t, 1, laenge){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE out{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    outtext (t, 1, a.xsize - spa + 1){}END PROC out;{}PROC erase (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}
  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize COR zei > a.ysize COR spa < 1 COR zei < 1{}       THEN LEAVE erase{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 1, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa + 1.{}  verkuerzte ausgabe:{}    erase (a.xsize - spa + 1){}END PROC erase;{}PROC out invers (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}
  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (mark ein); out (t); out (blank); out (mark aus){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (xsize - 4) COR zei > ysize COR spa < 2 COR zei < 1{}       THEN LEAVE out invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{}    out (blank); out (mark aus){}END PROC out invers;{}
PROC out invers (AREA CONST a, INT CONST spa, zei,{}                 TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (mark ein); outtext (t, 1, laenge); out (blank); out (mark aus){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{}       THEN LEAVE out invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}
  laenge ist zu gross:{}    laenge > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    out (mark ein); outsubtext (t, 1, a.xsize - spa - 1);{}    out (blank); out (mark aus){}END PROC out invers;{}PROC erase invers (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge + 3){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > (a.xsize - 4) COR zei > a.ysize COR spa < 2 COR zei < 1{}
       THEN LEAVE erase invers{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 2, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 1.{}  verkuerzte ausgabe:{}    erase ( a.xsize - spa + 2).{}END PROC erase invers;{}PROC out with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (blank);{}          out (t);{}          out (blank); out (blank); out (senkrecht){}
  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (blank);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC out with beam (AREA CONST a, INT CONST spa, zei,{}
                    TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (blank);{}          outtext (t, 1,laenge);{}          out (blank); out (blank); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}
  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (blank);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (blank); out (senkrecht){}END PROC out with beam;{}PROC erase with beam (AREA CONST a, INT CONST spa, zei, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE erase (laenge + 6){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
       THEN LEAVE erase with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    erase (a.xsize - spa + 4).{}END PROC erase with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei, TEXT CONST t):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF text ist zu lang{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (mark ein);{}          out (t);{}
          out (blank); out (mark aus); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}       THEN LEAVE out invers with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  text ist zu lang:{}    length (t) > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (mark ein);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (mark aus); out (senkrecht){}
END PROC out invers with beam;{}PROC out invers with beam (AREA CONST a, INT CONST spa, zei,{}                           TEXT CONST t, INT CONST laenge):{}  ueberpruefe cursorangaben; positioniere cursor;{}  IF laenge ist zu gross{}     THEN verkuerzte ausgabe{}     ELSE out (senkrecht); out (blank); out (mark ein);{}          outtext (t, 1, laenge);{}          out (blank); out (mark aus); out (senkrecht){}  FI.{}  ueberpruefe cursorangaben:{}    IF spa > a.xsize - 7 COR zei > a.ysize COR spa < 4 COR zei < 1{}
       THEN LEAVE out invers with beam{}    FI.{}  positioniere cursor:{}    cursor (a.x + spa - 4, a.y + zei - 1).{}  laenge ist zu gross:{}    laenge > a.xsize - spa - 2.{}  verkuerzte ausgabe:{}    out (senkrecht); out (blank); out (mark ein);{}    outsubtext (t, 1, a.xsize - spa - 2);{}    out (blank); out (mark aus); out (senkrecht){}END PROC out invers with beam;{}END PACKET ls dialog 1;{}