1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
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;
|
