Initial import

1 files changed, 193 insertions, 0 deletions

diff --git a/app/schulis/2.2.1/src/0.anschr.grundfunktionen b/app/schulis/2.2.1/src/0.anschr.grundfunktionen
new file mode 100644
index 0000000..0330b7a
--- /dev/null
+++ b/app/schulis/2.2.1/src/0.anschr.grundfunktionen
@@ -0,0 +1,193 @@
+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 (
+zeilenlaenge<length(briefzeile))THEN postrennzeichen:=zeilenlaenge+1ELSE 
+postrennzeichen:=length(briefzeile)FI ;WHILE (briefzeileSUB postrennzeichen)
+<>trennzeichenREP 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;
+