1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
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;
|
