From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 4 Feb 2019 13:09:03 +0100
Subject: Initial import

---
 app/baisy/2.2.1-schulis/src/isp.maskendesign | 302 +++++++++++++++++++++++++++
 1 file changed, 302 insertions(+)
 create mode 100644 app/baisy/2.2.1-schulis/src/isp.maskendesign

(limited to 'app/baisy/2.2.1-schulis/src/isp.maskendesign')

diff --git a/app/baisy/2.2.1-schulis/src/isp.maskendesign b/app/baisy/2.2.1-schulis/src/isp.maskendesign
new file mode 100644
index 0000000..a90acca
--- /dev/null
+++ b/app/baisy/2.2.1-schulis/src/isp.maskendesign
@@ -0,0 +1,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
+
-- 
cgit v1.2.3