app/schulis/2.2.1/src/0.anschr.grundfunktionen

Raw file
Back to index

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;