path: root/dialog/ls-DIALOG 1

(* 
        
          ********************************************************* 
          ********************************************************* 
          **                                                     ** 
          **                     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;