diff options
Diffstat (limited to 'app/eudas/5.3')
26 files changed, 17026 insertions, 0 deletions
diff --git a/app/eudas/5.3/source-disk b/app/eudas/5.3/source-disk new file mode 100644 index 0000000..64243e5 --- /dev/null +++ b/app/eudas/5.3/source-disk @@ -0,0 +1,2 @@ +eudas/eudas-5.3_1989-02-06.1.img +eudas/eudas-5.3_1989-02-06.2.img diff --git a/app/eudas/5.3/src/Adressen b/app/eudas/5.3/src/Adressen Binary files differnew file mode 100644 index 0000000..74f0e3d --- /dev/null +++ b/app/eudas/5.3/src/Adressen diff --git a/app/eudas/5.3/src/boxzeichen b/app/eudas/5.3/src/boxzeichen new file mode 100644 index 0000000..12c3bb8 --- /dev/null +++ b/app/eudas/5.3/src/boxzeichen @@ -0,0 +1,3 @@ +box zeichen (""205""186""201""187""200""188""199""182""196"", + ""15""14"", ""178" ") + diff --git a/app/eudas/5.3/src/dummy.text b/app/eudas/5.3/src/dummy.text new file mode 100644 index 0000000..0eb03b0 --- /dev/null +++ b/app/eudas/5.3/src/dummy.text @@ -0,0 +1,14 @@ +PACKET dummy text DEFINES + lineform, pageform, autoform, autopageform : + +PROC lineform (TEXT CONST datei) : fehler END PROC lineform; +PROC pageform (TEXT CONST datei) : fehler END PROC pageform; +PROC autoform (TEXT CONST datei) : fehler END PROC autoform; +PROC autopageform (TEXT CONST datei) : fehler END PROC autopageform; + +PROC fehler : + errorstop ("Keine Textverarbeitung installiert") +END PROC fehler; + +END PACKET dummy text; + diff --git a/app/eudas/5.3/src/eudas.1 b/app/eudas/5.3/src/eudas.1 new file mode 100644 index 0000000..9a6070c --- /dev/null +++ b/app/eudas/5.3/src/eudas.1 @@ -0,0 +1,49 @@ +PACKETeudasdateienDEFINES EUDAT,oeffne,satznr,dateiende,saetze,aufsatz,weiter,zurueck,satzlesen,satzaendern,satzloeschen,satzeinfuegen,feldlesen,feldaendern,feldbearbeiten,felderzahl,feldnamenlesen,feldnamenaendern,notizenlesen,notizenaendern,feldinfo,automatischerschluessel,dezimalkomma,wertberechnen,reorganisiere,sortiere,sortierreihenfolge,unsortiertesaetze:LETb0=531,c0=121,d0=5000,e0=3243,f0=64,g0=48;LET INTVEC=TEXT,INDEX=STRUCT(INTh0,i0,INTj0,k0,INTVECl0),EINTRAG=STRUCT(INTh0,i0,m0,n0,SATZo0),DATEI=STRUCT(INTfelderzahl,SATZp0,INTVECfeldinfo,TEXTq0,INTr0,s0,t0,INTu0,v0,INTw0,satznr,INTx0,y0,z0,INTa1,b1,ROW3TEXTc1,ROWb0INTd1,ROWc0INDEXindex,ROWd0EINTRAGe1);TYPE EUDAT=BOUND DATEI;LETf1="";LETg1= +#201#"Datei ist keine EUDAS-Datei",h1= +#202#"inkonsistente EUDAS-Datei",i1= +#203#"EUDAS-Datei voll",j1= +#204#"Nicht erlaubtes Dezimalkomma"; +TEXT VARk1;TEXT VARl1:=" ";INTVEC CONSTm1:=n1(f0,1);LETo1="";TEXT VARp1;INTVEC PROCn1(INT CONSTlength,q1):replace(l1,1,q1);length*l1END PROCn1;PROCinsert(INTVEC VARr1,INT CONSTpos,q1):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(r1)+1THENt1ELSEreplace(l1,1,q1);p1:=subtext(r1,begin);r1:=subtext(r1,1,begin-1);r1CATl1;r1CATp1END IF END PROCinsert;PROCdelete(INTVEC VARr1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>=length(r1)THENt1ELSEp1:=subtext(r1,begin+2);r1:=subtext(r1,1,begin-1);r1CATp1END IF END PROCdelete;INT PROCpos(INTVEC CONSTr1,INT CONSTq1):replace(l1,1,q1);INT VARbegin:=1;REPbegin:=pos(r1,l1,begin)+1UNTIL(beginAND1)=0ORbegin=1END REP;beginDIV2END PROCpos;PROCu1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:=subtext(v1,begin);v1:=subtext(v1,1,begin-1)END IF END PROCu1;PROCx1(INTVEC VARv1,w1,INT CONSTpos):INT CONSTbegin:=pos+pos-1;IFbegin<1THENs1ELIFbegin>length(v1)+1THENt1ELSEw1:= +subtext(v1,1,begin-1);v1:=subtext(v1,begin)END IF END PROCx1;.t1:errorstop(9,f1).s1:errorstop(10,f1).PROCy1(DATEI VARz1):z1.felderzahl:=0;z1.feldinfo:=o1;satzinitialisieren(z1.p0);z1.q0:=f1;z1.r0:=1;z1.s0:=1;z1.u0:=0;z1.t0:=0;z1.w0:=0;z1.v0:=1;z1.a1:=0;z1.c1(1):=f1;z1.c1(2):=f1;z1.c1(3):=f1;z1.satznr:=1;z1.x0:=1;z1.y0:=1;z1.z0:=1;z1.index(1).l0:=m1;z1.index(1):=INDEX:(0,0,1,1,n1(1,1));INT VARa2;FORa2FROM1UPTOb0REPz1.d1(a2):=0END REP;z1.e1(1):=EINTRAG:(0,0,1,0,b2).b2:z1.p0.END PROCy1;PROCoeffne(EUDAT VARz1,TEXT CONSTc2):enablestop;IF NOTexists(c2)THEN CONCR(z1):=new(c2);y1(CONCR(z1));type(old(c2),e0)ELIFtype(old(c2))=e0THEN CONCR(z1):=old(c2)ELSEerrorstop(g1)ENDIF END PROCoeffne;PROCoeffne(EUDAT VARz1,DATASPACE CONSTd2):IFtype(d2)<0THEN CONCR(z1):=d2;y1(CONCR(z1));type(d2,e0)ELIFtype(d2)=e0THEN CONCR(z1):=d2ELSEerrorstop(g1)END IF END PROCoeffne;PROCfeldlesen(EUDAT CONSTz1,INT CONSTe2,TEXT VARf2):feldlesen(g2,e2,f2).g2:z1.e1(z1.z0).o0.END PROCfeldlesen;PROCfeldaendern(EUDAT VARz1,INT +CONSTe2,TEXT CONSTh2):IFi2THENj2(CONCR(z1));k2;feldaendern(g2,e2,h2)END IF.i2:z1.z0<>1.k2:IFe2=1THENdisablestop;l2(CONCR(z1),m2(h2))END IF.g2:z1.e1(z1.z0).o0.END PROCfeldaendern;INT PROCfelderzahl(EUDAT CONSTz1):z1.felderzahlEND PROCfelderzahl;PROCfeldbearbeiten(EUDAT CONSTz1,INT CONSTe2,PROC(TEXT CONST,INT CONST,INT CONST)n2):feldbearbeiten(g2,e2,PROC(TEXT CONST,INT CONST,INT CONST)n2).g2:z1.e1(z1.z0).o0.END PROCfeldbearbeiten;PROCfeldnamenlesen(EUDAT CONSTz1,SATZ VARo2):o2:=z1.p0END PROCfeldnamenlesen;PROCfeldnamenaendern(EUDAT VARz1,SATZ CONSTp2):z1.p0:=p2;INT CONSTq2:=felderzahl(p2);IFq2>z1.felderzahlTHENr2;z1.felderzahl:=q2END IF.r2:z1.feldinfoCATn1(s2,-1).s2:q2-length(z1.feldinfo)DIV2.END PROCfeldnamenaendern;INT PROCfeldinfo(EUDAT CONSTz1,INT CONSTe2):z1.feldinfoISUBe2END PROCfeldinfo;PROCfeldinfo(EUDAT VARz1,INT CONSTe2,t2):replace(z1.feldinfo,e2,t2);IFpos(z1.q0,code(e2))>0THENz1.a1:=z1.w0END IF END PROCfeldinfo;INT PROCsatznr(EUDAT CONSTz1):z1.satznrEND PROCsatznr;BOOL PROC +dateiende(EUDAT CONSTz1):z1.satznr>z1.w0END PROCdateiende;INT PROCsaetze(EUDAT CONSTz1):z1.w0END PROCsaetze;PROCu2(DATEI VARz1,INT CONSTx0,k0,satznr):IFx0<1ORx0>z1.s0CORk0<1ORk0>z1.index(x0).j0THENerrorstop(h1)END IF;disablestop;z1.x0:=x0;z1.y0:=k0;z1.satznr:=satznr;z1.z0:=z1.index(x0).l0ISUBk0END PROCu2;PROCaufsatz(EUDAT VARz1,INT CONSTv2):INT VARsatznr;IFv2<1THENsatznr:=1ELIFv2>z1.w0THENsatznr:=z1.w0+1ELSEsatznr:=v2END IF;w2(CONCR(z1),satznr)END PROCaufsatz;PROCaufsatz(EUDAT VARz1,TEXT CONSTx2):aufsatz(z1,1);IFy2THENweiter(z1,x2)END IF.y2:feldlesen(z1,1,k1);k1<>x2.END PROCaufsatz;PROCw2(DATEI VARz1,INT CONSTsatznr):IFz2THENu2(z1,1,1,1)END IF;INT VARx0:=z1.x0,a3:=z1.satznr-z1.y0;IFsatznr>z1.satznrTHENb3ELSEc3END IF;u2(z1,x0,k0,satznr).z2:satznr+satznr<z1.satznr.b3:WHILEd3REPa3INCRj0;x0:=z1.index(x0).i0END REP.d3:INT CONSTj0:=z1.index(x0).j0;a3+j0<satznr.c3:WHILEe3REPx0:=z1.index(x0).h0;a3DECRz1.index(x0).j0END REP.e3:a3>=satznr.k0:satznr-a3.END PROCw2;PROCweiter(EUDAT VARz1):f3(CONCR( +z1))END PROCweiter;PROCf3(DATEI VARz1):IFg3THENh3END IF.g3:z1.z0<>1.h3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=index.j0THENx0:=index.i0;k0:=1ELSEk0INCR1END IF;u2(z1,x0,k0,z1.satznr+1).index:z1.index(x0).END PROCf3;PROCzurueck(EUDAT VARz1):i3(CONCR(z1))END PROCzurueck;PROCi3(DATEI VARz1):IFj3THENk3END IF.j3:z1.satznr<>1.k3:INT VARx0:=z1.x0,k0:=z1.y0;IFk0=1THENx0:=m0.h0;k0:=m0.j0ELSEk0DECR1END IF;u2(z1,x0,k0,z1.satznr-1).m0:z1.index(x0).END PROCi3;PROCweiter(EUDAT VARz1,TEXT CONSTx2):f3(CONCR(z1),x2)END PROCweiter;PROCf3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPo3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,z1.w0+1)END IF.l3:INT VARdummy,k0:=z1.z0;IFn3THENq3(z1,m2(x2),k0,dummy)ELSEo3END IF.m3:k0<>0.n3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.o3:k0:=z1.e1(k0).i0.END PROCf3;PROCzurueck(EUDAT VARz1,TEXT CONSTx2):i3(CONCR(z1),x2)END PROCzurueck;PROCi3(DATEI VARz1,TEXT CONSTx2):l3;WHILEm3CANDn3REPr3END REP;IFm3THENp3(z1,k0)ELSEw2(z1,1)END IF.l3:INT VARk0:=z1.z0,dummy;IFk0=1ORs3THENq3(z1,m2(x2),dummy,k0) +END IF.m3:k0<>0.n3:k0=z1.z0ORs3.s3:feldlesen(g2,1,k1);k1<>x2.g2:z1.e1(k0).o0.r3:k0:=z1.e1(k0).h0.END PROCi3;PROCp3(DATEI VARz1,INT CONSTk0):INT CONSTt3:=z1.e1(k0).m0;INT VARy0:=1,satznr:=0;WHILEy0<>t3REPsatznrINCRz1.index(y0).j0;y0:=z1.index(y0).i0END REP;y0:=pos(z1.index(t3).l0,k0);satznrINCRy0;u2(z1,t3,y0,satznr).END PROCp3;INT VARindex;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):INT VARy3:=w3;index:=0;IFx3-w3<4THENz3ELSEa4END IF;index:=indexMODb0+1.z3:WHILEy3<=x3REPindex:=index*4;indexINCRcode(v3SUBy3);y3INCR1END REP.a4:WHILEy3<=x3REPindexINCRindex;indexINCRcode(v3SUBy3);IFindex>16000THENindex:=indexMODb0END IF;y3INCR1END REP.END PROCu3;INT PROCm2(TEXT CONSTv3):u3(v3,1,length(v3));indexEND PROCm2;INT PROCm2(SATZ CONSTo0):feldbearbeiten(o0,1,PROC(TEXT CONST,INT CONST,INT CONST)u3);indexEND PROCm2;PROCq3(DATEI CONSTz1,INT CONSTm2,INT VARk0,b4):INT VARx0:=z1.r0;b4:=z1.d1(m2);k0:=0;BOOL VARc4:=TRUE;WHILEc4ANDb4<>0REPd4;o3END REP.d4:IFe4THENf4ELSEg4END IF.e4:z1.e1(b4).m0=z1.x0.f4:x0:=z1.x0;INT +CONSTh4:=pos(l0,b4);IFh4=0THENerrorstop(h1)ELIFh4<=i4THENc4:=FALSE END IF.l0:z1.index(x0).l0.i4:z1.y0.g4:WHILEx0<>z1.e1(b4).m0REP IFx0=z1.x0THENc4:=FALSE;LEAVEd4ELSEx0:=z1.index(x0).h0END IF END REP.o3:IFc4THENk0:=b4;b4:=z1.e1(k0).h0END IF.END PROCq3;PROCj4(DATEI VARz1,INT CONSTm2):disablestop;INT CONSTk0:=z1.z0,h0:=z1.e1(k0).h0,i0:=z1.e1(k0).i0;IFi0<>0THENz1.e1(i0).h0:=h0ELSEz1.d1(m2):=h0END IF;IFh0<>0THENz1.e1(h0).i0:=i0END IF.END PROCj4;PROCk4(DATEI VARz1,INT CONSTm2,i0,h0):disablestop;INT CONSTk0:=z1.z0;z1.e1(k0).h0:=h0;z1.e1(k0).i0:=i0;IFh0<>0THENz1.e1(h0).i0:=k0END IF;IFi0<>0THENz1.e1(i0).h0:=k0ELSEz1.d1(m2):=k0END IF END PROCk4;PROCsatzlesen(EUDAT CONSTz1,SATZ VARo0):o0:=z1.e1(z1.z0).o0END PROCsatzlesen;PROCsatzaendern(EUDAT VARz1,SATZ CONSTl4):IF NOTdateiende(z1)THENm4END IF.m4:j2(CONCR(z1));disablestop;l2(CONCR(z1),m2(l4));g2:=l4.g2:z1.e1(z1.z0).o0.END PROCsatzaendern;PROCl2(DATEI VARz1,INT CONSTn4):IFo4THENp4END IF.o4:INT CONSTq4:=m2(g2);q4<>n4.p4:r4;s4.r4:j4(z1,q4).s4:INT +VARh0,i0;q3(z1,n4,h0,i0);k4(z1,n4,h0,i0).g2:z1.e1(z1.z0).o0.END PROCl2;PROCsatzloeschen(EUDAT VARz1):IF NOTdateiende(z1)THENt4END IF.t4:disablestop;u4(CONCR(z1));v4(CONCR(z1));z1.w0DECR1.END PROCsatzloeschen;PROCu4(DATEI VARz1):w4(z1);INT CONSTk0:=z1.z0;j4(z1,m2(g2));z1.e1(k0).i0:=z1.u0;z1.u0:=k0.g2:z1.e1(k0).o0.END PROCu4;PROCsatzeinfuegen(EUDAT VARz1,SATZ CONSTl4):x4(CONCR(z1),l4)END PROCsatzeinfuegen;PROCx4(DATEI VARz1,SATZ CONSTl4):INT VARk0,h0,i0;enablestop;y4;z4;disablestop;z1.w0INCR1;a5(z1,k0);INT CONSTb5:=m2(k1);q3(z1,b5,i0,h0);k4(z1,b5,i0,h0);j2(z1).y4:IFz1.u0<>0THENk0:=z1.u0;z1.u0:=z1.e1(k0).i0ELIFz1.v0=d0THENerrorstop(i1)ELSEz1.v0INCR1;k0:=z1.v0END IF;z1.e1(k0).n0:=0;z1.e1(k0).o0:=l4.z4:feldlesen(l4,1,k1);IFz1.b1>0THEN IFk1=""THENc5;feldaendern(z1.e1(k0).o0,1,k1)END IF END IF.c5:k1:=text(z1.b1);k1:=d5+k1;IFz1.b1>32000THENz1.b1:=1ELSEz1.b1INCR1END IF.d5:(4-length(k1))*"0".END PROCx4;PROCautomatischerschluessel(EUDAT VARe5,BOOL CONSTf5):IFf5ANDe5.b1<0OR NOTf5ANDe5.b1>0THENe5. +b1:=-e5.b1END IF END PROCautomatischerschluessel;BOOL PROCautomatischerschluessel(EUDAT CONSTe5):e5.b1>0END PROCautomatischerschluessel;INTVEC VARg5;PROCv4(DATEI VARz1):INT CONSTx0:=z1.x0,h0:=index.h0,i0:=index.i0;BOOL VARh5;delete(index.l0,z1.y0);index.j0DECR1;i5(z1,x0,i0,h5);IF NOTh5THENi5(z1,h0,x0,h5)END IF;j5(z1).index:z1.index(x0).END PROCv4;PROCi5(DATEI VARz1,INT CONSTy3,k5,BOOL VARh5):h5:=FALSE;IFy3<>0ANDk5<>0THENl5END IF.l5:INT CONSTm5:=index.j0,n5:=o5.j0;IFp5THENq5;h5:=TRUE END IF.p5:m5+n5<=g0ORm5=0ORn5=0.q5:index.j0INCRo5.j0;r5(z1,o5.l0,y3);index.l0CATo5.l0;s5.s5:index.i0:=o5.i0;IFindex.i0<>0THENz1.index(index.i0).h0:=y3ELSEz1.r0:=y3END IF;o5.i0:=z1.t0;z1.t0:=k5.index:z1.index(y3).o5:z1.index(k5).END PROCi5;PROCj5(DATEI VARz1):INT CONSTg2:=z1.satznr;u2(z1,1,1,1);w2(z1,g2)END PROCj5;PROCr5(DATEI VARz1,INTVEC CONSTl0,INT CONSTy3):INT VARa2;FORa2FROM1UPTOlength(l0)DIV2REPz1.e1(l0ISUBa2).m0:=y3END REP END PROCr5;PROCa5(DATEI VARz1,INT CONSTt5):INT VARx0:=z1.x0;IFindex.j0>=f0THEN +u5END IF;index.j0INCR1;insert(index.l0,z1.y0,t5);z1.z0:=t5;z1.e1(t5).m0:=x0.u5:INT VARb5:=0;v5;IFb5<>0THENw5ELSEx5(z1)END IF;j5(z1);x0:=z1.x0.v5:IFz1.t0<>0THENb5:=z1.t0;z1.t0:=o5.i0ELIFz1.s0<c0THENz1.s0INCR1;b5:=z1.s0;o5.l0:=m1END IF.w5:y5;z5;o5.j0:=index.j0-a6;u1(index.l0,o5.l0,a6+1);index.j0:=a6;r5(z1,o5.l0,b5).y5:INT CONSTb6:=index.i0;IFb6<>0THENz1.index(b6).h0:=b5ELSEz1.r0:=b5END IF;o5.i0:=b6;o5.h0:=x0;index.i0:=b5.z5:INT VARa6;IFc6THENa6:=g0ELSEa6:=index.j0DIV2+1END IF.c6:b6=0.index:z1.index(x0).o5:z1.index(b5).END PROCa5;PROCx5(DATEI VARz1):INT VARx0:=1;REPd6;e6END REP.d6:BOOL VARh5;REP INT CONSTi0:=index.i0;i5(z1,x0,i0,h5)UNTIL NOTh5END REP;IFi0=0THEN LEAVEx5ELIFf6THENg6END IF.f6:INT CONSTh6:=g0-index.j0;h6>0.g6:x1(o5.l0,g5,h6+1);o5.j0DECRh6;r5(z1,g5,x0);index.l0CATg5;index.j0:=g0.e6:x0:=i0.index:z1.index(x0).o5:z1.index(i0).END PROCx5;TEXT VARi6:=",";LETj6=1;TEXT PROCdezimalkomma:i6END PROCdezimalkomma;PROCdezimalkomma(TEXT CONSTk6):IFlength(k6)<>1THENerrorstop(j1)ELSEi6:=k6 +ENDIF END PROCdezimalkomma;INT PROCunsortiertesaetze(EUDAT CONSTz1):z1.a1END PROCunsortiertesaetze;TEXT PROCsortierreihenfolge(EUDAT CONSTz1):z1.q0END PROCsortierreihenfolge;PROCj2(DATEI VARz1):IFl6(z1)THENdisablestop;z1.e1(z1.z0).n0INCRj6;z1.a1INCR1END IF END PROCj2;PROCw4(DATEI VARz1):IF NOTl6(z1)THENdisablestop;z1.e1(z1.z0).n0DECRj6;z1.a1DECR1END IF END PROCw4;BOOL PROCl6(DATEI CONSTz1,INT CONSTk0):(z1.e1(k0).n0ANDj6)=0END PROCl6;BOOL PROCl6(DATEI CONSTz1):l6(z1,z1.z0)END PROCl6;INTVEC VARm6;TEXT VARq0;TEXT VARn6,o6;PROCsortiere(EUDAT VARz1):q0:=z1.q0;IFq0=f1THENp6END IF;q6(CONCR(z1)).p6:INT VARa2;FORa2FROM1UPTOz1.felderzahlREPq0CATcode(a2)END REP.END PROCsortiere;PROCsortiere(EUDAT VARz1,TEXT CONSTr6):q0:=r6;q6(CONCR(z1))END PROCsortiere;PROCq6(DATEI VARz1):IFz1.q0<>q0THENz1.q0:=q0;z1.a1:=z1.w0+1ELIFz1.a1=0THEN LEAVEq6END IF;m6:=z1.feldinfo;IFs6THENt6(z1);z1.a1:=0ELSEu6(z1)END IF;w2(z1,1).s6:z1.w0DIVz1.a1<3.END PROCq6;PROCt6(DATEI VARz1):INT VARz0,o0:=1,v6;w2(z1,1);w4(z1);z0:=z1.z0 +;WHILEw6REPx6;y6;cout(o0)END REP;disablestop;x5(z1);u2(z1,1,1,1).w6:o0<z1.w0.x6:o0INCR1;w2(z1,o0);v6:=z0;z0:=z1.z0.y6:IFz6THENa7(z1,o0,z0);z0:=v6ELSEw4(z1)END IF.z6:z1.e1(v6).o0GROESSERz1.e1(z0).o0.END PROCt6;PROCu6(DATEI VARz1):INT VARa2;FORa2FROM1UPTOz1.v0REP IF NOTl6(z1,a2)THENa7(z1,z1.w0+1,a2);cout(a2)END IF END REP END PROCu6;PROCa7(DATEI VARz1,INT CONSTsatznr,z0):b7;c7.b7:INT VARd7:=1,e7:=satznr-1,f7;WHILEg7REPh7;i7END REP.g7:d7<=e7.h7:f7:=(d7+e7)DIV2;INT VARj7;w2(z1,f7);IF NOTl6(z1)THENk7END IF;j7:=z1.z0.k7:WHILEz1.satznr<e7REPf3(z1);IFl7THEN LEAVEk7END IF END REP;WHILEz1.satznr>d7REPi3(z1);IFl7THEN LEAVEk7END IF END REP;LEAVEb7.l7:l6(z1).i7:IFm7GROESSERz1.e1(z0).o0THENe7:=f7-1ELSEd7:=f7+1END IF.m7:z1.e1(j7).o0.c7:p3(z1,z0);IFz1.satznr<d7THENd7DECR1END IF;disablestop;w4(z1);n7;v4(z1);w2(z1,d7);a5(z1,z0);o7.n7:INT CONSTp7:=m2(g2);j4(z1,p7).o7:INT VARh0,i0;q3(z1,p7,h0,i0);k4(z1,p7,h0,i0).g2:z1.e1(z0).o0.END PROCa7;BOOL OP GROESSER(SATZ CONSTq7,r7):s7;t7;SELECTm6ISUBu7OF CASE0:v7 +CASE1:w7CASE2:x7OTHERWISEy7END SELECT.s7:INT VARz7:=1;WHILEz7<length(q0)REP INT CONSTu7:=code(q0SUBz7);feldlesen(q7,u7,n6);feldlesen(r7,u7,o6);SELECTm6ISUBu7OF CASE0:a8CASE1:b8OTHERWISEc8END SELECT;z7INCR2END REP;LEAVE GROESSER WITH FALSE.t7:BOOL VARd8;IF(q0SUB(z7+1))="-"THENd8:=FALSE ELSEd8:=TRUE END IF.b8:REAL VARe8,f8;wertberechnen(n6,e8);wertberechnen(o6,f8);IFe8<>f8THEN LEAVEs7END IF.a8:IF NOT(n6LEXEQUALo6)THEN LEAVEs7END IF.c8:IFn6<>o6THEN LEAVEs7END IF.w7:IFd8THENe8>f8ELSEe8<f8END IF.v7:IFd8THENn6LEXGREATERo6ELSEo6LEXGREATERn6END IF.x7:g8(n6);g8(o6);IFd8THENn6>o6ELSEn6<o6END IF.y7:IFd8THENn6>o6ELSEn6<o6END IF.END OP GROESSER;PROCwertberechnen(TEXT CONSTh8,REAL VARwert):LETi8="0123456789";TEXT VARj8:=i6,text;INT VARk0;INT CONSTk8:=length(h8);l8;WHILEk0<=k8REPm8;k0INCR1END REP;wert:=real(text).l8:k0:=pos(h8,"0","9",1);IFk0=0THENwert:=0.0;LEAVEwertberechnenELIFpos(h8,"-",1,k0)>0THENtext:="-"ELSEtext:=f1END IF;.m8:TEXT CONSTn8:=h8SUBk0;IFpos(i8,n8)>0THENtextCATn8ELIFn8=j8THENtextCAT +".";j8:=f1END IF.END PROCwertberechnen;PROCg8(TEXT VARo8):IFlength(o8)<>8THENo8:=f1ELSEo8:=subtext(o8,7)+subtext(o8,4,5)+subtext(o8,1,2)END IF END PROCg8;PROCreorganisiere(TEXT CONSTc2):EUDAT VARp8,q8;oeffne(p8,c2);disablestop;DATASPACE VARd2:=nilspace;oeffne(q8,d2);r8(CONCR(p8),q8);IF NOTiserrorTHENforget(c2,quiet);copy(d2,c2)END IF;forget(d2)END PROCreorganisiere;PROCr8(DATEI VARp8,EUDAT VARq8):enablestop;s8;t8(p8,CONCR(q8)).s8:w2(p8,1);aufsatz(q8,1);WHILE NOTdateiendeREPsatzeinfuegen(q8,u8);cout(p8.satznr);f3(p8);weiter(q8)END REP.dateiende:p8.satznr>p8.w0.u8:p8.e1(p8.z0).o0.END PROCr8;PROCt8(DATEI VARp8,q8):q8.felderzahl:=p8.felderzahl;q8.p0:=p8.p0;q8.feldinfo:=p8.feldinfo;q8.q0:=p8.q0;q8.c1(1):=p8.c1(1);q8.c1(2):=p8.c1(2);q8.c1(3):=p8.c1(3)END PROCt8;PROCnotizenlesen(EUDAT CONSTz1,INT CONSTv2,TEXT VARv8):v8:=z1.c1(v2)END PROCnotizenlesen;PROCnotizenaendern(EUDAT VARz1,INT CONSTv2,TEXT CONSTv8):z1.c1(v2):=v8END PROCnotizenaendern;END PACKETeudasdateien; +PACKETdatenverwaltungDEFINESoeffne,kopple,kette,zugriff,sichere,dateienloeschen,aufkoppeldatei,anzahlkoppeldateien,anzahldateien,aendernerlaubt,inhaltveraendert,eudasdateiname,folgedatei,herkunft,dateiversion,anzahlfelder,feldnamenlesen,feldnamenbearbeiten,feldnummer,feldinfo,notizenlesen,notizenaendern,feldlesen,feldbearbeiten,feldaendern,satznummer,satzkombination,dateiende,weiter,zurueck,aufsatz,satzeinfuegen,satzloeschen,aenderungeneintragen,suchbedingung,suchbedingunglesen,suchbedingungloeschen,suchversion,satzausgewaehlt,markierungaendern,satzmarkiert,markierungenloeschen,markiertesaetze:LET INTVEC=TEXT,DATEI=STRUCT(TEXTname,SATZb0,INTVECc0,INTd0,INTe0,INTf0,TASKg0,DATASPACEh0,EUDATi0,SATZj0,BOOLk0,BOOLl0,m0,n0,TEXTo0,INTVECp0,INTq0),VERWEIS=STRUCT(INTr0,s0);LETt0="",u0="";LETmaxint=32767,v0=10,w0=256,x0=32;ROWv0DATEI VARy0;INT VARz0:=0,a1:=0,b1,c1:=0,d1,e1:=0,f1,g1,h1,i1:=0;BOOL VARj1:=TRUE,k1,l1;TEXT VARm1;ROWw0VERWEIS VARn1;ROWx0VERWEIS VARo1;INT VARp1;LETq1= +#301#"Zuviel Dateien geoeffnet",r1= +#302#"Datei existiert nicht",s1= +#303#"Nicht moeglich, wenn auf Koppeldatei geschaltet",t1= +#304#"Zu viele Felder",u1= +#305#"Zu viele Koppelfelder",v1= +#306#"keine Koppelfelder vorhanden",w1= +#307#"kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien",x1= +#308#"keine Datei geoeffnet",y1= +#309#"Datei nicht gesichert",z1= +#310#"Suchmuster zu umfangreich"; +TEXT VARa2;TEXT VARb2:=" ";INTVEC VARc2;OP CAT(INTVEC VARtext,INT CONSTwert):replace(b2,1,wert);textCATb2END OP CAT;PROCinsert(INTVEC VARd2,INT CONSTe2,wert):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+1);d2:=subtext(d2,1,f2);d2CATwert;d2CATc2END PROCinsert;PROCdelete(INTVEC VARd2,INT CONSTe2):INT CONSTf2:=e2+e2-2;c2:=subtext(d2,f2+3);d2:=subtext(d2,1,f2);d2CATc2END PROCdelete;PROCg2(INTVEC VARd2,INT CONSTh2,i2):INT VARj2;FORj2FROMh2UPTOlength(d2)DIV2-1REPreplace(d2,j2,(d2ISUBj2)+i2)END REP END PROCg2;EUDAT VARk2;SATZ VARl2;PROCm2(TEXT CONSTn2):IFz0=v0THENerrorstop(q1)END IF;IF NOTexists(n2)THENerrorstop(r1)END IF;IFo2THENerrorstop(s1)END IF;oeffne(k2,n2)END PROCm2;PROCp2(DATEI VARr0,TEXT CONSTn2,TASK CONSTq2):IFk1OR NOTisniltask(q2)THENr0.h0:=old(n2);oeffne(r0.i0,r0.h0);IF NOTk1THENforget(n2,quiet)END IF ELSEoeffne(r0.i0,n2)END IF;r0.g0:=q2;r0.e0:=0;r0.l0:=FALSE;r0.m0:=FALSE;r0.name:=n2;r2(r0)END PROCp2;PROCs2(INT CONSTt2):INT VARu2:=t2;WHILEy0(u2).e0<>0REPu2:=y0(u2).e0END REP;y0(u2).e0:= +z0END PROCs2;PROCv2:IFdateiende(y0(1).i0)THENaufsatz(1)ELSEaufsatz(satznr(y0(1).i0))END IF END PROCv2;PROCw2:d1:=felderzahl(y0(1).i0);e1:=d1;feldnamenlesen(y0(1).i0,y0(1).b0);p1:=0;INT VARj2;FORj2FROM1UPTOe1REPn1(j2).r0:=0END REP END PROCw2;PROCx2:i1INCR1;IFi1>32000THENi1:=-32000END IF END PROCx2;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2):oeffne(n2,y2,niltask)END PROCoeffne;PROCoeffne(TEXT CONSTn2,BOOL CONSTy2,TASK CONSTq2):enablestop;dateienloeschen(FALSE);suchbedingungloeschen;m2(n2);k1:=y2;z2;p2(y0(z0),n2,q2);v2;w2.z2:z0:=1;x2;h1:=0.END PROCoeffne;PROCkopple(TEXT CONSTn2):kopple(n2,niltask)END PROCkopple;PROCkopple(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);a3;b3;c3;p2(y0(z0),n2,q2);d3.a3:feldnamenlesen(k2,l2);INT VARc0:=0;INTVEC VARe3:=u0;WHILEc0<felderzahl(k2)REPfeldlesen(l2,c0+1,a2);INT CONSTindex:=feldindex(y0(1).b0,a2);IFindex>0THENc0INCR1;e3CATindexEND IF UNTILindex=0END REP.b3:IFe1+felderzahl(k2)-c0>w0THENerrorstop(t1)ELIFp1+c0>x0THENerrorstop(u1) +ELIFc0=0THENerrorstop(v1)END IF;z0INCR1;y0(z0).b0:=l2;y0(z0).c0:=e3;y0(z0).d0:=c0;INT VARf3:=c0;WHILEf3<felderzahl(k2)REPe1INCR1;f3INCR1;n1(e1).r0:=z0;n1(e1).s0:=f3END REP;FORf3FROM1UPTOc0REPg3END REP.g3:INT CONSTh3:=e3ISUBf3;IFn1(h3).r0=0THENi3ELSEj3END IF.i3:p1INCR1;o1(p1).r0:=z0;o1(p1).s0:=f3;n1(h3).r0:=p1;n1(h3).s0:=1.j3:INT CONSTk3:=n1(h3).r0+n1(h3).s0;l3;n1(h3).s0INCR1;o1(k3).r0:=z0;o1(k3).s0:=f3.l3:INT VARm3;FORm3FROMp1DOWNTOk3REPo1(m3+1):=o1(m3)END REP;p1INCR1;FORm3FROM1UPTOd1REP IFn1(m3).r0>=k3THENn1(m3).r0INCR1END IF END REP.c3:a1INCR1;IFc1=0THENc1:=z0ELSEs2(c1)END IF.d3:x2;y0(z0).k0:=FALSE;y0(z0).n0:=FALSE;y0(z0).f0:=satznr(k2);n3(y0(z0)).END PROCkopple;PROCkette(TEXT CONSTn2):kette(n2,niltask)END PROCkette;PROCkette(TEXT CONSTn2,TASK CONSTq2):enablestop;IFz0=0THENerrorstop(x1)END IF;m2(n2);z0INCR1;p2(y0(z0),n2,q2);s2(1);IFj1THENaufsatz(satznummer)END IF END PROCkette;PROCzugriff(PROC(EUDAT VAR)o3):IFz0>1ORo2THENerrorstop(w1)ELSEaenderungeneintragen;o3(y0(1).i0);x2;v2;w2;y0( +1).m0:=TRUE ENDIF END PROCzugriff;PROCsichere(INT CONSTp3,TEXT CONSTn2):aenderungeneintragen;notizenaendern(y0(p3).i0,2,date);IFk1THENforget(n2,quiet);copy(y0(p3).h0,n2)END IF;y0(p3).m0:=FALSE END PROCsichere;PROCdateienloeschen(BOOL CONSTq3):aenderungeneintragen;IFo2THENaufkoppeldatei(0)END IF;r3;s3.r3:a1:=0;c1:=0;y0(1).e0:=0;e1:=0;j1:=TRUE.s3:WHILEz0>0REP IFt3AND NOTq3THENerrorstop(y1);LEAVEdateienloeschenEND IF;forget(y0(z0).h0);z0DECR1END REP.t3:k1ANDy0(z0).m0.END PROCdateienloeschen;INT VARu3,v3,w3,x3,y3,z3,a4,b4;BOOL VARc4;INTVEC VARd4;SATZ VARe4;BOOL VARo2:=FALSE;INT VARf4:=0,g4:=1;BOOL PROCaufkoppeldatei:o2END PROCaufkoppeldatei;PROCaufkoppeldatei(INT CONSTh4):disablestop;x2;IFo2THENi4;o2:=FALSE;j4;k4ELSEl4;o2:=TRUE;m4END IF.i4:b1:=u3;d1:=v3;e1:=w3;f1:=x3;h1:=z3;c1:=a4;y0(g4).e0:=b4;n4:=f4;l1:=c4;o4:=d4;p4:=e4;IFn4>0THENq4:=1ELSEq4:=-1END IF.k4:f4:=0;g4:=1;enablestop;aufsatz(satznummer);WHILEg1<>y3REPweiter(1)END REP.j4:y0(g4).f0:=satznr(y0(g4).i0);IFh4=1AND NOTdateiende(y0(b1) +.i0)THENr4END IF.r4:INT VARs4;FORs4FROM1UPTOy0(g4).d0REPfeldaendern(y0(b1).i0,t4,u4)END REP;y3:=1.t4:y0(g4).c0ISUBs4.u4:feldlesen(y0(g4).i0,s4,a2);a2.l4:u3:=b1;v3:=d1;w3:=e1;x3:=f1;y3:=g1;z3:=h1;a4:=c1;b4:=y0(h4).e0;c4:=l1;d4:=o4;e4:=p4.m4:b1:=h4;f4:=n4;g4:=h4;d1:=felderzahl(y0(h4).i0);e1:=d1;f1:=0;h1:=(length(y0(h4).p0)-1)DIV2;c1:=0;y0(h4).e0:=0;suchbedingungloeschen;aufsatz(y0(h4).f0).END PROCaufkoppeldatei;INT PROCanzahlkoppeldateien:a1END PROCanzahlkoppeldateien;INT PROCanzahldateien:z0END PROCanzahldateien;BOOL PROCaendernerlaubt:k1END PROCaendernerlaubt;BOOL PROCinhaltveraendert(INT CONSTv4):aenderungeneintragen;y0(v4).m0END PROCinhaltveraendert;TEXT PROCeudasdateiname(INT CONSTv4):y0(v4).nameEND PROCeudasdateiname;INT PROCfolgedatei(INT CONSTv4):IFv4=0THENc1ELSEy0(v4).e0END IF END PROCfolgedatei;TASK PROCherkunft(INT CONSTv4):y0(v4).g0END PROCherkunft;INT PROCdateiversion:i1END PROCdateiversion;INT PROCanzahlfelder:e1END PROCanzahlfelder;PROCfeldnamenlesen(INT CONSTf3,TEXT VAR +name):IFf3<=d1THENfeldlesen(y0(g4).b0,f3,name)ELSEfeldlesen(w4,x4,name)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenlesen;PROCfeldnamenbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(g4).b0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(w4,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.w4:y0(n1(f3).r0).b0.x4:n1(f3).s0.END PROCfeldnamenbearbeiten;INT PROCfeldnummer(TEXT CONSTz4):INT VARa5:=d1,h4:=feldindex(y0(g4).b0,z4),u2:=c1;WHILEh4=0ANDu2<>0REPh4:=feldindex(y0(u2).b0,z4);b5;u2:=y0(u2).e0END REP;h4.b5:INT CONSTc5:=y0(u2).d0;IFh4=0THENa5INCRfelderzahl(y0(u2).i0);a5DECRc5ELSEh4INCRa5;h4DECRc5END IF.END PROCfeldnummer;INT PROCfeldinfo(INT CONSTf3):IFf3<=d1THENfeldinfo(y0(g4).i0,f3)ELSEfeldinfo(y0(w4).i0,x4)END IF.w4:n1(f3).r0.x4:n1(f3).s0.END PROCfeldinfo;PROCnotizenlesen(INT CONSTh4,TEXT VARd5):notizenlesen(y0(g4).i0,h4,d5)END PROCnotizenlesen;PROCnotizenaendern(INT CONSTh4,TEXT CONSTd5):notizenaendern(y0(g4).i0,h4 +,d5);y0(g4).m0:=TRUE END PROCnotizenaendern;PROCfeldlesen(INT CONSTf3,TEXT VARd5):IFf3<=d1THENfeldlesen(y0(b1).i0,f3,d5)ELSEe5END IF.e5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldlesen(y0(w4).j0,x4,d5)ELSEfeldlesen(y0(w4).i0,x4,d5)END IF.x4:n1(f3).s0.END PROCfeldlesen;PROCfeldbearbeiten(INT CONSTf3,PROC(TEXT CONST,INT CONST,INT CONST)y4):IFf3<=d1THENfeldbearbeiten(y0(b1).i0,f3,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEf5END IF.f5:INT CONSTw4:=n1(f3).r0;IFy0(w4).k0THENfeldbearbeiten(y0(w4).j0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)ELSEfeldbearbeiten(y0(w4).i0,x4,PROC(TEXT CONST,INT CONST,INT CONST)y4)END IF.x4:n1(f3).s0.END PROCfeldbearbeiten;PROCfeldaendern(INT CONSTf3,TEXT CONSTd5):INT CONSTw4:=n1(f3).r0;IFf3<=d1THENg5ELSEh5END IF.g5:y0(b1).m0:=TRUE;IFi5CANDj5THENk5END IF;feldaendern(y0(b1).i0,f3,d5).i5:NOTo2CANDw4>0.j5:feldlesen(y0(b1).i0,f3,a2);a2<>d5.k5:INT VARl5:=x4,m5:=w4;REPn5(y0(o5));y0(o5).n0:=TRUE;feldaendern(y0(o5).j0,h3,d5);m5INCR1;l5DECR1UNTILl5=0END REP.h5:n5(y0(w4)); +IFp5THENy0(w4).l0:=TRUE;feldaendern(y0(w4).j0,x4,d5)END IF.p5:feldlesen(y0(w4).j0,x4,a2);a2<>d5.x4:n1(f3).s0.o5:o1(m5).r0.h3:o1(m5).s0.END PROCfeldaendern;PROCn5(DATEI VARr0):IF NOTr0.k0THENr0.k0:=TRUE;q5END IF.q5:IFdateiende(r0.i0)THENsatzinitialisieren(r0.j0,r0.d0);r5ELSEsatzlesen(r0.i0,r0.j0)END IF.r5:INT VARj2;FORj2FROM1UPTOr0.d0REPfeldlesen(r0.c0ISUBj2,a2);feldaendern(r0.j0,j2,a2)END REP.END PROCn5;PROCn3(DATEI VARr0):s5;t5.s5:feldlesen(y0(b1).i0,u5,o0).u5:r0.c0ISUB1.o0:r0.o0.t5:aufsatz(r0.i0,o0);WHILE NOTv5(r0)REPweiter(r0.i0,o0)END REP;IFdateiende(r0.i0)THENn5(r0)ELSEr0.k0:=FALSE END IF.END PROCn3;PROCw5:INT VARu2:=c1;WHILEu2<>0REPn3(y0(u2));u2:=y0(u2).e0END REP;g1:=1END PROCw5;BOOL PROCv5(DATEI CONSTr0):IF NOTdateiende(r0.i0)THENx5END IF;TRUE.x5:INT VARy5;FORy5FROM2UPTOr0.d0REPfeldlesen(y0(b1).i0,c0ISUBy5,a2);feldbearbeiten(r0.i0,y5,PROC(TEXT CONST,INT CONST,INT CONST)z5);IF NOTa6THEN LEAVEv5WITH FALSE END IF END REP.c0:r0.c0.END PROCv5;BOOL VARa6;PROCz5(TEXT CONSTb6,INT CONST +t2,c6):a6:=length(a2)+t2=c6+1CANDpos(b6,a2,t2,c6+1)=t2END PROCz5;LETd6=22101,e6="h",f6=""27"";BOOL VARg6;PROCh6:TEXT VARi6;g6:=FALSE;REPi6:=incharety;type(i6)UNTILi6=t0END REP END PROCh6;PROCj6:IFg6THENtype(f6)END IF END PROCj6;BOOL PROCk6:TEXT VARi6;REPi6:=incharety;IFi6=t0THEN LEAVEk6WITH FALSE ELSEl6END IF END REP;FALSE.l6:IFg6THENg6:=FALSE;m6ELSEn6END IF.m6:IFi6=e6THENo6;errorstop(d6,t0);LEAVEk6WITH TRUE ELSEtype(f6);type(i6)END IF.n6:IFi6=f6THENg6:=TRUE ELSEtype(i6)END IF.o6:REP UNTILgetcharety=t0END REP.END PROCk6;PROCweiter(INT CONSTp6):IF NOTj1THENaenderungeneintragen;q6END IF.q6:SELECTp6OF CASE1:r6CASE2:s6CASE3:t6END SELECT.r6:u6(FALSE).s6:h6;REPu6(l1);cout(satznummer)UNTILsatzausgewaehltORj1ORk6END REP;j6.t6:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDe0<>0REPx6;v6:=1END REP;aufsatz(y0(b1).i0,y6);cout(satznummer);w5;j1:=dateiende(y0(b1).i0);z6.w6:a7(y0(b1),v6+1);INT CONSTy6:=y0(b1).p0ISUBy0(b1).q0;y6=maxint.e0:y0(b1).e0.END PROCweiter;PROCzurueck(INT CONSTp6):IFsatznummer>1THEN +aenderungeneintragen;b7END IF.b7:SELECTp6OF CASE1:c7CASE2:d7CASE3:e7END SELECT.c7:f7(FALSE).d7:h6;REPf7(l1);cout(satznummer)UNTILsatzausgewaehltORsatznummer=1ORk6END REP;j6.e7:INT VARv6:=satznr(y0(b1).i0);WHILEw6ANDb1<>1REPg7;v6:=maxint-1END REP;aufsatz(y0(b1).i0,h7);cout(satznummer);w5;j1:=FALSE;z6.w6:INT VARh7;a7(y0(b1),v6);IFy0(b1).q0=1THENh7:=1;TRUE ELSEh7:=y0(b1).p0ISUB(y0(b1).q0-1);FALSE END IF.END PROCzurueck;PROCu6(BOOL CONSTi7):j7;IFk7THENr6;w5ELSEg1INCR1END IF;z6.j7:INT VARu2:=c1;WHILEu2>0REPl7;u2:=y0(u2).e0END REP.l7:BOOL VARm7;n7(y0(u2),m7);IFm7THEN LEAVEj7END IF.k7:u2=0.r6:IFi7THENweiter(y0(b1).i0,m1)ELSEweiter(y0(b1).i0)END IF;WHILEdateiende(y0(b1).i0)REPo7UNTILj1END REP.o7:IFy0(b1).e0<>0THENx6;p7ELSEj1:=TRUE END IF.p7:aufsatz(y0(b1).i0,1).END PROCu6;PROCn7(DATEI VARr0,BOOL VARm7):IFdateiende(r0.i0)THENm7:=FALSE ELSEq7END IF.q7:m7:=TRUE;REPweiter(r0.i0,r0.o0);IFdateiende(r0.i0)THENm7:=FALSE;aufsatz(r0.i0,r0.o0)END IF UNTILv5(r0)END REP.END PROCn7;PROCf7(BOOL CONSTi7): +WHILEsatznr(y0(b1).i0)=1CANDsatznummer>1REPg7;r7(y0(b1).i0)END REP;IFi7THENzurueck(y0(b1).i0,m1)ELSEzurueck(y0(b1).i0)END IF;j1:=FALSE;w5;z6END PROCf7;PROCx6:f1INCRsaetze(y0(b1).i0);b1:=y0(b1).e0END PROCx6;PROCg7:INT VARs7:=1;WHILEy0(s7).e0<>b1REPs7:=y0(s7).e0END REP;f1DECRsaetze(y0(s7).i0);b1:=s7END PROCg7;PROCaenderungeneintragen:INT VARu2:=c1;WHILEu2<>0REPt7;u2:=y0(u2).e0END REP.t7:IFy0(u2).k0THENu7(y0(u2))END IF.END PROCaenderungeneintragen;PROCu7(DATEI VARr0):IFv7AND NOTw7THENx7ELIFy7ANDz7THENa8ELIFw7THENn3(r0)END IF;b8;l0:=FALSE;w7:=FALSE.v7:NOTdateiende(r0.i0)ANDl0.y7:felderzahl(j0)>r0.d0.z7:w7ORl0.a8:m0:=TRUE;feldlesen(j0,1,r0.o0);satzeinfuegen(r0.i0,j0).b8:r0.k0:=FALSE.x7:m0:=TRUE;satzaendern(r0.i0,j0).l0:r0.l0.w7:r0.n0.j0:r0.j0.m0:r0.m0.END PROCu7;PROCr7(EUDAT VARi0):aufsatz(i0,saetze(i0)+1)END PROCr7;PROCaufsatz(INT CONSTsatznr):aenderungeneintragen;b1:=g4;f1:=0;WHILEc8ANDd8REPx6END REP;aufsatz(y0(b1).i0,satznr-f1);w5;j1:=dateiende(y0(b1).i0);z6.c8:satznr-f1>saetze(y0(b1).i0 +).d8:y0(b1).e0<>0.END PROCaufsatz;PROCaufsatz(TEXT CONSTe8):aenderungeneintragen;f8(e8,j1);w5;z6END PROCaufsatz;PROCf8(TEXT CONSTe8,BOOL CONSTg8):IFg8THENaufsatz(1)END IF;REPaufsatz(y0(b1).i0,e8);IF NOTdateiende(y0(b1).i0)THENj1:=FALSE;LEAVEf8ELIFy0(b1).e0=0THENj1:=TRUE;IF NOTg8THENf8(e8,TRUE)END IF;LEAVEf8END IF;x6END REP END PROCf8;INT PROCsatznummer:f1+satznr(y0(b1).i0)END PROCsatznummer;INT PROCsatzkombination:g1END PROCsatzkombination;BOOL PROCdateiende:j1END PROCdateiende;SATZ VARh8;satzinitialisieren(h8);PROCsatzeinfuegen:aenderungeneintragen;i8;satzeinfuegen(y0(b1).i0,h8);y0(b1).m0:=TRUE;j8;j1:=FALSE;z6.i8:a7(y0(b1),satznr(y0(b1).i0));g2(y0(b1).p0,y0(b1).q0,1).j8:g1:=1;INT VARu2:=c1;WHILEu2<>0REPr7(y0(u2).i0);u2:=y0(u2).e0END REP.END PROCsatzeinfuegen;PROCsatzloeschen:IF NOTj1THENaenderungeneintragen;k8;satzloeschen(y0(b1).i0);y0(b1).m0:=TRUE;aufsatz(satznummer)END IF.k8:IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1END IF;g2(y0(b1).p0,y0(b1).q0,-1).END PROCsatzloeschen; +LETl8=100;ROWl8STRUCT(INTs0,m8,n8,o8,TEXTo0)VARp8;SATZ VARp4;INT VARn4,q4,q8:=1;BOOL VARr8,s8;suchbedingungloeschen;INT VARt8;LETu8=1,v8=2,w8=3,x8=4,y8=5,z8=6,a9=7,b9=8,c9=9;PROCz6:IFj1THENs8:=FALSE ELSEd9;s8:=e9END IF.d9:t8:=q4;WHILEt8>0REPf9;feldbearbeiten(g9,PROC(TEXT CONST,INT CONST,INT CONST)h9)END REP.f9:INT VARi9:=p8(t8).m8;IFi9>=256THENj9;k9END IF.j9:feldlesen((i9AND255)+1,a2).k9:IFl9=2THENm9END IF;p8(t8).o0:=a2.g9:p8(t8).s0.e9:t8<0.END PROCz6;PROCh9(TEXT CONSTb6,INT CONSTn9,o9):INT VARi9:=p8(t8).m8;IFi9>=256THENi9:=i9DIV256END IF;IFp9THENt8:=p8(t8).n8ELSEt8:=p8(t8).o8END IF.p9:SELECTi9OF CASEu8:q9CASEv8:r9CASEw8:s9CASEx8:t9CASEy8:u9CASEz8:v9CASEa9:w9CASEb9:x9CASEc9:y9OTHERWISE FALSE END SELECT.q9:SELECTl9OF CASE0:z9;a2LEXEQUALo0CASE1:z9;a10=b10OTHERWISElength(o0)=o9-n9+1ANDc10END SELECT.c10:n9>o9CORr9.r9:pos(b6,o0,n9,o9)=n9.s9:pos(b6,o0,o9+1-length(o0),o9)>0.t9:pos(b6,o0,n9,o9)>0.u9:z9;SELECTl9OF CASE0:o0LEXGREATERa2CASE1:a10<b10CASE2:m9;a2<o0OTHERWISEa2<o0END SELECT.v9:z9; +SELECTl9OF CASE0:a2LEXGREATEREQUALo0CASE1:a10>=b10CASE2:m9;a2>=o0OTHERWISEa2>=o0END SELECT.w9:n9<=o9.x9:satzmarkiert.y9:TRUE.z9:a2:=subtext(b6,n9,o9).END PROCh9;TEXT PROCo0:p8(t8).o0END PROCo0;PROCm9:IFlength(a2)=8THEN TEXT CONSTd10:=subtext(a2,7,8);replace(a2,7,subtext(a2,1,2));replace(a2,1,d10)ELSEa2:=t0END IF END PROCm9;INT PROCl9:feldinfo(p8(t8).s0)END PROCl9;REAL PROCa10:REAL VARe10;wertberechnen(a2,e10);e10END PROCa10;REAL PROCb10:REAL VARe10;wertberechnen(o0,e10);e10END PROCb10;LETf10=";",g10=",",h10="..",i10="++",j10="--",k10="*";BOOL VARl10,m10,n10;INT VARo10,p10,q10,r10,s10;INTVEC VARo4;PROCsuchbedingung(INT CONSTf3,TEXT CONSTp8):INT VARt2:=1,t10:=0;INT CONSTu10:=length(p8)+1;p10:=0;s10:=f3;o10:=n4+1;WHILEt2<u10REPv10;w10;t2:=c6+2END REP;feldaendern(p4,f3,p8).v10:INT VARx10:=pos(p8,g10,t2);IFx10=0THENx10:=u10END IF;IFt10<t2THENy10END IF;INT CONSTc6:=min(x10,t10)-1.y10:p10INCR1;l10:=TRUE;IFp10>1THENl1:=FALSE END IF;t10:=pos(p8,f10,t2);IFt10=0THENt10:=u10END IF.w10:z10;m10:= +TRUE;INT CONSTa11:=pos(p8,h10,t2,c6+1);IFb11THENc11(t0,c9,-p10)ELIFa11=0THENd11ELSEe11END IF.z10:IFsubtext(p8,t2,t2+1)=j10THENt2INCR2;n10:=TRUE ELSEn10:=FALSE END IF.b11:t2>c6.d11:IFf11THENg11ELSEh11END IF.f11:t2+1=c6CANDsubtext(p8,t2,c6)=i10.g11:c11(t0,b9,-p10).h11:INT VARi11:=pos(p8,k10,t2,c6+1);IFi11=0THENj11ELIFt2=c6THENk11ELSEl11;REPm11END REP END IF.j11:IFn11THENl1:=TRUE;m1:=p8END IF;c11(subtext(p8,t2,c6),u8,-p10).n11:f3=1ANDt2=1ANDc6=u10-1ANDo11AND NOTo2AND(p8SUB1)<>"&".o11:length(o4)<=2.k11:c11(t0,a9,-p10).l11:INT VARm8;IFi11=t2THENm8:=u8ELSEm8:=v8END IF.m11:IFm8<>u8THENp11END IF;t2:=i11+1;i11:=pos(p8,k10,t2,c6+1);IFi11=0THENi11:=c6+1;m8:=w8ELSEm8:=x8END IF.p11:TEXT CONSTo0:=subtext(p8,t2,i11-1);IFn10ORq11THEN IFn10THENm10:=TRUE END IF;c11(o0,m8,-p10);IFq11THEN LEAVEh11END IF ELSEc11(o0,m8,n4+2)END IF.q11:i11>=c6.e11:TEXT CONSTr11:=subtext(p8,t2,a11-1),s11:=subtext(p8,a11+2,c6);IFa11=t2THENc11(s11,y8,-p10)ELIFa11=c6-1THENc11(r11,z8,-p10)ELSEt11END IF.t11:IFn10THENc11(r11,z8,- +p10);m10:=TRUE ELSEc11(r11,z8,n4+2)END IF;c11(s11,y8,-p10).END PROCsuchbedingung;PROCc11(TEXT CONSTu11,INT CONSTm8,n8):v11;w11;IFl10THENx11;y11;r10:=n4ELIFm10THENz11END IF;a12;b12.v11:r8:=FALSE;IFn4=f4THENq8INCR1;IFq8>32000THENq8:=1END IF END IF.w11:IFn4=l8THENsuchbedingungloeschen;errorstop(z1)ELSEn4INCR1;q4:=f4+1END IF.x11:IFp10>length(o4)DIV2THENo4CATn4;c12(q4,0,n4)END IF;IFp10=length(o4)DIV2THENq10:=0ELSEq10:=o4ISUB(p10+1)END IF.y11:c12(q4,-p10,n4);l10:=FALSE;m10:=FALSE.z11:c12(r10,q10,n4);r10:=n4;m10:=FALSE.a12:p8(n4).m8:=m8;p8(n4).s0:=s10;IFn10THENp8(n4).n8:=q10;p8(n4).o8:=n8ELSEp8(n4).n8:=n8;p8(n4).o8:=q10END IF.b12:IFd12THENe12ELSEf12END IF.d12:(u11SUB1)="&"CANDg12.g12:INT CONSTh12:=feldnummer(subtext(u11,2));h12>0.e12:p8(n4).m8:=h12-1+256*m8.f12:INT CONSTi12:=feldinfo(s10);IFi12=2AND(m8=y8ORm8=z8)THENa2:=u11;m9;p8(n4).o0:=a2ELSEp8(n4).o0:=u11END IF.END PROCc11;PROCc12(INT CONSTn9,wert,j12):INT VARj2;FORj2FROMn9UPTOn4-1REP IFp8(j2).n8=wertTHENp8(j2).n8:=j12ELIFp8(j2).o8=wert +THENp8(j2).o8:=j12END IF END REP END PROCc12;PROCsuchbedingunglesen(INT CONSTf3,TEXT VARp8):feldlesen(p4,f3,p8)END PROCsuchbedingunglesen;PROCsuchbedingungloeschen:disablestop;IFo2THENn4:=f4ELSEf4:=0;n4:=0END IF;q4:=-1;o4:=u0;satzinitialisieren(p4);l1:=FALSE;r8:=TRUE;s8:=NOTj1END PROCsuchbedingungloeschen;BOOL PROCsatzausgewaehlt:IF NOTr8THENz6;r8:=TRUE END IF;s8END PROCsatzausgewaehlt;INT PROCsuchversion:IFn4=f4THEN0ELSEq8END IF END PROCsuchversion;PROCa7(DATEI VARr0,INT CONSTb6):IF(r0.p0ISUBr0.q0)<b6THENk12ELSEl12END IF.k12:REPr0.q0INCR1UNTIL(r0.p0ISUBr0.q0)>=b6END REP.l12:WHILEr0.q0>1CAND(r0.p0ISUB(r0.q0-1))>=b6REPr0.q0DECR1END REP.END PROCa7;PROCmarkierungaendern:disablestop;IFsatzmarkiertTHENdelete(y0(b1).p0,y0(b1).q0);h1DECR1ELSEinsert(y0(b1).p0,y0(b1).q0,satznr(y0(b1).i0));h1INCR1END IF END PROCmarkierungaendern;BOOL PROCsatzmarkiert:INT CONSTb6:=satznr(y0(b1).i0);a7(y0(b1),b6);b6=(y0(b1).p0ISUBy0(b1).q0)END PROCsatzmarkiert;INT PROCmarkiertesaetze:h1END PROCmarkiertesaetze;PROC +markierungenloeschen:disablestop;IFo2THENr2(y0(b1))ELSEm12END IF;h1:=0.m12:INT VARu2:=1;REPr2(y0(u2));u2:=y0(u2).e0UNTILu2=0END REP.END PROCmarkierungenloeschen;PROCr2(DATEI VARr0):r0.p0:=t0;r0.p0CATmaxint;r0.q0:=1END PROCr2;END PACKETdatenverwaltung; + diff --git a/app/eudas/5.3/src/eudas.2 b/app/eudas/5.3/src/eudas.2 new file mode 100644 index 0000000..50fc707 --- /dev/null +++ b/app/eudas/5.3/src/eudas.2 @@ -0,0 +1,73 @@ +PACKETverarbeitungDEFINESkopiere,stdkopiermuster,verarbeite,trage,eindeutigefelder,pruefe,wertemenge,feldmaske,tragesatz,holesatz,K,V,f,wert,zahltext,textdarstellung:SATZ VARb0,c0,d0;INT VARe0;BOOL VARf0;LETg0="",INTVEC=TEXT;INTVEC VARh0;TEXT VARi0:=" ";OP CAT(INTVEC VARj0,INT CONSTk0):replace(i0,1,k0);j0CATi0END OP CAT;PROCstdkopiermuster(TEXT CONSTl0,FILE VARm0):n0;INT VARo0;p0;q0;INT VARr0;FORr0FROM1UPTOo0REPs0;IFt0THENu0ELSEv0END IF END REP.p0:output(m0);EUDAT VARw0;IFexists(l0)THENoeffne(w0,l0)END IF.q0:IFexists(l0)CANDfelderzahl(w0)>0THENfeldnamenlesen(w0,b0);o0:=felderzahl(w0)ELSEx0;o0:=anzahlfelderEND IF.x0:TEXT VARy0;satzinitialisieren(b0);FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,y0);feldaendern(b0,r0,y0)END REP.t0:feldnummer(y0)>0.s0:feldlesen(b0,r0,y0);put(m0,textdarstellung(y0)).u0:write(m0,"K f(");write(m0,textdarstellung(y0));putline(m0,");").v0:putline(m0,"K """";").END PROCstdkopiermuster;PROCkopiere(TEXT CONSTl0,FILE VARm0):z0(a1,m0).a1:"kopiere ("+ +textdarstellung(l0)+", ".END PROCkopiere;PROCz0(TEXT CONSTb1,FILE VARc1):d1;write(e1,b1);putline(e1,"PROC programmfunktion);");putline(e1,"PROC programmfunktion:");f1;putline(e1,"END PROC programmfunktion");g1;forget(h1,quiet).d1:TEXT VARh1;INT VARi1:=0;REPi1INCR1;h1:=text(i1)UNTIL NOTexists(h1)END REP;disablestop;FILE VARe1:=sequentialfile(output,h1);headline(e1,j1).f1:TEXT VARk1;input(c1);WHILE NOTeof(c1)REPgetline(c1,k1);putline(e1,k1)END REP.g1:TEXT CONSTl1:=std;run(h1);lastparam(l1).END PROCz0;PROCkopiere(TEXT CONSTl0,PROCm1):enablestop;INT VARn1;o1(n1);IFdateiendeTHENaufsatz(1);LEAVEkopiereELSEp1END IF;WHILE NOTdateiendeREPsatzinitialisieren(d0);e0:=1;m1;q1;satzeinfuegen(w0,d0);weiter(w0);weiter(n1)END REP;aufsatz(1).p1:f0:=TRUE;EUDAT VARw0;oeffne(w0,l0);aufsatz(w0,saetze(w0)+1);feldnamenlesen(w0,c0);h0:=g0.q1:IFf0THENfeldnamenaendern(w0,c0);f0:=FALSE END IF END PROCkopiere;OP K(TEXT CONSTy0,r1):IFf0THENs1;END IF;feldaendern(d0,h0ISUBe0,r1);e0INCR1.s1:INT VARt1:=feldindex(c0,y0); +IFt1=0THENt1:=felderzahl(c0)+1;feldaendern(c0,t1,y0);END IF;h0CATt1.END OP K;PROCverarbeite(FILE VARu1):z0("verarbeite (",u1)END PROCverarbeite;PROCverarbeite(PROCv1):enablestop;INT VARn1;o1(n1);WHILE NOTdateiendeREPv1;weiter(n1)END REP;aufsatz(1)END PROCverarbeite;OP V(TEXT CONSTy0,r1):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0)ELSEfeldaendern(w1,r1)END IF END OP V;PROCo1(INT VARn1):n0;aufsatz(1);IFmarkiertesaetze>0THENn1:=3;IF NOTsatzmarkiertTHENweiter(n1)END IF ELSEn1:=2;IF NOTsatzausgewaehltTHENweiter(n1)END IF END IF END PROCo1;PROCn0:IFanzahldateien=0THENerrorstop(y1)END IF.END PROCn0;TEXT VARz1,a2;LETb2="""";TEXT PROCf(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);z1:=g0ELSEfeldlesen(w1,z1)END IF;z1END PROCf;REAL PROCwert(TEXT CONSTy0):INT CONSTw1:=feldnummer(y0);IFw1=0THENx1(y0);0.0ELSEfeldlesen(w1,z1);REAL VARc2;wertberechnen(z1,c2);c2END IF END PROCwert;REAL PROCwert(TEXT CONSTy0,INT CONSTd2):round(wert(y0),d2)END PROCwert;TEXT PROCzahltext(REAL CONSTe2,INT +CONSTd2):REAL CONSTf2:=round(abs(e2),d2);INT VARg2:=h2+d2+2;IFe2<0.0THENa2:="-"ELSEa2:=g0END IF;IFf2<1.0ANDf2<>0.0THENa2CAT"0";g2DECR1ENDIF;a2CATtext(f2,g2,d2);IFd2>0THENchange(a2,".",dezimalkomma)ELSEchange(a2,".",g0)END IF;a2.h2:max(0,decimalexponent(f2)).END PROCzahltext;TEXT PROCzahltext(TEXT CONSTy0,INT CONSTd2):zahltext(wert(y0),d2)END PROCzahltext;TEXT PROCtextdarstellung(TEXT CONSTi2):z1:=i2;changeall(z1,b2,b2+b2);j2;insertchar(z1,b2,1);z1CATb2;z1.j2:INT VARk2:=1;WHILEl2REPchange(z1,k2,k2,m2)END REP.l2:k2:=pos(z1,""0"",""31"",k2);k2>0.m2:b2+text(code(z1SUBk2))+b2.END PROCtextdarstellung;PROCx1(TEXT CONSTy0):errorstop(n2+textdarstellung(y0)+o2)END PROCx1;SATZ VARp2;EUDAT VARq2;LETj1= +#501#"erzeugtes Programm",y1= +#502#"keine Datei geoeffnet",r2= +#503#"Kein Satz zum Tragen vorhanden",s2= +#504#"Zieldatei hat falsche Felderzahl",t2= +#505#" existiert nicht",u2= +#506#" verletzt die Pruefbedingung.",v2= +#507#" ist in der Zieldatei bereits vorhanden.",o2= +#508#" ist nicht definiert.",w2= +#509#" ist nicht in der Wertemenge.",x2= +#510#" stimmt nicht mit der Maske ueberein.",y2= +#511#"Satz ",n2= +#512#"Das Feld "; +INT VARz2;FILE VARa3;BOOL VARb3:=FALSE,c3,d3;TEXT VARe3;PROCtrage(TEXT CONSTl0,FILE VARf3,BOOL CONSTg3):disablestop;b3:=g3;IFb3THENa3:=f3;output(a3)END IF;h3(l0);b3:=FALSE END PROCtrage;PROCh3(TEXT CONSTl0):enablestop;INT VARn1;o1(n1);i3(l0);INT VARj3:=0;REP IF NOTk3THENweiter(n1)ELSEcout(satznummer+j3)END IF;IFdateiendeTHENaufsatz(1);LEAVEh3END IF;l3END REP.k3:IFn1=3THENsatzmarkiertELSEsatzausgewaehltEND IF.l3:c3:=TRUE;IFb3THENnotizenlesen(q2,1,e3);do(e3)END IF;IFc3THENm3;IFc3THENsatzloeschen;j3INCR1END IF END IF;IF NOTc3THENweiter(n1)END IF.END PROCh3;PROCi3(TEXT CONSTl0):IFdateiendeTHENerrorstop(r2)END IF;oeffne(q2,l0);z2:=0;IFfelderzahl(q2)=0THENp1ELIFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)END IF;aufsatz(q2,saetze(q2)+1).p1:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldnamenlesen(r0,z1);feldaendern(p2,r0,z1)END REP;feldnamenaendern(q2,p2);n3;o3.n3:FORr0FROM1UPTOanzahlfelderREPfeldinfo(q2,r0,feldinfo(r0))END REP.o3:INT VARi1;FORi1FROM1UPTO3REP +notizenlesen(i1,z1);notizenaendern(q2,i1,z1)END REP.END PROCi3;PROCm3:IFz2>0CANDp3THENq3("",v2)ELSEr3;satzeinfuegen(q2,p2);weiter(q2)END IF.r3:satzinitialisieren(p2,anzahlfelder);INT VARr0;FORr0FROM1UPTOanzahlfelderREPfeldlesen(r0,z1);feldaendern(p2,r0,z1)END REP.p3:TEXT VARc1;INT CONSTs3:=satznr(q2);feldlesen(1,c1);d3:=FALSE;aufsatz(q2,c1);WHILE NOTdateiende(q2)REPt3;weiter(q2,c1)UNTILd3END REP;aufsatz(q2,s3);d3.t3:INT VARi1;d3:=TRUE;FORi1FROM2UPTOz2REPfeldlesen(q2,i1,z1);feldbearbeiten(i1,PROC(TEXT CONST,INT CONST,INT CONST)u3);IF NOTd3THEN LEAVEt3END IF END REP.END PROCm3;PROCu3(TEXT CONSTv3,INT CONSTw3,x3):IFy3COR(length(z1)>0CANDz3)THENd3:=FALSE END IF.y3:(x3-w3+1)<>length(z1).z3:pos(v3,z1,w3,x3+1)<>w3.END PROCu3;PROCq3(TEXT CONSTa4,b4):IFb3THENc4ELSEerrorstop(b4)END IF.c4:put(a3,y2);put(a3,satznummer);IFa4<>""THENwrite(a3,n2);write(a3,textdarstellung(a4))END IF;putline(a3,b4);c3:=FALSE.END PROCq3;PROCeindeutigefelder(INT CONSTd4):z2:=d4END PROCeindeutigefelder;PROCpruefe(TEXT +CONSTa4,BOOL CONSTe4):IF NOTe4THENq3(a4,u2)END IF END PROCpruefe;PROCwertemenge(TEXT CONSTa4,f4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEg4END IF.g4:INT VARk2:=0;LETh4=",";feldlesen(w1,z1);IFi4THEN LEAVEg4END IF;z1CATh4;REPk2:=pos(f4,z1,k2+1);IFk2=1ORk2>1CAND(f4SUBk2-1)=h4THEN LEAVEg4END IF UNTILk2=0END REP;q3(a4,w2).i4:INT CONSTj4:=length(f4)-length(z1);(f4SUBj4)=h4ANDpos(f4,z1,j4+1)>0.END PROCwertemenge;PROCfeldmaske(TEXT CONSTa4,k4):INT CONSTw1:=feldnummer(a4);IFw1=0THENq3(a4,o2)ELSEfeldlesen(w1,z1);l4END IF.l4:INT VARk2;TEXT CONSTm4:=code(length(k4)+1);TEXT VARn4:=""1"";FORk2FROM1UPTOlength(z1)REP TEXT CONSTo4:=z1SUBk2;p4UNTILn4=""END REP;IFq4THENq3(a4,x2)END IF.p4:INT VARr4:=1;WHILEr4<=length(n4)REP INT CONSTs4:=code(n4SUBr4);IF(k4SUBs4)="*"THENt4ELIFu4THENreplace(n4,r4,code(s4+1));r4INCR1ELSEdeletechar(n4,r4)END IF END REP.t4:IFs4=length(k4)THEN LEAVEfeldmaskeEND IF;r4INCR1;IFpos(n4,code(s4+1))=0THENinsertchar(n4,code(s4+1),r4)END IF.u4:SELECTpos("9XAa",k4SUBs4)OF CASE +1:pos("0123456789",o4)>0CASE2:TRUE CASE3:pos("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ",o4)>0CASE4:pos("abcdefghijklmnopqrstuvwxyzäöüß",o4)>0OTHERWISE(k4SUBs4)=o4END SELECT.q4:(n4=""CORpos(n4,m4)=0)ANDv4.v4:(k4SUBlength(k4))<>"*"ORpos(n4,code(length(k4)))=0.END PROCfeldmaske;PROCtragesatz(TEXT CONSTl0):i3(l0);INT CONSTw4:=satznr(q2);m3;satzloeschen;aufsatz(q2,w4)END PROCtragesatz;PROCholesatz(TEXT CONSTl0):n0;IF NOTexists(l0)THENerrorstop(textdarstellung(l0)+t2)END IF;oeffne(q2,l0);IFfelderzahl(q2)<>anzahlfelderTHENerrorstop(s2)ELIFsaetze(q2)=0THENerrorstop(r2)END IF;aufsatz(q2,saetze(q2));satzlesen(q2,p2);x4;satzloeschen(q2).x4:satzeinfuegen;INT VARr0;FORr0FROM1UPTOfelderzahl(p2)REPfeldlesen(p2,r0,z1);feldaendern(r0,z1)END REP.END PROCholesatz;END PACKETverarbeitung; +PACKETeudasdruckenDEFINESdrucke,interpretiere,gruppentest,druckdatei,direktdrucken,druckrichtung,maxdruckzeilen,gruppenwechsel,lfdnr:LETb0=25,SPEICHER=STRUCT(INTc0,d0,e0,f0,TEXTg0);ROWb0SPEICHER VARh0;INT VARi0;LETj0="",k0=" ",l0="#",m0=" ";TEXT VARn0;PROCinterpretiere(INT CONSTo0,p0,PROC(INT CONST,TEXT VAR)q0):INT VARr0,s0:=0,t0:=0,u0:=p0;v0(o0);WHILE NOTw0REPx0;IFy0THENs0INCR1ELSEz0;a1END IF END REP.a1:IFb1(r0)THENc1ELSEd1;t0:=0END IF.c1:SELECTr0OF CASEe1:f1CASEg1:h1OTHERWISE LEAVEinterpretiereEND SELECT.z0:WHILEs0>0REPi1(k0);s0DECR1END REP.f1:j1(i0).h1:j1(t0).y0:k1=j0ORk1=k0.d1:INT VARl1:=0,m1:=0;BOOL VARn1:=FALSE;REPo1;l1INCR1;IFi0=3THENn1:=TRUE END IF UNTILp1END REP.p1:IFi0<=2THEN TRUE ELIFt0<>0THENl1=t0ELSEm1=0END IF.o1:INT VARq1:=1,r1:=0,s1:=0,t1:=1,u1:=1;n0:=j0;REP IFv1THENw1END IF;IFx1THENy1END IF;z1;t1INCR1END REP.v1:l1=0.w1:a2(b2.c0,b2.d0,b2.e0);IF NOTc2THENd2;e2END IF.c2:b2.c0>length(k1).d2:IFf2ANDg2THENh2END IF.g2:(b2.e0AND1)=0.h2:INT VARi2:=b2.c0+b2.d0;IF(k1SUBi2)=k0THEN + WHILE(k1SUBi2+1)=k0REPi2INCR1;b2.d0INCR1END REP END IF.e2:INT CONSTj2:=k2(u0);IFj2>0THENfeldlesen(j2,b2.g0)ELSEq0(-j2,b2.g0)END IF;u0INCR1;b2.f0:=0;IFb2.g0<>j0THENm1INCR1END IF.x1:b2.e0>=4.b2:h0(t1).z1:INT CONSTreserve:=l2(b2);IFreserve>0THENm2ELSEs1DECRreserveEND IF.m2:r1INCRreserve;IFf2ANDr1>s1THENr1:=s1END IF;IFn2ANDo2THENp2END IF.f2:i0=2ORi0=4.n2:reserve=b2.d0.o2:(b2.e0AND1)=0.p2:IFb2.c0=1COR(k1SUB(b2.c0-1))=k0THEN INT VARq2:=r2(t1);WHILE(k1SUBq2)=k0REPq2INCR1;b2.d0INCR1;r1INCR1END REP END IF.y1:IFt1=1THEN IFc2THENs2END IF ELSEt2END IF.s2:IFn1THENi1(k0)ELSEi1(k1)END IF;LEAVEo1.t2:INT VARu2:=0,v2:=b2.c0;INT CONSTw2:=v2-length(k1);x2;y2;z2;a3.x2:IFw2>0THENr1INCRw2;v2DECR(w2-1)END IF;b3.b3:INT CONSTc3:=r2(t1-1),d3:=pos(k1,m0,c3,v2);IFd3>0THENv2:=d3;e3ELIFw2<0AND(k1SUB(v2-1))<>k0THENv2:=c3END IF.e3:INT VARf3:=v2+1;REPu2INCR1;f3INCR1UNTIL(k1SUBf3)<>k0END REP;r1INCRu2.y2:INT VARg3:=0;WHILEu1<t1REPh3;i3;j3;u1INCR1END REP.h3:INT CONSTc0:=k3.c0,d0:=k3.d0,e0:=k3.e0.i3:l3(q1,c0,n1);q1:=c0+d0 +.k3:h0(u1).j3:INT CONSTm3:=-l2(k3);IFm3=-d0THENn3ELIFm3<=0THENo3ELIFp3ANDq3THENr3ELSEs3END IF.n3:IFp3THENg3INCRm3;IFf2THENt3END IF ELSEu3(-m3)END IF.t3:IFg3<0THENu3(-g3);g3:=0END IF.o3:IFv3THENu3(-m3)END IF;w3(k3);m1DECR1;IFx3THENy3ELSEg3INCRm3;z3END IF.v3:(e0AND2)=2.x3:(e0AND1)=1.y3:IF NOTv3THENu3(-m3)END IF.z3:IFf2ANDg3<0THENu3(-g3);g3:=0END IF.p3:NOTx3.q3:m3<=r1.r3:w3(k3);m1DECR1;g3INCRm3;r1DECRm3.s3:INT VARa4:=0,b4:=k3.f0+1,c4:=b4+d0-1,d4:=d0;IFp3THENc4INCRr1;d4INCRr1END IF;IFv3ANDe4THENf4END IF;g4;IFh4THENi4END IF;j4;IFp3THENg3INCRr1;r1:=0END IF.f4:INT CONSTk4:=length(k3.g0)-c4;b4INCRk4;c4INCRk4.g4:INT VARl4;REPl4:=d4-c4+b4-1+m4(k3.g0,b4,c4);IFl4=0THEN LEAVEg4ELIFv3THENb4DECRl4ELSEc4INCRl4END IF END REP.h4:i0>=3.e4:NOTh4.j4:IFv3THENu3(a4)END IF;n4(k3.g0,b4,c4);IFo4THENu3(a4)END IF.o4:NOTv3.i4:IFpos(k3.g0,k0,b4,c4)>0THENp4END IF;INT CONSTq4:=pos(k3.g0,"!","�",c4+1);IFq4=0THENk3.f0:=length(k3.g0);m1DECR1ELSEk3.f0:=q4-1END IF.p4:c4INCR1;a4DECR1;WHILE(k3.g0SUBc4)<>k0REPc4DECR1;a4INCR1 +END REP;WHILE(k3.g0SUBc4)=k0REPc4DECR1;a4INCR1UNTILq2<b4END REP.z2:l3(q1,v2,n1);IFg3<0THEN IFv2<=length(k1)THENu3(-g3)END IF;q1:=v2ELSEq1:=v2+min(g3,u2)END IF.a3:IFw2>0THENr4;s4;LEAVEo1ELSEt4END IF.r4:IF NOTn1THENn4(k1,q1,length(k1))END IF.s4:INT VARu4:=length(n0);IF(n0SUBu4)=k0THEN REPu4DECR1UNTIL(n0SUBu4)<>k0END REP;n0:=subtext(n0,1,u4)END IF;IFv4THENn0CATk0END IF;i1(n0).v4:(k1SUB LENGTHk1)=k0AND(i0<>3ORm1=0).t4:r1:=0;s1:=0.END PROCinterpretiere;INT PROCr2(INT CONSTw4):h0(w4).c0+h0(w4).d0END PROCr2;INT PROCl2(SPEICHER CONSTx4):x4.d0-length(x4.g0)+m4(x4.g0)+x4.f0END PROCl2;INT PROCm4(TEXT CONSTy4):m4(y4,1,length(y4))END PROCm4;INT PROCm4(TEXT CONSTy4,INT CONSTz4,a5):INT CONSTb5:=pos(y4,l0,z4,a5);INT VARc5:=b5,d5,e5:=0;WHILEc5>0REPf5;IFg5THENh5ELSEi5END IF;j5END REP;e5.f5:d5:=pos(y4,l0,c5+1,a5).g5:d5=0.h5:IFa5=length(y4)THENe5INCRb5ELSEe5INCR(a5-c5+1)END IF.i5:e5INCR(d5-c5+1).j5:IFd5>0THENc5:=pos(y4,l0,d5+1,a5)ELSEc5:=0END IF.END PROCm4;LETk5=" ";PROCu3(INT CONSTl5):INT VARm5 +:=l5;WHILEm5>=10REPn0CATk5;m5DECR10END REP;WHILEm5>0REPn0CATk0;m5DECR1END REP END PROCu3;PROCw3(SPEICHER VARx4):IFx4.f0=0THENn0CATx4.g0ELSEn4(x4.g0,x4.f0+1,length(x4.g0))END IF;x4.f0:=length(x4.g0)END PROCw3;PROCl3(INT CONSTz4,a5,BOOL CONSTn1):IFn1THENu3(a5-z4)ELSEn4(k1,z4,a5-1)END IF END PROCl3;TEXT VARn5;PROCn4(TEXT CONSTo5,INT CONSTz4,a5):n5:=subtext(o5,z4,a5);n0CATn5END PROCn4;FILE VARp5;TEXT VARk1;INT VARq5;LETr5= +#401#"keine schliessende Klammer in Feldmuster",s5= +#402#"kein Kommando in Kommandozeile",t5= +#403#"unbekanntes Kommando"; +LETu5="&",v5="%",w5="%",x5="<",y5=">";LETz5= +#404#" "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR "LETa6=1,b6=2,c6=3,d6=4,e6=5,e1=6,g1=7,f6=100;INT VARg6,h6,i6;BOOL VARw0,j6;.k6:lineno(p5).l6:g6:=maxlinelength(p5).PROCm6(TEXT CONSTn6):REPq5INCR1UNTIL(k1SUBq5)<>n6END REP END PROCm6;PROCa2(INT VARb4,e5,e0):o6;IFc2THENb4:=max(g6,length(k1))+1;e5:=0;e0:=5ELSEb4:=q5;p6END IF.o6:q6(u5,v5).c2:q5>length(k1).p6:TEXT CONSTr6:=k1SUBq5;IFr6=v5THENe0:=0ELSEe0:=4END IF;s6;feldnamenlesen;t6.s6:m6(r6);IFq5-1>b4THENu6END IF.u6:e0INCR3.feldnamenlesen:IF(k1SUBq5)=x5THENv6ELSEw6END IF;IFx6THENa2(b4,e5,e0);LEAVEa2END IF.x6:h6>i6.v6:h6:=q5+1;i6:=pos(k1,y5,h6);IFi6=0THENy6(r5,subtext(k1,q5));i6:=length(k1)ELSEi6DECR1END IF;q5:=i6+2.w6:h6:=q5;q6(k0,v5);INT CONSTz6:=pos(k1,u5,h6,q5);IFz6>0THENq5:=z6END IF;i6:=q5-1.t6:IFa7THENb7;m6(r6)END IF;e5:=q5-b4.a7:(k1SUBq5)=r6.b7:e0:=e0OR1.END PROCa2;PROCa2(TEXT VARname):INT VARc7,e5,d7;a2(c7,e5,d7);IFe5>0THENname:=subtext(k1,h6,i6)ELSEname:=j0END +IF END PROCa2;PROCq6(TEXT CONSTe7,f7):INT CONSTg7:=pos(k1,e7,q5),h7:=pos(k1,f7,q5);q5:=length(k1)+1;IFg7>0THENq5:=g7END IF;IFh7>0ANDh7<q5THENq5:=h7END IF END PROCq6;PROCv0(INT CONSTi7):toline(p5,i7);j6:=FALSE;w0:=eof(p5)END PROCv0;PROCx0:IFj6THENdown(p5)ELSEj6:=TRUE END IF;readrecord(p5,k1);q5:=1;w0:=lineno(p5)>=lines(p5)END PROCx0;BOOL PROCb1(INT VARr0):q5:=1;IF(k1SUB1)<>w5THEN FALSE ELIF(k1SUB2)<>w5THENj7;k7;TRUE ELSEr0:=f6;TRUE END IF.j7:TEXT VARl7;m6(k0);IFq5>length(k1)THENy6(s5,k1);r0:=0;LEAVEb1WITH TRUE END IF;INT CONSTm7:=pos(k1,k0,q5);IFm7=0THENl7:=subtext(k1,q5);l7CATk0;q5:=length(k1)+1ELSEl7:=subtext(k1,q5,m7);q5:=m7END IF.k7:INT CONSTn7:=pos(z5,l7);IFn7>0CAND(z5SUB(n7-2))=k0THENr0:=code(z5SUB(n7-1))ELSEr0:=0;y6(t5,l7);END IF.END PROCb1;PROCj1(INT VARo7):m6(k0);INT CONSTp7:=q5;WHILEq7REPq5INCR1END REP;IFq5>p7THENo7:=int(subtext(k1,p7,q5-1))ELSEo7:=-1END IF.q7:pos("0123456789",k1SUBq5)>0.END PROCj1;FILE VARr7;TEXT VARs7;BOOL VARt7;PROCu7(TEXT CONSTname):s7:=name;v7("PROC ", +name," :")END PROCu7;PROCw7:v7("END PROC ",s7,";")END PROCw7;PROCx7(TEXT CONSTy7):t7:=TRUE;putline(r7,y7)END PROCx7;PROCx7(TEXT CONSTz7,a8,b8):t7:=TRUE;v7(z7,a8,b8)END PROCx7;PROCv7(TEXT CONSTz7,a8,b8):write(r7,z7);write(r7,a8);write(r7,b8);line(r7)END PROCv7;TEXT VARc8;PROCx7(TEXT CONSTz7,INT CONSTd8,TEXT CONSTb8):c8:=subtext(k1,d8);x7(z7,c8,b8)END PROCx7;PROCe8(INT CONSTi7,f8):v7("; interpretiere (",text(i7)+", "+text(f8),", PROC (INT CONST, TEXT VAR) abk);")END PROCe8;LETg8= +#405#"kein % WIEDERHOLUNG gefunden",h8= +#406#"Nur GRUPPE-Anweisung erlaubt",i8= +#407#"keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition",j8= +#408#"illegale Gruppennummer",k8= +#409#"diese Gruppe wurde schon definiert",l8= +#410#"diese Abkuerzung ist nicht definiert",m8= +#411#"dieser Abschnitt wurde schon einmal definiert",n8= +#412#"falscher Modus",o8= +#413#"diese Anweisung darf im Musterteil nicht vorkommen",p8= +#414#"im Abkuerzungsteil darf keine Anweisung auftreten",q8= +#415#"in dieser Zeile stehen zu viele Feldmuster",r8= +#416#"das Druckmuster enthaelt zu viele Feldmuster",s8= +#417#"nach dem ""&"" soll direkt der Name einer Abkuerzung folgen",t8= +#418#"kein Doppelpunkt nach Abkuerzung",u8= +#419#"Abkuerzung mehrfach definiert",v8= +#420#"das Druckmuster enthaelt zu viele Abkuerzungen"; +LETw8=200,x8=4,y8=250,GRUPPE=STRUCT(BOOLz8,a9,TEXTg0),ABSCHNITT=STRUCT(INTp0,o0,TEXTu7);ROWw8INT VARk2;INT VARb9;ROWx8GRUPPE VARc9;ROW3ABSCHNITT VARd9;SATZ VARq0;TEXT VARe9;INT VARf9;OP CAT(TEXT VARg9,INT CONSTwert):TEXT VARh9:=" ";replace(h9,1,wert);g9CATh9END OP CAT;PROCi9:enablestop;v0(1);j9;k9;WHILE NOTw0REPl9END REP;m9.j9:INT VARr0;INT VARn9;f9:=0;satzinitialisieren(q0);e9:=j0;b9:=0;t7:=FALSE;d9(1):=ABSCHNITT:(0,0,"vorspann");d9(2):=ABSCHNITT:(0,0,"wdh");d9(3):=ABSCHNITT:(0,0,"nachspann");FORn9FROM1UPTOx8REPc9(n9).a9:=FALSE END REP.k9:BOOL VARo9:=FALSE;REP IFw0THENy6(g8);LEAVEi9END IF;x0;IFb1(r0)THENp9END IF END REP.p9:SELECTr0OF CASEf6:q9CASEe6:r9CASEa6,b6,c6:IF NOTo9THENu7("gruppen")END IF;w7;LEAVEk9OTHERWISE IFr0>0THENy6(h8)END IF END SELECT.q9:IFo9THENy6(i8,k1)ELSEreplace(k1,1," ");x7(k1)END IF.r9:IF NOTo9THENu7("gruppen");o9:=TRUE END IF;INT VARs9;j1(s9);IFs9<1ORs9>x8THENy6(j8,k1)ELIFc9(s9).a9THENy6(k8,k1)ELSEc9(s9).a9:=TRUE;t9END IF.t9:x7("gruppentest (",text(s9),", ");x7( +" ",q5,");").l9:SELECTr0OF CASEa6:u9CASEb6:v9CASEc6:w9END SELECT.u9:x9(d9(1),r0).v9:j1(y9);j1(z9);x9(d9(2),r0).w9:x9(d9(3),r0).m9:IFt7THENa10;b10END IF;c10;IFt7THENd10;e10END IF.c10:FORn9FROM1UPTOf9REP IF(e9ISUBn9)>0THENy6(l8,f10,e9ISUBn9)ELSEg10END IF END REP.f10:TEXT VARh10;feldlesen(q0,n9,h10);h10.a10:FORn9FROM1UPTO3REP IFd9(n9).o0=0THENi10END IF END REP.i10:u7(d9(n9).u7);w7.b10:x7("PROC abk (INT CONST nr, TEXT VAR inhalt) :");IFf9>0THENx7("SELECT nr OF")ELSEx7("inhalt := text (nr)")END IF.g10:TEXT CONSTj10:=text(n9);x7("CASE "+j10," : inhalt := abk",j10).d10:IFf9>0THENx7("END SELECT")END IF;x7("END PROC abk;").e10:x7("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)").END PROCi9;PROCx9(ABSCHNITT VARk10,INT VARr0):BOOL VARl10:=TRUE;u7(k10.u7);m10;n10;o10.m10:IFk10.o0<>0THENy6(m8,k1)END IF;k10.o0:=k6+1;k10.p0:=b9+1.n10:WHILE NOTw0REPx0;IFb1(r0)THENp10ELSEq10;r10END IF END REP;s10;LEAVEx9.p10:SELECTr0OF CASEf6:replace(k1,1," ");x7(k1);l10:=TRUE CASEa6,b6,c6: +s10;LEAVEx9CASEd6:s10;LEAVEn10CASEe1:q10;INT VARt10;j1(t10);IFt10<1ORt10>4THENy6(n8,k1)END IF CASEg1:q10OTHERWISE IFr0>0THENy6(o8)END IF END SELECT.q10:IFl10THENe8(k6,b9+1);l10:=FALSE END IF.s10:w7.r10:TEXT VARname;INT VARu10:=0;REPa2(name);IFname=j0THEN LEAVEr10END IF;u10INCR1;v10END REP.v10:IFu10>=b0THENy6(q8)END IF;IFb9=w8THENy6(r8)ELSEb9INCR1END IF;w10.w10:INT VARx10:=feldnummer(name);IFx10=0THENx10:=feldindex(q0,name);IFx10=0THENy10(name,k6);k2(b9):=-f9ELSEk2(b9):=-x10END IF ELSEk2(b9):=x10END IF.o10:BOOL VARz10:=TRUE;WHILE NOTw0REPx0;IFb1(r0)THENa11ELIFb11THENc11END IF END REP.a11:SELECTr0OF CASEa6,b6,c6:LEAVEo10OTHERWISE IFr0>0THENy6(p8)END IF END SELECT.c11:IFz10THENx7(".");z10:=FALSE END IF;IFd11THENe11ELSEx7(k1)END IF.d11:(k1SUB1)=u5.e11:TEXT VARf11;a2(f11);IFf11=j0THENy6(s8,k1);LEAVEe11END IF;g11;h11.g11:LETi11=":";q5DECR1;m6(k0);IF(k1SUBq5)=i11THENq5INCR1ELSEy6(t8,k1)END IF.h11:y10(f11,0);x7(j11,q5-1,"").j11:"abk"+text(feldindex(q0,f11)).b11:k1<>j0ANDk1<>k0.END PROCx9;PROC +y10(TEXT CONSTname,INT CONSTi7):INT CONSTk11:=feldindex(q0,name);IFk11>0THENl11ELSEm11END IF.l11:IF(e9ISUBk11)>0THENreplace(e9,k11,i7)ELIFi7=0THENy6(u8,name)END IF.m11:IFf9=y8THENy6(v8)ELSEf9INCR1END IF;e9CATi7;feldaendern(q0,f9,name).END PROCy10;LETn11= +#421#"FEHLER in Zeile ",o11= +#422#" bei >>",p11= +#423#"<<"; +PROCy6(TEXT CONSTq11,r11,INT CONSTi7):LETs11=" ";TEXT VARt11:=n11;t11CATtext(i7);IFr11<>j0THENt11CATo11;t11CATr11;t11CATp11END IF;note(t11);noteline;note(s11);note(q11);noteline;IFonlineANDcommanddialogueTHENline;putline(t11);put(s11);putline(q11)END IF END PROCy6;PROCy6(TEXT CONSTq11):y6(q11,j0,k6)END PROCy6;PROCy6(TEXT CONSTq11,r11):y6(q11,r11,k6)END PROCy6;LETu11= +#424#"erzeugtes Programm",v11= +#425#"keine Datei geoeffnet",w11= +#426#"interner Fehler",x11= +#427#"Druckausgabe steht in",y11= +#428#"zum Drucker geschickt.",z11= +#429#"direkt Drucken nicht moeglich",a12= +#430#".a$"; +TEXT VARb12,c12:="";BOOL VARd12,e12,f12,g12:=FALSE;FILE VARh12;INT VARy9,z9,i12,j12,k12,l12:=1,m12:=4000,n12;PROCdrucke:drucke(lastparam)END PROCdrucke;PROCdrucke(TEXT CONSTo12):enablestop;lastparam(o12);p5:=sequentialfile(input,o12);modify(p5);IFanzahldateien=0THENerrorstop(v11)END IF;disablestop;p12;i9;IFanythingnotedTHENnoteedit(p5)ELIFt7THENq12ELSEdrucke(PROCr12,PROCs12,PROCt12,PROCu12)END IF;forget(v12,quiet).p12:TEXT VARv12;INT VARn9:=0;REPn9INCR1;v12:=text(n9)UNTIL NOTexists(v12)END REP;r7:=sequentialfile(output,v12);headline(r7,u11).q12:run(v12);lastparam(o12).END PROCdrucke;PROCr12:END PROCr12;PROCs12:w12(1)END PROCs12;PROCt12:w12(2)END PROCt12;PROCu12:w12(3)END PROCu12;PROCw12(INT CONSTx12):IFd9(x12).o0>0THENinterpretiere(d9(x12).o0,d9(x12).p0,PROC(INT CONST,TEXT VAR)y12)END IF END PROCw12;PROCy12(INT CONSTx12,TEXT VARg0):errorstop(w11);g0:=code(x12)END PROCy12;PROCdrucke(PROCz12,PROCa13,PROCb13,PROCc13):INT VARd13,e13,f13;enablestop;g13;h13;i13;n12:=1;WHILE NOTdateiendeREP +j13;cout(satznummer);k13;weiter(d13);l13END REP;m13;n13;aufsatz(1).h13:e13:=0;aufsatz(1);IFmarkiertesaetze>0THENd13:=3;IF NOTsatzmarkiertTHENweiter(d13)END IF ELSEd13:=2;IF NOTsatzausgewaehltTHENweiter(d13)END IF END IF.i13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).g0:=j0END REP.j13:IFe13=0THENz12;o13;p13(PROCa13)ELSEe12:=FALSE;q13;r13END IF;e13:=satznummer;f13:=satzkombination.q13:d12:=FALSE;z12.r13:IFd12THENs13(e13,f13,PROCc13)END IF;n12INCR1;IFd12THENp13(PROCa13)END IF.k13:IFz9<1THENl6ELSEg6:=z9END IF;IFi12<y9THENtoline(h12,j12)ELSEtoline(h12,k12+1);j12:=k12+1;i12:=0END IF;i0:=1;b13;i12INCR1.l13:IFk12>m12THENn13;g13END IF.m13:o13;IFe13=0THENp13(PROCc13)ELSEs13(e13,f13,PROCc13)END IF;v0(1).END PROCdrucke;PROCo13:INT VARn9;FORn9FROM1UPTOx8REPc9(n9).z8:=TRUE END REP;e12:=TRUE;d12:=TRUE END PROCo13;PROCp13(PROCk10):i12:=y9;toline(h12,k12+1);l6;i0:=1;k10END PROCp13;PROCs13(INT CONSTe13,f13,PROCc13):INT CONSTt13:=satznummer,u13:=satzkombination;aufsatz(e13);WHILEsatzkombination<>f13REPweiter(1) +END REP;p13(PROCc13);aufsatz(t13);WHILEsatzkombination<>u13REPweiter(1)END REP END PROCs13;PROCg13:IFaktuellereditor>0THENv13ELSEw13END IF;x13.v13:h12:=editfile;IFcol>1THENsplitline(h12,col,FALSE);down(h12);col(h12,1)END IF;k12:=lineno(h12)-1.w13:IF NOTf12THENy13END IF;h12:=sequentialfile(modify,c12);maxlinelength(h12,maxlinelength(p5));k12:=lines(h12).y13:INT VARm5:=0;REPm5INCR1;c12:=headline(p5)+a12+text(m5);UNTIL NOTexists(c12)END REP.x13:v0(1);WHILE NOTw0REPz13END REP.z13:x0;INT VARr0;IFb1(r0)THENa14ELSEi1(k1)END IF.a14:IFr0<>f6ANDr0<>e6THEN LEAVEx13END IF.END PROCg13;PROCn13:IFaktuellereditor>0THEN LEAVEn13ELIFf12THENf12:=FALSE;ELIFg12THENdisablestop;b14ELIFonlineANDl12>1THENline;put(x11);putline(textdarstellung(c12));pause(40)END IF;toline(h12,1).b14:TEXT CONSTo7:=std;lastparam(c12);do("print (std)");IFiserrorTHENclearerror;errorstop(z11)ELIFonlineTHENline;put(textdarstellung(c12));putline(y11);forget(c12,quiet);pause(40)END IF;lastparam(o7).END PROCn13;PROCi1(TEXT CONSTi7):IFi12 +>=y9ORi12=0THENinsertrecord(h12);writerecord(h12,i7);k12INCR1ELSEc14END IF;down(h12).c14:IFeof(h12)THENb12:=j0;insertrecord(h12);k12INCR1ELSEreadrecord(h12,b12)END IF;d14;writerecord(h12,b12).d14:INT CONSTe14:=g6*i12;WHILElength(b12)<e14REPb12CATk0END REP;b12CATi7.END PROCi1;PROCdruckrichtung(INT CONSTf14):l12:=f14;g12:=(f14=0)END PROCdruckrichtung;INT PROCdruckrichtung:l12END PROCdruckrichtung;PROCdirektdrucken(BOOL CONSTd13):g12:=d13;IFd13THENl12:=0ELIFl12=0THENl12:=1END IF END PROCdirektdrucken;BOOL PROCdirektdrucken:g12END PROCdirektdrucken;PROCdruckdatei(TEXT CONSTo12):c12:=o12;f12:=TRUE END PROCdruckdatei;TEXT PROCdruckdatei:c12END PROCdruckdatei;PROCmaxdruckzeilen(INT CONSTg14):m12:=g14END PROCmaxdruckzeilen;PROCgruppentest(INT CONSTs9,TEXT CONSTh14):IFh14<>c9(s9).g0THENc9(s9).g0:=h14;c9(s9).z8:=TRUE;d12:=TRUE ELSEc9(s9).z8:=FALSE END IF END PROCgruppentest;BOOL PROCgruppenwechsel(INT CONSTs9):IFs9>0THENc9(s9).z8ELSEe12END IF END PROCgruppenwechsel;TEXT PROClfdnr:text(n12)END +PROClfdnr;END PACKETeudasdrucken; +PACKETeudasstdlistenDEFINESdruckestandardlisten,stdlistenbreite,stdlistenlaenge,stdlistenfont:LETb0="******* Listendruckmuster *******";FILE VARf;TEXT VARc0,d0;TEXT VARe0:="";INT VARf0:=70,g0:=60;PROCstdlistenbreite(INT CONSTh0):f0:=h0END PROCstdlistenbreite;INT PROCstdlistenbreite:f0END PROCstdlistenbreite;PROCstdlistenlaenge(INT CONSTi0):g0:=i0END PROCstdlistenlaenge;INT PROCstdlistenlaenge:g0END PROCstdlistenlaenge;PROCstdlistenfont(TEXT CONSTfont):e0:=fontEND PROCstdlistenfont;TEXT PROCstdlistenfont:e0END PROCstdlistenfont;PROCdruckestandardlisten(INT CONSTj0,TEXT CONSTk0):forget(b0,quiet);f:=sequentialfile(output,b0);maxlinelength(f,f0);IFl0THENm0(k0)ELSEn0(k0)END IF;TEXT CONSTo0:=std;drucke(b0);forget(b0,quiet);lastparam(o0).l0:j0=2.END PROCdruckestandardlisten;ROW100INT VARp0;INT VARq0,r0,s0,t0,u0;PROCv0:IFe0<>""THENputline(f,"#type("+textdarstellung(e0)+")#")END IF;putline(f,"% GRUPPE 1 seitennummer");putline(f,"% VOR");put(f,date);put(f,timeofday);put(f,"Uhr:");put(f, +eudasdateiname(1));write(f,(f0-length(eudasdateiname(1))-25)*" ");putline(f,"&&-S");line(f)END PROCv0;PROCw0:putline(f,"% NACH");putline(f,"#page#");putline(f,"% ABK");putline(f,"&? : lfd nr .");putline(f,"&-S : seitennummer .");putline(f,"seitennummer :");putline(f," text (int (lfd nr) DIV saetze pro seite + 1) .");write(f,"saetze pro seite : ");put(f,(g0-2)DIVq0-1);putline(f,".")END PROCw0;PROCm0(TEXT CONSTk0):v0;x0;y0;w0.x0:write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFz0<length(k0)THENwrite(f,d0+", ")ELSEwrite(f,d0)END IF END REP;line(f);putline(f,maxlinelength(f)*"-");q0:=1.y0:putline(f,"% WDH");INT CONSTa1:=maxlinelength(f);INT VARz0;maxlinelength(f,10000);write(f,"&&? ");FORz0FROM1UPTOlength(k0)REPb1END REP;line(f);maxlinelength(f,a1).b1:write(f,"%<");feldnamenlesen(code(k0SUBz0),d0);write(f,d0);write(f,">");IFz0<length(k0)THENwrite(f,", ")END IF.END PROCm0;PROCc1(TEXT CONSTk0):INT VARz0;d1;aufsatz(1);INT VARe1;IFmarkiertesaetze>0THENe1:=3;IF NOT +satzmarkiertTHENweiter(3)END IF ELSEe1:=2;IF NOTsatzausgewaehltTHENweiter(2)END IF END IF;WHILE NOTdateiendeREPf1;weiter(e1)END REP.d1:t0:=length(k0);FORz0FROM1UPTOt0REPp0(z0):=2END REP;u0:=0.f1:INT VARg1:=0;FORz0FROM1UPTOt0REPfeldbearbeiten(code(k0SUBz0),PROC(TEXT CONST,INT CONST,INT CONST)h1);IFs0>p0(z0)THENp0(z0):=s0END IF;g1INCRs0END REP;IFg1>u0THENu0:=g1END IF.END PROCc1;PROCh1(TEXT CONSTi1,INT CONSTj1,k1):s0:=k1-j1+1END PROCh1;PROCn0(TEXT CONSTk0):c1(k0);v0;x0;y0;l1;w0.x0:TEXT VARm1:="";INT VARz0;r0:=4;q0:=1;write(f,"Nr. ");FORz0FROM1UPTOlength(k0)REPfeldnamenlesen(code(k0SUBz0),d0);IFlength(d0)+2>=p0(z0)THENn1END IF;r0INCRp0(z0)+1;IFr0>f0THENline(f);r0:=p0(z0)+1;q0INCR1END IF;write(f,text(d0,p0(z0)+1))END REP;line(f);putline(f,maxlinelength(f)*"-").n1:m1CAT(k0SUBz0).y0:putline(f,"% WDH");write(f,"&&? ");FORz0FROM1UPTOlength(k0)REPo1END REP;line(f).o1:INT CONSTp1:=pos(m1,k0SUBz0);c0:="&";IFp1>0THENc0CATtext(code(p1+64),p0(z0))ELSEfeldnamenlesen(code(k0SUBz0),d0);c0CATtext("<"+d0+ +">",p0(z0))END IF;write(f,c0).l1:IFm1<>""THENputline(f,"% ABK");FORz0FROM1UPTOlength(m1)REPq1END REP END IF.q1:write(f,"&");write(f,code(z0+64));write(f," : ");write(f,"f (");feldnamenlesen(code(m1SUBz0),d0);write(f,textdarstellung(d0));putline(f,") .").END PROCn0;END PACKETeudasstdlisten; + diff --git a/app/eudas/5.3/src/eudas.3 b/app/eudas/5.3/src/eudas.3 new file mode 100644 index 0000000..92b783f --- /dev/null +++ b/app/eudas/5.3/src/eudas.3 @@ -0,0 +1,43 @@ +PACKETsatzanzeigeDEFINESanzeigefenster,bildausgeben,aendern,einfuegen,suchen,feldauswahl,rollen,exitdurch,exitzeichen:LETb0=256;LETc0=" ",d0="",e0=""5"",f0=""15"",g0=" "14"",h0=" "14" ";ROWb0STRUCT(INTi0,j0)VARk0;INT VARl0,m0,n0:=24,o0:=79,p0:=1,q0:=1,r0,s0,t0:=0,u0:=0,v0:=dateiversion-1,w0:=0;BOOL VARx0:=TRUE,y0:=TRUE,z0:=FALSE,a1;FENSTER VARfenster;fensterinitialisieren(fenster);DATASPACE VARb1,c1;FILE VAReditfile;TEXT VARd1,e1;LETf1= +#801#"Anzeigefenster zu klein"; +PROCanzeigefenster(FENSTER CONSTg1):INT VARh1,i1,j1,k1;fenstergroesse(g1,h1,i1,j1,k1);IFj1>=39THENfenstergroessesetzen(fenster,g1);y0:=h1+j1>=xsize;o0:=j1;n0:=k1;q0:=h1;p0:=i1;x0:=TRUE ELSEerrorstop(f1)END IF END PROCanzeigefenster;FENSTER PROCanzeigefenster:fensterEND PROCanzeigefenster;PROCl1:BOOL VARfensterveraendert;fensterzugriff(fenster,fensterveraendert);IFfensterveraendertTHENa1:=TRUE END IF END PROCl1;PROCm1:IFn1ORx0THENo1;p1;q1;r1;s1;t1END IF.n1:v0<>dateiversion.o1:l0:=0;WHILEl0<anzahlfelderREPl0INCR1;k0(l0).i0:=l0END REP;m0:=1.p1:INT VARi0;r0:=11;FORi0FROM1UPTOanzahlfelderREPfeldnamenbearbeiten(i0,PROC(TEXT CONST,INT CONST,INT CONST)u1)END REP;r0:=min(r0,o0DIV3);s0:=o0-r0-3.r1:a1:=TRUE.s1:forget(c1);c1:=nilspace;IFn1ANDz0THENforget(b1);z0:=FALSE END IF.t1:v0:=dateiversion;w0:=anzahldateien;x0:=FALSE.END PROCm1;PROCu1(TEXT CONSTv1,INT CONSTw1,x1):r0INCRlength(v1)-length(v1);r0:=max(r0,x1-w1+1)END PROCu1;PROCrollen(INT CONSTy1):m0:=m0+y1;IFm0<1THENm0:=1ELIFm0>z1THENm0:=max(z1, +1)END IF;a1:=TRUE.z1:l0-n0+3.END PROCrollen;PROCfeldauswahl(TEXT CONSTa2):m1;b2;a1:=TRUE.b2:l0:=length(a2);INT VARc2;FORc2FROM1UPTOl0REPk0(c2).i0:=code(a2SUBc2)END REP;m0:=1.END PROCfeldauswahl;INT VARd2;PROCe2:type(c1,-1);editfile:=sequentialfile(modify,c1);editinfo(editfile,-1);toline(editfile,1);col(editfile,1);maxlinelength(editfile,10000);d2:=1END PROCe2;.f2:d2<=l0.PROCg2(PROC(TEXT CONST,INT CONST)h2):i2;IFeof(editfile)THENh2("",i0)ELIFj2THENk2;l2;h2(e1,i0)ELIFm2THENreadrecord(editfile,e1);l2;h2(e1,i0);down(editfile)ELSEexec(PROC(TEXT CONST,INT CONST)h2,editfile,i0);down(editfile)END IF.i2:INT CONSTw1:=d2,i0:=k0(w1).i0;REPd2INCR1UNTILd2>l0CORn2END REP.n2:k0(d2).i0<>i0.j2:d2-w1>1.k2:e1:="";REPexec(PROC(TEXT CONST,INT CONST)o2,editfile,length(e1));down(editfile)UNTILeof(editfile)ORlineno(editfile)=d2END REP.m2:INT CONSTp2:=len(editfile);subtext(editfile,p2,p2)=c0.END PROCg2;PROCo2(TEXT CONSTq2,INT CONSTr2):IFr2>0CAND(e1SUBr2)<>c0CAND(q2SUB1)<>c0THENe1CATc0END IF;e1CATq2END PROCo2; +PROCl2:INT VARp2:=length(e1);WHILE(e1SUBp2)=c0REPp2DECR1END REP;e1:=subtext(e1,1,p2)END PROCl2;BOOL VARs2;PROCeinfuegen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;u2(PROCt2);satzeinfuegen;s2:=TRUE;v2END IF END PROCeinfuegen;PROCv2:WHILEf2REPg2(PROC(TEXT CONST,INT CONST)w2)END REP;aenderungeneintragenEND PROCv2;PROCw2(TEXT CONSTx2,INT CONSTi0):IF NOTs2CORx2<>d0THENfeldaendern(i0,x2)END IF END PROCw2;PROCaendern(PROCt2):enablestop;IFdateiendeTHENeinfuegen(PROCt2)ELSEy2END IF.y2:m1;IFl0>0THENe2;l1;z2(a1);a3;u2(PROCt2);s2:=FALSE;v2END IF.a3:b3:=1;WHILEb3<=l0REPfeldbearbeiten(k0(b3).i0,PROC(TEXT CONST,INT CONST,INT CONST)c3);insertrecord(editfile);writerecord(editfile,e1);down(editfile);b3INCR1END REP;toline(editfile,1).END PROCaendern;INT VARb3;PROCc3(TEXT CONSTv1,INT CONSTw1,x1):e1:=subtext(v1,d3,e3).d3:w1+k0(b3).j0.e3:IFf3THENx1ELSEw1+k0(b3+1).j0-1END IF.f3:b3=l0CORk0(b3+1).i0<>k0(b3).i0.END PROCc3;PROCsuchen(PROCt2):enablestop;m1;IFl0>0THENe2;l1;IFsuchversion<>0THENg3END IF;u2(PROCt2);h3END +IF.g3:b3:=1;WHILEb3<=l0REPinsertrecord(editfile);i3;down(editfile);b3INCR1END REP;toline(editfile,1).i3:IFk0(b3).j0=0THENsuchbedingunglesen(k0(b3).i0,e1);writerecord(editfile,e1)END IF.h3:suchbedingungloeschen;WHILEf2REPg2(PROC(TEXT CONST,INT CONST)j3)END REP.END PROCsuchen;PROCj3(TEXT CONSTk3,INT CONSTi0):suchbedingung(i0,k3)END PROCj3;PROCbildausgeben(BOOL CONSTl3):enablestop;m1;l1;IFl3ORa1ORm3THENz2(a1);t0:=satznummer;u0:=satzkombination;n3(TRUE)ELSEo3(TRUE)END IF.m3:satznummer<>t0ORu0<>satzkombination.END PROCbildausgeben;INT VARj0;BOOL VARp3;PROCz2(BOOL CONSTq3):INT VARc2:=1,r3:=0;p3:=TRUE;WHILEc2<=l0OR NOTp3REPs3END REP.s3:IFp3CANDk0(c2).i0=r3THENt3ELSE IFu3THENv3END IF;k0(c2).j0:=j0;feldbearbeiten(k0(c2).i0,PROC(TEXT CONST,INT CONST,INT CONST)w3);c2INCR1END IF.t3:IFq3THENx3(c2)ELSEk0(c2).j0:=j0;c2INCR1END IF.u3:c2>l0CORk0(c2).i0<>r3.v3:IFp3THENy3ELSEz3(c2);k0(c2).i0:=r3END IF.y3:r3:=k0(c2).i0;j0:=0.END PROCz2;PROCw3(TEXT CONSTv1,INT CONSTw1,x1):INT CONSTa4:=x1-w1-j0+1;IFa4>s0-2 +THENj0INCRs0-2;b4;p3:=FALSE ELSEj0INCRa4;p3:=TRUE END IF.b4:INT VARc4:=w1+j0-1;IFd4ANDe4THEN WHILE(v1SUBc4)<>c0REPc4DECR1;j0DECR1END REP END IF.d4:(v1SUBc4)<>c0.e4:pos(v1,c0,c4-s0+3,c4-1)>0.END PROCw3;PROCz3(INT CONSTc2):INT VARf4;FORf4FROMl0DOWNTOc2REPk0(f4+1):=k0(f4)END REP;l0INCR1;a1:=TRUE END PROCz3;PROCx3(INT CONSTc2):INT VARf4;FORf4FROMc2+1UPTOl0REPk0(f4-1):=k0(f4)END REP;l0DECR1;a1:=TRUE END PROCx3;INT VARg4;TEXT VARh4,i4,j4,k4:="",l4;LETm4= +#802#""15" Bild verschoben ! ESC 1 druecken ! "14""; +LETn4=""3""10"19"11""12""13"q?hpg";LETo4=1,p4=2,q4=3,r4=4,s4=5,t4=6,u4=7,v4=8,w4=9,x4=10,y4=11,z4=12;PROCu2(PROCt2):INT VARa5:=m0;lernsequenzauftastelegen("D",date);REPn3(FALSE);b5;c5;d5;e5UNTILf5END REP;toline(editfile,1);col(editfile,1).b5:IFlines(editfile)<l0+1THENoutput(editfile);line(editfile,l0-lines(editfile)+2);modify(editfile)END IF.c5:IFm0<>1THENg5(m0-1,i4)END IF;g5(h5,j4);toline(editfile,a5).h5:min(l0+1,m0+n0-1).d5:openeditor(groesstereditor+1,editfile,TRUE,q0+r0+3,p0,s0,i5);edit(groesstereditor,n4+k4,PROC(TEXT CONST)j5);k5.k5:INT VARl5,m5;getcursor(l5,m5);IFl5<>1THENbildschirmneuEND IF.i5:min(l0-m0+2,n0).e5:a5:=lineno(editfile);n5;SELECTg4OF CASEo4:o5CASEp4:p5CASEq4:q5CASEr4:r5CASEs4:s5CASEt4:t5CASEu4:u5CASEw4:t2;a1:=TRUE CASEx4:errorstop(d0)CASEy4:v5CASEz4:w5END SELECT.n5:INT CONSTx5:=col(editfile);col(editfile,1);IFm0<>1THENy5(m0-1,i4)END IF;y5(h5,j4);col(editfile,x5).o5:INT VARz5;z5:=a5-m0;rollen(-n0+1);a5:=m0+z5.p5:z5:=a5-m0;rollen(n0-1);a5:=min(m0+z5,l0).q5:rollen(-999 +);a5:=1.r5:z5:=a5-m0;rollen(999);a5:=min(m0+z5,l0).s5:toline(editfile,a5);a6;z3(a5).a6:readrecord(editfile,e1);h4:=subtext(e1,x5);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1);down(editfile);insertrecord(editfile);writerecord(editfile,h4).t5:toline(editfile,a5);IFx5=1AND(b6CANDc6ORd6CANDe6)THENf6ELSEg6END IF.b6:a5<>l0.c6:k0(a5+1).i0=k0(a5).i0.d6:a5<>1.e6:k0(a5-1).i0=k0(a5).i0.f6:deleterecord(editfile);x3(a5);IFa5>l0THENa5:=l0END IF.g6:readrecord(editfile,e1);e1:=subtext(e1,1,x5-1);writerecord(editfile,e1).u5:z5:=a5-m0;rollen(z5).v5:forget(b1);b1:=c1;z0:=TRUE.w5:IFz0THENforget(c1);c1:=b1;editfile:=sequentialfile(modify,c1)END IF.f5:g4=v4.END PROCu2;PROCj5(TEXT CONSTh6):enablestop;setbusyindicator;g4:=pos(n4,h6);IFg4>0THENl4:=h6;quitELIFpos(k4,h6)>0THENg4:=v4;l4:=h6;quitELIFkommandoauftaste(h6)<>d0THENstdkommandointerpreter(h6)ELSEnichtsneuEND IF END PROCj5;PROCg5(INT CONSTc2,TEXT VARi6):toline(editfile,c2);readrecord(editfile,i6);writerecord(editfile,m4)END PROCg5;PROCy5(INT CONSTc2, +TEXT CONSTi6):toline(editfile,c2);IFeof(editfile)CORpos(editfile,m4,1)=0THENtoline(editfile,1);down(editfile,m4);IFeof(editfile)THENtoline(editfile,c2);insertrecord(editfile)END IF END IF;writerecord(editfile,i6)END PROCy5;PROCexitzeichen(TEXT CONSTj6):k4:=j6END PROCexitzeichen;TEXT PROCexitdurch:l4END PROCexitdurch;INT VARk6;LETl6= +#803#"ENDE.",m6= +#804#"SUCH+",n6= +#805#"SUCH-",o6= +#806#"MARK+",p6= +#807#"MARK-",q6= +#808#" Zeile "14" ",r6= +#809#" Satz ",s6= +#810#"<KOPPEL>"; +LETt6=".....",u6=" ";PROCn3(BOOL CONSTv6):INT VARw6:=p0+1,x6:=0;INT CONSTy6:=m0+n0-2;o3(v6);k6:=m0;WHILEk6<=y6REPz6;a7;b7;w6INCR1;k6INCR1END REP;a1:=FALSE.z6:IFa1THENcursor(q0,w6);IFk6<=l0THENc7ELIFk6=l0+1THENd7ELSEe7END IF END IF.c7:out(f0);IFk0(k6).i0=x6THENr0TIMESOUTc0ELSEx6:=k0(k6).i0;feldnamenbearbeiten(x6,PROC(TEXT CONST,INT CONST,INT CONST)f7)END IF;out(g0).d7:out(f0);o0-4TIMESOUT".";out(h0).e7:IFy0THENout(e0)ELSEo0TIMESOUTc0END IF.a7:IFv6ANDk6<=l0THENcursor(q0+r0+3,w6);feldbearbeiten(k0(k6).i0,PROC(TEXT CONST,INT CONST,INT CONST)g7)END IF.b7:IF NOTa1THEN TEXT CONSTinput:=getcharety;IFinput<>d0THENpush(input);IFpos(k4,input)>0THENt0:=0;LEAVEn3END IF END IF END IF.END PROCn3;PROCo3(BOOL CONSTv6):h7;i7;cursor(q0,p0);IF NOTv6THENoutsubtext(d1,1,r0+3);LEAVEo3END IF;replace(d1,r0+7,j7);replace(d1,r0+14,k7);out(d1);cursor(q0+o0-5,p0);out(text(m0)).h7:TEXT VARsatznr;satznr:=text(satznummer);IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENsatznrCAT"-";satznrCATtext(satzkombination +)END IF.i7:replace(d1,7,u6);replace(d1,7,satznr).j7:IFsuchversion=0THENt6ELIFsatzausgewaehltTHENm6ELSEn6END IF.k7:IFdateiendeTHENl6ELIFmarkiertesaetze=0THENt6ELIFsatzmarkiertTHENo6ELSEp6END IF.END PROCo3;PROCf7(TEXT CONSTv1,INT CONSTw1,x1):IFx1-w1>=r0THENoutsubtext(v1,w1,w1+r0-1)ELSEoutsubtext(v1,w1,x1);r0-x1+w1-1TIMESOUTc0END IF END PROCf7;PROCg7(TEXT CONSTv1,INT CONSTw1,x1):INT VARp2;IFk6=l0CORl7THENp2:=x1ELSEp2:=w1+k0(k6+1).j0-1END IF;outsubtext(v1,w1+k0(k6).j0,p2);IFy0THENout(e0)ELSEm7TIMESOUTc0END IF.l7:k0(k6+1).i0<>k0(k6).i0.m7:s0-p2+w1+k0(k6).j0-1.END PROCg7;PROCq1:d1:=text(r6,r0+3);d1CATf0;INT VARf4;INT CONSTn7:=o0-length(d1)-12;FORf4FROM1UPTOn7REPd1CAT"."END REP;d1CATq6;o7.o7:IFaufkoppeldateiTHENreplace(d1,r0+22,s6)END IF.END PROCq1;END PACKETsatzanzeige; +PACKETuebersichtsanzeigeDEFINESuebersicht,uebersichtsfenster:ROW24INT VARb0;ROW24INT VARc0;FENSTER VARfenster;fensterinitialisieren(fenster);INT VARd0:=24,e0:=79,f0:=1,g0:=1,h0,i0:=-1;BOOL VARj0;TEXT VARk0;LETl0="",m0=""15"",n0=""14"",o0=" ",p0=""7"",q0=""5"";LETr0= +#901#""15"Satznr. ",s0= +#902#" << DATEIENDE >>",t0= +#903#"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?"; +PROCuebersichtsfenster(FENSTER CONSTu0):fenstergroesse(u0,g0,f0,e0,d0);fenstergroessesetzen(fenster,u0);j0:=g0+e0>=xsizeEND PROCuebersichtsfenster;FENSTER PROCuebersichtsfenster:fensterEND PROCuebersichtsfenster;PROCuebersicht(TEXT CONSTv0,PROCw0):TEXT VARx0;BOOL VARdummy;INT VARy0:=1,z0:=0,a1:=1;fensterzugriff(fenster,dummy);statusanzeigen(t0);b1;c1;REPd1;e1;f1END REP.b1:IFv0=l0THENg1ELSEk0:=v0;i0:=dateiversionEND IF.g1:IFi0<>dateiversionTHENh1;i0:=dateiversionEND IF.h1:INT VARi1;k0:=l0;FORi1FROM1UPTOanzahlfelderREPk0CATcode(i1)END REP.d1:WHILEz0<d0REPx0:=getcharety;IFx0<>""THEN LEAVEd1END IF;j1;z0INCR1END REP;k1;getchar(x0).j1:IFz0=0THENl1ELIFz0=1THENm1ELSEn1END IF.l1:cursor(g0,f0);out(r0);h0:=e0-length(r0)-1;INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldnamenbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP;p1;cursor(g0+e0-1,f0);out(n0).m1:q1(1);r1(1);s1.n1:cursor(g0,f0+z0);IFdateiendeTHENb0(z0):=0;h0:=e0;p1ELSEt1;r1(z0);s1END IF.t1: +weiter(2);u1;b0(z0):=satznummer;c0(z0):=satzkombination.u1:IF NOT(satzausgewaehltORdateiende)THEN LEAVEuebersichtEND IF.e1:cursor(g0,f0+y0).k1:WHILEb0(y0)=0REPy0DECR1END REP;q1(y0);cursor(g0+6,f0+y0).f1:SELECTa1OF CASE1:v1CASE2:w1CASE3:x1END SELECT.v1:SELECTpos(""3""10""1""27"+-",x0)OF CASE1:y1CASE2:z1CASE3:a1:=2CASE4:a1:=3CASE5:a2CASE6:b2OTHERWISEout(p0)END SELECT.w1:SELECTpos(""3""10""13"",x0)OF CASE1:c2CASE2:d2CASE3:e2OTHERWISEout(p0)END SELECT;a1:=1.x1:SELECTpos("19qh?",x0)OF CASE1:f2CASE2:g2CASE3,4:h2CASE5:i2OTHERWISEout(p0)END SELECT;a1:=1.y1:IFy0>1THENy0DECR1;ELSEj2(1);z0:=1END IF.z1:IF NOTdateiendeTHEN IFy0<d0-1THENy0INCR1ELSEb0(1):=b0(2);c0(1):=c0(2);z0:=1END IF END IF.a2:IF NOTsatzmarkiertTHENmarkierungaendern;IFy0<z0THENr1(y0)END IF END IF.b2:IFsatzmarkiertTHENmarkierungaendern;IFy0<z0THENr1(y0)END IF END IF.c2:IFy0>1THENy0:=1ELSEj2(d0-1);z0:=1END IF.d2:IFy0=d0-1AND NOTdateiendeTHENweiter(2);c1;z0:=1ELSEy0:=d0-1END IF.e2:IFy0<>1THENb0(1):=b0(y0);c0(1):=c0(y0);y0:=1;z0:=1END +IF.f2:aufsatz(1);IF NOTsatzausgewaehltTHENweiter(2)END IF;c1;y0:=1;z0:=1.g2:aufsatz(32767);c1;j2(d0-2);z0:=1.h2:LEAVEuebersicht.i2:w0;statusanzeigen(t0);z0:=0.END PROCuebersicht;PROCj2(INT CONSTk2):INT VARi1;q1(1);FORi1FROM1UPTOk2WHILEsatznummer>1REPzurueck(2)END REP;c1END PROCj2;PROCq1(INT CONSTl2):aufsatz(b0(l2));WHILEsatzkombination<>c0(l2)REPweiter(1)END REP END PROCq1;PROCc1:b0(1):=satznummer;c0(1):=satzkombinationEND PROCc1;BOOL PROCm2(INT CONSTl2):satznummer=b0(l2)CANDsatzkombination=c0(l2)END PROCm2;PROCo1(TEXT CONSTn2,INT CONSTo2,p2):INT CONSTd0:=min(h0,p2-o2+1);outsubtext(n2,o2,o2+d0-1);h0DECRd0;IFh0>=2THENout(", ");h0DECR2ELIFh0=1THENout(",");h0:=0END IF END PROCo1;PROCr1(INT CONSTl2):cursor(g0,f0+l2);IFsatzmarkiertTHENout(m0)ELSEout(o0)END IF;outtext(text(satznummer),1,5);IFsatzmarkiertTHENout(n0)ELSEout(o0)END IF;h0:=e0-7END PROCr1;PROCp1:IFj0THENout(q0)ELSEh0TIMESOUTo0END IF END PROCp1;PROCs1:IFsatzausgewaehltTHENq2ELIFdateiendeTHENout(s0);h0DECRlength(s0)ELSEout("<< >>") +;h0DECR5END IF;p1.q2:INT VARfeldindex;FORfeldindexFROM1UPTOlength(k0)WHILEh0>0REPfeldbearbeiten(code(k0SUBfeldindex),PROC(TEXT CONST,INT CONST,INT CONST)o1)END REP.END PROCs1;END PACKETuebersichtsanzeige; +PACKETeudasdialoghilfenDEFINESfenstergroessenbestimmen,fensterlinks,fensterrechts,fensterganz,ausfuehrung,aufarchiv,bittewarten,frageobeinrichten,setcommanddialoguefalse,resetcommanddialogue,edit:LETb0=16;INT VARc0:=0,d0;FENSTER VARe0,f0,g0,h0;fensterinitialisieren(h0);fensterinitialisieren(e0);fensterinitialisieren(f0);fensterinitialisieren(g0);PROCfenstergroessenbestimmen:IFxsize<>c0ORysize<>d0THENi0;c0:=xsize;d0:=ysizeEND IF.i0:fenstergroessesetzen(e0,1,2,xsize-1,ysize-1);fenstergroessesetzen(f0,1,2,b0,ysize-2);fenstergroessesetzen(g0,b0+1,2,xsize-b0-1,ysize-2);fenstergroessesetzen(h0,1,ysize,xsize-1,1);dialogfenster(g0);anzeigefenster(g0);uebersichtsfenster(e0).END PROCfenstergroessenbestimmen;FENSTER PROCfensterrechts:g0END PROCfensterrechts;FENSTER PROCfensterlinks:f0END PROCfensterlinks;FENSTER PROCfensterganz:e0END PROCfensterganz;LETj0= +#1001#"Keine Datei zur Auswahl vorhanden.",k0= +#1002#"Name der Datei: "; +SATZ VARl0;THESAURUS VARm0;TEXT VARn0,o0,p0;LETq0="",r0=""27"z",s0=""5"";LETt0=11,u0=0;DATASPACE VARv0;INITFLAG VARw0;BOUND STRUCT(TEXTname,x0,y0)VARz0;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,PROC(TEXT CONST)d1):ausfuehrung(a1,b1,c1,niltask,PROC(TEXT CONST)d1)END PROCausfuehrung;PROCausfuehrung(TEXT CONSTa1,BOOL CONSTb1,INT CONSTc1,TASK CONSTe1,PROC(TEXT CONST)d1):enablestop;f1;IFo0=q0THENerrorstop(q0)ELIFg1THENo0:=subtext(o0,3);h1(all,c1,e1);auswahlanbieten("EUDAS-Dateiauswahl",g0,i1,"AUSWAHL/Datei",PROC(TEXT VAR,INT CONST)j1);bittewarten;k1(PROC(TEXT CONST)d1)ELSElastparam(o0);d1(o0)END IF.f1:IFexists(std)AND(c1=0CORtype(old(std))=c1)THENo0:=stdELSEo0:=q0END IF;editget(a1,o0,"z","GET/Dateiname").i1:IFb1THEN1ELSE1024END IF.END PROCausfuehrung;PROCaufarchiv(PROC(TEXT CONST)d1,THESAURUS CONSTl1):o0:=q0;editget(k0,o0,"z","GET/Dateiname");IFo0=q0THENerrorstop(q0)ELIFg1THENm1ELSElastparam(o0);d1(o0)END IF.m1:o0:=subtext(o0,3);h1(l1,0,niltask);auswahlanbieten( +"EUDAS-Archivauswahl",g0,"AUSWAHL/Archiv",PROC(TEXT VAR,INT CONST)j1);k1(PROC(TEXT CONST)d1).END PROCaufarchiv;PROCh1(THESAURUS CONSTn1,INT CONSTc1,TASK CONSTe1):BOOL CONSTo1:=pos(o0,"*")=0;p1;q1;r1;s1.p1:INT VARt1:=1,u1:=0;satzinitialisieren(l0);REPget(n1,n0,u1);IFn0=q0THEN LEAVEp1ELIFv1ANDw1THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.v1:c1=0CORtype(old(n0))=c1.w1:o1COR(n0LIKEo0).q1:p0:=q0;INT VARx1;FORx1FROM1UPTOanzahldateienREP INT CONSTy1:=feldindex(l0,eudasdateiname(x1));IFy1>0THENp0CATcode(y1)END IF END REP.r1:IF NOTisniltask(e1)THENm0:=ALLe1;z1END IF.z1:u1:=0;REPget(m0,n0,u1);IFn0=q0THEN LEAVEz1ELIFw1CANDa2CANDb2THENfeldaendern(l0,t1,n0);t1INCR1END IF END REP.a2:NOT(n1CONTAINSn0).b2:c1=0CORc2(n0,e1)=c1.s1:IFt1=1THENdialog(j0);errorstop(q0)END IF.END PROCh1;INT PROCc2(TEXT CONSTd2,TASK CONSTe2):enablestop;INT VARf2,g2;IF NOTinitialized(w0)THENv0:=nilspaceEND IF;forget(v0);v0:=nilspace;z0:=v0;z0.name:=d2;z0.x0:=writepassword;z0.y0:=readpassword;call(e2,t0,v0,f2);IFf2<>u0THENg2 +:=0ELSEg2:=type(v0)END IF;forget(v0);g2END PROCc2;BOOL PROCg1:subtext(o0,1,2)=r0END PROCg1;PROCj1(TEXT VARh2,INT CONSTt1):IFt1<256THENfeldlesen(l0,t1,h2);IFpos(p0,code(t1))>0THENh2:="<!> "+textdarstellung(h2)ELIFh2<>q0THENh2:=textdarstellung(h2)END IF ELSEh2:=q0END IF END PROCj1;PROCk1(PROC(TEXT CONST)d1):INT VARt1:=1;REP IFwahl(t1)=0THEN LEAVEk1ELSEfeldlesen(l0,wahl(t1),n0);i2;lastparam(n0);d1(n0)END IF;t1INCR1END REP.i2:IFonlineTHENfensterveraendert(h0);cursor(1,ysize);out(s0);out(text(t1));out(". ");out(textdarstellung(n0))END IF.END PROCk1;LETj2= +#1003#"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?",k2= +#1004#"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?"; +INT VARl2;BOOL VARm2,n2;PROCedit(FILE VARf,FENSTER CONSTfenster,TEXT CONSTo2,BOOL CONSTaendern):INT VARp2,q2,r2,s2;fenstergroesse(fenster,p2,q2,r2,s2);fensterveraendert(fenster);enablestop;t2;m2:=aendern;REPu2;openeditor(groesstereditor+1,f,aendern,p2,q2,r2,s2);edit(groesstereditor,"eqvw19dpgn"9"?hF",PROC(TEXT CONST)v2);w2END REP.t2:IFaendernANDq2<3ANDs2>22ANDp2<14ANDr2>75THENn2:=TRUE ELSEn2:=FALSE END IF.w2:SELECTl2OF CASE0:LEAVEeditCASE1:hilfeanbieten(o2,fenster)CASE2:errorstop(q0)END SELECT.END PROCedit;PROCu2:IFm2THENstatusanzeigen(j2)ELSEstatusanzeigen(k2)END IF END PROCu2;PROCv2(TEXT CONSTx2):l2:=pos("q?h",x2);IFl2>0THENl2DECR1;quitELIFn2CANDx2="F"THENdo("feldnamen anzeigen");u2ELSEstdkommandointerpreter(x2);u2;bildschirmneuEND IF END PROCv2;BOOL VARy2;PROCsetcommanddialoguefalse:y2:=commanddialogue;commanddialogue(FALSE)END PROCsetcommanddialoguefalse;PROCresetcommanddialogue:commanddialogue(y2)END PROCresetcommanddialogue;LETz2= +#1005#" Bitte warten.. ",a3= +#1006#" neu einrichten"; +PROCbittewarten:statusanzeigen(z2)END PROCbittewarten;PROCfrageobeinrichten(TEXT CONSTd2):IF NOTja(textdarstellung(d2)+a3,"JA/einrichten")THENerrorstop(q0)END IF END PROCfrageobeinrichten;END PACKETeudasdialoghilfen; + + diff --git a/app/eudas/5.3/src/eudas.4 b/app/eudas/5.3/src/eudas.4 new file mode 100644 index 0000000..7170f43 --- /dev/null +++ b/app/eudas/5.3/src/eudas.4 @@ -0,0 +1,134 @@ +PACKETeudassteuerungDEFINESeudas,einzelsicherung,suchen,aendern,einfuegen,prueffehlereditieren,feldstruktur,feldnamenanzeigen,formatierenautomatisch,arbeitsbereichbestimmen,dateiverwaltung,archivverwaltung:INT VARb0:=1003,c0:=3243;IFd0THENb0:=1004END IF.d0:maxintDIV2>17000.;LETe0="",f0=" ",g0=""4"",h0=""5"";FILE VARi0;DATASPACE VARj0;INT VARk0,l0:=dateiversion-1;TEXT VARm0;BOOL VARn0:=FALSE;LETo0= +#1101#"EUDAS.Öffnen",p0= +#1102#"EUDAS.Einzelsatz",q0= +#1103#"EUDAS.Gesamtdatei",r0= +#1104#"EUDAS.Drucken",s0= +#1105#"EUDAS.Dateien",t0= +#1106#"EUDAS.Archiv"; +LETu0= +#1107#"EUDAS kann nicht unter EUDAS aufgerufen werden",v0= +#1108#"Suchbedingung einstellen",w0= +#1109#"Alle Sätze drucken",x0= +#1110#"Alle markierten Sätze drucken",y0= +#1111#"Aktuellen Satz drucken",z0= +#1112#"Mit neuer Auswahl noch einmal",a1= +#1113#""15"Akt.Datei "14"",b1= +#1114#""15"Datum "14""; +PROCeudas:IFaktuellereditor>0THENc1ELIFn0THENerrorstop(u0)ELSEd1END IF.d1:fenstergroessenbestimmen;page;bildschirmneu;k0:=heapsize;disablestop;n0:=TRUE;menueanbieten(ROW6TEXT:(o0,p0,q0,r0,s0,t0),fensterlinks,TRUE,PROC(INT CONST,INT CONST)e1);n0:=FALSE;enablestop;f1;page;bildschirmneuEND PROCeudas;PROCc1:TEXT VARg1:=e0;h1;f1;IFi1THEN LEAVEc1END IF;j1(FALSE);aufsatz(1);k1(g1);REPl1;uebersicht(g1,PROCm1);h1;n1UNTILo1END REP;dateienloeschen(FALSE).i1:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THEN LEAVEi1WITH TRUE END IF END REP;FALSE.l1:IFja(v0,"JA/Suchmuster")THENsuchen;allesneuEND IF.n1:IFmarkiertesaetze=0CANDq1THENr1(s1,b0,PROC(TEXT CONST)t1)ELIFmarkiertesaetze>0CANDu1THENr1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenELIFv1THENmarkierungenloeschen;markierungaendern;r1(s1,b0,PROC(TEXT CONST)t1);markierungenloeschenEND IF.q1:ja(w0,"JA/alle Saetze",FALSE).u1:ja(x0,"JA/alle markierten").v1:ja(y0,"JA/Einzelsatz drucken").o1:NOTja(z0,"JA/noch einmal",FALSE).END PROCc1; +PROCh1:bildschirmneu;cursor(1,1);out(g0)END PROCh1;PROCt1(TEXT CONSTw1):x1;disablestop;drucke(w1);y1;h1END PROCt1;PROCe1(INT CONSTz1,a2):enablestop;SELECTz1OF CASE0:b2CASE1:c2(a2)CASE2:d2(a2)CASE3:e2(a2)CASE4:f2(a2)CASE5:dateiverwaltung(a2)CASE6:archivverwaltung(z1,a2)END SELECT.b2:IFanzahldateien=0THENg2(FALSE);h2(FALSE)ELIF NOTaendernerlaubtTHENh2(FALSE)END IF;i2;fusszeile("","",35,b1,64);fussteil(3,date).END PROCe1;PROCg2(BOOL CONSTj2):INT VARk2;waehlbar(1,4,j2);waehlbar(1,5,j2);waehlbar(1,7,j2);FORk2FROM1UPTO12REPwaehlbar(2,k2,j2)END REP;waehlbar(3,1,j2);waehlbar(3,4,j2);waehlbar(3,6,j2);waehlbar(4,1,j2)END PROCg2;PROCi2:BOOL VARj2:=anzahldateien=1ANDaendernerlaubt;waehlbar(1,6,j2);waehlbar(3,5,j2);j2:=anzahldateien>0ANDanzahldateien<10AND NOTaufkoppeldatei;waehlbar(1,2,j2);waehlbar(1,3,j2)END PROCi2;PROCh2(BOOL CONSTj2):INT VARk2;FORk2FROM8UPTO11REPwaehlbar(2,k2,j2)END REP;waehlbar(3,2,j2);waehlbar(3,3,j2)END PROCh2;LETl2= +#1115#""15"Manager "14"",m2= +#1116#"Manager ausschalten",n2= +#1117#"Keine Sicherung nötig.",o2= +#1118#"Interne Arbeitskopien löschen",p2= +#1119#"Arbeitskopie ",q2= +#1120#" unverändert.",r2= +#1121#" verändert! Optionen zum Sichern:",s2= +#1125#"Sichern unter dem neuen Namen:",t2= +#1126#" überschreiben",u2= +#1127#"Datei wieder sortieren",v2= +#1128#"Notizen",w2= +#1129#"Name Managertask:",x2= +#1130#"Task existiert nicht !",y2= +#1131#"Wollen Sie etwas verändern (eine Arbeitskopie anlegen)",z2= +#1132#"Alle Markierungen gelöscht.",a3= +#1133#"Prüfbedingungen",b3= +#1134#"Feldnamen ändern",c3= +#1135#"Feldtypen ändern",d3= +#1136#"Feldnamen anfügen",e3= +#1137#"Neuer Feldname:",f3= +#1138#"Typwahl für Feld ",g3= +#1139#"Neue Feldnamen",h3= +#1140#"TEXT ",i3= +#1141#" DIN ",j3= +#1142#"ZAHL ",k3= +#1143#"DATUM",l3= +#1144#"Alte Feldreihenfolge ändern",m3= +#1145#""7"ACHTUNG: System voll, Dateien löschen!"; +BOOL VARn3,o3:=FALSE;TASK VARp3:=niltask;TEXT VARq3:=e0;SATZ VARr3;ROW6TEXT VARs3;s3(1):=h3;s3(2):=i3;s3(3):=j3;s3(4):=k3;s3(5):=e0;s3(6):=e0;PROCc2(INT CONSTa2):SELECTa2OF CASE0:t3CASE1:u3CASE2:v3CASE3:w3CASE4:x3CASE5:y3CASE6:z3CASE7:a4CASE8:b4OTHERWISEc4END SELECT;d4;e4.t3:IFanzahldateien=0THENe1(0,0)END IF;f4;fussteil(2,l2,q3).u3:f1;j1(TRUE);IFanzahldateien>0THENpush("2")END IF.v3:g4(PROC(TEXT CONST)h4).w3:g4(PROC(TEXT CONST)i4).x3:IFaendernerlaubtTHENj4ELSEdateienloeschen(FALSE);dialog(n2)END IF;k4.j4:INT VARp1;FORp1FROM1UPTOanzahldateienREPeinzelsicherung(p1)END REP;IFja(o2,"JA/Dateien loeschen")THENl4;dateienloeschen(TRUE)END IF.k4:IFanzahldateien=0THENg2(FALSE);h2(FALSE)END IF;i2;f4.y3:m4;dialogfensterloeschen.z3:zugriff(PROC(EUDAT VAR)feldstruktur).a4:n4;dialogfensterloeschen.b4:TEXT VARo4:="";editget(w2,o4,"","GET/multi task");IFo4=e0THEN IFp4THENq4(e0,FALSE)END IF ELIFexiststask(o4)THENr4(task(o4));q4(o4,TRUE)ELSEerrorstop(x2)END IF.p4:ja(m2,"JA/manager aus").e4:IFheapsize-k0 +>4THENcollectheapgarbage;k0:=heapsizeEND IF.c4:IFa2=-1THENdialogfensterloeschen;LEAVEc2END IF.END PROCc2;PROCg4(PROC(TEXT CONST)s4):ausfuehrung(t4,TRUE,c0,p3,PROC(TEXT CONST)s4);i2;f4END PROCg4;PROCf4:TEXT VARu4:=e0;IFanzahldateien>0THENu4CAT"""";u4CATeudasdateiname(1);u4CAT""""END IF;IFanzahldateien>1THENu4CAT" .."END IF;fussteil(1,a1,u4)END PROCf4;PROCq4(TEXT CONSTv4,BOOL CONSTw4):IFw4THENp3:=task(v4)ELSEp3:=niltaskEND IF;o3:=w4;q3:=v4;fussteil(2,q3)END PROCq4;PROCf1:BOOL VARx4:=FALSE;IFaendernerlaubtTHENy4END IF.y4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFinhaltveraendert(p1)THENeinzelsicherung(p1);x4:=TRUE;z4END IF END REP.z4:IFp1=1CANDstd=eudasdateiname(1)THENlastparam(e0)END IF.END PROCf1;PROCeinzelsicherung(INT CONSTp1):a5;IFinhaltveraendert(p1)THENb5ELSEdialog(c5)END IF.a5:TEXT VARc5:=p2;c5CATtextdarstellung(eudasdateiname(p1));IFinhaltveraendert(p1)THENc5CATr2ELSEc5CATq2END IF.b5:INT VARd5:=1;auswahlanbieten("WAHL.Sichern",c5,"WAHL/sichere",d5);e5.e5:TEXT VARname:= +eudasdateiname(p1);SELECTd5OF CASE1:f5CASE3:g5END SELECT;IFd5<>2THENh5END IF.f5:forget(name,quiet).g5:editget(s2,name,"","GET/Sicherungsname");IFexists(name)ORi5THENj5END IF.i5:k5(p1)CANDexists(name,herkunft(p1)).j5:IFja(textdarstellung(name)+t2,"JA/ueber",FALSE)THENforget(name,quiet)ELSEeinzelsicherung(p1);LEAVEeinzelsicherungEND IF.h5:sichere(p1,name);l5;m5.l5:EUDAT VARn5;oeffne(n5,name);IFo5CANDp5THENbittewarten;sortiere(n5)END IF.o5:sortierreihenfolge(n5)<>e0CANDunsortiertesaetze(n5)>0.p5:ja(u2,"JA/Sicherungssortierung").m5:IFk5(p1)THENdisablestop;setcommanddialoguefalse;save(name,herkunft(p1));resetcommanddialogue;enablestop;forget(name,quiet)END IF.END PROCeinzelsicherung;PROCj1(BOOL CONSTq5):IFaendernerlaubtTHENl4END IF;dateienloeschen(TRUE);g2(FALSE);h2(FALSE);forget(j0);disablestop;n3:=q5;g4(PROC(TEXT CONST)r5);enablestop;IFanzahldateien>0THENg2(TRUE);h2(aendernerlaubt)END IF END PROCj1;PROCl4:INT VARp1;FORp1FROM1UPTOanzahldateienREP IFk5(p1)THENs5END IF END REP.s5:free( +eudasdateiname(p1),herkunft(p1)).END PROCl4;PROCr5(TEXT CONSTw1):BOOL VARt5;TASK VARu5;v5;oeffne(w1,t5,u5).v5:IFw5ANDn3THENfrageobeinrichten(w1);EUDAT VARn5;oeffne(n5,w1);feldstruktur(n5);t5:=TRUE;u5:=niltaskELSEt5:=n3CANDja(y2,"JA/oeffne",FALSE);x5(w1,t5,u5)END IF.w5:NOTexists(w1)ANDy5.y5:NOTo3COR NOTexists(w1,p3).END PROCr5;PROCh4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kette(w1,u5)END PROCh4;PROCi4(TEXT CONSTw1):TASK VARu5;x5(w1,aendernerlaubt,u5);kopple(w1,u5)END PROCi4;PROCx5(TEXT CONSTw1,BOOL CONSTz5,TASK VARu5):u5:=niltask;IFo3THENa6END IF.a6:IF NOTexists(w1)CANDexists(w1,p3)THEN IFz5THENlock(w1,p3)END IF;forget(w1,quiet);fetch(w1,p3);u5:=p3END IF.END PROCx5;BOOL PROCk5(INT CONSTp1):NOTisniltask(herkunft(p1))END PROCk5;PROCm4:notizenlesen(3,m0);DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;headline(f,v2);c6(f,m0,fensterganz,"EDIT/Notizen");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(3,m0)END IF END PROCm4;PROCc6(FILE VARf,TEXT +VARd6,FENSTER CONSTe6,TEXT CONSTf6):LETg6="#-#";enablestop;h6;i6;j6.h6:INT VARk6:=1,l6;REPl6:=pos(d6,g6,k6);IFl6=0THENputline(f,subtext(d6,k6))ELSEputline(f,subtext(d6,k6,l6-1))END IF;k6:=l6+3UNTILl6=0ORk6>length(d6)END REP.i6:modify(f);edit(f,e6,f6,TRUE).j6:TEXT VARm6;d6:=e0;input(f);WHILE NOTeof(f)REPgetline(f,m6);n6;d6CATm6;d6CATg6END REP.n6:IF(m6SUBlength(m6))=f0THENm6:=subtext(m6,1,length(m6)-1)END IF.END PROCc6;PROCfeldstruktur(EUDAT VARn5):INT VARo6;feldnamenlesen(n5,r3);IFp6THENq6END IF;IFr6THENs6END IF;IFja(c3,"JA/Feldtypen aendern",FALSE)THENt6END IF;feldnamenaendern(n5,r3).p6:felderzahl(r3)>0CANDja(b3,"JA/Feldnamen aendern",FALSE).r6:felderzahl(r3)=0CORja(d3,"JA/feldnamen",FALSE).q6:u6(n5);o6:=1;WHILEwahl(o6)>0REPv6;o6INCR1END REP.v6:TEXT VARw6;feldlesen(r3,wahl(o6),w6);editget(e3,w6,"","GET/feldname");feldaendern(r3,wahl(o6),w6).s6:DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);disablestop;x6(f,r3);forget(b6);enablestop;feldnamenaendern(n5,r3).t6:u6(n5);o6:= +1;WHILEwahl(o6)>0REPy6;o6INCR1END REP.y6:INT VARd5:=feldinfo(n5,wahl(o6))+2;feldlesen(r3,wahl(o6),w6);auswahlanbieten("WAHL.Typen",f3+textdarstellung(w6),"WAHL/Feldtypen",d5);feldinfo(n5,wahl(o6),d5-2).END PROCfeldstruktur;PROCu6(EUDAT CONSTn5):z6;auswahlanbieten("EUDAS-Felder",fensterrechts,"AUSWAHL/Felder",PROC(TEXT VAR,INT CONST)a7).z6:INT VARo6;satzinitialisieren(b7);FORo6FROM1UPTOfelderzahl(r3)REPfeldlesen(r3,o6,m0);feldaendern(b7,o6,c7+m0)END REP.c7:"<"+s3(feldinfo(n5,o6)+2)+"> ".END PROCu6;PROCn4:enablestop;DATASPACE VARb6:=nilspace;FILE VARf:=sequentialfile(output,b6);headline(f,a3);notizenlesen(1,m0);disablestop;c6(f,m0,fensterganz,"EDIT/Pruefbed");forget(b6);enablestop;IFaendernerlaubtTHENnotizenaendern(1,m0)END IF.END PROCn4;PROCx6(FILE VARf,SATZ VARd7):enablestop;e7;f7.e7:modify(f);headline(f,g3);edit(f,fensterrechts,"EDIT/Feldnamen",TRUE).f7:INT VARo6:=felderzahl(d7);input(f);WHILE NOTeof(f)REPgetline(f,m0);n6;o6INCR1;feldaendern(d7,o6,m0)END REP.n6:IF(m0SUBlength(m0))=f0 +THENm0:=subtext(m0,1,length(m0)-1)END IF.END PROCx6;PROCd4:INT VARg7,h7;storage(g7,h7);IFh7>g7THENneuerdialog;dialog(m3)END IF END PROCd4;BOOL VARi7,j7:=FALSE,k7:=FALSE;LETl7= +#1146#"SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",m7= +#1147#"SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",n7= +#1148#"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?",o7= +#1149#"Umschalten auf Koppeldatei ",p7= +#1150#"Koppelfelder übernehmen",q7= +#1151#"Ungültige Satznummer",r7= +#1152#"Neue Satznummer:",s7= +#1153#"wzK",t7= +#1154#"wz"; +PROCd2(INT CONSTa2):SELECTa2OF CASE0:u7CASE1:v7CASE2:w7CASE3:x7CASE4:y7CASE5:z7CASE6:a8CASE7:b8CASE8:c8CASE9:d8CASE10:e8CASE11:f8CASE12:g8CASE13:h8CASE14:i8CASE15:j8CASE16:k8CASE17:l8OTHERWISEm8END SELECT;d4.u7:f4;fussteil(2,"","");exitzeichen(t7).v7:bittewarten;weiter(2);bildausgeben(FALSE).w7:bittewarten;zurueck(2);bildausgeben(FALSE).z7:suchen;bildausgeben(TRUE).a8:suchbedingungloeschen;bildausgeben(FALSE).x7:TEXT VARn8:=e0;editget(r7,n8,"","GET/auf Satz");INT CONSTo8:=int(n8);IFn8=e0THENbildausgeben(FALSE)ELIFlastconversionokTHENaufsatz(o8);bildausgeben(FALSE)ELSEerrorstop(q7)END IF.y7:TEXT VARp8;feldnamenlesen(1,p8);n8:=e0;editget(p8+":",n8,"","GET/auf Schluessel");aufsatz(n8);bildausgeben(FALSE).c8:einfuegen;bildausgeben(TRUE).d8:aendern;bildausgeben(TRUE).b8:markierungaendern;bildausgeben(FALSE).e8:q8;r1(r8,c0,PROC(TEXT CONST)s8);bildausgeben(TRUE).f8:q8;r1(t8,c0,PROC(TEXT CONST)holesatz);bildausgeben(TRUE).g8:TEXT VARu8:=e0;v8(u8,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder"); +IFu8<>e0THENfeldauswahl(u8)END IF;bildausgeben(TRUE).h8:w8;rollen(-23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.i8:w8;rollen(23);IFanzahldateien>0THENbildausgeben(FALSE)END IF.j8:w8;rollen(-9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.k8:w8;rollen(9999);IFanzahldateien>0THENbildausgeben(FALSE)END IF.l8:IFaufkoppeldateiTHENx8ELSEy8END IF;IFanzahldateien>0THENbildausgeben(TRUE)END IF.x8:IF(k7ORj7)THENz8;a9ELSEaufkoppeldatei(0)END IF;i2.z8:IF NOTdateiendeCANDja(p7,"JA/uebernehmen")THENaufkoppeldatei(1)ELSEaufkoppeldatei(0)END IF.a9:j7:=FALSE;IFk7THENk7:=FALSE;aendernELSEb9(TRUE)END IF.m8:IFa2=-2THEN IFanzahldateien>0THENbildausgeben(FALSE)END IF ELSEdialogfensterloeschenEND IF.END PROCd2;PROCsuchen:disablestop;exitzeichen("");statusanzeigen(n7);suchen(PROCc9);exitzeichen(t7)END PROCsuchen;PROCc9:hilfeanbieten("EDIT/Suchen",fensterrechts)END PROCc9;PROCeinfuegen:b9(FALSE)END PROCeinfuegen;PROCb9(BOOL CONSTd9):BOOL VARe9:=d9;f9;REPstatusanzeigen(m7);IFe9THENaendern(PROCg9);e9 +:=FALSE ELSEeinfuegen(PROCg9)END IF;h9;i9END REP.i9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEb9CASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenELSEbittewarten;zurueck(2)END IF CASE3:y8;IFaufkoppeldateiTHENj7:=TRUE;LEAVEb9END IF;e9:=TRUE END SELECT.END PROCb9;PROCg9:hilfeanbieten("EDIT/Einfuegen",fensterrechts)END PROCg9;PROCf9:IFanzahlkoppeldateien>0AND NOTaufkoppeldateiTHENexitzeichen(s7)ELSEexitzeichen(t7)END IF END PROCf9;PROCaendern:f9;kommandoauftastelegen("F","prueffehler editieren");REPstatusanzeigen(l7);aendern(PROCj9);h9;k9END REP.k9:SELECTpos(s7,exitdurch)OF CASE0:IFi7THENsatzloeschenEND IF;LEAVEaendernCASE1:IFi7THENsatzloeschenELSEbittewarten;weiter(2)END IF CASE2:IFi7THENsatzloeschenEND IF;bittewarten;zurueck(2)CASE3:y8;IFaufkoppeldateiTHENk7:=TRUE;LEAVEaendernEND IF END SELECT.END PROCaendern;PROCj9:hilfeanbieten("EDIT/Aendern",fensterrechts)END PROCj9;PROCprueffehlereditieren:IFl0=dateiversionTHENmodify(i0);edit( +i0)END IF END PROCprueffehlereditieren;PROCy8:INT VARp1:=folgedatei(0);WHILEp1>0REP IFl9THENaufkoppeldatei(p1);i2;LEAVEy8END IF;p1:=folgedatei(p1)END REP.l9:ja(o7+textdarstellung(eudasdateiname(p1)),"JA/umschalten").END PROCy8;PROCm9(TEXT CONSTm6,INT CONSTdummy):outsubtext(m6,n9);out(h0).n9:pos(m6,f0,6)+1+dummy-dummy.END PROCm9;PROCh9:feldbearbeiten(1,PROC(TEXT CONST,INT CONST,INT CONST)o9)END PROCh9;PROCo9(TEXT CONSTd7,INT CONSTk6,l6):i7:=k6<3ORk6>length(d7)+l6-l6END PROCo9;PROCw8:cursor(15,24)END PROCw8;PROCs8(TEXT CONSTw1):IFexists(w1)THENp9ELSEfrageobeinrichten(w1)END IF;bittewarten;tragesatz(w1).p9:IFq9(w1)<>0THENerrorstop(r9)END IF.END PROCs8;PROCv8(TEXT VARu8,TEXT CONSTs9,t9):auswahlanbieten(s9,fensterrechts,256,t9,u8,PROC(TEXT VAR,INT CONST)u9);u8:=e0;INT VARn8:=1;WHILEwahl(n8)>0REPu8CATcode(wahl(n8));n8INCR1END REP END PROCv8;LETt4= +#1155#"Name der Datei:",r8= +#1156#"Name der Zieldatei:",v9= +#1157#"Name der Verarbeitungsvorschrift:",s1= +#1158#"Name des Druckmusters:",t8= +#1159#"Name der Quelldatei:"; +LETg8= +#1160#"Angezeigte Felder auswählen",w9= +#1161#" aufsteigend sortieren"; +TEXT VARx9:=e0;INT VARy9:=0;DATASPACE VARz9;PROCe2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:b10CASE2:c10CASE3:d10CASE4:e10CASE5:f10CASE6:g10OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").c10:q8;r1(r8,c0,PROC(TEXT CONST)h10).b10:q8;r1(r8,c0,PROC(TEXT CONST)i10);dialogfensterloeschen.d10:ausfuehrung(v9,b0,PROC(TEXT CONST)j10);dialogfensterloeschen.e10:IFdateiversion<>y9THENx9:=e0;y9:=dateiversionEND IF;k1(x9);uebersicht(x9,PROCm1);dialogfensterloeschen.f10:zugriff(PROC(EUDAT VAR)k10).g10:markierungenloeschen;dialog(z2).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCe2;PROCq8:IFq9(std)<>0THENlastparam(e0)END IF END PROCq8;PROCh10(TEXT CONSTw1):BOOL VARl10;IFexists(w1)THENp9;m10ELSEfrageobeinrichten(w1);l10:=FALSE END IF;BOOL CONSTn10:=ja(o10,"JA/sortieren");bittewarten;p10;trage(w1,i0,l10);q10;IFn10THEN EUDAT VARn5;oeffne(n5,w1);sortiere(n5)END IF.p9:IFq9(w1)<>0THENerrorstop(r9)END IF.m10:l10:=ja(r10,"JA/testen").p10:IFl10THENforget(j0);j0:=nilspace;i0:=sequentialfile(output,j0);l0:= +dateiversionELSEforget(j0);l0:=dateiversion-1END IF.q10:IFl10CANDlines(i0)>0THENdialog(text(lines(i0))+s10)END IF.END PROCh10;PROCj10(TEXT CONSTw1):IF NOTexists(w1)THENt10(w1,"EDIT/Verarbeite")END IF;x1;FILE VARf:=sequentialfile(input,w1);disablestop;verarbeite(f);y1.END PROCj10;PROCk1(TEXT VARx9):IFja(g8,"JA/Ub.Felder")THENv8(x9,"EUDAS-Anzeigefelder","AUSWAHL/Anzeigefelder")END IF END PROCk1;PROCm1:hilfeanbieten("UEBERSICHT",fensterganz)END PROCm1;PROCi10(TEXT CONSTw1):disablestop;z9:=nilspace;u10(w1);forget(z9)END PROCi10;PROCu10(TEXT CONSTw1):TEXT VARv10:="";FILE VARf;EUDAT VARn5;BOOL VARn10:=FALSE;enablestop;IFexists(w1)THENw10ELSEfrageobeinrichten(w1)END IF;editget(x10,v10,"","GET/kopiermuster");IFexists(v10)THENf:=sequentialfile(input,v10)ELSEy10;stdkopiermuster(w1,f)END IF;modify(f);z10;a11.w10:IFq9(w1)<>0THENerrorstop(r9)END IF;oeffne(n5,w1);IFsortierreihenfolge(n5)<>e0THENn10:=ja(o10,"JA/sortieren")END IF.y10:IFv10=e0THENf:=sequentialfile(output,z9)ELSEfrageobeinrichten(v10);f +:=sequentialfile(output,v10)END IF.z10:edit(f,fensterganz,"EDIT/Kopiermuster",TRUE);x1;kopiere(w1,f).a11:IFn10THENoeffne(n5,w1);sortiere(n5)END IF.END PROCu10;INT PROCq9(TEXT CONSTw1):INT VARp1;FORp1FROM1UPTOanzahldateienREP IFeudasdateiname(p1)=w1THEN LEAVEq9WITHp1END IF END REP;0END PROCq9;PROCt10(TEXT CONSTw1,b11):IF NOTexists(w1)THENfrageobeinrichten(w1)END IF;FILE VARf:=sequentialfile(modify,w1);edit(f,fensterganz,b11,TRUE)END PROCt10;PROCx1:bittewarten;cursor(1,2);out(g0);bildschirmneuEND PROCx1;PROCk10(EUDAT VARn5):TEXT VARc11:=sortierreihenfolge(n5);IFc11=e0CORd11THENe11;bittewarten;sortiere(n5,c11)ELSEbittewarten;sortiere(n5)END IF.d11:ja(l3,"JA/Sortierfelder",FALSE).e11:feldnamenlesen(n5,b7);auswahlanbieten("EUDAS-Sortierfelder",fensterrechts,1024,"AUSWAHL/Sortierfelder",c11,PROC(TEXT VAR,INT CONST)a7);INT VARo6:=1;c11:=e0;WHILEwahl(o6)<>0REPc11CATcode(wahl(o6));f11;o6INCR1END REP.f11:feldlesen(b7,wahl(o6),m0);IFja(textdarstellung(m0)+w9,"JA/Sortierrichtung")THENc11CAT"+"ELSE +c11CAT"-"END IF.END PROCk10;PROCu9(TEXT VARname,INT CONSTn8):IFn8<=anzahlfelderTHENfeldnamenlesen(n8,name)ELSEname:=e0END IF END PROCu9;LETg11= +#1163#"Name Ausgabedatei:",h11= +#1210#"Erzeugte Ausgabe ausdrucken",i11= +#1211#"Erzeugte Ausgabe löschen",j11= +#1212#"Richtung der Druckausgabe:",k11= +#1213#"Form der Liste:",l11= +#1214#"Anzahl Zeichen pro Zeile:",m11= +#1215#"Eingabe ist keine gültige Zahl",o10= +#1164#"Zieldatei anschließend sortieren",r10= +#1165#"Prüfbedingungen testen",s10= +#1166#"Prüffehler festgestellt",r9= +#1167#"Zieldatei darf nicht geöffnet sein",x10= +#1168#"Name Kopiermuster (RET=Std):"; +LETn11= +#1169#" zeilenweise formatieren",o11= +#1170#" seitenweise formatieren"; +LETp11=0,q11=1,r11=2;BOOL VARs11:=FALSE,t11:=FALSE;PROCf2(INT CONSTa2):SELECTa2OF CASE0:a10CASE1:u11CASE2:v11CASE3:w11CASE4:x11CASE5:y11CASE6:z11OTHERWISEc4END SELECT;d4.a10:f4;fussteil(2,"","").u11:ausfuehrung(s1,b0,PROC(TEXT CONST)a12);dialogfensterloeschen.v11:INT VARb12:=1;auswahlanbieten("WAHL.Std-Listen",k11,"WAHL/Std-Listen",b12);c12;d12;e12;f12;x1;druckestandardlisten(b12,g12);h12.c12:TEXT VARg12:=e0;v8(g12,"EUDAS-Druckfelder","AUSWAHL/Druckfelder").d12:.e12:TEXT VARi12:=text(stdlistenbreite);editget(l11,i12,"","GET/listenbreite");INT CONSTj12:=int(i12);IF NOTlastconversionokTHENerrorstop(m11)ELSEstdlistenbreite(j12)END IF.w11:INT VARd5:=druckrichtung+1;auswahlanbieten("WAHL.Richtung",j11,"WAHL/Richtung",d5);druckrichtung(d5-1).x11:ausfuehrung(t4,b0,PROC(TEXT CONST)k12);dialogfensterloeschen.y11:ausfuehrung(t4,b0,PROC(TEXT CONST)print).z11:ausfuehrung(t4,b0,PROC(TEXT CONST)l12);dialogfensterloeschen.c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCf2;PROCy1:IFm12THENclearerror +END IF.m12:iserrorCANDerrormessage=e0.END PROCy1;PROCa12(TEXT CONSTw1):IF NOTexists(w1)THENk12(w1)END IF;f12;x1;disablestop;drucke(w1);h12;y1.END PROCa12;PROCf12:IFdruckrichtung=r11THEN TEXT VARw1:=druckdatei;IFpos(w1,"$")>0THENw1:=e0END IF;editget(g11,w1,"","GET/Druckdatei");IFw1<>e0THENdruckdatei(w1)END IF END IF END PROCf12;PROCh12:IF NOTiserrorCANDdruckrichtung=q11CANDexists(druckdatei)THENenablestop;n12END IF.n12:FILE VARo12:=sequentialfile(input,druckdatei);edit(o12,fensterganz,"EDIT/Druckausgabe",TRUE);IFja(h11,"JA/Ausgabe drucken",FALSE)THENprint(druckdatei)END IF;IFja(i11,"JA/Ausgabe loeschen",FALSE)THENforget(druckdatei,quiet)END IF.END PROCh12;PROCk12(TEXT CONSTw1):t10(w1,"EDIT/Druckmuster")END PROCk12;PROCprint(TEXT CONSTw1):do("print ("+textdarstellung(w1)+")")END PROCprint;PROCl12(TEXT CONSTw1):IFja(textdarstellung(w1)+n11,"JA/zeilenform")THENp12END IF;IFja(textdarstellung(w1)+o11,"JA/seitenform")THENseitenformatierenEND IF.p12:IFs11THENautoform(w1)ELSElineform(w1)END IF; +page;bildschirmneu.seitenformatieren:IFt11THENautopageform(w1)ELSEpageform(w1)END IF;bildschirmneu.END PROCl12;PROCformatierenautomatisch(BOOL CONSTq12,r12):s11:=q12;t11:=r12END PROCformatierenautomatisch;INITFLAG VARs12;TEXT VARt12;LETu12= +#1171#""15"Bereich "14"",v12= +#1172#"Neuer Name:",w12= +#1173#"Zieldatei:",x12= +#1174#"belegt ",y12= +#1175#"KB.",z12= +#1176#" existiert nicht.",a13= +#1177#" in dieser Task löschen"; +PROCdateiverwaltung(INT CONSTa2):enablestop;SELECTa2OF CASE0:a10CASE1:b13CASE2:c13CASE3:d13CASE4:e13CASE5:f13CASE6:g13OTHERWISEc4END SELECT;d4.a10:arbeitsbereichbestimmen;fussteil(2,"","").g13:ausfuehrung(PROC(TEXT CONST)h13).d13:ausfuehrung(PROC(TEXT CONST)i13).c13:ausfuehrung(PROC(TEXT CONST)j13).b13:disablestop;DATASPACE VARk13:=nilspace;FILE VARf:=sequentialfile(output,k13);list(f);IF NOTiserrorTHENedit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);enablestop;l13.e13:ausfuehrung(PROC(TEXT CONST)m13).f13:ausfuehrung(PROC(TEXT CONST)n13).c4:IFa2=-1THENdialogfensterloeschenEND IF.END PROCdateiverwaltung;PROCarbeitsbereichbestimmen:IF NOTinitialized(s12)THENo13END IF;fussteil(1,u12,t12).o13:IFstation(myself)<>0THENt12:=text(station(myself))+"/"""ELSEt12:=""""END IF;t12CATname(myself);t12CAT"""".END PROCarbeitsbereichbestimmen;PROCl13:WHILEgetcharety<>e0REP END REP END PROCl13;PROCh13(TEXT CONSTw1):bittewarten;IFtype(old(w1))=c0THENreorganisiere(w1)ELSEreorganize(w1)END IF +END PROCh13;PROCi13(TEXT CONSTw1):TEXT VARp13:=w1;IFexists(w1)THENeditget(v12,p13,"","GET/rename")END IF;rename(w1,p13)END PROCi13;PROCj13(TEXT CONSTw1):IFq13THENerrorstop(r9)ELIFexists(w1)CANDr13THENforget(w1,quiet)END IF.q13:q9(w1)<>0.r13:ja(textdarstellung(w1)+a13,"JA/forget",FALSE).END PROCj13;PROCm13(TEXT CONSTw1):TEXT VARs13:=e0;editget(w12,s13,"","GET/copy");copy(w1,s13)END PROCm13;PROCn13(TEXT CONSTw1):dialog(textdarstellung(w1));IFexists(w1)THENout(x12);put(storage(old(w1)));out(y12)ELSEout(z12)END IF END PROCn13;TEXT VARt13:=e0,u13:="ARCHIVE";INT VARv13:=0;THESAURUS VARw13;BOOL VARx13,y13:=TRUE;LETz13= +#1182#""15"Ziel "14"",a14= +#1183#"Archiv heisst ",b14= +#1184#"Name des Archivs:",c14= +#1185#"Name Zielarchiv:",d14= +#1186#"Nr. der Zielstation (od. RETURN):",e14= +#1187#"Art des Zielarchivs:",f14= +#1188#"Diskette neu formatieren",g14= +#1189#"Neuer Archivname:",h14= +#1190#" in dieser Task überschreiben",i14= +#1191#" auf Archiv löschen",j14= +#1192#"Archiv ",k14= +#1193#" überschreiben",l14= +#1194#"Diskette eingelegt",m14= +#1195#" auf Archiv überschreiben",n14= +#1196#"Mögliche Diskettenformate: "; +LETo14= +#1197#"Passwort: ",p14= +#1198#"Passwort stimmt nicht mit der ersten Eingabe überein",q14= +#1199#"Passwort zur Kontrolle bitte nochmal eingeben:",r14= +#1200#"Passwort löschen",s14= +#1201#"Unzulässige Stationsnummer",t14= +#1202#"Angegebene Task ist kein Manager"; +ROW4TEXT VARu14;u14(1):="ARCHIVE";u14(2):="PUBLIC";u14(3):="ARCHIVE360";u14(4):="DOS";PROCarchivverwaltung(INT CONSTz1,a2):enablestop;SELECTa2OF CASE0:v14CASE1:w14CASE2:x14CASE3:y14CASE4:z14CASE5:a15CASE6:b15CASE7:c15CASE8:d15CASE9:e15OTHERWISEf15END SELECT;d4.v14:arbeitsbereichbestimmen;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);fussteil(2,z13,g15+u13);x13:=FALSE.z14:IFy13THENh15END IF;bittewarten;w13:=ALLi15;ausfuehrung(PROC(TEXT CONST)j15).y14:disablestop;k15;bittewarten;w13:=ALLi15;IFl15THENw13:=ALLi15END IF;enablestop;aufarchiv(PROC(TEXT CONST)m15,w13).a15:IFy13THENh15END IF;bittewarten;w13:=ALLi15;aufarchiv(PROC(TEXT CONST)a15,w13).w14:k15;disablestop;bittewarten;DATASPACE VARk13:=nilspace;f:=sequentialfile(output,k13);list(f,i15);IFl15THENlist(f,i15)END IF;IF NOTiserrorTHENmodify(f);toline(f,1);writerecord(f,headline(f));headline(f,e0);edit(f,fensterrechts,"SHOW/Uebersicht",FALSE)END IF;forget(k13);l13;enablestop.x14:k15;n15;FILE VARf:=sequentialfile(output,o15);disablestop; +bittewarten;list(f,i15);IFl15THENlist(f,i15)END IF;IFiserrorTHENforget(o15,quiet)END IF;enablestop;modify(f);insertrecord(f);writerecord(f,headline(f));print(o15);forget(o15,quiet).n15:INT VARk2:=0;TEXT VARo15;REPk2INCR1;o15:="Archivliste "+text(k2)UNTIL NOTexists(o15)END REP.b15:k15;IFp15CORq15CANDr15THEN LEAVEb15END IF;BOOL CONSTs15:=ja(f14,"JA/format");t15;u15.p15:NOTja(l14,"JA/eingelegt").q15:reserve("",i15);bittewarten;disablestop;w13:=ALLi15;BOOL CONSTd5:=l15;clearerror;enablestop;d5.r15:NOTja(j14+textdarstellung(t13)+k14,"JA/archiv loeschen").t15:editget(g14,t13,"","GET/Archivname");reserve(t13,i15).u15:IFs15THENv15;w15ELSEx15END IF.x15:bittewarten;disablestop;setcommanddialoguefalse;clear(i15);resetcommanddialogue.v15:INT VARstd:=1;auswahlanbieten("WAHL.Format",n14,"WAHL/format",std);stdDECR1.w15:bittewarten;disablestop;setcommanddialoguefalse;format(std,i15);resetcommanddialogue;enablestop.c15:INT VARy15:=1;IFx13THENrelease(i15);x13:=FALSE END IF;auswahlanbieten("WAHL.Ziel", +e14,"WAHL/zielarchiv",y15);TEXT VARz15:=u14(y15);IFy15>1THENa16END IF;b16;c16;waehlbar(z1,6,y13);waehlbar(z1,9,NOTy13);bildschirmneu;fussteil(2,g15+u13).a16:editget(c14,z15,"","GET/Zielarchiv");IFz15=e0THEN LEAVEc15END IF;u14(y15):=z15.b16:TEXT VARd16:=text(station(myself));IFstation(myself)<>0THENeditget(d14,d16,"","GET/Zielstation")END IF.c16:v13:=int(d16);IF NOTlastconversionokTHENerrorstop(s14)END IF;u13:=z15;y13:=y15=1ORy15=3;r4(i15).g15:IFv13=0THENe0ELSEtext(v13)+"/"END IF.e15:TEXT VARe16:=e0;editget(b14,e16,"","GET/Archivname");reserve(e16,i15);x13:=TRUE.f15:IFa2=-1THEN IFx13THENrelease(i15)END IF;dialogfensterloeschenEND IF.END PROCarchivverwaltung;TASK PROCi15:IFv13=0THENtask(u13)ELSEv13/u13END IF END PROCi15;PROCr4(TASK CONSTf16):INT VARk2;IFstation(f16)=station(myself)THEN FORk2FROM1UPTO5REP IFstatus(f16)=2ORstatus(f16)=6THEN LEAVEr4END IF;pause(10)END REP;errorstop(t14)END IF END PROCr4;PROCh15:TEXT VARg14:=t13;editget(b14,g14,"","GET/Archivname");IF NOTx13ORg14<>t13THEN +reserve(g14,i15);x13:=TRUE END IF;t13:=g14END PROCh15;PROCk15:IF NOTx13ANDy13THENreserve(t13,i15);x13:=TRUE END IF END PROCk15;BOOL PROCl15:IFy13ANDiserrorTHEN TEXT CONSTg16:=errormessage;IFsubtext(g16,1,14)=a14CANDsubtext(g16,16,20)<>"?????"THENclearerror;h16;LEAVEl15WITH TRUE END IF END IF;FALSE.h16:t13:=subtext(g16,16,length(g16)-1);reserve(t13,i15).END PROCl15;PROCj15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORi16THENj16;bittewarten;setcommanddialoguefalse;save(w1,i15);resetcommanddialogueEND IF.i16:ja(textdarstellung(w1)+m14,"JA/save",FALSE).j16:INT CONSTn8:=q9(w1);IFn8>0CANDaendernerlaubtCANDinhaltveraendert(n8)THENeinzelsicherung(n8)END IF.END PROCj15;PROCm15(TEXT CONSTw1):disablestop;IF NOTexists(w1)CORk16THENbittewarten;setcommanddialoguefalse;fetch(w1,i15);resetcommanddialogueEND IF.k16:ja(textdarstellung(w1)+h14,"JA/fetch",FALSE).END PROCm15;PROCa15(TEXT CONSTw1):disablestop;IF NOT(w13CONTAINSw1)CORa15THENbittewarten;setcommanddialoguefalse;erase(w1,i15); +resetcommanddialogueEND IF.a15:ja(textdarstellung(w1)+i14,"JA/erase",FALSE).END PROCa15;PROCd15:BOUND ROW2TEXT VARl16;DATASPACE VARb6:=nilspace;l16:=b6;disablestop;m16(o14,l16(1));IFl16(1)=e0THENn16ELSEo16END IF;forget(b6).n16:IFja(r14,"JA/pw loeschen")THENsetcommanddialoguefalse;enterpassword(e0);resetcommanddialogueEND IF.o16:m16(q14,l16(2));IFl16(1)<>l16(2)THENerrorstop(p14)ELSEsetcommanddialoguefalse;enterpassword(l16(1));resetcommanddialogueEND IF.END PROCd15;PROCm16(TEXT CONSTp16,TEXT VARq16):enablestop;dialog(p16);getsecretline(q16)END PROCm16;SATZ VARb7;PROCa7(TEXT VARr16,INT CONSTs16):IFs16<=256THENfeldlesen(b7,s16,r16)ELSEr16:=e0END IF END PROCa7;PROCfeldnamenanzeigen:IFanzahlfelder>0THENt16;u16;v16END IF.t16:INT VARo6;satzinitialisieren(b7,anzahlfelder);FORo6FROM1UPTOanzahlfelderREPfeldnamenlesen(o6,m0);feldaendern(b7,o6,m0)END REP.u16:auswahlanbieten("EUDAS-Editfelder",fensterrechts,"AUSWAHL/Feldnamen",PROC(TEXT VAR,INT CONST)a7).v16:INT VARs16:=1;WHILEwahl(s16)>0REP IFs16> +1THENtype(f0)END IF;feldnamenlesen(wahl(s16),m0);type("<");type(m0);type(">");s16INCR1END REP.END PROCfeldnamenanzeigen;PROCr1(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,TRUE,w16,PROC(TEXT CONST)s4)END PROCr1;PROCausfuehrung(TEXT CONSTp16,INT CONSTw16,PROC(TEXT CONST)s4):ausfuehrung(p16,FALSE,w16,PROC(TEXT CONST)s4)END PROCausfuehrung;PROCausfuehrung(PROC(TEXT CONST)s4):ausfuehrung(t4,0,PROC(TEXT CONST)s4)END PROCausfuehrung;END PACKETeudassteuerung; + diff --git a/app/eudas/5.3/src/eudas.alt b/app/eudas/5.3/src/eudas.alt new file mode 100644 index 0000000..41ca9b0 --- /dev/null +++ b/app/eudas/5.3/src/eudas.alt @@ -0,0 +1,44 @@ +PACKET eudas alt nach neu + + DEFINES + + eudas alt nach neu : + + +DATASPACE VAR scratch; + +PROC eudas alt nach neu (TEXT CONST datei alt, datei neu) : + + IF exists (datei neu) THEN + errorstop ("Zieldatei existiert bereits") + ELSE + FILE VAR f := sequential file (input, datei alt); + forget (scratch); scratch := nilspace; + BOUND TEXT VAR zeile := scratch; + BOUND SATZ VAR neu := scratch; + zieldatei einrichten; + kopieren; + forget (scratch) + END IF . + +zieldatei einrichten : + getline (f, zeile); + IF (zeile ISUB 1) < 3 OR (zeile ISUB 1) > 256 THEN + errorstop ("Ausgangsdatei ist keine EUDAS-Datei") + END IF; + EUDAT VAR e; + oeffne (e, datei neu); + feldnamen aendern (e, neu) . + +kopieren : + WHILE NOT eof (f) REP + getline (f, zeile); + satz einfuegen (e, neu); + cout (satznr (e)); + weiter (e) + END REP . + +END PROC eudas alt nach neu; + +END PACKET eudas alt nach neu; + diff --git a/app/eudas/5.3/src/eudas.dateien.05 b/app/eudas/5.3/src/eudas.dateien.05 new file mode 100644 index 0000000..b4a57e5 --- /dev/null +++ b/app/eudas/5.3/src/eudas.dateien.05 @@ -0,0 +1,1690 @@ +PACKET eudas dateien + +(*************************************************************************) +(* *) +(* EUDAS-Dateien als indexsequentielle Dateien *) +(* *) +(* Version 05 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 25.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + EUDAT, +(*dump, Test *) + oeffne, + satznr, + dateiende, + saetze, + auf satz, + weiter, + zurueck, + satz lesen, + satz aendern, + satz loeschen, + satz einfuegen, + feld lesen, + feld aendern, + feld bearbeiten, + felderzahl, + feldnamen lesen, + feldnamen aendern, + notizen lesen, + notizen aendern, + feldinfo, + automatischer schluessel, + dezimalkomma, + wert berechnen, + reorganisiere, + sortiere, + sortierreihenfolge, + unsortierte saetze : + + +LET + maxhash = 531, + maxindex = 121, + maxsatz = 5000, + eudat typ = 3243, + maxeintrag = 64, + dreiviertel maxeintrag = 48; + +LET + INTVEC = TEXT, + + INDEX = STRUCT + (INT vorgaenger, nachfolger, + INT eintraege, stelle, + INTVEC satzindex), + + EINTRAG = STRUCT + (INT vorgaenger, nachfolger, indexblock, attribut, + SATZ satz), + + DATEI = STRUCT + (INT felderzahl, + SATZ feldnamen, + INTVEC feldinfo, + TEXT sortierfelder, + INT letzter index, indexblocks, erster leerindex, + INT erster leersatz, anz satzeintraege, + INT anz saetze, satznr, + INT indexzeiger, indexstelle, satzzeiger, + INT anz unsortierte, schluesselzaehler, + ROW 3 TEXT notizen, + ROW maxhash INT hashliste, + ROW maxindex INDEX index, + ROW maxsatz EINTRAG ablage); + +TYPE EUDAT = BOUND DATEI; + +LET + niltext = ""; + +LET + datei ist keine eudas datei = #201# + "Datei ist keine EUDAS-Datei", + inkonsistente datei = #202# + "inkonsistente EUDAS-Datei", + eudas datei voll = #203# + "EUDAS-Datei voll", + nicht erlaubtes dezimalkomma = #204# + "Nicht erlaubtes Dezimalkomma"; + +TEXT VAR + feldpuffer; + +TEXT VAR + inttext := " "; + +INTVEC CONST + blockreservierung := intvec (maxeintrag, 1); + + +(*************************** Test-Dump ***********************************) +(* +PROC dump (EUDAT CONST datei, TEXT CONST file) : + + FILE VAR f := sequential file (output, file); + idump (CONCR (datei), f) + +END PROC dump; + +PROC idump (DATEI CONST datei, FILE VAR f) : + + put (f, "Felderzahl:"); put (f, datei. felderzahl); line (f); + INT VAR i; putline (f, "feldnamen:"); + FOR i FROM 1 UPTO felderzahl (datei. feldnamen) REP + TEXT VAR feld; feld lesen (datei. feldnamen, i, feld); + write (f, feld); write (f, ",") + END REP; line (f); putline (f, "feldinfo:"); + FOR i FROM 1 UPTO length (datei. feldinfo) DIV 2 REP + put (f, datei. feldinfo ISUB i) + END REP; line (f); + put (f, "letzter index:"); put (f, datei. letzter index); + put (f, "indexblocks:"); put (f, datei. indexblocks); + put (f, "erster leerindex:"); put (f, datei. erster leerindex); line (f); + put (f, "erster leersatz:"); put (f, datei. erster leersatz); + put (f, "anz satzeintraege:"); put (f, datei. anz satzeintraege); line (f); + put (f, "anz saetze:"); put (f, datei. anz saetze); + put (f, "satznr:"); put (f, datei.satznr); line (f); + put (f, "indexzeiger:"); put (f, datei. indexzeiger); + put (f, "indexstelle:"); put (f, datei. indexstelle); + put (f, "satzzeiger:"); put (f, datei. satzzeiger); line (f); + put (f, "anz unsortierte:"); put (f, datei. anz unsortierte); line (f); + ROW 10 INT VAR anzahl ketten; + FOR i FROM 1 UPTO 10 REP anzahl ketten (i) := 0 END REP; + FOR i FROM 1 UPTO maxhash REP + INT VAR laenge := 0; + laenge der hashkette bestimmen; + IF laenge > 10 THEN laenge := 10 END IF; + IF laenge > 0 THEN anzahl ketten (laenge) INCR 1 END IF + END REP; + put (f, "Hash:"); + FOR i FROM 1 UPTO 10 REP put (f, anzahl ketten (i)) END REP; line (f); + FOR i FROM 1 UPTO datei. indexblocks REP + put (f, "INDEX"); put (f, i); put (f, "vor:"); put (f, + datei. index (i). vorgaenger); put (f, "nach:"); put (f, + datei. index (i). nachfolger); put (f, "eintraege:"); put (f, + datei. index (i). eintraege); line (f); INT VAR j; + FOR j FROM 1 UPTO length (datei. index (i). satzindex) DIV 2 REP + put (f, datei. index (i). satzindex ISUB j) + END REP; + line (f) + END REP; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + put (f, "SATZ"); put (f,i); put (f, "vor:"); put (f, + datei. ablage (i). vorgaenger); put (f, "nach:"); put (f, + datei. ablage (i). nachfolger); put (f, "index:"); put (f, + datei. ablage (i). indexblock); put (f, "attr:"); put (f, + datei. ablage (i). attribut); line (f); + FOR j FROM 1 UPTO felderzahl (datei. ablage (i). satz) REP + feld lesen (datei. ablage (i). satz, j, feld); + write (f, feld); write (f, ",") + END REP; cout (i); + line (f) + END REP . + +laenge der hashkette bestimmen : + INT VAR index := datei. hashliste (i); + WHILE index <> 0 REP + index := datei. ablage (index). vorgaenger; + laenge INCR 1 + END REP . + +END PROC i dump; +*) + +(**************************** INTVEC *************************************) + +(* An Stelle von maximal dimensionierten ROW max INT werden an ver- *) +(* schiedenen Stellen TEXTe mit eingeschriebenen Integern verwendet. *) +(* Auf diese Art und Weise werden auch das Einfuegen und Loeschen, sowie *) +(* das Aufsplitten und Zusammenfuegen effizienter realisiert. *) + +LET + empty intvec = ""; + +TEXT VAR + buffer; + +INTVEC PROC intvec (INT CONST length, value) : + + replace (inttext, 1, value); + length * inttext + +END PROC intvec; + +PROC insert (INTVEC VAR vector, INT CONST pos, value) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (vector) + 1 THEN + subscript overflow + ELSE + replace (inttext, 1, value); + buffer := subtext (vector, begin); + vector := subtext (vector, 1, begin - 1); + vector CAT inttext; + vector CAT buffer + END IF + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin >= length (vector) THEN + subscript overflow + ELSE + buffer := subtext (vector, begin + 2); + vector := subtext (vector, 1, begin - 1); + vector CAT buffer + END IF + +END PROC delete; + +INT PROC pos (INTVEC CONST vector, INT CONST value) : + + replace (inttext, 1, value); + INT VAR begin := 1; + REP + begin := pos (vector, inttext, begin) + 1 + UNTIL (begin AND 1) = 0 OR begin = 1 END REP; + begin DIV 2 + +END PROC pos; + +PROC split up (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, begin); + source := subtext (source, 1, begin - 1) + END IF + +END PROC split up; + +PROC split down (INTVEC VAR source, dest, INT CONST pos) : + + INT CONST begin := pos + pos - 1; + IF begin < 1 THEN + subscript underflow + ELIF begin > length (source) + 1 THEN + subscript overflow + ELSE + dest := subtext (source, 1, begin - 1); + source := subtext (source, begin) + END IF + +END PROC split down; + +. +subscript overflow : + errorstop (9, niltext) . + +subscript underflow : + errorstop (10, niltext) . + + +(************************** Datei oeffnen ********************************) + +PROC initialisiere eudat (DATEI VAR datei) : + + datei. felderzahl := 0; + datei. feldinfo := empty intvec; + satz initialisieren (datei. feldnamen); + datei. sortierfelder := niltext; + datei. letzter index := 1; + datei. indexblocks := 1; + datei. erster leersatz := 0; + datei. erster leerindex := 0; + datei. anz saetze := 0; + datei. anz satzeintraege := 1; + datei. anz unsortierte := 0; + datei. notizen (1) := niltext; + datei. notizen (2) := niltext; + datei. notizen (3) := niltext; + datei. satznr := 1; + datei. indexzeiger := 1; + datei. indexstelle := 1; + datei. satzzeiger := 1; + datei. index (1). satzindex := blockreservierung; + datei. index (1) := INDEX : (0, 0, 1, 1, intvec(1, 1)); + INT VAR i; + FOR i FROM 1 UPTO maxhash REP + datei. hashliste (i) := 0 + END REP; + datei. ablage (1) := EINTRAG : (0, 0, 1, 0, leersatz) . + +leersatz : + datei. feldnamen . + +END PROC initialisiere eudat; + +PROC oeffne (EUDAT VAR datei, TEXT CONST dateiname) : + + enable stop; + IF NOT exists (dateiname) THEN + CONCR (datei) := new (dateiname); + initialisiere eudat (CONCR (datei)); + type (old (dateiname), eudat typ) + ELIF type (old (dateiname)) = eudat typ THEN + CONCR (datei) := old (dateiname) + ELSE + errorstop (datei ist keine eudas datei) + ENDIF + +END PROC oeffne; + +PROC oeffne (EUDAT VAR datei, DATASPACE CONST ds) : + + IF type (ds) < 0 THEN + CONCR (datei) := ds; + initialisiere eudat (CONCR (datei)); + type (ds, eudat typ) + ELIF type (ds) = eudat typ THEN + CONCR (datei) := ds + ELSE + errorstop (datei ist keine eudas datei) + END IF + +END PROC oeffne; + + +(************************* Feldzugriffe **********************************) + +PROC feld lesen (EUDAT CONST datei, INT CONST feldnr, TEXT VAR inhalt) : + + feld lesen (aktueller satz, feldnr, inhalt) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld lesen; + +PROC feld aendern (EUDAT VAR datei, INT CONST feldnr, + TEXT CONST neuer inhalt) : + + IF nicht hinter letztem satz THEN + aktueller satz unsortiert (CONCR (datei)); + moeglicherweise schluessel aendern; + feld aendern (aktueller satz, feldnr, neuer inhalt) + END IF . + +nicht hinter letztem satz : + datei. satzzeiger <> 1 . + +moeglicherweise schluessel aendern : + IF feldnr = 1 THEN + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer inhalt)) + END IF . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld aendern; + +INT PROC felderzahl (EUDAT CONST datei) : + + datei. felderzahl + +END PROC felderzahl; + +PROC feld bearbeiten (EUDAT CONST datei, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feld bearbeiten (aktueller satz, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC feld bearbeiten; + + +(************************* Feldinformationen *****************************) + +(* Jedes Feld der Datei hat einen Namen und eine Typinformation. Die *) +(* Anzahl der vorhandenen Felder richtet sich nach dem hoechsten ver- *) +(* gebenen Feldnamen. 'feldinfo' kann folgende Werte annehmen : *) +(* -1 : normales Textfeld *) +(* 0 : Textfeld, das nach DIN-Norm verglichen wird *) +(* 1 : Zahlfeld (alle irrelevanten Zeichen werden ignoriert) *) +(* 2 : Datum mit einer Laenge von 8 Zeichen *) +(* Das Feldinfo eines noch nicht eingerichteten Feldes fuehrt zu *) +(* einer Fehlermeldung. *) + +PROC feldnamen lesen (EUDAT CONST datei, SATZ VAR namen) : + + namen := datei. feldnamen + +END PROC feldnamen lesen; + +PROC feldnamen aendern (EUDAT VAR datei, SATZ CONST neue namen) : + + datei. feldnamen := neue namen; + INT CONST neue felder := felderzahl (neue namen); + IF neue felder > datei. felderzahl THEN + feldinfo erweitern; + datei. felderzahl := neue felder + END IF . + +feldinfo erweitern : + datei. feldinfo CAT intvec (fehlende zeilen, - 1) . + +fehlende zeilen : + neue felder - length (datei. feldinfo) DIV 2. + +END PROC feldnamen aendern; + +INT PROC feldinfo (EUDAT CONST datei, INT CONST feldnr) : + + datei. feldinfo ISUB feldnr + +END PROC feldinfo; + +PROC feldinfo (EUDAT VAR datei, INT CONST feldnr, zeilen) : + + replace (datei. feldinfo, feldnr, zeilen); + IF pos (datei. sortierfelder, code (feldnr)) > 0 THEN + datei. anz unsortierte := datei. anz saetze + END IF + +END PROC feldinfo; + + +(*************************** Positionsabfragen ***************************) + +INT PROC satznr (EUDAT CONST datei) : + + datei. satznr + +END PROC satznr; + +BOOL PROC dateiende (EUDAT CONST datei) : + + datei. satznr > datei. anz saetze + +END PROC dateiende; + +INT PROC saetze (EUDAT CONST datei) : + + datei. anz saetze + +END PROC saetze; + + +(***************************** Positionieren *****************************) + +(* Positioniert werden kann nach der Satznummer oder nach dem ersten *) +(* Feld. Das erste Feld kann durch eine Hashtabelle schnell gefunden *) +(* werden. In der Hashtabelle sind die Saetze nach absoluten Positionen *) +(* eingetragen und nicht nach Satznummern. Ueber den Rueckverweis auf *) +(* den Indexblock kann die Satznummer zu einem gegebenen Satz gefunden *) +(* werden. *) + +PROC neue satzposition (DATEI VAR datei, INT CONST indexzeiger, stelle, + satznr) : + + IF indexzeiger < 1 OR indexzeiger > datei. indexblocks COR + stelle < 1 OR stelle > datei. index (indexzeiger). eintraege THEN + errorstop (inkonsistente datei) + END IF; + disable stop; + datei. indexzeiger := indexzeiger; + datei. indexstelle := stelle; + datei. satznr := satznr; + datei. satzzeiger := datei. index (indexzeiger). satzindex ISUB stelle + +END PROC neue satzposition; + +PROC auf satz (EUDAT VAR datei, INT CONST nr) : + + INT VAR satznr; + IF nr < 1 THEN + satznr := 1 + ELIF nr > datei. anz saetze THEN + satznr := datei. anz saetze + 1 + ELSE + satznr := nr + END IF; + auf satz intern (CONCR (datei), satznr) + +END PROC auf satz; + +PROC auf satz (EUDAT VAR datei, TEXT CONST muster) : + + auf satz (datei, 1); + IF nicht auf erstem satz THEN + weiter (datei, muster) + END IF . + +nicht auf erstem satz : + feld lesen (datei, 1, feldpuffer); + feldpuffer <> muster . + +END PROC auf satz; + +PROC auf satz intern (DATEI VAR datei, INT CONST satznr) : + + IF von anfang naeher THEN + neue satzposition (datei, 1, 1, 1) + END IF; + INT VAR + indexzeiger := datei. indexzeiger, + erreichter satz := datei. satznr - datei. indexstelle; + IF satznr > datei. satznr THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF; + neue satzposition (datei, indexzeiger, stelle, satznr) . + +von anfang naeher : + satznr + satznr < datei. satznr . + +vorwaerts gehen : + WHILE noch vor satz REP + erreichter satz INCR eintraege; + indexzeiger := datei. index (indexzeiger). nachfolger + END REP . + +noch vor satz : + INT CONST eintraege := datei. index (indexzeiger). eintraege; + erreichter satz + eintraege < satznr . + +rueckwaerts gehen : + WHILE noch hinter satz REP + indexzeiger := datei. index (indexzeiger). vorgaenger; + erreichter satz DECR datei. index (indexzeiger). eintraege + END REP . + +noch hinter satz : + erreichter satz >= satznr . + +stelle : + satznr - erreichter satz . + +END PROC auf satz intern; + +PROC weiter (EUDAT VAR datei) : + + weiter intern (CONCR (datei)) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei) : + + IF nicht dateiende THEN + naechster satz + END IF . + +nicht dateiende : + datei. satzzeiger <> 1 . + +naechster satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = index. eintraege THEN + indexzeiger := index. nachfolger; + stelle := 1 + ELSE + stelle INCR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr + 1) . + +index : + datei. index (indexzeiger) . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei) : + + zurueck intern (CONCR (datei)) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei) : + + IF nicht am anfang THEN + voriger satz + END IF . + +nicht am anfang : + datei. satznr <> 1 . + +voriger satz : + INT VAR + indexzeiger := datei. indexzeiger, + stelle := datei. indexstelle; + + IF stelle = 1 THEN + indexzeiger := indexblock. vorgaenger; + stelle := indexblock. eintraege + ELSE + stelle DECR 1 + END IF; + neue satzposition (datei, indexzeiger, stelle, datei. satznr - 1) . + +indexblock : + datei. index (indexzeiger) . + +END PROC zurueck intern; + +PROC weiter (EUDAT VAR datei, TEXT CONST muster) : + + weiter intern (CONCR (datei), muster) + +END PROC weiter; + +PROC weiter intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle weiter + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, datei. anz saetze + 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR dummy, stelle := datei. satzzeiger; + IF muster nicht gefunden THEN + stelle in hashkette (datei, hashindex (muster), stelle, dummy) + ELSE + eine stelle weiter + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle weiter : + stelle := datei. ablage (stelle). nachfolger . + +END PROC weiter intern; + +PROC zurueck (EUDAT VAR datei, TEXT CONST muster) : + + zurueck intern (CONCR (datei), muster) + +END PROC zurueck; + +PROC zurueck intern (DATEI VAR datei, TEXT CONST muster) : + + stelle in hashkette bestimmen; + WHILE noch weitere saetze CAND muster nicht gefunden REP + eine stelle zurueck + END REP; + IF noch weitere saetze THEN + positioniere intern (datei, stelle) + ELSE + auf satz intern (datei, 1) + END IF . + +stelle in hashkette bestimmen : + INT VAR stelle := datei. satzzeiger, dummy; + IF stelle = 1 OR schluessel stimmt nicht ueberein THEN + stelle in hashkette (datei, hashindex (muster), dummy, stelle) + END IF . + +noch weitere saetze : + stelle <> 0 . + +muster nicht gefunden : + stelle = datei. satzzeiger OR schluessel stimmt nicht ueberein . + +schluessel stimmt nicht ueberein : + feld lesen (aktueller satz, 1, feldpuffer); + feldpuffer <> muster . + +aktueller satz : + datei. ablage (stelle). satz . + +eine stelle zurueck : + stelle := datei. ablage (stelle). vorgaenger . + +END PROC zurueck intern; + +PROC positioniere intern (DATEI VAR datei, INT CONST stelle) : + + INT CONST zielblock := datei. ablage (stelle). indexblock; + INT VAR + indexstelle := 1, + satznr := 0; + WHILE indexstelle <> zielblock REP + satznr INCR datei. index (indexstelle). eintraege; + indexstelle := datei. index (indexstelle). nachfolger + END REP; + indexstelle := pos (datei. index (zielblock). satzindex, stelle); + satznr INCR indexstelle; + neue satzposition (datei, zielblock, indexstelle, satznr) . + +END PROC positioniere intern; + + +(************************* Hashverwaltung ********************************) + +INT VAR index; + +PROC hashindex berechnen (TEXT CONST feld, INT CONST von, bis) : + + INT VAR + zeiger := von; + index := 0; + IF bis - von < 4 THEN + mit faktor 4 streuen + ELSE + mit faktor 2 streuen + END IF; + index := index MOD maxhash + 1 . + +mit faktor 4 streuen : + WHILE zeiger <= bis REP + index := index * 4; + index INCR code (feld SUB zeiger); + zeiger INCR 1 + END REP . + +mit faktor 2 streuen : + WHILE zeiger <= bis REP + index INCR index; + index INCR code (feld SUB zeiger); + IF index > 16000 THEN index := index MOD maxhash END IF; + zeiger INCR 1 + END REP . + +END PROC hashindex berechnen; + +INT PROC hashindex (TEXT CONST feld) : + + hashindex berechnen (feld, 1, length (feld)); + index + +END PROC hashindex; + +INT PROC hashindex (SATZ CONST satz) : + + feld bearbeiten (satz, 1, + PROC (TEXT CONST, INT CONST, INT CONST) hashindex berechnen); + index + +END PROC hashindex; + +PROC stelle in hashkette (DATEI CONST datei, INT CONST hashindex, + INT VAR stelle, vorher) : + + INT VAR indexzeiger := datei. letzter index; + vorher := datei. hashliste (hashindex); + stelle := 0; + BOOL VAR hinter aktuellem satz := TRUE; + WHILE hinter aktuellem satz AND vorher <> 0 REP + stelle untersuchen; + eine stelle weiter + END REP . + +stelle untersuchen : + IF verweis auf aktuellen block THEN + ueberpruefe innerhalb block + ELSE + teste ob aktueller block in indexkette + END IF . + +verweis auf aktuellen block : + datei. ablage (vorher). indexblock = datei. indexzeiger . + +ueberpruefe innerhalb block : + indexzeiger := datei. indexzeiger; + INT CONST stelle in block := pos (satzindex, vorher); + IF stelle in block = 0 THEN + errorstop (inkonsistente datei) + ELIF stelle in block <= aktuelle stelle THEN + hinter aktuellem satz := FALSE + END IF . + +satzindex : + datei. index (indexzeiger). satzindex . + +aktuelle stelle : + datei. indexstelle . + +teste ob aktueller block in indexkette : + WHILE indexzeiger <> datei. ablage (vorher). indexblock REP + IF indexzeiger = datei. indexzeiger THEN + hinter aktuellem satz := FALSE; + LEAVE stelle untersuchen + ELSE + indexzeiger := datei. index (indexzeiger). vorgaenger + END IF + END REP . + +eine stelle weiter : + IF hinter aktuellem satz THEN + stelle := vorher; + vorher := datei. ablage (stelle). vorgaenger + END IF . + +END PROC stelle in hashkette; + +PROC hash ausketten (DATEI VAR datei, INT CONST hashindex) : + + disable stop; + INT CONST + stelle := datei. satzzeiger, + vorgaenger := datei. ablage (stelle). vorgaenger, + nachfolger := datei. ablage (stelle). nachfolger; + + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := vorgaenger + ELSE + datei. hashliste (hashindex) := vorgaenger + END IF; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := nachfolger + END IF . + +END PROC hash ausketten; + +PROC hash einketten (DATEI VAR datei, INT CONST hashindex, + nachfolger, vorgaenger) : + + disable stop; + INT CONST stelle := datei. satzzeiger; + datei. ablage (stelle). vorgaenger := vorgaenger; + datei. ablage (stelle). nachfolger := nachfolger; + IF vorgaenger <> 0 THEN + datei. ablage (vorgaenger). nachfolger := stelle + END IF; + IF nachfolger <> 0 THEN + datei. ablage (nachfolger). vorgaenger := stelle + ELSE + datei. hashliste (hashindex) := stelle + END IF + +END PROC hash einketten; + + +(************************** Satzzugriffe *********************************) + +PROC satz lesen (EUDAT CONST datei, SATZ VAR satz) : + + satz := datei. ablage (datei. satzzeiger). satz + +END PROC satz lesen; + +PROC satz aendern (EUDAT VAR datei, SATZ CONST neuer satz) : + + IF NOT dateiende (datei) THEN + satz wirklich aendern + END IF . + +satz wirklich aendern : + aktueller satz unsortiert (CONCR (datei)); + disable stop; + schluessel aendern (CONCR (datei), hashindex (neuer satz)); + aktueller satz := neuer satz . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC satz aendern; + +PROC schluessel aendern (DATEI VAR datei, INT CONST neuer hashindex) : + + IF anderer hashindex THEN + in neue hashkette + END IF . + +anderer hashindex : + INT CONST alter hashindex := hashindex (aktueller satz); + alter hashindex <> neuer hashindex . + +in neue hashkette : + in alter kette ausketten; + in neuer kette einketten . + +in alter kette ausketten : + hash ausketten (datei, alter hashindex) . + +in neuer kette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, neuer hashindex, vorgaenger, nachfolger); + hash einketten (datei, neuer hashindex, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (datei. satzzeiger). satz . + +END PROC schluessel aendern; + +PROC satz loeschen (EUDAT VAR datei) : + + IF NOT dateiende (datei) THEN + satz wirklich loeschen + END IF . + +satz wirklich loeschen : + disable stop; + satzeintrag loeschen (CONCR (datei)); + indexeintrag loeschen (CONCR (datei)); + datei. anz saetze DECR 1 . + +END PROC satz loeschen; + +PROC satzeintrag loeschen (DATEI VAR datei) : + + aktueller satz sortiert (datei); + INT CONST stelle := datei. satzzeiger; + hash ausketten (datei, hashindex (aktueller satz)); + datei. ablage (stelle). nachfolger := datei. erster leersatz; + datei. erster leersatz := stelle . + +aktueller satz : + datei. ablage (stelle). satz . + +END PROC satzeintrag loeschen; + +PROC satz einfuegen (EUDAT VAR datei, SATZ CONST neuer satz) : + + satz einfuegen intern (CONCR (datei), neuer satz) + +END PROC satz einfuegen; + +PROC satz einfuegen intern (DATEI VAR datei, SATZ CONST neuer satz) : + + INT VAR + stelle, + vorgaenger, + nachfolger; + + enable stop; + satzeintrag belegen; + ggf schluessel einfuegen; + disable stop; + datei. anz saetze INCR 1; + indexeintrag einfuegen (datei, stelle); + INT CONST neuer index := hashindex (feldpuffer); + stelle in hashkette (datei, neuer index, nachfolger, vorgaenger); + hash einketten (datei, neuer index, nachfolger, vorgaenger); + aktueller satz unsortiert (datei) . + +satzeintrag belegen : + IF datei. erster leersatz <> 0 THEN + stelle := datei. erster leersatz; + datei. erster leersatz := datei. ablage (stelle). nachfolger + ELIF datei. anz satzeintraege = maxsatz THEN + errorstop (eudas datei voll) + ELSE + datei. anz satzeintraege INCR 1; + stelle := datei. anz satzeintraege + END IF; + datei. ablage (stelle). attribut := 0; + datei. ablage (stelle). satz := neuer satz . + +ggf schluessel einfuegen : + feld lesen (neuer satz, 1, feldpuffer); + IF datei. schluesselzaehler > 0 THEN + IF feldpuffer = "" THEN + neuen schluessel erzeugen; + feld aendern (datei. ablage (stelle). satz, 1, feldpuffer) + END IF + END IF . + +neuen schluessel erzeugen : + feldpuffer := text (datei. schluesselzaehler); + feldpuffer := fuehrende nullen + feldpuffer; + IF datei. schluesselzaehler > 32000 THEN + datei. schluesselzaehler := 1 + ELSE + datei. schluesselzaehler INCR 1 + END IF . + +fuehrende nullen : + (4 - length (feldpuffer)) * "0" . + +END PROC satz einfuegen intern; + +PROC automatischer schluessel (EUDAT VAR eudat, BOOL CONST automatisch) : + + IF automatisch AND eudat. schluesselzaehler < 0 OR + NOT automatisch AND eudat. schluesselzaehler > 0 THEN + eudat. schluesselzaehler := - eudat. schluesselzaehler + END IF + +END PROC automatischer schluessel; + +BOOL PROC automatischer schluessel (EUDAT CONST eudat) : + + eudat. schluesselzaehler > 0 + +END PROC automatischer schluessel; + + +(************************* Indexverwaltung *******************************) + +(* Die logische Reihenfolge der Saetze wird durch einen Index herge- *) +(* stellt. Dieser besteht aus einer Liste von INTVECs. Ein Listenelement *) +(* nimmt Satzeintraege auf, bis die Maximalgroesse erreicht ist. In *) +(* diesem Fall wird ein neues Listenelement eingefuegt. Beim Loeschen *) +(* von Eintraegen wird ueberprueft, ob zwei benachbarte Eintraege kom- *) +(* biniert werden koennen. Steht fuer eine Anforderung kein Eintrag mehr *) +(* zur Verfuegung, wird der ganze Index reorganisiert. Es ist garantiert,*) +(* dass der Index die maximale Anzahl von Satzeintraegen aufnehmen kann. *) + +INTVEC VAR indexpuffer; + + +PROC indexeintrag loeschen (DATEI VAR datei) : + + INT CONST + indexzeiger := datei. indexzeiger, + vorgaenger := index. vorgaenger, + nachfolger := index. nachfolger; + BOOL VAR moeglich; + delete (index. satzindex, datei. indexstelle); + index. eintraege DECR 1; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich); + IF NOT moeglich THEN + indizes zusammenlegen (datei, vorgaenger, indexzeiger, moeglich) + END IF; + indexzeiger justieren (datei) . + +index : + datei. index (indexzeiger) . + +END PROC indexeintrag loeschen; + +PROC indizes zusammenlegen (DATEI VAR datei, INT CONST zeiger, folgezeiger, + BOOL VAR moeglich) : + + moeglich := FALSE; + IF zeiger <> 0 AND folgezeiger <> 0 THEN + versuche zusammenzulegen + END IF . + +versuche zusammenzulegen : + INT CONST + eintraege a := index. eintraege, + eintraege b := folgeindex. eintraege; + IF zusammenlegbar THEN + wirklich zusammenlegen; + moeglich := TRUE + END IF . + +zusammenlegbar: + eintraege a + eintraege b <= dreiviertel maxeintrag OR + eintraege a = 0 OR eintraege b = 0 . + +wirklich zusammenlegen : + index. eintraege INCR folgeindex. eintraege; + indexverweise aendern (datei, folgeindex. satzindex, zeiger); + index. satzindex CAT folgeindex. satzindex; + folgeindex ausketten . + +folgeindex ausketten : + index. nachfolger := folgeindex. nachfolger; + IF index. nachfolger <> 0 THEN + datei. index (index. nachfolger). vorgaenger := zeiger + ELSE + datei. letzter index := zeiger + END IF; + folgeindex. nachfolger := datei. erster leerindex; + datei. erster leerindex := folgezeiger . + +index : + datei. index (zeiger) . + +folgeindex : + datei. index (folgezeiger) . + +END PROC indizes zusammenlegen; + +PROC indexzeiger justieren (DATEI VAR datei) : + + INT CONST aktueller satz := datei. satznr; + neue satzposition (datei, 1, 1, 1); + auf satz intern (datei, aktueller satz) + +END PROC indexzeiger justieren; + +PROC indexverweise aendern (DATEI VAR datei, INTVEC CONST satzindex, + INT CONST zeiger) : + + INT VAR i; + FOR i FROM 1 UPTO length (satzindex) DIV 2 REP + datei. ablage (satzindex ISUB i). indexblock := zeiger + END REP + +END PROC indexverweise aendern; + +PROC indexeintrag einfuegen (DATEI VAR datei, INT CONST eintrag) : + + INT VAR indexzeiger := datei. indexzeiger; + IF index. eintraege >= maxeintrag THEN + platz schaffen + END IF; + index. eintraege INCR 1; + insert (index. satzindex, datei. indexstelle, eintrag); + datei. satzzeiger := eintrag; + datei. ablage (eintrag). indexblock := indexzeiger . + +platz schaffen : + INT VAR neuer index := 0; + neuen indexblock besorgen; + IF neuer index <> 0 THEN + index aufsplitten + ELSE + index reorganisieren (datei) + END IF; + indexzeiger justieren (datei); + indexzeiger := datei. indexzeiger . + +neuen indexblock besorgen : + IF datei. erster leerindex <> 0 THEN + neuer index := datei. erster leerindex; + datei. erster leerindex := folgeindex. nachfolger + ELIF datei. indexblocks < maxindex THEN + datei. indexblocks INCR 1; + neuer index := datei. indexblocks; + folgeindex. satzindex := blockreservierung + END IF . + +index aufsplitten : + neuen block einketten; + splitpunkt bestimmen; + folgeindex. eintraege := index. eintraege - halbe eintraege; + split up (index. satzindex, folgeindex. satzindex, halbe eintraege + 1); + index. eintraege := halbe eintraege; + indexverweise aendern (datei, folgeindex. satzindex, neuer index) . + +neuen block einketten : + INT CONST alter nachfolger := index. nachfolger; + IF alter nachfolger <> 0 THEN + datei. index (alter nachfolger). vorgaenger := neuer index + ELSE + datei. letzter index := neuer index + END IF; + folgeindex. nachfolger := alter nachfolger; + folgeindex. vorgaenger := indexzeiger; + index. nachfolger := neuer index . + +splitpunkt bestimmen : + INT VAR halbe eintraege; + IF letzter block THEN + halbe eintraege := dreiviertel maxeintrag + ELSE + halbe eintraege := index. eintraege DIV 2 + 1 + END IF . + +letzter block : + alter nachfolger = 0 . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (neuer index) . + +END PROC indexeintrag einfuegen; + +PROC index reorganisieren (DATEI VAR datei) : + + INT VAR indexzeiger := 1; + REP + index auffuellen; + zum naechsten index + END REP . + +index auffuellen : + BOOL VAR moeglich; + REP + INT CONST nachfolger := index. nachfolger; + indizes zusammenlegen (datei, indexzeiger, nachfolger, moeglich) + UNTIL NOT moeglich END REP; + IF nachfolger = 0 THEN + LEAVE index reorganisieren + ELIF noch platz THEN + rest auffuellen + END IF . + +noch platz : + INT CONST platz := dreiviertel maxeintrag - index. eintraege; + platz > 0 . + +rest auffuellen : + split down (folgeindex. satzindex, indexpuffer, platz + 1); + folgeindex. eintraege DECR platz; + indexverweise aendern (datei, indexpuffer, indexzeiger); + index. satzindex CAT indexpuffer; + index. eintraege := dreiviertel maxeintrag . + +zum naechsten index : + indexzeiger := nachfolger . + +index : + datei. index (indexzeiger) . + +folgeindex : + datei. index (nachfolger) . + +END PROC index reorganisieren; + + +(************************* Sortierabfragen *******************************) + +TEXT VAR dez komma := ","; + +LET + sortmask = 1; + +TEXT PROC dezimalkomma : + + dez komma + +END PROC dezimalkomma; + +PROC dezimalkomma (TEXT CONST neues komma) : + + IF length (neues komma) <> 1 THEN + errorstop (nicht erlaubtes dezimalkomma) + ELSE + dez komma := neues komma + ENDIF + +END PROC dezimalkomma; + +INT PROC unsortierte saetze (EUDAT CONST datei) : + + datei. anz unsortierte + +END PROC unsortierte saetze; + +TEXT PROC sortierreihenfolge (EUDAT CONST datei) : + + datei. sortierfelder + +END PROC sortierreihenfolge; + +PROC aktueller satz unsortiert (DATEI VAR datei) : + + IF sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut INCR sortmask; + datei. anz unsortierte INCR 1 + END IF + +END PROC aktueller satz unsortiert; + +PROC aktueller satz sortiert (DATEI VAR datei) : + + IF NOT sortiert (datei) THEN + disable stop; + datei. ablage (datei. satzzeiger). attribut DECR sortmask; + datei. anz unsortierte DECR 1 + END IF + +END PROC aktueller satz sortiert; + +BOOL PROC sortiert (DATEI CONST datei, INT CONST stelle) : + + (datei. ablage (stelle). attribut AND sortmask) = 0 + +END PROC sortiert; + +BOOL PROC sortiert (DATEI CONST datei) : + + sortiert (datei, datei. satzzeiger) + +END PROC sortiert; + + +(************************* Sortieren *************************************) + +(* Eine Datei kann in einer beliebigen Feldreihenfolge sortiert werden. *) +(* Dabei wird das Feldinfo beachtet. Wurden seit der letzten Sortierung *) +(* nur wenige Saetze geaendert (deren Plaetze in 'unsortierte' gespei- *) +(* chert sind), werden nur diese Saetze einsortiert. *) + +INTVEC VAR sortierinfo; + +TEXT VAR sortierfelder; + +TEXT VAR l, r; + + +PROC sortiere (EUDAT VAR datei) : + + sortierfelder := datei. sortierfelder; + IF sortierfelder = niltext THEN + standardbelegung + END IF; + sortiere intern (CONCR (datei)) . + +standardbelegung : + INT VAR i; + FOR i FROM 1 UPTO datei. felderzahl REP + sortierfelder CAT code (i) + END REP . + +END PROC sortiere; + +PROC sortiere (EUDAT VAR datei, TEXT CONST felder) : + + sortierfelder := felder; + sortiere intern (CONCR (datei)) + +END PROC sortiere; + +PROC sortiere intern (DATEI VAR datei) : + + IF datei. sortierfelder <> sortierfelder THEN + datei. sortierfelder := sortierfelder; + datei. anz unsortierte := datei. anz saetze + 1 + ELIF datei. anz unsortierte = 0 THEN + LEAVE sortiere intern + END IF; + sortierinfo := datei. feldinfo; + IF mehr als ein drittel THEN + komplett sortieren (datei); + datei. anz unsortierte := 0 + ELSE + einzeln sortieren (datei) + END IF; + auf satz intern (datei, 1) . + +mehr als ein drittel : + datei. anz saetze DIV datei. anz unsortierte < 3 . + +END PROC sortiere intern; + +PROC komplett sortieren (DATEI VAR datei) : + + INT VAR + satzzeiger, + satz := 1, + satz vorher; + + auf satz intern (datei, 1); + aktueller satz sortiert (datei); + satzzeiger := datei. satzzeiger; + WHILE noch satz vorhanden REP + zum naechsten satz; + satz richtig einsortieren; + cout (satz) + END REP; + disable stop; + index reorganisieren (datei); + neue satzposition (datei, 1, 1, 1) . + +noch satz vorhanden : + satz < datei. anz saetze . + +zum naechsten satz : + satz INCR 1; + auf satz intern (datei, satz); + satz vorher := satzzeiger; + satzzeiger := datei. satzzeiger . + +satz richtig einsortieren : + IF satz kleiner als vorgaenger THEN + satz einsortieren (datei, satz, satzzeiger); + satzzeiger := satz vorher + ELSE + aktueller satz sortiert (datei) + END IF . + +satz kleiner als vorgaenger : + datei. ablage (satz vorher). satz GROESSER + datei. ablage (satzzeiger). satz . + +END PROC komplett sortieren; + +PROC einzeln sortieren (DATEI VAR datei) : + + INT VAR i; + FOR i FROM 1 UPTO datei. anz satzeintraege REP + IF NOT sortiert (datei, i) THEN + satz einsortieren (datei, datei. anz saetze + 1, i); + cout (i) + END IF + END REP + +END PROC einzeln sortieren; + +PROC satz einsortieren (DATEI VAR datei, INT CONST satznr, satzzeiger) : + + stelle suchen; + an dieser stelle einfuegen . + +stelle suchen : + INT VAR + anfang := 1, + ende := satznr - 1, + mitte; + WHILE stelle nicht gefunden REP + intervall in der mitte halbieren; + teilintervall auswaehlen + END REP . + +stelle nicht gefunden : + anfang <= ende . + +intervall in der mitte halbieren : + mitte := (anfang + ende) DIV 2; + INT VAR vergleichssatz; + auf satz intern (datei, mitte); + IF NOT sortiert (datei) THEN + passenden vergleichssatz suchen + END IF; + vergleichssatz := datei. satzzeiger . + +passenden vergleichssatz suchen : + WHILE datei. satznr < ende REP + weiter intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + WHILE datei. satznr > anfang REP + zurueck intern (datei); + IF satz richtig THEN LEAVE passenden vergleichssatz suchen END IF + END REP; + LEAVE stelle suchen . + +satz richtig : + sortiert (datei) . + +teilintervall auswaehlen : + IF zu vergleichender satz GROESSER datei. ablage (satzzeiger). satz THEN + ende := mitte - 1 + ELSE + anfang := mitte + 1 + END IF . + +zu vergleichender satz : + datei. ablage (vergleichssatz). satz . + +an dieser stelle einfuegen : + positioniere intern (datei, satzzeiger); + IF datei. satznr < anfang THEN anfang DECR 1 END IF; + disable stop; + aktueller satz sortiert (datei); + in hashkette ausketten; + indexeintrag loeschen (datei); + auf satz intern (datei, anfang); + indexeintrag einfuegen (datei, satzzeiger); + in hashkette einketten . + +in hashkette ausketten : + INT CONST h index := hashindex (aktueller satz); + hash ausketten (datei, h index) . + +in hashkette einketten : + INT VAR vorgaenger, nachfolger; + stelle in hashkette (datei, h index, vorgaenger, nachfolger); + hash einketten (datei, h index, vorgaenger, nachfolger) . + +aktueller satz : + datei. ablage (satzzeiger). satz . + +END PROC satz einsortieren; + +BOOL OP GROESSER (SATZ CONST links, rechts) : + + ungleiches feld suchen; + sortierrichtung feststellen; + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din vergleich + CASE 1 : zahl vergleich + CASE 2 : datum vergleich + OTHERWISE text vergleich + END SELECT . + +ungleiches feld suchen : + INT VAR nr zeiger := 1; + WHILE nr zeiger < length (sortierfelder) REP + INT CONST vergleichsfeld := code (sortierfelder SUB nr zeiger); + feld lesen (links, vergleichsfeld, l); + feld lesen (rechts, vergleichsfeld, r); + SELECT sortierinfo ISUB vergleichsfeld OF + CASE 0 : din gleich + CASE 1 : zahl gleich + OTHERWISE text gleich + END SELECT; + nr zeiger INCR 2 + END REP; + LEAVE GROESSER WITH FALSE . + +sortierrichtung feststellen : + BOOL VAR aufsteigend; + IF (sortierfelder SUB (nr zeiger + 1)) = "-" THEN + aufsteigend := FALSE + ELSE + aufsteigend := TRUE + END IF . + +zahl gleich : + REAL VAR l wert, r wert; + wert berechnen (l, l wert); + wert berechnen (r, r wert); + IF l wert <> r wert THEN + LEAVE ungleiches feld suchen + END IF . + +din gleich : + IF NOT (l LEXEQUAL r) THEN + LEAVE ungleiches feld suchen + END IF . + +text gleich : + IF l <> r THEN + LEAVE ungleiches feld suchen + END IF . + +zahl vergleich : + IF aufsteigend THEN + l wert > r wert + ELSE + l wert < r wert + END IF . + +din vergleich : + IF aufsteigend THEN + l LEXGREATER r + ELSE + r LEXGREATER l + END IF . + +datum vergleich : + datum umdrehen (l); + datum umdrehen (r); + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +textvergleich : + IF aufsteigend THEN + l > r + ELSE + l < r + END IF . + +END OP GROESSER; + +PROC wert berechnen (TEXT CONST zahl, REAL VAR wert) : + + LET ziffern = "0123456789"; + TEXT VAR komma := dez komma, text; + INT VAR stelle; + INT CONST laenge := length (zahl); + anfang bestimmen; + WHILE stelle <= laenge REP + zeichen untersuchen; + stelle INCR 1 + END REP; + wert := real (text) . + +anfang bestimmen : + stelle := pos (zahl, "0", "9", 1); + IF stelle = 0 THEN + wert := 0.0; LEAVE wert berechnen + ELIF pos (zahl, "-", 1, stelle) > 0 THEN + text := "-" + ELSE + text := niltext + END IF; . + +zeichen untersuchen: + TEXT CONST char := zahl SUB stelle; + IF pos (ziffern, char) > 0 THEN + text CAT char + ELIF char = komma THEN + text CAT "."; komma := niltext + END IF . + +END PROC wert berechnen; + +PROC datum umdrehen (TEXT VAR datum) : + + IF length (datum) <> 8 THEN + datum := niltext + ELSE + datum := subtext (datum, 7) + subtext (datum, 4, 5) + + subtext (datum, 1, 2) + END IF + +END PROC datum umdrehen; + + +(**************************** Reorganisieren *****************************) + +PROC reorganisiere (TEXT CONST dateiname) : + + EUDAT VAR datei 1, datei 2; + oeffne (datei 1, dateiname); + disable stop; + DATASPACE VAR ds := nilspace; + oeffne (datei 2, ds); + kopiere eudat (CONCR (datei 1), datei 2); + IF NOT is error THEN + forget (dateiname, quiet); + copy (ds, dateiname) + END IF; + forget (ds) + +END PROC reorganisiere; + +PROC kopiere eudat (DATEI VAR datei 1, EUDAT VAR datei 2) : + + enable stop; + kopiere saetze; + kopiere interna (datei 1, CONCR (datei 2)) . + +kopiere saetze : + auf satz intern (datei 1, 1); + auf satz (datei 2, 1); + WHILE NOT dateiende REP + satz einfuegen (datei 2, kopiersatz); + cout (datei 1. satznr); + weiter intern (datei 1); + weiter (datei 2) + END REP . + +dateiende : + datei 1. satznr > datei 1. anz saetze . + +kopiersatz : + datei 1. ablage (datei 1. satzzeiger). satz . + +END PROC kopiere eudat; + +PROC kopiere interna (DATEI VAR datei 1, datei 2) : + + datei 2. felderzahl := datei 1. felderzahl; + datei 2. feldnamen := datei 1. feldnamen; + datei 2. feldinfo := datei 1. feldinfo; + datei 2. sortierfelder := datei 1. sortierfelder; + datei 2. notizen (1) := datei 1. notizen (1); + datei 2. notizen (2) := datei 1. notizen (2); + datei 2. notizen (3) := datei 1. notizen (3) + +END PROC kopiere interna; + + +(************************* Notizen ***************************************) + +PROC notizen lesen (EUDAT CONST datei, INT CONST nr, TEXT VAR notiztext) : + + notiztext := datei. notizen (nr) + +END PROC notizen lesen; + +PROC notizen aendern (EUDAT VAR datei, INT CONST nr, TEXT CONST notiztext) : + + datei. notizen (nr) := notiztext + +END PROC notizen aendern; + +END PACKET eudas dateien; + diff --git a/app/eudas/5.3/src/eudas.dialoghilfen.04 b/app/eudas/5.3/src/eudas.dialoghilfen.04 new file mode 100644 index 0000000..b204978 --- /dev/null +++ b/app/eudas/5.3/src/eudas.dialoghilfen.04 @@ -0,0 +1,435 @@ +PACKET eudas dialoghilfen + +(*************************************************************************) +(* *) +(* Dialoghilfen für EUDAS *) +(* *) +(* Version 04 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 15.10.88 *) +(* *) +(*************************************************************************) + + DEFINES + + fenstergroessen bestimmen, + fenster links, + fenster rechts, + fenster ganz, + + ausfuehrung, + auf archiv, + bitte warten, + frage ob einrichten, + set command dialogue false, + reset command dialogue, + edit : + + +(**************************** Fenster *************************************) + +LET + breite links = 16; + +INT VAR + last x size := 0, + last y size; + +FENSTER VAR + ganz, + links, + rechts, + fuss; + +fenster initialisieren (fuss); +fenster initialisieren (ganz); +fenster initialisieren (links); +fenster initialisieren (rechts); + + +PROC fenstergroessen bestimmen : + + IF x size <> last x size OR y size <> last y size THEN + neue fenstergroessen; + last x size := x size; + last y size := y size + END IF . + +neue fenstergroessen : + fenstergroesse setzen (ganz, 1, 2, x size - 1, y size - 1); + fenstergroesse setzen (links, 1, 2, breite links, y size - 2); + fenstergroesse setzen (rechts, + breite links + 1, 2, x size - breite links - 1, y size - 2); + fenstergroesse setzen (fuss, 1, y size, x size - 1, 1); + dialogfenster (rechts); + anzeigefenster (rechts); + uebersichtsfenster (ganz) . + +END PROC fenstergroessen bestimmen; + +FENSTER PROC fenster rechts : rechts END PROC fenster rechts; + +FENSTER PROC fenster links : links END PROC fenster links; + +FENSTER PROC fenster ganz : ganz END PROC fenster ganz; + + +(******************** Parameter-Auswahl ***********************************) + +LET + keine datei zur auswahl = #1001# + "Keine Datei zur Auswahl vorhanden.", + name der datei = #1002# + "Name der Datei: "; + +SATZ VAR sammel; + +THESAURUS VAR + zusaetzliche namen; + +TEXT VAR + feldpuffer, + dateiname, + offene; + +LET + niltext = "", + esc z = ""27"z", + cleol = ""5""; + +LET + fetch code = 11, + ack = 0; + +DATASPACE VAR ds; + +INITFLAG VAR init ds; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, nur eine, typ, niltask, + PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +PROC ausfuehrung (TEXT CONST prompt, BOOL CONST nur eine, INT CONST typ, + TASK CONST zusatztask, + PROC (TEXT CONST) operation) : + + enable stop; + dateinamen anfordern; + IF dateiname = niltext THEN + errorstop (niltext) + ELIF ist esc z THEN + dateiname := subtext (dateiname, 3); + dateinamen sammeln (all, typ, zusatztask); + auswahl anbieten ("EUDAS-Dateiauswahl", rechts, max wahl, + "AUSWAHL/Datei", + PROC (TEXT VAR, INT CONST) als text); + bitte warten; + operation ausfuehren (PROC (TEXT CONST) operation) + ELSE + last param (dateiname); + operation (dateiname) + END IF . + +dateinamen anfordern : + IF exists (std) AND (typ = 0 COR type (old (std)) = typ) THEN + dateiname := std + ELSE + dateiname := niltext + END IF; + editget (prompt, dateiname, "z", "GET/Dateiname") . + +max wahl : + IF nur eine THEN 1 ELSE 1024 END IF . + +END PROC ausfuehrung; + +PROC auf archiv (PROC (TEXT CONST) operation, THESAURUS CONST archivinhalt) : + + dateiname := niltext; + editget (name der datei, dateiname, "z", "GET/Dateiname"); + IF dateiname = niltext THEN + errorstop (niltext) + ELIF ist esc z THEN + uebersicht zeigen + ELSE + last param (dateiname); + operation (dateiname) + END IF . + +uebersicht zeigen : + dateiname := subtext (dateiname, 3); + dateinamen sammeln (archivinhalt, 0, niltask); + auswahl anbieten ("EUDAS-Archivauswahl", rechts, "AUSWAHL/Archiv", + PROC (TEXT VAR, INT CONST) als text); + operation ausfuehren (PROC (TEXT CONST) operation) . + +END PROC auf archiv; + +PROC dateinamen sammeln (THESAURUS CONST t, INT CONST typ, + TASK CONST zusatztask) : + + BOOL CONST kein pattern := pos (dateiname, "*") = 0; + uebergebene namen sammeln; + offene dateien merken; + zusaetzliche namen dazu; + meldung falls keine datei . + +uebergebene namen sammeln : + INT VAR + stelle := 1, + von := 0; + satz initialisieren (sammel); + REP + get (t, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE uebergebene namen sammeln + ELIF richtiger typ AND nach pattern THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +richtiger typ : + typ = 0 COR type (old (feldpuffer)) = typ . + +nach pattern : + kein pattern COR (feldpuffer LIKE dateiname) . + +offene dateien merken : + offene := niltext; + INT VAR i; + FOR i FROM 1 UPTO anzahl dateien REP + INT CONST t link := feldindex (sammel, eudas dateiname (i)); + IF t link > 0 THEN + offene CAT code (t link) + END IF + END REP . + +zusaetzliche namen dazu : + IF NOT is niltask (zusatztask) THEN + zusaetzliche namen := ALL zusatztask; + zusaetzliche namen nach typ abfragen + END IF . + +zusaetzliche namen nach typ abfragen : + von := 0; + REP + get (zusaetzliche namen, feldpuffer, von); + IF feldpuffer = niltext THEN + LEAVE zusaetzliche namen nach typ abfragen + ELIF nach pattern CAND noch nicht enthalten CAND typ stimmt THEN + feld aendern (sammel, stelle, feldpuffer); + stelle INCR 1 + END IF + END REP . + +noch nicht enthalten : + NOT (t CONTAINS feldpuffer) . + +typ stimmt : + typ = 0 COR tasktyp (feldpuffer, zusatztask) = typ . + +meldung falls keine datei : + IF stelle = 1 THEN + dialog (keine datei zur auswahl); + errorstop (niltext) + END IF . + +END PROC dateinamen sammeln; + +INT PROC tasktyp (TEXT CONST datei, TASK CONST zieltask) : + + enable stop; + INT VAR reply, result; + IF NOT initialized (init ds) THEN ds := nilspace END IF; + forget (ds); ds := nilspace; + msg := ds; + msg. name := datei; + msg. write pass := write password; + msg. read pass := read password; + call (zieltask, fetch code, ds, reply); + IF reply <> ack THEN + result := 0 + ELSE + result := type (ds) + END IF; + forget (ds); + result + +END PROC tasktyp; + +BOOL PROC ist esc z : + + subtext (dateiname, 1, 2) = esc z + +END PROC ist esc z; + +PROC als text (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle < 256 THEN + feld lesen (sammel, stelle, inhalt); + IF pos (offene, code (stelle)) > 0 THEN + inhalt := "<!> " + textdarstellung (inhalt) + ELIF inhalt <> niltext THEN + inhalt := textdarstellung (inhalt) + END IF + ELSE + inhalt := niltext + END IF + +END PROC als text; + +PROC operation ausfuehren (PROC (TEXT CONST) operation) : + + INT VAR + stelle := 1; + REP + IF wahl (stelle) = 0 THEN + LEAVE operation ausfuehren + ELSE + feld lesen (sammel, wahl (stelle), feldpuffer); + meldung in fusszeile; + last param (feldpuffer); + operation (feldpuffer) + END IF; + stelle INCR 1 + END REP . + +meldung in fusszeile : + IF online THEN + fenster veraendert (fuss); + cursor (1, y size); out (cleol); + out (text (stelle)); out (". "); + out (textdarstellung (feldpuffer)) + END IF . + +END PROC operation ausfuehren; + + +(************************** Editor ****************************************) + +LET + edit status = #1003# +"EDITIEREN: Abbruch: ESC h Verlassen: ESC q Hilfe: ESC ?", + show status = #1004# +"ZEIGEN: Blättern: HOP OBEN, HOP UNTEN Ende: ESC q Hilfe: ESC ?"; + +INT VAR return code; + +BOOL VAR + zeige edit status, + feldanzeige erlaubt; + + +PROC edit (FILE VAR f, FENSTER CONST fenster, TEXT CONST hilfe, + BOOL CONST aendern) : + + INT VAR x, y, x l, y l; + fenstergroesse (fenster, x, y, x l, y l); + fenster veraendert (fenster); + enable stop; + feldanzeige erlauben; + zeige edit status := aendern; + REP + edit status anzeigen; + open editor (groesster editor + 1, f, aendern, x, y, x l, y l); + edit (groesster editor, "eqvw19dpgn"9"?hF", PROC (TEXT CONST) kdo); + return code behandeln + END REP . + +feldanzeige erlauben : + IF aendern AND y < 3 AND y l > 22 AND x < 14 AND x l > 75 THEN + feldanzeige erlaubt := TRUE + ELSE + feldanzeige erlaubt := FALSE + END IF . + +return code behandeln : + SELECT return code OF + CASE 0 : LEAVE edit + CASE 1 : hilfe anbieten (hilfe, fenster) + CASE 2 : errorstop (niltext) + END SELECT . + +END PROC edit; + +PROC edit status anzeigen : + + IF zeige edit status THEN + status anzeigen (edit status) + ELSE + status anzeigen (show status) + END IF + +END PROC edit status anzeigen; + +PROC kdo (TEXT CONST zeichen) : + + return code := pos ("q?h", zeichen); + IF return code > 0 THEN + return code DECR 1; + quit + ELIF feldanzeige erlaubt CAND zeichen = "F" THEN + do ("feldnamen anzeigen"); + edit status anzeigen + ELSE + std kommando interpreter (zeichen); + edit status anzeigen; + bildschirm neu + END IF + +END PROC kdo; + + +(**************************** Kommandodialog *******************************) + +BOOL VAR dialogue state; + +PROC set command dialogue false : + + dialogue state := command dialogue; + command dialogue (FALSE) + +END PROC set command dialogue false; + +PROC reset command dialogue : + + command dialogue (dialogue state) + +END PROC reset command dialogue; + + +(************************** Verschiedenes ********************************) + +LET + t bitte warten = #1005# + " Bitte warten.. ", + t neu einrichten = #1006# + " neu einrichten"; + + +PROC bitte warten : + + status anzeigen (t bitte warten) + +END PROC bitte warten; + +PROC frage ob einrichten (TEXT CONST datei) : + + IF NOT ja (textdarstellung (datei) + t neu einrichten, + "JA/einrichten") THEN + errorstop (niltext) + END IF + +END PROC frage ob einrichten; + + +END PACKET eudas dialoghilfen; + diff --git a/app/eudas/5.3/src/eudas.drucken.13 b/app/eudas/5.3/src/eudas.drucken.13 new file mode 100644 index 0000000..b191dc5 --- /dev/null +++ b/app/eudas/5.3/src/eudas.drucken.13 @@ -0,0 +1,2001 @@ +PACKET eudas drucken + +(*************************************************************************) +(* *) +(* Drucken von EUDAS-Dateien nach Druckmuster *) +(* *) +(* Version 13 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + +(*dump, (* Test *) *) + + drucke, + interpretiere, + gruppentest, + + druckdatei, + direkt drucken, + druckrichtung, + max druckzeilen, + + gruppenwechsel, + lfd nr : + + +(*************************** Musterinterpreter ***************************) + +(* + EXPORTS + + INT max musterspeicher + INT VAR interpretationsmodus + interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abk) +*) + + +LET + max musterspeicher = 25, + SPEICHER = STRUCT (INT feldanfang, + feldlaenge, + setzmodus, + bearbeitet bis, + TEXT inhalt); + +ROW max musterspeicher SPEICHER VAR musterspeicher; + +INT VAR interpretationsmodus; + +LET + niltext = "", + blank = " ", + fis = "#", + zwei blanks = " "; + +TEXT VAR ausgabezeile; + + +PROC interpretiere (INT CONST erste zeile, erstes muster, + PROC (INT CONST, TEXT VAR) abkuerzungen) : + + INT VAR + kommandoindex, + anzahl leerzeilen := 0, + anzahl wiederholungen := 0, + aktuelles muster := erstes muster; + + muster auf zeile (erste zeile); + WHILE NOT druckmusterende REP + musterzeile lesen; + IF leerzeile THEN + anzahl leerzeilen INCR 1 + ELSE + letzte leerzeilen beruecksichtigen; + zeile auswerten + END IF + END REP . + +zeile auswerten : + IF kommandozeile (kommandoindex) THEN + kommando auswerten + ELSE + zeile interpretieren; + anzahl wiederholungen := 0 + END IF . + +kommando auswerten : + SELECT kommandoindex OF + CASE modus index : modus umstellen + CASE mehr index : anzahl wiederholungen setzen + OTHERWISE LEAVE interpretiere + END SELECT . + +letzte leerzeilen beruecksichtigen : + WHILE anzahl leerzeilen > 0 REP + zeile drucken (blank); + anzahl leerzeilen DECR 1 + END REP . + +modus umstellen : + int param (interpretationsmodus) . + +anzahl wiederholungen setzen : + int param (anzahl wiederholungen) . + +leerzeile : + musterzeile = niltext OR musterzeile = blank . + +zeile interpretieren : + INT VAR + zeilenzaehler := 0, + zu bearbeitende inhalte := 0; + BOOL VAR + blanks dazwischen := FALSE; + + REP + einen zeilendurchgang; + zeilenzaehler INCR 1; + IF interpretationsmodus = 3 THEN + blanks dazwischen := TRUE + END IF + UNTIL zeile fertig bearbeitet END REP . + +zeile fertig bearbeitet : + IF interpretationsmodus <= 2 THEN + TRUE + ELIF anzahl wiederholungen <> 0 THEN + zeilenzaehler = anzahl wiederholungen + ELSE + zu bearbeitende inhalte = 0 + END IF . + +einen zeilendurchgang : + INT VAR + letztes feldende := 1, + reservelaenge := 0, + benoetigte reserve := 0, + einzulesendes muster := 1, + einzusetzendes muster := 1; + + ausgabezeile := niltext; + REP + IF musterinhalt abspeichern THEN + musterinhalt besorgen + END IF; + IF festes muster THEN + zeilenabschnitt ausgeben + END IF; + einsetzdaten sammeln; + einzulesendes muster INCR 1 + END REP . + +musterinhalt abspeichern : + zeilenzaehler = 0 . + +musterinhalt besorgen : + naechstes muster (lesespeicher. feldanfang, lesespeicher. feldlaenge, + lesespeicher. setzmodus); + IF NOT zeilenende THEN + tabellenmodus beruecksichtigen; + musterinhalt lesen + END IF . + +zeilenende : + lesespeicher. feldanfang > length (musterzeile) . + +tabellenmodus beruecksichtigen : + IF linksschieben verboten AND setzmodus variabel THEN + folgende leerzeichen schlucken + END IF . + +setzmodus variabel : + (lesespeicher. setzmodus AND 1) = 0 . + +folgende leerzeichen schlucken : + INT VAR nach name := lesespeicher. feldanfang + lesespeicher. feldlaenge; + IF (musterzeile SUB nach name) = blank THEN + WHILE (musterzeile SUB nach name + 1) = blank REP + nach name INCR 1; + lesespeicher. feldlaenge INCR 1 + END REP + END IF . + +musterinhalt lesen : + INT CONST musterfunktion := musterindex (aktuelles muster); + IF musterfunktion > 0 THEN + feld lesen (musterfunktion, lesespeicher. inhalt) + ELSE + abkuerzungen (-musterfunktion, lesespeicher. inhalt) + END IF; + aktuelles muster INCR 1; + lesespeicher. bearbeitet bis := 0; + IF lesespeicher. inhalt <> niltext THEN + zu bearbeitende inhalte INCR 1 + END IF . + +festes muster : + lesespeicher. setzmodus >= 4 . + +lesespeicher : + musterspeicher (einzulesendes muster) . + +einsetzdaten sammeln : + INT CONST reserve := setzdifferenz (lesespeicher); + IF reserve > 0 THEN + reserve merken + ELSE + benoetigte reserve DECR reserve + END IF . + +reserve merken : + reservelaenge INCR reserve; + IF linksschieben verboten AND reservelaenge > benoetigte reserve THEN + reservelaenge := benoetigte reserve + END IF; + IF kein inhalt mehr einzusetzen AND variabel THEN + loeschbare blanks zaehlen + END IF . + +linksschieben verboten : + interpretationsmodus = 2 OR interpretationsmodus = 4 . + +kein inhalt mehr einzusetzen : + reserve = lesespeicher. feldlaenge . + +variabel : + (lesespeicher. setzmodus AND 1) = 0 . + +loeschbare blanks zaehlen : + IF lesespeicher. feldanfang = 1 COR + (musterzeile SUB (lesespeicher. feldanfang - 1)) = blank THEN + INT VAR ende := feldende (einzulesendes muster); + WHILE (musterzeile SUB ende) = blank REP + ende INCR 1; + lesespeicher. feldlaenge INCR 1; + reservelaenge INCR 1 + END REP + END IF . + +zeilenabschnitt ausgeben : + IF einzulesendes muster = 1 THEN + IF zeilenende THEN + zeile ganz ausgeben + END IF + ELSE + zeile bis dahin zusammenstellen + END IF . + +zeile ganz ausgeben : + IF blanks dazwischen THEN + zeile drucken (blank) + ELSE + zeile drucken (musterzeile) + END IF; + LEAVE einen zeilendurchgang . + +zeile bis dahin zusammenstellen : + INT VAR + blankluecke := 0, + blankpuffer := lesespeicher. feldanfang; + INT CONST + endeluecke := blankpuffer - length (musterzeile); + blankluecke suchen; + alle zwischenliegenden muster in ausgabedatei kopieren; + letzten zwischenraum kopieren; + zeilenende behandeln . + +blankluecke suchen : + IF endeluecke > 0 THEN + reservelaenge INCR endeluecke; + blankpuffer DECR (endeluecke - 1) + END IF; + rueckwaerts zwei blanks suchen . + +rueckwaerts zwei blanks suchen : + INT CONST + ende voriges feld := feldende (einzulesendes muster - 1), + leerstelle := + pos (musterzeile, zwei blanks, ende voriges feld, blankpuffer); + IF leerstelle > 0 THEN + blankpuffer := leerstelle; + groesse der blankluecke bestimmen + ELIF endeluecke < 0 AND (musterzeile SUB (blankpuffer - 1)) <> blank THEN + blankpuffer := ende voriges feld + END IF . + +groesse der blankluecke bestimmen : + INT VAR ende der luecke := blankpuffer + 1; + REP + blankluecke INCR 1; + ende der luecke INCR 1 + UNTIL (musterzeile SUB ende der luecke) <> blank END REP; + reservelaenge INCR blankluecke . + +alle zwischenliegenden muster in ausgabedatei kopieren : + INT VAR verschiebung := 0; + WHILE einzusetzendes muster < einzulesendes muster REP + setzspeicher in einzelvariablen lesen; + musterzwischenraum kopieren; + muster einsetzen; + einzusetzendes muster INCR 1 + END REP . + +setzspeicher in einzelvariablen lesen : + INT CONST + feldanfang := setzspeicher. feldanfang, + feldlaenge := setzspeicher. feldlaenge, + setzmodus := setzspeicher. setzmodus . + +musterzwischenraum kopieren : + zwischenraum (letztes feldende, feldanfang, blanks dazwischen); + letztes feldende := feldanfang + feldlaenge . + +setzspeicher : + musterspeicher (einzusetzendes muster) . + +muster einsetzen : + INT CONST ueberschuss := - setzdifferenz (setzspeicher); + IF ueberschuss = - feldlaenge THEN + leeres feld behandeln + ELIF ueberschuss <= 0 THEN + in voller laenge einsetzen + ELIF variable laenge AND reserve vorhanden THEN + einsetzen und nach rechts schieben + ELSE + bis zur grenze einsetzen + END IF . + +leeres feld behandeln : + IF variable laenge THEN + verschiebung INCR ueberschuss; + IF linksschieben verboten THEN + verschiebung korrigieren + END IF + ELSE + blanks anfuegen (-ueberschuss) + END IF . + +verschiebung korrigieren : + IF verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +in voller laenge einsetzen : + IF rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF; + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + IF feste laenge THEN + ggf mit blanks auffuellen + ELSE + verschiebung INCR ueberschuss; + linksschieben korrigieren + END IF . + +rechtsbuendig : + (setzmodus AND 2) = 2 . + +feste laenge : + (setzmodus AND 1) = 1 . + +ggf mit blanks auffuellen : + IF NOT rechtsbuendig THEN + blanks anfuegen (-ueberschuss) + END IF . + +linksschieben korrigieren : + IF linksschieben verboten AND verschiebung < 0 THEN + blanks anfuegen (-verschiebung); + verschiebung := 0 + END IF . + +variable laenge : + NOT feste laenge . + +reserve vorhanden : + ueberschuss <= reservelaenge . + +einsetzen und nach rechts schieben : + musterspeicher ganz ausgeben (setzspeicher); + zu bearbeitende inhalte DECR 1; + verschiebung INCR ueberschuss; + reservelaenge DECR ueberschuss . + +bis zur grenze einsetzen : + INT VAR + umbruchblanks := 0, + anfang := setzspeicher. bearbeitet bis + 1, + setz ende := anfang + feldlaenge - 1, + einsetzlaenge := feldlaenge; + IF variable laenge THEN + setz ende INCR reservelaenge; + einsetzlaenge INCR reservelaenge + END IF; + IF rechtsbuendig AND keine mehrfachzeilen THEN + rechten teil einsetzen + END IF; + textanweisungen beruecksichtigen; + IF mehrfachzeilen erlaubt THEN + umbruch + END IF; + teilfeld ausgeben; + IF variable laenge THEN + verschiebung INCR reservelaenge; + reservelaenge := 0 + END IF . + +rechten teil einsetzen : + INT CONST nach rechts := length (setzspeicher. inhalt) - setz ende; + anfang INCR nach rechts; + setz ende INCR nach rechts . + +textanweisungen beruecksichtigen : + INT VAR mehr platz; + REP + mehr platz := einsetzlaenge - setz ende + anfang - 1 + + kommandolaenge (setzspeicher. inhalt, anfang, setz ende); + IF mehr platz = 0 THEN + LEAVE textanweisungen beruecksichtigen + ELIF rechtsbuendig THEN + anfang DECR mehr platz + ELSE + setz ende INCR mehr platz + END IF + END REP . + +mehrfachzeilen erlaubt : + interpretationsmodus >= 3 . + +keine mehrfachzeilen : + NOT mehrfachzeilen erlaubt . + +teilfeld ausgeben : + IF rechtsbuendig THEN + blanks anfuegen (umbruchblanks) + END IF; + druckausgabe (setzspeicher. inhalt, anfang, setz ende); + IF linksbuendig THEN + blanks anfuegen (umbruchblanks) + END IF . + +linksbuendig : + NOT rechtsbuendig . + +umbruch : + IF pos (setzspeicher. inhalt, blank, anfang, setz ende) > 0 THEN + ende zuruecksetzen + END IF; + INT CONST naechstes wort := + pos (setzspeicher. inhalt, ""33"", ""254"", setz ende + 1); + IF naechstes wort = 0 THEN + setzspeicher. bearbeitet bis := length (setzspeicher. inhalt); + zu bearbeitende inhalte DECR 1 + ELSE + setzspeicher. bearbeitet bis := naechstes wort - 1 + END IF . + +ende zuruecksetzen : + setz ende INCR 1; umbruchblanks DECR 1; + WHILE (setzspeicher. inhalt SUB setz ende) <> blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + END REP; + WHILE (setzspeicher. inhalt SUB setz ende) = blank REP + setz ende DECR 1; + umbruchblanks INCR 1 + UNTIL ende < anfang END REP . + +letzten zwischenraum kopieren : + zwischenraum (letztes feldende, blankpuffer, blanks dazwischen); + IF verschiebung < 0 THEN + IF blankpuffer <= length (musterzeile) THEN + blanks anfuegen (-verschiebung) + END IF; + letztes feldende := blankpuffer + ELSE + letztes feldende := blankpuffer + min (verschiebung, blankluecke) + END IF . + +zeilenende behandeln : + IF endeluecke > 0 THEN + rest der musterzeile drucken; + zeile ausgeben; + LEAVE einen zeilendurchgang + ELSE + folgenden abschnitt vorbereiten + END IF . + +rest der musterzeile drucken : + IF NOT blanks dazwischen THEN + druckausgabe (musterzeile, letztes feldende, length (musterzeile)) + END IF . + +zeile ausgeben : + INT VAR neues ende := length (ausgabezeile); + IF (ausgabezeile SUB neues ende) = blank THEN + REP + neues ende DECR 1 + UNTIL (ausgabezeile SUB neues ende) <> blank END REP; + ausgabezeile := subtext (ausgabezeile, 1, neues ende) + END IF; + IF absatzmarkierung noetig THEN + ausgabezeile CAT blank + END IF; + zeile drucken (ausgabezeile) . + +absatzmarkierung noetig : + (musterzeile SUB LENGTH musterzeile) = blank AND + (interpretationsmodus <> 3 OR zu bearbeitende inhalte = 0) . + +folgenden abschnitt vorbereiten : + reservelaenge := 0; + benoetigte reserve := 0 . + +END PROC interpretiere; + +INT PROC feldende (INT CONST speicherindex) : + + musterspeicher (speicherindex). feldanfang + + musterspeicher (speicherindex). feldlaenge + +END PROC feldende; + +INT PROC setzdifferenz (SPEICHER CONST speicher) : + + speicher. feldlaenge - length (speicher. inhalt) + + kommandolaenge (speicher. inhalt) + speicher. bearbeitet bis + +END PROC setzdifferenz; + +INT PROC kommandolaenge (TEXT CONST inh) : + + kommandolaenge (inh, 1, length (inh)) + +END PROC kommandolaenge; + +INT PROC kommandolaenge (TEXT CONST inh, INT CONST von, bis) : + + INT CONST + first fis := pos (inh, fis, von, bis); + INT VAR + p := first fis, + n, + laenge := 0; + + WHILE p > 0 REP + naechstes fis suchen; + IF kein naechstes THEN + rand korrigieren + ELSE + laenge addieren + END IF; + fis anfang suchen + END REP; + laenge . + +naechstes fis suchen : + n := pos (inh, fis, p + 1, bis) . + +kein naechstes : + n = 0 . + +rand korrigieren : + IF bis = length (inh) THEN + laenge INCR first fis + ELSE + laenge INCR (bis - p + 1) + END IF . + +laenge addieren : + laenge INCR (n - p + 1) . + +fis anfang suchen : + IF n > 0 THEN + p := pos (inh, fis, n + 1, bis) + ELSE + p := 0 + END IF . + +END PROC kommando laenge; + +LET + zehn blanks = " "; + +PROC blanks anfuegen (INT CONST anzahl) : + + INT VAR zaehler := anzahl; + WHILE zaehler >= 10 REP + ausgabezeile CAT zehn blanks; + zaehler DECR 10 + END REP; + WHILE zaehler > 0 REP + ausgabezeile CAT blank; + zaehler DECR 1 + END REP + +END PROC blanks anfuegen; + +PROC musterspeicher ganz ausgeben (SPEICHER VAR speicher) : + + IF speicher. bearbeitet bis = 0 THEN + ausgabezeile CAT speicher. inhalt + ELSE + druckausgabe (speicher. inhalt, speicher. bearbeitet bis + 1, + length (speicher. inhalt)) + END IF; + speicher. bearbeitet bis := length (speicher. inhalt) + +END PROC musterspeicher ganz ausgeben; + +PROC zwischenraum (INT CONST von, bis, BOOL CONST blanks dazwischen) : + + IF blanks dazwischen THEN + blanks anfuegen (bis - von) + ELSE + druckausgabe (musterzeile, von, bis - 1) + END IF + +END PROC zwischenraum; + +TEXT VAR ausgabepuffer; + +PROC druckausgabe (TEXT CONST context, INT CONST von, bis) : + + ausgabepuffer := subtext (context, von, bis); + ausgabezeile CAT ausgabepuffer + +END PROC druckausgabe; + + +(************************* Musterscanner *********************************) + +(* + EXPORTS + + FILE VAR druckmuster + naechstes muster (TEXT VAR mustername) + naechstes muster (INT VAR musteranfang, musterlaenge, setzmodus) + musterzeile lesen + TEXT musterzeile + INT zeilennr + muster auf zeile (INT CONST neue zeile) + BOOL kommandozeile (INT VAR kommandoindex) + int param (INT VAR param) + INT m pos + BOOL druckmusterende + ueberlesen (TEXT CONST zeichen) + INT musterzeilenbreite + standard musterzeilenbreite +*) + + +FILE VAR druckmuster; + +TEXT VAR musterzeile; + +INT VAR m pos; + +LET + keine schliessende klammer = #401# + "keine schliessende Klammer in Feldmuster", + kein kommando in kommandozeile = #402# + "kein Kommando in Kommandozeile", + unbekanntes kommando = #403# + "unbekanntes Kommando"; + +LET + fix symbol = "&", + var symbol = "%", + com symbol = "%", + klammer auf = "<", + klammer zu = ">"; + +LET + kommandos = #404# + " "1"VOR "1"VORSPANN "2"WDH "2"WIEDERHOLUNG "3"NACH "3"NACHSPANN + "4"ABK "4"ABKUERZUNGEN "5"GRUPPE "6"MODUS "7"MEHR " + + +LET + vor index = 1, + wdh index = 2, + nach index = 3, + abk index = 4, + gruppe index = 5, + modus index = 6, + mehr index = 7, + do index = 100; + +INT VAR + musterzeilenbreite, + name anfang, + name ende; + +BOOL VAR + druckmusterende, + zeile gelesen; + + +. +zeilennr : + line no (druckmuster) . + +standard musterzeilenbreite : + musterzeilenbreite := maxlinelength (druckmuster) . + + +PROC ueberlesen (TEXT CONST zeichen) : + + REP + m pos INCR 1 + UNTIL (musterzeile SUB m pos) <> zeichen END REP + +END PROC ueberlesen; + +PROC naechstes muster (INT VAR anfang, laenge, setzmodus) : + + m pos auf naechsten anfang; + IF zeilenende THEN + anfang := max (musterzeilenbreite, length (musterzeile)) + 1; + laenge := 0; + setzmodus := 5 + ELSE + anfang := m pos; + muster lesen + END IF . + +m pos auf naechsten anfang : + m pos auf zeichen (fix symbol, var symbol) . + +zeilenende : + m pos > length (musterzeile) . + +muster lesen : + TEXT CONST musterzeichen := musterzeile SUB m pos; + IF musterzeichen = var symbol THEN + setzmodus := 0 + ELSE + setzmodus := 4 + END IF; + anfangszeichen ueberlesen; + feldnamen lesen; + endezeichen ueberlesen . + +anfangszeichen ueberlesen : + ueberlesen (musterzeichen); + IF m pos - 1 > anfang THEN + ist rechtsbuendig + END IF . + +ist rechtsbuendig : + setzmodus INCR 3 . + +feldnamen lesen : + IF (musterzeile SUB m pos) = klammer auf THEN + bis klammer zu lesen + ELSE + bis blank oder muster lesen + END IF; + IF leerer feldname THEN + naechstes muster (anfang, laenge, setzmodus); + LEAVE naechstes muster + END IF . + +leerer feldname : + name anfang > name ende . + +bis klammer zu lesen : + name anfang := m pos + 1; + name ende := pos (musterzeile, klammer zu, name anfang); + IF name ende = 0 THEN + fehler (keine schliessende klammer, subtext (musterzeile, m pos)); + name ende := length (musterzeile) + ELSE + name ende DECR 1 + END IF; + m pos := name ende + 2 . + +bis blank oder muster lesen : + name anfang := m pos; + m pos auf zeichen (blank, var symbol); + INT CONST zwischenpos := pos (musterzeile, fix symbol, name anfang, m pos); + IF zwischenpos > 0 THEN + m pos := zwischenpos + END IF; + name ende := m pos - 1 . + +endezeichen ueberlesen : + IF musterzeichen angetroffen THEN + ist fest; + ueberlesen (musterzeichen) + END IF; + laenge := m pos - anfang . + +musterzeichen angetroffen : + (musterzeile SUB m pos) = musterzeichen . + +ist fest : + setzmodus := setzmodus OR 1 . + +END PROC naechstes muster; + +PROC naechstes muster (TEXT VAR name) : + + INT VAR d1, laenge, d3; + naechstes muster (d1, laenge, d3); + IF laenge > 0 THEN + name := subtext (musterzeile, name anfang, name ende) + ELSE + name := niltext + END IF + +END PROC naechstes muster; + +PROC m pos auf zeichen (TEXT CONST zeichen 1, zeichen 2) : + + INT CONST + pos 1 := pos (musterzeile, zeichen 1, m pos), + pos 2 := pos (musterzeile, zeichen 2, m pos); + m pos := length (musterzeile) + 1; + IF pos 1 > 0 THEN + m pos := pos 1 + END IF; + IF pos 2 > 0 AND pos 2 < m pos THEN + m pos := pos 2 + END IF + +END PROC m pos auf zeichen; + +PROC muster auf zeile (INT CONST zeile) : + + to line (druckmuster, zeile); + zeile gelesen := FALSE; + druckmusterende := eof (druckmuster) + +END PROC muster auf zeile; + +PROC musterzeile lesen : + + IF zeile gelesen THEN + down (druckmuster) + ELSE + zeile gelesen := TRUE + END IF; + read record (druckmuster, musterzeile); + m pos := 1; + druckmusterende := line no (druckmuster) >= lines (druckmuster) + +END PROC musterzeile lesen; + +BOOL PROC kommandozeile (INT VAR kommandoindex) : + + m pos := 1; + IF (musterzeile SUB 1) <> com symbol THEN + FALSE + ELIF (musterzeile SUB 2) <> com symbol THEN + kommando abtrennen; + kommandoindex bestimmen; + TRUE + ELSE + kommandoindex := do index; + TRUE + END IF . + +kommando abtrennen : + TEXT VAR kommando; + ueberlesen (blank); + IF m pos > length (musterzeile) THEN + fehler (kein kommando in kommandozeile, musterzeile); + kommandoindex := 0; + LEAVE kommandozeile WITH TRUE + END IF; + INT CONST blank pos := pos (musterzeile, blank, m pos); + IF blank pos = 0 THEN + kommando := subtext (musterzeile, m pos); + kommando CAT blank; + m pos := length (musterzeile) + 1 + ELSE + kommando := subtext (musterzeile, m pos, blank pos); + m pos := blank pos + END IF . + +kommandoindex bestimmen : + INT CONST wo := pos (kommandos, kommando); + IF wo > 0 CAND (kommandos SUB (wo - 2)) = blank THEN + kommandoindex := code (kommandos SUB (wo - 1)) + ELSE + kommandoindex := 0; + fehler (unbekanntes kommando, kommando); + END IF . + +END PROC kommandozeile; + +PROC int param (INT VAR param) : + + ueberlesen (blank); + INT CONST par anfang := m pos; + WHILE ziffer REP + m pos INCR 1 + END REP; + IF m pos > par anfang THEN + param := int (subtext (musterzeile, par anfang, m pos - 1)) + ELSE + param := -1 + END IF . + +ziffer : + pos ("0123456789", musterzeile SUB m pos) > 0 . + +END PROC int param; + + +(**************************** Codegenerierung ****************************) + +(* + EXPORTS + + FILE VAR programm + BOOL wird uebersetzt + proc name (TEXT CONST name) + end proc + anweisung (TEXT CONST text) + anweisung (TEXT CONST pre, mid, post) + anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) + interpret anweisung (INT CONST zeile, muster) +*) + +FILE VAR programm; + +TEXT VAR + aktuelle proc; + +BOOL VAR + wird uebersetzt; + + +PROC proc name (TEXT CONST name) : + + aktuelle proc := name; + programmausgabe ("PROC ", name, " :") + +END PROC proc name; + +PROC end proc : + + programmausgabe ("END PROC ", aktuelle proc, ";") + +END PROC end proc; + +PROC anweisung (TEXT CONST programmtext) : + + wird uebersetzt := TRUE; + putline (programm, programmtext) + +END PROC anweisung; + +PROC anweisung (TEXT CONST pre, mid, post) : + + wird uebersetzt := TRUE; + programmausgabe (pre, mid, post) + +END PROC anweisung; + +PROC programmausgabe (TEXT CONST pre, mid, post) : + + write (programm, pre); + write (programm, mid); + write (programm, post); + line (programm) + +END PROC programmausgabe; + +TEXT VAR textpuffer; + +PROC anweisung (TEXT CONST pre, INT CONST spalte, TEXT CONST post) : + + text puffer := subtext (musterzeile, spalte); + anweisung (pre, textpuffer, post) + +END PROC anweisung; + +PROC interpret anweisung (INT CONST zeile, muster) : + + programmausgabe ("; interpretiere (", + text (zeile) + ", " + text (muster), + ", PROC (INT CONST, TEXT VAR) abk);") + +END PROC interpret anweisung; + + +(************************ Muster uebersetzen *****************************) + +(* + EXPORTS + + druckmuster uebersetzen + ROW 3 ABSCHNITT VAR abschnitte + ROW max muster INT VAR musterindex + fehler (TEXT CONST meldung) + ROW maxgruppen GRUPPE VAR gruppen + +*) + + +LET + vorzeitiges ende = #405# + "kein % WIEDERHOLUNG gefunden", + nur gruppe erlaubt = #406# + "Nur GRUPPE-Anweisung erlaubt", + kein do mehr erlaubt nach gruppen = #407# + "keine ELAN-Anweisung im Initialisierungsteil nach Gruppendefinition", + illegale gruppennummer = #408# + "illegale Gruppennummer", + gruppe schon definiert = #409# + "diese Gruppe wurde schon definiert", + abkuerzung nicht definiert = #410# + "diese Abkuerzung ist nicht definiert", + abschnitt mehrfach definiert = #411# + "dieser Abschnitt wurde schon einmal definiert", + falscher modus = #412# + "falscher Modus", + im musterteil nicht erlaubt = #413# + "diese Anweisung darf im Musterteil nicht vorkommen", + im abkuerzungsteil nicht erlaubt = #414# + "im Abkuerzungsteil darf keine Anweisung auftreten", + zuviele muster pro zeile = #415# + "in dieser Zeile stehen zu viele Feldmuster", + zuviele muster = #416# + "das Druckmuster enthaelt zu viele Feldmuster", + name der abkuerzung fehlt = #417# + "nach dem ""&"" soll direkt der Name einer Abkuerzung folgen", + kein doppelpunkt nach abkuerzung = #418# + "kein Doppelpunkt nach Abkuerzung", + abkuerzung mehrfach definiert = #419# + "Abkuerzung mehrfach definiert", + zu viele abkuerzungen = #420# + "das Druckmuster enthaelt zu viele Abkuerzungen"; + +LET + max muster = 200, + max gruppen = 4, + max abkuerzungen = 250, + + GRUPPE = STRUCT (BOOL wechsel, + definiert, + TEXT inhalt), + + ABSCHNITT = STRUCT (INT erstes muster, + erste zeile, + TEXT proc name); + + +ROW max muster INT VAR musterindex; + +INT VAR anzahl muster; + +ROW maxgruppen GRUPPE VAR gruppen; + +ROW 3 ABSCHNITT VAR abschnitte; + +SATZ VAR abkuerzungen; + +TEXT VAR + abkuerzungszeile; + +INT VAR + anzahl abkuerzungen; + + +OP CAT (TEXT VAR intvec, INT CONST wert) : + + TEXT VAR platz fuer int := " "; + replace (platz fuer int, 1, wert); + intvec CAT platz fuer int + +END OP CAT; + +PROC druckmuster uebersetzen : + + enable stop; + muster auf zeile (1); + uebersetzungsvariablen initialisieren; + initialisierungsteil uebersetzen; + WHILE NOT druckmusterende REP + einen von drei abschnitten uebersetzen + END REP; + abkuerzungen einsetzen . + +uebersetzungsvariablen initialisieren : + INT VAR kommandoindex; + INT VAR i; + anzahl abkuerzungen := 0; + satz initialisieren (abkuerzungen); + abkuerzungszeile := niltext; + anzahl muster := 0; + wird uebersetzt := FALSE; + abschnitte (1) := ABSCHNITT : (0, 0, "vorspann"); + abschnitte (2) := ABSCHNITT : (0, 0, "wdh"); + abschnitte (3) := ABSCHNITT : (0, 0, "nachspann"); + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). definiert := FALSE + END REP . + +initialisierungsteil uebersetzen : + BOOL VAR + schon gruppendefinition := FALSE; + + REP + IF druckmusterende THEN + fehler (vorzeitiges ende); + LEAVE druckmuster uebersetzen + END IF; + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + initialisierungskommando uebersetzen + END IF + END REP . + +initialisierungskommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + do kommando kopieren + + CASE gruppe index : + gruppendefinition aufnehmen + + CASE vor index, wdh index, nach index : + IF NOT schon gruppendefinition THEN + proc name ("gruppen") + END IF; + end proc; + LEAVE initialisierungsteil uebersetzen + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (nur gruppe erlaubt) + END IF + + END SELECT . + +do kommando kopieren : + IF schon gruppendefinition THEN + fehler (kein do mehr erlaubt nach gruppen, musterzeile) + ELSE + replace (musterzeile, 1, " "); + anweisung (musterzeile) + END IF . + +gruppendefinition aufnehmen : + IF NOT schon gruppendefinition THEN + proc name ("gruppen"); + schon gruppendefinition := TRUE + END IF; + INT VAR gruppennr; + int param (gruppennr); + IF gruppennr < 1 OR gruppennr > max gruppen THEN + fehler (illegale gruppennummer, musterzeile) + ELIF gruppen (gruppennr). definiert THEN + fehler (gruppe schon definiert, musterzeile) + ELSE + gruppen (gruppennr). definiert := TRUE; + ausdruck uebersetzen + END IF . + +ausdruck uebersetzen : + anweisung ("gruppentest (", text (gruppennr), ", "); + anweisung (" ", m pos, ");") . + +einen von drei abschnitten uebersetzen : + SELECT kommandoindex OF + CASE vor index : vorspann uebersetzen + CASE wdh index : wiederholungsteil uebersetzen + CASE nach index : nachspann uebersetzen + END SELECT . + +vorspann uebersetzen : + abschnitt uebersetzen (abschnitte (1), kommandoindex) . + +wiederholungsteil uebersetzen : + int param (spalten); int param (spaltenbreite); + abschnitt uebersetzen (abschnitte (2), kommandoindex) . + +nachspann uebersetzen : + abschnitt uebersetzen (abschnitte (3), kommandoindex) . + +abkuerzungen einsetzen : + IF wird uebersetzt THEN + fehlende procs definieren; + abk headline + END IF; + abkuerzungen ueberpruefen; + IF wird uebersetzt THEN + abk ende; + druckaufruf + END IF . + +abkuerzungen ueberpruefen : + FOR i FROM 1 UPTO anzahl abkuerzungen REP + IF (abkuerzungszeile ISUB i) > 0 THEN + fehler (abkuerzung nicht definiert, + name der abkuerzung, abkuerzungszeile ISUB i) + ELSE + anweisung in abk proc generieren + END IF + END REP . + +name der abkuerzung : + TEXT VAR puffer; + feld lesen (abkuerzungen, i, puffer); + puffer . + +fehlende procs definieren : + FOR i FROM 1 UPTO 3 REP + IF abschnitte (i). erste zeile = 0 THEN + abschnitt proc definieren + END IF + END REP . + +abschnitt proc definieren : + proc name (abschnitte (i). proc name); + end proc . + +abk headline : + anweisung ("PROC abk (INT CONST nr, TEXT VAR inhalt) :"); + IF anzahl abkuerzungen > 0 THEN + anweisung ("SELECT nr OF") + ELSE + anweisung ("inhalt := text (nr)") + END IF . + +anweisung in abk proc generieren : + TEXT CONST lfd index := text (i); + anweisung ("CASE " + lfd index, " : inhalt := abk", lfd index) . + +abk ende : + IF anzahl abkuerzungen > 0 THEN + anweisung ("END SELECT") + END IF; + anweisung ("END PROC abk;") . + +druckaufruf : + anweisung + ("drucke (PROC gruppen, PROC vorspann, PROC wdh, PROC nachspann)") . + +END PROC druckmuster uebersetzen; + +PROC abschnitt uebersetzen (ABSCHNITT VAR abschnitt, + INT VAR kommandoindex) : + + BOOL VAR war do zeile := TRUE; (* generiert erstes 'interpretiere' *) + proc name (abschnitt. proc name); + abschnitt anfang speichern; + musterteil uebersetzen; + abkuerzungen uebersetzen . + +abschnitt anfang speichern : + IF abschnitt. erste zeile <> 0 THEN + fehler (abschnitt mehrfach definiert, musterzeile) + END IF; + abschnitt. erste zeile := zeilennr + 1; + abschnitt. erstes muster := anzahl muster + 1 . + +musterteil uebersetzen : + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + abschnitt kommando uebersetzen + ELSE + interpret anweisung generieren; + musterzeile auf feldmuster untersuchen + END IF + END REP; + abschnitt beenden; + LEAVE abschnitt uebersetzen . + +abschnitt kommando uebersetzen : + SELECT kommandoindex OF + + CASE do index : + replace (musterzeile, 1, " "); + anweisung (musterzeile); + war do zeile := TRUE + + CASE vor index, wdh index, nach index : + abschnitt beenden; + LEAVE abschnitt uebersetzen + + CASE abk index : + abschnitt beenden; + LEAVE musterteil uebersetzen + + CASE modus index : + interpret anweisung generieren; + INT VAR parameter; + int param (parameter); + IF parameter < 1 OR parameter > 4 THEN + fehler (falscher modus, musterzeile) + END IF + + CASE mehr index : + interpret anweisung generieren + + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im musterteil nicht erlaubt) + END IF + + END SELECT . + +interpret anweisung generieren : + IF war do zeile THEN + interpret anweisung (zeilennr, anzahl muster + 1); + war do zeile := FALSE + END IF . + +abschnitt beenden : + end proc . + +musterzeile auf feldmuster untersuchen : + TEXT VAR name; + INT VAR muster pro zeile := 0; + + REP + naechstes muster (name); + IF name = niltext THEN + LEAVE musterzeile auf feldmuster untersuchen + END IF; + muster pro zeile INCR 1; + muster uebersetzen + END REP . + +muster uebersetzen : + IF muster pro zeile >= max musterspeicher THEN + fehler (zu viele muster pro zeile) + END IF; + IF anzahl muster = max muster THEN + fehler (zu viele muster) + ELSE + anzahl muster INCR 1 + END IF; + vorlaeufigen musterindex suchen . + +vorlaeufigen musterindex suchen : + INT VAR feldnr := feldnummer (name); + IF feldnr = 0 THEN + feldnr := feldindex (abkuerzungen, name); + IF feldnr = 0 THEN + abkuerzung eintragen (name, zeilennr); + musterindex (anzahl muster) := -anzahl abkuerzungen + ELSE + musterindex (anzahl muster) := -feldnr + END IF + ELSE + musterindex (anzahl muster) := feldnr + END IF . + +abkuerzungen uebersetzen : + BOOL VAR erste abkuerzungszeile := TRUE; + WHILE NOT druckmusterende REP + musterzeile lesen; + IF kommandozeile (kommandoindex) THEN + auf ende pruefen + ELIF zeile nicht leer THEN + abkuerzung behandeln + END IF + END REP . + +auf ende pruefen : + SELECT kommandoindex OF + CASE vor index, wdh index, nach index : + LEAVE abkuerzungen uebersetzen + OTHERWISE + IF kommandoindex > 0 THEN + fehler (im abkuerzungsteil nicht erlaubt) + END IF + END SELECT . + +abkuerzung behandeln : + IF erste abkuerzungszeile THEN + anweisung ("."); + erste abkuerzungszeile := FALSE + END IF; + IF erste zeile einer abkuerzung THEN + namen isolieren + ELSE + anweisung (musterzeile) + END IF . + +erste zeile einer abkuerzung : + (musterzeile SUB 1) = fix symbol . + +namen isolieren : + TEXT VAR abkuerzungsname; + naechstes muster (abkuerzungsname); + IF abkuerzungsname = niltext THEN + fehler (name der abkuerzung fehlt, musterzeile); + LEAVE namen isolieren + END IF; + doppelpunkt suchen; + an compiler uebergeben . + +doppelpunkt suchen : + LET doppelpunkt = ":"; + m pos DECR 1; (* wegen 'ueberlesen' *) + ueberlesen (blank); + IF (musterzeile SUB m pos) = doppelpunkt THEN + m pos INCR 1 + ELSE + fehler (kein doppelpunkt nach abkuerzung, musterzeile) + END IF . + +an compiler uebergeben : + abkuerzung eintragen (abkuerzungsname, 0); + anweisung (refinement name, m pos - 1, "") . + +refinement name : + "abk" + text (feldindex (abkuerzungen, abkuerzungsname)) . + +zeile nicht leer : + musterzeile <> niltext AND musterzeile <> blank . + +END PROC abschnitt uebersetzen; + +PROC abkuerzung eintragen (TEXT CONST name, INT CONST zeile) : + + INT CONST vorhanden := feldindex (abkuerzungen, name); + IF vorhanden > 0 THEN + alten eintrag ergaenzen + ELSE + neu anlegen + END IF . + +alten eintrag ergaenzen : + IF (abkuerzungszeile ISUB vorhanden) > 0 THEN + replace (abkuerzungszeile, vorhanden, zeile) + ELIF zeile = 0 THEN + fehler (abkuerzung mehrfach definiert, name) + END IF . + +neu anlegen : + IF anzahl abkuerzungen = max abkuerzungen THEN + fehler (zu viele abkuerzungen) + ELSE + anzahl abkuerzungen INCR 1 + END IF; + abkuerzungszeile CAT zeile; + feld aendern (abkuerzungen, anzahl abkuerzungen, name) . + +END PROC abkuerzung eintragen; + +LET + fehler in = #421# + "FEHLER in Zeile ", + fehler bei = #422# + " bei >>", + fehler ende = #423# + "<<"; + +PROC fehler (TEXT CONST fehlermeldung, bei, INT CONST zeile) : + + LET + blanks = " "; + TEXT VAR + meldung := fehler in; + meldung CAT text (zeile); + IF bei <> niltext THEN + meldung CAT fehler bei; + meldung CAT bei; + meldung CAT fehler ende + END IF; + note (meldung); note line; + note (blanks); note (fehlermeldung); note line; + IF online AND command dialogue THEN + line; + putline (meldung); + put (blanks); putline (fehlermeldung) + END IF + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung) : + + fehler (fehlermeldung, niltext, zeilennr) + +END PROC fehler; + +PROC fehler (TEXT CONST fehlermeldung, bei) : + + fehler (fehlermeldung, bei, zeilennr) + +END PROC fehler; + + +(************************** Drucksteuerung *******************************) + +(* + EXPORTS + + drucke (TEXT CONST dateiname) + drucke (PROC gruppen, PROC vor, PROC wdh, PROC nach) + druckdatei (TEXT CONST dateiname) + direkt drucken (BOOL CONST modus) + BOOL direkt drucken + max druckzeilen (INT CONST zeilen) + BOOL gruppenwechsel (INT CONST gruppennr) + gruppentest (INT CONST gruppe, TEXT CONST merkmal) + TEXT lfd nr + zeile drucken (TEXT CONST zeile) + INT spalten + INT spaltenbreite +*) + + +LET + erzeugtes programm = #424# + "erzeugtes Programm", + keine datei geoeffnet = #425# + "keine Datei geoeffnet", + interner fehler = #426# + "interner Fehler", + druckausgabe steht in = #427# + "Druckausgabe steht in", + zum drucker geschickt = #428# + "zum Drucker geschickt.", + direkt drucken nicht moeglich = #429# + "direkt Drucken nicht moeglich", + eudas ausgabe punkt = #430# + ".a$"; + +TEXT VAR + spaltenpuffer, + druckdateiname := ""; + +BOOL VAR + wechsel erfolgt, + wechsel 0, + externer dateiname, + direkt ausdrucken := FALSE; + +FILE VAR ausgabe; + +INT VAR + spalten, + spaltenbreite, + gedruckte spalten, + gemeinsamer anfang, + gedruckte zeilen, + richtung := 1, + max zeilen := 4000, + satzzaehler; + + +PROC drucke : + + drucke (last param) + +END PROC drucke; + +PROC drucke (TEXT CONST dateiname) : + + enable stop; + last param (dateiname); + druckmuster := sequential file (input, dateiname); + modify (druckmuster); + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + disable stop; + programmdatei einrichten; + druckmuster uebersetzen; + IF anything noted THEN + note edit (druckmuster) + ELIF wird uebersetzt THEN + programm uebersetzen + ELSE + drucke (PROC dummy gruppentest, + PROC std vor, PROC std wdh, PROC std nach) + END IF; + forget (programmdatei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + programm := sequential file (output, programmdatei); + headline (programm, erzeugtes programm) . + +programm uebersetzen : + run (programmdatei); + last param (dateiname) . + +END PROC drucke; + +PROC dummy gruppentest : END PROC dummy gruppentest; + +PROC std vor : + + abschnitt ausfuehren (1) + +END PROC std vor; + +PROC std wdh : + + abschnitt ausfuehren (2) + +END PROC std wdh; + +PROC std nach : + + abschnitt ausfuehren (3) + +END PROC std nach; + +PROC abschnitt ausfuehren (INT CONST nr) : + + IF abschnitte (nr). erste zeile > 0 THEN + interpretiere (abschnitte (nr). erste zeile, + abschnitte (nr). erstes muster, + PROC (INT CONST, TEXT VAR) std abk) + END IF + +END PROC abschnitt ausfuehren; + +PROC std abk (INT CONST nr, TEXT VAR inhalt) : + + errorstop (interner fehler); + inhalt := code (nr) (* Dummy-Anweisung, damit Parameter benutzt *) + +END PROC std abk; + +PROC drucke (PROC grp test, PROC vorspann, PROC wdh, PROC nachspann) : + + INT VAR + modus, + letzter satz, + letzte kombination; + + enable stop; + druckdatei eroeffnen; + auf ersten satz; + gruppen initialisieren; + satzzaehler := 1; + WHILE NOT dateiende REP + bei gruppenwechsel nachspann und vorspann; + cout (satznummer); + wiederholungsteil interpretieren; + weiter (modus); + ende der druckdatei ueberpruefen + END REP; + letzten nachspann drucken; + datei ausdrucken; + auf satz (1) . + +auf ersten satz : + letzter satz := 0; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF . + +gruppen initialisieren : + INT VAR i; + FOR i FROM 1 UPTO maxgruppen REP + gruppen (i). inhalt := niltext + END REP . + +bei gruppenwechsel nachspann und vorspann : + IF letzter satz = 0 THEN + grp test; + alle gruppen wechseln; + abschnitt interpretieren (PROC vorspann) + ELSE + wechsel 0 := FALSE; + gruppenwechsel testen; + gruppenwechsel mit nachspann + END IF; + letzter satz := satznummer; + letzte kombination := satzkombination . + +gruppenwechsel testen : + wechsel erfolgt := FALSE; + grp test . + +gruppenwechsel mit nachspann : + IF wechsel erfolgt THEN + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + satzzaehler INCR 1; + IF wechsel erfolgt THEN + abschnitt interpretieren (PROC vorspann) + END IF . + +wiederholungsteil interpretieren : + IF spaltenbreite < 1 THEN + standard musterzeilenbreite + ELSE + musterzeilenbreite := spaltenbreite + END IF; + IF gedruckte spalten < spalten THEN + to line (ausgabe, gemeinsamer anfang) + ELSE + to line (ausgabe, gedruckte zeilen + 1); + gemeinsamer anfang := gedruckte zeilen + 1; + gedruckte spalten := 0 + END IF; + interpretationsmodus := 1; + wdh; + gedruckte spalten INCR 1 . + +ende der druckdatei ueberpruefen : + IF gedruckte zeilen > maxzeilen THEN + datei ausdrucken; + druckdatei eroeffnen + END IF . + +letzten nachspann drucken : + alle gruppen wechseln; + IF letzter satz = 0 THEN + abschnitt interpretieren (PROC nachspann) + ELSE + nachspann drucken (letzter satz, letzte kombination, PROC nachspann) + END IF; + muster auf zeile (1) . + +END PROC drucke; + +PROC alle gruppen wechseln : + + INT VAR i; + FOR i FROM 1 UPTO max gruppen REP + gruppen (i). wechsel := TRUE + END REP; + wechsel 0 := TRUE; + wechsel erfolgt := TRUE + +END PROC alle gruppen wechseln; + +PROC abschnitt interpretieren (PROC abschnitt) : + + gedruckte spalten := spalten; + to line (ausgabe, gedruckte zeilen + 1); + standard musterzeilenbreite; + interpretationsmodus := 1; + abschnitt + +END PROC abschnitt interpretieren; + +PROC nachspann drucken (INT CONST letzter satz, letzte kombination, + PROC nachspann) : + + INT CONST + aktueller satz := satznummer, + aktuelle kombination := satzkombination; + auf satz (letzter satz); + WHILE satzkombination <> letzte kombination REP weiter (1) END REP; + abschnitt interpretieren (PROC nachspann); + auf satz (aktueller satz); + WHILE satzkombination <> aktuelle kombination REP weiter (1) END REP + +END PROC nachspann drucken; + +PROC druckdatei eroeffnen : + + IF aktueller editor > 0 THEN + in editfile schreiben + ELSE + in ausgabedatei schreiben + END IF; + druckanweisungen uebertragen . + +in editfile schreiben : + ausgabe := edit file; + IF col > 1 THEN + split line (ausgabe, col, FALSE); + down (ausgabe); col (ausgabe, 1) + END IF; + gedruckte zeilen := line no (ausgabe) - 1 . + +in ausgabedatei schreiben : + IF NOT externer dateiname THEN + druckdateinamen generieren + END IF; + ausgabe := sequential file (modify, druckdateiname); + max linelength (ausgabe, max linelength (druckmuster)); + gedruckte zeilen := lines (ausgabe) . + +druckdateinamen generieren : + INT VAR zaehler := 0; + REP + zaehler INCR 1; + druckdateiname := + headline (druckmuster) + eudas ausgabe punkt + text (zaehler); + UNTIL NOT exists (druckdateiname) END REP . + +druckanweisungen uebertragen : + muster auf zeile (1); + WHILE NOT druckmusterende REP + zeile uebertragen + END REP . + +zeile uebertragen : + musterzeile lesen; + INT VAR kommandoindex; + IF kommandozeile (kommandoindex) THEN + auf ende testen + ELSE + zeile drucken (musterzeile) + END IF . + +auf ende testen : + IF kommandoindex <> do index AND kommandoindex <> gruppe index THEN + LEAVE druckanweisungen uebertragen + END IF . + +END PROC druckdatei eroeffnen; + +PROC datei ausdrucken : + + IF aktueller editor > 0 THEN + LEAVE datei ausdrucken + ELIF externer dateiname THEN + externer dateiname := FALSE; + ELIF direkt ausdrucken THEN + disable stop; + ausdruck versuchen + ELIF online AND richtung > 1 THEN + line; put (druckausgabe steht in); + putline (textdarstellung (druckdateiname)); + pause (40) + END IF; + to line (ausgabe, 1) . + +ausdruck versuchen : + TEXT CONST param := std; + last param (druckdateiname); + do ("print (std)"); + IF is error THEN + clear error; + errorstop (direkt drucken nicht moeglich) + ELIF online THEN + line; put (textdarstellung (druckdateiname)); + putline (zum drucker geschickt); + forget (druckdateiname, quiet); + pause (40) + END IF; + last param (param) . + +END PROC datei ausdrucken; + +PROC zeile drucken (TEXT CONST zeile) : + + IF gedruckte spalten >= spalten OR gedruckte spalten = 0 THEN + insert record (ausgabe); + write record (ausgabe, zeile); + gedruckte zeilen INCR 1 + ELSE + an zeile anfuegen + END IF; + down (ausgabe) . + +an zeile anfuegen : + IF eof (ausgabe) THEN + spaltenpuffer := niltext; + insert record (ausgabe); + gedruckte zeilen INCR 1 + ELSE + read record (ausgabe, spaltenpuffer) + END IF; + spaltenpuffer verlaengern; + write record (ausgabe, spaltenpuffer) . + +spaltenpuffer verlaengern : + INT CONST ziellaenge := musterzeilenbreite * gedruckte spalten; + WHILE length (spaltenpuffer) < ziellaenge REP + spaltenpuffer CAT blank + END REP; + spaltenpuffer CAT zeile . + +END PROC zeile drucken; + +PROC druckrichtung (INT CONST r) : + + richtung := r; + direkt ausdrucken := (r = 0) + +END PROC druckrichtung; + +INT PROC druckrichtung : + + richtung + +END PROC druckrichtung; + +PROC direkt drucken (BOOL CONST modus) : + + direkt ausdrucken := modus; + IF modus THEN + richtung := 0 + ELIF richtung = 0 THEN + richtung := 1 + END IF + +END PROC direkt drucken; + +BOOL PROC direkt drucken : + + direkt ausdrucken + +END PROC direkt drucken; + +PROC druckdatei (TEXT CONST dateiname) : + + druckdateiname := dateiname; + externer dateiname := TRUE + +END PROC druckdatei; + +TEXT PROC druckdatei : + + druckdateiname + +END PROC druckdatei; + +PROC max druckzeilen (INT CONST zeilen) : + + max zeilen := zeilen + +END PROC max druckzeilen; + +PROC gruppentest (INT CONST gruppennr, TEXT CONST merkmal) : + + IF merkmal <> gruppen (gruppennr). inhalt THEN + gruppen (gruppennr). inhalt := merkmal; + gruppen (gruppennr). wechsel := TRUE; + wechsel erfolgt := TRUE + ELSE + gruppen (gruppennr). wechsel := FALSE + END IF + +END PROC gruppentest; + +BOOL PROC gruppenwechsel (INT CONST gruppennr) : + + IF gruppennr > 0 THEN + gruppen (gruppennr). wechsel + ELSE + wechsel 0 + END IF + +END PROC gruppenwechsel; + +TEXT PROC lfd nr : + + text (satzzaehler) + +END PROC lfd nr; + +(* +PROC dump : + + FILE VAR d := sequential file (output, "EUDAS-DUMP"); + put (d, "anzahl muster :"); put (d, anzahl muster); line (d); + INT VAR i; + FOR i FROM 1 UPTO anzahl muster REP + put (d, musterindex (i)); + END REP; + line (d); + put (d, "anzahl abkuerzungen :"); put (d, anzahl abkuerzungen); + line (d); + FOR i FROM 1 UPTO anzahl abkuerzungen REP + TEXT VAR p; feld lesen (abkuerzungen, i, p); + write (d, """"); write (d, p); write (d, """ "); + put (d, abkuerzungsindex ISUB i) + END REP; + line (d); + FOR i FROM 1 UPTO 3 REP + put (d, abschnitte (i). proc name); put (d, abschnitte (i). erste zeile); + put (d, abschnitte (i). erstes muster); line (d) + END REP; + edit ("EUDAS-DUMP"); + forget ("EUDAS-DUMP") + +END PROC dump; *) + +END PACKET eudas drucken; + diff --git a/app/eudas/5.3/src/eudas.fenster.06 b/app/eudas/5.3/src/eudas.fenster.06 new file mode 100644 index 0000000..cb9578b --- /dev/null +++ b/app/eudas/5.3/src/eudas.fenster.06 @@ -0,0 +1,253 @@ +PACKET fenster + +(*************************************************************************) +(* *) +(* Bildschirmaufteilung in Fenster *) +(* *) +(* Version 06 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 15.01.88 *) +(* *) +(*************************************************************************) + + DEFINES + + FENSTER, + fenster initialisieren, + fenstergroesse setzen, + fenstergroesse, + fenster veraendert, + fensterzugriff, + bildschirm neu : + + +TYPE FENSTER = STRUCT (INT koordinaten, version); + +LET + maxfenster = 16, + BITVEKTOR = INT, + GROESSE = STRUCT (INT x anf, y anf, x laenge, y laenge); + +ROW maxfenster STRUCT (INT referenzen, aktuelle version, + BITVEKTOR ueberschneidungen, + GROESSE groesse) + VAR fenstergroessen; + +INT VAR naechste version := 1; + +BITVEKTOR VAR veraenderungen; + +INT VAR i; +FOR i FROM 2 UPTO maxfenster REP + fenstergroessen (i). referenzen := 0 +END REP; +fenstergroessen (1). referenzen := 1; +fenstergroessen (1). aktuelle version := 0; +fenstergroessen (1). ueberschneidungen := 0; +fenstergroessen (1). groesse := GROESSE : (1, 1, 79, 24); + + +(************************* fenster anfordern *****************************) + +PROC fenster initialisieren (FENSTER VAR f) : + + f. koordinaten := 1; + fenstergroessen (1). referenzen INCR 1; + neue version (f. version) + +END PROC fenster initialisieren; + +PROC neue version (INT VAR version) : + + version := naechste version; + naechste version INCR 1; + IF naechste version >= 32000 THEN naechste version := -32000 END IF + +END PROC neue version; + +PROC fenstergroesse setzen (FENSTER VAR links, FENSTER CONST rechts) : + + neue version (links. version); + fenstergroessen (links. koordinaten). referenzen DECR 1; + links. koordinaten := rechts. koordinaten; + fenstergroessen (rechts. koordinaten). referenzen INCR 1 + +END PROC fenstergroesse setzen; + +PROC fenstergroesse setzen (FENSTER VAR f, + INT CONST x anf, y anf, x laenge, y laenge) : + + INT VAR stelle; + passendes fenster suchen; + IF stelle > maxfenster THEN + freie stelle suchen; + neue koordinaten initialisieren; + ueberschneidungen bestimmen + END IF; + auf referenz setzen . + +passendes fenster suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF groesse passt THEN + LEAVE passendes fenster suchen + END IF; + stelle INCR 1 + END REP . + +groesse passt : + g. x anf = x anf AND g. y anf = y anf AND g. x laenge = x laenge AND + g. y laenge = y laenge . + +g : + fenstergroessen (stelle). groesse . + +freie stelle suchen : + stelle := 1; + WHILE stelle <= maxfenster REP + IF fenstergroessen (stelle). referenzen = 0 THEN + LEAVE freie stelle suchen + END IF; + stelle INCR 1 + END REP; + errorstop ("zu viele Fenstergroessen"); + LEAVE fenstergroesse setzen . + +neue koordinaten initialisieren : + fenstergroessen (stelle). referenzen := 0; + fenstergroessen (stelle). aktuelle version := 0; + fenstergroessen (stelle). groesse := + GROESSE : (x anf, y anf, x laenge, y laenge); + fenstergroessen (stelle). ueberschneidungen := 0 . + +ueberschneidungen bestimmen : + INT VAR vergleich; + FOR vergleich FROM 1 UPTO maxfenster REP + IF fenstergroessen (vergleich). referenzen > 0 THEN + vergleiche auf ueberschneidung + END IF + END REP . + +vergleiche auf ueberschneidung : + IF ueberschneidung (neues fenster, vergleichsfenster) THEN + set bit (fenstergroessen (stelle). ueberschneidungen, vergleich); + set bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + ELSE + reset bit (fenstergroessen (vergleich). ueberschneidungen, stelle) + END IF . + +neues fenster : + fenstergroessen (stelle). groesse . + +vergleichsfenster : + fenstergroessen (vergleich). groesse . + +auf referenz setzen : + fenstergroessen (f. koordinaten). referenzen DECR 1; + f. koordinaten := stelle; + fenstergroessen (stelle). referenzen INCR 1 . + +END PROC fenstergroesse setzen; + +BOOL PROC ueberschneidung (GROESSE CONST a, b) : + + ueberschneidung in x richtung AND ueberschneidung in y richtung . + +ueberschneidung in x richtung : + IF a. x anf <= b. x anf THEN + b. x anf < a. x anf + a. x laenge + ELSE + a. x anf < b. x anf + b. x laenge + END IF . + +ueberschneidung in y richtung : + IF a. y anf <= b. y anf THEN + b. y anf < a. y anf + a. y laenge + ELSE + a. y anf < b. y anf + b. y laenge + END IF . + +END PROC ueberschneidung; + +PROC fenstergroesse (FENSTER CONST f, + INT VAR x anf, y anf, x laenge, y laenge) : + + x anf := g. x anf; + y anf := g. y anf; + x laenge := g. x laenge; + y laenge := g. y laenge . + +g : + fenstergroessen (f. koordinaten). groesse . + +END PROC fenstergroesse; + + +(************************** fenster veraendert ***************************) + +PROC fenster veraendert (FENSTER CONST f) : + + fenstergroessen (f. koordinaten). aktuelle version := 0; + veraenderungen := veraenderungen OR meine ueberschneidungen . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fenster veraendert; + + +(************************** fensterzugriff *******************************) + +PROC fensterzugriff (FENSTER CONST f, BOOL VAR veraendert) : + + veraendert := bit (veraenderungen, f. koordinaten); + IF fenstergroessen (f. koordinaten). aktuelle version <> f. version THEN + fenstergroessen (f. koordinaten). aktuelle version := f. version; + veraendert := TRUE + END IF; + veraenderungen := veraenderungen OR meine ueberschneidungen; + reset bit (veraenderungen, f. koordinaten) . + +meine ueberschneidungen : + fenstergroessen (f. koordinaten). ueberschneidungen . + +END PROC fensterzugriff; + + +(************************ bildschirm neu *********************************) + +PROC bildschirm neu : + + veraenderungen := - 1 + +END PROC bildschirm neu; + + +(**************************** BITVEKTOR **********************************) + +(* Erforderlich, da 'reset bit' im EUMEL nicht richtig funktionierte. *) + +ROW 16 INT VAR bitwert := ROW 16 INT : + (1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1); + +PROC set bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor OR bitwert (stelle) + +END PROC set bit; + +PROC reset bit (BITVEKTOR VAR vektor, INT CONST stelle) : + + vektor := vektor AND (-1 - bitwert (stelle)) + +END PROC reset bit; + +BOOL PROC bit (BITVEKTOR CONST vektor, INT CONST stelle) : + + (vektor AND bitwert (stelle)) <> 0 + +END PROC bit; + +END PACKET fenster; + diff --git a/app/eudas/5.3/src/eudas.generator b/app/eudas/5.3/src/eudas.generator new file mode 100644 index 0000000..ebafebc --- /dev/null +++ b/app/eudas/5.3/src/eudas.generator @@ -0,0 +1,105 @@ +INT VAR size, used; +BOOL VAR einzeln, sparen, box, l3; +TASK VAR ar; +IF (pcb (9) AND 255) = 1 THEN + errorstop ("Nicht für Single-User-Systeme geeignet") +END IF; +storage (size, used); +einzeln := size - used < 500; +soehne loeschen; +forget ("eudas.generator", quiet); +page; +putline ("EUDAS - automatische Generierung"); +putline ("Version 5.3 vom 06.02.89"); +line; +sparen := no ("Ausfuehrliche Hilfstexte installieren"); +box := yes ("Mit IBM Grafikzeichen"); +l3 := maxint DIV 2 > 17000; +IF l3 THEN ar := /"EUMEL" ELSE ar := archive END IF; +line; +disable stop; +do ("TEXT VARt:=additionalcommands"); +IF is error THEN + clear error; + enable stop; + gen ("dummy.text") +END IF; +enable stop; +IF id (0) < 175 THEN + gen ("pos.173") +END IF; +IF l3 THEN + gen ("isub.replace") +END IF; +IF NOT einzeln THEN + holen ("menues.1"); + holen ("eudas.1"); + holen ("eudas.2"); + holen ("eudas.3"); + holen ("eudas.4"); + holen ("eudas.init.14"); + IF box THEN holen ("boxzeichen") END IF; + release (ar) +END IF; +check off; +gen ("menues.1"); +IF box THEN gen ("boxzeichen") END IF; +gen ("eudas.1"); +gen ("eudas.2"); +gen ("eudas.3"); +gen ("eudas.4"); +IF anything noted THEN + push (""27"q"); note edit; pause (100) +END IF; +holen ("eudas.init.14"); +IF einzeln THEN + release (ar) +END IF; +IF sparen THEN do ("menue loeschen (TRUE)") END IF; +reorg ("eudas.init.14"); +do ("menuedaten einlesen (""eudas.init.14"")"); +forget ("eudas.init.14", quiet); +check on; +do ("global manager"); + +PROC reorg (TEXT CONST dateiname) : + IF l3 CAND type (old (dateiname)) = 1003 THEN + reorganize (dateiname) + END IF +END PROC reorg; + +PROC vom archiv (TEXT CONST datei): + out (""""); out (datei); putline (""" wird geholt."); + fetch (datei, ar) +END PROC vom archiv; + +PROC holen (TEXT CONST datei) : + IF NOT exists (datei) THEN vom archiv (datei) END IF +END PROC holen; + +PROC gen (TEXT CONST datei) : + holen (datei); + cursor (1, 7); out (""4""); + out (""""); out (datei); out (""" wird uebersetzt: "); + reorg (datei); + insert (datei); + forget (datei, quiet) +END PROC gen; + +PROC soehne loeschen : + + command dialogue (TRUE); + access catalogue; + TASK VAR sohn := son (myself); + WHILE NOT is niltask (sohn) REP + TASK CONST naechster := brother (sohn); + IF yes ("Sohntask """ + name (sohn) + """ loeschen") THEN + end (sohn) + ELIF yes ("Generierung abbrechen") THEN + errorstop ("") + END IF; + sohn := naechster + END REP + +END PROC soehne loeschen; + diff --git a/app/eudas/5.3/src/eudas.init.14 b/app/eudas/5.3/src/eudas.init.14 new file mode 100644 index 0000000..69ac8c7 --- /dev/null +++ b/app/eudas/5.3/src/eudas.init.14 @@ -0,0 +1,1625 @@ +% MENUE "EUDAS.Öffnen" +% BILD +EUDAS-Datei + Öffnen + Anketten + Koppeln +- +Arbeitskopie + Sichern +- +Aktuelle Datei + Notizen + Feldstrukt. + Prüfbeding. +- +Mehrbenutzer + Manager +% FELD 1 "EUDAS/1O" "oOöÖ" +% FELD 2 "EUDAS/1E" "aA" +% FELD 3 "EUDAS/1K" "kK" +% FELD 4 "EUDAS/1S" "sS" +% FELD 5 "EUDAS/1N" "nN" +% FELD 6 "EUDAS/1F" "fF" +% FELD 7 "EUDAS/1P" "pP" +% FELD 8 "EUDAS/1M" "mM" +% ENDE +% MENUE "EUDAS.Einzelsatz" +% BILD +Positionieren + Weiter + Zurück + Nr. Direkt + Inh. Direkt +- +Suchbedingung + Setzen + Löschen + Markierung +- +Datensatz + Einfügen + Ändern + Tragen + Holen +- + Feldauswahl +% FELD 1 "EUDAS/2W" "wW" +% FELD 2 "EUDAS/2Z" "zZ" +% FELD 3 "EUDAS/2N" "nN" +% FELD 4 "EUDAS/2I" "iI" +% FELD 5 "EUDAS/2S" "sS" +% FELD 6 "EUDAS/2L" "lL" +% FELD 7 "EUDAS/2M" "mM" +% FELD 8 "EUDAS/2E" "eE" +% FELD 9 "EUDAS/2A" "aAäÄ" +% FELD 10 "EUDAS/2T" "tT" +% FELD 11 "EUDAS/2H" "hH" +% FELD 12 "EUDAS/2F" "fF" +% FELD 13 "" ""3"" +% FELD 14 "" ""10"" +% FELD 15 "" "1" +% FELD 16 "" "9" +% FELD 17 "" "K" +% ENDE +% MENUE "EUDAS.Gesamtdatei" +% BILD +Satzauswahl + Kopieren + Tragen + Verändern + Übersicht +- +Aktuelle Datei + Sortieren +- +Alle Markier. + Löschen +% FELD 1 "EUDAS/3K" "kK" +% FELD 2 "EUDAS/3T" "tT" +% FELD 3 "EUDAS/3V" "vV" +% FELD 4 "EUDAS/3U" "uUüÜ" +% FELD 5 "EUDAS/3S" "sS" +% FELD 6 "EUDAS/3L" "lL" +% ENDE +% MENUE "EUDAS.Drucken" +% BILD +Druckausgabe + Generieren + Std.-Listen + Richtung +- +Textdatei + Editieren + Drucken + Nachbearb. +% FELD 1 "EUDAS/4D" "gG" +% FELD 2 "EUDAS/4S" "sS" +% FELD 3 "EUDAS/4R" "rR" +% FELD 4 "EUDAS/4E" "eE" +% FELD 5 "EUDAS/4A" "dD" +% FELD 6 "EUDAS/4N" "nN" +% ENDE +% MENUE "EUDAS.Dateien" +% BILD +Dieser Bereich + Übersicht +- +Datei + Löschen + Namen änd. + Kopieren + Platzbedarf + Aufräumen +% FELD 1 "EUDAS/5U" "UuüÜ" +% FELD 2 "EUDAS/5L" "Ll" +% FELD 3 "EUDAS/5N" "Nn" +% FELD 4 "EUDAS/5K" "Kk" +% FELD 5 "EUDAS/5P" "Pp" +% FELD 6 "EUDAS/5A" "Aa" +% ENDE +% MENUE "EUDAS.Archiv" +% BILD +Dateien Archiv + Übersicht + Drucke Übs. +- +Datei + Kopieren + vom Archiv + Schreiben + auf Archiv + Löschen + auf Archiv +- +Archivdiskette + Init +- + Zielarchiv + Passwort + Reservieren +% FELD 1 "EUDAS/6U" "UuÜü" +% FELD 2 "EUDAS/6D" "Dd" +% FELD 3 "EUDAS/6K" "Kk" +% FELD 4 "EUDAS/6S" "Ss" +% FELD 5 "EUDAS/6L" "Ll" +% FELD 6 "EUDAS/6I" "Ii" +% FELD 7 "EUDAS/6Z" "Zz" +% FELD 8 "EUDAS/6P" "Pp" +% FELD 9 "EUDAS/6R" "Rr" +% ENDE +% MENUE "WAHL.Ja" +% BILD + Ja +Nein +% FELD 1 "" "jJ" +% FELD 2 "" "nN" +% ENDE +% MENUE "WAHL.Typen" +% BILD +TEXT +NDIN +ZAHL +DATUM +% FELD 1 "" "tT" +% FELD 2 "" "nN" +% FELD 3 "" "zZ" +% FELD 4 "" "dD" +% ENDE +% MENUE "WAHL.Sichern" +% BILD +Statt alter Version +Ignorieren +Unter neuem Namen +% FELD 1 "" "sS" +% FELD 2 "" "iI" +% FELD 3 "" "uU" +% ENDE +% MENUE "WAHL.Ziel" +% BILD +Standard +Dateimanager +And.Laufwerk +Fremdformate +% FELD 1 "" "sS" +% FELD 2 "" "dD" +% FELD 3 "" "aA" +% FELD 4 "" "fF" +% ENDE +% MENUE "WAHL.Format" +% BILD +Standard +360 KB +720 KB +1,2 MB +% FELD 1 "" "sS" +% FELD 2 "" "3" +% FELD 3 "" "7" +% FELD 4 "" "1" +% ENDE +% MENUE "WAHL.Richtung" +% BILD +Drucker +Bildschirm +Textdatei +% FELD 1 "" "dD" +% FELD 2 "" "bB" +% FELD 3 "" "tT" +% ENDE +% MENUE "WAHL.Std-Listen" +% BILD +Spaltenliste +Kommaliste +% FELD 1 "" "kK" +% FELD 2 "" "sS" +% ENDE +% AUSWAHL "EUDAS-Felder" + Bitte die Felder, die geändert werden sollen, ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Sortierfelder" + Bitte die Felder, nach denen sortiert werden soll, + in Reihenfolge ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Anzeigefelder" + Bitte die Felder, die angezeigt werden sollen, + in Reihenfolge ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Editfelder" + Bitte die Felder ankreuzen, die in die Datei übernommen + werden sollen: +% ENDE +% AUSWAHL "EUDAS-Druckfelder" + Bitte die Felder ankreuzen, deren Inhalte gedruckt + werden sollen: +% ENDE +% AUSWAHL "EUDAS-Archivauswahl" + Auswahl der Dateien auf dem Archiv. + Gewünschte Datei(en) bitte ankreuzen: +% ENDE +% AUSWAHL "EUDAS-Dateiauswahl" + Auswahl der vorhandenen Dateien. + Gewünschte Datei(en) bitte ankreuzen: +% ENDE +% HILFE "EUDAS/Allgemein" +% SEITE 1 +MENÜBEDIENUNG: +- +Das Menü dient zur Auswahl von Funktionen. Die Funktionen sind +durch einen vorangestellten Buchstaben gekennzeichnet. Mit den +Pfeiltasten können Sie die Markierung zu einer beliebigen +Position auf und ab bewegen. Diese Funktion können Sie dann +durch Drücken der Leertaste ausführen. Durch ESC '?' +(nacheinander gedrückt) erhalten Sie Informationen zur gerade +markierten Funktion. +Funktionen, die im momentanen Zustand nicht ausgeführt werden +können, sind durch ein Minuszeichen gekennzeichnet. +In der obersten Bildschirmzeile sind weitere Menüs aufgeführt, +die Sie aufrufen können. Das aktuelle Menü ist invers +markiert. Ein anderes Menü wählen Sie durch Drücken der +Pfeiltasten RECHTS oder LINKS. Wollen Sie das Programm wieder +verlassen, drücken Sie die ESC-Taste und 'q' hintereinander. +% ENDE +% HILFE "EUDAS/1O" +% SEITE 1 +Öffnen zum Bearbeiten: +- +Diese Funktion öffnet eine EUDAS-Datei zur anschließenden +Bearbeitung. Sie können angeben, ob Sie die Datei nur ansehen +oder auch ändern wollen. Die vorher geöffnete Datei wird ggf. +gesichert. Wenn Sie eine neue Datei angeben, wird diese +eingerichtet. Dabei müssen Sie die Feldnamen eingeben. + +=> Hinweise zur Menübedienung auf der zweiten Seite (ESC 'w') +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1E" +% SEITE 1 +EUDAS-Datei ketten: +- +Mit dieser Funktion können Sie eine EUDAS-Datei logisch an die +bereits geöffnete Datei anketten. Dazu müssen jedoch die +beiden Dateien in ihrer Feldstruktur übereinstimmen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1N" +% SEITE 1 +Notizen ansehen/ändern: +- +Mit dieser Funktion können Sie der aktuell geöffneten Datei +Notizen zuordnen bzw. sich die vorherigen Notizen ansehen. +Dazu wird der normale Editor verwendet. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1M" +% SEITE 1 +Manager (Mehrbenutzerbetrieb): +- +Mit dieser Funktion können Sie die Task festlegen, aus der +beim Öffnen automatisch EUDAS-Dateien geholt werden können. +Dadurch können mehrere Benutzer auf die gleiche Datei +zugreifen, jedoch immer nur einer ändern. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1F" +% SEITE 1 +Feldstruktur ändern: +- +Mit dieser Funktion können Sie + +1. neue Feldnamen anfügen + Sie können neue Feldnamen der Datei am Ende anfügen. Sie + müssen die Namen untereinander im Editor in der gewünschten + Reihenfolge angeben. Vorher werden Sie jedoch gefragt, ob + Sie diese Funktion überhaupt ausführen wollen. + +2. Feldnamen und Feldtypen ändern + In diesem Teil wird Ihnen eine Auswahl aller vorhandenen + Felder angeboten, in der jeweils auch der Typ angegeben + ist. Wenn Sie diese Funktion nicht ausführen wollen, + beenden Sie die Auswahl einfach mit ESC q. Sonst wählen Sie + die Felder aus, deren Namen oder Typ Sie ändern wollen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1P" +% SEITE 1 +Prüfbedingungen: +- +Bei dieser Funktion können Sie im Editor ein Prüfprogramm +eingeben, das mit der Datei gespeichert wird und beim +Reintragen neuer Sätze ausgeführt wird. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1K" +% SEITE 1 +EUDAS-Datei koppeln: +- +Mit dieser Funktion können Sie eine Datei angeben, die zu den +bisher geöffneten Dateien dazugekoppelt wird. Anschließend +werden zu jedem Satz der existierenden Datei die in den +Koppelfeldern übereinstimmenden Sätze der Koppeldatei gezeigt. +Als Koppelfelder werden dabei die ersten Felder der +Koppeldatei betrachtet, die auch in der geöffneten Datei +vorhanden sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3S" +% SEITE 1 +Aktuelle Datei sortieren: +- +Mit dieser Funktion kann die aktuell geöffnete EUDAS-Datei +sortiert werden. Die Reihenfolge, in der die Felder +berücksichtigt werden, kann vorher angegeben werden. Eventuell +müssen zum richtigen Sortieren Feldtypen vergeben werden (s. +"Feldstrukt."). +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/1S" +% SEITE 1 +Aktuelle Dateien sichern: +- +EUDAS arbeitet bei Änderungen immer auf Sicherheitskopien der +Dateien. Wenn Ändern erlaubt ist, müssen geänderte +Arbeitskopien mit dieser Funktion gesichert werden. Für eine +veränderte Datei kann dabei auch ein neuer Name angegeben +werden, damit die alte Version erhalten bleibt. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2W" +% SEITE 1 +Satz weiter: +- +Diese Funktion geht zum nächsten Satz und zeigt ihn an. Wenn +eine Suchbedingung eingestellt ist, werden nicht ausgewählte +Sätze übersprungen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2Z" +% SEITE 1 +Satz zurück: +- +Diese Funktion geht zum vorigen Satz. Wenn eine Suchbedingung +eingestellt ist, werden nicht ausgewählte Sätze übersprungen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2S" +% SEITE 1 +Suchbedingung setzen: +- +Mit dieser Funktion kann eine Suchbedingung als Suchmuster +eingegeben werden, die angibt, welche Sätze bearbeitet werden +sollen. Die vorher eingestellte Suchbedingung wird automatisch +gelöscht. Die Bedingungen für die einzelnen Felder können im +Editor eingegeben werden. + +mögliche Bedingungen: + Text identisch mit Text.. größergleich + *Text endet mit ..Text kleiner + Text* beginnt mit Text..Text zwischen + *Text* enthält * nicht leer + + --Bed Verneinung + +Kombination von Bedingungen: + Bedingungen für verschiedene Felder: + UND + Komma zwischen Bedingungen: + lokales ODER (Prio höher als UND) + Semikolon zwischen Bedingungen: + globales ODER (Prio niedriger als UND) +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2L" +% SEITE 1 +Suchbedingung löschen: +- +Mit dieser Funktion kann eine eingestellte Suchbedingung +wieder gelöscht werden, so daß wieder alle Sätze sichtbar +sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2N" +% SEITE 1 +auf Satz Nr.: +- +Mit dieser Funktion kann ein bestimmter Satz direkt angewählt +werden. Dazu müssen Sie lediglich dessen Satznummer angeben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2I" +% SEITE 1 +Nach Inhalt direkt positionieren +- +Mit dieser Funktion kann auf einen bestimmten Satz nach dem +Inhalt seines ersten Feldes (Schlüsselfeld) positioniert +werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2E" +% SEITE 1 +neuen Satz einfügen: +- +Mit dieser Funktion wird vor dem aktuellen Satz ein neuer Satz +eingefügt. Die Inhalte dieses zunächst leeren Satzes können +Sie mit Hilfe des Editors neben die einzelnen Feldnamen +schreiben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2A" +% SEITE 1 +Satz ändern: +- +Mit dieser Funktion können Sie die Inhalte des aktuellen +Satzes verändern. Am Bildschirm können Sie die Daten mit Hilfe +des Editors ändern, löschen und Neues hinzufügen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2M" +% SEITE 1 +Markierung ein/aus: +- +Mit dieser Funktion können Sie einen Satz markieren, damit +später nur die markierten Sätze bearbeitet werden. Ist der +Satz schon markiert, wird die Markierung wieder gelöscht. Wenn +mindestens ein Satz markiert ist, erscheint die +Markierungsinformation in der Überschrift. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3L" +% SEITE 1 +Alle Markierungen loeschen: +- +Mit dieser Funktion werden alle Markierungen in der Datei +gelöscht. Die Markierungsinformation wird nicht mehr +angezeigt. Die Markierungen werden auch beim neuen Öffnen +gelöscht, da sie nicht permanent in der Datei gespeichert +sind. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2T" +% SEITE 1 +Einzelsatz tragen: +- +Mit dieser Funktion kann der aktuelle Satz in eine andere +Datei transportiert werden. Anschließend wird er gelöscht. Der +Satz wird am Ende der Zieldatei angefügt, wobei diese +gegebenenfalls eingerichtet wird. Den Namen der Zieldatei +können Sie eingeben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2H" +% SEITE 1 +Einzelsatz holen: +- +Diese Funktion holt den letzten Satz einer anderen Datei und +fügt ihn vor dem aktuellen Satz ein. Damit wird das letzte +'Tragen' wieder rückgängig gemacht. Die Dateien müssen gleiche +Felderzahl haben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3U" +% SEITE 1 +Übersicht: +- +Mit dieser Funktion können Sie sich eine Übersicht über +mehrere Sätze verschaffen. Es werden vom aktuellen Satz an +alle durch die Suchbedingung spezifizierten Sätze angezeigt, +jeder Satz in einer Zeile. In dieser Übersicht können Sie +blättern und auch bestimmte Sätze zur späteren Bearbeitung +markieren. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/2F" +% SEITE 1 +Auswahl Felder: +- +Mit dieser Funktion kann gewählt werden, welche Felder in +welcher Reihenfolge angezeigt werden sollen. Alle Felder +werden zum Ankreuzen angeboten. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4D" +% SEITE 1 +Drucken nach Muster: +- +Mit dieser Funktion können die Inhalte der Datei nach einem +Druckmuster ausgedruckt werden. Das Druckmuster ist eine +Textdatei und muß vorher erstellt werden. Es gibt die Form des +Ausdrucks an. Über den Aufbau eines Druckmusters lesen Sie am +besten das Benutzerhandbuch. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3T" +% SEITE 1 +Satzauswahl tragen +- +Diese Funktion trägt alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei und löscht +sie danach. Die Zieldatei muß gleiche Felderzahl haben, damit +keine Information verlorengeht. Beim Tragen können auch die +Prüfbedingungen der Zieldatei geprüft werden, wenn Sie die +entsprechende Frage bejahen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4S" +% SEITE 1 +Standard-Listen +- +Mit dieser Funktion können Standard-Listen einer Datei +erzeugt werden, ohne ein Druckmuster zu schreiben. Es stehen +ein Format mit Kommata als Trennzeichen sowie ein +Spaltenformat zur Auswahl. Ansonsten gelten alle Optionen +des normalen Generierens von Ausgaben. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4E" +% SEITE 1 +Textdatei erstellen/aendern: +- +Mit dieser Funktion kann eine Textdatei erstellt, geändert +oder angesehen werden. Es wird der normale Editor verwendet. +Mit dieser Funktion werden auch Druckmuster bearbeitet. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3K" +% SEITE 1 +Satzauswahl kopieren: +- +Diese Funktion kopiert alle durch die Suchbedingung oder durch +Markierung ausgewählten Sätze in eine andere Datei. Welche +Felder in welcher Reihenfolge kopiert werden sollen, wird +durch ein Kopiermuster bestimmt, das nach der Struktur der +Zieldatei bestimmt wird und dann von Ihnen noch geändert +werden kann. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4R" +% SEITE 1 +Richtung Ausgabe: +- +Mit dieser Funktion können Sie festlegen, ob die Ausgabe des +Druckvorgangs direkt anschließend ausgedruckt werden soll, +oder in eine Datei gespeichert wird. Sie können den Namen +dieser Datei eingeben, anderenfalls wählt sich EUDAS selbst +einen Namen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4A" +% SEITE 1 +Textdatei ausdrucken: +- +Mit dieser Funktion wird eine Textdatei direkt ausgedruckt. +Die Datei kann Anweisungen zur Druckersteuerung enthalten, die +Sie dem EUMEL-Benutzerhandbuch entnehmen können. Sie können +hiermit Ausgabedateien des Druckprozesses und das Druckmuster +selbst ausdrucken. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/3V" +% SEITE 1 +Ändern nach Vorschrift: +- +Diese Funktion ermöglicht es, alle durch die Suchbedingung +oder durch Markierung ausgewählten Sätze nach einer Vorschrift +automatisch zu ändern. Die Art der Änderungen wird dabei durch +ein Verarbeitungsmuster festgelegt, das vorher als Textdatei +erstellt werden muß. Über die Form des Verarbeitungsmusters s. +Benutzerhandbuch. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/4N" +% SEITE 1 +Textdatei nachbearbeiten: +- +Mit dieser Funktion können Sie eine Datei zeilenweise und +seitenweise formatieren (lineform/pageform). Dies dient an +dieser Stelle zur Bearbeitung von Druckdateien, die +verschiedene oder Proportionalschriften enthalten. Sie werden +jeweils für jede der beiden Funktionen gefragt, ob Sie sie +ausführen wollen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6S" +% SEITE 1 +Schreiben auf Archiv: +- +Diese Funktion schreibt eine oder mehrere Dateien auf das +Archiv. Der Archivname muß vorher eingegeben werden. Dann kann +entweder der Name der gewünschten Datei eingegeben werden oder +mit ESC 'z' eine Auswahl von Dateien angekreuzt werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5A" +% SEITE 1 +Datei aufräumen: +- +Diese Funktion reorganisiert eine Datei, an der viel geändert +wurde, zur Platz- und Zeitersparnis. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5K" +% SEITE 1 +Datei kopieren: +- +Mit dieser Funktion kann eine beliebige Datei logisch kopiert +werden. Die Kopie ist identisch mit dem Original und belegt +den gleichen Platz, erst bei Änderungen werden +unterschiedliche Daten gespeichert. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5P" +% SEITE 1 +Platzbedarf Datei: +- +Diese Funktion gibt an, wieviel Platz eine Datei im System +belegt. Dieser Platz kann aber mit anderen Dateien geteilt +sein. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6D" +% SEITE 1 +Archivübersicht drucken: +- +Diese Funktion druckt die Übersicht der Archivdateien aus. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6I" +% SEITE 1 +Archiv initialisieren: +- +Diese Funktion initialisiert einen Archivträger vor dem +Beschreiben. Sämtliche Daten werden gelöscht. Auf Wunsch kann +der Datenträger auch formatiert werden (falls vom System +unterstützt). +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6Z" +% SEITE 1 +Zielarchiv einstellen: +- +Mit dieser Funktion kann eine Managertask angegeben werden, +auf die die Archivfunktionen angewendet werden. Dies dient +sowohl zur Ansteuerung von mehreren Archiven (z.B. über Netz) +als auch zur Kommunikation mit anderen Managern. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6P" +% SEITE 1 +Passwort: +- +Mit dieser Funktion können Sie das Passwort einstellen, das +beim Versenden von Dateien an andere Tasks verwendet wird. +Beim Schreiben einer Datei wird das Passwort der Datei +mitgegeben und beim Lesen wird überprüft, ob das Passwort +übereinstimmt. Das Passwort kann in der Form +Schreibpasswort/Lesepasswort angegeben werden. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6R" +% SEITE 1 +Reservieren: +- +Mit dieser Funktion können Sie einen Kanalmanager (z.B. +DOS-Task) reservieren. Die Reservierung wird beim Verlassen +des Archivmenüs wieder aufgehoben. Den Parameter zur +Reservierung (Modus bei DOS-Task) können Sie angeben. Bei +normalen Archivtasks wird die Reservierung automatisch +vorgenommen, daher ist diese Funktion dann gesperrt. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6K" +% SEITE 1 +Kopieren vom Archiv: +- +Diese Funktion kopiert eine Datei vom Archiv ins System. Der +Archivname wird automatisch bestimmt. Sie können dann entweder +den gewünschten Dateinamen angeben oder mit ESC 'z' eine +Auswahl aller Dateien auf dem Archiv abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5N" +% SEITE 1 +Datei Namen ändern: +- +Mit dieser Funktion können Sie für eine Datei auf dem System +einen neuen Namen vergeben. Wenn Sie den neuen Namen eingeben, +wird Ihnen der alte Name angeboten. Sie können ihn ändern oder +ganz überschreiben. Dadurch ersparen Sie sich bei kleinen +Änderungen das Neutippen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6L" +% SEITE 1 +Löschen auf Archiv: +- +Diese Funktion ermöglicht es, eine Datei auf dem Archiv zu +löschen. Der Platz dieser Datei wird jedoch nur dann +wiederverwendet, wenn keine Dateien mehr dahinter stehen. Der +Archivname muß eingegeben werden. Sie können bei der Eingabe +des Dateinamens mit ESC 'z' eine Dateiauswahl abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5L" +% SEITE 1 +Datei löschen: +- +Diese Funktion löscht eine Datei auf dem System nach Anfrage. +Sie können den Dateinamen eingeben oder mit ESC 'z' eine +Auswahl aller vorhandenen Dateien abrufen. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/6U" +% SEITE 1 +Übersicht Archiv: +- +Diese Funktion liefert eine Übersicht der Dateien auf dem +Archiv. Verlassen Sie diese Übersicht mit ESC 'q'. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "EUDAS/5U" +% SEITE 1 +Übersicht Dateien: +- +Diese Funktion liefert eine Übersicht über alle im System +vorhandenen Dateien. Verlassen Sie diese Übersicht mit ESC +'q'. +% SEITE 1 "EUDAS/Allgemein" +% ENDE +% HILFE "AUSWAHL/Allgemein" +% SEITE 1 +AUSWAHL: +- +Mit Hilfe der Auswahl ist es möglich, aus einem Angebot einen +Teil auszuwählen. Die gewünschten Namen werden einfach in +beliebiger Reihenfolge angekreuzt und anschließend in dieser +Reihenfolge verwendet. +Die Schreibmarke (Cursor) gibt an, welcher Name gerade +angekreuzt werden kann. Mit den Pfeiltasten kann der Cursor +auf den Kreisen bewegt werden. '+' kreuzt einen Namen an, '-' +löscht die Ankreuzung wieder. +Mit ESC 'q' wird die Auswahl verlassen. ESC 'h' bricht die +Auswahl und die folgende Funktion ab. Falls das Angebot nicht +auf den Bildschirm paßt, wird es gerollt. ESC '1' positioniert +immer auf den Anfang und ESC '9' auf das Ende der Auswahl. Mit +HOP '+' werden alle noch nicht angekreuzten Namen angekreuzt, +mit HOP '-' werden alle Ankreuzungen gelöscht. +Der Balken an der rechten Seite gibt an, welcher Teil der +ganzen Auswahl sichtbar ist, wenn nicht alle Namen auf eine +Seite passen. +% ENDE +% HILFE "AUSWAHL/Felder" +% SEITE 1 +Feldauswahl: +- +Sie können hier alle Felder ankreuzen, die Sie ändern wollen. +Ändern können Sie den Feldnamen bzw. den Feldtyp. Wollen Sie +keine Felder ändern, drücken Sie einfach ESC 'q'. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Sortierfelder" +% SEITE 1 +Auswahl Sortierfelder: +- +Kreuzen Sie hier die Felder an, die bei der Sortierung +berücksichtigt werden sollen. Die Reihenfolge des Ankreuzens +ist wichtig. Beim Vergleich zweier Sätze wird erst das als +erstes angekreuzte Feld verglichen und danach die Einordnung +der Sätze bestimmt. Ist dieses Feld bei beiden gleich, wird +das nächste angekreuzte Feld untersucht usw. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Anzeigefelder" +% SEITE 1 +Auswahl Anzeigefelder: +- +Kreuzen Sie hier alle Felder an, die Sie angezeigt haben +möchten. Die Felder erscheinen in der angekreuzten +Reihenfolge. Für beide Arten der Anzeige können Sie eine +separate Feldauswahl einstellen. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Druckfelder" +% SEITE 1 +Auswahl Druckfelder: +- +Kreuzen Sie hier alle Felder an, die Sie im Ausdruck sehen +möchten. Die Reihenfolge des Ankreuzens bestimmt die +Reihenfolge beim Ausdruck. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Feldnamen" +% SEITE 1 +Auswahl Feldnamen: +- +Durch Blättern in der Auswahl können Sie die Schreibweise der +Feldnamen ansehen. Die Namen, die Sie ankreuzen, werden danach +mit spitzen Klammern in die gerade editierte Datei übernommen. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Archiv" +% SEITE 1 +Auswahl Archivdateien: +- +Diese Auswahl zeigt alle auf dem Archiv vorhandenen Dateien +an. Kreuzen Sie die Dateien an, die Sie bearbeiten möchten. +Die Dateien werden in der angekreuzten Reihenfolge verwendet. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "AUSWAHL/Datei" +% SEITE 1 +Auswahl Dateien: +- +Diese Auswahl zeigt alle Dateien auf dem System, die Sie +verwenden können. Kreuzen Sie die gewünschte(n) Datei(en) an. +% SEITE 1 "AUSWAHL/Allgemein" +% ENDE +% HILFE "FEHLER/Allgemein" +% SEITE 1 +FEHLERMELDUNGEN: +- +Fehlermeldungen werden von einem Programm abgesetzt, wenn es +seine Funktion nicht durchführen kann. Der Text der Meldung +identifiziert die Ursache des Problems. Zur Zeit liegen noch +keine meldungsspezifischen Informationen vor, schauen Sie ggf. +in das Benutzerhandbuch. +% ENDE +% HILFE "FEHLER/9" +% SEITE 1 +Programmfehler: +- +Diese Fehlermeldung deutet auf einen internen Programmfehler +(wenn Sie nicht selber ein Programm geschrieben haben). Melden +Sie diesen Fehler bitte, damit eine Korrektur vorgenommen +werden kann. Schreiben Sie sich dazu die Begleitumstände auf +(welche Datei haben Sie benutzt, welche Funktion). Versuchen +Sie gegebenenfalls, den Fehler zu wiederholen. Es ist nämlich +z.B. wichtig, ob der Fehler nur bei einer bestimmten Datei +auftritt oder ganz "zufällig". Wenn Sie vermuten, daß der +Fehler an einer bestimmten Datei liegt, sichern Sie diese +Datei bitte auf einer Diskette, um sie eventuell einschicken +zu können. +% ENDE +% HILFE "FEHLER/10" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/11" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "FEHLER/14" +% SEITE 1 "FEHLER/9" +% ENDE +% HILFE "GET/Allgemein" +% SEITE 1 +EINGABE: +- +Die Eingabe erwartet von Ihnen eine bestimmte Information, die +Sie eingeben sollen. Die Art der Information wird durch den +Anforderungstext angegeben. Wenn Sie sich beim Eintippen +verschrieben haben, können Sie mit den Pfeiltasten zurückgehen +und den Text korrigieren. Eine bereits dastehende Information +können Sie überschreiben. RUBOUT löscht ein Zeichen, RUBIN +schaltet in den Einfügemodus (Zeichen werden nicht mehr +überschrieben). Beenden Sie die Eingabe mit RETURN. ESC 'h' +bricht die Eingabe und die folgende Funktion ab. Wenn in der +Statuszeile angegeben, können Sie mit ESC 'z' eine Auswahl +verfügbarer Namen abrufen, die Sie dann Ankreuzen können. +% ENDE +% HILFE "GET/Sicherungsname" +% SEITE 1 +Neuer Name für Arbeitskopie: +- +Sie können jetzt den Namen angeben, unter dem die Arbeitskopie +gespeichert werden soll. Ihnen wird der alte Name zum +Überschreiben angeboten. Drücken Sie nur RETURN, wird der alte +Name genommen und die alte Version überschrieben. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Dateiname" +% SEITE 1 +Dateiname: +- +Bitte geben Sie den Namen der Datei ein, mit dem die Operation +ausgeführt werden soll. Mit ESC 'z' können Sie sich die zur +Verfügung stehenden Namen auch als Auswahl zeigen lassen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/feldname" +% SEITE 1 +Feldname: +- +Sie können den Namen des angegebenen Feldes ändern, indem Sie +den alten Namen überschreiben bzw. korrigieren. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Satz" +% SEITE 1 +Satznummer: +- +Sie können hier die Satznummer des Satzes eingeben, den Sie +sehen wollen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/auf Schluessel" +% SEITE 1 +Inhalt des Schlüsselfeldes: +- +Geben Sie hier den Inhalt des Schlüsselfeldes von dem Satz +an, den Sie suchen. Wenn Sie Suchbedingungen benötigen, +müssen Sie ein Suchmuster einstellen. Direse Funktion prüft +nur auf absolute Identität. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/listenbreite" +% SEITE 1 +Maximale Listenbreite: +- +Geben Sie hier die maximal Anzahl von Zeichen an, die zum +Ausdrucken zur Verfügung stehen. Werden mehr Zeichen für +einen Satz gebraucht, werden Inhalte abgeschnitten. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/copy" +% SEITE 1 +Dateiname für Kopie: +- +Geben Sie hier den Namen für die logische Kopie der Datei an. +Dieser Name darf keine existierende Datei bezeichnen. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Archivname" +% SEITE 1 +Name des Archivs: +- +Geben Sie den Namen des eingelegten Archivs ein (zur +Sicherheit). Der zuletzt verwendete Name wird zum Ändern +angeboten. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/rename" +% SEITE 1 +Neuer Dateiname: +- +Sie können den alten Namen der Datei durch Überschreiben und +Korrigieren ändern. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Druckdatei" +% SEITE 1 +Name der Druckdatei: +- +Geben Sie hier den Namen der Datei ein, in die die Ausgabe des +Druckprozesses geschrieben werden soll. Drücken Sie einfach +RETURN, wenn Sie keinen besonderen Namen wollen. EUDAS erzeugt +einen Namen der Form "druckmuster.a$n" mit 'n' zur +Unterscheidung mehrerer Ausgaben. +Die angegebene Datei wird nur für den nächsten Druckvorgang +verwendet. Sie müssen den Namen also jedes Mal wieder neu +angeben. Existiert die Datei schon, wird die Ausgabe an das +Ende angehängt. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielarchiv" +% SEITE 1 +Name Zielarchiv: +- +Geben Sie hier entweder den Namen einer Archivtask ein +(normalerweise "ARCHIVE") oder einer anderen Managertask. Bei +Netzbetrieb können Sie auch die Station anschließend angeben. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/Zielstation" +% SEITE 1 +Zielstation: +- +Geben Sie hier die Stationsnummer der Zieltask ein. Wenn sich +die Zieltask in Ihrem eigenen System befindet, brauchen Sie +nur RETURN zu drücken. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/multi task" +% SEITE 1 +Name Managertask: +- +Sie können hier den Namen einer EUDAS-Managertask angeben +(EUDAS muß in dieser Task insertiert sein). Wenn Sie keinen +Namen angeben, werden keine entsprechenden Abfragen beim +Öffnen mehr gemacht. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "GET/kopiermuster" +% SEITE 1 +Name Kopiermuster: +- +Geben Sie den Namen einer Datei ein, in der das Kopiermuster +stehen soll. Drücken Sie einfach RETURN, wenn Sie das Muster +nicht aufbewahren wollen. Wenn die Datei noch nicht existiert, +wird das Standard-Kopiermuster in die Datei geschrieben. +Anschließend kann das Muster noch im Editor geändert werden. +% SEITE 1 "GET/Allgemein" +% ENDE +% HILFE "JA/Allgemein" +% SEITE 1 +FRAGEN: +- +Das Programm stellt Ihnen eine Frage, die Sie bejahen oder +verneinen können. Sie bejahen die Frage, indem Sie 'j' drücken +und verneinen Sie mit 'n' (beides groß oder klein). Mit ESC +'h' können Sie die Funktion abbrechen. +% ENDE +% HILFE "JA/oeffne" +% SEITE 1 +Änderungen vornehmen? +- +Beantworten Sie die Frage mit 'n', wenn Sie die Datei nur +ansehen wollen. In diesem Fall wird keine Sicherheitskopie +erstellt. Verneinen Sie die Frage, wird eine interen Kopie +angelegt, die Sie dann verändern können. Die Kopie muß nach +dem Ändern gesichert werden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Dateien loeschen" +% SEITE 1 +Arbeitskopien löschen? +- +Beim Sichern hatten Sie Gelegenheit, alle veränderten +Arbeitskopien zu sichern. Die Arbeitskopien können damit +gelöscht werden. Dazu bejahen Sie die Frage. Wenn die Dateien +jedoch noch geöffnet bleiben sollen, oder Sie eine Datei aus +Versehen nicht gesichert haben, müssen Sie diese Frage +verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/ueber" +% SEITE 1 +Datei überschreiben? +- +Sie haben für die Arbeitskopie einen Namen angegeben, der noch +existiert. Bejahen Sie die Frage, wird die alte Datei dieses +Namens überschrieben. Anderenfalls erhalten Sie eine neue +Gelegenheit, einen Namen einzugeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sicherungssortierung" +% SEITE 1 +Sortierung wiederherstellen? +- +Die angegebene Datei war früher schon einmal sortiert worden. +Die Sortierung wurde jedoch durch nachfolgende Änderungen +zerstört. Wenn Sie die Datei wieder sortiert haben wollen, +beantworten Sie die Frage mit 'j'. Die Sortierung dauert nicht +lange, wenn nur wenige Sätze verändert wurden. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/feldnamen" +% SEITE 1 +Feldnamen anfügen? +- +Falls Sie neue Felder zu den existierenden anfügen wollen, +müssen Sie diese Frage bejahen. Sie erhalten dann Gelegenheit, +die neuen Namen im Editor einzugeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierfelder" +% SEITE 1 +Sortierreihenfolge ändern? +- +Die Reihenfolge, in der die Felder bei der Sortierung +berücksichtigt werden, ist in der EUDAS-Datei intern +gespeichert. Wenn Sie diese Reihenfolge, die beim letzten +Sortieren angegeben wurde, ändern möchten, müssen Sie die +Frage bejahen. Sie können dann die neue Feldreihenfolge +auswählen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/sortieren" +% SEITE 1 +Zieldatei sortieren? +- +Wenn Sie diese Frage bejahen, wird die Zieldatei nach +Ausführung der Funktion in ihrer eingestellten Feldreihenfolge +sortiert. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/forget" +% SEITE 1 +Datei löschen? +- +Wenn Sie diese Frage bejahen, wird die Datei wirklich +gelöscht. Wenn Sie die Datei irrtümlich gewählt haben, müssen +Sie die Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/einrichten" +% SEITE 1 +Datei neu einrichten? +- +Sie haben eine Datei angegeben, die noch nicht existiert. Wenn +Sie die Frage bejahen, wird die Datei neu eingerichtet. +Anderenfalls wird die Funktion abgebrochen, so daß Sie +Gelegenheit haben, die Funktion mit einem neuen Namen zu +wiederholen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/testen" +% SEITE 1 +Prüfbedingungen beachten? +- +Wenn Sie diese Frage bejahen, werden beim Tragen die +Prüfbedingungen der Zieldatei abgefragt. Sätze, die diese +Bedingungen nicht erfüllen, werden nicht getragen und können +danach geändert werden. Beim Ändern wird dann jeweils die den +Satz betreffende Meldung ausgegeben. Die Prüfbedingungen der +Zieldatei können Sie mit der Funktion "Feldstruktur aendern" +angeben oder ändern. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/save" +% SEITE 1 +Datei überschreiben? +- +Die angegebene Datei befindet sich bereits auf dem Archiv. +Wenn Sie die Datei überschreiben wollen, müssen Sie die Frage +bejahen. Ansonsten wird die Datei nicht auf das Archiv +geschrieben (keine Wirkung). +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/fetch" +% SEITE 1 +Datei überschreiben? +- +Die angegebene Datei ist bereits im System vorhanden. Wenn Sie +diese Datei überschreiben wollen, müssen Sie die Frage +bejahen. Anderenfalls wird keine Aktion vorgenommen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/erase" +% SEITE 1 +Datei löschen? +- +Zur Sicherheit wird gefragt, ob Sie die angegebene Datei +wirklich auf dem Archiv löschen wollen. Wenn Sie die Frage +verneinen, wird keine Aktion durchgeführt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/format" +% SEITE 1 +Formatieren? +- +Wenn Ihr Rechner dies unterstützt, können Sie Archivdisketten +vor dem Initialisieren noch physikalisch formatieren. Dies ist +immer dann notwendig, wenn eine Diskette neu ist (vor der +ersten Benutzung) oder wenn Schreibfehler aufgetreten sind, +die sich nicht mehr reparieren lassen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/archiv loeschen" +% SEITE 1 +Archiv löschen? +- +Wenn Sie irrtümlich die falsche Diskette eingelegt haben oder +eine andere Funktion ausführen wollten, können Sie die +Funktion durch Verneinen der Frage abbrechen. Achten Sie auf +den angegebenen Archivnamen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle Saetze" +% SEITE 1 +Alle Sätze drucken? +- +Wenn Sie die Frage bejahen, werden anschließend alle Sätze, +die in der Übersicht zu sehen waren, gedruckt. Den Namen des +Druckmusters können Sie dann gleich eingeben. Wenn Sie keinen +oder nur den aktuellen Satz drucken wollen, müssen Sie die +Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/alle markierten" +% SEITE 1 +Alle markierten Sätze drucken? +- +Wenn Sie die Frage bejahen, werden anschließend alle +markierten Sätze gedruckt. Den Namen des Druckmusters können +Sie dann gleich eingeben. Wenn Sie keinen oder nur den +aktuellen Satz drucken wollen, müssen Sie die Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Einzelsatz drucken" +% SEITE 1 +Aktuellen Satz drucken? +- +Wenn Sie die Frage bejahen, wird der aktuelle (markierte) Satz +gedruckt. Den Namen des Druckmusters können Sie dann gleich +eingeben. Wenn Sie keinen Satz drucken wollen, müssen Sie die +Frage verneinen. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/noch einmal" +% SEITE 1 +Noch einmal? +- +Wenn Sie die Frage bejahen, können Sie noch einmal die Datei +mit einer neuen Suchbedingung ansehen und erneut drucken. +Sonst kehren Sie wieder in den Editor zurück. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ub.Felder" +% SEITE 1 +Felder auswählen? +- +Wenn Sie die Frage bejahen, können Sie einzelne Felder in +einer bestimmten Reihenfolge für die Übersichtsanzeige +auswählen. Anderenfalls werden alle Felder angezeigt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Suchmuster" +% SEITE 1 +Suchbedingung angeben? +- +Wenn Sie die Frage bejahen, können Sie eine Suchbedingung für +die angezeigten Sätze angeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/umschalten" +% SEITE 1 +Auf Koppeldatei umschalten? +- +Wenn Sie die Frage bejahen, schalten Sie auf die genannte +Koppeldatei um. Damit wird diese Datei zeitweise als einzige +geöffnete betrachtet. Damit können Sie einen bestimmten Satz +aufsuchen, den Sie später beim Zurückschalten übernehmen +können. Verneinen Sie die Frage, werden Ihnen weitere mögliche +Koppeldateien angeboten, oder Sie kehren ohne Schaden zurück. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/uebernehmen" +% SEITE 1 +Koppelfelder übernehmen? +- +Wenn Sie die Frage bejahen, werden die Koppelfelder des jetzt +ausgewählten Satzes in den aktuellen Satz der ersten Datei +übernommen, an dem Sie dann weiter ändern können. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Sortierrichtung" +% SEITE 1 +Aufsteigend sortieren? +- +Wenn Sie die Frage bejahen, wird die Datei nach dem genannten +Feld in aufsteigender Richtung sortiert, anderenfalls in +absteigender. Für weitere Felder können Sie wieder eine andere +Richtung angeben. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/zeilenform" +% SEITE 1 +Zeilenweise formatieren? +- +Wenn Sie die Frage bejahen, wird die angegebene Datei +zeilenweise interaktiv formatiert. Der Text wird unter +Berücksichtigung der Schrifttypen gleichmäßig auf die Zeilen +verteilt. Beachten Sie die Wirkung der Absatzmarken! +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/seitenform" +% SEITE 1 +Seitenweise formatieren? +- +Wenn Sie die Frage bejahen, wird die angegebene Datei +interaktiv seitenweise formatiert. Der Text wird bis zur +angegebenen Seitenlänge auf die Seiten verteilt. Dabei werden +Seitenköpfe und Fußnoten eingefügt. Das Ergebnis steht in der +Datei "xxx.p". +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/pw loeschen" +% SEITE 1 +Passwort löschen? +- +Wenn Sie die Frage bejahen, wird das Passwort gelöscht und das +leere Passwort eingestellt. Anderenfalls bleibt das alte +Passwort erhalten. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/manager aus" +% SEITE 1 +Manager ausschalten? +- +Wenn Sie die Frage bejahen, berücksichtigt EUDAS im weiteren +keine Managertask mehr. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Feldtypen aendern" +% SEITE 1 +Feldtypen ändern? +- +Wenn Sie die Frage bejahen, können Sie den Typ von +existierenden Feldern verändern. Der Feldtyp hat nur +Auswirkungen beim Größenvergleich (Suchen und Sortieren). +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Feldnamen aendern" +% SEITE 1 +Feldnamen ändern? +- +Wenn Sie die Frage bejahen, können Sie existierende Feldnamen +in ihrer Schreibweise verändern. Diese Funktion hat keine +Auswirkung auf die Dateiinhalte. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/eingelegt" +% SEITE 1 +Diskette eingelegt? +- +Legen Sie bitte die gewünschte Diskette ein und bejahen Sie +die Frage. Anderenfalls wird die Funktion ohne Wirkung +beendet. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ausgabe drucken" +% SEITE 1 +Ausgabe drucken? +- +Wenn Sie die Frage bejahen, wird die gezeigte Datei sofort +ausgedruckt. Anderenfalls können Sie sie ggf. aufbewahren. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "JA/Ausgabe loeschen" +% SEITE 1 +Ausgabe löschen? +- +Wenn Sie die Frage bejahen, wird die gezeigte Datei +gelöscht. Anderenfalls wird sie für eine weitere Bearbeitung +aufbewahrt. +% SEITE 1 "JA/Allgemein" +% ENDE +% HILFE "EDIT/Allgemein" +% SEITE 1 +EDITOR: +- +Mit dem Editor können Sie einen Text zeilenweise eingeben. +Dabei können Sie den Cursor mit den Pfeiltasten bewegen. +RUBOUT löscht ein Zeichen, RUBIN schaltet in den Einfügemodus +um. Für weitere Informationen zum Editor s. +EUMEL-Benutzerhandbuch. ESC 'q' verläßt den Editor normal. Mit +ESC 'h' wird die Funktion abgebrochen. +% ENDE +% HILFE "EDIT/Feldnamen" +% SEITE 1 +Neue Feldnamen: +- +Sie können hier die neuen Feldnamen in der gewünschten +Reihenfolge untereinander eingeben. Jeder Feldname muß in +einer Zeile stehen und ohne Anführungsstriche geschrieben +sein. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Pruefbed" +% SEITE 1 +Prüfbedingungen: +- +Sie können hier die Prüfbedingungen der Datei eingeben bzw. +ändern. Die Prüfbedingungen sind ein ELAN-Programm. Da ELAN- +Programme formatfrei sind, kann es sein, daß Ihr Programm beim +nächsten Mal anders erscheint, als Sie es eingegeben haben. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Notizen" +% SEITE 1 +Notizen: +- +Sie können jetzt zu der angegebenen Datei beliebige Notizen +eingeben bzw. ändern. Sie befinden sich im Editor und können +die gleichen Funktionen wie bei der normalen Texteingabe +verwenden. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Suchen" +% SEITE 1 +Suchmuster: +- +Sie können jetzt eine Selektionsbedingung einstellen. Dazu +müssen Sie jeweils neben den Feldnamen eine Bedingung +schreiben. Mögliche Bedingungen sind: + Text muß gleich sein + Text* muß mit Text anfangen + *Text muß mit Text enden + *Text* enthält Text + Text.. muß größer oder gleich Text sein + ..Text muß kleiner als Text sein oder mit Text anfangen + Text1..Text2 liegt zwischen den beiden Texten +"--" verneint eine Bedingung. Weitere Bedingungen und +Kombination von Bedingungen s. EUDAS-Benutzerhandbuch. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Einfuegen" +% SEITE 1 +Satz einfügen: +- +Sie können hier die Inhalte eines neuen Satzes eingeben, der +vor dem aktuellen Satz eingefügt wird. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz wird nicht eingefügt + ESC 'w' Beenden und gleich den nächsten Satz einfügen + ESC 'D' aktuelles Tagesdatum schreiben +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Aendern" +% SEITE 1 +Satz ändern: +- +Sie können die Inhalte des aktuellen Satzes hier abändern. +Spezielle Tastenkombinationen: + ESC RUBOUT Rest der Zeile löschen + ESC RUBIN Zeile aufbrechen + ESC OBEN nach oben blättern + ESC UNTEN nach unten blättern + ESC '1' auf erste Zeile + ESC '9' auf letzte Zeile + ESC 'h' Abbruch, der Satz bleibt unverändert + ESC 'w' Beenden und gleich den nächsten Satz ändern + ESC 'D' aktuelles Tagesdatum schreiben +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckmuster" +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Verarbeite" +% SEITE 1 +Verarbeitungsvorschrift: +- +Sie können hier eine Verarbeitungsvorschrift eingeben. Die +Verarbeitungsvorschrift ist ein ELAN-Programm. Ein Feld wird +geändert durch den Operator "V": + "Feldname" V "neuer Feldinhalt"; +Statt des neuen Feldinhalts kann auch ein beliebiger +ELAN-Ausdruck angegeben werden. Mit + f ("Feldname") +wird der Inhalt eines Feldes als Text geliefert. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Kopiermuster" +% SEITE 1 +Kopiermuster: +- +Sie können das hier angegebene Kopiermuster verändern. Sollen +Felder nicht kopiert werden, brauchen Sie nur die +entsprechenden Zeilen zu löschen. Soll eine Feld andere +Inhalte bekommen, geben Sie in dem Ausdruck + "Feldname" K f ("Feldname"); +hinter dem K einen anderen ELAN-Ausdruck ein. Die Reihenfolge +der K-Ausdrücke bestimmt die Reihenfolge der Feldnamen in der +Zieldatei, wenn die Zieldatei noch nicht existierte. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "EDIT/Druckausgabe" +% SEITE 1 +Druckausgabe: +- +Sie können hier das Ergebnis der Druckgenerierung ansehen +und ggf. noch verändern. Nach Verlassen des Editors mit ESC +q wird der Text auf Anfrage gedruckt. +% SEITE 1 "EDIT/Allgemein" +% ENDE +% HILFE "UEBERSICHT" +% SEITE 1 +UEBERSICHT: +- +In diesem Modus können Sie sich alle Sätze der Datei durch +Blättern ansehen. Der aktuelle Satz ist jeweils markiert. Die +eingestellte Suchbedingung wird beachtet. Mit den Pfeiltasten +OBEN und UNTEN bewegen Sie sich vorwärts und rückwärts in der +Datei. Mit HOP OBEN, HOP UNTEN und HOP RETURN blättern Sie wie +im Editor. Mit ESC '1' gelangen Sie an den Anfang, mit ESC '9' +an das Ende der Datei. Mit '+' und '-' können Sie die +Markierung des aktuellen Satzes für spätere Verarbeitung +ändern. Verlassen Sie die Übersicht mit ESC 'q'. +% ENDE +% HILFE "SHOW/Uebersicht" +% SEITE 1 +Dateiübersicht: +- +In der gezeigten Dateiübersicht können Sie mit HOP OBEN und +HOP UNTEN blättern, wenn nicht alle Dateien auf eine Seite +passen. Verlassen Sie die Übersicht mit ESC 'q'. +% ENDE +% HILFE "WAHL/Allgemein" +% SEITE 1 +Horizontale WAHL eines Parameters: +- +Sie können aus den angezeigten Alternativen eine auswaehlen, +indem sie sie mit den Cursortasten RECHTS und LINKS markieren. +Durch RETURN bestätigen Sie die getroffene Wahl. Sie können +ihre Wahl auch durch Eintippen des ersten Buchstabens einer +Option angeben (klein oder groß geschrieben). ESC 'h' bricht +die aktuelle Funktion ab. +% ENDE +% HILFE "WAHL/Feldtypen" +% SEITE 1 +Feldtypen: +- +Sie können hier einen von vier möglichen Typen auswaehlen: + TEXT normaler Text mit Vergleich nach EUMEL-Code. + DIN Text, der nach DIN 5007 verglichen wird (Umlaute + richtig, Groß-/Kleinschreibung und Sonderzeichen ignoriert). + ZAHL Alle nichtnumerischen Zeichen außer Minus und + Dezimalkomma werden beim Vergleichen ignoriert. + DATUM Datum der Form "tt.mm.jj" +Die Feldtypen werden beim Sortieren und Suchen beachtet. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/sichere" +% SEITE 1 +Wahlmöglichkeiten beim Sichern: +- +Sie haben drei Möglichkeiten. +1. Die Arbeitskopie überschreibt die alte Version (Original) +vor den Änderungen. +2. Sie ignoriere die Veränderungen momentan. Die Arbeitskopie +bleibt weiter erhalten, wenn Sie am Ende des Sicherns +nichts anderes angeben. +3. Die geänderte Arbeitskopie kann unter einem neuen Namen +gespeichert werden, so daß das Original erhalten bleibt. +Sie erhalten anschließend Gelegenheit zur Eingabe des neuen +Namens. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/format" +% SEITE 1 +Auswahl des Diskettenformats: +- +Sie haben die Wahl zwischen den angegebenen Diskettenformaten. +Wenn Sie sich damit nicht auskennen, wählen Sie das +Standardformat. Die Angabe bezieht sich nur auf den +Formatiervorgang; beim Lesen wird das Format der Diskette +automatisch erkannt. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/zielarchiv" +% SEITE 1 +Art des Zielarchivs: +- +Sie können wählen zwischen: + +Std-Archiv Normales Archiv +Dateimanager Eine Managertask wie z.B. PUBLIC +Zweites Archiv Zur Bedienung eines zweiten Diskettenlaufwerks +und zum Archivieren über Netz +Formatumsetzer Für andere Diskettenformate, z.B. DOS + +Außer im ersten Fall können Sie anschließend den Namen des +Zielarchivs eingeben. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/Richtung" +% SEITE 1 +Richtung der Druckausgabe +- +Sie können wählen zwischen: + +Drucker Die Druckausgabe wird direkt gedruckt und +dann gelöscht +Bildschirm Die Ausgabe wird im Editor gezeigt und kann +danach auf Anfrage gedruckt und gelöscht werden +Textdatei Die Ausgabe erfolgt in eine Textdatei. Der +Name dieser Datei wird vor jedem Drucken erfragt. +% SEITE 1 "WAHL/Allgemein" +% ENDE +% HILFE "WAHL/Std-Listen" +% SEITE 1 +Art der Listen +- +Sie können wählen zwischen: + +Kommaliste Alle Felder werden durch Komma getrennt +aneinandergehängt +Spaltenanordnung Die Felder werden in Spalten angeordnet, +wobei die Spaltenbreite durch einen Durchlauf durch die +Datei ermittelt wird. +% SEITE 1 "WAHL/Allgemein" +% ENDE + diff --git a/app/eudas/5.3/src/eudas.listen.01 b/app/eudas/5.3/src/eudas.listen.01 new file mode 100644 index 0000000..47e7270 --- /dev/null +++ b/app/eudas/5.3/src/eudas.listen.01 @@ -0,0 +1,276 @@ +PACKET eudas std listen + +(*************************************************************************) +(* *) +(* Drucken von Standardlisten ohne Druckmuster *) +(* *) +(* Version 01 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + drucke standardlisten, + std listenbreite, + std listenlaenge, + std listenfont : + + +LET + listendruckmuster = "******* Listendruckmuster *******"; + +FILE VAR f; + +TEXT VAR puffer, feldname; + +TEXT VAR std font := ""; + +INT VAR + std breite := 70, + std laenge := 60; + + + +PROC std listenbreite (INT CONST breite) : + std breite := breite +END PROC std listenbreite; + +INT PROC std listenbreite : + std breite +END PROC std listenbreite; + +PROC std listenlaenge (INT CONST laenge) : + std laenge := laenge +END PROC std listenlaenge; + +INT PROC std listenlaenge : + std laenge +END PROC std listenlaenge; + +PROC std listenfont (TEXT CONST font) : + std font := font +END PROC std listenfont; + +TEXT PROC std listenfont : + std font +END PROC std listenfont; + +PROC drucke standardlisten (INT CONST listenform, TEXT CONST feldliste) : + + forget (listendruckmuster, quiet); + f := sequential file (output, listendruckmuster); + maxlinelength (f, std breite); + IF kommaliste THEN + generiere komma druckmuster (feldliste) + ELSE + generiere spalten druckmuster (feldliste) + END IF; + TEXT CONST last := std; + drucke (listendruckmuster); + forget (listendruckmuster, quiet); + last param (last) . + +kommaliste : + listenform = 2 . + +END PROC drucke standardlisten; + +ROW 100 INT VAR feld max; + +INT VAR + zeilen pro satz, + zeilenlaenge, + feldlaenge, + druckfelder, + ges max; + +PROC generiere listenkopf : + + IF std font <> "" THEN + putline (f, "#type(" + textdarstellung (std font) + ")#") + END IF; + putline (f, "% GRUPPE 1 seitennummer"); + putline (f, "% VOR"); + put (f, date); put (f, time of day); put (f, "Uhr:"); + put (f, eudas dateiname (1)); + write (f, (std breite - length (eudas dateiname (1)) - 25) * " "); + putline (f, "&&-S"); + line (f) + +END PROC generiere listenkopf; + +PROC generiere seitenvorschub : + + putline (f, "% NACH"); + putline (f, "#page#"); + putline (f, "% ABK"); + putline (f, "&? : lfd nr ."); + putline (f, "&-S : seitennummer ."); + putline (f, "seitennummer :"); + putline (f, " text (int (lfd nr) DIV saetze pro seite + 1) ."); + write (f, "saetze pro seite : "); + put (f, (std laenge - 2) DIV zeilen pro satz - 1); + putline (f, ".") + +END PROC generiere seitenvorschub; + +PROC generiere komma druckmuster (TEXT CONST feldliste) : + + generiere listenkopf; + generiere feldueberschriften; + generiere wiederholungsteil; + generiere seitenvorschub . + +generiere feldueberschriften : + write (f, "Nr. "); + FOR i FROM 1 UPTO length (feldliste) REP + feldnamen lesen (code (feldliste SUB i), feldname); + IF i < length (feldliste) THEN + write (f, feldname + ", ") + ELSE + write (f, feldname) + END IF + END REP; + line (f); + putline (f, maxlinelength (f) * "-"); + zeilen pro satz := 1 . + +generiere wiederholungsteil : + putline (f, "% WDH"); + INT CONST max alt := maxlinelength (f); + INT VAR i; + maxlinelength (f, 10000); + write (f, "&&? "); + FOR i FROM 1 UPTO length (feldliste) REP + ein feldname als muster + END REP; + line (f); + maxlinelength (f, max alt) . + +ein feldname als muster : + write (f, "%<"); + feldnamen lesen (code (feldliste SUB i), feldname); + write (f, feldname); + write (f, ">"); + IF i < length (feldliste) THEN write (f, ", ") END IF . + +END PROC generiere komma druckmuster; + +PROC maxima suchen (TEXT CONST feldliste) : + + INT VAR i; + maxima initialisieren; + auf satz (1); + INT VAR modus; + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (3) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (2) END IF + END IF; + + WHILE NOT dateiende REP + einen satz testen; + weiter (modus) + END REP . + +maxima initialisieren : + druckfelder := length (feldliste); + FOR i FROM 1 UPTO druckfelder REP + feld max (i) := 2 + END REP; + ges max := 0 . + +einen satz testen : + INT VAR gesamt := 0; + FOR i FROM 1 UPTO druckfelder REP + feld bearbeiten (code (feldliste SUB i), + PROC (TEXT CONST, INT CONST, INT CONST) fl); + IF feldlaenge > feld max (i) THEN feld max (i) := feldlaenge END IF; + gesamt INCR feldlaenge + END REP; + IF gesamt > ges max THEN ges max := gesamt END IF . + +END PROC maxima suchen; + +PROC fl (TEXT CONST satz, INT CONST von, bis) : + feldlaenge := bis - von + 1 +END PROC fl; + +PROC generiere spalten druckmuster (TEXT CONST feldliste) : + + maxima suchen (feldliste); + generiere listenkopf; + generiere feldueberschriften; + generiere wiederholungsteil; + generiere abkuerzungen; + generiere seitenvorschub . + +generiere feldueberschriften : + TEXT VAR abk felder := ""; + INT VAR i; + zeilenlaenge := 4; + zeilen pro satz := 1; + write (f, "Nr. "); + FOR i FROM 1 UPTO length (feldliste) REP + feldnamen lesen (code (feldliste SUB i), feldname); + IF length (feldname) + 2 >= feld max (i) THEN + abkuerzung einfuehren + END IF; + zeilenlaenge INCR feld max (i) + 1; + IF zeilenlaenge > std breite THEN + line (f); zeilenlaenge := feld max (i) + 1; zeilen pro satz INCR 1 + END IF; + write (f, text (feldname, feld max (i) + 1)) + END REP; + line (f); + putline (f, maxlinelength (f) * "-") . + +abkuerzung einfuehren : + abk felder CAT (feldliste SUB i) . + +generiere wiederholungsteil : + putline (f, "% WDH"); + write (f, "&&? "); + FOR i FROM 1 UPTO length (feldliste) REP + ein feldmuster erzeugen + END REP; + line (f) . + +ein feldmuster erzeugen : + INT CONST abk pos := pos (abk felder, feldliste SUB i); + puffer := "&"; + IF abk pos > 0 THEN + puffer CAT text (code (abk pos + 64), feld max (i)) + ELSE + feldnamen lesen (code (feldliste SUB i), feldname); + puffer CAT text ("<" + feldname + ">", feld max (i)) + END IF; + write (f, puffer) . + +generiere abkuerzungen : + IF abk felder <> "" THEN + putline (f, "% ABK"); + FOR i FROM 1 UPTO length (abk felder) REP + eine abkuerzung generieren + END REP + END IF . + +eine abkuerzung generieren : + write (f, "&"); + write (f, code (i + 64)); + write (f, " : "); + write (f, "f ("); + feldnamen lesen (code (abk felder SUB i), feldname); + write (f, textdarstellung (feldname)); + putline (f, ") .") . + +END PROC generiere spalten druckmuster; + + +END PACKET eudas std listen; + diff --git a/app/eudas/5.3/src/eudas.menues.14 b/app/eudas/5.3/src/eudas.menues.14 new file mode 100644 index 0000000..8ccdd5e --- /dev/null +++ b/app/eudas/5.3/src/eudas.menues.14 @@ -0,0 +1,3157 @@ +PACKET eudas menues + +(*************************************************************************) +(* *) +(* Menue-Manager *) +(* *) +(* Version 14 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + global manager, + menue manager, + lock, + free, + menuedaten einlesen, + menuenamen, + menue loeschen, + + box zeichen, + waehlbar, + fusszeile, + fussteil, + ausfuehrtaste, + menue anbieten, + zeilenmenue anbieten, + auswahl anbieten, + wahl, + esc hop ausfuehren, + + hilfe anbieten, + viel hilfe, + status anzeigen, + statuszeile, + + dialogfenster, + dialogfenster loeschen, + dialog, + neuer dialog, + ja, + editget, + fehler ausgeben : + + +(***************************** Zeilenanalyse *****************************) + +ROW 7 TEXT VAR kommandotext := + ROW 7 TEXT : ("MENUE", "BILD", "FELD", "ENDE", "AUSWAHL", + "HILFE", "SEITE"); + +LET + menue kommando = 1, + bild kommando = 2, + feld kommando = 3, + ende kommando = 4, + auswahl kommando = 5, + hilfe kommando = 6, + seite kommando = 7; + +LET + bold = 2, + integer = 3, + string = 4, + end of line = 7; + +LET + fehler in zeile = #701# + "FEHLER in Zeile "; + +FILE VAR file; + +TEXT VAR + zeile, + kommando; + + +PROC zeile lesen : + + IF eof (file) THEN + zeile := "%DUMMY" + ELSE + read record (file, zeile); + IF zeile = niltext THEN zeile := blank END IF; + cout (line no (file)); + down (file) + END IF + +END PROC zeile lesen; + +BOOL PROC kommandozeile : + + IF (zeile SUB 1) = kommandozeichen THEN + kommando isolieren + ELSE + FALSE + END IF . + +kommando isolieren : + INT VAR typ; + replace (zeile, 1, blank); + scan (zeile); + replace (zeile, 1, kommandozeichen); + next symbol (kommando, typ); + IF typ <> bold THEN + fehler (kein kommando angegeben); + FALSE + ELSE + TRUE + END IF . + +END PROC kommandozeile; + +BOOL PROC kommando ist (INT CONST identifikation) : + + kommandotext (identifikation) = kommando + +END PROC kommando ist; + +INT PROC int parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = integer THEN + int (symbol) + ELSE + IF typ <> end of line THEN fehler (kein int parameter) END IF; + -1 + END IF + +END PROC int parameter; + +TEXT PROC text parameter : + + TEXT VAR symbol; + INT VAR typ; + next symbol (symbol, typ); + IF typ = string THEN + symbol + ELSE + IF typ <> end of line THEN fehler (kein text parameter) END IF; + niltext + END IF + +END PROC text parameter; + +PROC fehler (TEXT CONST meldung) : + + note (fehler in zeile); note (line no (file) - 1); note line; + note (meldung); note line; + line; putline (meldung) + +END PROC fehler; + + +(***************************** Fensterkoordinaten ************************) + +INT VAR + y laenge, + x laenge, + x pos, + y pos; + +PROC f cursor (INT CONST x, y) : + + cursor (x pos + x - 1, y pos + y - 1) + +END PROC f cursor; + + +(*************************** Box ****************************************) + +TEXT VAR + ecke links oben, + ecke rechts oben, + ecke links unten, + ecke rechts unten, + anschluss links, + anschluss rechts, + strich senkrecht, + strich waagerecht, + trennung waagerecht, + scroll voll, + scroll leer; + +TEXT VAR + blank 120 := 120 * " ", + strich 120, + trennung 120; + +box zeichen ("-:..`'::-", ""15""14"", "X "); + + +PROC box zeichen (TEXT CONST begrenzer, s voll, s leer) : + + scroll voll := s voll; scroll leer := s leer; + IF LENGTH begrenzer = 9 THEN + strich waagerecht := begrenzer SUB 1; + strich senkrecht := begrenzer SUB 2; + ecke links oben := begrenzer SUB 3; + ecke rechts oben := begrenzer SUB 4; + ecke links unten := begrenzer SUB 5; + ecke rechts unten := begrenzer SUB 6; + anschluss links := begrenzer SUB 7; + anschluss rechts := begrenzer SUB 8; + trennung waagerecht := begrenzer SUB 9 + END IF; + strich 120 := 120 * strich waagerecht; + trennung 120 := 120 * trennung waagerecht + +END PROC box zeichen; + +PROC out oben (INT CONST laenge) : + + out (ecke links oben); + outsubtext (strich 120, 1, laenge - 2); + out (ecke rechts oben) + +END PROC out oben; + +PROC out oben (INT CONST laenge, TEXT CONST kopf) : + + out (ecke links oben); + outsubtext (strich 120, 1, laenge - 3 - length (kopf)); + out (kopf); + out (strich waagerecht); out (ecke rechts oben) + +END PROC out oben; + +PROC out mitte (INT CONST laenge) : + + out (anschluss links); + outsubtext (trennung 120, 1, laenge - 2); + out (anschluss rechts) + +END PROC out mitte; + +PROC out unten (INT CONST laenge) : + + out (ecke links unten); + outsubtext (strich 120, 1, laenge - 2); + out (ecke rechts unten) + +END PROC out unten; + +PROC out leer (INT CONST x, laenge) : + + IF x + laenge >= x size THEN + out (cleol) + ELSE + outsubtext (blank 120, 1, laenge) + END IF + +END PROC out leer; + + +(**************************** Einlesen zentral ***************************) + +LET + zeile ohne zusammenhang = #702# + "Zeile ist ohne Zusammenhang", + k menuedaten im speicher = #703# + "K Menuedaten im Speicher"; + +PROC menuedaten einlesen (TEXT CONST dateiname) : + + ggf initialisieren; + file := sequential file (input, dateiname); + modify (file); + to line (file, 1); + WHILE NOT eof (file) REP + zeile lesen; + IF kommandozeile THEN + eventuell verteilen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF + END REP; + seiten anzeigen; + IF anything noted THEN + note edit (file) + END IF . + +eventuell verteilen : + IF kommando ist (menue kommando) THEN + menue aus datei lesen + ELIF kommando ist (auswahl kommando) THEN + auswahl aus datei lesen + ELIF kommando ist (hilfe kommando) THEN + hilfe aus datei lesen + ELIF NOT anything noted THEN + fehler (zeile ohne zusammenhang) + END IF . + +seiten anzeigen : + IF online THEN + line; put (anzahl ds k); + putline (k menuedaten im speicher) + END IF . + +anzahl ds k : + storage (menueds (1)) + storage (menueds (2)) + storage (menueds (3)) . + +END PROC menuedaten einlesen; + + +(**************************** TYPE MENUE *********************************) + +TYPE MENUE = STRUCT (SATZ + bild, + hilfen, + kommandos, + TEXT + feldtasten, + feldzeilen); + +BOUND ROW 200 MENUE VAR menues; + + +(************************** Menue Einlesen *******************************) + +TEXT VAR + m feldzeilen, + m feldtasten; + +SATZ VAR + m hilfen, + m kommandos; + +LET + niltext = "", + blank = " ", + feldmarkierung = ""223"", + markierungsspalte = 2, + kommandozeichen = "%", + piep = ""7"", + esc = ""27"", + cleol = ""5""; + +LET + bildkommando erwartet = #704# + "% BILD erwartet", + keine feldnr angegeben = #705# + "Feldnummer beim %FELD-Kommando fehlt", + ende fehlt = #706# + "% ENDE erwartet", + kein name angegeben = #707# + "Name fehlt", + kein kommando angegeben = #708# + "Kommandozeile enthaelt kein Kommando", + kein int parameter = #709# + "Parameter soll eine Zahl sein", + kein text parameter = #710# + "Parameter soll ein TEXT sein"; + + +PROC menue aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index; + neues menue einfuegen; + menue aus datei lesen (menues (index)) + END IF . + +neues menue einfuegen : + index := link (thesaurus (2), name); + IF index = 0 THEN + insert (thesaurus (2), name, index) + END IF . + +END PROC menue aus datei lesen; + +PROC menue aus datei lesen (MENUE VAR m) : + + menue initialisieren; + bild einlesen; + felddefinitionen bearbeiten; + auf ende testen; + ergebnis abspeichern . + +menue initialisieren : + satz initialisieren (m. bild); + satz initialisieren (m hilfen); + satz initialisieren (m kommandos); + m feldtasten := niltext; + m feldzeilen := niltext . + +bild einlesen : + teste auf bild kommando; + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE bild einlesen + ELSE + bildzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +teste auf bild kommando : + zeile lesen; + IF NOT (kommandozeile CAND kommando ist (bild kommando)) THEN + fehler (bild kommando erwartet) + END IF . + +bildzeile bearbeiten : + IF pos (zeile, feldmarkierung) > 0 THEN + m feldzeilen CAT code (zeilennr + 1); + IF (zeile SUB markierungsspalte) = feldmarkierung THEN + replace (zeile, markierungsspalte, blank) + END IF + END IF; + feld aendern (m. bild, zeilennr, zeile) . + +felddefinitionen bearbeiten : + WHILE kommando ist (feld kommando) REP + eine felddefinition bearbeiten + END REP . + +eine felddefinition bearbeiten : + INT VAR feldnr := int parameter; + IF feldnr = -1 THEN + fehler (keine feldnr angegeben); + feldnr := 100 + END IF; + hilfe text einlesen; + feldtasten einlesen; + kommandos einlesen . + +hilfe text einlesen : + feld aendern (m hilfen, feldnr, text parameter) . + +feldtasten einlesen : + TEXT CONST tasten := text parameter; + INT VAR p; + FOR p FROM 1 UPTO length (tasten) REP + m feldtasten CAT code (feldnr); + m feldtasten CAT (tasten SUB p) + END REP . + +kommandos einlesen : + TEXT VAR k := niltext; + zeile lesen; + WHILE NOT kommandozeile REP + k CAT zeile; + zeile lesen + END REP; + feld aendern (m kommandos, feldnr, k) . + +auf ende testen : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +ergebnis abspeichern : + m. hilfen := m hilfen; + m. kommandos := m kommandos; + m. feldtasten := m feldtasten; + m. feldzeilen := m feldzeilen . + +END PROC menue aus datei lesen; + + +(*************************** Menue anbieten ******************************) + +LET + ausfuehren status = #711# + "Kommando wird ausgeführt ..", + gib kommando = #712# + ""15"Gib Kommando: ", + falsche ausfuehrtaste = #713# + "falsche Ausfuehrtaste", + t existiert nicht = #714# + " existiert nicht."; + +LET + blank 50 = " ", + begin mark = ""15"", + end mark = ""14"", + frage marke = "?"8"", + ausfuehren marke = "*"8""; + +INT VAR + markenpos, + gezeichnete zeilen; + +BOOL VAR + ist zeilenmenue := FALSE, + funktionssperre veraendert, + menue init durchgefuehrt; + +TEXT VAR + menuebalken := niltext, + sperrzeichen, + menuefunktionstasten := ""32""1""2""3""8""10""13""27"", + edit kommando, + altes kommando := niltext; + +ROW 6 TEXT VAR + funktionssperre := ROW 6 TEXT : ("", "", "", "", "", ""), + fusstexte := funktionssperre; + +FENSTER VAR + balkenfenster, + fussfenster; + +fenster initialisieren (balkenfenster); +fenster initialisieren (fussfenster); + + +PROC waehlbar (INT CONST menue, funktion, BOOL CONST moeglich) : + + IF moeglich THEN + ggf sperre aufheben + ELSE + sperre setzen + END IF; + funktionssperre veraendert := TRUE . + +ggf sperre aufheben : + IF length (funktionssperre (menue)) >= funktion THEN + replace (funktionssperre (menue), funktion, " ") + END IF . + +sperre setzen : + WHILE length (funktionssperre (menue)) < funktion REP + funktionssperre (menue) CAT " " + END REP; + replace (funktionssperre (menue), funktion, "-") . + +END PROC waehlbar; + +PROC ausfuehrtaste (TEXT CONST taste) : + + IF length (taste) <> 1 COR taste schon belegt THEN + errorstop (falsche ausfuehrtaste) + ELSE + replace (menuefunktionstasten, 1, taste) + END IF . + +taste schon belegt : + taste <> ""13"" AND pos (menuefunktionstasten, taste, 2) > 0 . + +END PROC ausfuehrtaste; + +PROC fusszeile (TEXT CONST prompt1, + TEXT CONST prompt2, INT CONST pos2, + TEXT CONST prompt3, INT CONST pos3) : + + fusstexte (1) := code (1) + prompt1; + fusstexte (4) := niltext; + fusstexte (2) := code (pos2) + prompt2; + fusstexte (5) := niltext; + fusstexte (3) := code (pos3) + prompt3; + fusstexte (6) := niltext; + fenster veraendert (fussfenster) + +END PROC fusszeile; + +PROC fussteil (INT CONST index, TEXT CONST prompt, inhalt) : + + fusszeile ausgeben; + fusstexte (index) := (fusstexte (index) SUB 1) + prompt; + cursor (code (fusstexte (index) SUB 1), y size); + outsubtext (fusstexte (index), 2); + fussteil (index, inhalt) + +END PROC fussteil; + +PROC fussteil (INT CONST index, TEXT CONST inhalt) : + + INT VAR erlaubte laenge; + IF index = 3 THEN + erlaubte laenge := x size + ELSE + erlaubte laenge := code (fusstexte (index + 1) SUB 1) + END IF; + INT CONST verbrauchte laenge := + code (fusstexte (index) SUB 1) + length (fusstexte (index)) - 1; + erlaubte laenge DECR verbrauchte laenge; + fusstexte (index + 3) := subtext (inhalt, 1, erlaubte laenge); + fusszeile ausgeben; + cursor (verbrauchte laenge, y size); + outsubtext (inhalt, 1, erlaubte laenge); + outsubtext (blank 120, 1, erlaubte laenge - length (fusstexte (index + 3))) + +END PROC fussteil; + +PROC fusszeile ausgeben : + + BOOL VAR veraendert; + fensterzugriff (fussfenster, veraendert); + IF veraendert CAND fusstexte (1) <> niltext THEN + zeile ausgeben + END IF . + +zeile ausgeben : + INT VAR i; + cursor (1, y size); out (cleol); + FOR i FROM 1 UPTO 3 REP + cursor (code (fusstexte (i) SUB 1), y size); + outsubtext (fusstexte (i), 2); + out (fusstexte (i + 3)) + END REP . + +END PROC fusszeile ausgeben; + +PROC menue anbieten (ROW 6 TEXT CONST menuenamen, + FENSTER CONST f, BOOL CONST esc erlaubt, + PROC (INT CONST, INT CONST) interpreter) : + + ROW 6 INT VAR + m anfang, + m ende, + m wahl; + + INT VAR + menuenr intern, + leistenindex := 0, + neuer leistenindex := 1, + leave code := 0, + besetzte menues; + + TEXT VAR + balken; + + ROW 6 TEXT VAR + sperre, + fuss; + + BOOL VAR + save zeilenmenue; + + ggf initialisieren; + andere initialisierungen; + disable stop; + REP + menuebalken und sperre aktualisieren; + menue aufrufen; + funktion ausfuehren + END REP . + +andere initialisierungen : + fenstergroesse bestimmen; + rekursive werte sichern; + menuebalken aufbauen; + funktionssperre aufbauen . + +fenstergroesse bestimmen : + fenstergroesse setzen (balkenfenster, 1, 1, x size - 1, 1); + fenstergroesse setzen (fussfenster, 1, y size, x size - 1, 1) . + +rekursive werte sichern : + save zeilenmenue := ist zeilenmenue; + ist zeilenmenue := FALSE; + balken := menuebalken; + sperre := funktionssperre; + fuss := fusstexte . + +menuebalken aufbauen : + menuebalken := ""6""0""0""; + identifikation extrahieren; + weitere menues anfuegen; + menuebalken CAT cl eol . + +identifikation extrahieren : + INT VAR ppos := pos (menuenamen (1), "."); + IF ppos > 0 THEN + menuebalken CAT subtext (menuenamen (1), 1, ppos - 1) + END IF; + menuebalken CAT ": " . + +weitere menues anfuegen : + besetzte menues := 0; + WHILE besetzte menues < 6 CAND noch ein menue vorhanden REP + besetzte menues INCR 1; + ein weiteres menue; + m wahl (besetzte menues) := 1 + END REP . + +noch ein menue vorhanden : + menuenamen (besetzte menues + 1) <> niltext . + +ein weiteres menue : + m anfang (besetzte menues) := length (menuebalken); + ppos := pos (menuenamen (besetzte menues), "."); + IF ppos = 0 THEN + menuebalken CAT menuenamen (besetzte menues) + ELSE + menuebalken CAT subtext (menuenamen (besetzte menues), ppos + 1) + END IF; + menuebalken CAT " "; + m ende (besetzte menues) := length (menuebalken) - 1 . + +funktionssperre aufbauen : + INT VAR i; + FOR i FROM 1 UPTO 6 REP + funktionssperre (i) := niltext; + fusstexte (i) := niltext + END REP; + funktionssperre veraendert := TRUE; + interpreter (0, 0) . + +menuebalken und sperre aktualisieren : + IF neuer leistenindex > 0 THEN + altes menue demarkieren; + neues menue markieren; + leistenindex := neuer leistenindex; + neuer leistenindex := 0; + neues menue auswaehlen + END IF . + +altes menue demarkieren : + IF leistenindex > 0 THEN + replace (menuebalken, m anfang (leistenindex), " "); + replace (menuebalken, m ende (leistenindex), " "); + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF + END IF . + +neues menue markieren : + replace (menuebalken, m anfang (neuer leistenindex), begin mark); + replace (menuebalken, m ende (neuer leistenindex), end mark); + fenster veraendert (balkenfenster); + menuebalken anzeigen . + +neues menue auswaehlen : + menuenr intern := link (thesaurus (2), menuenamen (leistenindex)); + IF menuenr intern = 0 THEN + existiert nicht (menuenamen (leistenindex)); + LEAVE menue anbieten + END IF; + menue init durchgefuehrt := FALSE; + fenster veraendert (f) . + +menue aufrufen : + leave code := leistenindex; + anbieten (menues (menuenr intern), f, leave code, m wahl (leistenindex), + PROC (INT CONST, INT CONST) interpreter) . + +funktion ausfuehren : + SELECT leave code OF + CASE 0 : menue verlassen + CASE 1 : kommandodialog + CASE 2 : menuewechsel nach rechts + CASE 3 : menuewechsel nach links + CASE 4 : wahl behandeln + OTHERWISE direkte menuewahl + END SELECT . + +menuewechsel nach rechts : + IF leistenindex < besetzte menues THEN + neuer leistenindex := leistenindex + 1 + ELSE + neuer leistenindex := 1 + END IF . + +menuewechsel nach links : + IF leistenindex > 1 THEN + neuer leistenindex := leistenindex - 1 + ELSE + neuer leistenindex := besetzte menues + END IF . + +direkte menuewahl : + leave code := leave code - 10; + IF leave code <= besetzte menues THEN + neuer leistenindex := leave code + END IF . + +kommandodialog : + IF esc erlaubt THEN + BOOL VAR bild veraendert := FALSE; + REP + editget kommando; + kommando ausfuehren + UNTIL erfolgreich END REP; + IF bild veraendert THEN + bildschirm neu; + dialogfenster loeschen; + fusszeile ausgeben; + interpreter (leistenindex, -2) + END IF + END IF . + +kommando ausfuehren : + IF echtes kommando THEN + bild veraendert := TRUE; + status anzeigen (ausfuehren status); + cursor (1, 2); out (cl eop); + do (edit kommando) + END IF . + +echtes kommando : + pos (edit kommando, ""33"", ""254"", 1) > 0 . + +erfolgreich : + NOT is error . + +menue verlassen : + IF menue init durchgefuehrt THEN + interpreter (leistenindex, -1) + END IF; + fenster veraendert (f); + rekursive werte wiederherstellen; + LEAVE menue anbieten . + +rekursive werte wiederherstellen : + ist zeilenmenue := save zeilenmenue; + menuebalken := balken; + fenster veraendert (balkenfenster); + funktionssperre := sperre; + funktionssperre veraendert := TRUE; + fusstexte := fuss; + fenster veraendert (fussfenster) . + +wahl behandeln : + IF m wahl (leistenindex) > 0 THEN + interpreter (leistenindex, m wahl (leistenindex)) + ELSE + m wahl (leistenindex) := - m wahl (leistenindex) + END IF; + fusszeile ausgeben . + +END PROC menue anbieten; + +PROC menuebalken anzeigen : + + BOOL VAR veraendert; + fensterzugriff (balkenfenster, veraendert); + IF veraendert THEN out (menuebalken) END IF + +END PROC menuebalken anzeigen; + +PROC anbieten (MENUE CONST m, FENSTER CONST f, INT VAR menuenr, wahl, + PROC (INT CONST, INT CONST) interpreter) : + + INT VAR + tastenzustand := 0; + + fehler behandeln; + neuen fensterzugriff anmelden (f); + IF gezeichnete zeilen = 0 THEN + markenpos := 0 + END IF; + neuer dialog; + geaenderte funktionssperre beruecksichtigen; + REP + menuebalken anzeigen; + auf eingabe warten; + menuefunktion + END REP . + +fehler behandeln : + IF wahl > length (m. feldzeilen) THEN + wahl := markenpos; + ELIF is error THEN + fehler ausgeben; + interpreter (menuenr, -2); + END IF . + +geaenderte funktionssperre beruecksichtigen : + IF funktionssperre veraendert THEN + sperrzeichen setzen (menuenr, m); + bereits angezeigte funktionen korrigieren; + funktionssperre veraendert := FALSE + END IF . + +bereits angezeigte funktionen korrigieren : + INT VAR f index; + FOR f index FROM 1 UPTO length (m. feldzeilen) REP + INT CONST funktionszeile := code (m. feldzeilen SUB f index); + IF funktionszeile > gezeichnete zeilen THEN + LEAVE bereits angezeigte funktionen korrigieren + END IF; + erstes zeichen ausgeben (m. bild, funktionszeile) + END REP . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + halt vom terminal behandeln + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + BOOL VAR menue jetzt fertig ausgegeben := FALSE; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + bildschirm update; + cursor positionieren (m, wahl); + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + ggf init durchfuehren; + gezeichnete zeilen INCR 1; + menuezeile markiert oder nicht markiert ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +ggf init durchfuehren : + IF NOT menue init durchgefuehrt AND gezeichnete zeilen = 0 THEN + interpreter (menuenr, 0); + sperrzeichen setzen (menuenr, m); + menue init durchgefuehrt := TRUE + END IF . + +menuezeile markiert oder nicht markiert ausgeben : + IF gezeichnete zeilen = code (m. feldzeilen SUB wahl) THEN + menuezeile ausgeben (m. bild, gezeichnete zeilen, TRUE); + markenpos := wahl + ELSE + menuezeile ausgeben (m. bild, gezeichnete zeilen, FALSE) + END IF; + IF gezeichnete zeilen = y laenge THEN + menue jetzt fertig ausgegeben := TRUE + END IF . + +bildschirm update : + IF menue jetzt fertig ausgegeben AND NOT is error THEN + fusszeile ausgeben; + interpreter (menuenr, -2); + IF is error THEN clear error END IF + END IF . + +halt vom terminal behandeln : + fehler ausgeben; + menuebalken anzeigen; + gezeichnete zeilen := 0 . + +menuefunktion : + INT VAR posi; + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (menuefunktionstasten, eingabe) OF + CASE 1 : leerzeichen ausfuehren + CASE 2 : tastenzustand := 1 + CASE 3 : rechts ausfuehren + CASE 4 : oben ausfuehren + CASE 5 : links ausfuehren + CASE 6 : unten ausfuehren + CASE 7 : return ausfuehren + CASE 8 : tastenzustand := 2 + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""1""3""10"", eingabe) OF + CASE 1 : hop hop ausfuehren + CASE 2 : hop oben ausfuehren + CASE 3 : hop unten ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1""27"?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc esc ausfuehren + CASE 3 : esc fragezeichen ausfuehren + CASE 4, 5 : esc q ausfuehren + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +rechts ausfuehren : + leave code := 2; + LEAVE anbieten . + +oben ausfuehren : + IF wahl > 1 THEN + wahl DECR 1 + ELSE + wahl := length (m. feldzeilen) + END IF . + +links ausfuehren : + leave code := 3; + LEAVE anbieten . + +unten ausfuehren : + IF wahl < length (m. feldzeilen) THEN + wahl INCR 1 + ELSE + wahl := 1 + END IF . + +return ausfuehren : + unten ausfuehren . + +sondertaste : + IF menuewahl THEN + menuewahl bearbeiten + ELIF wahl fuer bestimmtes feld THEN + feld waehlen + ELIF eingabe <= ""32"" THEN + push (esc + eingabe) + END IF . + +menuewahl : + pos ("123456", eingabe) > 0 . + +menuewahl bearbeiten : + leave code := code (eingabe) - 38; + LEAVE anbieten . + +wahl fuer bestimmtes feld : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 END REP; + posi > 0 AND feld mit bildschirmposition . + +feld mit bildschirmposition : + code (m. feldtasten SUB posi - 1) <= length (m. feldzeilen) . + +feld waehlen : + wahl := code (m. feldtasten SUB posi - 1); + cursor positionieren (m, wahl); + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl); + leave code := 4; + LEAVE anbieten + END IF . + +hop hop ausfuehren : + wahl := 1 . + +hop oben ausfuehren : + wahl := 1 . + +hop unten ausfuehren : + wahl := length (m. feldzeilen) . + +belegte taste : + IF esc sonderfunktion THEN + wahl := code (m. feldtasten SUB posi - 1); + leave code := 4; + LEAVE anbieten + ELSE + push (lernsequenz auf taste (eingabe)) + END IF . + +esc sonderfunktion : + posi := 0; + REP + posi := pos (m. feldtasten, eingabe, posi + 1) + UNTIL (posi MOD 2) = 0 CAND + (posi = 0 COR feld ohne bildschirmposition) END REP; + posi > 0 . + +feld ohne bildschirmposition : + code (m. feldtasten SUB posi - 1) > length (m. feldzeilen) . + +esc esc ausfuehren : + leave code := 1; + LEAVE anbieten . + +esc fragezeichen ausfuehren : + TEXT VAR hilfe name; + wahl demarkieren (m, wahl, frage marke); + feld lesen (m. hilfen, wahl, hilfe name); + hilfe anbieten (hilfe name, d fenster); + IF is error THEN fehler ausgeben END IF; + interpreter (menuenr, -2); + neuen fensterzugriff anmelden (f) . + +esc q ausfuehren : + leave code := 0; + LEAVE anbieten . + +leerzeichen ausfuehren : + IF (funktionssperre (menuenr) SUB wahl) <> "-" THEN + wahl getroffen (m, wahl); + leave code := 4; + LEAVE anbieten + END IF . + +leave code : + menuenr . + +END PROC anbieten; + +PROC neuen fensterzugriff anmelden (FENSTER CONST f) : + + BOOL VAR veraendert; + fensterzugriff (f, veraendert); + fenstergroesse (f, x pos, y pos, x laenge, y laenge); + IF veraendert THEN + gezeichnete zeilen := 0; + f cursor (1, 1) + END IF + +END PROC neuen fensterzugriff anmelden; + +PROC sperrzeichen setzen (INT CONST menuenr, MENUE CONST m) : + + sperrzeichen := blank 50; + INT VAR i; + FOR i FROM 1 UPTO length (funktionssperre (menuenr)) REP + replace (sperrzeichen, code (m. feldzeilen SUB i), + funktionssperre (menuenr) SUB i) + END REP + +END PROC sperrzeichen setzen; + +PROC cursor positionieren (MENUE CONST m, INT CONST wahl) : + + INT CONST wahlzeile := code (m. feldzeilen SUB wahl); + IF markenpos > 0 AND markenpos <> wahl THEN + INT CONST markenzeile := code (m. feldzeilen SUB markenpos); + menuezeile ausgeben (m. bild, markenzeile, FALSE) + END IF; + menuezeile ausgeben (m. bild, wahlzeile, TRUE); + markenpos := wahl; + f cursor (2, wahlzeile) + +END PROC cursor positionieren; + +PROC getchar mit enable stop (TEXT VAR z) : + + enable stop; + getchar (z) + +END PROC getchar mit enable stop; + +PROC wahl getroffen (MENUE CONST m, INT VAR wahl) : + + wahl demarkieren (m, wahl, ausfuehren marke); + TEXT VAR k; + feld lesen (m. kommandos, wahl, k); + IF k <> niltext AND k <> blank THEN + do (k); + bildschirm neu; + wahl := - wahl + END IF . + +END PROC wahl getroffen; + +PROC wahl demarkieren (MENUE CONST m, INT CONST wahl, TEXT CONST m zeichen) : + + INT CONST y pos := code (m. feldzeilen SUB wahl); + IF gezeichnete zeilen >= y pos THEN + menuezeile ausgeben (m. bild, y pos, FALSE); + f cursor (2, y pos); + out (m zeichen) + END IF . + +END PROC wahl demarkieren; + +PROC esc hop ausfuehren : + + TEXT VAR + puffer := ""0"", + ausgang; + lernsequenz auf taste legen (""0"", niltext); + push (""27""1""0""0""); + editget (puffer, 1, 1, ""0"", "", ausgang); + out (""8""); + puffer := lernsequenz auf taste (""0""); + IF puffer <> niltext THEN + gelerntes auf richtige taste legen + ELSE + letzten nullcode auslesen + END IF . + +gelerntes auf richtige taste legen : + REP + getchar (ausgang) + UNTIL pos (""1""2""8""11""12"", ausgang) = 0 END REP; + lernsequenz auf taste legen (ausgang, puffer) . + +letzten nullcode auslesen : + getchar (ausgang) . + +END PROC esc hop ausfuehren; + + +BOOL VAR + ist trennung; + +INT VAR + anfang, + ende, + mark ende; + +PROC erstes zeichen ausgeben (SATZ CONST bild, INT CONST bildzeile) : + + f cursor (2, bildzeile); + IF (sperrzeichen SUB bildzeile) <> blank THEN + out (sperrzeichen SUB bildzeile) + ELSE + feld bearbeiten (bild, bildzeile - 1, + PROC (TEXT CONST, INT CONST, INT CONST) zeichen 1) + END IF + +END PROC erstes zeichen ausgeben; + +PROC zeichen 1 (TEXT CONST satz, INT CONST anfang, ende) : + + out (satz SUB anfang + ende - ende) + +END PROC zeichen 1; + +PROC menuezeile ausgeben (SATZ CONST bild, + INT CONST zeilennr, BOOL CONST markiert) : + + enable stop; + f cursor (1, zeilennr); + IF markiert THEN + ist trennung := FALSE; + out (strich senkrecht); + erstes zeichen ausgeben (bild, zeilennr); + out (begin mark); + anfang := 3; mark ende := 1; + bildzeile ausgeben (bild, zeilennr - 1) + ELIF zeilennr = 1 THEN + out oben (x laenge) + ELIF zeilennr = y laenge THEN + out unten (x laenge) + ELIF zeilennr = felderzahl (bild) + 2 THEN + out mitte (x laenge) + ELSE + auf trennung pruefen; + IF (sperrzeichen SUB zeilennr) = "-" THEN + out ("-"); anfang := 2 + ELSE + anfang := 1 + END IF; + mark ende := 0; + bildzeile ausgeben (bild, zeilennr - 1) + END IF . + +auf trennung pruefen : + feld bearbeiten (bild, zeilennr - 1, + PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen) . + +END PROC menuezeile ausgeben; + +PROC trennung feststellen (TEXT CONST satz, INT CONST von, bis) : + + ist trennung := (satz SUB von + bis - bis) = "-"; + IF NOT ist trennung THEN + out (strich senkrecht) + END IF + +END PROC trennung feststellen; + +PROC menuezeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + feld bearbeiten (bild, zeilennr - 1, + PROC (TEXT CONST, INT CONST, INT CONST) trennung feststellen); + anfang := 1; mark ende := 0; + bildzeile ausgeben (bild, zeilennr - 1) + +END PROC menuezeile ausgeben; + +PROC bildzeile ausgeben (SATZ CONST bild, INT CONST zeilennr) : + + IF ist trennung THEN + out mitte (x laenge) + ELSE + zeileninhalt ausgeben + END IF . + +zeileninhalt ausgeben : + feld bearbeiten (bild, zeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) abschnitt ausgeben); + zeilenrest ausgeben . + +zeilenrest ausgeben : + outsubtext (blank 120, 1, x laenge - ende - mark ende - 2); + ggf endemarkierung; + rechte begrenzung . + +ggf endemarkierung : + IF mark ende > 0 THEN + out (end mark) + END IF . + +rechte begrenzung : + out (strich senkrecht) . + +END PROC bildzeile ausgeben; + +PROC abschnitt ausgeben (TEXT CONST t, INT CONST von, bis) : + + INT CONST offset := von - 1; + anfang INCR offset; + ende := min (bis, x laenge + offset - mark ende - 2); + outsubtext (t, anfang, ende); + ende DECR offset + +END PROC abschnitt ausgeben; + +PROC editget kommando : + + LET esc k = ""27"k"; + TEXT VAR + exit char; + fenster veraendert (balkenfenster); + bei fehler altes kommando wiederholen; + markierte zeile ausgeben; + REP + kommando editieren + UNTIL exit char <> esc k END REP; + IF pos (edit kommando , ""33"", ""254"", 1) > 0 THEN + altes kommando := edit kommando + END IF . + +bei fehler altes kommando wiederholen : + IF is error THEN + fehler ausgeben; + edit kommando := altes kommando + ELSE + edit kommando := niltext + END IF . + +markierte zeile ausgeben : + cursor (1, 1); + out (gib kommando); + outsubtext (blank 120, 1, x laenge - 15); + out (end mark) . + +kommando editieren : + cursor (16, 1); + editget (edit kommando, 32000, 62, "", "kh", exit char); + IF is error THEN + clear error + ELIF exit char = esc k THEN + edit kommando := altes kommando + ELIF exit char = esc h THEN + edit kommando := niltext + END IF . + +END PROC edit get kommando; + +PROC existiert nicht (TEXT CONST dateiname) : + + errorstop ("""" + dateiname + """" + t existiert nicht) + +END PROC existiert nicht; + + +(*************************** Auswahl Einlesen ****************************) + +TYPE AUSWAHL = STRUCT (SATZ kopf); + +BOUND ROW 200 AUSWAHL VAR auswahlen; + + +PROC auswahl aus datei lesen : + + TEXT VAR name := text parameter; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + INT VAR index := link (thesaurus (3), name); + IF index = 0 THEN + insert (thesaurus (3), name, index) + END IF; + auswahl aus datei lesen (auswahlen (index)) + END IF + +END PROC auswahl aus datei lesen; + +PROC auswahl aus datei lesen (AUSWAHL VAR a) : + + menue initialisieren; + kopf einlesen; + teste auf ende . + +menue initialisieren : + satz initialisieren (a. kopf) . + +kopf einlesen : + INT VAR zeilennr := 1; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE kopf einlesen + ELSE + kopfzeile bearbeiten; + zeilennr INCR 1 + END IF + END REP . + +kopfzeile bearbeiten : + feld aendern (a. kopf, zeilennr, zeile) . + +teste auf ende : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF . + +END PROC auswahl aus datei lesen; + + +(*************************** Auswahl anbieten ****************************) + +LET + unten = ""10"", + plus esc q = "+"27"q"; + +LET + fenster zu klein = #715# + "Fenster zu klein", + auswahlstatus = #716# +"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?"; + +INT VAR + s anfang, + s ende, + wahlen, + kopfzeilen, + max wahllaenge, + gerollt; + +BOOL VAR + mit reihenfolge; + +LET INTVEC = TEXT; + +INTVEC VAR gewaehlt; + + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + auswahl anbieten (name, f, 1024, hilfe, niltext, + PROC (TEXT VAR, INT CONST) inhalt) + +END PROC auswahl anbieten; + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl, + TEXT CONST hilfe, + PROC (TEXT VAR, INT CONST) inhalt) : + + auswahl anbieten (name, f, max wahl, hilfe, niltext, + PROC (TEXT VAR, INT CONST) inhalt) + +END PROC auswahl anbieten; + +PROC auswahl anbieten (TEXT CONST name, FENSTER CONST f, INT CONST max wahl, + TEXT CONST hilfe, anfangswahl, + PROC (TEXT VAR, INT CONST) inhalt) : + + ggf initialisieren; + INT CONST index := link (thesaurus (3), name); + IF index = 0 THEN + existiert nicht (name) + ELSE + anfangswahl initialisieren; + anbieten (auswahlen (index), f, hilfe, max wahl, + PROC (TEXT VAR, INT CONST) inhalt) + END IF . + +anfangswahl initialisieren : + INT VAR i; + gewaehlt := niltext; + FOR i FROM 1 UPTO length (anfangswahl) REP + gewaehlt CAT code (anfangswahl SUB i) + END REP . + +END PROC auswahl anbieten; + +PROC anbieten (AUSWAHL CONST a, FENSTER CONST f, TEXT CONST hilfe, + INT CONST max wahl, + PROC (TEXT VAR, INT CONST) inhalt) : + + INT VAR + gezeichnete zeilen := 0, + tastenzustand := 0; + enable stop; + fensterzugriff durchfuehren; + status anzeigen (auswahlstatus); + anzahl der wahlen feststellen; + bildparameter berechnen; + auswahl initialisieren; + REP + auf eingabe warten; + auswahlfunktion durchfuehren + END REP . + +fensterzugriff durchfuehren : + BOOL VAR dummy; + fensterzugriff (f, dummy); + fenstergroesse (f, x pos, y pos, x laenge, y laenge) . + +anzahl der wahlen feststellen : + INT VAR + schritt := 1024; + wahlen := schritt; + REP + schritt := schritt DIV 2; + inhalt (zeile, wahlen); + IF zeile = niltext THEN + wahlen DECR schritt + ELSE + wahlen INCR schritt + END IF + UNTIL schritt = 1 END REP; + inhalt (zeile, wahlen); + IF zeile = niltext THEN wahlen DECR 1 END IF . + +bildparameter berechnen : + kopfzeilen := felderzahl (a. kopf) + 2; + gerollt := 0; + scroll bar berechnen; + IF kopfzeilen >= y laenge THEN + errorstop (fenster zu klein) + END IF . + +auswahl initialisieren : + INT VAR + akt zeile := kopfzeilen + 1, + alte akt zeile, + akt wahl := 1; + mit reihenfolge := max wahl > 1 . + +auf eingabe warten : + REP + ausgabe und zeichen annehmen; + IF is error THEN + clear error; + gezeichnete zeilen := 0 + ELSE + LEAVE auf eingabe warten + END IF + END REP . + +ausgabe und zeichen annehmen : + TEXT VAR eingabe; + WHILE gezeichnete zeilen < y laenge REP + eingabe := getcharety; + eventuell eine zeile ausgeben + END REP; + cursor positionieren; + getchar mit enable stop (eingabe) . + +eventuell eine zeile ausgeben : + IF eingabe = niltext THEN + IF gezeichnete zeilen = kopfzeilen THEN + alte akt zeile := 999; + max wahllaenge := 10 + END IF; + gezeichnete zeilen INCR 1; + entsprechende zeile ausgeben + ELSE + LEAVE ausgabe und zeichen annehmen + END IF . + +entsprechende zeile ausgeben : + f cursor (1, gezeichnete zeilen); + IF gezeichnete zeilen <= kopfzeilen THEN + kopfzeile ausgeben + ELSE + wiederholungszeile ausgeben + END IF . + +kopfzeile ausgeben : + IF gezeichnete zeilen = 1 THEN + out oben (x laenge) + ELIF gezeichnete zeilen = kopfzeilen THEN + out mitte (x laenge) + ELSE + menuezeile ausgeben (a. kopf, gezeichnete zeilen) + END IF . + +wiederholungszeile ausgeben : + INT CONST tatsaechliche zeile := + gezeichnete zeilen + gerollt - kopfzeilen; + IF gezeichnete zeilen = y laenge THEN + out unten (x laenge) + ELIF tatsaechliche zeile <= wahlen THEN + auswahlzeile ausgeben (tatsaechliche zeile, + scroll on zeile, FALSE, + PROC (TEXT VAR, INT CONST) inhalt); + max wahllaenge := max (max wahllaenge, length (zeile)) + ELIF tatsaechliche zeile = wahlen + 1 THEN + out mitte (x laenge) + ELSE + out (strich senkrecht); + outsubtext (blank 120, 1, x laenge - 2); + out (strich senkrecht) + END IF . + +scroll on zeile : + gezeichnete zeilen >= s anfang AND gezeichnete zeilen <= s ende . + +cursor positionieren : + IF akt zeile <> alte akt zeile THEN + IF alte akt zeile <= gezeichnete zeilen THEN + alte zeile demarkieren + END IF; + neue zeile markieren + END IF; + cursor (1, 1) . +(* f cursor (5, akt zeile) .*) + +alte zeile demarkieren : + f cursor (5, alte akt zeile); + auswahlzeile ausgeben (alte akt zeile + gerollt - kopfzeilen, FALSE, + PROC (TEXT VAR, INT CONST) inhalt) . + +neue zeile markieren : + f cursor (5, akt zeile); + auswahlzeile ausgeben (akt wahl, TRUE, + PROC (TEXT VAR, INT CONST) inhalt); + alte akt zeile := akt zeile . + +auswahlfunktion durchfuehren : + SELECT tastenzustand OF + CASE 0 : normale funktion + CASE 1 : hop funktion + CASE 2 : esc funktion + END SELECT . + +normale funktion : + SELECT pos (""1""3""10""13""27" +x-o", eingabe) OF + CASE 1 : tastenzustand := 1 + CASE 2 : oben ausfuehren + CASE 3 : unten ausfuehren + CASE 4 : return ausfuehren + CASE 5 : tastenzustand := 2 + CASE 6 : leertaste ausfuehren + CASE 7, 8 : plus ausfuehren + CASE 9, 10 : minus ausfuehren + OTHERWISE sondertaste + END SELECT . + +hop funktion : + SELECT pos (""3""10"+x-o", eingabe) OF + CASE 1 : hop oben ausfuehren + CASE 2 : hop unten ausfuehren + CASE 3, 4 : hop plus ausfuehren + CASE 5, 6 : hop minus ausfuehren + OTHERWISE out (piep) + END SELECT; + tastenzustand := 0 . + +esc funktion : + SELECT pos (""1"19?qh", eingabe) OF + CASE 1 : esc hop ausfuehren + CASE 2 : esc 1 ausfuehren + CASE 3 : esc 9 ausfuehren + CASE 4 : esc fragezeichen ausfuehren + CASE 5 : esc q ausfuehren + CASE 6 : errorstop (niltext) + OTHERWISE belegte taste + END SELECT; + tastenzustand := 0 . + +oben ausfuehren : + IF akt wahl > 1 THEN + akt zeile DECR 1; + akt wahl DECR 1; + IF akt zeile <= kopfzeilen THEN + akt zeile INCR 1; + gerollt DECR 1; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF + END IF . + +unten ausfuehren : + IF akt wahl < wahlen THEN + akt zeile INCR 1; + akt wahl INCR 1; + IF akt zeile >= y laenge THEN + akt zeile DECR 1; + gerollt INCR 1; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF + END IF . + +return ausfuehren : + push (unten) . + +leertaste ausfuehren : + push (plus esc q) . + +plus ausfuehren : + IF wahlpos (akt wahl) = 0 AND akt wahl <= wahlen THEN + wahl aufnehmen; + wahl sichtbar machen + END IF . + +wahl aufnehmen : + BOOL CONST an grenze := abs (max wahl) <= length (gewaehlt) DIV 2; + IF an grenze THEN + gewaehlt := subtext (gewaehlt, 3) + END IF; + gewaehlt CAT akt wahl . + +wahl sichtbar machen : + IF an grenze THEN + wahlpositionen ausgeben + ELIF akt zeile <= gezeichnete zeilen THEN + wahlnummer (akt zeile, length (gewaehlt) DIV 2) + END IF . + +minus ausfuehren : + INT CONST alte pos := wahlpos (akt wahl); + IF alte pos > 0 THEN + wahl entfernen; + wahlpositionen ausgeben + END IF . + +wahl entfernen : + change (gewaehlt, 2 * alte pos - 1, 2 * alte pos, niltext) . + +sondertaste : + IF eingabe < blank THEN + push (lernsequenz auf taste (eingabe)) + ELSE + out (piep) + END IF . + +hop oben ausfuehren : + IF akt zeile = kopfzeilen + 1 THEN + nach oben rollen + ELSE + nach oben + END IF . + +nach oben rollen : + INT VAR um := min (y laenge - kopfzeilen - 1, gerollt); + gerollt DECR um; + akt wahl DECR um; + IF um > 0 THEN + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF . + +nach oben : + um := akt zeile - kopfzeilen - 1; + akt zeile DECR um; + akt wahl DECR um . + +hop unten ausfuehren : + IF akt zeile = y laenge - 1 THEN + nach unten rollen + ELSE + nach unten + END IF . + +nach unten rollen : + um := min (y laenge - kopfzeilen - 1, wahlen - akt wahl); + gerollt INCR um; + akt wahl INCR um; + IF um > 0 THEN + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF . + +nach unten : + um := min (wahlen - akt wahl, y laenge - akt zeile - 1); + akt zeile INCR um; + akt wahl INCR um . + +hop plus ausfuehren : + IF wahlen > abs (max wahl) THEN + out (piep); LEAVE hop plus ausfuehren + END IF; + INT VAR w; + FOR w FROM 1 UPTO wahlen REP + IF wahlpos (w) = 0 THEN + gewaehlt CAT w + END IF + END REP; + wahlpositionen ausgeben . + +hop minus ausfuehren : + gewaehlt := niltext; + wahlpositionen ausgeben . + +esc fragezeichen ausfuehren : + hilfe anbieten (hilfe, f); + status anzeigen (auswahlstatus); + gezeichnete zeilen := 0 . + +esc q ausfuehren : + LEAVE anbieten . + +belegte taste : + push (lernsequenz auf taste (eingabe)) . + +esc 1 ausfuehren : + akt zeile := kopfzeilen + 1; + akt wahl := 1; + gerollt := 0; + scroll bar berechnen; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) . + +esc 9 ausfuehren : + INT CONST letzte zeile := kopfzeilen + wahlen; + IF letzte zeile < y laenge THEN + akt zeile := letzte zeile; + gerollt := 0 + ELSE + akt zeile := y laenge - 1; + gerollt := letzte zeile - y laenge + 1; + gezeichnete zeilen := min (gezeichnete zeilen, kopfzeilen) + END IF; + scroll bar berechnen; + akt wahl := wahlen . + +END PROC anbieten; + +PROC wahlpositionen ausgeben : + + INT VAR z, w; + w := erste angezeigte wahl; + FOR z FROM erste wahlzeile UPTO letzte wahlzeile REP + wahlnummer (z, wahlpos (w)); + w INCR 1 + END REP . + +erste angezeigte wahl : + gerollt + 1 . + +erste wahlzeile : + kopfzeilen + 1 . + +letzte wahlzeile : + min (y laenge - 1, kopfzeilen + wahlen) . + +END PROC wahlpositionen ausgeben; + +PROC scrollbar berechnen : + + INT CONST s laenge := y laenge - kopfzeilen - 1; + IF gerollt = 0 THEN + s anfang := 1 + ELSE + s anfang := max (1, gerollt * s laenge DIV wahlen) + 1 + END IF; + IF wahlen <= s laenge THEN + s ende := wahlen + ELIF wahlen - gerollt = s laenge THEN + s ende := s laenge + ELSE + s ende := min (s anfang + s laenge * s laenge DIV wahlen, s laenge - 1) + END IF; + s anfang INCR kopfzeilen; + s ende INCR kopfzeilen + +END PROC scrollbar berechnen; + + +TEXT VAR zwei bytes := "xx"; + +INT PROC wahlpos (INT CONST feld) : + + replace (zwei bytes, 1, feld); + INT VAR p := 0; + REP + p := pos (gewaehlt, zwei bytes, p + 1) + UNTIL p = 0 OR p MOD 2 = 1 END REP; + (p + 1) DIV 2 + +END PROC wahlpos; + +OP CAT (INTVEC VAR intvec, INT CONST wert) : + + replace (zwei bytes, 1, wert); + intvec CAT zwei bytes + +END OP CAT; + +PROC auswahlzeile ausgeben (INT CONST erste wahl, + BOOL CONST scroll ein, markiert, + PROC (TEXT VAR, INT CONST) inhalt) : + + out (strich senkrecht); + position ausgeben; + auswahlzeile ausgeben (erste wahl, markiert, + PROC (TEXT VAR, INT CONST) inhalt); + scrollbar ausgeben; + out (strich senkrecht) . + +position ausgeben : + INT CONST n := wahlpos (erste wahl); + IF n = 0 THEN + out (" ") + ELIF mit reihenfolge THEN + out (text (n, 3)); + ELSE + out (" x ") + END IF . + +scrollbar ausgeben : + IF scroll ein THEN out (scroll voll) ELSE out (scroll leer) END IF . + +END PROC auswahlzeile ausgeben; + +PROC auswahlzeile ausgeben (INT CONST erste wahl, BOOL CONST markiert, + PROC (TEXT VAR, INT CONST) inhalt) : + + inhalt (zeile, erste wahl); + INT VAR f laenge := min (x laenge - 8, length (zeile)); + IF markiert THEN + f laenge := min (f laenge, x laenge - 9); + out (""15"") + ELSE + out (" ") + END IF; + outsubtext (zeile, 1, f laenge); + zeilenrest loeschen . + +zeilenrest loeschen : + IF markiert THEN + outsubtext (blank 120, 1, max wahllaenge - f laenge + 1); + out (""14""); + outsubtext (blank 120, 1, x laenge - max wahllaenge - 10) + ELSE + outsubtext (blank 120, 1, x laenge - f laenge - 8) + END IF . + +END PROC auswahlzeile ausgeben; + +PROC wahlnummer (INT CONST zeile, wert) : + + f cursor (2, zeile); + IF wert = 0 THEN + out (" ") + ELIF mit reihenfolge THEN + out (text (wert, 3)) + ELSE + out (" x ") + END IF + +END PROC wahlnummer; + +INT PROC wahl (INT CONST stelle) : + + IF stelle + stelle <= length (gewaehlt) THEN + gewaehlt ISUB stelle + ELSE + 0 + END IF + +END PROC wahl; + + +(************************ Hilfen *****************************************) + +LET + maxgebiete = 200, + maxseiten = 5000; + +LET HILFE = STRUCT ( + INT anzahl seiten, + ROW maxgebiete THESAURUS hilfsnamen, + ROW maxgebiete SATZ seitenindex, + ROW maxseiten SATZ seiten); + +BOUND HILFE VAR h; + +INT VAR hx, hy, hxl, hyl; + +BOOL VAR hilfen sparen := FALSE; + +TEXT VAR zeilenpuffer; + + +(************************* Hilfe einlesen ********************************) + +LET + hilfsgebiet existiert bereits = #717# + "Das Hilfsgebiet existiert bereits", + seite existiert nicht = #718# + "Diese Seite ist in der anderen Hilfe nicht vorhanden"; + + +PROC hilfe aus datei lesen : + + TEXT VAR name := text parameter; + BOOL VAR hilfe ueberspringen; + IF name = niltext THEN + fehler (kein name angegeben) + ELSE + eintrag reservieren; + seiten einlesen; + hilfe abspeichern + END IF . + +eintrag reservieren : + INT CONST trennung := pos (name, "/"); + TEXT VAR gebiet; + IF trennung = 0 THEN + gebiet := name + ELSE + gebiet := subtext (name, 1, trennung - 1) + END IF; + gebietsindex bestimmen; + einzelindex bestimmen . + +gebietsindex bestimmen : + INT VAR gebietsindex := link (thesaurus (1), gebiet); + hilfe ueberspringen := FALSE; + IF gebietsindex = 0 THEN + insert (thesaurus (1), gebiet, gebietsindex); + h. hilfsnamen (gebietsindex) := empty thesaurus; + satz initialisieren (h. seitenindex (gebietsindex)); + ELIF trennung = 0 THEN + fehler (hilfsgebiet existiert bereits); + LEAVE hilfe aus datei lesen + ELIF hilfen sparen THEN + hilfe ueberspringen := TRUE + END IF . + +einzelindex bestimmen : + INT VAR einzelindex; + TEXT VAR einzelname := subtext (name, trennung + 1); + IF trennung = 0 THEN + einzelindex := 1 + ELSE + einzelindex := link (h. hilfsnamen (gebietsindex), einzelname); + IF einzelindex = 0 AND NOT hilfe ueberspringen THEN + insert (h. hilfsnamen (gebietsindex), einzelname, einzelindex) + END IF + END IF . + +seiten einlesen : + INT VAR vorlaeufige seiten := h. anzahl seiten; + IF vorlaeufige seiten < 0 THEN + vorlaeufige seiten := 0 + END IF; + TEXT VAR alle seiten := niltext; + zeile lesen; + WHILE kommandozeile CAND kommando ist (seite kommando) REP + eine seite einlesen + END REP . + +eine seite einlesen : + INT CONST seitennr := int parameter; + TEXT CONST referenz := text parameter; + IF referenz <> niltext THEN + seitenreferenz besorgen; + zeile lesen + ELSE + neue seite einlesen + END IF . + +seitenreferenz besorgen : + TEXT VAR referenzseiten; + seiten bestimmen (referenz, referenzseiten); + IF seitennr + seitennr <= length (referenzseiten) THEN + alle seiten CAT (referenzseiten ISUB seitennr) + ELIF NOT (anything noted OR hilfe ueberspringen) THEN + fehler (seite existiert nicht) + END IF . + +neue seite einlesen : + INT VAR zeilennr := 1; + IF NOT hilfe ueberspringen THEN + vorlaeufige seiten INCR 1; + alle seiten CAT vorlaeufige seiten; + satz initialisieren (h. seiten (vorlaeufige seiten)) + END IF; + zeilenpuffer := niltext; + REP + zeile lesen; + IF kommandozeile THEN + LEAVE neue seite einlesen + ELIF NOT hilfe ueberspringen THEN + zeile in hilfe einfuegen + END IF + END REP . + +zeile in hilfe einfuegen : + zeilenpuffer CAT zeile; + feld aendern (h. seiten (vorlaeufige seiten), zeilennr, zeilenpuffer); + IF absatzzeile THEN + zeilennr INCR 1; + zeilenpuffer := niltext + ELSE + zeilenpuffer CAT blank + END IF . + +absatzzeile : + (zeilenpuffer SUB LENGTH zeilenpuffer) = blank . + +hilfe abspeichern : + IF NOT kommando ist (ende kommando) THEN + fehler (ende fehlt) + END IF; + IF NOT (anything noted OR hilfe ueberspringen) THEN + feld aendern (h. seitenindex (gebietsindex), einzelindex, alle seiten); + h. anzahl seiten := vorlaeufige seiten + END IF . + +END PROC hilfe aus datei lesen; + +PROC seiten bestimmen (TEXT CONST name, TEXT VAR alle seiten) : + + INT CONST trennung := pos (name, "/"); + INT VAR + gebiet, + einzelindex := 0; + IF trennung = 0 THEN + gebiet := link (thesaurus (1), name) + ELSE + gebiet := link (thesaurus (1), subtext (name, 1, trennung - 1)); + einzelindex suchen + END IF; + IF einzelindex = 0 THEN + einzelindex := 1 + END IF; + IF gebiet = 0 THEN + errorstop (hilfe existiert nicht) + ELSE + feld lesen (h. seitenindex (gebiet), einzelindex, alle seiten) + END IF . + +einzelindex suchen : + IF gebiet > 0 THEN + einzelindex := + link (h. hilfsnamen (gebiet), subtext (name, trennung + 1)) + END IF . + +END PROC seiten bestimmen; + + +(************************* Hilfe anbieten ********************************) + +LET + hilfe existiert nicht = #719# + "Hilfe existiert nicht", + hilfe ist leer = #720# + "Hilfe ist leer", + t seite nr = #721# + " Seite ", + t seite von = #722# + " von ", + hilfe status = #723# +"HILFE: Beenden: ESC q Seite weiter: ESC UNTEN Seite zurueck: ESC OBEN"; + + +TEXT VAR seitenkopf; + +INT VAR + einrueckbreite, + hilfszeilennr, + hilfsanfang; + +BOOL VAR ausfuehrliche hilfe := TRUE; + + +PROC viel hilfe (BOOL CONST wirklich) : + ausfuehrliche hilfe := wirklich +END PROC viel hilfe; + +BOOL PROC viel hilfe : ausfuehrliche hilfe END PROC viel hilfe; + + +PROC hilfe anbieten (TEXT CONST name, FENSTER CONST f) : + + enable stop; + ggf initialisieren; + TEXT VAR alle seiten; + fensterzugriff anmelden; + seiten bestimmen (name, alle seiten); + IF alle seiten = niltext THEN + errorstop (hilfe ist leer) + ELSE + seiten ausgeben + END IF . + +fensterzugriff anmelden : + fenster veraendert (f); + fenstergroesse (f, hx, hy, hxl, hyl) . + +seiten ausgeben : + INT CONST hilfeseiten := length (alle seiten) DIV 2; + tastenpuffer loeschen; + status anzeigen (hilfe status); + INT VAR seitenindex := 1; + REP + eine seite ausgeben; + kommando annehmen + END REP . + +eine seite ausgeben : + INT CONST tatsaechliche seite := alle seiten ISUB seitenindex; + seitenkopf := t seite nr + text (seitenindex) + t seite von; + seitenkopf CAT text (hilfeseiten); seitenkopf CAT " "; + IF length (seitenkopf) + 2 > hxl THEN seitenkopf := niltext END IF; + seite ausgeben (h. seiten (tatsaechliche seite)) . + +kommando annehmen : + TEXT VAR eingabe; + REP + getchar (eingabe); + IF eingabe = esc THEN + getchar (eingabe); + kommando ausfuehren; + LEAVE kommando annehmen + ELSE + out (piep) + END IF + END REP . + +kommando ausfuehren : + SELECT pos ("q"10""3"?"1"", eingabe) OF + CASE 1 : LEAVE hilfe anbieten + CASE 2 : eine seite weiter + CASE 3 : eine seite zurueck + CASE 4 : an anfang + CASE 5 : esc hop ausfuehren + OTHERWISE out (piep) + END SELECT . + +eine seite weiter : + IF seitenindex < hilfeseiten THEN + seitenindex INCR 1 + END IF . + +eine seite zurueck : + IF seitenindex > 1 THEN + seitenindex DECR 1 + END IF . + +an anfang : + seitenindex := 1 . + +END PROC hilfe anbieten; + +PROC seite ausgeben (SATZ CONST seite) : + + INT VAR zeilennr; + hilfszeilennr := 1; + hilfsanfang := 0; + kopfzeile ausgeben; + einrueckbreite := 0; + FOR zeilennr FROM 1 UPTO hyl - 2 REP + cursor (hx, hy + zeilennr); + feld bearbeiten (seite, hilfszeilennr, + PROC (TEXT CONST, INT CONST, INT CONST) zeile ausgeben) + END REP; + letzte zeile ausgeben . + +kopfzeile ausgeben : + cursor (hx, hy); + out oben (hxl, seitenkopf) . + +letzte zeile ausgeben : + cursor (hx, hy + hyl - 1); + out unten (hxl); + cursor (1, 1) . + +END PROC seite ausgeben; + +PROC zeile ausgeben (TEXT CONST bild, INT CONST von, bis) : + + ende := min (hilfsanfang + von + hxl - 3 - einrueckbreite, bis); + IF von <= bis CAND (bild SUB von) = "-" THEN + out mitte (hxl); + hilfszeilennr INCR 1; + einrueckbreite := 0 + ELSE + umbruch; + wirklich ausgeben; + naechsten zeilenanfang setzen + END IF . + +umbruch : + IF ende < bis THEN + IF umbruch noetig CAND umbruch moeglich THEN + ende zuruecksetzen + END IF + END IF . + +umbruch noetig : + (bild SUB ende + 1) <> " " AND (bild SUB ende) <> " " . + +umbruch moeglich : + pos (bild, " ", hilfsanfang + von, ende) > 0 . + +ende zuruecksetzen : + WHILE (bild SUB ende) <> " " REP ende DECR 1 END REP . + +wirklich ausgeben : + out (strich senkrecht); + outsubtext (blank 120, 1, einrueckbreite); + outsubtext (bild, von + hilfsanfang, ende); + outsubtext (blank 120, 1, + hxl + von + hilfsanfang - einrueckbreite - ende - 3); + out (strich senkrecht) . + +naechsten zeilenanfang setzen : + IF ende < bis THEN + ggf einrueckbreite setzen; + hilfsanfang := ende - von + 1; + ende INCR 1; + WHILE (bild SUB ende) = " " REP + hilfsanfang INCR 1; ende INCR 1 + END REP + ELSE + hilfsanfang := 0; + hilfszeilennr INCR 1; + einrueckbreite := 0 + END IF . + +ggf einrueckbreite setzen : + IF einrueckbreite = 0 CAND hilfsanfang = 0 THEN + einrueckbreite := pos (bild, " ", von, ende); + IF einrueckbreite > 0 THEN + einrueckbreite auf wortanfang + END IF + END IF . + +einrueckbreite auf wortanfang : + WHILE (bild SUB einrueckbreite) = " " REP + einrueckbreite INCR 1 + END REP; + einrueckbreite DECR von . + +END PROC zeile ausgeben; + + +(*********************** Statuszeile *************************************) + +BOOL VAR status zeigen := TRUE; + +PROC statuszeile (BOOL CONST modus) : + status zeigen := modus +END PROC statuszeile; + +BOOL PROC statuszeile : + status zeigen +END PROC statuszeile; + + +PROC status anzeigen (TEXT CONST status) : + + IF status zeigen THEN + cursor (1, 1); out (" "); + out (status); + out (cl eol); + fenster veraendert (balkenfenster) + END IF + +END PROC status anzeigen; + + +(***************************** Basisauswahl *******************************) + +LET max funktionen = 20; + +ROW max funktionen INT VAR w anf; + +INT VAR + position, + gesamtlaenge, + h zeile, + p zeile, + cursor x alt, + cursor y alt; + +TEXT VAR prompt; + + +PROC basisauswahl (MENUE CONST m, INT CONST x anf, INT VAR wahl) : + + enable stop; + BOOL VAR menue ausgegeben := FALSE; + REP + IF NOT menue ausgegeben THEN + menue ausgeben + END IF; + zeichen annehmen; + kommando ausfuehren + END REP . + +menue ausgeben : + INT VAR i; + cursor (x anf, h zeile); + position := x anf; + w anf (1) := position; + FOR i FROM 1 UPTO felderzahl (m. bild) REP + out (" "); position INCR 1; + feld bearbeiten (m. bild, i, + PROC (TEXT CONST, INT CONST, INT CONST) m out incr); + out (" "); position INCR 1; + w anf (i + 1) := position; + END REP; + gesamtlaenge := position; + menue ausgegeben := TRUE; + aktuelle wahl markieren (m. bild, wahl) . + +zeichen annehmen : + TEXT VAR zeichen; + getchar (zeichen) . + +kommando ausfuehren : + SELECT pos (""2""8""13" "1""27"", zeichen) OF + CASE 1 : neue wahl (m. bild, wahl, wahl + 1) + CASE 2 : neue wahl (m. bild, wahl, wahl - 1) + CASE 3, 4 : exit wahl (m. bild, wahl); LEAVE basisauswahl + CASE 5 : hop kommando + CASE 6 : esc kommando + OTHERWISE direkte wahl + END SELECT . + +direkte wahl: + INT VAR d pos := 0; + REP + d pos := pos (m. feldtasten, zeichen, d pos + 1) + UNTIL (d pos MOD 2) = 0 END REP; + IF d pos = 0 THEN + IF zeichen < ""32"" THEN push (""27"" + zeichen) ELSE out (""7"") END IF + ELSE + neue wahl (m. bild, wahl, code (m. feldtasten SUB d pos - 1)); + exit wahl (m. bild, wahl); + LEAVE basisauswahl + END IF . + +esc kommando : + TEXT VAR zweites; + getchar (zweites); + SELECT pos (""1"qh?"27"", zweites) OF + CASE 1 : esc hop ausfuehren + CASE 2 : wahl := 0; LEAVE basisauswahl + CASE 3 : errorstop ("") + CASE 4 : exit wahl (m. bild, wahl); wahl := - wahl; + LEAVE basisauswahl + CASE 5 : wahl := - 32000; LEAVE basisauswahl + OTHERWISE push (lernsequenz auf taste (zweites)) + END SELECT . + +hop kommando : + getchar (zweites); + SELECT pos (""8""2"", zweites) OF + CASE 1 : neue wahl (m. bild, wahl, 1) + CASE 2 : neue wahl (m. bild, wahl, felderzahl (m. bild)) + OTHERWISE out (""7"") + END SELECT . + +END PROC basisauswahl; + +PROC menueheader (SATZ CONST bild, INT CONST wahl) : + + IF p zeile > 0 THEN + cursor (1, p zeile); + out (""15""); out (prompt); position := length (prompt) + 1; + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out rechts); + out (" "14"") + END IF + +END PROC menueheader; + +PROC aktuelle wahl markieren (SATZ CONST bild, INT CONST wahl) : + + menueheader (bild, wahl); + cursor (w anf (wahl), h zeile); + out (""15""); + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + out (" "14""); + cursor (cursor x alt, cursor y alt) + +END PROC aktuelle wahl markieren; + +PROC neue wahl (SATZ CONST bild, INT VAR wahl, INT CONST neu) : + + alte wahl demarkieren; + wahl := neu; + IF wahl < 1 THEN + wahl := felderzahl (bild) + ELIF wahl > felderzahl (bild) THEN + wahl := 1 + END IF; + aktuelle wahl markieren (bild, wahl) . + +alte wahl demarkieren : + cursor (w anf (wahl), h zeile); + out (" "); + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + out (" ") . + +END PROC neue wahl; + +PROC exit wahl (SATZ CONST bild, INT CONST wahl) : + + cursor (w anf (1), h zeile); + w anf (wahl) - w anf (1) + 1 TIMESOUT " "; + feld bearbeiten (bild, wahl, + PROC (TEXT CONST, INT CONST, INT CONST) m out); + gesamtlaenge - w anf (wahl + 1) + 2 TIMESOUT " " + +END PROC exit wahl; + +PROC m out incr (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) - 1; + IF grenze < 0 THEN grenze := bis END IF; + outsubtext (satz, von, grenze); + position INCR grenze - von + 1 + +END PROC m out incr; + +PROC m out (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) - 1; + IF grenze < 0 THEN grenze := bis END IF; + outsubtext (satz, von, grenze) + +END PROC m out; + +PROC m out rechts (TEXT CONST satz, INT CONST von, bis) : + + INT VAR grenze := pos (satz, " ", von) + 1; + IF grenze < 2 THEN grenze := bis + 1 END IF; + x size - 5 - position - bis + grenze TIMESOUT " "; + outsubtext (satz, grenze, bis) + +END PROC m out rechts; + +PROC zeilenmenue anbieten (TEXT CONST m name, BOOL CONST esc erlaubt, + PROC (INT CONST) kommandos) : + + BOOL VAR save zeilenmenue := ist zeilenmenue; + INT VAR m index := link (thesaurus (2), m name); + IF m index = 0 THEN + existiert nicht (m name); LEAVE zeilenmenue anbieten + END IF; + h zeile := y size; p zeile := y size - 1; + get cursor (cursor x alt, cursor y alt); + prompt := m name; + disable stop; + ist zeilenmenue := TRUE; + auswahl durchfuehren; + kommando ausfuehren; + ist zeilenmenue := save zeilenmenue . + +auswahl durchfuehren : + INT VAR wahl := 1; + REP + basisauswahl (menues (m index), 1, wahl); + IF wahl >= 0 THEN + LEAVE auswahl durchfuehren + ELIF wahl = -32000 THEN + IF esc erlaubt THEN LEAVE auswahl durchfuehren END IF + ELSE + wahl := - wahl; + TEXT VAR hilfsname; + feld lesen (menues (m index). hilfen, wahl, hilfsname); + hilfe anbieten (hilfsname, d fenster) + END IF + UNTIL is error END REP . + +kommando ausfuehren : + IF wahl > 0 THEN + exec im enable stop (wahl, PROC (INT CONST) kommandos) + ELIF wahl = - 32000 THEN + gib kommando im menue + END IF . + +gib kommando im menue : + cursor (1, y size - 1); + out (""4""); out (gib kommando); out (""14""); + TEXT VAR dummy := ""; + editget (dummy); + IF dummy <> "" THEN + do (dummy) + END IF . + +END PROC zeilenmenue anbieten; + +PROC exec im enable stop (INT CONST wahl, PROC (INT CONST) kommandos) : + + enable stop; + kommandos (wahl) + +END PROC exec im enable stop; + + +(******************************* Dialog **********************************) + +LET + cleop = ""4"", + esc fragezeichen = ""27"?", + esc q = ""27"q", + esc h = ""27"h"; + +LET +(*ja text = #724# + " Ja ", + nein text = #725# + "Nein",*) + fragezeichen = #726# + " ?", + horizontal auswahl status = #727# +"WAHL: Wählen: <-, -> Bestätigen: RETURN Abbruch: ESC h Hilfe: ESC ?", + ja status = #728# +"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?", + editget status ohne esc z = #729# +"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?", + editget status mit esc z = #730# +"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?", + fehler status = #731# +""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?"; + +FENSTER VAR d fenster; +fenster initialisieren (d fenster); + +INT VAR + dialogzeile, + dx, + dy, + dxl, + dyl; + + +PROC dialogfenster (FENSTER CONST fe) : + + fenstergroesse (fe, dx, dy, dxl, dyl); + fenstergroesse setzen (d fenster, fe) + +END PROC dialogfenster; + +FENSTER PROC dialogfenster : + + d fenster + +END PROC dialogfenster; + +PROC neuer dialog : + + dialogzeile := dyl + +END PROC neuer dialog; + +PROC dialog box : + + BOOL VAR veraendert; + fensterzugriff (d fenster, veraendert); + dialogzeile INCR 3; + IF dialogzeile + 3 > dyl OR veraendert THEN + loeschvorgang dialogfenster; + dialogzeile := 1 + END IF; + rahmen zeichnen; + cursor (dx + 1, dy + dialogzeile) . + +rahmen zeichnen : + cursor (dx, dy + dialogzeile - 1); + out oben (dxl); + cursor (dx, dy + dialogzeile); + leere boxzeile; + cursor (dx, dy + dialogzeile + 1); + leere boxzeile; + cursor (dx, dy + dialogzeile + 2); + out unten (dxl) . + +END PROC dialog box; + +PROC leere boxzeile : + + out (strich senkrecht); + outsubtext (blank 120, 1, dxl - 2); + out (strich senkrecht) + +END PROC leere boxzeile; + +PROC dialog (TEXT CONST ausgabe) : + + dialog box; + outsubtext (ausgabe, 1, dxl - 2); + cursor (dx + 1, dy + dialogzeile + 1) + +END PROC dialog; + +PROC dialogfenster loeschen : + + fenster veraendert (d fenster); + loeschvorgang dialogfenster + +END PROC dialogfenster loeschen; + +PROC loeschvorgang dialogfenster : + + BOOL CONST bis zeilenende := dx + dxl >= x size; + dialogzeile := 0; + REP + cursor (dx, dy + dialogzeile); + IF bis zeilenende THEN + out (cleol) + ELSE + outsubtext (blank 120, 1, dxl) + END IF; + dialogzeile INCR 1 + UNTIL dialogzeile >= dyl END REP + +END PROC loeschvorgang dialogfenster; + +PROC auswahl anbieten (TEXT CONST m name, prompt, hilfe, INT VAR ergebnis) : + + INT VAR auswahl nr := link (thesaurus (2), m name); + IF auswahl nr = 0 THEN + existiert nicht (m name); LEAVE auswahl anbieten + END IF; + REP + status anzeigen (horizontal auswahl status); + dialog box; + outsubtext (prompt, 1, dxl - 2); + auswahl durchfuehren + END REP . + +auswahl durchfuehren : + INT CONST alte wahl := ergebnis; + h zeile := dy + dialogzeile + 1; p zeile := 0; + cursor x alt := 1; cursor y alt := 1; + basisauswahl (menues (auswahl nr), dx + 1, ergebnis); + IF ergebnis >= 0 THEN + IF ergebnis = 0 THEN ergebnis := alte wahl END IF; + LEAVE auswahl anbieten + ELIF ergebnis = - 32000 THEN + ergebnis := 1 + ELSE + hilfe anbieten (hilfe, d fenster); + neuer dialog; + ergebnis := - ergebnis + END IF . + +END PROC auswahl anbieten; + +BOOL PROC ja (TEXT CONST frage, hilfe) : + + ja (frage, hilfe, TRUE) + +END PROC ja; + +BOOL PROC ja (TEXT CONST frage, hilfe, BOOL CONST default) : + + INT VAR wahl; + IF default THEN wahl := 1 ELSE wahl := 2 END IF; + REP + status anzeigen (ja status); + IF ist zeilenmenue THEN + cursor (1, y size); + INT CONST fragelaenge := min (length (frage), x size - 16); + outsubtext (frage, 1, fragelaenge); out (""5"") + ELSE + dialog box; + outsubtext (frage, 1, dxl - 4); + END IF; + out (fragezeichen); + tastenpuffer loeschen; + ja auswahl durchfuehren + END REP; + FALSE . + +ja auswahl durchfuehren : + basisauswahl initialisieren; + basisauswahl (ja auswahl, auswahl anfang, wahl); + IF wahl = 1 THEN + LEAVE ja WITH TRUE + ELIF wahl = 2 THEN + LEAVE ja WITH FALSE + ELIF wahl = -32000 THEN + wahl := 1 + ELIF wahl = 0 THEN + errorstop ("") + ELSE + hilfe anbieten (hilfe, d fenster); + neuer dialog; + wahl := - wahl + END IF . + +basisauswahl initialisieren : + INT VAR auswahl anfang; + IF ist zeilenmenue THEN + h zeile := y size; p zeile := 0; + auswahl anfang := fragelaenge + 4 + ELSE + h zeile := dy + dialogzeile + 1; p zeile := 0; + cursor x alt := 1; cursor y alt := 1; + auswahl anfang := dx + 1 + END IF . + +ja auswahl : + menues (link (thesaurus (2), "WAHL.Ja")) . + +END PROC ja; + +PROC editget (TEXT CONST prompt, TEXT VAR eingabe, TEXT CONST res, hilfe) : + + TEXT VAR exit char; + passenden status anzeigen; + IF ist zeilenmenue THEN + cursor (1, y size); out (""5""); put (prompt); + ELSE + dialog (prompt); +(* cursor (dx + 1, dy + dialogzeile + 1); out (">"); + cursor (dx + dxl - 2, dy + dialogzeile + 1); out ("<");*) + cursor (dx + 1, dy + dialogzeile + 1) + END IF; + editget (eingabe, 1000, editlaenge, "", "?hq" + res, exit char); + cursor (1, 1); + IF exit char = esc fragezeichen THEN + hilfe anbieten (hilfe, d fenster); + neuer dialog; + editget (prompt, eingabe, res, hilfe) + ELIF exit char = esc h OR exit char = esc q THEN + errorstop (niltext) + ELIF length (exit char) = 2 THEN + eingabe := exit char + eingabe + END IF . + +passenden status anzeigen : + IF pos (res, "z") > 0 THEN + status anzeigen (editget status mit esc z) + ELSE + status anzeigen (editget status ohne esc z) + END IF . + +editlaenge : + IF ist zeilenmenue THEN + x size - length (prompt) - 2 + ELSE + dxl - 4 + END IF . + +END PROC editget; + +PROC fehler ausgeben : + + TEXT CONST meldung := errormessage; + IF error code = 1 THEN + page; bildschirm neu + END IF; + clear error; + tastenpuffer loeschen; + IF meldung <> niltext THEN + status anzeigen (fehler status); + meldung ausgeben; + eingabe abwarten; + neuer dialog + END IF . + +meldung ausgeben : + dialog box; + out (piep); out (">>> "); + cursor (dx + 1, dy + dialogzeile + 1); + outsubtext (errormessage, 1, dxl - 2) . + +eingabe abwarten : + TEXT VAR eingabe; + cursor (1, 1); + getchar (eingabe); + IF eingabe = esc THEN + esc funktionen + END IF . + +esc funktionen : + getchar (eingabe); + IF eingabe = "?" THEN + hilfe anbieten ("FEHLER/" + text (errorcode), d fenster) + ELIF eingabe = ""1"" THEN + esc hop ausfuehren + END IF . + +END PROC fehler ausgeben; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + + +(************************** Menue Manager ********************************) + +LET + max ds = 3, + save order = 12, + erase order = 14, + fetch order = 1070, + lock order = 1068, + free order = 1069, + ack = 0, + error nak = 2; + +ROW maxds DATASPACE VAR menue ds; + +ROW maxds THESAURUS VAR thesaurus; + +BOOL VAR vater ist menuemanager := FALSE; + +INITFLAG VAR menueinitialisierung; + + +PROC ggf initialisieren : + + IF NOT initialized (menueinitialisierung) THEN + initialisierung durchfuehren + END IF . + +initialisierung durchfuehren : + BOOL VAR erfolgreich := vater ist menuemanager; + datenraeume holen; + IF erfolgreich THEN + ankoppeln + ELSE + menue loeschen (FALSE) + END IF . + +datenraeume holen : + INT VAR nr; + FOR nr FROM 1 UPTO maxds + WHILE erfolgreich REP + versuche zu holen + END REP . + +versuche zu holen : + INT VAR + reply, + retries; + FOR retries FROM 1 UPTO 10 REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + pingpong (father, fetch order + nr, menue ds (nr), reply); + IF reply = ack THEN + LEAVE versuche zu holen + ELIF reply <> error nak THEN + pause (15) + END IF + UNTIL reply = error nak END REP; + forget (menue ds (nr)); + menue ds (nr) := nilspace; + erfolgreich := FALSE . + +END PROC ggf initialisieren; + +THESAURUS PROC menuenamen (INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + h. hilfsnamen (- nr) + ELSE + thesaurus (nr) + END IF + +END PROC menuenamen; + +PROC menue loeschen (TEXT CONST name, INT CONST nr) : + + ggf initialisieren; + IF nr < 0 THEN + loeschen (name, h. hilfsnamen (- nr)) + ELSE + loeschen (name, thesaurus (nr)) + END IF + +END PROC menue loeschen; + +PROC loeschen (TEXT CONST name, THESAURUS VAR t) : + + INT CONST index := link (t, name); + IF index > 0 THEN + delete (t, index) + END IF + +END PROC loeschen; + +PROC menue loeschen (BOOL CONST hilfen reduzieren) : + + INT VAR nr; + menueinitialisierung := TRUE; + hilfen sparen := hilfen reduzieren; + FOR nr FROM 1 UPTO max ds REP + forget (menue ds (nr)); + menue ds (nr) := nilspace; + thesaurus (nr) := empty thesaurus + END REP; + ankoppeln + +END PROC menue loeschen; + +PROC ankoppeln : + + h := menue ds (1); + menues := menue ds (2); + auswahlen := menue ds (3) + +END PROC ankoppeln; + + +LET + lock aktiv = #732# + "Datei wird von anderer Task geaendert.", + auftrag nur fuer soehne = #733# + "Auftrag nur fuer Soehne erlaubt"; + +THESAURUS VAR locks := empty thesaurus; + +ROW 200 TASK VAR lock owner; + +TEXT VAR save file name; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg; + +PROC menue manager (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + enable stop; + vater ist menue manager := TRUE; + IF order >= lock order AND order <= fetch order + max ds THEN + menue auftrag + ELSE + IF order = save order OR order = erase order THEN + save pre + END IF; + free manager (ds, order, phase, order task) + END IF . + +menue auftrag : + IF order = lock order THEN + lock ausfuehren + ELIF order = free order THEN + free ausfuehren + ELSE + menue fetch + END IF . + +lock ausfuehren : + msg := ds; + set lock (msg. name, order task); + send (order task, ack, ds) . + +free ausfuehren : + msg := ds; + reset lock (msg. name); + send (order task, ack, ds) . + +save pre : + IF phase = 1 THEN + lock ueberpruefen + ELIF order = erase order THEN + reset lock (save file name) + END IF . + +lock ueberpruefen : + msg := ds; + save file name := msg. name; + IF gesperrt und task ungleich THEN + errorstop (lock aktiv) + END IF . + +gesperrt und task ungleich : + INT VAR stelle := link (locks, save file name); + stelle > 0 CAND NOT (lock owner (stelle) = order task) . + +menue fetch : + IF order task < myself THEN + ggf initialisieren; + forget (ds); ds := menue ds (order - fetch order); + send (order task, ack, ds) + ELSE + errorstop (auftrag nur fuer soehne) + END IF . + +END PROC menue manager; + +PROC set lock (TEXT CONST dateiname, TASK CONST owner) : + + INT VAR i := link (locks, dateiname); + IF i = 0 THEN + insert (locks, dateiname, i); + ggf reorganisieren; + lock owner (i) := owner + ELIF exists (lock owner (i)) THEN + IF NOT (lock owner (i) = owner) THEN + errorstop (lock aktiv) + END IF + ELSE + lock owner (i) := owner + END IF . + +ggf reorganisieren : + IF i = 0 THEN + locks reorganisieren; + insert (locks, dateiname, i) + END IF . + +locks reorganisieren : + TEXT VAR eintrag; + i := 0; + REP + get (locks, eintrag, i); + IF i = 0 THEN + LEAVE locks reorganisieren + END IF; + IF NOT exists (eintrag) OR NOT exists (lock owner (i)) THEN + delete (locks, i) + END IF + END REP . + +END PROC set lock; + +PROC reset lock (TEXT CONST dateiname) : + + INT VAR i; + delete (locks, dateiname, i) + +END PROC reset lock; + +PROC global manager : + + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, + TASK CONST) menue manager) + +END PROC global manager; + +PROC lock (TEXT CONST dateiname, TASK CONST manager) : + + call (lock order, dateiname, manager) + +END PROC lock; + +PROC free (TEXT CONST dateiname, TASK CONST manager) : + + call (free order, dateiname, manager) + +END PROC free; + +END PACKET eudas menues; + diff --git a/app/eudas/5.3/src/eudas.saetze.03 b/app/eudas/5.3/src/eudas.saetze.03 new file mode 100644 index 0000000..d3f53f1 --- /dev/null +++ b/app/eudas/5.3/src/eudas.saetze.03 @@ -0,0 +1,271 @@ +PACKET eudas satzzugriffe + +(*************************************************************************) +(* *) +(* Feldstrukturierung von Texten *) +(* *) +(* Version 03 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 17.04.87 *) +(* *) +(*************************************************************************) + + DEFINES + + SATZ, + := , + satz initialisieren, + felderzahl, + feld lesen, + feld bearbeiten, + feld aendern, + feldindex : + + +LET + maximale felderzahl = 256, + zeigerlaenge = 2; + +LET + blank = " ", + niltext = ""; + +LET + illegale feldnummer = #101# + " ist keine Feldnummer"; + +TEXT VAR + raum fuer ein int := zeigerlaenge * blank; + + +(**************************** Typ SATZ ***********************************) + +TYPE SATZ = TEXT; + +OP := (SATZ VAR links, SATZ CONST rechts) : + + CONCR (links) := CONCR (rechts) + +END OP := ; + + +(************************ Satz initialisieren ****************************) + +PROC satz initialisieren (SATZ VAR satz) : + + satz initialisieren (satz, 0) + +END PROC satz initialisieren; + +PROC satz initialisieren (SATZ VAR satz, INT CONST felder) : + + replace (raum fuer ein int, 1, 2 * felder + 3); + INT VAR i; + CONCR (satz) := niltext; + FOR i FROM 1 UPTO felder + 1 REP + CONCR (satz) CAT raum fuer ein int + END REP + +END PROC satz initialisieren; + + +(*************************** Felderzahl **********************************) + +INT PROC felderzahl (SATZ CONST satz) : + + INT VAR letzter zeiger := (CONCR (satz) ISUB 1) DIV 2; + INT CONST satzende := CONCR (satz) ISUB letzter zeiger; + REP + letzter zeiger DECR 1 + UNTIL letzter zeiger <= 0 COR kein leeres feld END REP; + letzter zeiger . + +kein leeres feld : + (CONCR (satz) ISUB letzter zeiger) <> satzende . + +END PROC felderzahl; + + +(************************** Feld lesen ***********************************) + +PROC feld lesen (SATZ CONST satz, INT CONST feldnr, TEXT VAR inhalt) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + inhalt := subtext (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld lesen; + +PROC feld bearbeiten (SATZ CONST satz, INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + feldgrenzen bestimmen (CONCR (satz), feldnr); + IF NOT is error THEN + bearbeite (CONCR (satz), feldanfang, feldende) + END IF + +END PROC feld bearbeiten; + + +(************************ Feldgrenzen bestimmen **************************) + +INT VAR + feldanfang, + feldende; + +PROC feldgrenzen bestimmen (TEXT CONST satz, INT CONST feldnr) : + + IF illegales feld THEN + errorstop (text (feldnr) + illegale feldnummer) + ELIF vorhandenes feld THEN + feldanfang := satz ISUB feldnr; + feldende := (satz ISUB feldnr + 1) - 1 + ELSE + feldanfang := 1; feldende := 0 + END IF . + +illegales feld : + feldnr <= 0 OR feldnr > maximale felderzahl . + +vorhandenes feld : + feldnr + feldnr < (satz ISUB 1) - 1 . + +END PROC feldgrenzen bestimmen; + + +(*************************** Feld aendern ********************************) + +TEXT VAR puffer; + +PROC feld aendern (SATZ VAR satz, INT CONST feldnr, TEXT CONST inhalt) : + + INT VAR zeigerstelle; + INT CONST satzfelder := ((CONCR (satz) ISUB 1) - 2) DIV 2; + IF normales feld THEN + normal ersetzen + ELSE + errorstop (text (feldnr) + illegale feldnummer) + END IF . + +normales feld : + feldnr > 0 AND feldnr <= maximale felderzahl . + +normal ersetzen : + INT CONST fehlende zeiger := feldnr - satzfelder; + IF fehlende zeiger <= 0 THEN + vorhandenes feld ersetzen + ELIF inhalt <> niltext THEN + neues feld anfuegen + END IF . + +neues feld anfuegen : + INT CONST endezeiger := CONCR (satz) ISUB (satzfelder + 1); + puffer := subtext (CONCR (satz), erstes feld, endezeiger - 1); + CONCR (satz) := subtext (CONCR (satz), 1, satzfelder + satzfelder); + korrigiere zeiger (CONCR (satz), 1, satzfelder, platz fuer zeiger); + neue zeiger anfuegen; + endezeiger anfuegen; + CONCR (satz) CAT puffer; + CONCR (satz) CAT inhalt . + +platz fuer zeiger : + fehlende zeiger + fehlende zeiger . + +neue zeiger anfuegen : + INT CONST neuer zeiger := endezeiger + platz fuer zeiger; + FOR zeigerstelle FROM satzfelder + 1 UPTO feldnr REP + zeiger anfuegen (CONCR (satz), neuer zeiger) + END REP . + +endezeiger anfuegen : + zeiger anfuegen (CONCR (satz), neuer zeiger + length (inhalt)) . + +erstes feld: + CONCR (satz) ISUB 1 . + +vorhandenes feld ersetzen : + INT CONST + feldanfang := CONCR (satz) ISUB feldnr, + naechster feldanfang := CONCR (satz) ISUB (feldnr + 1); + IF feldanfang > length (CONCR (satz)) THEN + optimiere leerfelder + ELSE + ersetze beliebig + END IF . + +optimiere leerfelder : + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + length (inhalt)); + CONCR (satz) CAT inhalt . + +ersetze beliebig : + puffer := subtext (CONCR (satz), naechster feldanfang); + CONCR (satz) := subtext (CONCR (satz), 1, feldanfang - 1); + korrigiere zeiger (CONCR (satz), feldnr + 1, satzfelder + 1, + laengendifferenz); + CONCR (satz) CAT inhalt; + CONCR (satz) CAT puffer . + +laengendifferenz : + length (inhalt) - feldlaenge . + +feldlaenge : + naechster feldanfang - feldanfang . + +END PROC feld aendern; + +PROC zeiger anfuegen (TEXT VAR satz, INT CONST zeigerwert) : + + replace (raum fuer ein int, 1, zeigerwert); + satz CAT raum fuer ein int + +END PROC zeiger anfuegen; + +PROC korrigiere zeiger (TEXT VAR satz, INT CONST anfang, ende, differenz) : + + INT VAR zeigerstelle; + FOR zeigerstelle FROM anfang UPTO ende REP + replace (satz, zeigerstelle, alter zeiger + differenz) + END REP . + +alter zeiger : + satz ISUB zeigerstelle . + +END PROC korrigiere zeiger; + + +(*************************** 'feldindex' *********************************) + +INT PROC feldindex (SATZ CONST satz, TEXT CONST muster) : + + INT VAR + anfang := (CONCR (satz) ISUB 1) - 1, + zeigerstelle := 1; + + REP + anfang := pos (CONCR (satz), muster, anfang + 1); + IF anfang = 0 THEN + LEAVE feldindex WITH 0 + END IF; + durchsuche zeiger ob feldanfang + UNTIL zeiger zeigt auf anfang CAND naechster zeiger hinter ende END REP; + zeigerstelle . + +durchsuche zeiger ob feldanfang : + WHILE (CONCR (satz) ISUB zeigerstelle) < anfang REP + zeigerstelle INCR 1 + END REP . + +zeiger zeigt auf anfang : + (CONCR (satz) ISUB zeigerstelle) = anfang . + +naechster zeiger hinter ende : + (CONCR (satz) ISUB (zeigerstelle + 1)) = anfang + length (muster) . + +END PROC feldindex; + + +END PACKET eudas satzzugriffe; + diff --git a/app/eudas/5.3/src/eudas.satzanzeige.12 b/app/eudas/5.3/src/eudas.satzanzeige.12 new file mode 100644 index 0000000..0fc5cd9 --- /dev/null +++ b/app/eudas/5.3/src/eudas.satzanzeige.12 @@ -0,0 +1,1007 @@ +PACKET satzanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Saetzen *) +(* *) +(* Version 12 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 05.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + anzeigefenster, + bild ausgeben, + aendern, + einfuegen, + suchen, + feldauswahl, + rollen, + exit durch, + exit zeichen : + + +LET + maxfelder = 256; + +LET + blank = " ", + niltext = "", + cleol = ""5"", + begin mark = ""15"", + blank end mark = " "14"", + blank end mark blank = " "14" "; + +ROW maxfelder STRUCT (INT feldnr, anfang) VAR zeilen; + +INT VAR + anzahl zeilen, + erste zeile, + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + feldnamenlaenge, + inhaltsbreite, + zuletzt angezeigter satz := 0, + letzte kombi := 0, + anzeigeversion := dateiversion - 1, + anzeigedateien := 0; + +BOOL VAR + neues fenster := TRUE, + bis zeilenende := TRUE, + save ds voll := FALSE, + namen ausgeben; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +DATASPACE VAR + save ds, + edit ds; + +FILE VAR edit file; + +TEXT VAR + ueberschrift, + zeilenpuffer; + +LET + fenster zu klein = #801# + "Anzeigefenster zu klein"; + + +PROC anzeigefenster (FENSTER CONST fe) : + + INT VAR x anf, y anf, x laenge, y laenge; + fenstergroesse (fe, x anf, y anf, x laenge, y laenge); + IF x laenge >= 39 THEN + fenstergroesse setzen (fenster, fe); + bis zeilenende := x anf + x laenge >= x size; + breite := x laenge; laenge := y laenge; + spalten anf := x anf; + zeilen anf := y anf; + neues fenster := TRUE + ELSE + errorstop (fenster zu klein) + END IF + +END PROC anzeigefenster; + +FENSTER PROC anzeigefenster : + fenster +END PROC anzeigefenster; + +PROC fensterzugriff anmelden : + + BOOL VAR fenster veraendert; + fensterzugriff (fenster, fenster veraendert); + IF fenster veraendert THEN + namen ausgeben := TRUE + END IF + +END PROC fensterzugriff anmelden; + +PROC zeilendeskriptor aktualisieren : + + IF neue datei seit letztem mal OR neues fenster THEN + neue feldnummern uebernehmen; + feldnamenlaenge bestimmen; + ueberschrift generieren; + fuer bildausgabe sorgen; + edit datei loeschen; + veraenderungsstatus merken + END IF . + +neue datei seit letztem mal : + anzeigeversion <> dateiversion . + +neue feldnummern uebernehmen : + anzahl zeilen := 0; + WHILE anzahl zeilen < anzahl felder REP + anzahl zeilen INCR 1; + zeilen (anzahl zeilen). feldnr := anzahl zeilen + END REP; + erste zeile := 1 . + +feldnamenlaenge bestimmen : + INT VAR feldnr; + feldnamenlaenge := 11; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen bearbeiten (feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) namen max) + END REP; + feldnamenlaenge := min (feldnamenlaenge, breite DIV 3); + inhaltsbreite := breite - feldnamenlaenge - 3 . + +fuer bildausgabe sorgen : + namen ausgeben := TRUE . + +edit datei loeschen : + forget (edit ds); + edit ds := nilspace; + IF neue datei seit letztem mal AND save ds voll THEN + forget (save ds); + save ds voll := FALSE + END IF . + +veraenderungsstatus merken : + anzeigeversion := dateiversion; + anzeigedateien := anzahl dateien; + neues fenster := FALSE . + +END PROC zeilendeskriptor aktualisieren; + +PROC namen max (TEXT CONST satz, INT CONST von, bis) : + + feldnamenlaenge INCR length (satz) - length (satz); + (* damit Parameter benutzt *) + feldnamenlaenge := max (feldnamenlaenge, bis - von + 1) + +END PROC namen max; + +PROC rollen (INT CONST vektor) : + + erste zeile := erste zeile + vektor; + IF erste zeile < 1 THEN + erste zeile := 1 + ELIF erste zeile > letzte zeile THEN + erste zeile := max (letzte zeile, 1) + END IF; + namen ausgeben := TRUE . + +letzte zeile : + anzahl zeilen - laenge + 3 . + +END PROC rollen; + +PROC feldauswahl (TEXT CONST wahlvektor) : + + zeilendeskriptor aktualisieren; + feldnummern uebernehmen; + namen ausgeben := TRUE . + +feldnummern uebernehmen : + anzahl zeilen := length (wahlvektor); + INT VAR zeilennr; + FOR zeilennr FROM 1 UPTO anzahl zeilen REP + zeilen (zeilennr). feldnr := code (wahlvektor SUB zeilennr) + END REP; + erste zeile := 1 . + +END PROC feldauswahl; + + +(**************************** editfile ***********************************) + +INT VAR gelesene zeile; + +PROC edit file loeschen : + + type (edit ds, - 1); + edit file := sequential file (modify, edit ds); + edit info (edit file, -1); + to line (editfile, 1); + col (editfile, 1); + maxlinelength (edit file, 10000); + gelesene zeile := 1 + +END PROC edit file loeschen; + +. +noch zeile zu bearbeiten : + gelesene zeile <= anzahl zeilen . + +PROC naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) bearbeite) : + + zu bearbeitende zeilen bestimmen; + IF eof (editfile) THEN + bearbeite ("", feldnr) + ELIF mehrere zeilen THEN + zeilen verketten; + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr) + ELIF blanks am ende THEN + read record (edit file, zeilenpuffer); + blanks abschneiden; + bearbeite (zeilenpuffer, feldnr); + down (edit file) + ELSE + exec (PROC (TEXT CONST, INT CONST) bearbeite, edit file, feldnr); + down (edit file) + END IF . + +zu bearbeitende zeilen bestimmen : + INT CONST + von := gelesene zeile, + feldnr := zeilen (von). feldnr; + REP + gelesene zeile INCR 1 + UNTIL gelesene zeile > anzahl zeilen COR neues feld END REP . + +neues feld : + zeilen (gelesene zeile). feldnr <> feldnr . + +mehrere zeilen : + gelesene zeile - von > 1 . + +zeilen verketten : + zeilenpuffer := ""; + REP + exec (PROC (TEXT CONST, INT CONST) verkette, + edit file, length (zeilenpuffer)); + down (edit file) + UNTIL eof (edit file) OR line no (edit file) = gelesene zeile END REP . + +blanks am ende : + INT CONST ende := len (edit file); + subtext (edit file, ende, ende) = blank . + +END PROC naechste zeile bearbeiten; + +PROC verkette (TEXT CONST edit zeile, INT CONST pufferlaenge) : + + IF pufferlaenge > 0 CAND (zeilenpuffer SUB pufferlaenge) <> blank + CAND (edit zeile SUB 1) <> blank THEN + zeilenpuffer CAT blank + END IF; + zeilenpuffer CAT edit zeile + +END PROC verkette; + +PROC blanks abschneiden : + + INT VAR ende := length (zeilenpuffer); + WHILE (zeilenpuffer SUB ende) = blank REP + ende DECR 1 + END REP; + zeilenpuffer := subtext (zeilenpuffer, 1, ende) + +END PROC blanks abschneiden; + + +(*************************** Funktionen **********************************) + + +BOOL VAR aus einfuegen; + +PROC einfuegen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + editieren (PROC hilfe); + satz einfuegen; + aus einfuegen := TRUE; + felder aendern + END IF + +END PROC einfuegen; + +PROC felder aendern : + + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten + (PROC (TEXT CONST, INT CONST) ein feld aendern) + END REP; + aenderungen eintragen + +END PROC felder aendern; + +PROC ein feld aendern (TEXT CONST inhalt, INT CONST feldnr) : + + IF NOT aus einfuegen COR inhalt <> niltext THEN + feld aendern (feldnr, inhalt) + END IF + +END PROC ein feld aendern; + +PROC aendern (PROC hilfe) : + + enable stop; + IF dateiende THEN + einfuegen (PROC hilfe) + ELSE + wirklich aendern + END IF . + +wirklich aendern : + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + bild aufbauen (namen ausgeben); + feldinhalte eintragen; + editieren (PROC hilfe); + aus einfuegen := FALSE; + felder aendern + END IF . + +feldinhalte eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + feld bearbeiten (zeilen (kopierzeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) inhalt kopieren); + insert record (edit file); + write record (edit file, zeilenpuffer); + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +END PROC aendern; + +INT VAR kopierzeile; + +PROC inhalt kopieren (TEXT CONST satz, INT CONST von, bis) : + + zeilenpuffer := subtext (satz, feldanfang, feldende) . + +feldanfang : + von + zeilen (kopierzeile). anfang . + +feldende : + IF keine fortsetzung THEN + bis + ELSE + von + zeilen (kopierzeile + 1). anfang - 1 + END IF . + +keine fortsetzung : + kopierzeile = anzahl zeilen COR + zeilen (kopierzeile + 1). feldnr <> zeilen (kopierzeile). feldnr . + +END PROC inhalt kopieren; + +PROC suchen (PROC hilfe) : + + enable stop; + zeilendeskriptor aktualisieren; + IF anzahl zeilen > 0 THEN + edit file loeschen; + fensterzugriff anmelden; + IF such version <> 0 THEN + altes suchmuster eintragen + END IF; + editieren (PROC hilfe); + suchbedingung einstellen + END IF . + +altes suchmuster eintragen : + kopierzeile := 1; + WHILE kopierzeile <= anzahl zeilen REP + insert record (edit file); + suchmusterzeile eintragen; + down (edit file); + kopierzeile INCR 1 + END REP; + to line (edit file, 1) . + +suchmusterzeile eintragen : + IF zeilen (kopierzeile). anfang = 0 THEN + suchbedingung lesen (zeilen (kopierzeile). feldnr, zeilenpuffer); + write record (edit file, zeilenpuffer) + END IF . + +suchbedingung einstellen : + suchbedingung loeschen; + WHILE noch zeile zu bearbeiten REP + naechste zeile bearbeiten (PROC (TEXT CONST, INT CONST) zeilenbedingung) + END REP . + +END PROC suchen; + +PROC zeilenbedingung (TEXT CONST zeile, INT CONST feldnr) : + + suchbedingung (feldnr, zeile) + +END PROC zeilenbedingung; + +PROC bild ausgeben (BOOL CONST datei veraendert) : + + enable stop; + zeilendeskriptor aktualisieren; + fensterzugriff anmelden; + IF datei veraendert OR namen ausgeben OR anderer satz THEN + bild aufbauen (namen ausgeben); + zuletzt angezeigter satz := satznummer; + letzte kombi := satzkombination; + einzelbild ausgeben (TRUE) + ELSE + ueberschrift ausgeben (TRUE) + END IF . + +anderer satz : + satznummer <> zuletzt angezeigter satz OR letzte kombi <> satzkombination . + +END PROC bild ausgeben; + + +(*************************** Bild aufbauen *******************************) + +INT VAR anfang; + +BOOL VAR fertig; + + +PROC bild aufbauen (BOOL CONST kuerzen erlaubt) : + + INT VAR + zeilennr := 1, + alte feldnr := 0; + fertig := TRUE; + WHILE zeilennr <= anzahl zeilen OR NOT fertig REP + eine zeile behandeln + END REP . + +eine zeile behandeln : + IF fertig CAND zeilen (zeilennr). feldnr = alte feldnr THEN + eventuell zusammenruecken + ELSE + IF altes feld beendet THEN + feldwechsel + END IF; + zeilen (zeilennr). anfang := anfang; + feld bearbeiten (zeilen (zeilennr). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) laenge bestimmen); + zeilennr INCR 1 + END IF . + +eventuell zusammenruecken : + IF kuerzen erlaubt THEN + zeile loeschen (zeilennr) + ELSE + zeilen (zeilennr). anfang := anfang; + zeilennr INCR 1 + END IF . + +altes feld beendet : + zeilennr > anzahl zeilen COR zeilen (zeilennr). feldnr <> alte feldnr . + +feldwechsel : + IF fertig THEN + neues feld anfangen + ELSE + zeile einfuegen (zeilennr); + zeilen (zeilennr). feldnr := alte feldnr + END IF . + +neues feld anfangen : + alte feldnr := zeilen (zeilennr). feldnr; + anfang := 0 . + +END PROC bild aufbauen; + +PROC laenge bestimmen (TEXT CONST satz, INT CONST von, bis) : + + INT CONST restlaenge := bis - von - anfang + 1; + IF restlaenge > inhaltsbreite - 2 THEN + anfang INCR inhaltsbreite - 2; + rueckwaerts blank suchen; + fertig := FALSE + ELSE + anfang INCR restlaenge; + fertig := TRUE + END IF . + +rueckwaerts blank suchen : + INT VAR stelle := von + anfang - 1; + IF trennung im wort AND blanks vorhanden THEN + WHILE (satz SUB stelle) <> blank REP + stelle DECR 1; anfang DECR 1 + END REP + END IF . + +trennung im wort : + (satz SUB stelle) <> blank . + +blanks vorhanden : + pos (satz, blank, stelle - inhaltsbreite + 3, stelle - 1) > 0 . + +END PROC laenge bestimmen; + +PROC zeile einfuegen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM anzahl zeilen DOWNTO zeilennr REP + zeilen (i+1) := zeilen (i) + END REP; + anzahl zeilen INCR 1; + namen ausgeben := TRUE + +END PROC zeile einfuegen; + +PROC zeile loeschen (INT CONST zeilennr) : + + INT VAR i; + FOR i FROM zeilennr + 1 UPTO anzahl zeilen REP + zeilen (i-1) := zeilen (i) + END REP; + anzahl zeilen DECR 1; + namen ausgeben := TRUE + +END PROC zeile loeschen; + + +(************************** Editieren ************************************) + +INT VAR rueckkehrcode; + +TEXT VAR + zeilenrest, + zeile vorher, + zeile nachher, + quit zeichen := "", + quit durch; + +LET + hinweiszeile = #802# + ""15" Bild verschoben ! ESC 1 druecken ! "14""; + +LET + eudas res = ""3""10"19"11""12""13"q?hpg"; + +LET + oben = 1, + unten = 2, + eins = 3, + neun = 4, + rubin = 5, + rubout = 6, + return = 7, + edit ende = 8, + frage = 9, + abbruch = 10, + double = 11, + esc get = 12; + + +PROC editieren (PROC hilfe) : + + INT VAR alte zeilennr := erste zeile; + lernsequenz auf taste legen ("D", date); + REP + einzelbild ausgeben (FALSE); + file verlaengern; + erste und letzte zeile markieren; + file editieren; + nachbehandeln + UNTIL wirklich verlassen END REP; + to line (edit file, 1); + col (edit file, 1) . + +file verlaengern : + IF lines (edit file) < anzahl zeilen + 1 THEN + output (edit file); + line (editfile, anzahl zeilen - lines (editfile) + 2); + modify (edit file) + END IF . + +erste und letzte zeile markieren : + IF erste zeile <> 1 THEN + einsetzen (erste zeile - 1, zeile vorher) + END IF; + einsetzen (zeile nach bildschirm, zeile nachher); + to line (edit file, alte zeilennr) . + +zeile nach bildschirm : + min (anzahl zeilen + 1, erste zeile + laenge - 1) . + +file editieren : + open editor (groesster editor + 1, edit file, TRUE, + spalten anf + feldnamenlaenge + 3, zeilen anf, + inhaltsbreite, editlaenge); + edit (groesster editor, eudas res + quit zeichen, + PROC (TEXT CONST) eudas interpreter); + auf lernwarnmeldung achten . + +auf lernwarnmeldung achten : + INT VAR test x, test y; + get cursor (test x, test y); + IF test x <> 1 THEN bildschirm neu END IF . + +editlaenge : + min (anzahl zeilen - erste zeile + 2, laenge) . + +nachbehandeln : + alte zeilennr := line no (edit file); + hinweiszeilen entfernen; + SELECT rueckkehrcode OF + CASE oben : nach oben rollen + CASE unten : nach unten rollen + CASE eins : auf erste zeile + CASE neun : auf letzte zeile + CASE rubin : zeile umbrechen + CASE rubout : zeile entfernen + CASE return : aktuelle zeile als anfang + CASE frage : hilfe; namen ausgeben := TRUE + CASE abbruch : errorstop (niltext) + CASE double : in save ds kopieren + CASE esc get : aus save ds holen + END SELECT . + +hinweiszeilen entfernen : + INT CONST spalte := col (edit file); + col (edit file, 1); + IF erste zeile <> 1 THEN + entfernen (erste zeile - 1, zeile vorher) + END IF; + entfernen (zeile nach bildschirm, zeile nachher); + col (edit file, spalte) . + +nach oben rollen : + INT VAR abstand; + abstand := alte zeilennr - erste zeile; + rollen (-laenge + 1); + alte zeilennr := erste zeile + abstand . + +nach unten rollen : + abstand := alte zeilennr - erste zeile; + rollen (laenge - 1); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +auf erste zeile : + rollen (-999); + alte zeilennr := 1 . + +auf letzte zeile : + abstand := alte zeilennr - erste zeile; + rollen (999); + alte zeilennr := min (erste zeile + abstand, anzahl zeilen) . + +zeile umbrechen : + to line (edit file, alte zeilennr); + aktuelle zeile aufsplitten; + zeile einfuegen (alte zeilennr) . + +aktuelle zeile aufsplitten : + read record (edit file, zeilenpuffer); + zeilenrest := subtext (zeilenpuffer, spalte); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer); + down (edit file); + insert record (edit file); + write record (edit file, zeilenrest) . + +zeile entfernen : + to line (edit file, alte zeilennr); + IF spalte = 1 AND + (nicht letzte zeile CAND noch gleiche dahinter OR + nicht erste zeile CAND noch gleiche davor) THEN + ganz loeschen + ELSE + nur ueberschreiben + END IF . + +nicht letzte zeile : + alte zeilennr <> anzahl zeilen . + +noch gleiche dahinter : + zeilen (alte zeilennr + 1). feldnr = zeilen (alte zeilennr). feldnr . + +nicht erste zeile : + alte zeilennr <> 1 . + +noch gleiche davor : + zeilen (alte zeilennr - 1). feldnr = zeilen (alte zeilennr). feldnr . + +ganz loeschen : + delete record (edit file); + zeile loeschen (alte zeilennr); + IF alte zeilennr > anzahl zeilen THEN + alte zeilennr := anzahl zeilen + END IF . + +nur ueberschreiben : + read record (edit file, zeilenpuffer); + zeilenpuffer := subtext (zeilenpuffer, 1, spalte - 1); + write record (edit file, zeilenpuffer) . + +aktuelle zeile als anfang : + abstand := alte zeilennr - erste zeile; + rollen (abstand) . + +in save ds kopieren : + forget (save ds); + save ds := edit ds; + save ds voll := TRUE . + +aus save ds holen : + IF save ds voll THEN + forget (edit ds); + edit ds := save ds; + edit file := sequential file (modify, edit ds) + END IF . + +wirklich verlassen : + rueckkehrcode = edit ende . + +END PROC editieren; + +PROC eudas interpreter (TEXT CONST zeichen) : + + enable stop; + set busy indicator; + rueckkehrcode := pos (eudas res, zeichen); + IF rueckkehrcode > 0 THEN + quit durch := zeichen; + quit + ELIF pos (quit zeichen, zeichen) > 0 THEN + rueckkehrcode := edit ende; + quit durch := zeichen; + quit + ELIF kommando auf taste (zeichen) <> niltext THEN + std kommando interpreter (zeichen) + ELSE + nichts neu + END IF + +END PROC eudas interpreter; + +PROC einsetzen (INT CONST zeilennr, TEXT VAR speicher) : + + to line (edit file, zeilennr); + read record (edit file, speicher); + write record (edit file, hinweiszeile) + +END PROC einsetzen; + +PROC entfernen (INT CONST zeilennr, TEXT CONST speicher) : + + to line (edit file, zeilennr); + IF eof (edit file) COR pos (edit file, hinweiszeile, 1) = 0 THEN + to line (edit file, 1); + down (edit file, hinweiszeile); + IF eof (edit file) THEN + to line (edit file, zeilennr); + insert record (edit file) + END IF + END IF; + write record (edit file, speicher) + +END PROC entfernen; + +PROC exit zeichen (TEXT CONST zeichenkette) : + + quit zeichen := zeichenkette + +END PROC exit zeichen; + +TEXT PROC exit durch : + + quit durch + +END PROC exit durch; + + +(****************************** Ausgabe **********************************) + +INT VAR ausgabezeile; + +LET + t ende = #803# + "ENDE.", + t such plus = #804# + "SUCH+", + t such minus = #805# + "SUCH-", + t mark plus = #806# + "MARK+", + t mark minus = #807# + "MARK-", + t feld = #808# + " Zeile "14" ", + t satz = #809# + " Satz ", + t koppel = #810# + "<KOPPEL>"; + +LET + fuenf punkte = ".....", + sieben blanks = " "; + + +PROC einzelbild ausgeben (BOOL CONST auch inhalte) : + + INT VAR + bildschirmzeile := zeilen anf + 1, + aktuelles feld := 0; + INT CONST letzte ausgabezeile := erste zeile + laenge - 2; + ueberschrift ausgeben (auch inhalte); + ausgabezeile := erste zeile; + WHILE ausgabezeile <= letzte ausgabezeile REP + feldnamen ausgeben; + feldinhalt ausgeben; + evtl unterbrechung; + bildschirmzeile INCR 1; + ausgabezeile INCR 1 + END REP; + namen ausgeben := FALSE . + +feldnamen ausgeben : + IF namen ausgeben THEN + cursor (spalten anf, bildschirmzeile); + IF ausgabezeile <= anzahl zeilen THEN + namen tatsaechlich ausgeben + ELIF ausgabezeile = anzahl zeilen + 1 THEN + endebalken ausgeben + ELSE + bildschirmzeile loeschen + END IF + END IF . + +namen tatsaechlich ausgeben : + out (begin mark); + IF zeilen (ausgabezeile). feldnr = aktuelles feld THEN + feldnamenlaenge TIMESOUT blank + ELSE + aktuelles feld := zeilen (ausgabezeile). feldnr; + feldnamen bearbeiten (aktuelles feld, + PROC (TEXT CONST, INT CONST, INT CONST) randanzeige) + END IF; + out (blank end mark) . + +endebalken ausgeben : + out (begin mark); + breite - 4 TIMESOUT "."; + out (blank end mark blank) . + +bildschirmzeile loeschen : + IF bis zeilenende THEN + out (cleol) + ELSE + breite TIMESOUT blank + END IF . + +feldinhalt ausgeben : + IF auch inhalte AND ausgabezeile <= anzahl zeilen THEN + cursor (spalten anf + feldnamenlaenge + 3, bildschirmzeile); + feld bearbeiten (zeilen (ausgabezeile). feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) feldteil ausgeben) + END IF . + +evtl unterbrechung : + IF NOT namen ausgeben THEN + TEXT CONST input := getcharety; + IF input <> niltext THEN + push (input); + IF pos (quit zeichen, input) > 0 THEN + zuletzt angezeigter satz := 0; + LEAVE einzelbild ausgeben + END IF + END IF + END IF . + +END PROC einzelbild ausgeben; + +PROC ueberschrift ausgeben (BOOL CONST auch inhalte) : + + satznummer bestimmen; + satznummer in ueberschrift; + cursor (spalten anf, zeilen anf); + IF NOT auch inhalte THEN + outsubtext (ueberschrift, 1, feldnamenlaenge + 3); + LEAVE ueberschrift ausgeben + END IF; + replace (ueberschrift, feldnamenlaenge + 7, auswahlzeichen); + replace (ueberschrift, feldnamenlaenge + 14, markzeichen); + out (ueberschrift); + cursor (spalten anf + breite - 5, zeilen anf); + out (text (erste zeile)) . + +satznummer bestimmen : + TEXT VAR satznr; + satznr := text (satznummer); + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + satznr CAT "-"; + satznr CAT text (satzkombination) + END IF . + +satznummer in ueberschrift : + replace (ueberschrift, 7, sieben blanks); + replace (ueberschrift, 7, satznr) . + +auswahlzeichen : + IF such version = 0 THEN + fuenf punkte + ELIF satz ausgewaehlt THEN + t such plus + ELSE + t such minus + END IF . + +markzeichen : + IF dateiende THEN + t ende + ELIF markierte saetze = 0 THEN + fuenf punkte + ELIF satz markiert THEN + t mark plus + ELSE + t mark minus + END IF . + +END PROC ueberschrift ausgeben; + +PROC randanzeige (TEXT CONST satz, INT CONST von, bis) : + + IF bis - von >= feldnamenlaenge THEN + outsubtext (satz, von, von + feldnamenlaenge - 1) + ELSE + outsubtext (satz, von, bis); + feldnamenlaenge - bis + von - 1 TIMESOUT blank + END IF + +END PROC randanzeige; + +PROC feldteil ausgeben (TEXT CONST satz, INT CONST von, bis) : + + INT VAR ende; + IF ausgabezeile = anzahl zeilen COR letzte feldzeile THEN + ende := bis + ELSE + ende := von + zeilen (ausgabezeile + 1). anfang - 1 + END IF; + outsubtext (satz, von + zeilen (ausgabezeile). anfang, ende); + IF bis zeilenende THEN + out (cleol) + ELSE + laenge bis zum rand TIMESOUT blank + END IF . + +letzte feldzeile : + zeilen (ausgabezeile + 1). feldnr <> zeilen (ausgabezeile). feldnr . + +laenge bis zum rand : + inhaltsbreite - ende + von + zeilen (ausgabezeile). anfang - 1 . + +END PROC feldteil ausgeben; + +PROC ueberschrift generieren : + + ueberschrift := text (t satz, feldnamenlaenge + 3); + ueberschrift CAT begin mark; + INT VAR i; + INT CONST punktlaenge := breite - length (ueberschrift) - 12; + FOR i FROM 1 UPTO punktlaenge REP + ueberschrift CAT "." + END REP; + ueberschrift CAT t feld; + ggf koppel in ueberschrift . + +ggf koppel in ueberschrift : + IF auf koppeldatei THEN + replace (ueberschrift, feldnamenlaenge + 22, t koppel) + END IF . + +END PROC ueberschrift generieren; + + +END PACKET satzanzeige; + diff --git a/app/eudas/5.3/src/eudas.steuerung.14 b/app/eudas/5.3/src/eudas.steuerung.14 new file mode 100644 index 0000000..f96047b --- /dev/null +++ b/app/eudas/5.3/src/eudas.steuerung.14 @@ -0,0 +1,2535 @@ +PACKET eudas steuerung + +(*************************************************************************) +(* *) +(* Menuesteuerung von EUDAS *) +(* *) +(* Version 14 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 06.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + eudas, + + einzelsicherung, + suchen, + aendern, + einfuegen, + prueffehler editieren, + feldstruktur, + feldnamen anzeigen, + formatieren automatisch, + + arbeitsbereich bestimmen, + dateiverwaltung, + archivverwaltung : + + + +(**************************** Variablen ***********************************) + +INT VAR + file typ := 1003, + eudas typ := 3243; + +IF l3 THEN file typ := 1004 END IF . + +l3 : maxint DIV 2 > 17000 . +; + +LET + niltext = "", + blank = " ", + cleop = ""4"", + cleol = ""5""; + +FILE VAR test file; + +DATASPACE VAR test ds; + +INT VAR + belegter heap, + test version := dateiversion - 1; + +TEXT VAR + feldpuffer; + + +(*************************** EUDAS ***************************************) + +BOOL VAR + eudas schon aktiv := FALSE; + +LET + menue 1 = #1101# + "EUDAS.Öffnen", + menue 2 = #1102# + "EUDAS.Einzelsatz", + menue 3 = #1103# + "EUDAS.Gesamtdatei", + menue 4 = #1104# + "EUDAS.Drucken", + menue 5 = #1105# + "EUDAS.Dateien", + menue 6 = #1106# + "EUDAS.Archiv"; + +LET + kein rekursiver aufruf = #1107# + "EUDAS kann nicht unter EUDAS aufgerufen werden", + suchmuster eingeben = #1108# + "Suchbedingung einstellen", + alle saetze drucken = #1109# + "Alle Sätze drucken", + alle markierten saetze drucken = #1110# + "Alle markierten Sätze drucken", + einzelsatz drucken = #1111# + "Aktuellen Satz drucken", + uebersicht wiederholen = #1112# + "Mit neuer Auswahl noch einmal", + akt datei = #1113# + ""15"Akt.Datei "14"", + datum doppelpunkt = #1114# + ""15"Datum "14""; + + +PROC eudas : + + IF aktueller editor > 0 THEN + eudas kurzabfrage + ELIF eudas schon aktiv THEN + errorstop (kein rekursiver aufruf) + ELSE + eudas aufrufen + END IF . + +eudas aufrufen : + fenstergroessen bestimmen; + page; bildschirm neu; + belegter heap := heap size; + disable stop; + eudas schon aktiv := TRUE; + menue anbieten (ROW 6 TEXT : (menue 1, menue 2, menue 3, + menue 4, menue 5, menue 6), + fenster links, TRUE, + PROC (INT CONST, INT CONST) eudas interpreter); + eudas schon aktiv := FALSE; + enable stop; + auf sicherung ueberpruefen; + page; bildschirm neu + +END PROC eudas; + +PROC eudas kurzabfrage : + + TEXT VAR gewaehlte feldnamen := niltext; + bild frei; + auf sicherung ueberpruefen; + IF nicht alle gesichert THEN + LEAVE eudas kurzabfrage + END IF; + oeffnen im menue (FALSE); + auf satz (1); + feldauswahl fuer uebersicht (gewaehlte feldnamen); + REP + ggf suchmuster eingeben; + uebersicht (gewaehlte feldnamen, PROC uebersicht hilfe); + bild frei; + saetze drucken + UNTIL nicht noch einmal END REP; + dateien loeschen (FALSE) . + +nicht alle gesichert : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + LEAVE nicht alle gesichert WITH TRUE + END IF + END REP; + FALSE . + +ggf suchmuster eingeben : + IF ja (suchmuster eingeben, "JA/Suchmuster") THEN + suchen; alles neu + END IF . + +saetze drucken : + IF markierte saetze = 0 CAND alle drucken THEN + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht) + ELIF markierte saetze > 0 CAND alle markierten drucken THEN + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht); + markierungen loeschen + ELIF einzelsatz THEN + markierungen loeschen; markierung aendern; + einzelausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke uebersicht); + markierungen loeschen + END IF . + +alle drucken : + ja (alle saetze drucken, "JA/alle Saetze", FALSE) . + +alle markierten drucken : + ja (alle markierten saetze drucken, "JA/alle markierten") . + +einzelsatz : + ja (einzelsatz drucken, "JA/Einzelsatz drucken") . + +nicht noch einmal : + NOT ja (uebersicht wiederholen, "JA/noch einmal", FALSE) . + +END PROC eudas kurzabfrage; + +PROC bild frei : + + bildschirm neu; + cursor (1, 1); + out (cleop) + +END PROC bild frei; + +PROC drucke uebersicht (TEXT CONST dateiname) : + + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + uebersetzungsfehler behandeln; + bild frei + +END PROC drucke uebersicht; + +PROC eudas interpreter (INT CONST menuenr, wahl nr) : + + enable stop; + SELECT menuenr OF + CASE 0 : waehlbarkeit setzen + CASE 1 : oeffnen interpreter (wahl nr) + CASE 2 : anzeigen interpreter (wahl nr) + CASE 3 : bearbeiten interpreter (wahl nr) + CASE 4 : drucken interpreter (wahl nr) + CASE 5 : dateiverwaltung (wahl nr) + CASE 6 : archivverwaltung (menuenr, wahl nr) + END SELECT . + +waehlbarkeit setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + ELIF NOT aendern erlaubt THEN + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + fusszeile ("", "", 35, datum doppelpunkt, 64); + fussteil (3, date) . + +END PROC eudas interpreter; + +PROC oeffnen sperre (BOOL CONST wie) : + + INT VAR i; + waehlbar (1, 4, wie); + waehlbar (1, 5, wie); + waehlbar (1, 7, wie); + FOR i FROM 1 UPTO 12 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 1, wie); + waehlbar (3, 4, wie); + waehlbar (3, 6, wie); + waehlbar (4, 1, wie) + +END PROC oeffnen sperre; + +PROC ketten koppeln sperre : + + BOOL VAR wie := anzahl dateien = 1 AND aendern erlaubt; + waehlbar (1, 6, wie); + waehlbar (3, 5, wie); + wie := anzahl dateien > 0 AND anzahl dateien < 10 AND NOT auf koppeldatei; + waehlbar (1, 2, wie); + waehlbar (1, 3, wie) + +END PROC ketten koppeln sperre; + +PROC aendern sperre (BOOL CONST wie) : + + INT VAR i; + FOR i FROM 8 UPTO 11 REP + waehlbar (2, i, wie) + END REP; + waehlbar (3, 2, wie); + waehlbar (3, 3, wie) + +END PROC aendern sperre; + + +(**************************** Menue 'Oeffnen' *****************************) + +LET + p manager = #1115# + ""15"Manager "14"", + t manager ausschalten = #1116# + "Manager ausschalten", + keine sicherung noetig = #1117# + "Keine Sicherung nötig.", + arbeitskopien loeschen = #1118# + "Interne Arbeitskopien löschen", + t arbeitskopie = #1119# + "Arbeitskopie ", + t unveraendert = #1120# + " unverändert.", + t veraendert = #1121# + " verändert! Optionen zum Sichern:", +(*t alte ersetzen = #1122# + "Statt alter Version", + t sichern neuer name = #1123# + "Unter neuem Namen", + t vergessen = #1124# + "Ignorieren",*) + unter dem namen = #1125# + "Sichern unter dem neuen Namen:", + ueberschreiben = #1126# + " überschreiben", + sortierung wiederherstellen = #1127# + "Datei wieder sortieren", + t notizen ansehen = #1128# + "Notizen", + name task = #1129# + "Name Managertask:", + task existiert nicht = #1130# + "Task existiert nicht !", + wollen sie etwas veraendern = #1131# + "Wollen Sie etwas verändern (eine Arbeitskopie anlegen)", + markierungen geloescht = #1132# + "Alle Markierungen gelöscht.", + t pruefbedingungen = #1133# + "Prüfbedingungen", + t feldnamen aendern = #1134# + "Feldnamen ändern", + t feldtypen aendern = #1135# + "Feldtypen ändern", + t feldnamen anfuegen = #1136# + "Feldnamen anfügen", + neuer feldname = #1137# + "Neuer Feldname:", + t feldtypen = #1138# + "Typwahl für Feld ", + neue feldnamen eingeben = #1139# + "Neue Feldnamen", + id text = #1140# + "TEXT ", + id din = #1141# + " DIN ", + id zahl = #1142# + "ZAHL ", + id datum = #1143# + "DATUM", + alte feldreihenfolge aendern = #1144# + "Alte Feldreihenfolge ändern", + speicherengpass = #1145# + ""7"ACHTUNG: System voll, Dateien löschen!"; + +BOOL VAR + nach aendern fragen, + multi user manager eingestellt := FALSE; + +TASK VAR multi user manager := niltask; + +TEXT VAR + manager taskname := niltext; + +SATZ VAR feldersatz; + +ROW 6 TEXT VAR typen auswahl; + typen auswahl (1) := id text; + typen auswahl (2) := id din; + typen auswahl (3) := id zahl; + typen auswahl (4) := id datum; + typen auswahl (5) := niltext; + typen auswahl (6) := niltext; + +PROC oeffnen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : auf geschlossene datei pruefen + CASE 1 : neue datei oeffnen + CASE 2 : datei ketten + CASE 3 : datei koppeln + CASE 4 : aktuelle datei sichern + CASE 5 : notizen editieren + CASE 6 : feldstruktur aendern + CASE 7 : pruefbedingungen aendern + CASE 8 : multi user manager einstellen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren; + heap kontrollieren . + +auf geschlossene datei pruefen : + IF anzahl dateien = 0 THEN + eudas interpreter (0, 0) + END IF; + akt dateiname in fuss; + fussteil (2, p manager, manager taskname) . + +neue datei oeffnen : + auf sicherung ueberpruefen; + oeffnen im menue (TRUE); + IF anzahl dateien > 0 THEN push ("2") END IF . + +datei ketten : + oeffnen op (PROC (TEXT CONST) ketten) . + +datei koppeln : + oeffnen op (PROC (TEXT CONST) koppeln) . + +aktuelle datei sichern : + IF aendern erlaubt THEN + einzeldateien abfragen + ELSE + dateien loeschen (FALSE); + dialog (keine sicherung noetig) + END IF; + sperre setzen . + +einzeldateien abfragen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + einzelsicherung (datei nr) + END REP; + IF ja (arbeitskopien loeschen, "JA/Dateien loeschen") THEN + dateien aus manager zuruecksichern; + dateien loeschen (TRUE) + END IF . + +sperre setzen : + IF anzahl dateien = 0 THEN + oeffnen sperre (FALSE); + aendern sperre (FALSE) + END IF; + ketten koppeln sperre; + akt dateiname in fuss . + +notizen editieren : + notizen ansehen; + dialogfenster loeschen . + +feldstruktur aendern : + zugriff (PROC (EUDAT VAR) feldstruktur) . + +pruefbedingungen aendern : + pruefbedingungen; + dialogfenster loeschen . + +multi user manager einstellen : + TEXT VAR edit manager name := ""; + editget (name task, edit manager name, "", "GET/multi task"); + IF edit manager name = niltext THEN + IF manager ausschalten THEN set manager (niltext, FALSE) END IF + ELIF exists task (edit manager name) THEN + teste auf manager (task (edit manager name)); + set manager (edit manager name, TRUE) + ELSE + errorstop (task existiert nicht) + END IF . + +manager ausschalten : + ja (t manager ausschalten, "JA/manager aus") . + +heap kontrollieren : + IF heap size - belegter heap > 4 THEN + collect heap garbage; + belegter heap := heap size + END IF . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen; + LEAVE oeffnen interpreter + END IF . + +END PROC oeffnen interpreter; + +PROC oeffnen op (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, TRUE, eudas typ, multi user manager, + PROC (TEXT CONST) operation); + ketten koppeln sperre; + akt dateiname in fuss + +END PROC oeffnen op; + +PROC akt dateiname in fuss : + + TEXT VAR f text := niltext; + IF anzahl dateien > 0 THEN + f text CAT """"; + f text CAT eudas dateiname (1); + f text CAT """" + END IF; + IF anzahl dateien > 1 THEN + f text CAT " .." + END IF; + fussteil (1, akt datei, f text) + +END PROC akt dateiname in fuss; + +PROC set manager (TEXT CONST m name, BOOL CONST an) : + + IF an THEN + multi user manager := task (m name) + ELSE + multi user manager := niltask + END IF; + multi user manager eingestellt := an; + manager taskname := m name; + fussteil (2, manager taskname) + +END PROC set manager; + +PROC auf sicherung ueberpruefen : + + BOOL VAR notwendig := FALSE; + IF aendern erlaubt THEN + wirklich pruefen + END IF . + +wirklich pruefen : + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF inhalt veraendert (datei nr) THEN + einzelsicherung (datei nr); + notwendig := TRUE; + ggf last param korrigieren + END IF + END REP . + +ggf last param korrigieren : + IF datei nr = 1 CAND std = eudas dateiname (1) THEN + last param (niltext) + END IF . + +END PROC auf sicherung ueberpruefen; + +PROC einzelsicherung (INT CONST datei nr) : + + frage zusammenbauen; + IF inhalt veraendert (datei nr) THEN + sicherung durchfuehren + ELSE + dialog (frage) + END IF . + +frage zusammenbauen : + TEXT VAR frage := t arbeitskopie; + frage CAT textdarstellung (eudas dateiname (datei nr)); + IF inhalt veraendert (datei nr) THEN + frage CAT t veraendert + ELSE + frage CAT t unveraendert + END IF . + +sicherung durchfuehren : + INT VAR ergebnis := 1; + auswahl anbieten ("WAHL.Sichern", frage, "WAHL/sichere", ergebnis); + ergebnis auswerten . + +ergebnis auswerten : + TEXT VAR name := eudas dateiname (datei nr); + SELECT ergebnis OF + CASE 1 : alte version ueberschreiben + CASE 3 : unter neuem namen sichern + END SELECT; + IF ergebnis <> 2 THEN + unter namen sichern + END IF . + +alte version ueberschreiben : + forget (name, quiet) . + +unter neuem namen sichern : + edit get (unter dem namen, name, "", "GET/Sicherungsname"); + IF exists (name) OR im manager vorhanden THEN + eventuell ueberschreiben + END IF . + +im manager vorhanden : + manager herkunft (dateinr) CAND exists (name, herkunft (datei nr)) . + +eventuell ueberschreiben : + IF ja (textdarstellung (name) + ueberschreiben, "JA/ueber", FALSE) THEN + forget (name, quiet) + ELSE + einzelsicherung (datei nr); + LEAVE einzelsicherung + END IF . + +unter namen sichern : + sichere (datei nr, name); + eventuell sortierung wiederherstellen; + ggf in manager sichern . + +eventuell sortierung wiederherstellen : + EUDAT VAR eudat; + oeffne (eudat, name); + IF war sortiert CAND soll sortiert werden THEN + bitte warten; + sortiere (eudat) + END IF . + +war sortiert : + sortierreihenfolge (eudat) <> niltext CAND unsortierte saetze (eudat) > 0 . + +soll sortiert werden : + ja (sortierung wiederherstellen, "JA/Sicherungssortierung") . + +ggf in manager sichern : + IF manager herkunft (datei nr) THEN + disable stop; + set command dialogue false; + save (name, herkunft (datei nr)); + reset command dialogue; + enable stop; + forget (name, quiet) + END IF . + +END PROC einzelsicherung; + +PROC oeffnen im menue (BOOL CONST aendern fragen) : + + IF aendern erlaubt THEN + dateien aus manager zuruecksichern + END IF; + dateien loeschen (TRUE); + oeffnen sperre (FALSE); + aendern sperre (FALSE); + forget (test ds); + disable stop; + nach aendern fragen := aendern fragen; + oeffnen op (PROC (TEXT CONST) oeffnen); + enable stop; + IF anzahl dateien > 0 THEN + oeffnen sperre (TRUE); + aendern sperre (aendern erlaubt) + END IF + +END PROC oeffnen im menue; + +PROC dateien aus manager zuruecksichern : + + INT VAR datei nr; + FOR datei nr FROM 1 UPTO anzahl dateien REP + IF manager herkunft (datei nr) THEN + free an manager + END IF + END REP . + +free an manager : + free (eudas dateiname (datei nr), herkunft (datei nr)) . + +END PROC dateien aus manager zuruecksichern; + +PROC oeffnen (TEXT CONST dateiname) : + + BOOL VAR auch aendern; + TASK VAR ursprung; + eventuell neu einrichten; + oeffne (dateiname, auch aendern, ursprung) . + +eventuell neu einrichten : + IF datei existiert nicht AND nach aendern fragen THEN + frage ob einrichten (dateiname); + EUDAT VAR eudat; + oeffne (eudat, dateiname); + feldstruktur (eudat); + auch aendern := TRUE; + ursprung := niltask + ELSE + auch aendern := nach aendern fragen CAND + ja (wollen sie etwas veraendern, "JA/oeffne", FALSE); + aus manager besorgen (dateiname, auch aendern, ursprung) + END IF . + +datei existiert nicht : + NOT exists (dateiname) AND auch nicht im manager . + +auch nicht im manager : + NOT multi user manager eingestellt COR + NOT exists (dateiname, multi user manager) . + +END PROC oeffnen; + +PROC ketten (TEXT CONST dateiname) : + + TASK VAR ursprung; + aus manager besorgen (dateiname, aendern erlaubt, ursprung); + kette (dateiname, ursprung) + +END PROC ketten; + +PROC koppeln (TEXT CONST dateiname) : + + TASK VAR ursprung; + aus manager besorgen (dateiname, aendern erlaubt, ursprung); + kopple (dateiname, ursprung) + +END PROC koppeln; + +PROC aus manager besorgen (TEXT CONST dateiname, BOOL CONST mit lock, + TASK VAR ursprung) : + + ursprung := niltask; + IF multi user manager eingestellt THEN + manager abfragen + END IF . + +manager abfragen : + IF NOT exists (dateiname) CAND exists (dateiname, multi user manager) THEN + IF mit lock THEN + lock (dateiname, multi user manager) + END IF; + forget (dateiname, quiet); + fetch (dateiname, multi user manager); + ursprung := multi user manager + END IF . + +END PROC aus manager besorgen; + +BOOL PROC manager herkunft (INT CONST dateinr) : + + NOT is niltask (herkunft (dateinr)) + +END PROC manager herkunft; + +PROC notizen ansehen : + + notizen lesen (3, feldpuffer); + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + headline (f, t notizen ansehen); + notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Notizen"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (3, feldpuffer) + END IF + +END PROC notizen ansehen; + +PROC notizen anbieten (FILE VAR f, TEXT VAR puffer, + FENSTER CONST edit fenster, TEXT CONST hilfsname) : + + LET trennzeichen = "#-#"; + enable stop; + notizen in datei; + datei editieren; + notizen aus datei . + +notizen in datei : + INT VAR + von := 1, + bis; + REP + bis := pos (puffer, trennzeichen, von); + IF bis = 0 THEN + putline (f, subtext (puffer, von)) + ELSE + putline (f, subtext (puffer, von, bis - 1)) + END IF; + von := bis + 3 + UNTIL bis = 0 OR von > length (puffer) END REP . + +datei editieren : + modify (f); + edit (f, edit fenster, hilfsname, TRUE) . + +notizen aus datei : + TEXT VAR zeile; + puffer := niltext; + input (f); + WHILE NOT eof (f) REP + getline (f, zeile); + blank entfernen; + puffer CAT zeile; + puffer CAT trennzeichen + END REP . + +blank entfernen : + IF (zeile SUB length (zeile)) = blank THEN + zeile := subtext (zeile, 1, length (zeile) - 1) + END IF . + +END PROC notizen anbieten; + +PROC feldstruktur (EUDAT VAR eudat) : + + INT VAR feldnr; + feldnamen lesen (eudat, feldersatz); + IF feldnamen auch aendern THEN + feldnamen anbieten und aendern + END IF; + IF feldnamen anfuegen THEN + feldnamen editieren + END IF; + IF ja (t feldtypen aendern, "JA/Feldtypen aendern", FALSE) THEN + feldtypen anbieten und aendern + END IF; + feldnamen aendern (eudat, feldersatz) . + +feldnamen auch aendern : + felderzahl (feldersatz) > 0 CAND + ja (t feldnamen aendern, "JA/Feldnamen aendern", FALSE) . + +feldnamen anfuegen : + felderzahl (feldersatz) = 0 COR + ja (t feldnamen anfuegen, "JA/feldnamen", FALSE) . + +feldnamen anbieten und aendern : + felder anbieten (eudat); + feldnr := 1; + WHILE wahl (feldnr) > 0 REP + einen feldnamen aendern; + feldnr INCR 1 + END REP . + +einen feldnamen aendern : + TEXT VAR feldname; + feld lesen (feldersatz, wahl (feldnr), feldname); + editget (neuer feldname, feldname, "", "GET/feldname"); + feld aendern (feldersatz, wahl (feldnr), feldname) . + +feldnamen editieren : + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + disable stop; + feldnamen anbieten (f, feldersatz); + forget (ds); + enable stop; + feldnamen aendern (eudat, feldersatz) . + +feldtypen anbieten und aendern : + felder anbieten (eudat); + feldnr := 1; + WHILE wahl (feldnr) > 0 REP + einen feldtyp aendern; + feldnr INCR 1 + END REP . + +einen feldtyp aendern : + INT VAR ergebnis := feldinfo (eudat, wahl (feldnr)) + 2; + feld lesen (feldersatz, wahl (feldnr), feldname); + auswahl anbieten ("WAHL.Typen", + t feldtypen + textdarstellung (feldname), + "WAHL/Feldtypen", ergebnis); + feldinfo (eudat, wahl (feldnr), ergebnis - 2) . + +END PROC feldstruktur; + +PROC felder anbieten (EUDAT CONST eudat) : + + feldtypen dazuschreiben; + auswahl anbieten ("EUDAS-Felder", fenster rechts, "AUSWAHL/Felder", + PROC (TEXT VAR, INT CONST) aus sammel) . + +feldtypen dazuschreiben : + INT VAR feldnr; + satz initialisieren (sammel); + FOR feldnr FROM 1 UPTO felderzahl (feldersatz) REP + feld lesen (feldersatz, feldnr, feldpuffer); + feld aendern (sammel, feldnr, info + feldpuffer) + END REP . + +info : + "<" + typen auswahl (feldinfo (eudat, feldnr) + 2) + "> " . + +END PROC felder anbieten; + +PROC pruefbedingungen : + + enable stop; + DATASPACE VAR ds := nilspace; + FILE VAR f := sequential file (output, ds); + headline (f, t pruefbedingungen); + notizen lesen (1, feldpuffer); + disable stop; + notizen anbieten (f, feldpuffer, fenster ganz, "EDIT/Pruefbed"); + forget (ds); + enable stop; + IF aendern erlaubt THEN + notizen aendern (1, feldpuffer) + END IF . + +END PROC pruefbedingungen; + +PROC feldnamen anbieten (FILE VAR f, SATZ VAR satz) : + + enable stop; + neue namen editieren; + neue namen zurueckschreiben . + +neue namen editieren : + modify (f); + headline (f, neue feldnamen eingeben); + edit (f, fenster rechts, "EDIT/Feldnamen", TRUE) . + +neue namen zurueckschreiben : + INT VAR feldnr := felderzahl (satz); + input (f); + WHILE NOT eof (f) REP + getline (f, feldpuffer); + blank entfernen; + feldnr INCR 1; + feld aendern (satz, feldnr, feldpuffer) + END REP . + +blank entfernen : + IF (feldpuffer SUB length (feldpuffer)) = blank THEN + feldpuffer := subtext (feldpuffer, 1, length (feldpuffer) - 1) + END IF . + +END PROC feldnamen anbieten; + +PROC storage kontrollieren : + + INT VAR size, used; + storage (size, used); + IF used > size THEN + neuer dialog; + dialog (speicherengpass) + END IF + +END PROC storage kontrollieren; + + +(************************* Menue 'Einzelsatz' *****************************) + +BOOL VAR + satz leer, + umgeschaltet aus einfuegen := FALSE, + umgeschaltet aus aendern := FALSE; + +LET + aendern status = #1146# +"SATZ ÄNDERN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + einfuegen status = #1147# +"SATZ EINFÜGEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + suchen status = #1148# +"SUCHMUSTER EINGEBEN: Abbruch: ESC h Beenden: ESC q Hilfe: ESC ?", + umschalten auf = #1149# + "Umschalten auf Koppeldatei ", + koppelfelder uebernehmen = #1150# + "Koppelfelder übernehmen", + ungueltige satznummer = #1151# + "Ungültige Satznummer", + neue satznummer = #1152# + "Neue Satznummer:", + wzk = #1153# + "wzK", + wz = #1154# + "wz"; + +PROC anzeigen interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : anzeige einschalten + CASE 1 : einen satz weiter + CASE 2 : einen satz zurueck + CASE 3 : direkt auf satz + CASE 4 : auf satz nach schluessel + CASE 5 : saetze auswaehlen + CASE 6 : auswahlbedingung loeschen + CASE 7 : aktuelle markierung aendern + CASE 8 : neuen satz einfuegen + CASE 9 : aktuellen satz aendern + CASE 10: einzelsatz tragen + CASE 11: einzelsatz holen + CASE 12: felder auswaehlen + CASE 13: esc oben + CASE 14: esc unten + CASE 15: esc 1 + CASE 16: esc 9 + CASE 17: esc k + OTHERWISE anzeige update + END SELECT; + storage kontrollieren . + +anzeige einschalten : + akt dateiname in fuss; + fussteil (2, "", ""); + exit zeichen (wz) . + +einen satz weiter : + bitte warten; + weiter (2); + bild ausgeben (FALSE) . + +einen satz zurueck : + bitte warten; + zurueck (2); + bild ausgeben (FALSE) . + +saetze auswaehlen : + suchen; + bild ausgeben (TRUE) . + +auswahlbedingung loeschen : + suchbedingung loeschen; + bild ausgeben (FALSE) . + +direkt auf satz : + TEXT VAR nr := niltext; + editget (neue satznummer, nr, "", "GET/auf Satz"); + INT CONST ziel := int (nr); + IF nr = niltext THEN + bild ausgeben (FALSE) + ELIF last conversion ok THEN + auf satz (ziel); + bild ausgeben (FALSE) + ELSE + errorstop (ungueltige satznummer) + END IF . + +auf satz nach schluessel : + TEXT VAR name schluesselfeld; + feldnamen lesen (1, name schluesselfeld); + nr := niltext; + editget (name schluesselfeld + ":", nr, "", "GET/auf Schluessel"); + auf satz (nr); + bild ausgeben (FALSE) . + +neuen satz einfuegen : + einfuegen; + bild ausgeben (TRUE) . + +aktuellen satz aendern : + aendern; + bild ausgeben (TRUE) . + +aktuelle markierung aendern : + markierung aendern; + bild ausgeben (FALSE) . + +einzelsatz tragen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) trage satz und frage); + bild ausgeben (TRUE) . + +einzelsatz holen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der quelldatei, eudas typ, + PROC (TEXT CONST) hole satz); + bild ausgeben (TRUE) . + +felder auswaehlen : + TEXT VAR wahlvektor := niltext; + felder waehlen lassen (wahlvektor, + "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder"); + IF wahlvektor <> niltext THEN + feldauswahl (wahlvektor) + END IF; + bild ausgeben (TRUE) . + +esc oben : + rollcursor; + rollen (-23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc unten : + rollcursor; + rollen (23); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 1 : + rollcursor; + rollen (-9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc 9 : + rollcursor; + rollen (9999); + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF . + +esc k : + IF auf koppeldatei THEN + zurueckschalten + ELSE + auf koppeldatei umschalten + END IF; + IF anzahl dateien > 0 THEN + bild ausgeben (TRUE) + END IF . + +zurueckschalten : + IF (umgeschaltet aus aendern OR umgeschaltet aus einfuegen) THEN + fragen ob koppelfelder uebernehmen; + wieder in alte operation + ELSE + auf koppeldatei (0) + END IF; + ketten koppeln sperre . + +fragen ob koppelfelder uebernehmen : + IF NOT dateiende CAND ja (koppelfelder uebernehmen, "JA/uebernehmen") THEN + auf koppeldatei (1) + ELSE + auf koppeldatei (0) + END IF . + +wieder in alte operation : + umgeschaltet aus einfuegen := FALSE; + IF umgeschaltet aus aendern THEN + umgeschaltet aus aendern := FALSE; + aendern + ELSE + einfuegen intern (TRUE) + END IF . + +anzeige update : + IF wahl nr = -2 THEN + IF anzahl dateien > 0 THEN + bild ausgeben (FALSE) + END IF + ELSE + dialogfenster loeschen + END IF . + +END PROC anzeigen interpreter; + +PROC suchen : + + disable stop; + exit zeichen (""); + status anzeigen (suchen status); + suchen (PROC suchen hilfe); + exit zeichen (wz) + +END PROC suchen; + +PROC suchen hilfe : + + hilfe anbieten ("EDIT/Suchen", fenster rechts) + +END PROC suchen hilfe; + +PROC einfuegen : + + einfuegen intern (FALSE) + +END PROC einfuegen; + +PROC einfuegen intern (BOOL CONST nach umschalten) : + + BOOL VAR weiter aendern := nach umschalten; + exit zeichen setzen; + REP + status anzeigen (einfuegen status); + IF weiter aendern THEN + aendern (PROC einfuegen hilfe); + weiter aendern := FALSE + ELSE + einfuegen (PROC einfuegen hilfe) + END IF; + satz untersuchen; + exit zeichen bei einfuegen behandeln + END REP . + +exit zeichen bei einfuegen behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE einfuegen intern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; zurueck (2) + END IF + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus einfuegen := TRUE; + LEAVE einfuegen intern + END IF; + weiter aendern := TRUE + END SELECT . + +END PROC einfuegen intern; + +PROC einfuegen hilfe : + + hilfe anbieten ("EDIT/Einfuegen", fenster rechts) + +END PROC einfuegen hilfe; + +PROC exit zeichen setzen : + + IF anzahl koppeldateien > 0 AND NOT auf koppeldatei THEN + exit zeichen (wzk) + ELSE + exit zeichen (wz) + END IF + +END PROC exit zeichen setzen; + +PROC aendern : + + exit zeichen setzen; + kommando auf taste legen ("F", "prueffehler editieren"); + REP + status anzeigen (aendern status); + aendern (PROC aendern hilfe); + satz untersuchen; + exit zeichen bei aendern behandeln + END REP . + +exit zeichen bei aendern behandeln : + SELECT pos (wzk, exit durch) OF + CASE 0 : IF satz leer THEN + satz loeschen + END IF; + LEAVE aendern + CASE 1 : IF satz leer THEN + satz loeschen + ELSE + bitte warten; weiter (2) + END IF + CASE 2 : IF satz leer THEN + satz loeschen + END IF; + bitte warten; zurueck (2) + CASE 3 : auf koppeldatei umschalten; + IF auf koppeldatei THEN + umgeschaltet aus aendern := TRUE; + LEAVE aendern + END IF + END SELECT . + +END PROC aendern; + +PROC aendern hilfe : + + hilfe anbieten ("EDIT/Aendern", fenster rechts) + +END PROC aendern hilfe; + +PROC prueffehler editieren : + + IF test version = datei version THEN + modify (test file); + edit (test file) + END IF + +END PROC prueffehler editieren; + +PROC auf koppeldatei umschalten : + + INT VAR datei nr := folgedatei (0); + WHILE datei nr > 0 REP + IF auf diese datei schalten THEN + auf koppeldatei (datei nr); + ketten koppeln sperre; + LEAVE auf koppeldatei umschalten + END IF; + datei nr := folgedatei (datei nr) + END REP . + +auf diese datei schalten : + ja (umschalten auf + textdarstellung (eudas dateiname (datei nr)), + "JA/umschalten") . + +END PROC auf koppeldatei umschalten; + +PROC zeilenrest ausgeben (TEXT CONST zeile, INT CONST dummy) : + + outsubtext (zeile, anfang); out (cleol) . + +anfang : + pos (zeile, blank, 6) + 1 + dummy - dummy . + +END PROC zeilenrest ausgeben; + +PROC satz untersuchen : + + feld bearbeiten (1, PROC (TEXT CONST, INT CONST, INT CONST) ob leer) + +END PROC satz untersuchen; + +PROC ob leer (TEXT CONST satz, INT CONST von, bis) : + + satz leer := von < 3 OR von > length (satz) + bis - bis + +END PROC ob leer; + +PROC rollcursor : + + cursor (15, 24) + +END PROC rollcursor; + +PROC trage satz und frage (TEXT CONST dateiname) : + + IF exists (dateiname) THEN + teste auf offen + ELSE + frage ob einrichten (dateiname) + END IF; + bitte warten; + trage satz (dateiname) . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +END PROC trage satz und frage; + +PROC felder waehlen lassen (TEXT VAR wahlvektor, + TEXT CONST name auswahl, name hilfe) : + + auswahl anbieten (name auswahl, fenster rechts, 256, name hilfe, + wahlvektor, + PROC (TEXT VAR, INT CONST) gib namen); + wahlvektor := niltext; + INT VAR nr := 1; + WHILE wahl (nr) > 0 REP + wahlvektor CAT code (wahl (nr)); + nr INCR 1 + END REP + +END PROC felder waehlen lassen; + + +(************************* Menue 'Gesamtdatei' ***************************) + +LET + name der datei = #1155# + "Name der Datei:", + name der zieldatei = #1156# + "Name der Zieldatei:", + name der verarbeitungsvorschrift = #1157# + "Name der Verarbeitungsvorschrift:", + name des druckmusters = #1158# + "Name des Druckmusters:", + name der quelldatei = #1159# + "Name der Quelldatei:"; + +LET + felder auswaehlen = #1160# + "Angezeigte Felder auswählen", + aufsteigend sortieren = #1161# + " aufsteigend sortieren"; + +TEXT VAR + uebersichtsauswahl := niltext; + +INT VAR + version uebersicht := 0; + +DATASPACE VAR + kopier ds; + + +PROC bearbeiten interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : saetze kopieren + CASE 2 : saetze tragen + CASE 3 : nach vorschrift aendern + CASE 4 : uebersicht ausgeben + CASE 5 : datei sortieren + CASE 6 : alle markierungen loeschen + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + akt dateiname in fuss; + fussteil (2, "", "") . + +saetze tragen : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) trage saetze) . + +saetze kopieren : + last param darf nicht geoeffnet sein; + einzelausfuehrung (name der zieldatei, eudas typ, + PROC (TEXT CONST) kopiere saetze); + dialogfenster loeschen . + +nach vorschrift aendern : + ausfuehrung (name der verarbeitungsvorschrift, file typ, + PROC (TEXT CONST) verarbeite mit edit); + dialogfenster loeschen . + +uebersicht ausgeben : + IF dateiversion <> version uebersicht THEN + uebersichtsauswahl := niltext; + version uebersicht := dateiversion + END IF; + feldauswahl fuer uebersicht (uebersichtsauswahl); + uebersicht (uebersichtsauswahl, PROC uebersicht hilfe); + dialogfenster loeschen . + +datei sortieren : + zugriff (PROC (EUDAT VAR) einzelsortiere) . + +alle markierungen loeschen : + markierungen loeschen; + dialog (markierungen geloescht) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC bearbeiten interpreter; + +PROC last param darf nicht geoeffnet sein : + + IF index der arbeitskopie (std) <> 0 THEN + last param (niltext) + END IF + +END PROC last param darf nicht geoeffnet sein; + +PROC trage saetze (TEXT CONST dateiname) : + + BOOL VAR mit test; + IF exists (dateiname) THEN + teste auf offen; + frage ob testen + ELSE + frage ob einrichten (dateiname); + mit test := FALSE + END IF; + BOOL CONST mit sortieren := ja (sortierfrage, "JA/sortieren"); + bitte warten; + ggf datei initialisieren; + trage (dateiname, test file, mit test); + fehlerzahl ausgeben; + IF mit sortieren THEN + EUDAT VAR eudat; + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +teste auf offen : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF . + +frage ob testen : + mit test := ja (pruefbedingungen testen, "JA/testen") . + +ggf datei initialisieren : + IF mit test THEN + forget (test ds); + test ds := nilspace; + test file := sequential file (output, test ds); + test version := datei version + ELSE + forget (test ds); + test version := datei version - 1 + END IF . + +fehlerzahl ausgeben : + IF mit test CAND lines (test file) > 0 THEN + dialog (text (lines (test file)) + prueffehler festgestellt) + END IF . + +END PROC trage saetze; + +PROC verarbeite mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + edit unten (dateiname, "EDIT/Verarbeite") + END IF; + bild frei fuer uebersetzung; + FILE VAR f := sequential file (input, dateiname); + disable stop; + verarbeite (f); + uebersetzungsfehler behandeln . + +END PROC verarbeite mit edit; + +PROC feldauswahl fuer uebersicht (TEXT VAR uebersichtsauswahl) : + + IF ja (felder auswaehlen, "JA/Ub.Felder") THEN + felder waehlen lassen (uebersichtsauswahl, + "EUDAS-Anzeigefelder", "AUSWAHL/Anzeigefelder") + END IF + +END PROC feldauswahl fuer uebersicht; + +PROC uebersicht hilfe : + + hilfe anbieten ("UEBERSICHT", fenster ganz) + +END PROC uebersicht hilfe; + +PROC kopiere saetze (TEXT CONST dateiname) : + + disable stop; + kopier ds := nilspace; + kopiere saetze intern (dateiname); + forget (kopier ds) + +END PROC kopiere saetze; + +PROC kopiere saetze intern (TEXT CONST dateiname) : + + TEXT VAR mustername := ""; + FILE VAR f; + EUDAT VAR eudat; + BOOL VAR mit sortieren := FALSE; + + enable stop; + IF exists (dateiname) THEN + teste auf offen und sortieren + ELSE + frage ob einrichten (dateiname) + END IF; + editget (name kopiermuster, mustername, "", "GET/kopiermuster"); + IF exists (mustername) THEN + f := sequential file (input, mustername) + ELSE + ggf kopiermuster einrichten; + std kopiermuster (dateiname, f) + END IF; + modify (f); + wirklich kopieren; + ggf sortieren . + +teste auf offen und sortieren : + IF index der arbeitskopie (dateiname) <> 0 THEN + errorstop (nicht in offene datei) + END IF; + oeffne (eudat, dateiname); + IF sortierreihenfolge (eudat) <> niltext THEN + mit sortieren := ja (sortierfrage, "JA/sortieren") + END IF . + +ggf kopiermuster einrichten : + IF mustername = niltext THEN + f := sequential file (output, kopier ds) + ELSE + frage ob einrichten (mustername); + f := sequential file (output, mustername) + END IF . + +wirklich kopieren : + edit (f, fenster ganz, "EDIT/Kopiermuster", TRUE); + bild frei fuer uebersetzung; + kopiere (dateiname, f) . + +ggf sortieren : + IF mit sortieren THEN + oeffne (eudat, dateiname); + sortiere (eudat) + END IF . + +END PROC kopiere saetze intern; + +INT PROC index der arbeitskopie (TEXT CONST dateiname) : + + INT VAR dateinr; + FOR dateinr FROM 1 UPTO anzahl dateien REP + IF eudas dateiname (dateinr) = dateiname THEN + LEAVE index der arbeitskopie WITH dateinr + END IF + END REP; + 0 + +END PROC index der arbeitskopie; + +PROC edit unten (TEXT CONST dateiname, hilfe) : + + IF NOT exists (dateiname) THEN + frage ob einrichten (dateiname) + END IF; + FILE VAR f := sequential file (modify, dateiname); + edit (f, fenster ganz, hilfe, TRUE) + +END PROC edit unten; + +PROC bild frei fuer uebersetzung : + + bitte warten; + cursor (1, 2); + out (cl eop); + bildschirm neu + +END PROC bild frei fuer uebersetzung; + +PROC einzelsortiere (EUDAT VAR eudat) : + + TEXT VAR reihenfolge := sortierreihenfolge (eudat); + IF reihenfolge = niltext COR alte reihenfolge aendern THEN + sortierreihenfolge aendern; + bitte warten; + sortiere (eudat, reihenfolge) + ELSE + bitte warten; + sortiere (eudat) + END IF . + +alte reihenfolge aendern : + ja (alte feldreihenfolge aendern, "JA/Sortierfelder", FALSE) . + +sortierreihenfolge aendern : + feldnamen lesen (eudat, sammel); + auswahl anbieten ("EUDAS-Sortierfelder", fenster rechts, 1024, + "AUSWAHL/Sortierfelder", reihenfolge, + PROC (TEXT VAR, INT CONST) aus sammel); + INT VAR feldnr := 1; + reihenfolge := niltext; + WHILE wahl (feldnr) <> 0 REP + reihenfolge CAT code (wahl (feldnr)); + nach richtung fragen; + feldnr INCR 1 + END REP . + +nach richtung fragen : + feld lesen (sammel, wahl (feldnr), feldpuffer); + IF ja (textdarstellung (feldpuffer) + aufsteigend sortieren, + "JA/Sortierrichtung") THEN + reihenfolge CAT "+" + ELSE + reihenfolge CAT "-" + END IF . + +END PROC einzelsortiere; + +PROC gib namen (TEXT VAR name, INT CONST nr) : + + IF nr <= anzahl felder THEN + feldnamen lesen (nr, name) + ELSE + name := niltext + END IF + +END PROC gib namen; + + +(************************* Menue 'Drucken' ********************************) + +LET +(*direkt ausgabe = #1162# + "Ausgabe automatisch zum Drucker",*) + name druckzieldatei = #1163# + "Name Ausgabedatei:", + zwischendatei drucken = #1210# + "Erzeugte Ausgabe ausdrucken", + zwischendatei loeschen = #1211# + "Erzeugte Ausgabe löschen", + welche richtung = #1212# + "Richtung der Druckausgabe:", + welche listenform = #1213# + "Form der Liste:", + t max listenbreite = #1214# + "Anzahl Zeichen pro Zeile:", + keine zahl angegeben = #1215# + "Eingabe ist keine gültige Zahl", + sortierfrage = #1164# + "Zieldatei anschließend sortieren", + pruefbedingungen testen = #1165# + "Prüfbedingungen testen", + prueffehler festgestellt = #1166# + "Prüffehler festgestellt", + nicht in offene datei = #1167# + "Zieldatei darf nicht geöffnet sein", + name kopiermuster = #1168# + "Name Kopiermuster (RET=Std):"; + +LET + z form = #1169# + " zeilenweise formatieren", + s form = #1170# + " seitenweise formatieren"; + +LET + m drucke direkt = 0, + m drucke auf schirm = 1, + m drucke in datei = 2; + +BOOL VAR + zeilen automatisch := FALSE, + seiten automatisch := FALSE; + + +PROC drucken interpreter (INT CONST wahl nr) : + + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : nach muster drucken + CASE 2 : standardlisten + CASE 3 : ausgaberichtung umschalten + CASE 4 : musterdatei aendern + CASE 5 : textdatei drucken + CASE 6 : nachbearbeiten + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + akt dateiname in fuss; + fussteil (2, "", "") . + +nach muster drucken : + ausfuehrung (name des druckmusters, file typ, + PROC (TEXT CONST) drucke mit edit); + dialogfenster loeschen . + +standardlisten : + INT VAR listenform := 1; + auswahl anbieten ("WAHL.Std-Listen", welche listenform, "WAHL/Std-Listen", + listenform); + feldliste erfragen; + listenfont erfragen; + listenbreite erfragen; + ausgabedatei erfragen; + bild frei fuer uebersetzung; + drucke standardlisten (listenform, feldliste); + ergebnis anbieten . + +feldliste erfragen : + TEXT VAR feldliste := niltext; + felder waehlen lassen (feldliste, + "EUDAS-Druckfelder", "AUSWAHL/Druckfelder") . + +listenfont erfragen : + . + +listenbreite erfragen : + TEXT VAR edit zahl := text (std listenbreite); + editget (t max listenbreite, edit zahl, "", "GET/listenbreite"); + INT CONST neue breite := int (edit zahl); + IF NOT last conversion ok THEN + errorstop (keine zahl angegeben) + ELSE + std listenbreite (neue breite) + END IF . + +ausgaberichtung umschalten : + INT VAR ergebnis := druckrichtung + 1; + auswahl anbieten ("WAHL.Richtung", welche richtung, "WAHL/Richtung", + ergebnis); + druckrichtung (ergebnis - 1) . + +musterdatei aendern : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) muster edit); + dialogfenster loeschen . + +textdatei drucken : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) print) . + +nachbearbeiten : + ausfuehrung (name der datei, file typ, + PROC (TEXT CONST) nachbearbeitung); + dialogfenster loeschen . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC drucken interpreter; + +PROC uebersetzungsfehler behandeln : + + IF uebersetzungsfehler THEN + clear error + END IF . + +uebersetzungsfehler : + is error CAND errormessage = niltext . + +END PROC uebersetzungsfehler behandeln; + +PROC drucke mit edit (TEXT CONST dateiname) : + + IF NOT exists (dateiname) THEN + muster edit (dateiname) + END IF; + ausgabedatei erfragen; + bild frei fuer uebersetzung; + disable stop; + drucke (dateiname); + ergebnis anbieten; + uebersetzungsfehler behandeln . + +END PROC drucke mit edit; + +PROC ausgabedatei erfragen : + + IF druckrichtung = m drucke in datei THEN + TEXT VAR dateiname := druckdatei; + IF pos (dateiname, "$") > 0 THEN dateiname := niltext END IF; + editget (name druckzieldatei, dateiname, "", "GET/Druckdatei"); + IF dateiname <> niltext THEN + druckdatei (dateiname) + END IF + END IF + +END PROC ausgabedatei erfragen; + +PROC ergebnis anbieten : + + IF NOT is error CAND druckrichtung = m drucke auf schirm CAND + exists (druckdatei) THEN + enable stop; + zwischendatei zeigen + END IF . + +zwischendatei zeigen : + FILE VAR ausgabefile := sequential file (input, druckdatei); + edit (ausgabefile, fenster ganz, "EDIT/Druckausgabe", TRUE); + IF ja (zwischendatei drucken, "JA/Ausgabe drucken", FALSE) THEN + print (druckdatei) + END IF; + IF ja (zwischendatei loeschen, "JA/Ausgabe loeschen", FALSE) THEN + forget (druckdatei, quiet) + END IF . + +END PROC ergebnis anbieten; + +PROC muster edit (TEXT CONST dateiname) : + + edit unten (dateiname, "EDIT/Druckmuster") + +END PROC muster edit; + +PROC print (TEXT CONST dateiname) : + + do ("print (" + textdarstellung (dateiname) + ")") + +END PROC print; + +PROC nachbearbeitung (TEXT CONST dateiname) : + + IF ja (textdarstellung (dateiname) + z form, "JA/zeilenform") THEN + zeilen formatieren + END IF; + IF ja (textdarstellung (dateiname) + s form, "JA/seitenform") THEN + seiten formatieren + END IF . + +zeilen formatieren : + IF zeilen automatisch THEN + autoform (dateiname) + ELSE + lineform (dateiname) + END IF; + page; + bildschirm neu . + +seiten formatieren : + IF seiten automatisch THEN + autopageform (dateiname) + ELSE + pageform (dateiname) + END IF; + bildschirm neu . + +END PROC nachbearbeitung; + +PROC formatieren automatisch (BOOL CONST za, sa) : + + zeilen automatisch := za; + seiten automatisch := sa + +END PROC formatieren automatisch; + + +(********************** Menue 'Dateien' ***********************************) + +INITFLAG VAR diese task; + +TEXT VAR arbeitsbereich; + +LET + p task = #1171# + ""15"Bereich "14"", + t neuer name = #1172# + "Neuer Name:", + t zieldatei = #1173# + "Zieldatei:", + t belegt = #1174# + "belegt ", + t kb = #1175# + "KB.", + t existiert nicht = #1176# + " existiert nicht.", + t loeschen = #1177# + " in dieser Task löschen"; + +PROC dateiverwaltung (INT CONST wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : fusszeile aktualisieren + CASE 1 : dateiuebersicht + CASE 2 : datei loeschen + CASE 3 : datei umbenennen + CASE 4 : datei kopieren + CASE 5 : speicherbelegung datei + CASE 6 : datei reorganisieren + OTHERWISE ggf dialogfenster loeschen + END SELECT; + storage kontrollieren . + +fusszeile aktualisieren : + arbeitsbereich bestimmen; + fussteil (2, "", "") . + +datei reorganisieren : + ausfuehrung (PROC (TEXT CONST) aufraeumen) . + +datei umbenennen : + ausfuehrung (PROC (TEXT CONST) umbenennen) . + +datei loeschen : + ausfuehrung (PROC (TEXT CONST) loeschen) . + +dateiuebersicht : + disable stop; + DATASPACE VAR list ds := nilspace; + FILE VAR f := sequential file (output, list ds); + list (f); + IF NOT is error THEN + edit (f, fenster rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + enable stop; + tastenpuffer loeschen . + +datei kopieren : + ausfuehrung (PROC (TEXT CONST) ds kopieren) . + +speicherbelegung datei : + ausfuehrung (PROC (TEXT CONST) speicherbelegung) . + +ggf dialogfenster loeschen : + IF wahl nr = -1 THEN + dialogfenster loeschen + END IF . + +END PROC dateiverwaltung; + +PROC arbeitsbereich bestimmen : + + IF NOT initialized (diese task) THEN + neu bestimmen + END IF; + fussteil (1, p task, arbeitsbereich) . + +neu bestimmen : + IF station (myself) <> 0 THEN + arbeitsbereich := text (station (myself)) + "/""" + ELSE + arbeitsbereich := """" + END IF; + arbeitsbereich CAT name (myself); + arbeitsbereich CAT """" . + +END PROC arbeitsbereich bestimmen; + +PROC tastenpuffer loeschen : + + WHILE getcharety <> niltext REP END REP + +END PROC tastenpuffer loeschen; + +PROC aufraeumen (TEXT CONST dateiname) : + + bitte warten; + IF type (old (dateiname)) = eudas typ THEN + reorganisiere (dateiname) + ELSE + reorganize (dateiname) + END IF + +END PROC aufraeumen; + +PROC umbenennen (TEXT CONST dateiname) : + + TEXT VAR neuer name := dateiname; + IF exists (dateiname) THEN + editget (t neuer name, neuer name, "", "GET/rename") + END IF; + rename (dateiname, neuer name) + +END PROC umbenennen; + +PROC loeschen (TEXT CONST dateiname) : + + IF offene datei THEN + errorstop (nicht in offene datei) + ELIF exists (dateiname) CAND frage bejaht THEN + forget (dateiname, quiet) + END IF . + +offene datei : + index der arbeitskopie (dateiname) <> 0 . + +frage bejaht : + ja (textdarstellung (dateiname) + t loeschen, "JA/forget", FALSE) . + +END PROC loeschen; + +PROC ds kopieren (TEXT CONST dateiname) : + + TEXT VAR zieldatei := niltext; + editget (t zieldatei, zieldatei, "", "GET/copy"); + copy (dateiname, zieldatei) + +END PROC ds kopieren; + +PROC speicherbelegung (TEXT CONST dateiname) : + + dialog (textdarstellung (dateiname)); + IF exists (dateiname) THEN + out (t belegt); + put (storage (old (dateiname))); + out (t kb) + ELSE + out (t existiert nicht) + END IF + +END PROC speicherbelegung; + + +(*********************** Menue 'Archiv' ***********************************) + +TEXT VAR + letzter archivname := niltext, + zielarchiv := "ARCHIVE"; + +INT VAR zielstation := 0; + +THESAURUS VAR archivinhalt; + +BOOL VAR + archivzugriff, + ziel ist manager := TRUE; + +LET + p zielarchiv = #1182# + ""15"Ziel "14"", + archiv heisst = #1183# + "Archiv heisst ", + name des archivs = #1184# + "Name des Archivs:", + name zielarchiv = #1185# + "Name Zielarchiv:", + nr zielstation = #1186# + "Nr. der Zielstation (od. RETURN):", + t zielmodus = #1187# + "Art des Zielarchivs:", + diskette formatieren = #1188# + "Diskette neu formatieren", + neuer archivname = #1189# + "Neuer Archivname:", + t im system ueberschreiben = #1190# + " in dieser Task überschreiben", + t auf archiv loeschen = #1191# + " auf Archiv löschen", + t archiv = #1192# + "Archiv ", + t ueberschreiben = #1193# + " überschreiben", + diskette eingelegt = #1194# + "Diskette eingelegt", + t auf archiv ueberschreiben = #1195# + " auf Archiv überschreiben", + t formatparameter = #1196# + "Mögliche Diskettenformate: "; + +LET + t passwort = #1197# + "Passwort: ", + passwortwiederholung falsch = #1198# + "Passwort stimmt nicht mit der ersten Eingabe überein", + bitte passwort wiederholen = #1199# + "Passwort zur Kontrolle bitte nochmal eingeben:", + passwort loeschen = #1200# + "Passwort löschen", + falsche stationsnr = #1201# + "Unzulässige Stationsnummer", + task ist kein manager = #1202# + "Angegebene Task ist kein Manager"; + +ROW 4 TEXT VAR archivtask; + archivtask (1) := "ARCHIVE"; + archivtask (2) := "PUBLIC"; + archivtask (3) := "ARCHIVE360"; + archivtask (4) := "DOS"; + + +PROC archivverwaltung (INT CONST menue nr, wahl nr) : + + enable stop; + SELECT wahl nr OF + CASE 0 : eintritt + CASE 1 : archivuebersicht + CASE 2 : uebersicht drucken + CASE 3 : datei vom archiv holen + CASE 4 : datei auf archiv sichern + CASE 5 : auf archiv loeschen + CASE 6 : archiv initialisieren + CASE 7 : zielarchiv einstellen + CASE 8 : passwort einstellen + CASE 9 : reservieren + OTHERWISE verlassen + END SELECT; + storage kontrollieren . + +eintritt : + arbeitsbereich bestimmen; + waehlbar (menue nr, 6, ziel ist manager); + waehlbar (menue nr, 9, NOT ziel ist manager); + fussteil (2, p zielarchiv, stationsnr + zielarchiv); + archivzugriff := FALSE . + +datei auf archiv sichern : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + ausfuehrung (PROC (TEXT CONST) archivieren) . + +datei vom archiv holen : + disable stop; + archiv anmelden; + bitte warten; + archivinhalt := ALL eudas archiv; + IF falscher name THEN archivinhalt := ALL eudas archiv END IF; + enable stop; + auf archiv (PROC (TEXT CONST) holen, archivinhalt) . + +auf archiv loeschen : + IF ziel ist manager THEN + archivnamen holen + END IF; + bitte warten; + archivinhalt := ALL eudas archiv; + auf archiv (PROC (TEXT CONST) auf archiv loeschen, archivinhalt) . + +archivuebersicht : + archiv anmelden; + disable stop; + bitte warten; + DATASPACE VAR list ds := nilspace; + f :=sequential file (output, list ds); + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + IF NOT is error THEN + modify (f); to line (f, 1); + write record (f, headline (f)); + headline (f, niltext); + edit (f, fenster rechts, "SHOW/Uebersicht", FALSE) + END IF; + forget (list ds); + tastenpuffer loeschen; + enable stop . + +uebersicht drucken : + archiv anmelden; + namen generieren; + FILE VAR f := sequential file (output, list name); + disable stop; + bitte warten; + list (f, eudas archiv); + IF falscher name THEN list (f, eudas archiv) END IF; + IF is error THEN forget (list name, quiet) END IF; + enable stop; + modify (f); + insert record (f); + write record (f, headline (f)); + print (list name); + forget (list name, quiet) . + +namen generieren : + INT VAR i := 0; + TEXT VAR list name; + REP + i INCR 1; + list name := "Archivliste " + text (i) + UNTIL NOT exists (list name) END REP . + +archiv initialisieren : + archiv anmelden; + IF keine diskette COR benanntes archiv CAND loeschen verneint THEN + LEAVE archiv initialisieren + END IF; + BOOL CONST mit format := ja (diskette formatieren, "JA/format"); + neuen namen erfragen; + tatsaechlich initialisieren . + +keine diskette : + NOT ja (diskette eingelegt, "JA/eingelegt") . + +benanntes archiv : + reserve ("", eudas archiv); + bitte warten; + disable stop; + archivinhalt := ALL eudas archiv; + BOOL CONST ergebnis := falscher name; + clear error; + enable stop; + ergebnis . + +loeschen verneint : + NOT ja (t archiv + textdarstellung (letzter archivname) + t ueberschreiben, + "JA/archiv loeschen") . + +neuen namen erfragen : + editget (neuer archivname, letzter archivname, "", "GET/Archivname"); + reserve (letzter archivname, eudas archiv) . + +tatsaechlich initialisieren : + IF mit format THEN + formatparameter abrufen; + archiv formatieren + ELSE + clear aufrufen + END IF . + +clear aufrufen : + bitte warten; + disable stop; + set command dialogue false; + clear (eudas archiv); + reset command dialogue . + +formatparameter abrufen : + INT VAR std := 1; + auswahl anbieten ("WAHL.Format", t formatparameter, "WAHL/format", std); + std DECR 1 . + +archiv formatieren : + bitte warten; + disable stop; + set command dialogue false; + format (std, eudas archiv); + reset command dialogue; + enable stop . + +zielarchiv einstellen : + INT VAR zielmodus := 1; + IF archivzugriff THEN + release (eudas archiv); archivzugriff := FALSE + END IF; + auswahl anbieten ("WAHL.Ziel", t zielmodus, "WAHL/zielarchiv", zielmodus); + TEXT VAR zieltaskname := archivtask (zielmodus); + IF zielmodus > 1 THEN + namen des zielarchivs erfragen + END IF; + zielstation einlesen; + werte uebertragen; + waehlbar (menue nr, 6, ziel ist manager); + waehlbar (menue nr, 9, NOT ziel ist manager); + bildschirm neu; + fussteil (2, stationsnr + zielarchiv) . + +namen des zielarchivs erfragen : + editget (name zielarchiv, zieltaskname, "", "GET/Zielarchiv"); + IF zieltaskname = niltext THEN + LEAVE zielarchiv einstellen + END IF; + archivtask (zielmodus) := zieltaskname . + +zielstation einlesen : + TEXT VAR rechner := text (station (myself)); + IF station (myself) <> 0 THEN + editget (nr zielstation, rechner, "", "GET/Zielstation") + END IF . + +werte uebertragen : + zielstation := int (rechner); + IF NOT last conversion ok THEN + errorstop (falsche stationsnr) + END IF; + zielarchiv := zieltaskname; + ziel ist manager := zielmodus = 1 OR zielmodus = 3; + teste auf manager (eudas archiv) . + +stationsnr : + IF zielstation = 0 THEN + niltext + ELSE + text (zielstation) + "/" + END IF . + +reservieren : + TEXT VAR parameter := niltext; + editget (name des archivs, parameter, "", "GET/Archivname"); + reserve (parameter, eudas archiv); + archivzugriff := TRUE . + +verlassen : + IF wahl nr = -1 THEN + IF archivzugriff THEN + release (eudas archiv) + END IF; + dialogfenster loeschen + END IF . + +END PROC archivverwaltung; + +TASK PROC eudas archiv : + + IF zielstation = 0 THEN + task (zielarchiv) + ELSE + zielstation / zielarchiv + END IF + +END PROC eudas archiv; + +PROC teste auf manager (TASK CONST t) : + + INT VAR i; + IF station (t) = station (myself) THEN + FOR i FROM 1 UPTO 5 REP + IF status (t) = 2 OR status (t) = 6 THEN + LEAVE teste auf manager + END IF; + pause (10) + END REP; + errorstop (task ist kein manager) + END IF + +END PROC teste auf manager; + +PROC archivnamen holen : + + TEXT VAR neuer archivname := letzter archivname; + editget (name des archivs, neuer archivname, "", "GET/Archivname"); + IF NOT archivzugriff OR neuer archivname <> letzter archivname THEN + reserve (neuer archivname, eudas archiv); + archivzugriff := TRUE + END IF; + letzter archivname := neuer archivname + +END PROC archivnamen holen; + +PROC archiv anmelden : + + IF NOT archivzugriff AND ziel ist manager THEN + reserve (letzter archivname, eudas archiv); + archivzugriff := TRUE + END IF + +END PROC archiv anmelden; + +BOOL PROC falscher name : + + IF ziel ist manager AND is error THEN + TEXT CONST meldung := errormessage; + IF subtext (meldung, 1, 14) = archiv heisst CAND + subtext (meldung, 16, 20) <> "?????" THEN + clear error; + nochmal anmelden; + LEAVE falscher name WITH TRUE + END IF + END IF; + FALSE . + +nochmal anmelden : + letzter archivname := subtext (meldung, 16, length (meldung) - 1); + reserve (letzter archivname, eudas archiv) . + +END PROC falscher name; + +PROC archivieren (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv ueberschreiben THEN + vorher eventuell sichern; + bitte warten; + set command dialogue false; + save (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv ueberschreiben : + ja (textdarstellung (dateiname) + t auf archiv ueberschreiben, + "JA/save", FALSE) . + +vorher eventuell sichern : + INT CONST nr := index der arbeitskopie (dateiname); + IF nr > 0 CAND aendern erlaubt CAND inhalt veraendert (nr) THEN + einzelsicherung (nr) + END IF . + +END PROC archivieren; + +PROC holen (TEXT CONST dateiname) : + + disable stop; + IF NOT exists (dateiname) COR eigene datei ueberschreiben THEN + bitte warten; + set command dialogue false; + fetch (dateiname, eudas archiv); + reset command dialogue + END IF . + +eigene datei ueberschreiben : + ja (textdarstellung (dateiname) + t im system ueberschreiben, + "JA/fetch", FALSE) . + +END PROC holen; + +PROC auf archiv loeschen (TEXT CONST dateiname) : + + disable stop; + IF NOT (archivinhalt CONTAINS dateiname) COR auf archiv loeschen THEN + bitte warten; + set command dialogue false; + erase (dateiname, eudas archiv); + reset command dialogue + END IF . + +auf archiv loeschen : + ja (textdarstellung (dateiname) + t auf archiv loeschen, + "JA/erase", FALSE) . + +END PROC auf archiv loeschen; + +PROC passwort einstellen : + + BOUND ROW 2 TEXT VAR pw; + DATASPACE VAR ds := nilspace; + pw := ds; + disable stop; + passwort holen (t passwort, pw (1)); + IF pw (1) = niltext THEN + fragen ob loeschen + ELSE + doppelt eingeben + END IF; + forget (ds) . + +fragen ob loeschen : + IF ja (passwort loeschen, "JA/pw loeschen") THEN + set command dialogue false; + enter password (niltext); + reset command dialogue + END IF . + +doppelt eingeben : + passwort holen (bitte passwort wiederholen, pw (2)); + IF pw (1) <> pw (2) THEN + errorstop (passwortwiederholung falsch) + ELSE + set command dialogue false; + enter password (pw (1)); + reset command dialogue + END IF . + +END PROC passwort einstellen; + +PROC passwort holen (TEXT CONST prompt, TEXT VAR wort) : + + enable stop; + dialog (prompt); + get secret line (wort) + +END PROC passwort holen; + + +(********************** Auswahlinterface **********************************) + +SATZ VAR + sammel; + +PROC aus sammel (TEXT VAR inhalt, INT CONST stelle) : + + IF stelle <= 256 THEN + feld lesen (sammel, stelle, inhalt) + ELSE + inhalt := niltext + END IF + +END PROC aus sammel; + +PROC feldnamen anzeigen : + + IF anzahl felder > 0 THEN + feldnamen sammeln; + sammlung zur auswahl anbieten; + ergebnis in editor uebernehmen + END IF . + +feldnamen sammeln : + INT VAR feldnr; + satz initialisieren (sammel, anzahl felder); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (sammel, feldnr, feldpuffer) + END REP . + +sammlung zur auswahl anbieten : + auswahl anbieten ("EUDAS-Editfelder", fenster rechts, + "AUSWAHL/Feldnamen", + PROC (TEXT VAR, INT CONST) aus sammel) . + +ergebnis in editor uebernehmen : + INT VAR stelle := 1; + WHILE wahl (stelle) > 0 REP + IF stelle > 1 THEN type (blank) END IF; + feldnamen lesen (wahl (stelle), feldpuffer); + type ("<"); type (feldpuffer); type (">"); + stelle INCR 1 + END REP . + +END PROC feldnamen anzeigen; + +PROC einzelausfuehrung (TEXT CONST prompt, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, TRUE, typ, PROC (TEXT CONST) operation) + +END PROC einzelausfuehrung; + +PROC ausfuehrung (TEXT CONST prompt, INT CONST typ, + PROC (TEXT CONST) operation) : + + ausfuehrung (prompt, FALSE, typ, PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +PROC ausfuehrung (PROC (TEXT CONST) operation) : + + ausfuehrung (name der datei, 0, PROC (TEXT CONST) operation) + +END PROC ausfuehrung; + +END PACKET eudas steuerung; + diff --git a/app/eudas/5.3/src/eudas.uebersicht.04 b/app/eudas/5.3/src/eudas.uebersicht.04 new file mode 100644 index 0000000..be597da --- /dev/null +++ b/app/eudas/5.3/src/eudas.uebersicht.04 @@ -0,0 +1,404 @@ +PACKET uebersichtsanzeige + +(*************************************************************************) +(* *) +(* Anzeige von EUDAS-Dateien als Übersicht *) +(* *) +(* Version 04 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 14.01.88 *) +(* *) +(*************************************************************************) + + DEFINES + + uebersicht, + uebersichtsfenster : + + +ROW 24 INT VAR zeilensatz; + +ROW 24 INT VAR zeilenkombi; + +FENSTER VAR fenster; +fenster initialisieren (fenster); + +INT VAR + laenge := 24, + breite := 79, + zeilen anf := 1, + spalten anf := 1, + freier rest, + feldversion := -1; + +BOOL VAR + bis zeilenende; + +TEXT VAR + feldnummern; + +LET + niltext = "", + begin mark = ""15"", + end mark = ""14"", + blank = " ", + piep = ""7"", + cleol = ""5""; + +LET + t satznr = #901# + ""15"Satznr. ", + t dateiende = #902# + " << DATEIENDE >>", + uebersicht status = #903# +"UEBERSICHT: Rollen: HOP OBEN, HOP UNTEN Beenden: ESC q Hilfe: ESC ?"; + + +PROC uebersichtsfenster (FENSTER CONST fe) : + + fenstergroesse (fe, spalten anf, zeilen anf, breite, laenge); + fenstergroesse setzen (fenster, fe); + bis zeilenende := spalten anf + breite >= x size + +END PROC uebersichtsfenster; + +FENSTER PROC uebersichtsfenster : + fenster +END PROC uebersichtsfenster; + +PROC uebersicht (TEXT CONST nummern, PROC hilfe) : + + TEXT VAR eingabezeichen; + BOOL VAR dummy; + INT VAR + angezeigter satz := 1, + ausgegebene zeilen := 0, + eingabezustand := 1; + + fensterzugriff (fenster, dummy); + status anzeigen (uebersicht status); + feldnummern bestimmen; + aktueller satz wird erster; + REP + kommando annehmen und zeile ausgeben; + cursor auf zeilenanfang; + kommando interpretieren + END REP . + +feldnummern bestimmen : + IF nummern = niltext THEN + ggf alte auswahl uebernehmen + ELSE + feldnummern := nummern; + feldversion := dateiversion + END IF . + +ggf alte auswahl uebernehmen : + IF feldversion <> dateiversion THEN + alle felder anzeigen; + feldversion := dateiversion + END IF . + +alle felder anzeigen : + INT VAR i; + feldnummern := niltext; + FOR i FROM 1 UPTO anzahl felder REP + feldnummern CAT code (i) + END REP . + +kommando annehmen und zeile ausgeben : + WHILE ausgegebene zeilen < laenge REP + eingabezeichen := getcharety; + IF eingabezeichen <> "" THEN + LEAVE kommando annehmen und zeile ausgeben + END IF; + eine zeile ausgeben; + ausgegebene zeilen INCR 1 + END REP; + aktuellen satz markieren und einnehmen; + getchar (eingabezeichen) . + +eine zeile ausgeben : + IF ausgegebene zeilen = 0 THEN + ueberschrift ausgeben + ELIF ausgegebene zeilen = 1 THEN + erste zeile ausgeben + ELSE + weitere zeile ausgeben + END IF . + +ueberschrift ausgeben : + cursor (spalten anf, zeilen anf); + out (t satznr); + freier rest := breite - length (t satznr) - 1; + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feldnamen bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP; + zeilenrest loeschen; + cursor (spalten anf + breite - 1, zeilen anf); + out (end mark) . + +erste zeile ausgeben : + auf uebersichtssatz (1); + satznummer in zeile (1); + satz als zeile ausgeben . + +weitere zeile ausgeben : + cursor (spalten anf, zeilen anf + ausgegebene zeilen); + IF dateiende THEN + zeilensatz (ausgegebene zeilen) := 0; + freier rest := breite; + zeilenrest loeschen + ELSE + naechsten satz einnehmen; + satznummer in zeile (ausgegebene zeilen); + satz als zeile ausgeben + END IF . + +naechsten satz einnehmen : + weiter (2); + auf abbruch testen; + zeilensatz (ausgegebene zeilen) := satznummer; + zeilenkombi (ausgegebene zeilen) := satzkombination . + +auf abbruch testen : + IF NOT (satz ausgewaehlt OR dateiende) THEN + LEAVE uebersicht + END IF . + +cursor auf zeilenanfang : + cursor (spalten anf, zeilen anf + angezeigter satz) . + +aktuellen satz markieren und einnehmen : + WHILE zeilensatz (angezeigter satz) = 0 REP + angezeigter satz DECR 1 + END REP; + auf uebersichtssatz (angezeigter satz); + cursor (spalten anf + 6, zeilen anf + angezeigter satz) . + +kommando interpretieren : + SELECT eingabezustand OF + CASE 1 : normales kommando interpretieren + CASE 2 : hop kommando interpretieren + CASE 3 : esc kommando interpretieren + END SELECT . + +normales kommando interpretieren : + SELECT pos (""3""10""1""27"+-", eingabezeichen) OF + CASE 1 : zeile nach oben + CASE 2 : zeile nach unten + CASE 3 : eingabezustand := 2 + CASE 4 : eingabezustand := 3 + CASE 5 : markieren + CASE 6 : demarkieren + OTHERWISE out (piep) + END SELECT . + +hop kommando interpretieren : + SELECT pos (""3""10""13"", eingabezeichen) OF + CASE 1 : seite nach oben + CASE 2 : seite nach unten + CASE 3 : hop return + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +esc kommando interpretieren : + SELECT pos ("19qh?", eingabezeichen) OF + CASE 1 : esc 1 + CASE 2 : esc 9 + CASE 3, 4 : esc q + CASE 5 : hilfestellung + OTHERWISE out (piep) + END SELECT; + eingabezustand := 1 . + +zeile nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz DECR 1; + ELSE + nach oben rollen (1); + ausgegebene zeilen := 1 + END IF . + +zeile nach unten : + IF NOT dateiende THEN + IF angezeigter satz < laenge - 1 THEN + angezeigter satz INCR 1 + ELSE + zeilensatz (1) := zeilensatz (2); + zeilenkombi (1) := zeilenkombi (2); + ausgegebene zeilen := 1 + END IF + END IF . + +markieren : + IF NOT satz markiert THEN + markierung aendern; + IF angezeigter satz < ausgegebene zeilen THEN + satznummer in zeile (angezeigter satz) + END IF + END IF . + +demarkieren : + IF satz markiert THEN + markierung aendern; + IF angezeigter satz < ausgegebene zeilen THEN + satznummer in zeile (angezeigter satz) + END IF + END IF . + +seite nach oben : + IF angezeigter satz > 1 THEN + angezeigter satz := 1 + ELSE + nach oben rollen (laenge - 1); + ausgegebene zeilen := 1 + END IF . + +seite nach unten : + IF angezeigter satz = laenge - 1 AND NOT dateiende THEN + weiter (2); + aktueller satz wird erster; + ausgegebene zeilen := 1 + ELSE + angezeigter satz := laenge - 1 + END IF . + +hop return : + IF angezeigter satz <> 1 THEN + zeilensatz (1) := zeilensatz (angezeigter satz); + zeilenkombi (1) := zeilenkombi (angezeigter satz); + angezeigter satz := 1; + ausgegebene zeilen := 1 + END IF . + +esc 1 : + auf satz (1); + IF NOT satz ausgewaehlt THEN + weiter (2) + END IF; + aktueller satz wird erster; + angezeigter satz := 1; + ausgegebene zeilen := 1 . + +esc 9 : + auf satz (32767); + aktueller satz wird erster; + nach oben rollen (laenge - 2); + ausgegebene zeilen := 1 . + +esc q : + LEAVE uebersicht . + +hilfestellung : + hilfe; + status anzeigen (uebersicht status); + ausgegebene zeilen := 0 . + +END PROC uebersicht; + +PROC nach oben rollen (INT CONST gerollt) : + + INT VAR i; + auf uebersichtssatz (1); + FOR i FROM 1 UPTO gerollt + WHILE satznummer > 1 REP + zurueck (2) + END REP; + aktueller satz wird erster + +END PROC nach oben rollen; + +PROC auf uebersichtssatz (INT CONST zeile) : + + auf satz (zeilensatz (zeile)); + WHILE satzkombination <> zeilenkombi (zeile) REP + weiter (1) + END REP + +END PROC auf uebersichtssatz; + +PROC aktueller satz wird erster : + + zeilensatz (1) := satznummer; + zeilenkombi (1) := satzkombination + +END PROC aktueller satz wird erster; + +BOOL PROC uebereinstimmung (INT CONST zeile) : + + satznummer = zeilensatz (zeile) CAND satzkombination = zeilenkombi (zeile) + +END PROC uebereinstimmung; + +PROC feld bis rest (TEXT CONST satz, INT CONST von, bis) : + + INT CONST laenge := min (freier rest, bis - von + 1); + outsubtext (satz, von, von + laenge - 1); + freier rest DECR laenge; + IF freier rest >= 2 THEN + out (", "); freier rest DECR 2 + ELIF freier rest = 1 THEN + out (","); freier rest := 0 + END IF + +END PROC feld bis rest; + +PROC satznummer in zeile (INT CONST zeile) : + + cursor (spalten anf, zeilen anf + zeile); + IF satz markiert THEN + out (begin mark) + ELSE + out (blank) + END IF; + outtext (text (satznummer), 1, 5); + IF satz markiert THEN + out (end mark) + ELSE + out (blank) + END IF; + freier rest := breite - 7 + +END PROC satznummer in zeile; + +PROC zeilenrest loeschen : + + IF bis zeilenende THEN + out (cleol) + ELSE + freier rest TIMESOUT blank + END IF + +END PROC zeilenrest loeschen; + +PROC satz als zeile ausgeben : + + IF satz ausgewaehlt THEN + felder ausgeben + ELIF dateiende THEN + out (t dateiende); + freier rest DECR length (t dateiende) + ELSE + out ("<< >>"); + freier rest DECR 5 + END IF; + zeilenrest loeschen . + +felder ausgeben : + INT VAR feldindex; + FOR feldindex FROM 1 UPTO length (feldnummern) + WHILE freier rest > 0 REP + feld bearbeiten (code (feldnummern SUB feldindex), + PROC (TEXT CONST, INT CONST, INT CONST) feld bis rest) + END REP . + +END PROC satz als zeile ausgeben; + +END PACKET uebersichtsanzeige; + diff --git a/app/eudas/5.3/src/eudas.verarbeiten.06 b/app/eudas/5.3/src/eudas.verarbeiten.06 new file mode 100644 index 0000000..8d91407 --- /dev/null +++ b/app/eudas/5.3/src/eudas.verarbeiten.06 @@ -0,0 +1,745 @@ +PACKET verarbeitung + +(*************************************************************************) +(* *) +(* Automatische Verarbeitung von EUDAS-Dateien *) +(* *) +(* Version 06 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + kopiere, + std kopiermuster, + verarbeite, + trage, + eindeutige felder, + pruefe, + wertemenge, + feldmaske, + trage satz, + hole satz, + K, + V, + f, + wert, + zahltext, + textdarstellung : + + +SATZ VAR + zielfeldnamen, + kopierfeldnamen, + kopiersatz; + +INT VAR kopierindex; + +BOOL VAR erstes mal; + +LET + niltext = "", + INTVEC = TEXT; + +INTVEC VAR kopiervektor; + +TEXT VAR zwei bytes := " "; + + +OP CAT (INTVEC VAR intvec, INT CONST zahl) : + + replace (zwei bytes, 1, zahl); + intvec CAT zwei bytes + +END OP CAT; + +PROC std kopiermuster (TEXT CONST dateiname, FILE VAR kopiermuster) : + + teste ob datei vorhanden; + INT VAR zielfelder; + dateien oeffnen; + feldnamen bestimmen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO zielfelder REP + feldnamen auslesen; + IF feld vorhanden THEN + direkt kopieren + ELSE + leer kopieren + END IF + END REP . + +dateien oeffnen : + output (kopiermuster); + EUDAT VAR eudas datei; + IF exists (dateiname) THEN + oeffne (eudas datei, dateiname) + END IF . + +feldnamen bestimmen : + IF exists (dateiname) CAND felderzahl (eudas datei) > 0 THEN + feldnamen lesen (eudas datei, zielfeldnamen); + zielfelder := felderzahl (eudas datei) + ELSE + quellfeldnamen kopieren; + zielfelder := anzahl felder + END IF . + +quellfeldnamen kopieren : + TEXT VAR feldname; + satz initialisieren (zielfeldnamen); + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldname); + feld aendern (zielfeldnamen, feldnr, feldname) + END REP . + +feld vorhanden : + feldnummer (feldname) > 0 . + +feldnamen auslesen : + feld lesen (zielfeldnamen, feldnr, feldname); + put (kopiermuster, textdarstellung (feldname)) . + +direkt kopieren : + write (kopiermuster, "K f("); + write (kopiermuster, textdarstellung (feldname)); + putline (kopiermuster, ");") . + +leer kopieren : + putline (kopiermuster, "K """";") . + +END PROC std kopiermuster; + +PROC kopiere (TEXT CONST dateiname, FILE VAR kopiermuster) : + + programmfunktion (kopieraufruf, kopiermuster) . + +kopieraufruf : + "kopiere (" + textdarstellung (dateiname) + ", " . + +END PROC kopiere; + +PROC programmfunktion (TEXT CONST aufruf, FILE VAR muster) : + + programmdatei einrichten; + write (programm, aufruf); + putline (programm, "PROC programmfunktion);"); + putline (programm, "PROC programmfunktion:"); + muster kopieren; + putline (programm, "END PROC programmfunktion"); + programm ausfuehren; + forget (programm datei, quiet) . + +programmdatei einrichten : + TEXT VAR programmdatei; + INT VAR i := 0; + REP + i INCR 1; + programmdatei := text (i) + UNTIL NOT exists (programmdatei) END REP; + disable stop; + FILE VAR programm := sequential file (output, programm datei); + headline (programm, erzeugtes programm) . + +muster kopieren : + TEXT VAR zeile; + input (muster); + WHILE NOT eof (muster) REP + getline (muster, zeile); + putline (programm, zeile) + END REP . + +programm ausfuehren : + TEXT CONST alter last param := std; + run (programmdatei); + last param (alter last param) . + +END PROC programm funktion; + +PROC kopiere (TEXT CONST dateiname, PROC kopierfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + IF dateiende THEN + auf satz (1); + LEAVE kopiere + ELSE + zieldatei einrichten + END IF; + + WHILE NOT dateiende REP + satz initialisieren (kopiersatz); + kopierindex := 1; + kopierfunktion; + evtl feldnamen einrichten; + satz einfuegen (eudas datei, kopiersatz); + weiter (eudas datei); + weiter (modus) + END REP; + auf satz (1) . + +zieldatei einrichten : + erstes mal := TRUE; + EUDAT VAR eudas datei; + oeffne (eudas datei, dateiname); + auf satz (eudas datei, saetze (eudas datei) + 1); + feldnamen lesen (eudas datei, kopierfeldnamen); + kopiervektor := niltext . + +evtl feldnamen einrichten : + IF erstes mal THEN + feldnamen aendern (eudas datei, kopierfeldnamen); + erstes mal := FALSE + END IF + +END PROC kopiere; + +OP K (TEXT CONST feldname, ausdruck) : + + IF erstes mal THEN + kopiervektor erstellen; + END IF; + feld aendern (kopiersatz, kopiervektor ISUB kopierindex, ausdruck); + kopierindex INCR 1 . + +kopiervektor erstellen : + INT VAR aktueller index := feldindex (kopierfeldnamen, feldname); + IF aktueller index = 0 THEN + aktueller index := felderzahl (kopierfeldnamen) + 1; + feld aendern (kopierfeldnamen, aktueller index, feldname); + END IF; + kopiervektor CAT aktueller index . + +END OP K; + +PROC verarbeite (FILE VAR verarbeitungsmuster) : + + programmfunktion ("verarbeite (", verarbeitungsmuster) + +END PROC verarbeite; + +PROC verarbeite (PROC verarbeitungsfunktion) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + + WHILE NOT dateiende REP + verarbeitungsfunktion; + weiter (modus) + END REP; + auf satz (1) + +END PROC verarbeite; + +OP V (TEXT CONST feldname, ausdruck) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname) + ELSE + feld aendern (nr, ausdruck) + END IF + +END OP V; + +PROC auf ersten satz (INT VAR modus) : + + teste ob datei vorhanden; + auf satz (1); + IF markierte saetze > 0 THEN + modus := 3; + IF NOT satz markiert THEN weiter (modus) END IF + ELSE + modus := 2; + IF NOT satz ausgewaehlt THEN weiter (modus) END IF + END IF + +END PROC auf ersten satz; + +PROC teste ob datei vorhanden : + + IF anzahl dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF . + +END PROC teste ob datei vorhanden; + + +(******************************** Zugriffe *******************************) + +TEXT VAR + feldpuffer, + werttext; + +LET quote = """"; + + +TEXT PROC f (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + feldpuffer := niltext + ELSE + feld lesen (nr, feldpuffer) + END IF; + feldpuffer + +END PROC f; + +REAL PROC wert (TEXT CONST feldname) : + + INT CONST nr := feldnummer (feldname); + IF nr = 0 THEN + unbekannt (feldname); + 0.0 + ELSE + feld lesen (nr, feldpuffer); + REAL VAR ergebnis; + wert berechnen (feldpuffer, ergebnis); + ergebnis + END IF + +END PROC wert; + +REAL PROC wert (TEXT CONST feldname, INT CONST kommastellen) : + + round (wert (feldname), kommastellen) + +END PROC wert; + +TEXT PROC zahltext (REAL CONST feldwert, INT CONST kommastellen) : + + REAL CONST w := round (abs (feldwert), kommastellen); + INT VAR stellen := exponent der zahl + kommastellen + 2; + IF feldwert < 0.0 THEN + werttext := "-" + ELSE + werttext := niltext + END IF; + IF w < 1.0 AND w <> 0.0 THEN + werttext CAT "0"; + stellen DECR 1 + ENDIF; + werttext CAT text (w, stellen, kommastellen); + IF kommastellen > 0 THEN + change (werttext, ".", dezimalkomma) + ELSE + change (werttext, ".", niltext) + END IF; + werttext . + +exponent der zahl : + max (0, decimal exponent (w)) . + +END PROC zahltext; + +TEXT PROC zahltext (TEXT CONST feldname, INT CONST kommastellen) : + + zahltext (wert (feldname), kommastellen) + +END PROC zahltext; + +TEXT PROC textdarstellung (TEXT CONST anzeigetext) : + + feldpuffer := anzeigetext; + change all (feldpuffer, quote, quote + quote); + steuerzeichen umwandeln; + insert char (feldpuffer, quote, 1); + feldpuffer CAT quote; + feldpuffer . + +steuerzeichen umwandeln : + INT VAR stelle := 1; + WHILE steuerzeichen vorhanden REP + change (feldpuffer, stelle, stelle, steuertext) + END REP . + +steuerzeichen vorhanden : + stelle := pos (feldpuffer, ""0"", ""31"", stelle); + stelle > 0 . + +steuertext : + quote + text (code (feldpuffer SUB stelle)) + quote . + +END PROC textdarstellung; + +PROC unbekannt (TEXT CONST feldname) : + + errorstop (t das feld + textdarstellung (feldname) + + nicht definiert) + +END PROC unbekannt; + + +(****************************** Tragen ***********************************) + +SATZ VAR tragsatz; + +EUDAT VAR zieldatei; + +LET + erzeugtes programm = #501# + "erzeugtes Programm", + keine datei geoeffnet = #502# + "keine Datei geoeffnet", + kein satz vorhanden = #503# + "Kein Satz zum Tragen vorhanden", + falsche felderzahl = #504# + "Zieldatei hat falsche Felderzahl", + existiert nicht = #505# + " existiert nicht", + verletzt die pruefbedingung = #506# + " verletzt die Pruefbedingung.", + bereits vorhanden = #507# + " ist in der Zieldatei bereits vorhanden.", + nicht definiert = #508# + " ist nicht definiert.", + nicht in wertemenge = #509# + " ist nicht in der Wertemenge.", + passt nicht zu maske = #510# + " stimmt nicht mit der Maske ueberein.", + t satz = #511# + "Satz ", + t das feld = #512# + "Das Feld "; + +INT VAR + anzahl eindeutiger felder; + +FILE VAR protokoll; + +BOOL VAR + testen := FALSE, + test erfolgreich, + uebereinstimmung; + +TEXT VAR testprogramm; + + +PROC trage (TEXT CONST dateiname, FILE VAR protokoll file, BOOL CONST test) : + + disable stop; + testen := test; + IF testen THEN + protokoll := protokoll file; + output (protokoll) + END IF; + trage intern (dateiname); + testen := FALSE + +END PROC trage; + +PROC trage intern (TEXT CONST dateiname) : + + enable stop; + INT VAR modus; + auf ersten satz (modus); + tragen vorbereiten (dateiname); + + INT VAR satzzaehler := 0; + REP + IF NOT ausgewaehlt THEN + weiter (modus) + ELSE + cout (satznummer + satzzaehler) + END IF; + IF dateiende THEN auf satz (1); LEAVE trage intern END IF; + satz testen und tragen + END REP . + +ausgewaehlt : + IF modus = 3 THEN satz markiert ELSE satz ausgewaehlt END IF . + +satz testen und tragen : + test erfolgreich := TRUE; + IF testen THEN + notizen lesen (zieldatei, 1, testprogramm); + do (testprogramm) + END IF; + IF test erfolgreich THEN + trage einzelsatz; + IF test erfolgreich THEN + satz loeschen; + satzzaehler INCR 1 + END IF + END IF; + IF NOT test erfolgreich THEN + weiter (modus) + END IF . + +END PROC trage intern; + +PROC tragen vorbereiten (TEXT CONST dateiname) : + + IF dateiende THEN + errorstop (kein satz vorhanden) + END IF; + oeffne (zieldatei, dateiname); + anzahl eindeutiger felder := 0; + IF felderzahl (zieldatei) = 0 THEN + zieldatei einrichten + ELIF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + END IF; + auf satz (zieldatei, saetze (zieldatei) + 1) . + +zieldatei einrichten : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feldnamen lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP; + feldnamen aendern (zieldatei, tragsatz); + feldinfo kopieren; + notizen kopieren . + +feldinfo kopieren : + FOR feldnr FROM 1 UPTO anzahl felder REP + feldinfo (zieldatei, feldnr, feldinfo (feldnr)) + END REP . + +notizen kopieren : + INT VAR i; + FOR i FROM 1 UPTO 3 REP + notizen lesen (i, feldpuffer); + notizen aendern (zieldatei, i, feldpuffer) + END REP . + +END PROC tragen vorbereiten; + +PROC trage einzelsatz : + + IF anzahl eindeutiger felder > 0 CAND schon vorhanden THEN + protokolliere ("", bereits vorhanden) + ELSE + tragsatz aufbauen; + satz einfuegen (zieldatei, tragsatz); + weiter (zieldatei) + END IF . + +tragsatz aufbauen : + satz initialisieren (tragsatz, anzahl felder); + INT VAR feldnr; + FOR feldnr FROM 1 UPTO anzahl felder REP + feld lesen (feldnr, feldpuffer); + feld aendern (tragsatz, feldnr, feldpuffer) + END REP . + +schon vorhanden : + TEXT VAR muster; + INT CONST alte satznummer := satznr (zieldatei); + feld lesen (1, muster); + uebereinstimmung := FALSE; + auf satz (zieldatei, muster); + WHILE NOT dateiende (zieldatei) REP + teste auf uebereinstimmung; + weiter (zieldatei, muster) + UNTIL uebereinstimmung END REP; + auf satz (zieldatei, alte satznummer); + uebereinstimmung . + +teste auf uebereinstimmung : + INT VAR i; + uebereinstimmung := TRUE; + FOR i FROM 2 UPTO anzahl eindeutiger felder REP + feld lesen (zieldatei, i, feldpuffer); + feld bearbeiten (i, + PROC (TEXT CONST, INT CONST, INT CONST) felduebereinstimmung); + IF NOT uebereinstimmung THEN + LEAVE teste auf uebereinstimmung + END IF + END REP . + +END PROC trage einzelsatz; + +PROC felduebereinstimmung (TEXT CONST satz, INT CONST von, bis) : + + IF laengen ungleich COR + (length (feldpuffer) > 0 CAND text ungleich) THEN + uebereinstimmung := FALSE + END IF . + +laengen ungleich : + (bis - von + 1) <> length (feldpuffer) . + +text ungleich : + pos (satz, feldpuffer, von, bis + 1) <> von . + +END PROC felduebereinstimmung; + +PROC protokolliere (TEXT CONST feld, meldung) : + + IF testen THEN + in protokoll + ELSE + errorstop (meldung) + END IF . + +in protokoll : + put (protokoll, t satz); put (protokoll, satznummer); + IF feld <> "" THEN + write (protokoll, t das feld); + write (protokoll, textdarstellung (feld)) + END IF; + putline (protokoll, meldung); + test erfolgreich := FALSE . + +END PROC protokolliere; + +PROC eindeutige felder (INT CONST anzahl) : + + anzahl eindeutiger felder := anzahl + +END PROC eindeutige felder; + +PROC pruefe (TEXT CONST feld, BOOL CONST bedingung) : + + IF NOT bedingung THEN + protokolliere (feld, verletzt die pruefbedingung) + END IF + +END PROC pruefe; + +PROC wertemenge (TEXT CONST feld, menge) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + pruefe ob enthalten + END IF . + +pruefe ob enthalten : + INT VAR stelle := 0; + LET komma = ","; + feld lesen (nr, feldpuffer); + IF ist letztes element THEN + LEAVE pruefe ob enthalten + END IF; + feldpuffer CAT komma; + REP + stelle := pos (menge, feldpuffer, stelle + 1); + IF stelle = 1 OR + stelle > 1 CAND (menge SUB stelle - 1) = komma THEN + LEAVE pruefe ob enthalten + END IF + UNTIL stelle = 0 END REP; + protokolliere (feld, nicht in wertemenge) . + +ist letztes element : + INT CONST letzter anfang := length (menge) - length (feldpuffer); + (menge SUB letzter anfang) = komma AND + pos (menge, feldpuffer, letzter anfang + 1) > 0 . + +END PROC wertemenge; + +PROC feldmaske (TEXT CONST feld, maske) : + + INT CONST nr := feldnummer (feld); + IF nr = 0 THEN + protokolliere (feld, nicht definiert) + ELSE + feld lesen (nr, feldpuffer); + mit maske vergleichen + END IF . + +mit maske vergleichen : + INT VAR stelle; + TEXT CONST ende := code (length (maske) + 1); + TEXT VAR moegliche positionen := ""1""; + FOR stelle FROM 1 UPTO length (feldpuffer) REP + TEXT CONST zeichen := feldpuffer SUB stelle; + zeichen vergleichen + UNTIL moegliche positionen = "" END REP; + IF nicht erfolgreich THEN + protokolliere (feld, passt nicht zu maske) + END IF . + +zeichen vergleichen : + INT VAR moeglich := 1; + WHILE moeglich <= length (moegliche positionen) REP + INT CONST position := code (moegliche positionen SUB moeglich); + IF (maske SUB position) = "*" THEN + stern behandeln + ELIF vergleich trifft zu THEN + replace (moegliche positionen, moeglich, code (position + 1)); + moeglich INCR 1 + ELSE + delete char (moegliche positionen, moeglich) + END IF + END REP . + +stern behandeln : + IF position = length (maske) THEN + LEAVE feldmaske + END IF; + moeglich INCR 1; + IF pos (moegliche positionen, code (position + 1)) = 0 THEN + insert char (moegliche positionen, code (position + 1), moeglich) + END IF . + +vergleich trifft zu : + SELECT pos ("9XAa", maske SUB position) OF + CASE 1 : pos ("0123456789", zeichen) > 0 + CASE 2 : TRUE + CASE 3 : pos ("ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ", zeichen) > 0 + CASE 4 : pos ("abcdefghijklmnopqrstuvwxyzäöüß", zeichen) > 0 + OTHERWISE (maske SUB position) = zeichen + END SELECT . + +nicht erfolgreich : + (moegliche positionen = "" COR pos (moegliche positionen, ende) = 0) + AND nicht gerade stern am ende . + +nicht gerade stern am ende : + (maske SUB length (maske)) <> "*" OR + pos (moegliche positionen, code (length (maske))) = 0 . + +END PROC feldmaske; + +PROC trage satz (TEXT CONST dateiname) : + + tragen vorbereiten (dateiname); + INT CONST alter satz := satznr (zieldatei); + trage einzelsatz; + satz loeschen; + auf satz (zieldatei, alter satz) + +END PROC trage satz; + +PROC hole satz (TEXT CONST dateiname) : + + teste ob datei vorhanden; + IF NOT exists (dateiname) THEN + errorstop (textdarstellung (dateiname) + existiert nicht) + END IF; + oeffne (zieldatei, dateiname); + IF felderzahl (zieldatei) <> anzahl felder THEN + errorstop (falsche felderzahl) + ELIF saetze (zieldatei) = 0 THEN + errorstop (kein satz vorhanden) + END IF; + auf satz (zieldatei, saetze (zieldatei)); + satz lesen (zieldatei, tragsatz); + tragsatz einfuegen; + satz loeschen (zieldatei) . + +tragsatz einfuegen : + satz einfuegen; + INT VAR feldnr; + FOR feldnr FROM 1 UPTO felderzahl (tragsatz) REP + feld lesen (tragsatz, feldnr, feldpuffer); + feld aendern (feldnr, feldpuffer) + END REP . + +END PROC hole satz; + +END PACKET verarbeitung; + diff --git a/app/eudas/5.3/src/eudas.verwaltung.11 b/app/eudas/5.3/src/eudas.verwaltung.11 new file mode 100644 index 0000000..9fc1393 --- /dev/null +++ b/app/eudas/5.3/src/eudas.verwaltung.11 @@ -0,0 +1,2047 @@ +PACKET datenverwaltung + +(*************************************************************************) +(* *) +(* Verwaltung der aktuellen EUDAS-Dateien *) +(* *) +(* Version 11 *) +(* *) +(* Autor: Thomas Berlage *) +(* Stand: 04.02.89 *) +(* *) +(*************************************************************************) + + DEFINES + + oeffne, + kopple, + kette, + zugriff, + sichere, + dateien loeschen, + auf koppeldatei, + + anzahl koppeldateien, + anzahl dateien, + aendern erlaubt, + inhalt veraendert, + eudas dateiname, + folgedatei, + herkunft, + + dateiversion, + + anzahl felder, + feldnamen lesen, + feldnamen bearbeiten, + feldnummer, + feldinfo, + notizen lesen, + notizen aendern, + + feld lesen, + feld bearbeiten, + feld aendern, + + satznummer, + satzkombination, + dateiende, + weiter, + zurueck, + auf satz, + + satz einfuegen, + satz loeschen, + aenderungen eintragen, + + suchbedingung, + suchbedingung lesen, + suchbedingung loeschen, + suchversion, + satz ausgewaehlt, + markierung aendern, + satz markiert, + markierungen loeschen, + markierte saetze : + + +LET + INTVEC = TEXT, + + DATEI = STRUCT + (TEXT name, + SATZ feldnamen, + INTVEC koppelfelder, + INT anz koppelfelder, + INT naechste datei, + INT alte koppelposition, + TASK ursprung, + DATASPACE ds, + EUDAT eudat, + SATZ satzpuffer, + BOOL gepuffert, + BOOL veraendert, datei veraendert, koppelfeld veraendert, + TEXT muster, + INTVEC marksaetze, + INT markzeiger), + + VERWEIS = STRUCT (INT datei, feld); + +LET + niltext = "", + empty intvec = ""; + +LET + maxint = 32767, + maxdateien = 10, + maxfelder = 256, + maxkoppeln = 32; + +ROW maxdateien DATEI VAR daten; + +INT VAR + anz dateien := 0, + anz koppeldateien := 0, + hauptdatei, + erste koppeldatei := 0, + felderzahl der ersten datei, + anz felder := 0, + satznummer offset, + kombination, + markierungen, + laufzaehler := 0; + +BOOL VAR + ende der datei := TRUE, + aenderungserlaubnis, + globales muster vorhanden; + +TEXT VAR globales muster; + +ROW maxfelder VERWEIS VAR verweis; + +ROW maxkoppeln VERWEIS VAR koppeln; + +INT VAR koppeleintraege; + +LET + zuviel dateien = #301# + "Zuviel Dateien geoeffnet", + datei existiert nicht = #302# + "Datei existiert nicht", + nicht im umgeschalteten zustand = #303# + "Nicht moeglich, wenn auf Koppeldatei geschaltet", + zu viele felder = #304# + "Zu viele Felder", + zu viele koppelfelder = #305# + "Zu viele Koppelfelder", + keine koppelfelder = #306# + "keine Koppelfelder vorhanden", + kein zugriff bei ketten oder koppeln = #307# + "kein direkter Dateizugriff bei geketteten oder gekoppelten Dateien", + keine datei geoeffnet = #308# + "keine Datei geoeffnet", + datei nicht gesichert = #309# + "Datei nicht gesichert", + suchmuster zu umfangreich = #310# + "Suchmuster zu umfangreich"; + +TEXT VAR feldpuffer; + + +(***************************** INTVEC ************************************) + +TEXT VAR raum fuer ein int := " "; + +INTVEC VAR puffer; + +OP CAT (INTVEC VAR text, INT CONST wert) : + + replace (raum fuer ein int, 1, wert); + text CAT raum fuer ein int + +END OP CAT; + +PROC insert (INTVEC VAR vector, INT CONST stelle, wert) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 1); + vector := subtext (vector, 1, trennung); + vector CAT wert; + vector CAT puffer + +END PROC insert; + +PROC delete (INTVEC VAR vector, INT CONST stelle) : + + INT CONST trennung := stelle + stelle - 2; + puffer := subtext (vector, trennung + 3); + vector := subtext (vector, 1, trennung); + vector CAT puffer + +END PROC delete; + +PROC inkrement (INTVEC VAR vector, INT CONST ab, um) : + + INT VAR i; + FOR i FROM ab UPTO length (vector) DIV 2 - 1 REP + replace (vector, i, (vector ISUB i) + um) + END REP + +END PROC inkrement; + + +(***************************** Dateien eintragen *************************) + +EUDAT VAR eudas datei; + +SATZ VAR namen; + +PROC datei testen (TEXT CONST dateiname) : + + IF anz dateien = maxdateien THEN + errorstop (zuviel dateien) + END IF; + IF NOT exists (dateiname) THEN + errorstop (datei existiert nicht) + END IF; + IF umgeschaltet THEN + errorstop (nicht im umgeschalteten zustand) + END IF; + oeffne (eudas datei, dateiname) + +END PROC datei testen; + +PROC datei eintragen (DATEI VAR datei, TEXT CONST dateiname, + TASK CONST manager) : + + IF aenderungserlaubnis OR NOT is niltask (manager) THEN + datei. ds := old (dateiname); + oeffne (datei. eudat, datei. ds); + IF NOT aenderungserlaubnis THEN forget (dateiname, quiet) END IF + ELSE + oeffne (datei. eudat, dateiname) + END IF; + datei. ursprung := manager; + datei. naechste datei := 0; + datei. veraendert := FALSE; + datei. datei veraendert := FALSE; + datei. name := dateiname; + mark loeschen (datei) + +END PROC datei eintragen; + +PROC in dateikette (INT CONST anfang) : + + INT VAR dateiindex := anfang; + WHILE daten (dateiindex). naechste datei <> 0 REP + dateiindex := daten (dateiindex). naechste datei + END REP; + daten (dateiindex). naechste datei := anz dateien + +END PROC in dateikette; + +PROC anfangsposition einnehmen : + + IF dateiende (daten (1). eudat) THEN + auf satz (1) + ELSE + auf satz (satznr (daten (1). eudat)) + END IF + +END PROC anfangsposition einnehmen; + +PROC felder anlegen : + + felderzahl der ersten datei := felderzahl (daten (1). eudat); + anz felder := felderzahl der ersten datei; + feldnamen lesen (daten (1). eudat, daten (1). feldnamen); + koppeleintraege := 0; + INT VAR i; + FOR i FROM 1 UPTO anz felder REP + verweis (i). datei := 0 + END REP + +END PROC felder anlegen; + +PROC laufzaehler erhoehen : + + laufzaehler INCR 1; + IF laufzaehler > 32000 THEN + laufzaehler := - 32000 + END IF + +END PROC laufzaehler erhoehen; + +PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern) : + + oeffne (dateiname, auch aendern, niltask) + +END PROC oeffne; + +PROC oeffne (TEXT CONST dateiname, BOOL CONST auch aendern, + TASK CONST manager) : + + enable stop; + dateien loeschen (FALSE); + suchbedingung loeschen; + datei testen (dateiname); + aenderungserlaubnis := auch aendern; + status setzen; + datei eintragen (daten (anz dateien), dateiname, manager); + anfangsposition einnehmen; + felder anlegen . + +status setzen : + anz dateien := 1; + laufzaehler erhoehen; + markierungen := 0 . + +END PROC oeffne; + +PROC kopple (TEXT CONST dateiname) : + + kopple (dateiname, niltask) + +END PROC kopple; + +PROC kopple (TEXT CONST dateiname, TASK CONST manager) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + koppelfelder bestimmen; + platz in feldtabellen belegen; + in kette der koppeldateien einfuegen; + datei eintragen (daten (anz dateien), dateiname, manager); + koppelstatus setzen . + +koppelfelder bestimmen : + feldnamen lesen (eudas datei, namen); + INT VAR koppelfelder := 0; + INTVEC VAR koppelfeldnr := empty intvec; + WHILE koppelfelder < felderzahl (eudas datei) REP + feld lesen (namen, koppelfelder + 1, feldpuffer); + INT CONST index := feldindex (daten (1). feldnamen, feldpuffer); + IF index > 0 THEN + koppelfelder INCR 1; + koppelfeldnr CAT index + END IF + UNTIL index = 0 END REP . + +platz in feldtabellen belegen : + IF anz felder + felderzahl (eudas datei) - koppelfelder > maxfelder THEN + errorstop (zu viele felder) + ELIF koppeleintraege + koppelfelder > maxkoppeln THEN + errorstop (zu viele koppelfelder) + ELIF koppelfelder = 0 THEN + errorstop (keine koppelfelder) + END IF; + anz dateien INCR 1; + daten (anz dateien). feldnamen := namen; + daten (anz dateien). koppelfelder := koppelfeldnr; + daten (anz dateien). anz koppelfelder := koppelfelder; + INT VAR feldnr := koppelfelder; + WHILE feldnr < felderzahl (eudas datei) REP + anz felder INCR 1; feldnr INCR 1; + verweis (anz felder). datei := anz dateien; + verweis (anz felder). feld := feldnr + END REP; + FOR feldnr FROM 1 UPTO koppelfelder REP + koppelfeld eintragen + END REP . + +koppelfeld eintragen : + INT CONST koppelfeld := koppelfeldnr ISUB feldnr; + IF verweis (koppelfeld). datei = 0 THEN + neues koppelfeld eintragen + ELSE + alten eintrag erweitern + END IF . + +neues koppelfeld eintragen : + koppeleintraege INCR 1; + koppeln (koppeleintraege). datei := anz dateien; + koppeln (koppeleintraege). feld := feldnr; + verweis (koppelfeld). datei := koppeleintraege; + verweis (koppelfeld). feld := 1 . + +alten eintrag erweitern : + INT CONST eintragposition := + verweis (koppelfeld). datei + verweis (koppelfeld). feld; + folgende eintraege hochschieben; + verweis (koppelfeld). feld INCR 1; + koppeln (eintragposition). datei := anz dateien; + koppeln (eintragposition). feld := feldnr . + +folgende eintraege hochschieben : + INT VAR eintrag; + FOR eintrag FROM koppeleintraege DOWNTO eintragposition REP + koppeln (eintrag + 1) := koppeln (eintrag) + END REP; + koppeleintraege INCR 1; + FOR eintrag FROM 1 UPTO felderzahl der ersten datei REP + IF verweis (eintrag). datei >= eintragposition THEN + verweis (eintrag). datei INCR 1 + END IF + END REP . + +in kette der koppeldateien einfuegen : + anz koppeldateien INCR 1; + IF erste koppeldatei = 0 THEN + erste koppeldatei := anz dateien + ELSE + in dateikette (erste koppeldatei) + END IF . + +koppelstatus setzen : + laufzaehler erhoehen; + daten (anz dateien). gepuffert := FALSE; + daten (anz dateien). koppelfeld veraendert := FALSE; + daten (anz dateien). alte koppelposition := satznr (eudas datei); + koppeldatei aktualisieren (daten (anz dateien)) . + +END PROC kopple; + +PROC kette (TEXT CONST dateiname) : + + kette (dateiname, niltask) + +END PROC kette; + +PROC kette (TEXT CONST dateiname, TASK CONST manager) : + + enable stop; + IF anz dateien = 0 THEN + errorstop (keine datei geoeffnet) + END IF; + datei testen (dateiname); + anz dateien INCR 1; + datei eintragen (daten (anz dateien), dateiname, manager); + in dateikette (1); + IF ende der datei THEN auf satz (satznummer) END IF + +END PROC kette; + +PROC zugriff (PROC (EUDAT VAR) bearbeitung) : + + IF anz dateien > 1 OR umgeschaltet THEN + errorstop (kein zugriff bei ketten oder koppeln) + ELSE + aenderungen eintragen; + bearbeitung (daten (1). eudat); + laufzaehler erhoehen; + anfangsposition einnehmen; + felder anlegen; + daten (1). datei veraendert := TRUE + ENDIF + +END PROC zugriff; + +PROC sichere (INT CONST dateinummer, TEXT CONST dateiname) : + + aenderungen eintragen; + notizen aendern (daten (dateinummer). eudat, 2, date); + IF aenderungserlaubnis THEN + forget (dateiname, quiet); + copy (daten (dateinummer). ds, dateiname) + END IF; + daten (dateinummer). datei veraendert := FALSE + +END PROC sichere; + +PROC dateien loeschen (BOOL CONST auch geaenderte) : + + aenderungen eintragen; + IF umgeschaltet THEN auf koppeldatei (0) END IF; + kontrollvariablen loeschen; + dateien einzeln loeschen . + +kontrollvariablen loeschen : + anz koppeldateien := 0; + erste koppeldatei := 0; + daten (1). naechste datei := 0; + anz felder := 0; + ende der datei := TRUE . + +dateien einzeln loeschen : + WHILE anz dateien > 0 REP + IF wirklich veraendert AND NOT auch geaenderte THEN + errorstop (datei nicht gesichert); + LEAVE dateien loeschen + END IF; + forget (daten (anz dateien). ds); + anz dateien DECR 1 + END REP . + +wirklich veraendert : + aenderungserlaubnis AND daten (anz dateien). datei veraendert . + +END PROC dateien loeschen; + + +(*********************** Umschalten Koppeldatei **************************) + +INT VAR + save hauptdatei, + save felderzahl der ersten datei, + save anz felder, + save satznummer offset, + save kombination, + save markierungen, + save erste koppeldatei, + save naechste koppeldatei; + +BOOL VAR + save globales muster vorhanden; + +INTVEC VAR + save oder anfang; + +SATZ VAR + save muster gespeichert; + + +BOOL VAR + umgeschaltet := FALSE; + +INT VAR + anzahl hauptmuster := 0, + feldnamendatei := 1; + + +BOOL PROC auf koppeldatei : + + umgeschaltet + +END PROC auf koppeldatei; + +PROC auf koppeldatei (INT CONST nr) : + + disable stop; + laufzaehler erhoehen; + IF umgeschaltet THEN + alte variablen wiederherstellen; + umgeschaltet := FALSE; + ggf koppelfelder uebernehmen; + fuer korrekten zustand sorgen + ELSE + alte variablen sichern; + umgeschaltet := TRUE; + neuen zustand herstellen + END IF . + +alte variablen wiederherstellen : + hauptdatei := save hauptdatei; + felderzahl der ersten datei := save felderzahl der ersten datei; + anz felder := save anz felder; + satznummer offset := save satznummer offset; + markierungen := save markierungen; + erste koppeldatei := save erste koppeldatei; + daten (feldnamendatei). naechste datei := save naechste koppeldatei; + anzahl muster := anzahl hauptmuster; + globales muster vorhanden := save globales muster vorhanden; + oder anfang := save oder anfang; + muster gespeichert := save muster gespeichert; + IF anzahl muster > 0 THEN + erster musterindex := 1 + ELSE + erster musterindex := -1 + END IF . + +fuer korrekten zustand sorgen : + anzahl hauptmuster := 0; + feldnamendatei := 1; + enable stop; + auf satz (satznummer); + WHILE kombination <> save kombination REP + weiter (1) + END REP . + +ggf koppelfelder uebernehmen : + daten (feldnamendatei). alte koppelposition := + satznr (daten (feldnamendatei). eudat); + IF nr = 1 AND NOT dateiende (daten (hauptdatei). eudat) THEN + alle koppelfelder in hauptdatei uebernehmen + END IF . + +alle koppelfelder in hauptdatei uebernehmen : + INT VAR koppel nr; + FOR koppel nr FROM 1 UPTO daten (feldnamendatei). anz koppelfelder REP + feld aendern (daten (hauptdatei). eudat, feld nr koppelfeld, + feldinhalt koppelfeld) + END REP; + save kombination := 1 . + +feld nr koppelfeld : + daten (feldnamendatei). koppelfelder ISUB koppel nr . + +feldinhalt koppelfeld : + feld lesen (daten (feldnamendatei). eudat, koppel nr, feldpuffer); + feldpuffer . + +alte variablen sichern : + save hauptdatei := hauptdatei; + save felderzahl der ersten datei := felderzahl der ersten datei; + save anz felder := anz felder; + save satznummer offset := satznummer offset; + save kombination := kombination; + save markierungen := markierungen; + save erste koppeldatei := erste koppeldatei; + save naechste koppeldatei := daten (nr). naechste datei; + save globales muster vorhanden := globales muster vorhanden; + save oder anfang := oder anfang; + save muster gespeichert := muster gespeichert . + +neuen zustand herstellen : + hauptdatei := nr; + anzahl hauptmuster := anzahl muster; + feldnamendatei := nr; + felderzahl der ersten datei := felderzahl (daten (nr). eudat); + anz felder := felderzahl der ersten datei; + satznummer offset := 0; + markierungen := (length (daten (nr). marksaetze) - 1) DIV 2; + erste koppeldatei := 0; + daten (nr). naechste datei := 0; + suchbedingung loeschen; + auf satz (daten (nr). alte koppelposition) . + +END PROC auf koppeldatei; + + +(************************** Dateiabfragen ********************************) + +INT PROC anzahl koppeldateien : + + anz koppeldateien + +END PROC anzahl koppeldateien; + +INT PROC anzahl dateien : + + anz dateien + +END PROC anzahl dateien; + +BOOL PROC aendern erlaubt : + + aenderungserlaubnis + +END PROC aendern erlaubt; + +BOOL PROC inhalt veraendert (INT CONST dateinr) : + + aenderungen eintragen; + daten (dateinr). datei veraendert + +END PROC inhalt veraendert; + +TEXT PROC eudas dateiname (INT CONST dateinr) : + + daten (dateinr). name + +END PROC eudas dateiname; + +INT PROC folgedatei (INT CONST dateinr) : + + IF dateinr = 0 THEN + erste koppeldatei + ELSE + daten (dateinr). naechste datei + END IF + +END PROC folgedatei; + +TASK PROC herkunft (INT CONST dateinr) : + + daten (dateinr). ursprung + +END PROC herkunft; + + +(*************************** Dateiversion ********************************) + +(* Die Dateiversion wird bei jedem neuen 'oeffne' hochgezaehlt. Sie *) +(* dient dazu, ein neues 'oeffne' festzustellen, um eventuell als *) +(* Optimierung gespeicherte Daten als ungueltig zu kennzeichnen. *) + +INT PROC dateiversion : + + laufzaehler + +END PROC dateiversion; + + +(******************************* Felder **********************************) + +INT PROC anzahl felder : + + anz felder + +END PROC anzahl felder; + +PROC feldnamen lesen (INT CONST feldnr, TEXT VAR name) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (feldnamendatei). feldnamen, feldnr, name) + ELSE + feld lesen (dateiverweis, feldverweis, name) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen lesen; + +PROC feldnamen bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (feldnamendatei). feldnamen, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (dateiverweis, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +dateiverweis : + daten (verweis (feldnr). datei). feldnamen . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldnamen bearbeiten; + +INT PROC feldnummer (TEXT CONST feldname) : + + INT VAR + offset := felderzahl der ersten datei, + nr := feldindex (daten (feldnamendatei). feldnamen, feldname), + dateiindex := erste koppeldatei; + WHILE nr = 0 AND dateiindex <> 0 REP + nr := feldindex (daten (dateiindex). feldnamen, feldname); + offset oder nr erhoehen; + dateiindex := daten (dateiindex). naechste datei + END REP; + nr . + +offset oder nr erhoehen : + INT CONST zahl der koppelfelder := daten (dateiindex). anz koppelfelder; + IF nr = 0 THEN + offset INCR felderzahl (daten (dateiindex). eudat); + offset DECR zahl der koppelfelder + ELSE + nr INCR offset; + nr DECR zahl der koppelfelder + END IF . + +END PROC feldnummer; + +INT PROC feldinfo (INT CONST feldnr) : + + IF feldnr <= felderzahl der ersten datei THEN + feldinfo (daten (feldnamendatei). eudat, feldnr) + ELSE + feldinfo (daten (dateiverweis). eudat, feldverweis) + END IF . + +dateiverweis : + verweis (feldnr). datei . + +feldverweis : + verweis (feldnr). feld . + +END PROC feldinfo; + +PROC notizen lesen (INT CONST nr, TEXT VAR inhalt) : + + notizen lesen (daten (feldnamendatei). eudat, nr, inhalt) + +END PROC notizen lesen; + +PROC notizen aendern (INT CONST nr, TEXT CONST inhalt) : + + notizen aendern (daten (feldnamendatei). eudat, nr, inhalt); + daten (feldnamendatei). datei veraendert := TRUE + +END PROC notizen aendern; + + +(*************************** Feldzugriffe ********************************) + +PROC feld lesen (INT CONST feldnr, TEXT VAR inhalt) : + + IF feldnr <= felderzahl der ersten datei THEN + feld lesen (daten (hauptdatei). eudat, feldnr, inhalt) + ELSE + in koppeldatei lesen + END IF . + +in koppeldatei lesen : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + ELSE + feld lesen (daten (dateiverweis). eudat, feldverweis, inhalt) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld lesen; + +PROC feld bearbeiten (INT CONST feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) : + + IF feldnr <= felderzahl der ersten datei THEN + feld bearbeiten (daten (hauptdatei). eudat, feldnr, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + in koppeldatei bearbeiten + END IF . + +in koppeldatei bearbeiten : + INT CONST dateiverweis := verweis (feldnr). datei; + IF daten (dateiverweis). gepuffert THEN + feld bearbeiten (daten (dateiverweis). satzpuffer, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + ELSE + feld bearbeiten (daten (dateiverweis). eudat, feldverweis, + PROC (TEXT CONST, INT CONST, INT CONST) bearbeite) + END IF . + +feldverweis : + verweis (feldnr). feld . + +END PROC feld bearbeiten; + +PROC feld aendern (INT CONST feldnr, TEXT CONST inhalt) : + + INT CONST dateiverweis := verweis (feldnr). datei; + IF feldnr <= felderzahl der ersten datei THEN + in hauptdatei aendern + ELSE + in koppeldatei aendern + END IF . + +in hauptdatei aendern : + daten (hauptdatei). datei veraendert := TRUE; + IF ist koppelfeld CAND wirklich veraenderung THEN + weitere dateien aktualisieren + END IF; + feld aendern (daten (hauptdatei). eudat, feldnr, inhalt) . + +ist koppelfeld : + NOT umgeschaltet CAND dateiverweis > 0 . + +wirklich veraenderung : + feld lesen (daten (hauptdatei). eudat, feldnr, feldpuffer); + feldpuffer <> inhalt . + +weitere dateien aktualisieren : + INT VAR + koppelzaehler := feldverweis, + koppelverweis := dateiverweis; + REP + satzpuffer aktualisieren (daten (koppeldatei)); + daten (koppeldatei). koppelfeld veraendert := TRUE; + feld aendern (daten (koppeldatei). satzpuffer, koppelfeld, inhalt); + koppelverweis INCR 1; + koppelzaehler DECR 1 + UNTIL koppelzaehler = 0 END REP . + +in koppeldatei aendern : + satzpuffer aktualisieren (daten (dateiverweis)); + IF koppeldatei wirklich veraendert THEN + daten (dateiverweis). veraendert := TRUE; + feld aendern (daten (dateiverweis). satzpuffer, feldverweis, inhalt) + END IF . + +koppeldatei wirklich veraendert : + feld lesen (daten (dateiverweis). satzpuffer, feldverweis, feldpuffer); + feldpuffer <> inhalt . + +feldverweis : + verweis (feldnr). feld . + +koppeldatei : + koppeln (koppelverweis). datei . + +koppelfeld : + koppeln (koppelverweis). feld . + +END PROC feld aendern; + +PROC satzpuffer aktualisieren (DATEI VAR datei) : + + IF NOT datei. gepuffert THEN + datei. gepuffert := TRUE; + satzpuffer lesen + END IF . + +satzpuffer lesen : + IF dateiende (datei. eudat) THEN + satz initialisieren (datei. satzpuffer, datei. anz koppelfelder); + koppelfelder in satzpuffer schreiben + ELSE + satz lesen (datei. eudat, datei. satzpuffer) + END IF . + +koppelfelder in satzpuffer schreiben : + INT VAR i; + FOR i FROM 1 UPTO datei. anz koppelfelder REP + feld lesen (datei. koppelfelder ISUB i, feldpuffer); + feld aendern (datei. satzpuffer, i, feldpuffer) + END REP . + +END PROC satzpuffer aktualisieren; + +PROC koppeldatei aktualisieren (DATEI VAR datei) : + + muster lesen; + koppeldatei positionieren . + +muster lesen : + feld lesen (daten (hauptdatei). eudat, musterfeld, muster) . + +musterfeld : + datei. koppelfelder ISUB 1 . + +muster : + datei. muster . + +koppeldatei positionieren : + auf satz (datei. eudat, muster); + WHILE NOT koppelfelder gleich (datei) REP + weiter (datei. eudat, muster) + END REP; + IF dateiende (datei. eudat) THEN + satzpuffer aktualisieren (datei) + ELSE + datei. gepuffert := FALSE + END IF . + +END PROC koppeldatei aktualisieren; + +PROC koppeldateien aktualisieren : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei aktualisieren (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + END REP; + kombination := 1 + +END PROC koppeldateien aktualisieren; + +BOOL PROC koppelfelder gleich (DATEI CONST datei) : + + IF NOT dateiende (datei. eudat) THEN + koppelfelder vergleichen + END IF; + TRUE . + +koppelfelder vergleichen : + INT VAR koppelindex; + FOR koppelindex FROM 2 UPTO datei. anz koppelfelder REP + feld lesen (daten (hauptdatei). eudat, koppelfelder ISUB koppelindex, + feldpuffer); + feld bearbeiten (datei. eudat, koppelindex, + PROC (TEXT CONST, INT CONST, INT CONST) feld vergleichen); + IF NOT vergleich erfolgreich THEN + LEAVE koppelfelder gleich WITH FALSE + END IF + END REP . + +koppelfelder : + datei. koppelfelder . + +END PROC koppelfelder gleich; + +BOOL VAR vergleich erfolgreich; + +PROC feld vergleichen (TEXT CONST satz, INT CONST anfang, ende) : + + vergleich erfolgreich := length (feldpuffer) + anfang = ende + 1 CAND + pos (satz, feldpuffer, anfang, ende + 1) = anfang + +END PROC feld vergleichen; + + +(**************************** Anhalten ***********************************) + +LET + halt error = 22101, + halt zeichen = "h", + esc = ""27""; + +BOOL VAR esc zustand; + + +PROC halt abfrage starten : + + TEXT VAR z; + esc zustand := FALSE; + REP + z := incharety; type (z) + UNTIL z = niltext END REP + +END PROC halt abfrage starten; + +PROC halt abfrage beenden : + + IF esc zustand THEN + type (esc) + END IF + +END PROC halt abfrage beenden; + +BOOL PROC angehalten : + + TEXT VAR z; + REP + z := incharety; + IF z = niltext THEN + LEAVE angehalten WITH FALSE + ELSE + zeichen behandeln + END IF + END REP; + FALSE . + +zeichen behandeln : + IF esc zustand THEN + esc zustand := FALSE; + auf halt zeichen testen + ELSE + auf esc testen + END IF . + +auf halt zeichen testen : + IF z = halt zeichen THEN + tastenpuffer loeschen; + errorstop (halt error, niltext); + LEAVE angehalten WITH TRUE + ELSE + type (esc); type (z) + END IF . + +auf esc testen : + IF z = esc THEN + esc zustand := TRUE + ELSE + type (z) + END IF . + +tastenpuffer loeschen : + REP UNTIL getcharety = niltext END REP . + +END PROC angehalten; + + +(************************** Positionieren ********************************) + +PROC weiter (INT CONST modus) : + + IF NOT ende der datei THEN + aenderungen eintragen; + nach modus weiter gehen + END IF . + +nach modus weitergehen : + SELECT modus OF + CASE 1 : einen satz weiter + CASE 2 : weiter bis ausgewaehlt + CASE 3 : weiter bis markiert + END SELECT . + +einen satz weiter : + weiter gehen (FALSE) . + +weiter bis ausgewaehlt : + halt abfrage starten; + REP + weiter gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR ende der datei OR angehalten END REP; + halt abfrage beenden . + +weiter bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND naechste datei <> 0 REP + eine datei weiter; + satzpos := 1 + END REP; + auf satz (daten (hauptdatei). eudat, naechster markierter satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +kein markierter satz mehr : + mark stelle (daten (hauptdatei), satzpos + 1); + INT CONST naechster markierter satz := + daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger; + naechster markierter satz = maxint . + +naechste datei : + daten (hauptdatei). naechste datei . + +END PROC weiter; + +PROC zurueck (INT CONST modus) : + + IF satznummer > 1 THEN + aenderungen eintragen; + nach modus zurueckgehen + END IF . + +nach modus zurueckgehen : + SELECT modus OF + CASE 1 : einen satz zurueck + CASE 2 : zurueck bis ausgewaehlt + CASE 3 : zurueck bis markiert + END SELECT . + +einen satz zurueck : + zurueck gehen (FALSE) . + +zurueck bis ausgewaehlt : + halt abfrage starten; + REP + zurueck gehen (globales muster vorhanden); + cout (satznummer) + UNTIL satz ausgewaehlt OR satznummer = 1 OR angehalten END REP; + halt abfrage beenden . + +zurueck bis markiert : + INT VAR satzpos := satznr (daten (hauptdatei). eudat); + WHILE kein markierter satz mehr AND hauptdatei <> 1 REP + eine datei zurueck; + satzpos := maxint - 1 + END REP; + auf satz (daten (hauptdatei). eudat, neuer satz); + cout (satznummer); + koppeldateien aktualisieren; + ende der datei := FALSE; + suchbedingung auswerten . + +kein markierter satz mehr : + INT VAR neuer satz; + mark stelle (daten (hauptdatei), satzpos); + IF daten (hauptdatei). markzeiger = 1 THEN + neuer satz := 1; + TRUE + ELSE + neuer satz := daten (hauptdatei). marksaetze ISUB + (daten (hauptdatei). markzeiger - 1); + FALSE + END IF . + +END PROC zurueck; + +PROC weiter gehen (BOOL CONST muster vorgegeben) : + + neue kombination suchen; + IF keine kombination mehr THEN + einen satz weiter; + koppeldateien aktualisieren + ELSE + kombination INCR 1 + END IF; + suchbedingung auswerten . + +neue kombination suchen : + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex > 0 REP + in koppeldatei weitergehen; + dateiindex := daten (dateiindex). naechste datei + END REP . + +in koppeldatei weitergehen : + BOOL VAR match gefunden; + kombination suchen (daten (dateiindex), match gefunden); + IF match gefunden THEN + LEAVE neue kombination suchen + END IF . + +keine kombination mehr : + dateiindex = 0 . + +einen satz weiter : + IF muster vorgegeben THEN + weiter (daten (hauptdatei). eudat, globales muster) + ELSE + weiter (daten (hauptdatei). eudat) + END IF; + WHILE dateiende (daten (hauptdatei). eudat) REP + auf naechste datei + UNTIL ende der datei END REP . + +auf naechste datei : + IF daten (hauptdatei). naechste datei <> 0 THEN + eine datei weiter; + auf ersten satz der naechsten datei + ELSE + ende der datei := TRUE + END IF . + +auf ersten satz der naechsten datei : + auf satz (daten (hauptdatei). eudat, 1) . + +END PROC weiter gehen; + +PROC kombination suchen (DATEI VAR datei, BOOL VAR match gefunden) : + + IF dateiende (datei. eudat) THEN + match gefunden := FALSE + ELSE + in datei weitergehen + END IF . + +in datei weitergehen : + match gefunden := TRUE; + REP + weiter (datei. eudat, datei. muster); + IF dateiende (datei. eudat) THEN + match gefunden := FALSE; + auf satz (datei. eudat, datei. muster) + END IF + UNTIL koppelfelder gleich (datei) END REP . + +END PROC kombination suchen; + +PROC zurueck gehen (BOOL CONST muster vorgegeben) : + + WHILE satznr (daten (hauptdatei). eudat) = 1 CAND satznummer > 1 REP + eine datei zurueck; + auf dateiende (daten (hauptdatei). eudat) + END REP; + IF muster vorgegeben THEN + zurueck (daten (hauptdatei). eudat, globales muster) + ELSE + zurueck (daten (hauptdatei). eudat) + END IF; + ende der datei := FALSE; + koppeldateien aktualisieren; + suchbedingung auswerten + +END PROC zurueck gehen; + +PROC eine datei weiter : + + satznummer offset INCR saetze (daten (hauptdatei). eudat); + hauptdatei := daten (hauptdatei). naechste datei + +END PROC eine datei weiter; + +PROC eine datei zurueck : + + INT VAR neuer index := 1; + WHILE daten (neuer index). naechste datei <> hauptdatei REP + neuer index := daten (neuer index). naechste datei + END REP; + satznummer offset DECR saetze (daten (neuer index). eudat); + hauptdatei := neuer index + +END PROC eine datei zurueck; + +PROC aenderungen eintragen : + + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + koppeldatei betrachten; + dateiindex := daten (dateiindex). naechste datei + END REP . + +koppeldatei betrachten : + IF daten (dateiindex). gepuffert THEN + datei aktualisieren (daten (dateiindex)) + END IF . + +END PROC aenderungen eintragen; + +PROC datei aktualisieren (DATEI VAR datei) : + + IF alter satz geaendert AND NOT koppelfelder veraendert THEN + satz in koppeldatei aendern + ELIF nicht nur koppelfelder belegt AND irgendwas veraendert THEN + neuen satz in koppeldatei einfuegen + ELIF koppelfelder veraendert THEN + koppeldatei aktualisieren (datei) + END IF; + puffer deaktivieren; + veraendert := FALSE; + koppelfelder veraendert := FALSE . + +alter satz geaendert : + NOT dateiende (datei. eudat) AND veraendert . + +nicht nur koppelfelder belegt : + felderzahl (satzpuffer) > datei. anz koppelfelder . + +irgendwas veraendert : + koppelfelder veraendert OR veraendert . + +neuen satz in koppeldatei einfuegen : + datei veraendert := TRUE; + feld lesen (satzpuffer, 1, datei. muster); + satz einfuegen (datei. eudat, satzpuffer) . + +puffer deaktivieren : + datei. gepuffert := FALSE . + +satz in koppeldatei aendern : + datei veraendert := TRUE; + satz aendern (datei. eudat, satzpuffer) . + +veraendert : + datei. veraendert . + +koppelfelder veraendert : + datei. koppelfeld veraendert . + +satzpuffer : + datei. satzpuffer . + +datei veraendert : + datei. datei veraendert . + +END PROC datei aktualisieren; + +PROC auf dateiende (EUDAT VAR eudat) : + + auf satz (eudat, saetze (eudat) + 1) + +END PROC auf dateiende; + +PROC auf satz (INT CONST satznr) : + + aenderungen eintragen; + hauptdatei := feldnamendatei; + satznummer offset := 0; + WHILE ueber datei hinaus AND noch weitere datei REP + eine datei weiter + END REP; + auf satz (daten (hauptdatei). eudat, satznr - satznummer offset); + koppeldateien aktualisieren; + ende der datei := dateiende (daten (hauptdatei). eudat); + suchbedingung auswerten . + +ueber datei hinaus : + satznr - satznummer offset > saetze (daten (hauptdatei). eudat) . + +noch weitere datei : + daten (hauptdatei). naechste datei <> 0 . + +END PROC auf satz; + +PROC auf satz (TEXT CONST schluesseltext) : + + aenderungen eintragen; + auf satz intern (schluesseltext, ende der datei); + koppeldateien aktualisieren; + suchbedingung auswerten + +END PROC auf satz; + +PROC auf satz intern (TEXT CONST schluesseltext, BOOL CONST am ende) : + + IF am ende THEN auf satz (1) END IF; + REP + auf satz (daten (hauptdatei). eudat, schluesseltext); + IF NOT dateiende (daten (hauptdatei). eudat) THEN + ende der datei := FALSE; + LEAVE auf satz intern + ELIF daten (hauptdatei). naechste datei = 0 THEN + ende der datei := TRUE; + IF NOT am ende THEN auf satz intern (schluesseltext, TRUE) END IF; + LEAVE auf satz intern + END IF; + eine datei weiter + END REP + +END PROC auf satz intern; + +INT PROC satznummer : + + satznummer offset + satznr (daten (hauptdatei). eudat) + +END PROC satznummer; + +INT PROC satzkombination : + + kombination + +END PROC satzkombination; + +BOOL PROC dateiende : + + ende der datei + +END PROC dateiende; + + +(*************************** Satzverwaltung ******************************) + +SATZ VAR leersatz; +satz initialisieren (leersatz); + +PROC satz einfuegen : + + aenderungen eintragen; + mark satz einfuegen; + satz einfuegen (daten (hauptdatei). eudat, leersatz); + daten (hauptdatei). datei veraendert := TRUE; + alle koppeldateien ans ende; + ende der datei := FALSE; + suchbedingung auswerten . + +mark satz einfuegen : + mark stelle (daten (hauptdatei), satznr (daten (hauptdatei). eudat)); + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, 1) . + +alle koppeldateien ans ende : + kombination := 1; + INT VAR dateiindex := erste koppeldatei; + WHILE dateiindex <> 0 REP + auf dateiende (daten (dateiindex). eudat); + dateiindex := daten (dateiindex). naechste datei + END REP . + +END PROC satz einfuegen; + +PROC satz loeschen : + + IF NOT ende der datei THEN + aenderungen eintragen; + mark satz loeschen; + satz loeschen (daten (hauptdatei). eudat); + daten (hauptdatei). datei veraendert := TRUE; + auf satz (satznummer) + END IF . + +mark satz loeschen : + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + END IF; + inkrement (daten (hauptdatei). marksaetze, + daten (hauptdatei). markzeiger, -1) . + +END PROC satz loeschen; + + +(*************************** Suchmuster **********************************) + +LET + maxmuster = 100; + +ROW maxmuster STRUCT (INT feld, relator, true exit, false exit, + TEXT muster) + VAR bedingung; + +SATZ VAR muster gespeichert; + +INT VAR + anzahl muster, + erster musterindex, + versionszaehler := 1; + +BOOL VAR + bereits ausgewertet, + erfuellt; + +suchbedingung loeschen; + +INT VAR + muster index; + +LET + gleich test = 1, + beginn test = 2, + endet test = 3, + enthalten test = 4, + kleiner test = 5, + groesser test = 6, + nicht leer test = 7, + markiert test = 8, + true test = 9; + + +PROC suchbedingung auswerten : + + IF ende der datei THEN + erfuellt := FALSE + ELSE + kette verfolgen; + erfuellt := in true exit + END IF . + +kette verfolgen : + musterindex := erster musterindex; + WHILE muster index > 0 REP + gegenfeld bearbeiten; + feld bearbeiten (suchfeld, + PROC (TEXT CONST, INT CONST, INT CONST) bedingung ueberpruefen) + END REP . + +gegenfeld bearbeiten : + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + gegenfeld lesen; + bei datum umdrehen + END IF . + +gegenfeld lesen : + feld lesen ((verwendeter relator AND 255) + 1, feldpuffer) . + +bei datum umdrehen : + IF jeweiliges feldinfo = 2 THEN + feldpuffer drehen + END IF; + bedingung (musterindex). muster := feldpuffer . + +suchfeld : + bedingung (musterindex). feld . + +in true exit : + musterindex < 0 . + +END PROC suchbedingung auswerten; + +PROC bedingung ueberpruefen (TEXT CONST satz, INT CONST von, bis) : + + INT VAR verwendeter relator := bedingung (musterindex). relator; + IF verwendeter relator >= 256 THEN + verwendeter relator := verwendeter relator DIV 256 + END IF; + IF bedingung trifft zu THEN + musterindex := bedingung (musterindex). true exit + ELSE + musterindex := bedingung (musterindex). false exit + END IF . + +bedingung trifft zu : + SELECT verwendeter relator OF + CASE gleich test : ist gleich + CASE beginn test : beginnt mit + CASE endet test : endet mit + CASE enthalten test : ist enthalten + CASE kleiner test : ist kleiner + CASE groesser test : ist groesser + CASE nicht leer test : ist nicht leer + CASE markiert test : ist markiert + CASE true test : ist true + OTHERWISE FALSE + END SELECT . + +ist gleich : + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer als subtext; feldpuffer LEXEQUAL muster + CASE 1 : feldpuffer als subtext; feldwert = musterwert + OTHERWISE length (muster) = bis - von + 1 AND text gleich + END SELECT . + +text gleich : + von > bis COR beginnt mit . + +beginnt mit : + pos (satz, muster, von, bis) = von . + +endet mit : + pos (satz, muster, bis + 1 - length (muster), bis) > 0 . + +ist enthalten : + pos (satz, muster, von, bis) > 0 . + +ist kleiner : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : muster LEXGREATER feldpuffer + CASE 1 : feldwert < musterwert + CASE 2 : feldpuffer drehen; feldpuffer < muster + OTHERWISE feldpuffer < muster + END SELECT . + +ist groesser : + feldpuffer als subtext; + SELECT jeweiliges feldinfo OF + CASE 0 : feldpuffer LEXGREATEREQUAL muster + CASE 1 : feldwert >= musterwert + CASE 2 : feldpuffer drehen; feldpuffer >= muster + OTHERWISE feldpuffer >= muster + END SELECT . + +ist nicht leer : + von <= bis . + +ist markiert : + satz markiert . + +ist true : + TRUE . + +feldpuffer als subtext : + feldpuffer := subtext (satz, von, bis) . + +END PROC bedingung ueberpruefen; + +TEXT PROC muster : + + bedingung (musterindex). muster + +END PROC muster; + +PROC feldpuffer drehen : + + IF length (feldpuffer) = 8 THEN + TEXT CONST jahr := subtext (feldpuffer, 7, 8); + replace (feldpuffer, 7, subtext (feldpuffer, 1, 2)); + replace (feldpuffer, 1, jahr) + ELSE + feldpuffer := niltext + END IF + +END PROC feldpuffer drehen; + +INT PROC jeweiliges feldinfo : + feldinfo (bedingung (musterindex). feld) +END PROC jeweiliges feldinfo; + +REAL PROC feldwert : + + REAL VAR r; + wert berechnen (feldpuffer, r); + r + +END PROC feldwert; + +REAL PROC musterwert : + + REAL VAR r; + wert berechnen (muster, r); + r + +END PROC musterwert; + + +LET + grosses oder = ";", + kleines oder = ",", + intervall symbol = "..", + markierungssymbol = "++", + negation = "--", + stern = "*"; + +BOOL VAR + neue alternative, + neue disjunktion, + verneinung; + +INT VAR + erstes feldmuster, + oder index, + naechster oder anfang, + anfang der disjunktion, + bearbeitetes feld; + +INTVEC VAR oder anfang; + + +PROC suchbedingung (INT CONST feldnr, TEXT CONST bedingung) : + + INT VAR + anfang := 1, + semi pos := 0; + INT CONST + bedingung ende := length (bedingung) + 1; + oder index := 0; + bearbeitetes feld := feldnr; + erstes feldmuster := anzahl muster + 1; + WHILE anfang < bedingung ende REP + feldende feststellen; + bedingung eintragen; + anfang := ende + 2 + END REP; + feld aendern (muster gespeichert, feldnr, bedingung) . + +feldende feststellen : + INT VAR + oder pos := pos (bedingung, kleines oder, anfang); + IF oder pos = 0 THEN oder pos := bedingung ende END IF; + IF semi pos < anfang THEN + neue alternative beginnen + END IF; + INT CONST ende := min (oder pos, semi pos) - 1 . + +neue alternative beginnen : + oder index INCR 1; + neue alternative := TRUE; + IF oder index > 1 THEN globales muster vorhanden := FALSE END IF; + semi pos := pos (bedingung, grosses oder, anfang); + IF semi pos = 0 THEN semi pos := bedingung ende END IF . + +bedingung eintragen : + verneinung testen; + neue disjunktion := TRUE; + INT CONST + intervall pos := pos (bedingung, intervall symbol, anfang, ende + 1); + IF leere bedingung THEN + eintragen (niltext, true test, - oder index) + ELIF intervall pos = 0 THEN + textvergleich + ELSE + groessenvergleich + END IF . + +verneinung testen : + IF subtext (bedingung, anfang, anfang + 1) = negation THEN + anfang INCR 2; verneinung := TRUE + ELSE + verneinung := FALSE + END IF . + +leere bedingung : + anfang > ende . + +text vergleich : + IF test auf markierung THEN + test auf markierung eintragen + ELSE + sterne suchen + END IF . + +test auf markierung : + anfang + 1 = ende CAND + subtext (bedingung, anfang, ende) = markierungssymbol . + +test auf markierung eintragen : + eintragen (niltext, markiert test, - oder index) . + +sterne suchen : + INT VAR stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + teste ob feld gleich + ELIF anfang = ende THEN + test auf nichtleeres feld + ELSE + relator bestimmen; + REP + teste auf enthalten sein + END REP + END IF . + +teste ob feld gleich : + IF globales muster moeglich THEN + globales muster vorhanden := TRUE; + globales muster := bedingung + END IF; + eintragen (subtext (bedingung, anfang, ende), gleich test, - oder index) . + +globales muster moeglich : + feldnr = 1 AND anfang = 1 AND ende = bedingung ende - 1 AND + noch keine globalen alternativen AND NOT umgeschaltet AND + (bedingung SUB 1) <> "&" . + +noch keine globalen alternativen : + length (oder anfang) <= 2 . + +test auf nichtleeres feld : + eintragen (niltext, nichtleer test, - oder index) . + +relator bestimmen : + INT VAR relator; + IF stern pos = anfang THEN + relator := gleich test + ELSE + relator := beginn test + END IF . + +teste auf enthalten sein : + IF relator <> gleich test THEN + teilmuster eintragen + END IF; + anfang := stern pos + 1; + stern pos := pos (bedingung, stern, anfang, ende + 1); + IF stern pos = 0 THEN + stern pos := ende + 1; + relator := endet test + ELSE + relator := enthalten test + END IF . + +teilmuster eintragen : + TEXT CONST muster := subtext (bedingung, anfang, stern pos - 1); + IF verneinung OR letztes feld THEN + IF verneinung THEN neue disjunktion := TRUE END IF; + eintragen (muster, relator, - oder index); + IF letztes feld THEN LEAVE sterne suchen END IF + ELSE + eintragen (muster, relator, anzahl muster + 2) + END IF . + +letztes feld : + stern pos >= ende . + +groessenvergleich : + TEXT CONST + muster 1 := subtext (bedingung, anfang, intervall pos - 1), + muster 2 := subtext (bedingung, intervall pos + 2, ende); + IF intervall pos = anfang THEN + eintragen (muster 2, kleiner test, - oder index) + ELIF intervall pos = ende - 1 THEN + eintragen (muster 1, groesser test, - oder index) + ELSE + intervall eintragen + END IF . + +intervall eintragen : + IF verneinung THEN + eintragen (muster 1, groesser test, - oder index); + neue disjunktion := TRUE + ELSE + eintragen (muster 1, groesser test, anzahl muster + 2) + END IF; + eintragen (muster 2, kleiner test, - oder index) . + +END PROC suchbedingung; + +PROC eintragen (TEXT CONST textmuster, INT CONST relator, true exit) : + + musterstatus verwalten; + musterplatz belegen; + IF neue alternative THEN + alte false exits auf neuen anfang setzen; + alte true exits auf diesen platz setzen; + anfang der disjunktion := anzahl muster + ELIF neue disjunktion THEN + false exits der letzten disjunktion anketten + END IF; + vergleichsdaten eintragen; + textmuster eintragen . + +musterstatus verwalten : + bereits ausgewertet := FALSE; + IF anzahl muster = anzahl hauptmuster THEN + versionszaehler INCR 1; + IF versionszaehler > 32000 THEN versionszaehler := 1 END IF + END IF . + +musterplatz belegen : + IF anzahl muster = maxmuster THEN + suchbedingung loeschen; + errorstop (suchmuster zu umfangreich) + ELSE + anzahl muster INCR 1; + erster musterindex := anzahl hauptmuster + 1 + END IF . + +alte false exits auf neuen anfang setzen : + IF oder index > length (oder anfang) DIV 2 THEN + oder anfang CAT anzahl muster; + setze verkettung (erster musterindex, 0, anzahl muster) + END IF; + IF oder index = length (oder anfang) DIV 2 THEN + naechster oder anfang := 0 + ELSE + naechster oder anfang := oder anfang ISUB (oder index + 1) + END IF . + +alte true exits auf diesen platz setzen : + setze verkettung (erster musterindex, - oder index, anzahl muster); + neue alternative := FALSE; + neue disjunktion := FALSE . + +false exits der letzten disjunktion anketten : + setze verkettung (anfang der disjunktion, naechster oder anfang, + anzahl muster); + anfang der disjunktion := anzahl muster; + neue disjunktion := FALSE . + +vergleichsdaten eintragen : + bedingung (anzahl muster). relator := relator; + bedingung (anzahl muster). feld := bearbeitetes feld; + IF verneinung THEN + bedingung (anzahl muster). true exit := naechster oder anfang; + bedingung (anzahl muster). false exit := true exit + ELSE + bedingung (anzahl muster). true exit := true exit; + bedingung (anzahl muster). false exit := naechster oder anfang + END IF . + +textmuster eintragen : + IF textmuster ist gegenfeld THEN + feldnummer des gegenfelds eintragen + ELSE + textmuster original eintragen + END IF . + +textmuster ist gegenfeld : + (textmuster SUB 1) = "&" CAND gueltiges feld . + +gueltiges feld : + INT CONST nr gegenfeld := feldnummer (subtext (textmuster, 2)); + nr gegenfeld > 0 . + +feldnummer des gegenfelds eintragen : + bedingung (anzahl muster). relator := nr gegenfeld - 1 + 256 * relator . + +textmuster original eintragen : + INT CONST info := feldinfo (bearbeitetes feld); + IF info = 2 AND (relator = kleiner test OR relator = groesser test) THEN + feldpuffer := textmuster; + feldpuffer drehen; + bedingung (anzahl muster). muster := feldpuffer + ELSE + bedingung (anzahl muster). muster := textmuster + END IF . + +END PROC eintragen; + +PROC setze verkettung (INT CONST von, wert, durch) : + + INT VAR i; + FOR i FROM von UPTO anzahl muster - 1 REP + IF bedingung (i). true exit = wert THEN + bedingung (i). true exit := durch + ELIF bedingung (i). false exit = wert THEN + bedingung (i). false exit := durch + END IF + END REP + +END PROC setze verkettung; + +PROC suchbedingung lesen (INT CONST feldnr, TEXT VAR bedingung) : + + feld lesen (muster gespeichert, feldnr, bedingung) + +END PROC suchbedingung lesen; + +PROC suchbedingung loeschen : + + disable stop; + IF umgeschaltet THEN + anzahl muster := anzahl hauptmuster + ELSE + anzahl hauptmuster := 0; + anzahl muster := 0 + END IF; + erster musterindex := -1; + oder anfang := empty intvec; + satz initialisieren (muster gespeichert); + globales muster vorhanden := FALSE; + bereits ausgewertet := TRUE; + erfuellt := NOT ende der datei + +END PROC suchbedingung loeschen; + +BOOL PROC satz ausgewaehlt : + + IF NOT bereits ausgewertet THEN + suchbedingung auswerten; + bereits ausgewertet := TRUE + END IF; + erfuellt + +END PROC satz ausgewaehlt; + +INT PROC suchversion : + + IF anzahl muster = anzahl hauptmuster THEN + 0 + ELSE + versionszaehler + END IF + +END PROC suchversion; + + +(*************************** Markierung **********************************) + +PROC mark stelle (DATEI VAR datei, INT CONST satz) : + + IF (datei. marksaetze ISUB datei. markzeiger) < satz THEN + vorwaerts gehen + ELSE + rueckwaerts gehen + END IF . + +vorwaerts gehen : + REP + datei. markzeiger INCR 1 + UNTIL (datei. marksaetze ISUB datei. markzeiger) >= satz END REP . + +rueckwaerts gehen : + WHILE datei. markzeiger > 1 CAND + (datei. marksaetze ISUB (datei. markzeiger - 1)) >= satz REP + datei. markzeiger DECR 1 + END REP . + +END PROC mark stelle; + +PROC markierung aendern : + + disable stop; + IF satz markiert THEN + delete (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger); + markierungen DECR 1 + ELSE + insert (daten (hauptdatei). marksaetze, daten (hauptdatei). markzeiger, + satznr (daten (hauptdatei). eudat)); + markierungen INCR 1 + END IF + +END PROC markierung aendern; + +BOOL PROC satz markiert : + + INT CONST satz := satznr (daten (hauptdatei). eudat); + mark stelle (daten (hauptdatei), satz); + satz = + (daten (hauptdatei). marksaetze ISUB daten (hauptdatei). markzeiger) + +END PROC satz markiert; + +INT PROC markierte saetze : + + markierungen + +END PROC markierte saetze; + +PROC markierungen loeschen : + + disable stop; + IF umgeschaltet THEN + mark loeschen (daten (hauptdatei)) + ELSE + in allen geketteten dateien loeschen + END IF; + markierungen := 0 . + +in allen geketteten dateien loeschen : + INT VAR dateiindex := 1; + REP + mark loeschen (daten (dateiindex)); + dateiindex := daten (dateiindex). naechste datei + UNTIL dateiindex = 0 END REP . + +END PROC markierungen loeschen; + +PROC mark loeschen (DATEI VAR datei) : + + datei. marksaetze := niltext; + datei. marksaetze CAT maxint; + datei. markzeiger := 1 + +END PROC mark loeschen; + + +END PACKET datenverwaltung; + diff --git a/app/eudas/5.3/src/isub.replace b/app/eudas/5.3/src/isub.replace new file mode 100644 index 0000000..3c48009 --- /dev/null +++ b/app/eudas/5.3/src/isub.replace @@ -0,0 +1,19 @@ +PACKET isub replace DEFINES ISUB, replace : + +INT OP ISUB (TEXT CONST t, INT CONST i) : + + INT CONST ii := i + i; + code (t SUB ii - 1) + 256 * code (t SUB ii) + +END OP ISUB; + +PROC replace (TEXT VAR t, INT CONST i, wert) : + + INT CONST ii := i + i; + replace (t, ii - 1, code (wert MOD 256)); + replace (t, ii, code (wert DIV 256 MOD 256)) + +END PROC replace + +END PACKET isub replace; + diff --git a/app/eudas/5.3/src/menues.1 b/app/eudas/5.3/src/menues.1 new file mode 100644 index 0000000..58b0769 --- /dev/null +++ b/app/eudas/5.3/src/menues.1 @@ -0,0 +1,75 @@ +PACKETeudassatzzugriffeDEFINES SATZ,:=,satzinitialisieren,felderzahl,feldlesen,feldbearbeiten,feldaendern,feldindex:LETb0=256,c0=2;LETd0=" ",e0="";LETf0= +#101#" ist keine Feldnummer"; +TEXT VARg0:=c0*d0;TYPE SATZ=TEXT;OP:=(SATZ VARh0,SATZ CONSTi0):CONCR(h0):=CONCR(i0)END OP:=;PROCsatzinitialisieren(SATZ VARj0):satzinitialisieren(j0,0)END PROCsatzinitialisieren;PROCsatzinitialisieren(SATZ VARj0,INT CONSTk0):replace(g0,1,2*k0+3);INT VARl0;CONCR(j0):=e0;FORl0FROM1UPTOk0+1REP CONCR(j0)CATg0END REP END PROCsatzinitialisieren;INT PROCfelderzahl(SATZ CONSTj0):INT VARm0:=(CONCR(j0)ISUB1)DIV2;INT CONSTn0:=CONCR(j0)ISUBm0;REPm0DECR1UNTILm0<=0CORo0END REP;m0.o0:(CONCR(j0)ISUBm0)<>n0.END PROCfelderzahl;PROCfeldlesen(SATZ CONSTj0,INT CONSTp0,TEXT VARq0):r0(CONCR(j0),p0);IF NOTiserrorTHENq0:=subtext(CONCR(j0),s0,t0)END IF END PROCfeldlesen;PROCfeldbearbeiten(SATZ CONSTj0,INT CONSTp0,PROC(TEXT CONST,INT CONST,INT CONST)u0):r0(CONCR(j0),p0);IF NOTiserrorTHENu0(CONCR(j0),s0,t0)END IF END PROCfeldbearbeiten;INT VARs0,t0;PROCr0(TEXT CONSTj0,INT CONSTp0):IFv0THENerrorstop(text(p0)+f0)ELIFw0THENs0:=j0ISUBp0;t0:=(j0ISUBp0+1)-1ELSEs0:=1;t0:=0END IF.v0:p0<=0ORp0>b0.w0:p0+p0<(j0ISUB1)-1.END +PROCr0;TEXT VARx0;PROCfeldaendern(SATZ VARj0,INT CONSTp0,TEXT CONSTq0):INT VARy0;INT CONSTz0:=((CONCR(j0)ISUB1)-2)DIV2;IFa1THENb1ELSEerrorstop(text(p0)+f0)END IF.a1:p0>0ANDp0<=b0.b1:INT CONSTc1:=p0-z0;IFc1<=0THENd1ELIFq0<>e0THENe1END IF.e1:INT CONSTf1:=CONCR(j0)ISUB(z0+1);x0:=subtext(CONCR(j0),g1,f1-1);CONCR(j0):=subtext(CONCR(j0),1,z0+z0);h1(CONCR(j0),1,z0,i1);j1;k1;CONCR(j0)CATx0;CONCR(j0)CATq0.i1:c1+c1.j1:INT CONSTl1:=f1+i1;FORy0FROMz0+1UPTOp0REPm1(CONCR(j0),l1)END REP.k1:m1(CONCR(j0),l1+length(q0)).g1:CONCR(j0)ISUB1.d1:INT CONSTs0:=CONCR(j0)ISUBp0,n1:=CONCR(j0)ISUB(p0+1);IFs0>length(CONCR(j0))THENo1ELSEp1END IF.o1:h1(CONCR(j0),p0+1,z0+1,length(q0));CONCR(j0)CATq0.p1:x0:=subtext(CONCR(j0),n1);CONCR(j0):=subtext(CONCR(j0),1,s0-1);h1(CONCR(j0),p0+1,z0+1,q1);CONCR(j0)CATq0;CONCR(j0)CATx0.q1:length(q0)-r1.r1:n1-s0.END PROCfeldaendern;PROCm1(TEXT VARj0,INT CONSTs1):replace(g0,1,s1);j0CATg0END PROCm1;PROCh1(TEXT VARj0,INT CONSTt1,u1,v1):INT VARy0;FORy0FROMt1UPTOu1REPreplace(j0,y0,w1+v1) +END REP.w1:j0ISUBy0.END PROCh1;INT PROCfeldindex(SATZ CONSTj0,TEXT CONSTx1):INT VARt1:=(CONCR(j0)ISUB1)-1,y0:=1;REPt1:=pos(CONCR(j0),x1,t1+1);IFt1=0THEN LEAVEfeldindexWITH0END IF;y1UNTILz1CANDa2END REP;y0.y1:WHILE(CONCR(j0)ISUBy0)<t1REPy0INCR1END REP.z1:(CONCR(j0)ISUBy0)=t1.a2:(CONCR(j0)ISUB(y0+1))=t1+length(x1).END PROCfeldindex;END PACKETeudassatzzugriffe; +PACKETfensterDEFINES FENSTER,fensterinitialisieren,fenstergroessesetzen,fenstergroesse,fensterveraendert,fensterzugriff,bildschirmneu:TYPE FENSTER=STRUCT(INTb0,c0);LETd0=16,BITVEKTOR=INT,GROESSE=STRUCT(INTe0,f0,g0,h0);ROWd0STRUCT(INTi0,j0,BITVEKTORk0,GROESSEl0)VARm0;INT VARn0:=1;BITVEKTOR VARo0;INT VARp0;FORp0FROM2UPTOd0REPm0(p0).i0:=0END REP;m0(1).i0:=1;m0(1).j0:=0;m0(1).k0:=0;m0(1).l0:=GROESSE:(1,1,79,24);PROCfensterinitialisieren(FENSTER VARf):f.b0:=1;m0(1).i0INCR1;q0(f.c0)END PROCfensterinitialisieren;PROCq0(INT VARc0):c0:=n0;n0INCR1;IFn0>=32000THENn0:=-32000END IF END PROCq0;PROCfenstergroessesetzen(FENSTER VARr0,FENSTER CONSTs0):q0(r0.c0);m0(r0.b0).i0DECR1;r0.b0:=s0.b0;m0(s0.b0).i0INCR1END PROCfenstergroessesetzen;PROCfenstergroessesetzen(FENSTER VARf,INT CONSTe0,f0,g0,h0):INT VARt0;u0;IFt0>d0THENv0;w0;x0END IF;y0.u0:t0:=1;WHILEt0<=d0REP IFz0THEN LEAVEu0END IF;t0INCR1END REP.z0:a1.e0=e0ANDa1.f0=f0ANDa1.g0=g0ANDa1.h0=h0.a1:m0(t0).l0.v0:t0:=1;WHILEt0<=d0REP IFm0(t0).i0=0THEN LEAVE +v0END IF;t0INCR1END REP;errorstop("zu viele Fenstergroessen");LEAVEfenstergroessesetzen.w0:m0(t0).i0:=0;m0(t0).j0:=0;m0(t0).l0:=GROESSE:(e0,f0,g0,h0);m0(t0).k0:=0.x0:INT VARb1;FORb1FROM1UPTOd0REP IFm0(b1).i0>0THENc1END IF END REP.c1:IFd1(e1,f1)THENsetbit(m0(t0).k0,b1);setbit(m0(b1).k0,t0)ELSEresetbit(m0(b1).k0,t0)END IF.e1:m0(t0).l0.f1:m0(b1).l0.y0:m0(f.b0).i0DECR1;f.b0:=t0;m0(t0).i0INCR1.END PROCfenstergroessesetzen;BOOL PROCd1(GROESSE CONSTa,g1):h1ANDi1.h1:IFa.e0<=g1.e0THENg1.e0<a.e0+a.g0ELSEa.e0<g1.e0+g1.g0END IF.i1:IFa.f0<=g1.f0THENg1.f0<a.f0+a.h0ELSEa.f0<g1.f0+g1.h0END IF.END PROCd1;PROCfenstergroesse(FENSTER CONSTf,INT VARe0,f0,g0,h0):e0:=a1.e0;f0:=a1.f0;g0:=a1.g0;h0:=a1.h0.a1:m0(f.b0).l0.END PROCfenstergroesse;PROCfensterveraendert(FENSTER CONSTf):m0(f.b0).j0:=0;o0:=o0ORj1.j1:m0(f.b0).k0.END PROCfensterveraendert;PROCfensterzugriff(FENSTER CONSTf,BOOL VARk1):k1:=bit(o0,f.b0);IFm0(f.b0).j0<>f.c0THENm0(f.b0).j0:=f.c0;k1:=TRUE END IF;o0:=o0ORj1;resetbit(o0,f.b0).j1:m0(f.b0).k0.END +PROCfensterzugriff;PROCbildschirmneu:o0:=-1END PROCbildschirmneu;ROW16INT VARl1:=ROW16INT:(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,-32767-1);PROCsetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1ORl1(t0)END PROCsetbit;PROCresetbit(BITVEKTOR VARm1,INT CONSTt0):m1:=m1AND(-1-l1(t0))END PROCresetbit;BOOL PROCbit(BITVEKTOR CONSTm1,INT CONSTt0):(m1ANDl1(t0))<>0END PROCbit;END PACKETfenster; +PACKETeudasmenuesDEFINESglobalmanager,menuemanager,lock,free,menuedateneinlesen,menuenamen,menueloeschen,boxzeichen,waehlbar,fusszeile,fussteil,ausfuehrtaste,menueanbieten,zeilenmenueanbieten,auswahlanbieten,wahl,eschopausfuehren,hilfeanbieten,vielhilfe,statusanzeigen,statuszeile,dialogfenster,dialogfensterloeschen,dialog,neuerdialog,ja,editget,fehlerausgeben:ROW7TEXT VARb0:=ROW7TEXT:("MENUE","BILD","FELD","ENDE","AUSWAHL","HILFE","SEITE");LETc0=1,d0=2,e0=3,f0=4,g0=5,h0=6,i0=7;LETj0=2,integer=3,k0=4,l0=7;LETm0= +#701#"FEHLER in Zeile "; +FILE VARn0;TEXT VARo0,p0;PROCq0:IFeof(n0)THENo0:="%DUMMY"ELSEreadrecord(n0,o0);IFo0=r0THENo0:=s0END IF;cout(lineno(n0));down(n0)END IF END PROCq0;BOOL PROCt0:IF(o0SUB1)=u0THENv0ELSE FALSE END IF.v0:INT VARw0;replace(o0,1,s0);scan(o0);replace(o0,1,u0);nextsymbol(p0,w0);IFw0<>j0THENx0(y0);FALSE ELSE TRUE END IF.END PROCt0;BOOL PROCz0(INT CONSTa1):b0(a1)=p0END PROCz0;INT PROCb1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=integerTHENint(c1)ELSE IFw0<>l0THENx0(d1)END IF;-1END IF END PROCb1;TEXT PROCe1:TEXT VARc1;INT VARw0;nextsymbol(c1,w0);IFw0=k0THENc1ELSE IFw0<>l0THENx0(f1)END IF;r0END IF END PROCe1;PROCx0(TEXT CONSTg1):note(m0);note(lineno(n0)-1);noteline;note(g1);noteline;line;putline(g1)END PROCx0;INT VARh1,i1,j1,k1;PROCl1(INT CONSTm1,n1):cursor(j1+m1-1,k1+n1-1)END PROCl1;TEXT VARo1,p1,q1,r1,s1,t1,u1,v1,w1,x1,y1;TEXT VARz1:=120*" ",a2,b2;boxzeichen("-:..`'::-",""15""14"","X ");PROCboxzeichen(TEXT CONSTc2,d2,e2):x1:=d2;y1:=e2;IF LENGTHc2=9THENv1:=c2SUB1;u1:=c2SUB2;o1:=c2SUB3;p1:=c2SUB4; +q1:=c2SUB5;r1:=c2SUB6;s1:=c2SUB7;t1:=c2SUB8;w1:=c2SUB9END IF;a2:=120*v1;b2:=120*w1END PROCboxzeichen;PROCf2(INT CONSTg2):out(o1);outsubtext(a2,1,g2-2);out(p1)END PROCf2;PROCf2(INT CONSTg2,TEXT CONSTh2):out(o1);outsubtext(a2,1,g2-3-length(h2));out(h2);out(v1);out(p1)END PROCf2;PROCi2(INT CONSTg2):out(s1);outsubtext(b2,1,g2-2);out(t1)END PROCi2;PROCj2(INT CONSTg2):out(q1);outsubtext(a2,1,g2-2);out(r1)END PROCj2;PROCk2(INT CONSTm1,g2):IFm1+g2>=xsizeTHENout(l2)ELSEoutsubtext(z1,1,g2)END IF END PROCk2;LETm2= +#702#"Zeile ist ohne Zusammenhang",n2= +#703#"K Menuedaten im Speicher"; +PROCmenuedateneinlesen(TEXT CONSTo2):p2;n0:=sequentialfile(input,o2);modify(n0);toline(n0,1);WHILE NOTeof(n0)REPq0;IFt0THENq2ELIF NOTanythingnotedTHENx0(m2)END IF END REP;r2;IFanythingnotedTHENnoteedit(n0)END IF.q2:IFz0(c0)THENs2ELIFz0(g0)THENt2ELIFz0(h0)THENu2ELIF NOTanythingnotedTHENx0(m2)END IF.r2:IFonlineTHENline;put(v2);putline(n2)END IF.v2:storage(w2(1))+storage(w2(2))+storage(w2(3)).END PROCmenuedateneinlesen;TYPE MENUE=STRUCT(SATZx2,y2,z2,TEXTa3,b3);BOUND ROW200MENUE VARc3;TEXT VARd3,e3;SATZ VARf3,g3;LETr0="",s0=" ",h3=" ",i3=2,u0="%",j3=""7"",k3=""27"",l2=""5"";LETl3= +#704#"% BILD erwartet",m3= +#705#"Feldnummer beim %FELD-Kommando fehlt",n3= +#706#"% ENDE erwartet",o3= +#707#"Name fehlt",y0= +#708#"Kommandozeile enthaelt kein Kommando",d1= +#709#"Parameter soll eine Zahl sein",f1= +#710#"Parameter soll ein TEXT sein"; +PROCs2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex;p3;s2(c3(index))END IF.p3:index:=link(q3(2),name);IFindex=0THENinsert(q3(2),name,index)END IF.END PROCs2;PROCs2(MENUE VARr3):s3;t3;u3;v3;w3.s3:satzinitialisieren(r3.x2);satzinitialisieren(f3);satzinitialisieren(g3);e3:=r0;d3:=r0.t3:x3;INT VARy3:=1;REPq0;IFt0THEN LEAVEt3ELSEz3;y3INCR1END IF END REP.x3:q0;IF NOT(t0CANDz0(d0))THENx0(l3)END IF.z3:IFpos(o0,h3)>0THENd3CATcode(y3+1);IF(o0SUBi3)=h3THENreplace(o0,i3,s0)END IF END IF;feldaendern(r3.x2,y3,o0).u3:WHILEz0(e0)REPa4END REP.a4:INT VARb4:=b1;IFb4=-1THENx0(m3);b4:=100END IF;c4;d4;e4.c4:feldaendern(f3,b4,e1).d4:TEXT CONSTf4:=e1;INT VARg4;FORg4FROM1UPTOlength(f4)REPe3CATcode(b4);e3CAT(f4SUBg4)END REP.e4:TEXT VARh4:=r0;q0;WHILE NOTt0REPh4CATo0;q0END REP;feldaendern(g3,b4,h4).v3:IF NOTz0(f0)THENx0(n3)END IF.w3:r3.y2:=f3;r3.z2:=g3;r3.a3:=e3;r3.b3:=d3.END PROCs2;LETi4= +#711#"Kommando wird ausgeführt ..",j4= +#712#""15"Gib Kommando: ",k4= +#713#"falsche Ausfuehrtaste",l4= +#714#" existiert nicht."; +LETm4=" ",n4=""15"",o4=""14"",p4="?"8"",q4="*"8"";INT VARr4,s4;BOOL VARt4:=FALSE,u4,v4;TEXT VARw4:=r0,x4,y4:=" "1""2""3""8""10""13""27"",z4,a5:=r0;ROW6TEXT VARb5:=ROW6TEXT:("","","","","",""),c5:=b5;FENSTER VARd5,e5;fensterinitialisieren(d5);fensterinitialisieren(e5);PROCwaehlbar(INT CONSTf5,g5,BOOL CONSTh5):IFh5THENi5ELSEj5END IF;u4:=TRUE.i5:IFlength(b5(f5))>=g5THENreplace(b5(f5),g5," ")END IF.j5:WHILElength(b5(f5))<g5REPb5(f5)CAT" "END REP;replace(b5(f5),g5,"-").END PROCwaehlbar;PROCausfuehrtaste(TEXT CONSTk5):IFlength(k5)<>1CORl5THENerrorstop(k4)ELSEreplace(y4,1,k5)END IF.l5:k5<>""13""ANDpos(y4,k5,2)>0.END PROCausfuehrtaste;PROCfusszeile(TEXT CONSTm5,TEXT CONSTn5,INT CONSTo5,TEXT CONSTp5,INT CONSTq5):c5(1):=code(1)+m5;c5(4):=r0;c5(2):=code(o5)+n5;c5(5):=r0;c5(3):=code(q5)+p5;c5(6):=r0;fensterveraendert(e5)END PROCfusszeile;PROCfussteil(INT CONSTindex,TEXT CONSTr5,s5):t5;c5(index):=(c5(index)SUB1)+r5;cursor(code(c5(index)SUB1),ysize); +outsubtext(c5(index),2);fussteil(index,s5)END PROCfussteil;PROCfussteil(INT CONSTindex,TEXT CONSTs5):INT VARu5;IFindex=3THENu5:=xsizeELSEu5:=code(c5(index+1)SUB1)END IF;INT CONSTv5:=code(c5(index)SUB1)+length(c5(index))-1;u5DECRv5;c5(index+3):=subtext(s5,1,u5);t5;cursor(v5,ysize);outsubtext(s5,1,u5);outsubtext(z1,1,u5-length(c5(index+3)))END PROCfussteil;PROCt5:BOOL VARw5;fensterzugriff(e5,w5);IFw5CANDc5(1)<>r0THENx5END IF.x5:INT VARy5;cursor(1,ysize);out(l2);FORy5FROM1UPTO3REPcursor(code(c5(y5)SUB1),ysize);outsubtext(c5(y5),2);out(c5(y5+3))END REP.END PROCt5;PROCmenueanbieten(ROW6TEXT CONSTmenuenamen,FENSTER CONSTf,BOOL CONSTz5,PROC(INT CONST,INT CONST)a6):ROW6INT VARb6,c6,d6;INT VARe6,f6:=0,g6:=1,h6:=0,i6;TEXT VARj6;ROW6TEXT VARk6,l6;BOOL VARm6;p2;n6;disablestop;REPo6;p6;q6END REP.n6:r6;s6;t6;u6.r6:fenstergroessesetzen(d5,1,1,xsize-1,1);fenstergroessesetzen(e5,1,ysize,xsize-1,1).s6:m6:=t4;t4:=FALSE;j6:=w4;k6:=b5;l6:=c5.t6:w4:=""6""0""0"";v6;w6;w4CATl2.v6:INT VARx6:=pos(menuenamen(1), +".");IFx6>0THENw4CATsubtext(menuenamen(1),1,x6-1)END IF;w4CAT": ".w6:i6:=0;WHILEi6<6CANDy6REPi6INCR1;z6;d6(i6):=1END REP.y6:menuenamen(i6+1)<>r0.z6:b6(i6):=length(w4);x6:=pos(menuenamen(i6),".");IFx6=0THENw4CATmenuenamen(i6)ELSEw4CATsubtext(menuenamen(i6),x6+1)END IF;w4CAT" ";c6(i6):=length(w4)-1.u6:INT VARy5;FORy5FROM1UPTO6REPb5(y5):=r0;c5(y5):=r0END REP;u4:=TRUE;a6(0,0).o6:IFg6>0THENa7;b7;f6:=g6;g6:=0;c7END IF.a7:IFf6>0THENreplace(w4,b6(f6)," ");replace(w4,c6(f6)," ");IFv4THENa6(f6,-1)END IF END IF.b7:replace(w4,b6(g6),n4);replace(w4,c6(g6),o4);fensterveraendert(d5);d7.c7:e6:=link(q3(2),menuenamen(f6));IFe6=0THENe7(menuenamen(f6));LEAVEmenueanbietenEND IF;v4:=FALSE;fensterveraendert(f).p6:h6:=f6;f7(c3(e6),f,h6,d6(f6),PROC(INT CONST,INT CONST)a6).q6:SELECTh6OF CASE0:g7CASE1:h7CASE2:i7CASE3:j7CASE4:k7OTHERWISEl7END SELECT.i7:IFf6<i6THENg6:=f6+1ELSEg6:=1END IF.j7:IFf6>1THENg6:=f6-1ELSEg6:=i6END IF.l7:h6:=h6-10;IFh6<=i6THENg6:=h6END IF.h7:IFz5THEN BOOL VARm7:=FALSE;REPn7;o7UNTILp7END + REP;IFm7THENbildschirmneu;dialogfensterloeschen;t5;a6(f6,-2)END IF END IF.o7:IFq7THENm7:=TRUE;statusanzeigen(i4);cursor(1,2);out(r7);do(z4)END IF.q7:pos(z4,"!","�",1)>0.p7:NOTiserror.g7:IFv4THENa6(f6,-1)END IF;fensterveraendert(f);s7;LEAVEmenueanbieten.s7:t4:=m6;w4:=j6;fensterveraendert(d5);b5:=k6;u4:=TRUE;c5:=l6;fensterveraendert(e5).k7:IFd6(f6)>0THENa6(f6,d6(f6))ELSEd6(f6):=-d6(f6)END IF;t5.END PROCmenueanbieten;PROCd7:BOOL VARw5;fensterzugriff(d5,w5);IFw5THENout(w4)END IF END PROCd7;PROCf7(MENUE CONSTr3,FENSTER CONSTf,INT VARt7,wahl,PROC(INT CONST,INT CONST)a6):INT VARu7:=0;v7;w7(f);IFs4=0THENr4:=0END IF;neuerdialog;x7;REPd7;y7;z7END REP.v7:IFwahl>length(r3.b3)THENwahl:=r4;ELIFiserrorTHENfehlerausgeben;a6(t7,-2);END IF.x7:IFu4THENa8(t7,r3);b8;u4:=FALSE END IF.b8:INT VARc8;FORc8FROM1UPTOlength(r3.b3)REP INT CONSTd8:=code(r3.b3SUBc8);IFd8>s4THEN LEAVEb8END IF;e8(r3.x2,d8)END REP.y7:REPf8;IFiserrorTHENg8ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;BOOL VARi8:=FALSE;WHILEs4<h1REPh8:= +getcharety;j8END REP;k8;l8(r3,wahl);m8(h8).j8:IFh8=r0THENn8;s4INCR1;o8ELSE LEAVEf8END IF.n8:IF NOTv4ANDs4=0THENa6(t7,0);a8(t7,r3);v4:=TRUE END IF.o8:IFs4=code(r3.b3SUBwahl)THENp8(r3.x2,s4,TRUE);r4:=wahlELSEp8(r3.x2,s4,FALSE)END IF;IFs4=h1THENi8:=TRUE END IF.k8:IFi8AND NOTiserrorTHENt5;a6(t7,-2);IFiserrorTHENclearerrorEND IF END IF.g8:fehlerausgeben;d7;s4:=0.z7:INT VARq8;SELECTu7OF CASE0:r8CASE1:s8CASE2:t8END SELECT.r8:SELECTpos(y4,h8)OF CASE1:u8CASE2:u7:=1CASE3:v8CASE4:w8CASE5:x8CASE6:y8CASE7:z8CASE8:u7:=2OTHERWISEa9END SELECT.s8:SELECTpos(""1""3""10"",h8)OF CASE1:b9CASE2:c9CASE3:d9OTHERWISEout(j3)END SELECT;u7:=0.t8:SELECTpos(""1""27"?qh",h8)OF CASE1:eschopausfuehrenCASE2:e9CASE3:f9CASE4,5:g9OTHERWISEh9END SELECT;u7:=0.v8:h6:=2;LEAVEf7.w8:IFwahl>1THENwahlDECR1ELSEwahl:=length(r3.b3)END IF.x8:h6:=3;LEAVEf7.y8:IFwahl<length(r3.b3)THENwahlINCR1ELSEwahl:=1END IF.z8:y8.a9:IFi9THENj9ELIFk9THENl9ELIFh8<=" "THENpush(k3+h8)END IF.i9:pos("123456",h8)>0.j9:h6:=code(h8)-38;LEAVEf7.k9:q8:=0;REPq8 +:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0END REP;q8>0ANDm9.m9:code(r3.a3SUBq8-1)<=length(r3.b3).l9:wahl:=code(r3.a3SUBq8-1);l8(r3,wahl);IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.b9:wahl:=1.c9:wahl:=1.d9:wahl:=length(r3.b3).h9:IFo9THENwahl:=code(r3.a3SUBq8-1);h6:=4;LEAVEf7ELSEpush(lernsequenzauftaste(h8))END IF.o9:q8:=0;REPq8:=pos(r3.a3,h8,q8+1)UNTIL(q8MOD2)=0CAND(q8=0CORp9)END REP;q8>0.p9:code(r3.a3SUBq8-1)>length(r3.b3).e9:h6:=1;LEAVEf7.f9:TEXT VARq9;r9(r3,wahl,p4);feldlesen(r3.y2,wahl,q9);hilfeanbieten(q9,s9);IFiserrorTHENfehlerausgebenEND IF;a6(t7,-2);w7(f).g9:h6:=0;LEAVEf7.u8:IF(b5(t7)SUBwahl)<>"-"THENn9(r3,wahl);h6:=4;LEAVEf7END IF.h6:t7.END PROCf7;PROCw7(FENSTER CONSTf):BOOL VARw5;fensterzugriff(f,w5);fenstergroesse(f,j1,k1,i1,h1);IFw5THENs4:=0;l1(1,1)END IF END PROCw7;PROCa8(INT CONSTt7,MENUE CONSTr3):x4:=m4;INT VARy5;FORy5FROM1UPTOlength(b5(t7))REPreplace(x4,code(r3.b3SUBy5),b5(t7)SUBy5)END REP END PROCa8;PROCl8(MENUE CONSTr3,INT CONSTwahl):INT CONSTt9:=code(r3.b3SUB +wahl);IFr4>0ANDr4<>wahlTHEN INT CONSTu9:=code(r3.b3SUBr4);p8(r3.x2,u9,FALSE)END IF;p8(r3.x2,t9,TRUE);r4:=wahl;l1(2,t9)END PROCl8;PROCm8(TEXT VARv9):enablestop;getchar(v9)END PROCm8;PROCn9(MENUE CONSTr3,INT VARwahl):r9(r3,wahl,q4);TEXT VARh4;feldlesen(r3.z2,wahl,h4);IFh4<>r0ANDh4<>s0THENdo(h4);bildschirmneu;wahl:=-wahlEND IF.END PROCn9;PROCr9(MENUE CONSTr3,INT CONSTwahl,TEXT CONSTw9):INT CONSTk1:=code(r3.b3SUBwahl);IFs4>=k1THENp8(r3.x2,k1,FALSE);l1(2,k1);out(w9)END IF.END PROCr9;PROCeschopausfuehren:TEXT VARx9:=""0"",y9;lernsequenzauftastelegen(""0"",r0);push(""27""1""0""0"");editget(x9,1,1,""0"","",y9);out(""8"");x9:=lernsequenzauftaste(""0"");IFx9<>r0THENz9ELSEa10END IF.z9:REPgetchar(y9)UNTILpos(""1""2""8""11""12"",y9)=0END REP;lernsequenzauftastelegen(y9,x9).a10:getchar(y9).END PROCeschopausfuehren;BOOL VARb10;INT VARc10,d10,e10;PROCe8(SATZ CONSTx2,INT CONSTf10):l1(2,f10);IF(x4SUBf10)<>s0THENout(x4SUBf10)ELSEfeldbearbeiten(x2,f10-1,PROC(TEXT CONST,INT CONST,INT CONST)g10)END IF END +PROCe8;PROCg10(TEXT CONSTh10,INT CONSTc10,d10):out(h10SUBc10+d10-d10)END PROCg10;PROCp8(SATZ CONSTx2,INT CONSTy3,BOOL CONSTi10):enablestop;l1(1,y3);IFi10THENb10:=FALSE;out(u1);e8(x2,y3);out(n4);c10:=3;e10:=1;j10(x2,y3-1)ELIFy3=1THENf2(i1)ELIFy3=h1THENj2(i1)ELIFy3=felderzahl(x2)+2THENi2(i1)ELSEk10;IF(x4SUBy3)="-"THENout("-");c10:=2ELSEc10:=1END IF;e10:=0;j10(x2,y3-1)END IF.k10:feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10).END PROCp8;PROCl10(TEXT CONSTh10,INT CONSTm10,n10):b10:=(h10SUBm10+n10-n10)="-";IF NOTb10THENout(u1)END IF END PROCl10;PROCp8(SATZ CONSTx2,INT CONSTy3):feldbearbeiten(x2,y3-1,PROC(TEXT CONST,INT CONST,INT CONST)l10);c10:=1;e10:=0;j10(x2,y3-1)END PROCp8;PROCj10(SATZ CONSTx2,INT CONSTy3):IFb10THENi2(i1)ELSEo10END IF.o10:feldbearbeiten(x2,y3,PROC(TEXT CONST,INT CONST,INT CONST)p10);q10.q10:outsubtext(z1,1,i1-d10-e10-2);r10;s10.r10:IFe10>0THENout(o4)END IF.s10:out(u1).END PROCj10;PROCp10(TEXT CONSTt10,INT CONSTm10,n10):INT CONSTu10:=m10-1;c10INCRu10;d10:= +min(n10,i1+u10-e10-2);outsubtext(t10,c10,d10);d10DECRu10END PROCp10;PROCn7:LETv10=""27"k";TEXT VARw10;fensterveraendert(d5);x10;y10;REPz10UNTILw10<>v10END REP;IFpos(z4,"!","�",1)>0THENa5:=z4END IF.x10:IFiserrorTHENfehlerausgeben;z4:=a5ELSEz4:=r0END IF.y10:cursor(1,1);out(j4);outsubtext(z1,1,i1-15);out(o4).z10:cursor(16,1);editget(z4,32000,62,"","kh",w10);IFiserrorTHENclearerrorELIFw10=v10THENz4:=a5ELIFw10=a11THENz4:=r0END IF.END PROCn7;PROCe7(TEXT CONSTo2):errorstop(""""+o2+""""+l4)END PROCe7;TYPE AUSWAHL=STRUCT(SATZh2);BOUND ROW200AUSWAHL VARb11;PROCt2:TEXT VARname:=e1;IFname=r0THENx0(o3)ELSE INT VARindex:=link(q3(3),name);IFindex=0THENinsert(q3(3),name,index)END IF;t2(b11(index))END IF END PROCt2;PROCt2(AUSWAHL VARa):s3;c11;d11.s3:satzinitialisieren(a.h2).c11:INT VARy3:=1;REPq0;IFt0THEN LEAVEc11ELSEe11;y3INCR1END IF END REP.e11:feldaendern(a.h2,y3,o0).d11:IF NOTz0(f0)THENx0(n3)END IF.END PROCt2;LETf11=""10"",g11="+"27"q";LETh11= +#715#"Fenster zu klein",i11= +#716#"AUSWAHL: Ankreuzen: 'x' Durchstreichen: 'o' Beenden: ESC q Hilfe: ESC ?"; +INT VARj11,k11,l11,m11,n11,o11;BOOL VARp11;LET INTVEC=TEXT;INTVEC VARq11;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,1024,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,PROC(TEXT VAR,INT CONST)s5):auswahlanbieten(name,f,s11,r11,r0,PROC(TEXT VAR,INT CONST)s5)END PROCauswahlanbieten;PROCauswahlanbieten(TEXT CONSTname,FENSTER CONSTf,INT CONSTs11,TEXT CONSTr11,t11,PROC(TEXT VAR,INT CONST)s5):p2;INT CONSTindex:=link(q3(3),name);IFindex=0THENe7(name)ELSEu11;f7(b11(index),f,r11,s11,PROC(TEXT VAR,INT CONST)s5)END IF.u11:INT VARy5;q11:=r0;FORy5FROM1UPTOlength(t11)REPq11CATcode(t11SUBy5)END REP.END PROCauswahlanbieten;PROCf7(AUSWAHL CONSTa,FENSTER CONSTf,TEXT CONSTr11,INT CONSTs11,PROC(TEXT VAR,INT CONST)s5):INT VARs4:=0,u7:=0;enablestop;v11;statusanzeigen(i11);w11;x11;y11;REPy7;z11END REP.v11:BOOL VARdummy;fensterzugriff(f,dummy); +fenstergroesse(f,j1,k1,i1,h1).w11:INT VARa12:=1024;l11:=a12;REPa12:=a12DIV2;s5(o0,l11);IFo0=r0THENl11DECRa12ELSEl11INCRa12END IF UNTILa12=1END REP;s5(o0,l11);IFo0=r0THENl11DECR1END IF.x11:m11:=felderzahl(a.h2)+2;o11:=0;b12;IFm11>=h1THENerrorstop(h11)END IF.y11:INT VARc12:=m11+1,d12,e12:=1;p11:=s11>1.y7:REPf8;IFiserrorTHENclearerror;s4:=0ELSE LEAVEy7END IF END REP.f8:TEXT VARh8;WHILEs4<h1REPh8:=getcharety;j8END REP;l8;m8(h8).j8:IFh8=r0THEN IFs4=m11THENd12:=999;n11:=10END IF;s4INCR1;f12ELSE LEAVEf8END IF.f12:l1(1,s4);IFs4<=m11THENg12ELSEh12END IF.g12:IFs4=1THENf2(i1)ELIFs4=m11THENi2(i1)ELSEp8(a.h2,s4)END IF.h12:INT CONSTi12:=s4+o11-m11;IFs4=h1THENj2(i1)ELIFi12<=l11THENj12(i12,k12,FALSE,PROC(TEXT VAR,INT CONST)s5);n11:=max(n11,length(o0))ELIFi12=l11+1THENi2(i1)ELSEout(u1);outsubtext(z1,1,i1-2);out(u1)END IF.k12:s4>=j11ANDs4<=k11.l8:IFc12<>d12THEN IFd12<=s4THENl12END IF;m12END IF;cursor(1,1).l12:l1(5,d12);j12(d12+o11-m11,FALSE,PROC(TEXT VAR,INT CONST)s5).m12:l1(5,c12);j12(e12,TRUE,PROC( +TEXT VAR,INT CONST)s5);d12:=c12.z11:SELECTu7OF CASE0:r8CASE1:s8CASE2:t8END SELECT.r8:SELECTpos(""1""3""10""13""27" +x-o",h8)OF CASE1:u7:=1CASE2:w8CASE3:y8CASE4:z8CASE5:u7:=2CASE6:n12CASE7,8:o12CASE9,10:p12OTHERWISEa9END SELECT.s8:SELECTpos(""3""10"+x-o",h8)OF CASE1:c9CASE2:d9CASE3,4:q12CASE5,6:r12OTHERWISEout(j3)END SELECT;u7:=0.t8:SELECTpos(""1"19?qh",h8)OF CASE1:eschopausfuehrenCASE2:s12CASE3:t12CASE4:f9CASE5:g9CASE6:errorstop(r0)OTHERWISEh9END SELECT;u7:=0.w8:IFe12>1THENc12DECR1;e12DECR1;IFc12<=m11THENc12INCR1;o11DECR1;b12;s4:=min(s4,m11)END IF END IF.y8:IFe12<l11THENc12INCR1;e12INCR1;IFc12>=h1THENc12DECR1;o11INCR1;b12;s4:=min(s4,m11)END IF END IF.z8:push(f11).n12:push(g11).o12:IFu12(e12)=0ANDe12<=l11THENv12;w12END IF.v12:BOOL CONSTx12:=abs(s11)<=length(q11)DIV2;IFx12THENq11:=subtext(q11,3)END IF;q11CATe12.w12:IFx12THENy12ELIFc12<=s4THENz12(c12,length(q11)DIV2)END IF.p12:INT CONSTa13:=u12(e12);IFa13>0THENb13;y12END IF.b13:change(q11,2*a13-1,2*a13,r0).a9:IFh8<s0THENpush( +lernsequenzauftaste(h8))ELSEout(j3)END IF.c9:IFc12=m11+1THENc13ELSEd13END IF.c13:INT VARe13:=min(h1-m11-1,o11);o11DECRe13;e12DECRe13;IFe13>0THENb12;s4:=min(s4,m11)END IF.d13:e13:=c12-m11-1;c12DECRe13;e12DECRe13.d9:IFc12=h1-1THENf13ELSEg13END IF.f13:e13:=min(h1-m11-1,l11-e12);o11INCRe13;e12INCRe13;IFe13>0THENb12;s4:=min(s4,m11)END IF.g13:e13:=min(l11-e12,h1-c12-1);c12INCRe13;e12INCRe13.q12:IFl11>abs(s11)THENout(j3);LEAVEq12END IF;INT VARh13;FORh13FROM1UPTOl11REP IFu12(h13)=0THENq11CATh13END IF END REP;y12.r12:q11:=r0;y12.f9:hilfeanbieten(r11,f);statusanzeigen(i11);s4:=0.g9:LEAVEf7.h9:push(lernsequenzauftaste(h8)).s12:c12:=m11+1;e12:=1;o11:=0;b12;s4:=min(s4,m11).t12:INT CONSTi13:=m11+l11;IFi13<h1THENc12:=i13;o11:=0ELSEc12:=h1-1;o11:=i13-h1+1;s4:=min(s4,m11)END IF;b12;e12:=l11.END PROCf7;PROCy12:INT VARv9,h13;h13:=j13;FORv9FROMk13UPTOl13REPz12(v9,u12(h13));h13INCR1END REP.j13:o11+1.k13:m11+1.l13:min(h1-1,m11+l11).END PROCy12;PROCb12:INT CONSTm13:=h1-m11-1;IFo11=0THENj11:=1ELSEj11:=max(1, +o11*m13DIVl11)+1END IF;IFl11<=m13THENk11:=l11ELIFl11-o11=m13THENk11:=m13ELSEk11:=min(j11+m13*m13DIVl11,m13-1)END IF;j11INCRm11;k11INCRm11END PROCb12;TEXT VARn13:="xx";INT PROCu12(INT CONSTo13):replace(n13,1,o13);INT VARg4:=0;REPg4:=pos(q11,n13,g4+1)UNTILg4=0ORg4MOD2=1END REP;(g4+1)DIV2END PROCu12;OP CAT(INTVEC VARp13,INT CONSTwert):replace(n13,1,wert);p13CATn13END OP CAT;PROCj12(INT CONSTq13,BOOL CONSTr13,i10,PROC(TEXT VAR,INT CONST)s5):out(u1);s13;j12(q13,i10,PROC(TEXT VAR,INT CONST)s5);t13;out(u1).s13:INT CONSTu13:=u12(q13);IFu13=0THENout(" ")ELIFp11THENout(text(u13,3));ELSEout(" x ")END IF.t13:IFr13THENout(x1)ELSEout(y1)END IF.END PROCj12;PROCj12(INT CONSTq13,BOOL CONSTi10,PROC(TEXT VAR,INT CONST)s5):s5(o0,q13);INT VARv13:=min(i1-8,length(o0));IFi10THENv13:=min(v13,i1-9);out(""15"")ELSEout(" ")END IF;outsubtext(o0,1,v13);w13.w13:IFi10THENoutsubtext(z1,1,n11-v13+1);out(""14"");outsubtext(z1,1,i1-n11-10)ELSEoutsubtext(z1,1,i1-v13-8)END IF.END PROCj12;PROCz12(INT CONSTo0,wert):l1(2, +o0);IFwert=0THENout(" ")ELIFp11THENout(text(wert,3))ELSEout(" x ")END IF END PROCz12;INT PROCwahl(INT CONSTx13):IFx13+x13<=length(q11)THENq11ISUBx13ELSE0END IF END PROCwahl;LETy13=200,z13=5000;LET HILFE=STRUCT(INTa14,ROWy13THESAURUSb14,ROWy13SATZc14,ROWz13SATZd14);BOUND HILFE VARe14;INT VARf14,g14,h14,i14;BOOL VARj14:=FALSE;TEXT VARk14;LETl14= +#717#"Das Hilfsgebiet existiert bereits",m14= +#718#"Diese Seite ist in der anderen Hilfe nicht vorhanden"; +PROCu2:TEXT VARname:=e1;BOOL VARn14;IFname=r0THENx0(o3)ELSEo14;p14;q14END IF.o14:INT CONSTr14:=pos(name,"/");TEXT VARs14;IFr14=0THENs14:=nameELSEs14:=subtext(name,1,r14-1)END IF;t14;u14.t14:INT VARv14:=link(q3(1),s14);n14:=FALSE;IFv14=0THENinsert(q3(1),s14,v14);e14.b14(v14):=emptythesaurus;satzinitialisieren(e14.c14(v14));ELIFr14=0THENx0(l14);LEAVEu2ELIFj14THENn14:=TRUE END IF.u14:INT VARw14;TEXT VARx14:=subtext(name,r14+1);IFr14=0THENw14:=1ELSEw14:=link(e14.b14(v14),x14);IFw14=0AND NOTn14THENinsert(e14.b14(v14),x14,w14)END IF END IF.p14:INT VARy14:=e14.a14;IFy14<0THENy14:=0END IF;TEXT VARz14:=r0;q0;WHILEt0CANDz0(i0)REPa15END REP.a15:INT CONSTb15:=b1;TEXT CONSTc15:=e1;IFc15<>r0THENd15;q0ELSEe15END IF.d15:TEXT VARf15;g15(c15,f15);IFb15+b15<=length(f15)THENz14CAT(f15ISUBb15)ELIF NOT(anythingnotedORn14)THENx0(m14)END IF.e15:INT VARy3:=1;IF NOTn14THENy14INCR1;z14CATy14;satzinitialisieren(e14.d14(y14))END IF;k14:=r0;REPq0;IFt0THEN LEAVEe15ELIF NOTn14THENh15END IF END REP.h15:k14CATo0; +feldaendern(e14.d14(y14),y3,k14);IFi15THENy3INCR1;k14:=r0ELSEk14CATs0END IF.i15:(k14SUB LENGTHk14)=s0.q14:IF NOTz0(f0)THENx0(n3)END IF;IF NOT(anythingnotedORn14)THENfeldaendern(e14.c14(v14),w14,z14);e14.a14:=y14END IF.END PROCu2;PROCg15(TEXT CONSTname,TEXT VARz14):INT CONSTr14:=pos(name,"/");INT VARs14,w14:=0;IFr14=0THENs14:=link(q3(1),name)ELSEs14:=link(q3(1),subtext(name,1,r14-1));j15END IF;IFw14=0THENw14:=1END IF;IFs14=0THENerrorstop(k15)ELSEfeldlesen(e14.c14(s14),w14,z14)END IF.j15:IFs14>0THENw14:=link(e14.b14(s14),subtext(name,r14+1))END IF.END PROCg15;LETk15= +#719#"Hilfe existiert nicht",l15= +#720#"Hilfe ist leer",m15= +#721#" Seite ",n15= +#722#" von ",o15= +#723#"HILFE: Beenden: ESC q Seite weiter: ESC UNTEN Seite zurueck: ESC OBEN"; +TEXT VARp15;INT VARq15,r15,s15;BOOL VARt15:=TRUE;PROCvielhilfe(BOOL CONSTu15):t15:=u15END PROCvielhilfe;BOOL PROCvielhilfe:t15END PROCvielhilfe;PROChilfeanbieten(TEXT CONSTname,FENSTER CONSTf):enablestop;p2;TEXT VARz14;v15;g15(name,z14);IFz14=r0THENerrorstop(l15)ELSEw15END IF.v15:fensterveraendert(f);fenstergroesse(f,f14,g14,h14,i14).w15:INT CONSTx15:=length(z14)DIV2;y15;statusanzeigen(o15);INT VARc14:=1;REPz15;a16END REP.z15:INT CONSTb16:=z14ISUBc14;p15:=m15+text(c14)+n15;p15CATtext(x15);p15CAT" ";IFlength(p15)+2>h14THENp15:=r0END IF;c16(e14.d14(b16)).a16:TEXT VARh8;REPgetchar(h8);IFh8=k3THENgetchar(h8);o7;LEAVEa16ELSEout(j3)END IF END REP.o7:SELECTpos("q"10""3"?"1"",h8)OF CASE1:LEAVEhilfeanbietenCASE2:d16CASE3:e16CASE4:f16CASE5:eschopausfuehrenOTHERWISEout(j3)END SELECT.d16:IFc14<x15THENc14INCR1END IF.e16:IFc14>1THENc14DECR1END IF.f16:c14:=1.END PROChilfeanbieten;PROCc16(SATZ CONSTg16):INT VARy3;r15:=1;s15:=0;g12;q15:=0;FORy3FROM1UPTOi14-2REPcursor(f14,g14+y3);feldbearbeiten(g16,r15, +PROC(TEXT CONST,INT CONST,INT CONST)x5)END REP;h16.g12:cursor(f14,g14);f2(h14,p15).h16:cursor(f14,g14+i14-1);j2(h14);cursor(1,1).END PROCc16;PROCx5(TEXT CONSTx2,INT CONSTm10,n10):d10:=min(s15+m10+h14-3-q15,n10);IFm10<=n10CAND(x2SUBm10)="-"THENi2(h14);r15INCR1;q15:=0ELSEi16;j16;k16END IF.i16:IFd10<n10THEN IFl16CANDm16THENn16END IF END IF.l16:(x2SUBd10+1)<>" "AND(x2SUBd10)<>" ".m16:pos(x2," ",s15+m10,d10)>0.n16:WHILE(x2SUBd10)<>" "REPd10DECR1END REP.j16:out(u1);outsubtext(z1,1,q15);outsubtext(x2,m10+s15,d10);outsubtext(z1,1,h14+m10+s15-q15-d10-3);out(u1).k16:IFd10<n10THENo16;s15:=d10-m10+1;d10INCR1;WHILE(x2SUBd10)=" "REPs15INCR1;d10INCR1END REP ELSEs15:=0;r15INCR1;q15:=0END IF.o16:IFq15=0CANDs15=0THENq15:=pos(x2," ",m10,d10);IFq15>0THENp16END IF END IF.p16:WHILE(x2SUBq15)=" "REPq15INCR1END REP;q15DECRm10.END PROCx5;BOOL VARq16:=TRUE;PROCstatuszeile(BOOL CONSTr16):q16:=r16END PROCstatuszeile;BOOL PROCstatuszeile:q16END PROCstatuszeile;PROCstatusanzeigen(TEXT CONSTstatus):IFq16THENcursor( +1,1);out(" ");out(status);out(l2);fensterveraendert(d5)END IF END PROCstatusanzeigen;LETs16=20;ROWs16INT VARt16;INT VARu16,v16,w16,x16,y16,z16;TEXT VARr5;PROCa17(MENUE CONSTr3,INT CONSTb17,INT VARwahl):enablestop;BOOL VARc17:=FALSE;REP IF NOTc17THENd17END IF;e17;o7END REP.d17:INT VARy5;cursor(b17,w16);u16:=b17;t16(1):=u16;FORy5FROM1UPTOfelderzahl(r3.x2)REPout(" ");u16INCR1;feldbearbeiten(r3.x2,y5,PROC(TEXT CONST,INT CONST,INT CONST)f17);out(" ");u16INCR1;t16(y5+1):=u16;END REP;v16:=u16;c17:=TRUE;g17(r3.x2,wahl).e17:TEXT VARh17;getchar(h17).o7:SELECTpos(""2""8""13" "1""27"",h17)OF CASE1:i17(r3.x2,wahl,wahl+1)CASE2:i17(r3.x2,wahl,wahl-1)CASE3,4:j17(r3.x2,wahl);LEAVEa17CASE5:k17CASE6:l17OTHERWISEm17END SELECT.m17:INT VARn17:=0;REPn17:=pos(r3.a3,h17,n17+1)UNTIL(n17MOD2)=0END REP;IFn17=0THEN IFh17<" "THENpush(""27""+h17)ELSEout(""7"")END IF ELSEi17(r3.x2,wahl,code(r3.a3SUBn17-1));j17(r3.x2,wahl);LEAVEa17END IF.l17:TEXT VARo17;getchar(o17);SELECTpos(""1"qh?"27"",o17)OF CASE1:eschopausfuehren +CASE2:wahl:=0;LEAVEa17CASE3:errorstop("")CASE4:j17(r3.x2,wahl);wahl:=-wahl;LEAVEa17CASE5:wahl:=-32000;LEAVEa17OTHERWISEpush(lernsequenzauftaste(o17))END SELECT.k17:getchar(o17);SELECTpos(""8""2"",o17)OF CASE1:i17(r3.x2,wahl,1)CASE2:i17(r3.x2,wahl,felderzahl(r3.x2))OTHERWISEout(""7"")END SELECT.END PROCa17;PROCp17(SATZ CONSTx2,INT CONSTwahl):IFx16>0THENcursor(1,x16);out(""15"");out(r5);u16:=length(r5)+1;feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)q17);out(" "14"")END IF END PROCp17;PROCg17(SATZ CONSTx2,INT CONSTwahl):p17(x2,wahl);cursor(t16(wahl),w16);out(""15"");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out(" "14"");cursor(y16,z16)END PROCg17;PROCi17(SATZ CONSTx2,INT VARwahl,INT CONSTs17):t17;wahl:=s17;IFwahl<1THENwahl:=felderzahl(x2)ELIFwahl>felderzahl(x2)THENwahl:=1END IF;g17(x2,wahl).t17:cursor(t16(wahl),w16);out(" ");feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);out(" ").END PROCi17;PROCj17(SATZ CONSTx2,INT CONSTwahl):cursor( +t16(1),w16);t16(wahl)-t16(1)+1TIMESOUT" ";feldbearbeiten(x2,wahl,PROC(TEXT CONST,INT CONST,INT CONST)r17);v16-t16(wahl+1)+2TIMESOUT" "END PROCj17;PROCf17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17);u16INCRu17-m10+1END PROCf17;PROCr17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)-1;IFu17<0THENu17:=n10END IF;outsubtext(h10,m10,u17)END PROCr17;PROCq17(TEXT CONSTh10,INT CONSTm10,n10):INT VARu17:=pos(h10," ",m10)+1;IFu17<2THENu17:=n10+1END IF;xsize-5-u16-n10+u17TIMESOUT" ";outsubtext(h10,u17,n10)END PROCq17;PROCzeilenmenueanbieten(TEXT CONSTv17,BOOL CONSTz5,PROC(INT CONST)z2):BOOL VARm6:=t4;INT VARw17:=link(q3(2),v17);IFw17=0THENe7(v17);LEAVEzeilenmenueanbietenEND IF;w16:=ysize;x16:=ysize-1;getcursor(y16,z16);r5:=v17;disablestop;t4:=TRUE;x17;o7;t4:=m6.x17:INT VARwahl:=1;REPa17(c3(w17),1,wahl);IFwahl>=0THEN LEAVEx17ELIFwahl=-32000THEN IFz5THEN LEAVEx17END IF ELSEwahl:=-wahl;TEXT VARy17;feldlesen(c3(w17).y2, +wahl,y17);hilfeanbieten(y17,s9)END IF UNTILiserrorEND REP.o7:IFwahl>0THENz17(wahl,PROC(INT CONST)z2)ELIFwahl=-32000THENa18END IF.a18:cursor(1,ysize-1);out(""4"");out(j4);out(""14"");TEXT VARdummy:="";editget(dummy);IFdummy<>""THENdo(dummy)END IF.END PROCzeilenmenueanbieten;PROCz17(INT CONSTwahl,PROC(INT CONST)z2):enablestop;z2(wahl)END PROCz17;LETr7=""4"",b18=""27"?",c18=""27"q",a11=""27"h";LETd18= +#726#" ?",e18= +#727#"WAHL: Wählen: <-, -> Bestätigen: RETURN Abbruch: ESC h Hilfe: ESC ?",f18= +#728#"FRAGE: Bejahen: j,J Verneinen: n,N Abbrechen: ESC h Hilfe: ESC ?",g18= +#729#"EINGABE: Bestätigen: RETURN Abbrechen: ESC h Hilfe: ESC ?",h18= +#730#"EINGABE: Bestätigen: RETURN Zeigen: ESC z Abbruch: ESC h Hilfe: ESC ?",i18= +#731#""15"!!! FEHLER !!! "14" Quittieren: ESC q Hilfe zur Meldung: ESC ?"; +FENSTER VARs9;fensterinitialisieren(s9);INT VARj18,k18,l18,m18,n18;PROCdialogfenster(FENSTER CONSTo18):fenstergroesse(o18,k18,l18,m18,n18);fenstergroessesetzen(s9,o18)END PROCdialogfenster;FENSTER PROCdialogfenster:s9END PROCdialogfenster;PROCneuerdialog:j18:=n18END PROCneuerdialog;PROCp18:BOOL VARw5;fensterzugriff(s9,w5);j18INCR3;IFj18+3>n18ORw5THENq18;j18:=1END IF;r18;cursor(k18+1,l18+j18).r18:cursor(k18,l18+j18-1);f2(m18);cursor(k18,l18+j18);s18;cursor(k18,l18+j18+1);s18;cursor(k18,l18+j18+2);j2(m18).END PROCp18;PROCs18:out(u1);outsubtext(z1,1,m18-2);out(u1)END PROCs18;PROCdialog(TEXT CONSTt18):p18;outsubtext(t18,1,m18-2);cursor(k18+1,l18+j18+1)END PROCdialog;PROCdialogfensterloeschen:fensterveraendert(s9);q18END PROCdialogfensterloeschen;PROCq18:BOOL CONSTu18:=k18+m18>=xsize;j18:=0;REPcursor(k18,l18+j18);IFu18THENout(l2)ELSEoutsubtext(z1,1,m18)END IF;j18INCR1UNTILj18>=n18END REP END PROCq18;PROCauswahlanbieten(TEXT CONSTv17,r5,r11,INT VARv18):INT VARw18:=link(q3(2),v17);IFw18=0THEN +e7(v17);LEAVEauswahlanbietenEND IF;REPstatusanzeigen(e18);p18;outsubtext(r5,1,m18-2);x17END REP.x17:INT CONSTx18:=v18;w16:=l18+j18+1;x16:=0;y16:=1;z16:=1;a17(c3(w18),k18+1,v18);IFv18>=0THEN IFv18=0THENv18:=x18END IF;LEAVEauswahlanbietenELIFv18=-32000THENv18:=1ELSEhilfeanbieten(r11,s9);neuerdialog;v18:=-v18END IF.END PROCauswahlanbieten;BOOL PROCja(TEXT CONSTy18,r11):ja(y18,r11,TRUE)END PROCja;BOOL PROCja(TEXT CONSTy18,r11,BOOL CONSTz18):INT VARwahl;IFz18THENwahl:=1ELSEwahl:=2END IF;REPstatusanzeigen(f18);IFt4THENcursor(1,ysize);INT CONSTa19:=min(length(y18),xsize-16);outsubtext(y18,1,a19);out(""5"")ELSEp18;outsubtext(y18,1,m18-4);END IF;out(d18);y15;b19END REP;FALSE.b19:c19;a17(d19,e19,wahl);IFwahl=1THEN LEAVEjaWITH TRUE ELIFwahl=2THEN LEAVEjaWITH FALSE ELIFwahl=-32000THENwahl:=1ELIFwahl=0THENerrorstop("")ELSEhilfeanbieten(r11,s9);neuerdialog;wahl:=-wahlEND IF.c19:INT VARe19;IFt4THENw16:=ysize;x16:=0;e19:=a19+4ELSEw16:=l18+j18+1;x16:=0;y16:=1;z16:=1;e19:=k18+1END IF.d19:c3(link(q3(2), +"WAHL.Ja")).END PROCja;PROCeditget(TEXT CONSTr5,TEXT VARh8,TEXT CONSTf19,r11):TEXT VARw10;g19;IFt4THENcursor(1,ysize);out(""5"");put(r5);ELSEdialog(r5);cursor(k18+1,l18+j18+1)END IF;editget(h8,1000,h19,"","?hq"+f19,w10);cursor(1,1);IFw10=b18THENhilfeanbieten(r11,s9);neuerdialog;editget(r5,h8,f19,r11)ELIFw10=a11ORw10=c18THENerrorstop(r0)ELIFlength(w10)=2THENh8:=w10+h8END IF.g19:IFpos(f19,"z")>0THENstatusanzeigen(h18)ELSEstatusanzeigen(g18)END IF.h19:IFt4THENxsize-length(r5)-2ELSEm18-4END IF.END PROCeditget;PROCfehlerausgeben:TEXT CONSTg1:=errormessage;IFerrorcode=1THENpage;bildschirmneuEND IF;clearerror;y15;IFg1<>r0THENstatusanzeigen(i18);i19;j19;neuerdialogEND IF.i19:p18;out(j3);out(">>> ");cursor(k18+1,l18+j18+1);outsubtext(errormessage,1,m18-2).j19:TEXT VARh8;cursor(1,1);getchar(h8);IFh8=k3THENk19END IF.k19:getchar(h8);IFh8="?"THENhilfeanbieten("FEHLER/"+text(errorcode),s9)ELIFh8=""1""THENeschopausfuehrenEND IF.END PROCfehlerausgeben;PROCy15:WHILEgetcharety<>r0REP END REP END PROCy15 +;LETl19=3,m19=12,n19=14,o19=1070,p19=1068,q19=1069,r19=0,s19=2;ROWl19DATASPACE VARw2;ROWl19THESAURUS VARq3;BOOL VARt19:=FALSE;INITFLAG VARu19;PROCp2:IF NOTinitialized(u19)THENv19END IF.v19:BOOL VARp7:=t19;w19;IFp7THENx19ELSEmenueloeschen(FALSE)END IF.w19:INT VARy19;FORy19FROM1UPTOl19WHILEp7REPz19END REP.z19:INT VARa20,b20;FORb20FROM1UPTO10REPforget(w2(y19));w2(y19):=nilspace;pingpong(father,o19+y19,w2(y19),a20);IFa20=r19THEN LEAVEz19ELIFa20<>s19THENpause(15)END IF UNTILa20=s19END REP;forget(w2(y19));w2(y19):=nilspace;p7:=FALSE.END PROCp2;THESAURUS PROCmenuenamen(INT CONSTy19):p2;IFy19<0THENe14.b14(-y19)ELSEq3(y19)END IF END PROCmenuenamen;PROCmenueloeschen(TEXT CONSTname,INT CONSTy19):p2;IFy19<0THENc20(name,e14.b14(-y19))ELSEc20(name,q3(y19))END IF END PROCmenueloeschen;PROCc20(TEXT CONSTname,THESAURUS VARt10):INT CONSTindex:=link(t10,name);IFindex>0THENdelete(t10,index)END IF END PROCc20;PROCmenueloeschen(BOOL CONSTd20):INT VARy19;u19:=TRUE;j14:=d20;FORy19FROM1UPTOl19REPforget(w2(y19) +);w2(y19):=nilspace;q3(y19):=emptythesaurusEND REP;x19END PROCmenueloeschen;PROCx19:e14:=w2(1);c3:=w2(2);b11:=w2(3)END PROCx19;LETe20= +#732#"Datei wird von anderer Task geaendert.",f20= +#733#"Auftrag nur fuer Soehne erlaubt"; +THESAURUS VARg20:=emptythesaurus;ROW200TASK VARh20;TEXT VARi20;BOUND STRUCT(TEXTname,j20,k20)VARl20;PROCmenuemanager(DATASPACE VARm20,INT CONSTn20,o20,TASK CONSTp20):enablestop;t19:=TRUE;IFn20>=p19ANDn20<=o19+l19THENq20ELSE IFn20=m19ORn20=n19THENr20END IF;freemanager(m20,n20,o20,p20)END IF.q20:IFn20=p19THENs20ELIFn20=q19THENt20ELSEu20END IF.s20:l20:=m20;v20(l20.name,p20);send(p20,r19,m20).t20:l20:=m20;w20(l20.name);send(p20,r19,m20).r20:IFo20=1THENx20ELIFn20=n19THENw20(i20)END IF.x20:l20:=m20;i20:=l20.name;IFy20THENerrorstop(e20)END IF.y20:INT VARx13:=link(g20,i20);x13>0CAND NOT(h20(x13)=p20).u20:IFp20<myselfTHENp2;forget(m20);m20:=w2(n20-o19);send(p20,r19,m20)ELSEerrorstop(f20)END IF.END PROCmenuemanager;PROCv20(TEXT CONSTo2,TASK CONSTz20):INT VARy5:=link(g20,o2);IFy5=0THENinsert(g20,o2,y5);a21;h20(y5):=z20ELIFexists(h20(y5))THEN IF NOT(h20(y5)=z20)THENerrorstop(e20)END IF ELSEh20(y5):=z20END IF.a21:IFy5=0THENb21;insert(g20,o2,y5)END IF.b21:TEXT VARc21;y5:=0;REPget(g20,c21,y5);IFy5=0 +THEN LEAVEb21END IF;IF NOTexists(c21)OR NOTexists(h20(y5))THENdelete(g20,y5)END IF END REP.END PROCv20;PROCw20(TEXT CONSTo2):INT VARy5;delete(g20,o2,y5)END PROCw20;PROCglobalmanager:globalmanager(PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST)menuemanager)END PROCglobalmanager;PROClock(TEXT CONSTo2,TASK CONSTd21):call(p19,o2,d21)END PROClock;PROCfree(TEXT CONSTo2,TASK CONSTd21):call(q19,o2,d21)END PROCfree;END PACKETeudasmenues; + diff --git a/app/eudas/5.3/src/pos.173 b/app/eudas/5.3/src/pos.173 new file mode 100644 index 0000000..a9706a3 --- /dev/null +++ b/app/eudas/5.3/src/pos.173 @@ -0,0 +1,19 @@ +PACKET xpos DEFINES x pos : +INT PROC x pos (TEXT CONST a, b, INT CONST c, d) : + pos (a, b, c, d) +END PROC x pos; +END PACKET x pos; +PACKET pos 173 DEFINES pos: +INT PROC pos (TEXT CONST a, b, INT CONST c, d) : + x pos (a, b, c, d+1) +END PROC pos; +END PACKET pos 173; +PACKET add 173 DEFINES split line, reserve : +PROC split line (FILE VAR f, INT CONST spalte, BOOL CONST dummy) : + split line (f, spalte) +END PROC split line; +PROC reserve (TEXT CONST modus, TASK CONST task) : + call (19, modus, task) +END PROC reserve; +END PACKET add 173; + |