(* ********************************************************* ********************************************************* ** ** ** ls-DIALOG 4 ** ** ** ** 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 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: Bestätigen: Abbruch: ", " Ändern: Bestätigen: Ja: Nein: ", " Ändern: Bestätigen: ", " Fertig: Zeigen: Abbruch: ", " Fertig: Abbruch: ", "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;