summaryrefslogtreecommitdiff
path: root/app/baisy/2.2.1-schulis/src/isp.maskendesign
blob: a90accaaa2a4a1af10440d199f294f58e6a8429f (plain)
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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
PACKET maskendesignDEFINES maskstart,aktuellendesignnamenlesen,maskgenstart,
holestandardvorgaben,maskenattributespeichern,einlesenderattribute,
generieremaske,zeigegeneriertemaske,formularentwerfen,formularspeichern,
felderentwerfen,felddefinitionenspeichern,maskenformularzeigen,
definitionsnamenlesen,gesuchtesfeldanzeigen,feldloeschen,feldspeichern,
feldnichtspeichern,feldmalen,feldaufneuenschirmmalen,feldattributesetzen,
holeattribute,listeallermasken,loescheneinermaske,kopierenaendern,
zweitennamenlesen,kopiereneinermaske,druckeneinermaske,neuernamefuereinemaske
:LET standardanfang=2;LET z="Liste aller Masken";LET nummernmaske=
"mb maskenfeldnummern",id="mb maskenbearbeitung1",zusatz=
"mb maskenbearbeitung2",mgmatrix="mb maskgenmatrix",mg="mb maskengenerator",
b1="mb maskenfeldattribute";LET dru=49;LET maxfeldnr=200;LET praefixs=
"Formular für: ",praefixf="form.";TEXT VAR symbalphag:="#",symbalphau:="&",
symbankreuz:="^",symbgeheim:="'",symbmeldung:="%",symbfortsetzunga:="<",
symbfortsetzunge:=">",symbpseudoblank:="!",unterlegungalpha:="_",
unterlegungankreuz:="_",unterlegunggeheim:="_",unterlegungmeldung:="=",
anzeigeankreuz:="x",anzeigegeheim:="-";TEXT VAR symbolischemaske:="";TEXT 
VAR formulardatei:="";TEXT VAR maskenname:="",zweitername:="";INT VAR 
feldname:=standardanfang,loeschfeld;BOOL VAR da;#DBMASKE VAR dbm;nil(dbm);#
TEXT VAR eingangsname;TAG VAR maske;;TAG VAR aktuellemaske;INT VAR 
aktuelleposition;TEXT VAR logtextergaenzung;PROC maskstart:
frageentwicklernachmaskennamen(id);aktuellendesignnamenlesenEND PROC 
maskstart;PROC frageentwicklernachmaskennamen(TEXT CONST start):eingangsname
:=start;standardstartproc(start)END PROC frageentwicklernachmaskennamen;PROC 
aktuellendesignnamenlesen:standardmaskenfeld(maskenname,2);standardnproc;
maskenname:=standardmaskenfeld(2);init(feld)END PROC 
aktuellendesignnamenlesen;PROC maskgenstart:zeigemaske;holestandardvorgaben;.
zeigemaske:frageentwicklernachmaskennamen(mg).END PROC maskgenstart;PROC 
holestandardvorgaben:standardmaskenfeld("",1);standardmaskenfeld(maskenname,2
);standardmaskenfeld(unterlegungalpha,3);standardmaskenfeld(symbalphag,4);
standardmaskenfeld(symbalphau,5);standardmaskenfeld(symbankreuz,6);
standardmaskenfeld(unterlegungankreuz,7);standardmaskenfeld(anzeigeankreuz,8)
;standardmaskenfeld(symbgeheim,9);standardmaskenfeld(unterlegunggeheim,10);
standardmaskenfeld(anzeigegeheim,11);standardmaskenfeld(symbmeldung,12);
standardmaskenfeld(unterlegungmeldung,13);standardmaskenfeld(symbfortsetzunga
,14);standardmaskenfeld(symbfortsetzunge,15);standardmaskenfeld(
symbpseudoblank,16);standardnproc;maskenname:=standardmaskenfeld(2);
unterlegungalpha:=standardmaskenfeld(3);symbalphag:=standardmaskenfeld(4);
symbalphau:=standardmaskenfeld(5);symbankreuz:=standardmaskenfeld(6);
unterlegungankreuz:=standardmaskenfeld(7);anzeigeankreuz:=standardmaskenfeld(
8);symbgeheim:=standardmaskenfeld(9);unterlegunggeheim:=standardmaskenfeld(10
);anzeigegeheim:=standardmaskenfeld(11);symbmeldung:=standardmaskenfeld(12);
unterlegungmeldung:=standardmaskenfeld(13);symbfortsetzunga:=
standardmaskenfeld(14);symbfortsetzunge:=standardmaskenfeld(15);
symbpseudoblank:=standardmaskenfeld(16);trans(symbpseudoblank+
symbfortsetzunga+symbfortsetzunge);.END PROC holestandardvorgaben;PROC 
formularentwerfen(INT CONST nummerderauskunft):IF maskenname=""THEN 
keineeingabe;return(1)ELSE setzedateinamen;IF NOT exists(symbolischemaske)
THEN IF NOT maskedaTHEN logtextergaenzung:="eingefügt";neuELSE 
logtextergaenzung:="geändert";aendernFI ;FI ;formularzeigen(nummerderauskunft
)FI .keineeingabe:aktuelleposition:=standardanfang;standardmeldung(26,"").
setzedateinamen:symbolischemaske:=praefixs+maskenname;formulardatei:=praefixf
+maskenname.maskeda:maskegibtes(maskenname).neu:init(feld);
erzeugeleeresymbolischemaske(maskenname).aendern:erzeugesymbolischemaske(
maskenname).END PROC formularentwerfen;PROC formularzeigen(INT CONST 
nummerderauskunft):page;sagderauskunftwasaufdemeingangsschirmstand;editiere(
symbolischemaske,"a",FALSE ).sagderauskunftwasaufdemeingangsschirmstand:TEXT 
VAR eingangsinfo:="";eingangsinfoCAT infozeile("geschützt",symbalphag);
eingangsinfoCAT infozeile("ungeschützt",symbalphau);eingangsinfoCAT infozeile
("Ankreuzfeld",symbankreuz);eingangsinfoCAT infozeile("sonst. Geheimfeld",
symbgeheim);eingangsinfoCAT infozeile("Meldungsfeld",symbmeldung);
eingangsinfoCAT infozeile("Beginn Fortsetzung",symbfortsetzunga);eingangsinfo
CAT infozeile("Ende Fortsetzung",symbfortsetzunge);eingangsinfoCAT infozeile(
"Überdeckungszeichen",symbpseudoblank);eingangsinfoCAT auskunftstextende;
ergaenzeauskunft(eingangsinfo,nummerderauskunft).END PROC formularzeigen;
PROC generieremaske:erzeugemaske(maskenname);page;show(maske);
zeigegeneriertemaskeEND PROC generieremaske;PROC zeigegeneriertemaske:INT 
VAR feldind,maxfeld:=min(fields(maske),maxfeldnr);ROW maxfeldnrTEXT VAR 
maskenfeld;INT VAR einstieg:=maxfeldnr;FOR feldindFROM 1UPTO maxfeldREP IF 
fieldexists(maske,feldind)THEN maskenfeld(feldind):="";put(maske,"",feldind);
cursor(maske,feldind);out(text(feldind));IF (NOT protected(maske,feldind))
CAND (feldind<einstieg)THEN einstieg:=feldindFI ;FI PER ;IF einstieg>maxfeld
THEN einstieg:=standardanfangFI ;get(maske,maskenfeld,einstieg)END PROC 
zeigegeneriertemaske;ROW maxfeldnrTEXT VAR feld;INT VAR maxfeld;PROC 
maskenattributesetzen:maskenholen;formularzeigen;attributezeigen;
einlesenderattribute.maskenholen:initmaske(aktuellemaske,mgmatrix).
formularzeigen:page;standardkopfmaskeausgeben(text(vergleichsknoten));show(
aktuellemaske).attributezeigen:INT VAR i;INT VAR maxfields:=fields(
aktuellemaske);feld(1):="";TEXT VAR hellername:=""+maskenname+" ";feld(2):=
hellername+(length(aktuellemaske,2)-length(hellername))*" ";INT VAR zaehler:=
3;FOR iFROM 2UPTO min(fields(maske),maxfeldnr-1)REP IF (fieldexists(maske,i))
THEN IF feld(zaehler)=""THEN feld(zaehler):=text(i,3)+text(auskunftsnr(maske,
i),5)+text(symbolicname(maske,i),3)FI ;zaehlerINCR 1FI PER ;FOR iFROM 1UPTO 
zaehler-1REP IF fieldexists(aktuellemaske,i)THEN put(aktuellemaske,feld(i),i)
FI PER ;FOR iFROM zaehlerUPTO maxfieldsREP protect(aktuellemaske,i,TRUE )PER 
;maxfeld:=zaehler-1;aktuelleposition:=3.END PROC maskenattributesetzen;PROC 
einlesenderattribute:get(aktuellemaske,feld,aktuelleposition)END PROC 
einlesenderattribute;PROC maskenattributespeichern:INT VAR i;IF NOT 
maskengeneratorTHEN gibtestag;IF NOT daTHEN meldezuerstformular;LEAVE 
maskenattributespeichernFI ;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""PER ;FI ;
maskenattributesetzen;FOR iFROM 3UPTO maxfeldREP INT VAR feldnr:=int(subtext(
feld(i),1,3));auskunftsnr(maske,feldnr,int(subtext(feld(i),4,8)));
symbolicname(maske,feldnr,int(subtext(feld(i),9,11)))PER .maskengenerator:
eingangsname=mg.meldezuerstformular:standardmeldung(32,"");return(1).END 
PROC maskenattributespeichern;PROC formularspeichern(INT CONST zurueck):
schreibemaske(maske,maskenname);logbucheintrag(logtextergaenzung);IF exists(
formulardatei)THEN forget(formulardatei,quiet)FI ;return(zurueck);
frageentwicklernachmaskennamen(eingangsname);meldespeicherung.
meldespeicherung:standardmeldung(27,"").END PROC formularspeichern;PROC 
felderentwerfen:gibtestag;IF daTHEN initialisiereELSE meldezuerstformularFI .
initialisiere:feldname:=standardanfang;maskenformularzeigen;
definitionsnamenlesen.meldezuerstformular:standardmeldung(32,"");return(1).
END PROC felderentwerfen;PROC gibtestag:initmaske(maske,maskenname);da:=
maskegibtes(maskenname)END PROC gibtestag;PROC felddefinitionenspeichern:
schreibemaske(maske,maskenname);return(2);frageentwicklernachmaskennamen(id);
meldespeicherung;.meldespeicherung:standardmeldung(28,"").END PROC 
felddefinitionenspeichern;PROC maskenformularzeigen:
maskezuderfelderstelltwerdensollzeigen;entwicklernachfeldnamenfragen.
maskezuderfelderstelltwerdensollzeigen:page;show(maske).END PROC 
maskenformularzeigen;PROC entwicklernachfeldnamenfragen:aktuelleposition:=
standardanfang;initmaske(aktuellemaske,nummernmaske);show(aktuellemaske).END 
PROC entwicklernachfeldnamenfragen;PROC definitionsnamenlesen:TEXT VAR f:=
text(feldname);ROW maxfeldnrTEXT VAR feld;init(feld);feld(2):=f;loeschfeld:=
feldname;putget(aktuellemaske,feld,aktuelleposition);feldname:=int(feld(
aktuelleposition));loeschemeldung(aktuellemaske);END PROC 
definitionsnamenlesen;PROC gesuchtesfeldanzeigen:IF NOT fieldexists(maske,
feldname)THEN meldefalschenummer;loeschenELSE TEXT CONST pointer:=(length(
maske,feldname))*"?";loeschen;put(maske,pointer,feldname);meldegesuchtesfeld
FI ;return(1).meldegesuchtesfeld:melde(aktuellemaske,10).loeschen:put(maske,
"",loeschfeld).END PROC gesuchtesfeldanzeigen;PROC meldefalschenummer:melde(
aktuellemaske,9).END PROC meldefalschenummer;LET null="�";TEXT VAR xrow,yrow,
lrow,trow;BOOL VAR a,b,c,d,e;INT VAR sym,aus;TEXT VAR geheimzeichen;PROC 
feldloeschen:INT VAR x,y;IF fieldexists(maske,feldname)THEN clearfield(maske,
feldname);put(maske,"",loeschfeld);getcursor(x,y);cursor(1,y);out(formline(
maske,y));melde(aktuellemaske,42)ELSE meldefalschenummerFI ;return(1)END 
PROC feldloeschen;PROC feldmalen:xrow:="";yrow:=" ";lrow:="";trow:="";IF 
menuedraussenTHEN reorganizescreenFI ;designfield(maske,feldname,xrow,yrow,
lrow,trow)END PROC feldmalen;PROC feldaufneuenschirmmalen:reorganizescreen;
designfield(maske,feldname,xrow,yrow,lrow,trow)END PROC 
feldaufneuenschirmmalen;PROC feldattributesetzen:INT VAR gz;fieldinfos(maske,
feldname,gz,a,b,c,d,e);geheimzeichen:=code(gz);baisymaskeholen;sym:=
symbolicname(maske,feldname);aus:=auskunftsnr(maske,feldname);show(
aktuellemaske);holeattribute;END PROC feldattributesetzen;PROC 
baisymaskeholen:initmaske(aktuellemaske,b1)END PROC baisymaskeholen;PROC 
holeattribute:ROW maxfeldnrTEXT VAR feld;init(feld);IF bTHEN feld(2):="X"FI ;
IF cTHEN feld(3):=geheimzeichenFI ;feld(4):=text(sym);putget(aktuellemaske,
feld,aktuelleposition);b:=feld(2)<>"";c:=feld(3)<>"";geheimzeichen:=feld(3);
sym:=int(feld(4))END PROC holeattribute;PROC feldspeichern:definefield(maske,
xrow,yrow,lrow,trow,sym,aus,feldname,geheimzeichen,null);setfieldinfos(maske,
feldname,a,b,c);maskenformularzeigen;meldevorlaeufiguebernommen;return(3).
meldevorlaeufiguebernommen:melde(aktuellemaske,41).END PROC feldspeichern;
PROC feldnichtspeichern(INT CONST schritte):maskenformularzeigen;return(
schritte)END PROC feldnichtspeichern;PROC listeallermasken:
meldezusammenstellung;listen.listen:listezusammenstellen;zeigendermaskenliste
.meldezusammenstellung:store(FALSE );standardmeldung(7,"");store(TRUE ).
listezusammenstellen:maskenliste(z).END PROC listeallermasken;PROC 
zeigendermaskenliste:page;editiere(z)END PROC zeigendermaskenliste;PROC 
loescheneinermaske:IF maskenname=""THEN keineeingabe;return(1)ELSE IF 
maskegibtes(maskenname)THEN loeschemaske(maskenname);logbucheintrag(
"gelöscht");meldeloeschungELSE maskegibtesnichtFI ;return(1)FI .
maskegibtesnicht:standardmeldung(8,"").meldeloeschung:standardmeldung(33,"").
keineeingabe:standardmeldung(26,"").END PROC loescheneinermaske;PROC 
kopierenaendern:maskekopierenoderaendern;IF NOT daTHEN maskegibtesnichtFI .
maskegibtesnicht:standardmeldung(8,"");return(1).END PROC kopierenaendern;
PROC maskekopierenoderaendern:IF NOT maskegibtes(maskenname)THEN da:=FALSE 
ELSE da:=TRUE ;frageentwicklernachmaske;zweitennamenlesenFI .
frageentwicklernachmaske:aktuelleposition:=standardanfang;initmaske(
aktuellemaske,zusatz);zweitername:="";show(aktuellemaske).END PROC 
maskekopierenoderaendern;PROC zweitennamenlesen:ROW maxfeldnrTEXT VAR feld;
init(feld);feld(2):=zweitername;putget(aktuellemaske,feld,aktuelleposition);
zweitername:=feld(2);loeschemeldung(aktuellemaske).END PROC zweitennamenlesen
;PROC kopiereneinermaske:IF maskegibtes(zweitername)THEN da:=TRUE ;return(1)
ELSE maskekopieren(maskenname,zweitername);da:=FALSE FI ;IF daTHEN gibtsschon
ELSE return(2);frageentwicklernachmaskennamen(id);meldekopierungFI .
gibtsschon:melde(aktuellemaske,31).meldekopierung:melde(aktuellemaske,29).
END PROC kopiereneinermaske;PROC neuernamefuereinemaske:IF maskegibtes(
zweitername)THEN da:=TRUE ;return(1)ELSE maskeumbenennen(maskenname,
zweitername);da:=FALSE ;FI ;IF daTHEN gibtsschonELSE return(2);
frageentwicklernachmaskennamen(id);meldeumbenennungFI .gibtsschon:melde(
aktuellemaske,31).meldeumbenennung:melde(aktuellemaske,30).END PROC 
neuernamefuereinemaske;PROC druckeneinermaske:BOOL VAR maskeda;TAG VAR t;IF 
maskenname=""THEN keineeingabe;return(1)ELSE maskeda:=maskegibtes(t,
maskenname);IF maskedaTHEN meldedrucken;fuehredurchELSE maskegibtesnichtFI ;
return(1)FI .maskegibtesnicht:standardmeldung(8,"").keineeingabe:
standardmeldung(26,"").meldedrucken:standardmeldung(dru,"").fuehredurch:
kopfindatei;formularindatei;feldinformationenindatei;drucken.kopfindatei:LET 
temp="temporäre Druckdatei";FILE VAR f:=sequentialfile(output,temp);putline(f
,"Name der Maske: "+maskenname);putline(f,"Stand:          "+date+"  "+
timeofday);line(f,2).drucken:print(temp);forget(temp,quiet).formularindatei:
INT VAR fz:=min(fields(t),maxfeldnr);IF fz>0THEN INT VAR i;FOR iFROM 1UPTO fz
REP IF fieldexists(t,i)THEN fill(t,text(i),i)FI PER FI ;tTO f.
feldinformationenindatei:line(f,2);IF fz>0THEN ueberschrift;FOR iFROM 1UPTO 
fzREP IF fieldexists(t,i)THEN tabellenzeileFI PER FI .ueberschrift:putline(f,
"Nr...Länge...geschützt....geheim.....Symbol.....Auskunftsnr....").
tabellenzeile:INT VAR gz;BOOL VAR a,b,c,d,e;fieldinfos(t,i,gz,a,b,c,d,e);
TEXT VAR geheim:=code(gz);INT VAR sym:=0,aus:=0;sym:=symbolicname(t,i);aus:=
auskunftsnr(t,i);put(f,text(text(i),4));put(f,text(text(length(t,i)),7));IF b
THEN put(f,text("X",13))ELSE put(f,13*" ")FI ;IF cTHEN put(f,text(geheim,11))
ELSE put(f,11*" ")FI ;IF sym<>0THEN put(f,text(text(sym),10))ELSE put(f,10*
" ")FI ;IF aus<>0THEN put(f,text(aus))FI ;line(f,1).END PROC 
druckeneinermaske;PROC schreibemaske(TAG VAR ta,TEXT CONST t):setzemaske(ta);
maskespeichern(t)END PROC schreibemaske;PROC loeschemaske(TEXT CONST t):
maskeloeschen(t)END PROC loeschemaske;BOOL PROC maskegibtes(TAG VAR t,TEXT 
CONST name):initmaske(t,name);maskegibtes(name)END PROC maskegibtes;PROC 
erzeugeleeresymbolischemaske(TEXT CONST maskenname):oeffneausgabedatei;
schreibemarkierungenindatei.oeffneausgabedatei:TEXT CONST dateiname:=praefixs
+maskenname;forget(dateiname,quiet);FILE VAR f:=sequentialfile(output,
dateiname).schreibemarkierungenindatei:dreileerzeilen;grundlinie;
vieleleerzeilen;endlinie.dreileerzeilen:INT VAR i;FOR iFROM 1UPTO 3REP 
putline(f,"")PER .grundlinie:putline(f,78*unterlegungmeldung).vieleleerzeilen
:FOR iFROM 1UPTO 18REP putline(f,"")PER .endlinie:putline(f,3*
unterlegungmeldung+72*symbmeldung+3*unterlegungmeldung).END PROC 
erzeugeleeresymbolischemaske;PROC erzeugesymbolischemaske(TEXT CONST 
maskenname):holeformular;oeffneausgabedatei;setzesymbole;
zeigesymbolischemaske.holeformular:INT VAR i;INT CONST maxmaskenfeld:=
maxfeldnr-1;initmaske(maske,maskenname);FOR iFROM 2UPTO maxmaskenfeldREP IF 
fieldexists(maske,i)THEN feld(i+1):=text(i,3)+text(auskunftsnr(maske,i),5)+
text(symbolicname(maske,i),3)ELSE feld(i+1):=""FI PER .oeffneausgabedatei:
TEXT CONST dateiname:=praefixs+maskenname;forget(dateiname,quiet);FILE VAR f
:=sequentialfile(output,dateiname).zeigesymbolischemaske:maskeTO f.
setzesymbole:erstesfeld;REP symbolisierefeld;naechstesfeldUNTIL letztesfeld
PER ;abschluss.erstesfeld:INT VAR aktfeld:=firstfield(maske),zeilennr:=1;INT 
VAR altesfeld:=aktfeld;INT VAR zeilenpointer:=1.naechstesfeld:altesfeld:=
aktfeld;aktfeld:=nextfield(maske,aktfeld).letztesfeld:aktfeld<0.
symbolisierefeld:setzezeile;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;
holeinformationenueberdasfeld;fuelledasfeldmitdensymbolen.
fuelledasfeldmitdensymbolen:TEXT VAR alteszeichen;IF aktfeld=1THEN fill(maske
,length(maske,1)*symbmeldung,aktfeld);alteszeichen:=symbmeldungELSE IF 
geschuetztTHEN fill(maske,laenge*symbalphag,aktfeld);alteszeichen:=symbalphag
ELSE IF geheimTHEN IF laenge=1THEN IF code(gz)=anzeigeankreuzTHEN fill(maske,
symbankreuz,aktfeld);alteszeichen:=symbankreuzELSE fill(maske,symbgeheim,
aktfeld);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbgeheim,aktfeld
);alteszeichen:=symbgeheimFI ELSE fill(maske,laenge*symbalphau,aktfeld);
alteszeichen:=symbalphauFI FI FI .holeinformationenueberdasfeld:INT VAR gz,x,
y,laenge:=length(maske,aktfeld);BOOL VAR a,geschuetzt,geheim,d,e;fieldinfos(
maske,aktfeld,gz,a,geschuetzt,geheim,d,e);.setzezeile:woliegtdasfeld;
allevorhergehendenzeilen.woliegtdasfeld:cursor(maske,aktfeld);getcursor(x,y).
allevorhergehendenzeilen:IF y>zeilennrTHEN INT VAR xalt:=x;x:=length(formline
(maske,zeilennr))+1;pruefeobfortsetzung;uebernehmenbiszudiesemfeld;x:=xalt;
zeilenpointer:=1;zeileaktualisierenFI .zeileaktualisieren:zeilennr:=y;.
abschluss:y:=ysize(maske)+1;allevorhergehendenzeilen.schoneinfeldinderzeile:
zeilenpointer<>1.pruefeobfortsetzung:BOOL VAR fortsetzung:=
schoneinfeldinderzeileCAND (pos(subtext(formline(maske,zeilennr),
zeilenpointer,x-1),alteszeichen,laenge+1)>0).uebernehmenbiszudiesemfeld:IF 
fortsetzungTHEN fill(maske,symbfortsetzunga+((length(maske,altesfeld)-2)*
alteszeichen)+symbfortsetzunge,altesfeld)FI ;zeilenpointer:=x.END PROC 
erzeugesymbolischemaske;PROC feldanfang(INT VAR fa,TEXT CONST zeile):INT 
CONST zeilenlaenge:=length(zeile);WHILE NOT issymbol(subtext(zeile,fa,fa))
REP faINCR 1UNTIL NOT inzeilePER .inzeile:NOT (fa>zeilenlaenge).END PROC 
feldanfang;BOOL PROC issymbol(TEXT CONST s):TEXT VAR symb:=s;symbol(symb);
symb<>""END PROC issymbol;PROC symbol(TEXT VAR s):IF NOT ((s=symbalphag)OR (s
=symbalphau)OR (s=symbankreuz)OR (s=symbgeheim)OR (s=symbmeldung)OR (s=
symbfortsetzunga)OR (s=symbfortsetzunge))THEN s:=""FI END PROC symbol;PROC 
felddefinition(INT VAR fa,TEXT VAR zeile,INT VAR feldnr,INT CONST znr):IF 
feldmitteilfeldernTHEN teilfelderELSE einfachesfeldFI ;setzefeld.
feldmitteilfeldern:subtext(zeile,fa,fa)=symbfortsetzunga.teilfelder:
geschuetzt:=FALSE ;geheim:=FALSE ;xkoord:="";ykoord:="";laengen:="";
geheimzeichen:=code(0);TEXT VAR gesamtunterlegung:=unterlegungalpha;BOOL VAR 
gesamtgeschuetzt:=TRUE ,gesamtgeheim:=FALSE ;teilfeldbearbeitung;unterlegung
:=gesamtunterlegung;geschuetzt:=gesamtgeschuetzt;geheim:=gesamtgeheim.
teilfeldbearbeitung:REP efeld(zeile,fa,unterlegung,xkoord,ykoord,laengen,
geschuetzt,geheim,geheimzeichen,znr);IF (unterlegung=symbfortsetzunge)COR (
unterlegung="")THEN LEAVE teilfeldbearbeitungELIF unterlegung<>""THEN 
gesamtunterlegung:=unterlegung;gesamtgeschuetzt:=geschuetzt;gesamtgeheim:=
geheimFI ;faINCR 1;feldanfang(fa,zeile);PER .einfachesfeld:TEXT VAR 
unterlegung;BOOL VAR geschuetzt:=FALSE ,geheim:=FALSE ;TEXT VAR xkoord:="",
ykoord:="",laengen:="",geheimzeichen:=code(0);efeld(zeile,fa,unterlegung,
xkoord,ykoord,laengen,geschuetzt,geheim,geheimzeichen,znr);.setzefeld:INT 
VAR fnr;IF meldungsfeldTHEN fnr:=1;geschuetzt:=TRUE ELSE fnr:=feldnr;feldnr
INCR 1FI ;definefield(maske,xkoord,ykoord,laengen,code(0),0,0,fnr,
geheimzeichen,code(0));setfieldinfos(maske,fnr,FALSE ,geschuetzt,geheim);
ersetzedurchunterlegung(zeile,xkoord,laengen,unterlegung).meldungsfeld:
subtext(zeile,fa,fa)=symbmeldung.END PROC felddefinition;PROC 
ersetzedurchunterlegung(TEXT VAR zeile,TEXT CONST xkoord,laengen,unterlegung)
:INT VAR eintragszahl:=length(xkoord),ind;FOR indFROM 1UPTO eintragszahlREP 
ersetzungPER .ersetzung:INT VAR fstart,flaenge;fstart:=code(subtext(xkoord,
ind,ind));flaenge:=code(subtext(laengen,ind,ind));replace(zeile,fstart,
flaenge*unterlegung);.END PROC ersetzedurchunterlegung;PROC efeld(TEXT CONST 
zeile,INT VAR fa,TEXT VAR unterlegung,xkoord,ykoord,laengen,BOOL VAR 
geschuetzt,geheim,TEXT VAR geheimzeichen,INT CONST znr):INT VAR poszeile:=fa;
IF issymbol(subtext(zeile,poszeile,poszeile))THEN WHILE issymbol(subtext(
zeile,poszeile+1,poszeile+1))REP poszeileINCR 1PER ;xkoordCAT code(fa);ykoord
CAT code(znr);laengenCAT code(poszeile-fa+1);fa:=poszeile;FI ;TEXT CONST s:=
subtext(zeile,fa,fa);IF s=symbalphagTHEN geschuetzt:=TRUE ;unterlegung:=
unterlegungalphaELIF s=symbalphauTHEN geschuetzt:=FALSE ;unterlegung:=
unterlegungalphaELIF s=symbankreuzTHEN geheim:=TRUE ;unterlegung:=
unterlegungankreuz;geheimzeichen:=anzeigeankreuzELIF s=symbgeheimTHEN geheim
:=TRUE ;unterlegung:=unterlegunggeheim;geheimzeichen:=anzeigegeheimELIF s=
symbmeldungTHEN unterlegung:=unterlegungmeldungELIF s=symbfortsetzungeTHEN 
unterlegung:=symbfortsetzungeELSE unterlegung:=""FI END PROC efeld;PROC 
erzeugemaske(TEXT CONST maskenname):oeffnedatei;
generieremaskeausformulardatei;uebertrageformular;.oeffnedatei:forget(
formulardatei,quiet);copy(symbolischemaske,formulardatei);FILE VAR datei:=
sequentialfile(modify,formulardatei).uebertrageformular:input(datei);dateiTO 
maske;forget(formulardatei,quiet).generieremaskeausformulardatei:
holeerstezeile;REP generierefelderdieserzeile;schreibeformularzeile;
holenaechstezeileUNTIL dateiendePER .holeerstezeile:ananfang;lesezeile.
holenaechstezeile:einsweiter;lesezeile.dateiende:eof(datei).einsweiter:down(
datei,1).ananfang:nil(maske);TEXT VAR zeile:="";toline(datei,1);INT VAR 
feldnr:=2.lesezeile:readrecord(datei,zeile).schreibeformularzeile:writerecord
(datei,zeile).generierefelderdieserzeile:startezeile;REP 
findefeldspezifikation;definierenaechstesfeldPER .startezeile:INT VAR fa:=1.
findefeldspezifikation:feldanfang(fa,zeile);IF fa>length(zeile)THEN LEAVE 
generierefelderdieserzeileFI ;.definierenaechstesfeld:felddefinition(fa,zeile
,feldnr,lineno(datei));faINCR 1.END PROC erzeugemaske;TEXT PROC infozeile(
TEXT CONST t,s):auskunftstextende+t+" = "+sEND PROC infozeile;PROC init(ROW 
maxfeldnrTEXT VAR feld):INT VAR i;FOR iFROM 1UPTO maxfeldnrREP feld(i):=""
PER END PROC init;PROC logbucheintrag(TEXT CONST logergaenzung):TEXT VAR 
eintrag:="Maske ";eintragCAT maskenname;eintragCAT " ";eintragCAT 
logergaenzung;logeintrag(eintrag)END PROC logbucheintrag;END PACKET 
maskendesign