diff options
Diffstat (limited to 'dialog/ls-DIALOG 1')
| -rw-r--r-- | dialog/ls-DIALOG 1 | 558 |
1 files changed, 523 insertions, 35 deletions
diff --git a/dialog/ls-DIALOG 1 b/dialog/ls-DIALOG 1 index 974bcda..b4a2408 100644 --- a/dialog/ls-DIALOG 1 +++ b/dialog/ls-DIALOG 1 @@ -22,39 +22,527 @@ *) 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;{} + 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; + |