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;{}
|
