1
2
3
4
5
6
|
PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETmarkein=""15"",markaus=""14"",delimiter=""13"",piep=""7"",cleol=""5"",rechtslinksescreturn=""2""8""27""13"",rechtslinksnullreturn=""2""8""0""13"" ,gueltigezeichen=""10""3""13"",esc=""27"",auswahl="z",abbruch="m",
trennliniensymbol="-",blank=" ",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: <Pfeile> Bestätigen: <RETURN> Menü: <ESC><m>"," Wählen: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>"," Wählen: <Pfeile> Bestätigen: <RETURN>"," Bestätigen: <RETURN> Zeigen: <ESC><z> Menü: <ESC><m>"," Bestätigen: <RETURN> Menü: <ESC><m>","Ja
Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):boxinfo(w,t,position,timelimit,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint,TRUE)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,PROC(AREA CONST)restore):boxinfo(w,t,5,maxint,TRUE,PROCrestore)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,trennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,ergebnis,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,TRUE)END PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg,PROC(AREA CONST)restore):INT VARx,y,xsize,ysize,spa,zei;AREA VARboxarea;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);fill(boxarea,x,y,xsize,ysize);restore(boxarea);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):boxyes(w,t,position,TRUE)END PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt
,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,BOOL CONSTtrennlinieweg):NOTboxyes(w,t,position,trennlinieweg)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTtrennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):boxanswer(w,t,vorgabe,position,TRUE)END PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswerone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswerone(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnoteFI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung,trennlinieweg):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnoteFI.END PROCboxanswersome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):boxanswersome(w,text,vorgabe,thesaurus,t1,t2,mitreinigung,TRUE)END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize))
PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+" "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI.
lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=compress(vorgabe);schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:=""ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahlELSEeingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabe.END PROCholeantwort;END PACKETlsdialog4;
|
