diff options
Diffstat (limited to 'dialog/ls-DIALOG 4')
| -rw-r--r-- | dialog/ls-DIALOG 4 | 762 |
1 files changed, 716 insertions, 46 deletions
diff --git a/dialog/ls-DIALOG 4 b/dialog/ls-DIALOG 4 index 7c9d9c4..e1d38c4 100644 --- a/dialog/ls-DIALOG 4 +++ b/dialog/ls-DIALOG 4 @@ -22,50 +22,720 @@ *) -PACKET ls dialog 4 DEFINES{} boxinfo,{} boxnotice,{} boxalternative,{} boxyes,{} boxno,{} boxanswer,{} boxone,{} boxanswerone,{} boxsome,{} boxanswersome,{} out footnote,{} erase footnote:{}LET mark ein = ""15"",{} mark aus = ""14"",{} delimiter = ""13"",{} piep = ""7"",{} rechts links esc return = ""2""8""27""13"",{} - rechts links null return = ""2""8""0""13"" ,{} blank = " ",{} niltext = "",{} janeintasten = "jJyYnN";{}ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ({}" Zum Weitermachen bitte irgendeine Taste tippen!",{}" Ändern: <Pfeile> Bestätigen: <RETURN> Abbruch: <ESC> <h>",{}" Ändern: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>",{}" Ändern: <Pfeile> Bestätigen: <RETURN>",{}" Fertig: <RETURN> Zeigen: <ESC><z> Abbruch: <ESC><h>",{} -" Fertig: <RETURN> Abbruch: <ESC><h>",{}"Ja"13"Nein",{}" Eingabe: "{});{}PROC boxinfo (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} cursor (w, spa, zei);{}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position,{} timelimit, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{} - get cursor (w, spa, zei);{} schreibe box (w, t, position, timelimit, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit):{} boxinfo (w, t, position, timelimit, TRUE){}END PROC boxinfo;{}PROC boxinfo (WINDOW VAR w, TEXT CONST t):{} boxinfo (w, t, 5, maxint, TRUE){}END PROC boxinfo;{} -PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} schreibe notiz (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei){}END PROC boxnotice;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize):{} - INT VAR ergebnis, spa, zei;{} get cursor (w, spa, zei);{} schreibe alternativen (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize, ergebnis);{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste,{} zusatztasten, INT CONST position,{} BOOL CONST mit abbruch, trennlinie weg):{} INT VAR x, y, xsize, ysize, ergebnis, spa, zei;{} - get cursor (w, spa, zei);{} ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position,{} mit abbruch, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} ergebnis{}END PROC boxalternative;{}INT PROC boxalternative (WINDOW VAR w, TEXT CONST t,{} auswahlliste, zusatztasten,{} INT CONST position, BOOL CONST mit abbruch):{} - boxalternative (w, t, auswahlliste, zusatztasten,{} position, mit abbruch, TRUE){}END PROC boxalternative;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize);{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{} - INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize);{} page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE);{} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxyes;{}BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxyes (w, t, position, TRUE){}END PROC boxyes;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position,{} - INT VAR x, y, xsize, ysize):{} NOT boxyes (w, t, position, x, y, xsize, ysize){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t,{} INT CONST position, BOOL CONST trennlinie weg):{} NOT boxyes (w, t, position, trennlinie weg){}END PROC boxno;{}BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position):{} boxno (w, t, position){}END PROC boxno;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, INT VAR x, y, xsize, ysize):{} - INT VAR spa, zei;{} TEXT VAR wert;{} get cursor (w, spa, zei);{} wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize);{} cursor (spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST trennlinie weg):{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE,{} x, y, xsize, ysize);{} - page up (x, y, xsize, ysize);{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxanswer;{}TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position):{} boxanswer (w, t, vorgabe, position, TRUE){}END PROC boxanswer;{}TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2, BOOL CONST mit reinigung):{} - INT VAR spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{} thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxone;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{} - THESAURUS CONST thesaurus, TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{} INT VAR x,y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} wert.{} lasse auswaehlen:{} IF mit reinigung{} THEN wert := boxone (w, thesaurus, t1, t2, TRUE ){} - ELSE wert := boxone (w, thesaurus, t1, t2, FALSE){} FI.{} uebernimm den wert:{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer one;{}TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus, TEXT CONST t1, t2,{} - BOOL CONST mit reinigung):{} boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswer one;{}THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus,{} TEXT CONST text1, text2,{} BOOL CONST mit reinigung):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2,{} - thesaurus, text1, text2);{} IF mit reinigung{} THEN page up (areax (w) + 2, areay (w) + 2,{} areaxsize (w) - 4, areaysize (w) - 2);{} erase footnote (w){} FI;{} cursor (w, spa, zei);{} wert{}END PROC boxsome;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{} TEXT CONST t1, t2,{} BOOL CONST mit reinigung, trennlinie weg):{} - THESAURUS VAR ergebnis :: empty thesaurus;{} INT VAR x, y, xsize, ysize, spa, zei;{} get cursor (w, spa, zei);{} TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE,{} x, y, xsize, ysize);{} IF wert = ""27"z"{} THEN lasse auswaehlen{} ELSE uebernimm den wert{} FI;{} cursor (w, spa, zei);{} ergebnis.{} lasse auswaehlen:{} IF mit reinigung{} THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ){} ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE){} - FI.{} uebernimm den wert:{} IF wert <> niltext{} THEN insert (ergebnis, wert){} FI;{} IF mit reinigung{} THEN page up (x, y, xsize, ysize);{} entferne ggf die trennlinie{} FI.{} entferne ggf die trennlinie:{} IF trennlinie weg{} THEN erase footnote (w, TRUE){} ELSE erase footnote (w, FALSE){} FI.{}END PROC boxanswer some;{}THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe,{} THESAURUS CONST thesaurus,{} - TEXT CONST t1, t2,{} BOOL CONST mit reinigung):{} boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE){}END PROC boxanswersome;{}PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF mit trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} areaxsize (w) TIMESOUT waagerecht{} FI;{} cursor (w, 1, areaysize (w));{} outtext (text, 1, areaxsize (w));{} - cursor (w, spa, zei){}END PROC out footnote;{}PROC out footnote (WINDOW VAR w, TEXT CONST t):{} out footnote (w, TRUE, t){}END PROC out footnote;{}PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie):{} INT VAR spa, zei;{} get cursor (w, spa, zei);{} IF auch trennlinie{} THEN cursor (w, 1, areaysize (w) - 1);{} outtext ("", 1, areaxsize (w)){} FI;{} cursor (w, 1, areaysize (w));{} outtext ("", 1, areaxsize (w));{} cursor (w, spa, zei){}END PROC erase footnote;{}PROC erase footnote (WINDOW VAR w):{} - erase footnote (w, TRUE){}END PROC erase footnote;{}PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t,{} INT CONST position, zusatzlaenge,{} mindestbreite, mindesthoehe,{} INT VAR x, y, xsize, ysize):{} ermittle boxbreite und boxhoehe;{} ermittle rahmenwerte;{} schreibe boxkopf;{} schreibe boxrumpf.{} ermittle boxbreite und boxhoehe:{} TEXT VAR intern :: t + delimiter;{} entferne fuehrende delimiter;{} INT VAR anfang :: 1,{} - ende :: pos (intern, delimiter, anfang) - 1;{} xsize := 0;{} ysize := 0;{} WHILE ende > 0 REP{} ysize INCR 1;{} lege ggf boxbreite fest;{} bestimme neue positionen{} PER.{} entferne fuehrende delimiter:{} WHILE (intern SUB 1) = delimiter REP{} intern := subtext (intern, 2){} PER.{} lege ggf boxbreite fest:{} IF length (subtext (intern, anfang, ende)) > xsize{} THEN xsize := length (subtext (intern, anfang, ende)){} FI.{} bestimme neue positionen:{} - anfang := ende + 2;{} ende := pos (intern, delimiter, anfang) - 1.{} ermittle rahmenwerte:{} schlage notwendige groessen auf;{} kill ueberlaengen;{} lege bildschirmpositionen fest.{} schlage notwendige groessen auf:{} IF xsize < mindestbreite{} THEN xsize := mindestbreite{} FI;{} IF ysize < mindesthoehe{} THEN ysize := mindesthoehe{} FI;{} ysize INCR zusatzlaenge;{} ysize INCR 2; (* Für den Rahmen *){} xsize INCR 2. (* Für den Rahmen *){} kill ueberlaengen:{} - IF ysize > (areaysize (w) - 4){} THEN ysize := areaysize (w) - 4{} FI;{} IF xsize > (areaxsize (w) - 4){} THEN xsize := areaxsize (w) - 4{} FI.{} lege bildschirmpositionen fest:{} SELECT position OF{} CASE 1: plazierung links oben{} CASE 2: plazierung rechts oben{} CASE 3: plazierung links unten{} CASE 4: plazierung rechts unten{} OTHERWISE plazierung im zentrum{} END SELECT.{} plazierung links oben:{} x := areax (w) + 2;{} y := areay (w) + 2.{} - plazierung rechts oben:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + 2.{} plazierung links unten:{} x := areax (w) + 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung rechts unten:{} x := areax (w) + areaxsize (w) - xsize - 2;{} y := areay (w) + areaysize (w) - ysize - 2.{} plazierung im zentrum:{} x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1;{} y := areay (w) + ((areaysize (w) - ysize) DIV 2).{} schreibe boxkopf:{} - cursor (x, y);{} out (ecke oben links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke oben rechts).{} schreibe boxrumpf:{} INT VAR i;{} intern := t + delimiter;{} entferne fuehrende delimiter;{} anfang := 1;{} ende := pos (intern, delimiter, anfang) - 1;{} FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP{} cursor (x, i);{} out (senkrecht);{} outtext (subtext (intern, anfang, ende), 1, xsize - 2);{} out (senkrecht);{} anfang := ende + 2;{} - ende := pos (intern, delimiter, anfang) - 1{} PER{}END PROC schreibe boxtext;{}PROC schreibe boxfuss (WINDOW VAR w,{} INT CONST x, y, xsize, ysize, limit):{} schreibe abschlusszeile;{} out footnote (w, aussage [1]);{} cursor in position und warten.{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} cursor in position und warten:{} cursor parken (w);{} - clear buffer;{} pause (limit){}END PROC schreibe boxfuss;{}PROC cursor parken (WINDOW VAR w):{} cursor (w, 1, 2){}END PROC cursor parken;{}PROC schreibe box (WINDOW VAR w, TEXT CONST t,{} INT CONST position, timelimit,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe boxfuss (w, x, y, xsize, ysize, timelimit){}END PROC schreibe box;{}PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize):{} - schreibe abschlusszeile;{} cursor parken (w).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{}END PROC schreibe notizfuss;{}PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize);{} schreibe notizfuss (w, x, y, xsize, ysize){}END PROC schreibe notiz;{}PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst,{} - INT CONST position, BOOL CONST mit abbruch,{} INT VAR x, y, xsize, ysize, ergebnis):{} ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste;{} normiere alternativen;{} untersuche alternativen;{} schreibe boxtext (w, textintern, position, 2, altbreite,{} 0, x, y, xsize, ysize);{} schreibe alternativenfuss;{} lasse auswaehlen;{} liefere ergebnis.{} textintern:{} IF sonst = janeintasten{} THEN TEXT VAR zwischen;{} - zwischen := t;{} kuerze um folgende blanks;{} zwischen + "? "{} ELSE t{} FI.{} kuerze um folgende blanks:{} WHILE (zwischen SUB (length (zwischen))) = blank REP{} zwischen := subtext (zwischen , 1, length (zwischen) - 1){} PER.{} normiere alternativen:{} TEXT VAR altintern :: altzeile;{} altintern CAT delimiter.{} untersuche alternativen:{} INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1,{} ende :: pos (altintern, delimiter, anfang) - 1;{} - WHILE ende > 0 AND altanzahl <= 10 REP{} trage alternative ein;{} trage alternativenanfang ein;{} trage alternativenlaenge ein;{} setze neue positionen fest{} PER;{} ermittle gesamtalternativenbreite.{} trage alternative ein:{} altliste [altanzahl].alternat :={} compress (subtext (altintern, anfang, ende)).{} trage alternativenanfang ein:{} first INCR 3;{} altliste [altanzahl].anfang := first.{} trage alternativenlaenge ein:{} - altliste [altanzahl].laenge := length (altliste [altanzahl].alternat);{} first INCR altliste [altanzahl].laenge.{} setze neue positionen fest:{} anfang := ende + 2;{} ende := pos (altintern, delimiter, anfang) - 1;{} altanzahl INCR 1.{} ermittle gesamtalternativenbreite:{} altanzahl DECR 1;{} altbreite := altliste [altanzahl].anfang;{} altbreite INCR (altliste [altanzahl].laenge + 3);{} IF altbreite > areaxsize (w) - 6{} THEN LEAVE schreibe alternativen{} - FI.{} schreibe alternativenfuss:{} schreibe leerzeile;{} schreibe antwortmoeglichkeiten;{} schreibe abschlusszeile;{} IF mit abbruch{} THEN out footnote (w, aussage [2]){} ELSE beruecksichtige ja nein hinweis{} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe antwortmoeglichkeiten:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} einrueckbreite TIMESOUT blank;{} - out (antwortleiste);{} rest TIMESOUT blank;{} out (senkrecht).{} einrueckbreite:{} (xsize - 2 - length (antwortleiste)) DIV 2.{} antwortleiste:{} INT VAR zeiger; TEXT VAR ausgabe :: "";{} FOR zeiger FROM 1 UPTO altanzahl REP{} ausgabe CAT altliste [zeiger].alternat;{} ausgabe CAT " "{} PER;{} compress (ausgabe).{} rest:{} xsize - 2 - einrueckbreite - length (antwortleiste).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} - (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} beruecksichtige ja nein hinweis:{} IF sonst = janeintasten{} THEN out footnote (w, aussage [3]){} ELSE out footnote (w, aussage [4]){} FI.{} lasse auswaehlen:{} INT VAR altzeiger :: 1;{} stelle erste alternative invers dar;{} REP{} hole eingabe;{} werte eingabe aus und reagiere{} UNTIL alternative gefunden PER.{} stelle erste alternative invers dar:{} cursor (x + einrueckbreite, y + ysize - 2);{} - out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (x + einrueckbreite, y + ysize - 2).{} hole eingabe:{} TEXT VAR moegliche, eingabe;{} IF mit abbruch{} THEN moegliche := rechts links esc return + sonst{} ELSE moegliche := rechts links null return + sonst{} FI;{} clear buffer;{} REP{} inchar (eingabe);{} piepse bei unzulaessiger eingabe{} UNTIL pos (moegliche, eingabe) > 0 PER.{} piepse bei unzulaessiger eingabe:{} - IF pos (moegliche, eingabe) = 0 THEN out (piep) FI.{} werte eingabe aus und reagiere:{} SELECT pos (moegliche, eingabe) OF{} CASE 1: zur naechsten alternative{} CASE 2: zur vorausgehenden alternative{} CASE 3: esc kommando verarbeiten{} END SELECT.{} zur naechsten alternative:{} loesche aktuelle alternative;{} ermittle rechte alternative;{} stelle neue alternative invers dar.{} zur vorausgehenden alternative:{} loesche aktuelle alternative;{} ermittle linke alternative;{} - stelle neue alternative invers dar.{} loesche aktuelle alternative:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (blank);{} out (altliste [altzeiger].alternat);{} out (2 * blank).{} alternativenanfang:{} x + einrueckbreite + altliste [altzeiger].anfang.{} ermittle rechte alternative:{} IF altzeiger = altanzahl{} THEN altzeiger := 1{} ELSE altzeiger INCR 1{} FI.{} ermittle linke alternative:{} IF altzeiger = 1{} THEN altzeiger := altanzahl{} - ELSE altzeiger DECR 1{} FI.{} stelle neue alternative invers dar:{} cursor (alternativenanfang - 1, y + ysize - 2);{} out (mark ein);{} out (altliste [altzeiger].alternat); out (blank);{} out (mark aus);{} cursor (alternativenanfang - 1, y + ysize - 2).{} esc kommando verarbeiten:{} inchar (eingabe);{} IF eingabe = "h"{} THEN ergebnis := 0;{} LEAVE schreibe alternativen{} ELSE out (piep); eingabe := ""{} FI.{} alternative gefunden:{} pos (moegliche, eingabe) > 3.{} - liefere ergebnis:{} IF pos (moegliche, eingabe) = 4{} THEN ergebnis := altzeiger{} ELSE ergebnis := 100 + pos (sonst, eingabe){} FI.{}END PROC schreibe alternativen;{}BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position,{} INT VAR x, y, xsize, ysize):{} INT VAR ergebnis;{} schreibe alternativen (w, t, aussage [7], janeintasten, position,{} FALSE, x, y, xsize, ysize, ergebnis);{} SELECT ergebnis OF{} CASE 2, 105, 106: FALSE{} OTHERWISE TRUE{} - END SELECT.{}END PROC ja;{}TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe,{} INT CONST position, BOOL CONST mit auswahl,{} INT VAR x, y, xsize, ysize):{} TEXT VAR eingabe :: compress (vorgabe);{} schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2,{} x, y, xsize, ysize);{} schreibe antwortfuss;{} clear buffer;{} REP{} IF eingabe = "break"{} THEN eingabe := ""{} FI;{} lasse eintragen{} - UNTIL eingabe <> "break" PER;{} liefere ergebnis.{} schreibe antwortfuss:{} schreibe leerzeile;{} schreibe eingabezeile;{} schreibe abschlusszeile;{} IF mit auswahl{} THEN out footnote (w, aussage [5]){} ELSE out footnote (w, aussage [6]){} FI.{} schreibe leerzeile:{} cursor (x, y + ysize - 3);{} out (senkrecht);{} (xsize - 2) TIMESOUT blank;{} out (senkrecht).{} schreibe eingabezeile:{} cursor (x, y + ysize - 2);{} out (senkrecht);{} out (aussage [8]);{} - (xsize - 2 - length (aussage [8])) TIMESOUT blank;{} out (senkrecht).{} schreibe abschlusszeile:{} cursor (x, y + ysize - 1);{} out (ecke unten links);{} (xsize - 2) TIMESOUT waagerecht;{} out (ecke unten rechts).{} lasse eintragen:{} TEXT VAR exit :: "";{} cursor on;{} cursor (x + length (aussage [8]) + 1, y + ysize - 2);{} IF mit auswahl{} THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit){} ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit){} - FI;{} cursor off;{} IF exit = ""27"h"{} THEN eingabe := ""{} ELIF mit auswahl AND (exit = ""27"z"){} THEN eingabe := ""27"z"{} ELSE eingabe := compress (eingabe){} FI.{} textlaenge:{} xsize - 2 - length (aussage [8]).{} liefere ergebnis:{} eingabe.{}END PROC hole antwort;{}END PACKET ls dialog 4;{} +PACKET ls dialog 4 DEFINES + boxinfo, + boxnotice, + boxalternative, + boxyes, + boxno, + boxanswer, + boxone, + boxanswerone, + boxsome, + boxanswersome, + out footnote, + erase footnote: +LET mark ein = ""15"", + mark aus = ""14"", + delimiter = ""13"", + piep = ""7"", + rechts links esc return = ""2""8""27""13"", + + rechts links null return = ""2""8""0""13"" , + blank = " ", + niltext = "", + janeintasten = "jJyYnN"; +ROW 8 TEXT CONST aussage :: ROW 8 TEXT : ( +" Zum Weitermachen bitte irgendeine Taste tippen!", +" Ändern: <Pfeile> Bestätigen: <RETURN> Abbruch: <ESC> <h>", +" Ändern: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>", +" Ändern: <Pfeile> Bestätigen: <RETURN>", +" Fertig: <RETURN> Zeigen: <ESC><z> Abbruch: <ESC><h>", + +" Fertig: <RETURN> Abbruch: <ESC><h>", +"Ja"13"Nein", +" Eingabe: " +); +PROC boxinfo (WINDOW VAR w, TEXT CONST t, + INT CONST position, timelimit, + INT VAR x, y, xsize, ysize): + INT VAR spa, zei; + get cursor (w, spa, zei); + schreibe box (w, t, position, timelimit, x, y, xsize, ysize); + cursor (w, spa, zei); +END PROC boxinfo; +PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, + timelimit, BOOL CONST trennlinie weg): + INT VAR x, y, xsize, ysize, spa, zei; + + get cursor (w, spa, zei); + schreibe box (w, t, position, timelimit, x, y, xsize, ysize); + page up (x, y, xsize, ysize); + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE) + FI; + cursor (w, spa, zei) +END PROC boxinfo; +PROC boxinfo (WINDOW VAR w, TEXT CONST t, INT CONST position, timelimit): + boxinfo (w, t, position, timelimit, TRUE) +END PROC boxinfo; +PROC boxinfo (WINDOW VAR w, TEXT CONST t): + boxinfo (w, t, 5, maxint, TRUE) +END PROC boxinfo; + +PROC boxnotice (WINDOW VAR w, TEXT CONST t, INT CONST position, + INT VAR x, y, xsize, ysize): + INT VAR spa, zei; + get cursor (w, spa, zei); + schreibe notiz (w, t, position, x, y, xsize, ysize); + cursor (w, spa, zei) +END PROC boxnotice; +INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, + auswahlliste, zusatztasten, + INT CONST position, BOOL CONST mit abbruch, + INT VAR x, y, xsize, ysize): + + INT VAR ergebnis, spa, zei; + get cursor (w, spa, zei); + schreibe alternativen (w, t, auswahlliste, zusatztasten, position, + mit abbruch, x, y, xsize, ysize, ergebnis); + cursor (w, spa, zei); + ergebnis +END PROC boxalternative; +INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, auswahlliste, + zusatztasten, INT CONST position, + BOOL CONST mit abbruch, trennlinie weg): + INT VAR x, y, xsize, ysize, ergebnis, spa, zei; + + get cursor (w, spa, zei); + ergebnis := boxalternative (w, t, auswahlliste, zusatztasten, position, + mit abbruch, x, y, xsize, ysize); + page up (x, y, xsize, ysize); + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE) + FI; + cursor (w, spa, zei); + ergebnis +END PROC boxalternative; +INT PROC boxalternative (WINDOW VAR w, TEXT CONST t, + auswahlliste, zusatztasten, + INT CONST position, BOOL CONST mit abbruch): + + boxalternative (w, t, auswahlliste, zusatztasten, + position, mit abbruch, TRUE) +END PROC boxalternative; +BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position, + INT VAR x, y, xsize, ysize): + INT VAR spa, zei; + get cursor (w, spa, zei); + BOOL CONST wert :: ja (w, t, position, x, y, xsize, ysize); + cursor (w, spa, zei); + wert +END PROC boxyes; +BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, + INT CONST position, BOOL CONST trennlinie weg): + + INT VAR x, y, xsize, ysize, spa, zei; + get cursor (w, spa, zei); + BOOL VAR wert :: ja (w, t, position, x, y, xsize, ysize); + page up (x, y, xsize, ysize); + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE); + FI; + cursor (w, spa, zei); + wert +END PROC boxyes; +BOOL PROC boxyes (WINDOW VAR w, TEXT CONST t, INT CONST position): + boxyes (w, t, position, TRUE) +END PROC boxyes; +BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position, + + INT VAR x, y, xsize, ysize): + NOT boxyes (w, t, position, x, y, xsize, ysize) +END PROC boxno; +BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, + INT CONST position, BOOL CONST trennlinie weg): + NOT boxyes (w, t, position, trennlinie weg) +END PROC boxno; +BOOL PROC boxno (WINDOW VAR w, TEXT CONST t, INT CONST position): + boxno (w, t, position) +END PROC boxno; +TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, + INT CONST position, INT VAR x, y, xsize, ysize): + + INT VAR spa, zei; + TEXT VAR wert; + get cursor (w, spa, zei); + wert := hole antwort (w, t, vorgabe, position, FALSE, x, y, xsize, ysize); + cursor (spa, zei); + wert +END PROC boxanswer; +TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, + INT CONST position, BOOL CONST trennlinie weg): + INT VAR x, y, xsize, ysize, spa, zei; + get cursor (w, spa, zei); + TEXT VAR wert := hole antwort (w, t, vorgabe, position, FALSE, + x, y, xsize, ysize); + + page up (x, y, xsize, ysize); + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE) + FI; + cursor (w, spa, zei); + wert +END PROC boxanswer; +TEXT PROC boxanswer (WINDOW VAR w, TEXT CONST t, vorgabe, + INT CONST position): + boxanswer (w, t, vorgabe, position, TRUE) +END PROC boxanswer; +TEXT PROC boxone (WINDOW VAR w, THESAURUS CONST thesaurus, + TEXT CONST text1, text2, BOOL CONST mit reinigung): + + INT VAR spa, zei; + get cursor (w, spa, zei); + TEXT VAR wert :: one (areax (w) + 2, areay (w) + 2, + areaxsize (w) - 4, areaysize (w) - 2, + thesaurus, text1, text2); + IF mit reinigung + THEN page up (areax (w) + 2, areay (w) + 2, + areaxsize (w) - 4, areaysize (w) - 2); + erase footnote (w) + FI; + cursor (w, spa, zei); + wert +END PROC boxone; +TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe, + + THESAURUS CONST thesaurus, TEXT CONST t1, t2, + BOOL CONST mit reinigung, trennlinie weg): + INT VAR x,y, xsize, ysize, spa, zei; + get cursor (w, spa, zei); + TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE, + x, y, xsize, ysize); + IF wert = ""27"z" + THEN lasse auswaehlen + ELSE uebernimm den wert + FI; + cursor (w, spa, zei); + wert. + lasse auswaehlen: + IF mit reinigung + THEN wert := boxone (w, thesaurus, t1, t2, TRUE ) + + ELSE wert := boxone (w, thesaurus, t1, t2, FALSE) + FI. + uebernimm den wert: + IF mit reinigung + THEN page up (x, y, xsize, ysize); + entferne ggf die trennlinie + FI. + entferne ggf die trennlinie: + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE) + FI. +END PROC boxanswer one; +TEXT PROC boxanswerone (WINDOW VAR w, TEXT CONST text, vorgabe, + THESAURUS CONST thesaurus, TEXT CONST t1, t2, + + BOOL CONST mit reinigung): + boxanswerone (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE) +END PROC boxanswer one; +THESAURUS PROC boxsome (WINDOW VAR w, THESAURUS CONST thesaurus, + TEXT CONST text1, text2, + BOOL CONST mit reinigung): + INT VAR spa, zei; + get cursor (w, spa, zei); + THESAURUS VAR wert :: some (areax (w) + 2, areay (w) + 2, + areaxsize (w) - 4, areaysize (w) - 2, + + thesaurus, text1, text2); + IF mit reinigung + THEN page up (areax (w) + 2, areay (w) + 2, + areaxsize (w) - 4, areaysize (w) - 2); + erase footnote (w) + FI; + cursor (w, spa, zei); + wert +END PROC boxsome; +THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe, + THESAURUS CONST thesaurus, + TEXT CONST t1, t2, + BOOL CONST mit reinigung, trennlinie weg): + + THESAURUS VAR ergebnis :: empty thesaurus; + INT VAR x, y, xsize, ysize, spa, zei; + get cursor (w, spa, zei); + TEXT VAR wert := hole antwort (w, text, vorgabe, 5, TRUE, + x, y, xsize, ysize); + IF wert = ""27"z" + THEN lasse auswaehlen + ELSE uebernimm den wert + FI; + cursor (w, spa, zei); + ergebnis. + lasse auswaehlen: + IF mit reinigung + THEN ergebnis := boxsome (w, thesaurus, t1, t2, TRUE ) + ELSE ergebnis := boxsome (w, thesaurus, t1, t2, FALSE) + + FI. + uebernimm den wert: + IF wert <> niltext + THEN insert (ergebnis, wert) + FI; + IF mit reinigung + THEN page up (x, y, xsize, ysize); + entferne ggf die trennlinie + FI. + entferne ggf die trennlinie: + IF trennlinie weg + THEN erase footnote (w, TRUE) + ELSE erase footnote (w, FALSE) + FI. +END PROC boxanswer some; +THESAURUS PROC boxanswersome (WINDOW VAR w, TEXT CONST text, vorgabe, + THESAURUS CONST thesaurus, + + TEXT CONST t1, t2, + BOOL CONST mit reinigung): + boxanswersome (w, text, vorgabe, thesaurus, t1, t2, mit reinigung, TRUE) +END PROC boxanswersome; +PROC out footnote (WINDOW VAR w, BOOL CONST mit trennlinie, TEXT CONST text): + INT VAR spa, zei; + get cursor (w, spa, zei); + IF mit trennlinie + THEN cursor (w, 1, areaysize (w) - 1); + areaxsize (w) TIMESOUT waagerecht + FI; + cursor (w, 1, areaysize (w)); + outtext (text, 1, areaxsize (w)); + + cursor (w, spa, zei) +END PROC out footnote; +PROC out footnote (WINDOW VAR w, TEXT CONST t): + out footnote (w, TRUE, t) +END PROC out footnote; +PROC erase footnote (WINDOW VAR w, BOOL CONST auch trennlinie): + INT VAR spa, zei; + get cursor (w, spa, zei); + IF auch trennlinie + THEN cursor (w, 1, areaysize (w) - 1); + outtext ("", 1, areaxsize (w)) + FI; + cursor (w, 1, areaysize (w)); + outtext ("", 1, areaxsize (w)); + cursor (w, spa, zei) +END PROC erase footnote; +PROC erase footnote (WINDOW VAR w): + + erase footnote (w, TRUE) +END PROC erase footnote; +PROC schreibe boxtext (WINDOW VAR w, TEXT CONST t, + INT CONST position, zusatzlaenge, + mindestbreite, mindesthoehe, + INT VAR x, y, xsize, ysize): + ermittle boxbreite und boxhoehe; + ermittle rahmenwerte; + schreibe boxkopf; + schreibe boxrumpf. + ermittle boxbreite und boxhoehe: + TEXT VAR intern :: t + delimiter; + entferne fuehrende delimiter; + INT VAR anfang :: 1, + + ende :: pos (intern, delimiter, anfang) - 1; + xsize := 0; + ysize := 0; + WHILE ende > 0 REP + ysize INCR 1; + lege ggf boxbreite fest; + bestimme neue positionen + PER. + entferne fuehrende delimiter: + WHILE (intern SUB 1) = delimiter REP + intern := subtext (intern, 2) + PER. + lege ggf boxbreite fest: + IF length (subtext (intern, anfang, ende)) > xsize + THEN xsize := length (subtext (intern, anfang, ende)) + FI. + bestimme neue positionen: + + anfang := ende + 2; + ende := pos (intern, delimiter, anfang) - 1. + ermittle rahmenwerte: + schlage notwendige groessen auf; + kill ueberlaengen; + lege bildschirmpositionen fest. + schlage notwendige groessen auf: + IF xsize < mindestbreite + THEN xsize := mindestbreite + FI; + IF ysize < mindesthoehe + THEN ysize := mindesthoehe + FI; + ysize INCR zusatzlaenge; + ysize INCR 2; (* Für den Rahmen *) + xsize INCR 2. (* Für den Rahmen *) + kill ueberlaengen: + + IF ysize > (areaysize (w) - 4) + THEN ysize := areaysize (w) - 4 + FI; + IF xsize > (areaxsize (w) - 4) + THEN xsize := areaxsize (w) - 4 + FI. + lege bildschirmpositionen fest: + SELECT position OF + CASE 1: plazierung links oben + CASE 2: plazierung rechts oben + CASE 3: plazierung links unten + CASE 4: plazierung rechts unten + OTHERWISE plazierung im zentrum + END SELECT. + plazierung links oben: + x := areax (w) + 2; + y := areay (w) + 2. + + plazierung rechts oben: + x := areax (w) + areaxsize (w) - xsize - 2; + y := areay (w) + 2. + plazierung links unten: + x := areax (w) + 2; + y := areay (w) + areaysize (w) - ysize - 2. + plazierung rechts unten: + x := areax (w) + areaxsize (w) - xsize - 2; + y := areay (w) + areaysize (w) - ysize - 2. + plazierung im zentrum: + x := areax (w) + ((areaxsize (w) - (xsize + 2)) DIV 2) + 1; + y := areay (w) + ((areaysize (w) - ysize) DIV 2). + schreibe boxkopf: + + cursor (x, y); + out (ecke oben links); + (xsize - 2) TIMESOUT waagerecht; + out (ecke oben rechts). + schreibe boxrumpf: + INT VAR i; + intern := t + delimiter; + entferne fuehrende delimiter; + anfang := 1; + ende := pos (intern, delimiter, anfang) - 1; + FOR i FROM y + 1 UPTO y + ysize - zusatzlaenge - 2 REP + cursor (x, i); + out (senkrecht); + outtext (subtext (intern, anfang, ende), 1, xsize - 2); + out (senkrecht); + anfang := ende + 2; + + ende := pos (intern, delimiter, anfang) - 1 + PER +END PROC schreibe boxtext; +PROC schreibe boxfuss (WINDOW VAR w, + INT CONST x, y, xsize, ysize, limit): + schreibe abschlusszeile; + out footnote (w, aussage [1]); + cursor in position und warten. + schreibe abschlusszeile: + cursor (x, y + ysize - 1); + out (ecke unten links); + (xsize - 2) TIMESOUT waagerecht; + out (ecke unten rechts). + cursor in position und warten: + cursor parken (w); + + clear buffer; + pause (limit) +END PROC schreibe boxfuss; +PROC cursor parken (WINDOW VAR w): + cursor (w, 1, 2) +END PROC cursor parken; +PROC schreibe box (WINDOW VAR w, TEXT CONST t, + INT CONST position, timelimit, + INT VAR x, y, xsize, ysize): + schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize); + schreibe boxfuss (w, x, y, xsize, ysize, timelimit) +END PROC schreibe box; +PROC schreibe notizfuss (WINDOW VAR w, INT CONST x, y, xsize, ysize): + + schreibe abschlusszeile; + cursor parken (w). + schreibe abschlusszeile: + cursor (x, y + ysize - 1); + out (ecke unten links); + (xsize - 2) TIMESOUT waagerecht; + out (ecke unten rechts). +END PROC schreibe notizfuss; +PROC schreibe notiz (WINDOW VAR w, TEXT CONST t, INT CONST position, + INT VAR x, y, xsize, ysize): + schreibe boxtext (w, t, position, 0, 0, 0, x, y, xsize, ysize); + schreibe notizfuss (w, x, y, xsize, ysize) +END PROC schreibe notiz; +PROC schreibe alternativen (WINDOW VAR w, TEXT CONST t, altzeile, sonst, + + INT CONST position, BOOL CONST mit abbruch, + INT VAR x, y, xsize, ysize, ergebnis): + ROW 10 STRUCT (TEXT alternat, INT anfang, laenge) VAR altliste; + normiere alternativen; + untersuche alternativen; + schreibe boxtext (w, textintern, position, 2, altbreite, + 0, x, y, xsize, ysize); + schreibe alternativenfuss; + lasse auswaehlen; + liefere ergebnis. + textintern: + IF sonst = janeintasten + THEN TEXT VAR zwischen; + + zwischen := t; + kuerze um folgende blanks; + zwischen + "? " + ELSE t + FI. + kuerze um folgende blanks: + WHILE (zwischen SUB (length (zwischen))) = blank REP + zwischen := subtext (zwischen , 1, length (zwischen) - 1) + PER. + normiere alternativen: + TEXT VAR altintern :: altzeile; + altintern CAT delimiter. + untersuche alternativen: + INT VAR altanzahl :: 1, altbreite, first :: - 2, anfang :: 1, + ende :: pos (altintern, delimiter, anfang) - 1; + + WHILE ende > 0 AND altanzahl <= 10 REP + trage alternative ein; + trage alternativenanfang ein; + trage alternativenlaenge ein; + setze neue positionen fest + PER; + ermittle gesamtalternativenbreite. + trage alternative ein: + altliste [altanzahl].alternat := + compress (subtext (altintern, anfang, ende)). + trage alternativenanfang ein: + first INCR 3; + altliste [altanzahl].anfang := first. + trage alternativenlaenge ein: + + altliste [altanzahl].laenge := length (altliste [altanzahl].alternat); + first INCR altliste [altanzahl].laenge. + setze neue positionen fest: + anfang := ende + 2; + ende := pos (altintern, delimiter, anfang) - 1; + altanzahl INCR 1. + ermittle gesamtalternativenbreite: + altanzahl DECR 1; + altbreite := altliste [altanzahl].anfang; + altbreite INCR (altliste [altanzahl].laenge + 3); + IF altbreite > areaxsize (w) - 6 + THEN LEAVE schreibe alternativen + + FI. + schreibe alternativenfuss: + schreibe leerzeile; + schreibe antwortmoeglichkeiten; + schreibe abschlusszeile; + IF mit abbruch + THEN out footnote (w, aussage [2]) + ELSE beruecksichtige ja nein hinweis + FI. + schreibe leerzeile: + cursor (x, y + ysize - 3); + out (senkrecht); + (xsize - 2) TIMESOUT blank; + out (senkrecht). + schreibe antwortmoeglichkeiten: + cursor (x, y + ysize - 2); + out (senkrecht); + einrueckbreite TIMESOUT blank; + + out (antwortleiste); + rest TIMESOUT blank; + out (senkrecht). + einrueckbreite: + (xsize - 2 - length (antwortleiste)) DIV 2. + antwortleiste: + INT VAR zeiger; TEXT VAR ausgabe :: ""; + FOR zeiger FROM 1 UPTO altanzahl REP + ausgabe CAT altliste [zeiger].alternat; + ausgabe CAT " " + PER; + compress (ausgabe). + rest: + xsize - 2 - einrueckbreite - length (antwortleiste). + schreibe abschlusszeile: + cursor (x, y + ysize - 1); + out (ecke unten links); + + (xsize - 2) TIMESOUT waagerecht; + out (ecke unten rechts). + beruecksichtige ja nein hinweis: + IF sonst = janeintasten + THEN out footnote (w, aussage [3]) + ELSE out footnote (w, aussage [4]) + FI. + lasse auswaehlen: + INT VAR altzeiger :: 1; + stelle erste alternative invers dar; + REP + hole eingabe; + werte eingabe aus und reagiere + UNTIL alternative gefunden PER. + stelle erste alternative invers dar: + cursor (x + einrueckbreite, y + ysize - 2); + + out (mark ein); + out (altliste [altzeiger].alternat); out (blank); + out (mark aus); + cursor (x + einrueckbreite, y + ysize - 2). + hole eingabe: + TEXT VAR moegliche, eingabe; + IF mit abbruch + THEN moegliche := rechts links esc return + sonst + ELSE moegliche := rechts links null return + sonst + FI; + clear buffer; + REP + inchar (eingabe); + piepse bei unzulaessiger eingabe + UNTIL pos (moegliche, eingabe) > 0 PER. + piepse bei unzulaessiger eingabe: + + IF pos (moegliche, eingabe) = 0 THEN out (piep) FI. + werte eingabe aus und reagiere: + SELECT pos (moegliche, eingabe) OF + CASE 1: zur naechsten alternative + CASE 2: zur vorausgehenden alternative + CASE 3: esc kommando verarbeiten + END SELECT. + zur naechsten alternative: + loesche aktuelle alternative; + ermittle rechte alternative; + stelle neue alternative invers dar. + zur vorausgehenden alternative: + loesche aktuelle alternative; + ermittle linke alternative; + + stelle neue alternative invers dar. + loesche aktuelle alternative: + cursor (alternativenanfang - 1, y + ysize - 2); + out (blank); + out (altliste [altzeiger].alternat); + out (2 * blank). + alternativenanfang: + x + einrueckbreite + altliste [altzeiger].anfang. + ermittle rechte alternative: + IF altzeiger = altanzahl + THEN altzeiger := 1 + ELSE altzeiger INCR 1 + FI. + ermittle linke alternative: + IF altzeiger = 1 + THEN altzeiger := altanzahl + + ELSE altzeiger DECR 1 + FI. + stelle neue alternative invers dar: + cursor (alternativenanfang - 1, y + ysize - 2); + out (mark ein); + out (altliste [altzeiger].alternat); out (blank); + out (mark aus); + cursor (alternativenanfang - 1, y + ysize - 2). + esc kommando verarbeiten: + inchar (eingabe); + IF eingabe = "h" + THEN ergebnis := 0; + LEAVE schreibe alternativen + ELSE out (piep); eingabe := "" + FI. + alternative gefunden: + pos (moegliche, eingabe) > 3. + + liefere ergebnis: + IF pos (moegliche, eingabe) = 4 + THEN ergebnis := altzeiger + ELSE ergebnis := 100 + pos (sonst, eingabe) + FI. +END PROC schreibe alternativen; +BOOL PROC ja (WINDOW VAR w, TEXT CONST t, INT CONST position, + INT VAR x, y, xsize, ysize): + INT VAR ergebnis; + schreibe alternativen (w, t, aussage [7], janeintasten, position, + FALSE, x, y, xsize, ysize, ergebnis); + SELECT ergebnis OF + CASE 2, 105, 106: FALSE + OTHERWISE TRUE + + END SELECT. +END PROC ja; +TEXT PROC hole antwort (WINDOW VAR w, TEXT CONST t, vorgabe, + INT CONST position, BOOL CONST mit auswahl, + INT VAR x, y, xsize, ysize): + TEXT VAR eingabe :: compress (vorgabe); + schreibe boxtext (w, t, position, 2, length (aussage [8]) + 12, 2, + x, y, xsize, ysize); + schreibe antwortfuss; + clear buffer; + REP + IF eingabe = "break" + THEN eingabe := "" + FI; + lasse eintragen + + UNTIL eingabe <> "break" PER; + liefere ergebnis. + schreibe antwortfuss: + schreibe leerzeile; + schreibe eingabezeile; + schreibe abschlusszeile; + IF mit auswahl + THEN out footnote (w, aussage [5]) + ELSE out footnote (w, aussage [6]) + FI. + schreibe leerzeile: + cursor (x, y + ysize - 3); + out (senkrecht); + (xsize - 2) TIMESOUT blank; + out (senkrecht). + schreibe eingabezeile: + cursor (x, y + ysize - 2); + out (senkrecht); + out (aussage [8]); + + (xsize - 2 - length (aussage [8])) TIMESOUT blank; + out (senkrecht). + schreibe abschlusszeile: + cursor (x, y + ysize - 1); + out (ecke unten links); + (xsize - 2) TIMESOUT waagerecht; + out (ecke unten rechts). + lasse eintragen: + TEXT VAR exit :: ""; + cursor on; + cursor (x + length (aussage [8]) + 1, y + ysize - 2); + IF mit auswahl + THEN editget (eingabe, maxtextlength, textlaenge, "", "hz", exit) + ELSE editget (eingabe, maxtextlength, textlaenge, "", "h", exit) + + FI; + cursor off; + IF exit = ""27"h" + THEN eingabe := "" + ELIF mit auswahl AND (exit = ""27"z") + THEN eingabe := ""27"z" + ELSE eingabe := compress (eingabe) + FI. + textlaenge: + xsize - 2 - length (aussage [8]). + liefere ergebnis: + eingabe. +END PROC hole antwort; +END PACKET ls dialog 4; + |