1
2
3
4
5
6
7
|
PACKETlsdialog2DEFINESsome,one,lsexitkey,resetlsexitkey,infixnamen,ohnepraefix,notempty:LETmaxentries=200;LETzeichenstring="���
�xo? ",obenuntenreturnruboutkreuzkringelblank="�
�xo ",qeinsneunh="w19m";LETzurueck="�",piep="�";LEThop=1,esc=2,oben=3,unten=4,return=5,rubout=6,kreuz=7,kringel=8,frage=9,leer=10;LETpunkt=".",blank=" ";INT VARx,y,xsize,ysize,maxeintraege,anzahl,ersteauswahlzeile,virtuellercursor,reellercursor;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="";BOOL VARabbruch,auswahlende;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW16TEXT CONSThinweis:=ROW16TEXT:(" Bitte warten...!"," Info: <?> Weiter: <ESC><w> Menü: <ESC><m>"," Weiter mit beliebiger Taste!","Weitere Einträge!"," INFORMATIONEN ZUR AUSWAHL AUS DER LISTE"," Positionierung der Schreibmarke:"," Pfeil auf/ab : eine Position nach oben/unten"," HOP Pfeil auf/ab : auf erste/letzte Pos. der Seite"," ESC 1/ESC 9 : auf erste/letzte Pos. der Liste"," Ankreuzen und Löschen von Kreuzen:"," RETURN/x : den Eintrag ankreuzen"," RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen"," HOP RETURN/HOP x : alle folgenden Eintr. ankreuzen"," HOP RUBOUT/HOP o : alle folgenden Kreuze löschen"," /HOP Leertaste"," Info: <?> Menü: <ESC><m>");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCresetlsexitkey:exitkey:=""END PROCresetlsexitkey;THESAURUS PROCauswahl(THESAURUS CONSTt,BOOL CONSTmehreremoeglich,TEXT CONSTt1,t2):TEXT VARlinie:=(xsize-2)*waagerecht;werteinitialisieren;namenbesorgen;bildschirmaufbauen;auswaehlenlassen;abgangvorbereiten.werteinitialisieren:THESAURUS VARausgabe:=emptythesaurus;DATASPACE VARds:=nilspace;eintrag:=ds;kennzeile1:=t1;kennzeile2:=t2;abbruch:=FALSE;ersteauswahlzeile:=y+5;anzahl:=0;maxeintraege:=ysize-8;virtuellercursor:=1;reellercursor:=1.namenbesorgen:fischedienamenausdemthesaurus;IFkeineintragvorhandenTHEN LEAVEauswahlWITHausgabeFI.bildschirmaufbauen:schreibekopfzeile;gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1);schreibefusszeile;IFmehreremoeglichTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;reellencursorsetzen.schreibekopfzeile:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreibefusszeile:cursor(x,y+ysize-2);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).auswaehlenlassen:kreuzean(mehreremoeglich).abgangvorbereiten:footnote(hinweis[1]);cursor(x+1,y+ysize-1);ausgabeerzeugen;forget(ds);ausgabe.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.ausgabeerzeugen:TEXT VARnummer;WHILEregistrierkette<>""REPnummer:=subtext(registrierkette,1,3);registrierkette:=subtext(registrierkette,5);insert(ausgabe,eintrag[int(nummer)])PER.END PROCauswahl;PROCreellencursorsetzen:cursor(x+1,ersteauswahlzeile+reellercursor-1);out(marke(virtuellercursor,TRUE)+8*zurueck)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):TEXT VARpunktlinie:=(xsize-2)*punkt,weiterzeile:=(xsize-length(hinweis[4])-5)*punkt+invers(hinweis[4]),beamedleerzeile:=senkrecht+(xsize-2)*blank+senkrecht;gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x,ersteauswahlzeile-1);out(senkrecht);IFreellercursor=virtuellercursorTHENout(punktlinie)ELSEout(weiterzeile)FI;out(senkrecht);line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;TEXT VARhilf;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x,ersteauswahlzeile+zaehler);hilf:=senkrecht;hilfCATmarke(zeiger,FALSE);hilfCATtext(subtext(eintrag[zeiger],1,xsize-10),xsize-10);hilfCATsenkrecht;out(hilf)PER.gibfusszeileaus:cursor(x,ersteauswahlzeile+zaehler+1);out(senkrecht);IF NOT((virtuellercursor+maxeintraege-reellercursor)<anzahl)THENout(punktlinie)ELSEout(weiterzeile)FI;out(
senkrecht).loescheggfrestbereich:IFzaehler+1<maxeintraegeTHENloeschebildschirmrestFI.loeschebildschirmrest:FORzeigerFROMrestanfangUPTOrestendeREPcursor(x,zeiger);out(beamedleerzeile)PER.restanfang:ersteauswahlzeile+zaehler+2.restende:ersteauswahlzeile+maxeintraege.grenze:min(anzahl,anfang+maxeintraege-1).END PROCbauebildschirmauf;TEXT PROCmarke(INT CONSTzeiger,BOOL CONSTmitcursor):INT VARplatz:=nr(zeiger);IFplatz=0THENleerELSEmitzahlFI.mitzahl:TEXT VARhilf;IFmitcursorTHENhilf:="==>";ELSEhilf:=" "END IF;hilfCAT(3-length(text(platz)))*blank;hilfCATtext(platz);hilfCAT"x ";hilf.leer:IFmitcursorTHEN"==> o "ELSE" o "FI.END PROCmarke;INT PROCnr(INT CONSTzeiger):IFpos(registrierkette,textstring(zeiger))=0THEN0ELSE(pos(registrierkette,textstring(zeiger))DIV4)+1FI END PROCnr;TEXT PROCtextstring(INT CONSTnr):text(nr,3)+"!"END PROCtextstring;PROCinfo:INT VARi;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(x+1,y+1);out(center(xsize-2,hinweis[5]));cursor(x+1,y+2);out("",xsize-2).notierepositionierhinweise:cursor(x+1,y+3);out(hinweis[6],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO7REPcursor(x+1,y+i);out(hinweis[i+2],xsize-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(x+1,y+8);out("",xsize-2);cursor(x+1,y+9);out(hinweis[10],xsize-2);cursor(x+1,y+10);out("",xsize-2);FORiFROM11UPTO15REPcursor(x+1,y+i);out(hinweis[i],xsize-2)PER;loeschedierestlichenzeilen;footnote(hinweis[3]);cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMy+16UPTOy+ysize-3REPcursor(x+1,i);out("",xsize-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[3]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(x+1,y+3);out(hinweis[10],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO9REPcursor(x+1,y+i);out(hinweis[i+6],xsize-2)PER;FORzaehlerFROM10UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.cursorinruhestellung:cursor(x+1,y+ysize-2).stellealtenbildschirmzustandwiederher:clearbuffer;pause;gibhinweisaus(kennzeile1,kennzeile2);virtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzen.nochplatzvorhanden:ysize>17.END PROCinfo;PROCkreuzean(BOOL CONSTmehrere):auswahlende:=FALSE;clearbuffer;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;getchar(zeichen).zeicheninterpretieren:SELECTpos(zeichenstring,zeichen)OF CASEhop:hopkommandoverarbeiten(mehrere)CASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEkreuz,return:ankreuzenweiter;evtlaufhoerenCASErubout,kringel,leer:auskreuzenweiterCASEfrage:info;IFmehrereTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;OTHERWISEout(piep)END SELECT.evtlaufhoeren:IF NOTmehrereTHEN LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten(BOOL CONSTmehrere):zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;getchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(obenuntenreturnruboutkreuzkringelblank,zweiteszeichen)OF CASE1:hopnachobenCASE2:hopnachuntenCASE3,5:IFmehrereTHENalledarunterankreuzenFI CASE4,6,7:IFmehrereTHENalledarunterloeschenFI OTHERWISEout(piep)END SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREP IFnr(i)=0THENankreuzenFI PER;bildaktualisieren;reellencursorsetzen.ankreuzen:registrierketteCATtextstring(i).alledarunterloeschen:INT VARj,position;FORjFROMvirtuellercursorUPTOanzahlREPposition:=nr(j);IFposition>0THENrausschmeissen;FI PER;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,(4*position)-4)+subtext(registrierkette,(4*position)+1).hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaettern
ELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschemarke;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschemarke;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;getchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:auswahlende:=TRUE CASE2:zeigeanfangCASE3:zeigeendeCASE4:abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT;exitkey:=zweiteszeichen.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschemarke;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschemarke;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)<maxeintraege+1.END PROCesckommandoverarbeiten;PROCankreuzen:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;reellencursorsetzenEND PROCankreuzen;PROCankreuzenweiter:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;IFvirtuellercursor<anzahlTHENnachuntenFI;IFvirtuellercursor=anzahlTHENreellencursorsetzenFI END PROCankreuzenweiter;PROCauskreuzenweiter:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissen;END IF;IFvirtuellercursor<anzahlTHENnachuntenELSEloeschemarkeFI;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzenweiter;PROCauskreuzen:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissenEND IF;loeschemarke;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzen;PROCbildaktualisieren:INT VARob,un,i,zaehler:=-1;ob:=virtuellercursor-reellercursor+1;un:=min(ob+maxeintraege-1,anzahl);FORiFROMobUPTOunREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);out(marke(i,FALSE))PER END PROCbildaktualisieren;PROCnachoben:IFnochnichtobenTHENgehenachobenELSEout(piep)FI.nochnichtoben:virtuellercursor>1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschemarke;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursor<anzahl.gehenachunten:IFreellercursor>maxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschemarke;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCloeschemarke:out(marke(virtuellercursor,FALSE))END PROCloeschemarke;PROCgibhinweisaus(TEXT CONSTt1,t2):
cursor(x,y+1);out(senkrecht);out(center(xsize-2,invers(t1)));out(senkrecht);cursor(x,y+2);out(senkrecht);out("",xsize-2);out(senkrecht);cursor(x,y+3);out(senkrecht);out(center(xsize-2,t2));out(senkrecht)END PROCgibhinweisaus;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROCohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<56COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5).END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-5)THENsubtext(text,1,xsize-7)+".."ELSEtextFI END PROCggfgekuerztertext;THESAURUS PROCsome(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);auswahl(t,TRUE,text1,text2)END PROCsome;THESAURUS PROCsome(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTt,TEXT CONSTt1,t2):some(1,1,79,24,t,t1,t2)END PROCsome;TEXT PROCone(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);name(auswahl(t,FALSE,text1,text2),1)END PROCone;TEXT PROCone(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTt,TEXT CONSTt1,t2):one(1,1,79,24,t,t1,t2)END PROCone;END PACKETlsdialog2;
|
