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/0.anschr.grundfunktionen | 193 +++++++++++++++++++++++++ 1 file changed, 193 insertions(+) create mode 100644 app/schulis/2.2.1/src/0.anschr.grundfunktionen (limited to 'app/schulis/2.2.1/src/0.anschr.grundfunktionen') 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 ( +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; + -- cgit v1.2.3