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