From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- app/schulis/2.2.1/src/6.ida.druck | 261 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 261 insertions(+) create mode 100644 app/schulis/2.2.1/src/6.ida.druck (limited to 'app/schulis/2.2.1/src/6.ida.druck') diff --git a/app/schulis/2.2.1/src/6.ida.druck b/app/schulis/2.2.1/src/6.ida.druck new file mode 100644 index 0000000..d24c0cd --- /dev/null +++ b/app/schulis/2.2.1/src/6.ida.druck @@ -0,0 +1,261 @@ +PACKET idadruckDEFINES listendruck,ausdruckauswerten,bschirm,drucker, +namederdruckausgabe,namederdruckausgabeohne,druckausgabeausgeben,ruecksprung, +zurueck,postext,seitenweise:LET linkeklammer="<",rechteklammer=">", +platzhalter="�",linefeed=" ",trenner=" ",kzkosmetik="#",kzseitenzahl="%", +ddrucker=1,dbschirm=2,mlddrucken=58,mldaufb=190;TEXT VAR filename:= +"ISP-Liste";INT CONST drucker:=ddrucker,bschirm:=dbschirm;FILE VAR ausgfile; +INT VAR dbauswertung,anzzeilen,zeilenzaehler:=0,fusszeilen:=0,kopfzeilen:=0, +aktuelleseite:=0,aktuellerds:=0,zeilenlaenge,verbund;BOOL VAR tupelbearbeitet +,isppageform:=FALSE ;TEXT VAR restderletztenzeile:="";TEXT VAR schriftart:="" +,kopfbereich:="",fussbereich:="",kosmetikbereich:="zzzz";REAL VAR links,oben; +#nurtest!!!!!!PROC standardmeldung(INT CONST mldaufb,TEXT CONST t):fehler( +"MELDUNG: "+text(mldaufb)+" "+t)ENDPROC standardmeldung;PROC editiere(TEXT +CONST fname,BOOL CONST f):edit(fname)ENDPROC editiere;PROC enter(INT CONST i) +:ENDPROC enter;#PROC seitenweise(BOOL CONST jn):isppageform:=jnENDPROC +seitenweise;BOOL PROC seitenweise:isppageformENDPROC seitenweise;TEXT PROC +rechtscompress(TEXT CONST zeile):TEXT VAR z:=zeile;INT VAR p:=length(zeile); +WHILE p>0CAND (zSUB p)=trennerREP pDECR 1PER ;z:=text(z,p);zENDPROC +rechtscompress;INT PROC bestimmevorhandeneblanks(TEXT CONST zeile):INT VAR +vorhandeneblanks:=0,i;FOR iFROM 1UPTO length(zeile)REP IF (zeileSUB i)= +trennerTHEN vorhandeneblanksINCR 1FI UNTIL (zeileSUB i)<>trennerPER ; +vorhandeneblanksENDPROC bestimmevorhandeneblanks;TEXT PROC +textmitfuehrendenblanks(TEXT CONST z,INT CONST anzblanks):INT VAR +vorhandeneblanks:=0;TEXT VAR zeile:=z;vorhandeneblanks:= +bestimmevorhandeneblanks(zeile);IF vorhandeneblanks>anzblanksTHEN +zeilekuerzenELSE mitblanksauffuellenFI ;zeile.zeilekuerzen:zeile:=subtext( +zeile,vorhandeneblanks-anzblanks).mitblanksauffuellen:zeile:=(anzblanks- +vorhandeneblanks)*trenner+zeile.ENDPROC textmitfuehrendenblanks;TEXT PROC +aktfilename:IF aktuellerds=0THEN filenameELSE filename+"."+text(aktuellerds) +FI ENDPROC aktfilename;PROC schreibebereich(TEXT CONST bereich,BOOL CONST +kopf):INT VAR von:=0,bis;TEXT VAR zeile:="";bis:=pos(bereich,linefeed);WHILE +bis>0REP zeile:=subtext(bereich,von+1,bis-1);IF kopfTHEN changeall(zeile, +kzseitenzahl,text(aktuelleseite));zeilenzaehlerINCR 1FI ;putline(ausgfile, +zeile);von:=bis;bis:=pos(bereich,linefeed,von+1);PER ENDPROC schreibebereich; +PROC schreibekopf:schreibebereich(kopfbereich,TRUE )ENDPROC schreibekopf; +PROC schreibefuss:schreibebereich(fussbereich,FALSE )ENDPROC schreibefuss; +PROC seitenvorschub:schreibefuss;IF filefastvollTHEN ausgabedateianlegenELSE +putline(ausgfile,"#page#")FI ;zeilenzaehler:=0;aktuelleseiteINCR 1; +schreibekopf.filefastvoll:lines(ausgfile)>=3000COR storage(old(aktfilename))> +700.ENDPROC seitenvorschub;PROC pageeinfuegen:putline(ausgfile,"#page#"); +zeilenzaehler:=0;ENDPROC pageeinfuegen;PROC zeilenvorschubundfussdrucken: +WHILE zeilenzaehler0THEN auszeile:=restderletztenzeile;IF +keintrennerzwischenzeilenTHEN auszeileCAT trennerFI FI ;auszeileCAT zeile; +restderletztenzeile:="";IF length(auszeile)<=zeilenlaengeTHEN putlein( +auszeile,FALSE )ELSE bestimmelinkenrand;WHILE length(auszeile)>zeilenlaenge +REP trennpositionbestimmen;zeileausgebenundkürzen;PER ;IF length(auszeile)>0 +THEN IF blocksatzTHEN putlein(auszeile,FALSE )ELSE restderletztenzeile:= +textmitfuehrendenblanks(auszeile,linkerrand)FI FI FI . +keintrennerzwischenzeilen:(restderletztenzeileSUB length(restderletztenzeile) +)<>trennerCAND (zeileSUB 1)<>trenner.bestimmelinkenrand:linkerrand:= +bestimmevorhandeneblanks(auszeile);.trennpositionbestimmen:trennpos:= +zeilenlaenge;WHILE trennpos>linkerrandCAND (auszeileSUB trennpos)<>trenner +REP trennposDECR 1PER ;IF trennpos<=linkerrandTHEN trennpos:=max(zeilenlaenge +,linkerrand+1);WHILE trennpos<=length(auszeile)CAND (auszeileSUB trennpos)<> +trennerREP trennposINCR 1PER ;FI .zeileausgebenundkürzen:putlein( +rechtscompress(text(auszeile,trennpos-1)),FALSE );auszeile:=compress(subtext( +auszeile,trennpos+1));IF length(auszeile)>0THEN auszeile:= +textmitfuehrendenblanks(auszeile,linkerrand)FI .ENDPROC putzeile;PROC +nextergebnistupel:INT VAR dnr;qsucc(verbund,dnr);tupelbearbeitet:=FALSE ; +verbund:=gettiefennr(verbund);IF dbstatus=endoffileCAND dbauswertung= +ordernewstackTHEN auswertungfortsetzen;dbauswertung:=dbstatus;qsucc(verbund, +dnr);verbund:=gettiefennr(verbund);FI ENDPROC nextergebnistupel;TEXT PROC +sonderfunktion(TEXT CONST stcode):TEXT VAR t:=stcode,ausdruck:=stcode;IF ( +ausdruckSUB 1)=linkeklammerTHEN deletechar(ausdruck,1)FI ;IF (ausdruckSUB +length(ausdruck))=rechteklammerTHEN deletechar(ausdruck,length(ausdruck))FI ; +IF ausdruck="tagesdatum"THEN t:=dateELIF ausdruck="tag"THEN t:=day(date(date) +)ELIF ausdruck="monat"THEN t:=month(date(date))ELIF ausdruck="jahr"THEN t:= +year(date(date))ELIF ausdruck="zeit"THEN t:=timeofdayELIF ausdruck="tt"THEN t +:=text(date,2)ELIF ausdruck="mm"THEN t:=subtext(date,4,5)ELIF ausdruck="jj" +THEN t:=subtext(date,7)FI ;tENDPROC sonderfunktion;TEXT PROC +aufbereitetezeile(TEXT CONST zeile,einfuegstellen):TEXT VAR auszeile:="", +auswert:="",ausdruck:="";INT VAR p:=1,pp,ppalt:=1,ix,laenge;BOOL VAR rbuendig +,druckvar;pp:=pos(zeile,platzhalter,ppalt);WHILE pp>0REP auszeileCAT subtext( +zeile,ppalt,pp-1);ix:=decodezahl(einfuegstellen,p);IF ix>0THEN getsteuercode( +ix,ausdruck,laenge,rbuendig,druckvar);IF druckvarTHEN auswert:= +ausdruckauswerten(ausdruck);aufbereitenundschreiben;ELSE auswert:= +sonderfunktion(ausdruck);aufbereitenundschreiben;FI FI ;ppalt:=pp+1;pp:=pos( +zeile,platzhalter,ppalt);PER ;auszeileCAT subtext(zeile,ppalt);auszeile. +aufbereitenundschreiben:IF laenge>0THEN IF length(auswert)>=laengeCOR NOT +rbuendigTHEN auswert:=text(auswert,laenge)ELSE auswert:=((laenge-length( +auswert))*" ")+auswertFI ;FI ;auszeileCAT auswert.ENDPROC aufbereitetezeile; +PROC druckezeile(TEXT CONST zeile,einfuegstellen):putzeile(aufbereitetezeile( +zeile,einfuegstellen))ENDPROC druckezeile;PROC druckeblock(INT CONST blocknr) +:INT VAR aktzeile:=1,pb,pz,nextblock,nextblockvorzeile;REP IF aktzeile=1CAND +verbund=blocknrTHEN tupelbearbeitet:=TRUE FI ;pb:=1;pz:=1;bestimmeunterblock; +WHILE aktzeile<=getzeilenanzahl(blocknr)COR aktzeile=nextblockvorzeileREP IF +aktzeile=nextblockvorzeileTHEN IF verbundblocknrTHEN LEAVE druckeblockFI ELIF verbund<>blocknrTHEN LEAVE +druckeblockFI UNTIL blocknr=0PER .innerhalbkosmetikbereich:(blocknr=0)CAND (( +aktzeile>=code(kosmetikbereichSUB 1)CAND aktzeile<=code(kosmetikbereichSUB 2) +)COR (aktzeile>=code(kosmetikbereichSUB 3)CAND aktzeile<=code(kosmetikbereich +SUB 4))).bestimmeunterblock:nextblock:=decodezahl(getunterbloecke(blocknr),pb +);nextblockvorzeile:=decodezahl(getvorzeilennr(blocknr),pz);.ENDPROC +druckeblock;PROC listendruck(INT CONST nr):listendruck(nr,bschirm)ENDPROC +listendruck;PROC ausgabedateianlegen:aktuellerdsINCR 1;forget(aktfilename, +quiet);ausgfile:=sequentialfile(output,aktfilename);putlein(schrifttyp,TRUE ) +;putlein(startanweisung,TRUE );zeilenzaehler:=0.schrifttyp:IF schriftart="" +THEN ""ELSE "#type ("""+schriftart+""")#"FI .startanweisung:"#start("+text( +links)+","+text(oben)+")# ".ENDPROC ausgabedateianlegen;PROC +headundbottommerken:#block(0)nachheadundbottomuntersuchen#INT VAR aktzeile:=1 +,p;TEXT VAR ausdruck:="",zeile:="";kopfzeilen:=0;fusszeilen:=0;kopfbereich:= +"";fussbereich:="";kosmetikbereich:="zzzz";WHILE aktzeile<=getzeilenanzahl(0) +REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;p:=pos(zeile,kzkosmetik);IF p> +0THEN ausdruckeinlesen;IF ausdruck="head"THEN kopfeinlesenELIF ausdruck= +"bottom"THEN fusseinlesenFI ;FI ;PER .ausdruckeinlesen:ausdruck:=compress( +subtext(zeile,p+1,pos(zeile,kzkosmetik,p+1)-1)).bereichsende:p:=pos(zeile, +kzkosmetik);IF p>0THEN ausdruckeinlesen;pos(";head;bottom;end;",";"+ausdruck+ +";")>0ELSE FALSE FI .kopfeinlesen:replace(kosmetikbereich,1,code(aktzeile-1)) +;REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsendeTHEN replace( +kosmetikbereich,2,code(aktzeile-1));LEAVE kopfeinlesenELSE kopfzeilenINCR 1; +zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile-1));kopfbereich +CAT (zeile+linefeed)FI PER .fusseinlesen:replace(kosmetikbereich,3,code( +aktzeile-1));REP zeile:=getzeile(0,aktzeile);aktzeileINCR 1;IF bereichsende +THEN replace(kosmetikbereich,4,code(aktzeile-1));LEAVE fusseinlesenELSE +fusszeilenINCR 1;zeile:=aufbereitetezeile(zeile,geteinfuegstellen(0,aktzeile- +1));fussbereichCAT (zeile+linefeed)FI PER .ENDPROC headundbottommerken;PROC +listendruck(INT CONST nr,INT CONST medium):REAL VAR limit;INT VAR fontnr:=0; +getdruckaufbereitung(schriftart,links,oben,anzzeilen,limit);schriftartpruefen +;zeilenlaenge:=int(limit);#IF seitenweiseTHEN #headundbottommerken; +aktuelleseite:=1;aktuellerds:=-1;ausgabedateianlegen;IF seitenweiseTHEN +schreibekopfFI ;auswertung("QUERY."+text(nr));dbauswertung:=dbstatus; +restderletztenzeile:="";verbund:=-1;tupelbearbeitet:=TRUE ;druckeblock(0);IF +length(restderletztenzeile)>0THEN putzeile("")FI ;IF seitenweiseCAND +fusszeilen>0THEN zeilenvorschubundfussdruckenFI ;druckegesamtliste. +schriftartpruefen:disablestop;fontnr:=font(schriftart);IF iserrorTHEN +schriftart:="";clearerror;ELIF fontnr=0THEN schriftart:=font(1)FI ;enablestop +.druckegesamtliste:BOOL VAR cd:=commanddialogue;INT VAR i;IF seitenweiseCOR +schriftart=""THEN druckausgabeausgeben(filename,medium);IF seitenweiseCAND +aktuellerds>0CAND medium=druckerTHEN FOR iFROM 1UPTO aktuellerdsREP +druckausgabeausgeben(filename,medium);PER FI ELSE sysout("dummy"); +commanddialogue(FALSE );standardmeldung(mldaufb,"");autopageform(filename); +forget(filename,quiet);sysout("");forget("dummy",quiet);commanddialogue(cd); +druckausgabeausgeben(filename+".p",medium)FI .ENDPROC listendruck;TEXT PROC +namederdruckausgabeohne:filenameENDPROC namederdruckausgabeohne;TEXT PROC +namederdruckausgabe:filename+".p"ENDPROC namederdruckausgabe;PROC +namederdruckausgabe(TEXT CONST fname):filename:=fnameENDPROC +namederdruckausgabe;PROC druckausgabeausgeben(TEXT CONST fname,INT CONST +medium):SELECT mediumOF CASE dbschirm:caufanfang;editiere(fname,FALSE );CASE +ddrucker:standardmeldung(mlddrucken,"");print(fname);enter(1)OTHERWISE : +errorstop("Falscher Druck-Code")ENDSELECT ;zurueck.caufanfang:FILE VAR f:= +sequentialfile(modify,fname);toline(f,1).ENDPROC druckausgabeausgeben;BOOL +VAR rueck:=FALSE ;PROC zurueck:rueck:=TRUE ENDPROC zurueck;BOOL PROC +ruecksprung:BOOL VAR b:=rueck;rueck:=FALSE ;bENDPROC ruecksprung;LET +parametergrenze="%",parametertrennzeichen="#",otherwise="*",niltext="", +textbegrenzer="""";INT PROC postextende(TEXT CONST ausgabe,INT CONST +aktuelleposition):INT VAR neupos:=aktuelleposition+1;WHILE (ausgabeSUB neupos +)<>textbegrenzerREP neuposINCR 1;IF (ausgabeSUB neupos)=textbegrenzerCAND ( +ausgabeSUB neupos+1)=textbegrenzerTHEN neuposINCR 2;FI ;UNTIL neupos>length( +ausgabe)PER ;neupos+1ENDPROC postextende;INT PROC postext(TEXT CONST source, +pattern,INT CONST from):INT VAR p:=from;WHILE (sourceSUB p)<>patternREP +nextcharUNTIL p>length(source)PER ;#9.12.87#IF p>length(source)THEN 0ELSE p +FI .nextchar:IF (sourceSUB p)=textbegrenzerTHEN p:=postextende(source,p)ELSE +pINCR 1;#9.12.87#FI .ENDPROC postext;TEXT PROC dbwert(TEXT CONST feldname, +BOOL VAR textvergleich):LET null="0",nulldatum="01.01.00";TEXT VAR ausgabe:= +"";INT CONST fnr:=feldnr(compress(feldname));IF fnr>0THEN ausgabe:=wert(fnr); +IF ((feldtyp(fnr)=intfeld)CAND (ausgabe=null))COR ((feldtyp(fnr)=datumfeld) +CAND (ausgabe=nulldatum))THEN ausgabe:=""FI ;textvergleich:=NOT (feldtyp(fnr) +=realfeldCOR feldtyp(fnr)=intfeld)ELSE textvergleich:=TRUE FI ;ausgabeEND +PROC dbwert;TEXT PROC auswerten(TEXT CONST eingabe):INT VAR +positionlinkeklammer:=1,positionrechteklammer:=1,positionlinkeskreuz, +positionrechteskreuz,positionmittlereskreuz,positionparametergrenze, +aktuelleposition:=1,positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR +ausdruckvorhanden,caseaufruf,linkeseitevariabel,rechteseitevariabel, +textvergleich;TEXT VAR puffer,vergleichswert,aktuellessymbol,parameter1, +ausgabe:=compress(eingabe);REP zeichenketteueberlesen; +auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN +bestimmungdesfeldnamensfuerdieprozedurdbwert;aufrufderprozedurdbwert;IF +caseaufrufTHEN bestimmungderrichtigenalternativeFI ; +einsetzendesfeldwertsoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ; +ausgabe.zeichenketteueberlesen:INT VAR p:=aktuelleposition;#1#BOOL VAR +innerhalbzeichenkette:=TRUE ;IF (ausgabeSUB p)=linkeklammerTHEN pINCR 1;FI ; +IF aktuelleszeichenisttextbegrenzerTHEN WHILE innerhalbzeichenketteREP REP +UNTIL textendeCOR aktuelleszeichenisttextbegrenzerPER ;IF NOT textendeCAND ( +ausgabeSUB p)=textbegrenzerTHEN innerhalbzeichenkette:=TRUE ;pINCR 1ELSE +innerhalbzeichenkette:=FALSE ;FI PER ;pDECR 1;aktuelleposition:=p; +leerzeichenentfernen;FI .aktuelleszeichenisttextbegrenzer:IF (ausgabeSUB p)= +textbegrenzerTHEN deletechar(ausgabe,p);TRUE ELSE pINCR 1;FALSE FI .textende: +p>length(ausgabe).leerzeichenentfernen:WHILE (ausgabeSUB p)=" "REP deletechar +(ausgabe,p)PER .auffindeneinesspitzgeklammertenausdrucks:#aktuelleposition:=0 +;#linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:= +pos(ausgabe,linkeklammer,aktuelleposition);ausdruckvorhanden:= +aktuelleposition<>0;positionlinkeklammer:=aktuelleposition. +bestimmungdesfeldnamensfuerdieprozedurdbwert: +ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenfeldnamen;IF +aktuellessymbol=rechteklammerTHEN caseaufruf:=FALSE ;fuehreleseoperationaus; +ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ; +positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus: +aktuellepositionINCR 1;IF aktuelleposition>length(ausgabe)THEN +aktuellessymbol:=rechteklammerELSE aktuellessymbol:=ausgabeSUB +aktuelleposition;FI ;IF aktuellessymbol=linkeklammerTHEN +anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol=rechteklammerTHEN +anzahldergeoeffnetenklammernDECR 1FI .fuehreleseoperationausmittextueberlesen +:aktuellepositionINCR 1;IF (ausgabeSUB aktuelleposition)=textbegrenzerTHEN +aktuelleposition:=postextende(ausgabe,aktuelleposition)FI ;IF +aktuelleposition>length(ausgabe)THEN aktuellessymbol:=rechteklammerELSE +aktuellessymbol:=ausgabeSUB aktuelleposition;FI ;IF aktuellessymbol= +linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol= +rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI . +ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus; +linkeseitevariabel:=aktuellessymbol=linkeklammer.bestimmedenfeldnamen:WHILE +NOT (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=parametergrenze +OR aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER ;IF +linkeseitevariabelTHEN parameter1:=(subtext(ausgabe,positionlinkeklammer+2, +aktuelleposition-1))ELSE parameter1:=(subtext(ausgabe,positionlinkeklammer+1, +aktuelleposition-1))FI .ueberpruefeobrechteseitedoppeltgeklammert:IF +aktuellessymbol=rechteklammerTHEN rechteseitevariabel:=TRUE ; +positionrechteklammer:=aktuellepositionELSE positionrechteklammer:= +aktuelleposition-1FI .aufrufderprozedurdbwert:puffer:=dbwert(parameter1, +textvergleich).bestimmungderrichtigenalternative: +bestimmungdeserstenvergleichswertes;WHILE +vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP +suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen; +IF vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinTHEN +bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)= +otherwiseTHEN puffer:=auswerten(subtext(ausgabe,positionotherwise+1, +positionrechteklammer-1))ELSE bereitstelleneinerleerenalternativeFI . +bestimmungdeserstenvergleichswertes:positionlinkeskreuz:= +positionparametergrenze;positionmittlereskreuz:=postext(ausgabe, +parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe, +positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen. +suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz; +positionmittlereskreuz:=postext(ausgabe,parametertrennzeichen, +positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1, +positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen: +aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP +fuehreleseoperationausmittextueberlesenUNTIL (anzahldergeoeffnetenklammern=0 +AND (aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR +anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition; +positionotherwise:=aktuelleposition. +vergleichswertstimmtmitdemergebnisausdemdbwertaufrufueberein:IF textvergleich +THEN vergleichswert=pufferELSE real(vergleichswert)=real(puffer)FI . +bereitstellenderentsprechendenalternative:puffer:=auswerten(subtext(ausgabe, +positionmittlereskreuz+1,positionrechteskreuz-1)). +bereitstelleneinerleerenalternative:puffer:=niltext. +vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT +vergleichswertstimmtmitdemergebnisausdemdbwertaufrufuebereinAND +einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden: +aktuellessymbol=parametertrennzeichen. +positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0; +IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern +<0AND aktuellessymbol=rechteklammer)REP +fuehreleseoperationausmittextueberlesenPER FI ;positionrechteklammer:= +aktuelleposition.einsetzendesfeldwertsoderderalternative:change(ausgabe, +positionlinkeklammer,positionrechteklammer,puffer).ENDPROC auswerten;TEXT +PROC ausdruckauswerten(TEXT CONST ausdruck):TEXT VAR eingabe:=ausdruck;IF ( +eingabeSUB 1)<>linkeklammerTHEN insertchar(eingabe,linkeklammer,1)FI ;IF ( +eingabeSUB (length(eingabe)))<>rechteklammerTHEN eingabeCAT rechteklammerFI ; +auswerten(eingabe)ENDPROC ausdruckauswerten;ENDPACKET idadruck; + -- cgit v1.2.3