PACKET anschrgrundfunktionenfueranschreibenDEFINES volljaehrig, setzesonderwert,setzesonderwerteschulkenndaten,zeigeallesonderwerte, initialisieresonderwerte,sonderwert,indexadressat,adressat, setzeanzahlderzeichenprozeile,schrift,start,schreibesteuerzeichenzeile, briefalternative:LET linkeklammer="<",rechteklammer=">",parametergrenze="%", parametertrennzeichen="#",otherwise="*",niltext="";INT CONST indexadressat:= 510;LET swindexdatum=1,swindexschulname=2,swindexschulstrasse=3, swindexschulort=4,swindexschuljahr=5,swindexschulleiter=6, swindexnaechstesschuljahr=7,swindexvorangehendesschuljahr=8,swindexhalbjahr=9 ;LET kennzahlsonderwert=500;LET laengedessonderwertpuffers=100, anzahlsonderwerteschulkenndaten=10;LET volljaehrigkeitsalter=18;TEXT VAR schrifttyp:="pica",ersterparameterstartanweisung:="1.0", zweiterparameterstartanweisung:="1.0";INT VAR zeilenlaenge:=70;ROW laengedessonderwertpuffersTEXT VAR sonderwertpuffer;BOOL PROC volljaehrig( TEXT CONST alter):TEXT VAR stichtag:=date;change(stichtag,7,8,text(int( subtext(stichtag,7,8))-volljaehrigkeitsalter));datum(alter)<=datum(stichtag) END PROC volljaehrig;PROC initialisieresonderwerte:INT VAR z;FOR zFROM anzahlsonderwerteschulkenndaten+1UPTO laengedessonderwertpuffersREP sonderwertpuffer(z):=""PER END PROC initialisieresonderwerte;PROC initialisiereallesonderwerte:INT VAR z;FOR zFROM 1UPTO anzahlsonderwerteschulkenndatenREP sonderwertpuffer(z):=""PER ; initialisieresonderwerteEND PROC initialisiereallesonderwerte;PROC setzesonderwert(INT CONST index,TEXT CONST sondertext):IF (index>( kennzahlsonderwert+anzahlsonderwerteschulkenndaten))AND (index<= laengedessonderwertpuffers+kennzahlsonderwert)THEN sonderwertpuffer(index- kennzahlsonderwert):=sondertextFI END PROC setzesonderwert;PROC sonderwertefuernaechstesundvorangehendesschuljahr(TEXT CONST aktuellesschuljahr):sonderwertfuernaechstesschuljahr; sonderwertfuervorangehendesschuljahr.sonderwertfuernaechstesschuljahr: sonderwertpuffer(swindexnaechstesschuljahr):=addierezumerstenjahreins+"/"+ addierezumzweitenjahreins;.addierezumerstenjahreins:text((int(subtext( aktuellesschuljahr,1,2))+1)MOD 100).addierezumzweitenjahreins:text((int( subtext(aktuellesschuljahr,3,4))+1)MOD 100). sonderwertfuervorangehendesschuljahr:sonderwertpuffer( swindexvorangehendesschuljahr):=subtrahierevomerstenjahreins+"/"+ subtrahierevomzweitenjahreins;.subtrahierevomerstenjahreins:text((int(subtext (aktuellesschuljahr,1,2))+99)MOD 100).subtrahierevomzweitenjahreins:text((int (subtext(aktuellesschuljahr,3,4))+99)MOD 100).END PROC sonderwertefuernaechstesundvorangehendesschuljahr;PROC zeigeallesonderwerte: INT VAR z,z1;page;z:=1;REP FOR z1FROM 1UPTO 20REP putline(text(z)+" "+ sonderwertpuffer(z));zINCR 1;PER ;pauseUNTIL z>=laengedessonderwertpuffers PER ;END PROC zeigeallesonderwerte;TEXT PROC sonderwert(INT CONST swindex): IF swindex>kennzahlsonderwertAND swindex<=kennzahlsonderwert+ laengedessonderwertpuffersTHEN sonderwertpuffer(swindex-kennzahlsonderwert) ELSE niltextFI END PROC sonderwert;PROC adressat(TEXT CONST name): sonderwertpuffer(indexadressat-kennzahlsonderwert):=compress(subtext(name,1, 20))END PROC adressat;TEXT PROC lueckenwert(INT CONST fnr1):IF fnr1<= kennzahlsonderwertTHEN aufbereiteterdbwertELSE sonderwertpuffer(fnr1- kennzahlsonderwert)FI .aufbereiteterdbwert:IF (feldtyp(fnr1)=intfeldCAND intwert(fnr1)=0)COR (feldtyp(fnr1)=datumfeldCAND wert(fnr1)="01.01.00")THEN ""ELSE wert(fnr1)FI .END PROC lueckenwert;TEXT PROC zeilenalternative(TEXT CONST eingabe,BOOL CONST rekursiveraufruf):INT VAR positionlinkeklammer:=1, positionrechteklammer:=1,positionlinkeskreuz,positionrechteskreuz, positionmittlereskreuz,positionparametergrenze,parameter1,parameter2, positionparametertrennzeichen,laenge,pufferlaenge,aktuelleposition, positionotherwise,anzahldergeoeffnetenklammern;BOOL VAR ausdruckvorhanden, caseaufruf,linkeseitevariabel,rechteseitevariabel;TEXT VAR puffer, vergleichswert,aktuellessymbol,ausgabe:=eingabe;REP auffindeneinesspitzgeklammertenausdrucks;IF ausdruckvorhandenTHEN bestimmungderuebergabeparameterfuerdieprozedurlueckenwert; aufrufderprozedurlueckenwert;IF NOT caseaufrufTHEN bestimmungdesteiltextes ELSE bestimmungderrichtigenalternativeFI ; einsetzendesteiltextesoderderalternative;FI ;UNTIL NOT ausdruckvorhandenPER ; ausgabe.auffindeneinesspitzgeklammertenausdrucks:aktuelleposition:=0; linkeseitevariabel:=FALSE ;rechteseitevariabel:=FALSE ;aktuelleposition:=pos( ausgabe,linkeklammer);ausdruckvorhanden:=aktuelleposition<>0; positionlinkeklammer:=aktuelleposition. bestimmungderuebergabeparameterfuerdieprozedurlueckenwert: ueberpruefeoblinkeseitedoppeltgeklammert;bestimmedenerstenuebergabeparameter; IF aktuellessymbol<>parametertrennzeichenTHEN parameter2:=1;ELSE bestimmedenzweitenuebergabeparameterFI ;IF aktuellessymbol=rechteklammerTHEN caseaufruf:=FALSE ;fuehreleseoperationaus; ueberpruefeobrechteseitedoppeltgeklammertELSE caseaufruf:=TRUE ; positionparametergrenze:=aktuellepositionFI .fuehreleseoperationaus: aktuellepositionINCR 1;aktuellessymbol:=ausgabeSUB aktuelleposition;IF aktuellessymbol=linkeklammerTHEN anzahldergeoeffnetenklammernINCR 1ELIF aktuellessymbol=rechteklammerTHEN anzahldergeoeffnetenklammernDECR 1FI . ueberpruefeoblinkeseitedoppeltgeklammert:fuehreleseoperationaus; linkeseitevariabel:=aktuellessymbol=linkeklammer. bestimmedenerstenuebergabeparameter:WHILE NOT (aktuellessymbol= parametertrennzeichenOR aktuellessymbol=parametergrenzeOR aktuellessymbol= rechteklammer)REP fuehreleseoperationausPER ;IF linkeseitevariabelTHEN parameter1:=int(subtext(ausgabe,positionlinkeklammer+2,aktuelleposition-1)) ELSE parameter1:=int(subtext(ausgabe,positionlinkeklammer+1,aktuelleposition- 1))FI .bestimmedenzweitenuebergabeparameter:positionparametertrennzeichen:= aktuelleposition;REP fuehreleseoperationausUNTIL aktuellessymbol= parametergrenzeOR aktuellessymbol=rechteklammerPER ;parameter2:=int(subtext( ausgabe,positionparametertrennzeichen+1,aktuelleposition-1)). ueberpruefeobrechteseitedoppeltgeklammert:IF aktuellessymbol=rechteklammer THEN rechteseitevariabel:=TRUE ;positionrechteklammer:=aktuellepositionELSE positionrechteklammer:=aktuelleposition-1FI .bestimmungdesteiltextes:IF NOT rekursiveraufrufTHEN bestimmungderlaengederauszufuellendenluecke; entsprechendenabschnittdeserhaltenenwortesbestimmenFI . aufrufderprozedurlueckenwert:puffer:=lueckenwert(parameter1#,parameter2#). bestimmungderlaengederauszufuellendenluecke:laenge:=positionrechteklammer- positionlinkeklammer+1.entsprechendenabschnittdeserhaltenenwortesbestimmen: pufferlaenge:=length(puffer);IF pufferlaenge<=laengeTHEN IF NOT ( linkeseitevariabelOR rechteseitevariabel)THEN puffer:=puffer+((laenge- pufferlaenge)*" ")ELIF linkeseitevariabelTHEN puffer:=((laenge-pufferlaenge)* " ")+pufferFI ;ELSE IF NOT linkeseitevariabelTHEN puffer:=subtext(puffer,1, laenge);ELSE puffer:=subtext(puffer,pufferlaenge-laenge+1,pufferlaenge)FI ; FI .bestimmungderrichtigenalternative:bestimmungdeserstenvergleichswertes; WHILE vergleichswertstimmtnichtuebereinundeinweiterervorhandenREP suchenaechstenvergleichswertPER ;positionrechteklammerbeicaseaufrufbestimmen; IF vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinTHEN bereitstellenderentsprechendenalternativeELIF (ausgabeSUB positionotherwise)= otherwiseTHEN puffer:=zeilenalternative(subtext(ausgabe,positionotherwise+1, positionrechteklammer-1),TRUE )ELSE bereitstelleneinerleerenalternativeFI . bestimmungdeserstenvergleichswertes:positionlinkeskreuz:= positionparametergrenze;positionmittlereskreuz:=pos(ausgabe, parametertrennzeichen,positionlinkeskreuz+1);vergleichswert:=subtext(ausgabe, positionlinkeskreuz+1,positionmittlereskreuz-1);rechteskreuzbestimmen. suchenaechstenvergleichswert:positionlinkeskreuz:=positionrechteskreuz; positionmittlereskreuz:=pos(ausgabe,parametertrennzeichen,positionlinkeskreuz +1);vergleichswert:=subtext(ausgabe,positionlinkeskreuz+1, positionmittlereskreuz-1);rechteskreuzbestimmen.rechteskreuzbestimmen: aktuelleposition:=positionmittlereskreuz;anzahldergeoeffnetenklammern:=0;REP fuehreleseoperationausUNTIL (anzahldergeoeffnetenklammern=0AND ( aktuellessymbol=parametertrennzeichenOR aktuellessymbol=otherwise))OR anzahldergeoeffnetenklammern<0PER ;positionrechteskreuz:=aktuelleposition; positionotherwise:=aktuelleposition. vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufueberein: vergleichswert=puffer.bereitstellenderentsprechendenalternative:puffer:= zeilenalternative(subtext(ausgabe,positionmittlereskreuz+1, positionrechteskreuz-1),TRUE ).bereitstelleneinerleerenalternative:puffer:="" .vergleichswertstimmtnichtuebereinundeinweiterervorhanden:NOT vergleichswertstimmtmitdemergebnisausdemlueckenwertaufrufuebereinAND einweiterervergleichswertistvorhanden.einweiterervergleichswertistvorhanden: aktuellessymbol=parametertrennzeichen. positionrechteklammerbeicaseaufrufbestimmen:anzahldergeoeffnetenklammern:=0; IF aktuellessymbol<>rechteklammerTHEN WHILE NOT (anzahldergeoeffnetenklammern <0AND aktuellessymbol=rechteklammer)REP fuehreleseoperationausPER FI ; positionrechteklammer:=aktuelleposition. einsetzendesteiltextesoderderalternative:change(ausgabe,positionlinkeklammer, positionrechteklammer,puffer).END PROC zeilenalternative;PROC setzeanzahlderzeichenprozeile(INT CONST anzahl):zeilenlaenge:=anzahlEND PROC setzeanzahlderzeichenprozeile;PROC schrift(TEXT CONST typ):schrifttyp:=typ END PROC schrift;PROC start(REAL CONST x,y):ersterparameterstartanweisung:= text(x);zweiterparameterstartanweisung:=text(y)END PROC start;PROC schreibesteuerzeichenzeile(TEXT CONST dateiname):FILE VAR f:=sequentialfile( output,dateiname);LET druckersteuerzeichen="#",praefixschrifttypanweisung= "type(""",praefixstartanweisung="start(",komma=",",suffixstartanweisung=")", suffixschrifttypanweisung=""")",pagelengthanweisung="#pagelength(29.0)#"; putline(f,druckersteuerzeichen+praefixschrifttypanweisung+schrifttyp+ suffixschrifttypanweisung+druckersteuerzeichen+druckersteuerzeichen+ praefixstartanweisung+ersterparameterstartanweisung+komma+ zweiterparameterstartanweisung+suffixstartanweisung+druckersteuerzeichen+ pagelengthanweisung)END PROC schreibesteuerzeichenzeile;PROC briefalternative (TEXT CONST eingabedatei,ausgabedatei):TEXT VAR ausgabe:=ausgabedatei;TEXT VAR zeile:="",text:="",praefixdernaechstenzeile:="",briefzeile:="";BOOL VAR absatzende;INT VAR postrennzeichen:=1,z;LET trennzeichen=" ";FILE VAR f:= sequentialfile(output,ausgabe);FILE VAR eingabe:=sequentialfile(input, eingabedatei);WHILE NOT eof(eingabe)REP holezeileausdemvordruck; einrueckendererstenbriefzeilevorbereiten;REP ueberpruefeaufabsatzende; ersetzeindergeholtenzeilediegeklammertenausdruecke; konkatenierediegeholtezeilemitdemrestdervorangehenden;IF briefzeilelanggenug OR absatzendeTHEN zeilenumbruch;WHILE absatzendeAND nochtextvorhandenREP bildedenrestdesumbruchs;zeilenumbruchPER FI ;IF NOT absatzendeTHEN holezeileausdemvordruck;einrueckendernaechstenbriefzeilevorbereiten;FI ; UNTIL absatzendePER PER .holezeileausdemvordruck:getline(eingabe,zeile). konkatenierediegeholtezeilemitdemrestdervorangehenden:briefzeile:=text+zeile+ trennzeichen;text:=briefzeile.ueberpruefeaufabsatzende:absatzende:=(zeileSUB (length(zeile)))=trennzeichen.briefzeilelanggenug:(length(briefzeile))>= zeilenlaenge.bildedenrestdesumbruchs:briefzeile:=text.nochtextvorhanden: length(subtext(text,length(praefixdernaechstenzeile)+1))>1.zeilenumbruch:IF ( zeilenlaengetrennzeichenREP postrennzeichen:=postrennzeichen-1PER ;putline(f,subtext( briefzeile,1,postrennzeichen-1));text:=praefixdernaechstenzeile+subtext( briefzeile,postrennzeichen+1);.einrueckendernaechstenbriefzeilevorbereiten: praefixdernaechstenzeile:="";z:=1;WHILE ((zeileSUB z)=trennzeichen)AND ( length(zeile)>z)REP praefixdernaechstenzeile:=praefixdernaechstenzeile+ trennzeichen;z:=z+1PER ;zeile:=subtext(zeile,z);. einrueckendererstenbriefzeilevorbereiten:praefixdernaechstenzeile:="";z:=1; WHILE ((zeileSUB z)=trennzeichen)AND (length(zeile)>z)REP praefixdernaechstenzeile:=praefixdernaechstenzeile+trennzeichen;z:=z+1PER ; text:="";.ersetzeindergeholtenzeilediegeklammertenausdruecke:zeile:= zeilenalternative(zeile,FALSE ).END PROC briefalternative;PROC setzesonderwerteschulkenndaten:TEXT VAR schlsicherung;savetupel(dnrschluessel ,schlsicherung);TEXT VAR aktj:=schulkenndatum("Schuljahr");sonderwertpuffer( swindexschulname):=schulkenndatum("Schulname");sonderwertpuffer( swindexschulstrasse):=schulkenndatum("Schulstraße");sonderwertpuffer( swindexschulort):=schulkenndatum("Schulort");sonderwertpuffer( swindexschuljahr):=aktj;insertchar(sonderwertpuffer(swindexschuljahr),"/",3); sonderwertpuffer(swindexschulleiter):=schulkenndatum("Schulleiter"); sonderwertpuffer(swindexhalbjahr):=schulkenndatum("Schulhalbjahr"); sonderwertpuffer(swindexdatum):=date; sonderwertefuernaechstesundvorangehendesschuljahr(aktj);restoretupel( dnrschluessel,schlsicherung);ENDPROC setzesonderwerteschulkenndaten; initialisiereallesonderwerte;initialisiereschriftundstart. initialisiereschriftundstart:schrift("pica");.END PACKET anschrgrundfunktionenfueranschreiben;