summaryrefslogtreecommitdiff
path: root/dialog/ls-DIALOG 1
diff options
context:
space:
mode:
Diffstat (limited to 'dialog/ls-DIALOG 1')
-rw-r--r--dialog/ls-DIALOG 1548
1 files changed, 0 insertions, 548 deletions
diff --git a/dialog/ls-DIALOG 1 b/dialog/ls-DIALOG 1
deleted file mode 100644
index b4a2408..0000000
--- a/dialog/ls-DIALOG 1
+++ /dev/null
@@ -1,548 +0,0 @@
-(*
-
- *********************************************************
- *********************************************************
- ** **
- ** 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;
-
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-07 04:58:27 +0000