diff options
Diffstat (limited to 'app/schulis-mathematiksystem')
55 files changed, 1244 insertions, 0 deletions
diff --git a/app/schulis-mathematiksystem/1.0/source-disk b/app/schulis-mathematiksystem/1.0/source-disk new file mode 100644 index 0000000..64e5484 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/source-disk @@ -0,0 +1 @@ +schulis-mathematiksystem-1.0/04_mathematiksystem.img diff --git a/app/schulis-mathematiksystem/1.0/src/PAC element row b/app/schulis-mathematiksystem/1.0/src/PAC element row new file mode 100644 index 0000000..574160c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC element row @@ -0,0 +1,3 @@ +PACKETelementrowDEFINES ELEMROW,:=,clear,length,insert,delete,append,remove,define,recall,field,pos,sup,inf,min,max,MIN,MAX,EXC,:LETminelement=1,maxelement=1000;LETminfield=1,maxfield=4;TYPE ELEMROW=STRUCT(INTused,ROWmaxelementROWmaxfieldINTf);OP:=(ELEMROW VARd,ELEMROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCclear(ELEMROW VARt):t.used:=0;END PROCclear;INT PROClength(ELEMROW CONSTt):t.usedEND PROClength;PROCinsert(ELEMROW VARt,INT CONSTk):insert(t,k,0,0,0,0);END PROCinsert;PROCinsert(ELEMROW VARt,INT CONSTk,INT CONSTa,b,c,d):checkelement(k," bei 'insert'");checkfilled(t.used," bei 'insert'");INT VARi:=t.used;WHILEi>=kREPt.f[i+1]:=t.f[i];iDECR1PER;t.usedINCR1;t.f[k][1]:=a;t.f[k][2]:=b;t.f[k][3]:=c;t.f[k][4]:=d;END PROCinsert;PROCdelete(ELEMROW VARt,INT CONSTk):IFk<minelementORk>t.usedTHEN LEAVEdeleteFI;INT VARi:=k;WHILEi<t.usedREPt.f[i]:=t.f[i+1];iINCR1PER;t.usedDECR1;END PROCdelete;PROCdelete(ELEMROW VARt,INT CONSTk,INT VARa,b,c,d):IFk<minelementORk>t.usedTHEN LEAVEdeleteFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];INT VARi:=k;WHILEi<t.usedREPt.f[i]:=t.f[i+1];iINCR1PER;t.usedDECR1;END PROCdelete;PROCappend(ELEMROW VARt):append(t,0,0,0,0);END PROCappend;PROCappend(ELEMROW VARt,INT CONSTa,b,c,d):checkfilled(t.used," bei 'append'");t.usedINCR1;t.f[t.used][1]:=a;t.f[t.used][2]:=b;t.f[t.used][3]:=c;t.f[t.used][4]:=d;END PROCappend;PROCremove(ELEMROW VARt):checkempty(t.used," bei 'remove'");t.usedDECR1;END PROCremove;PROCremove(ELEMROW VARt,INT VARa,b,c,d):checkempty(t.used," bei 'remove'");a:=t.f[t.used][1];b:=t.f[t.used][2];c:=t.f[t.used][3];d:=t.f[t.used][4];t.usedDECR1;END PROCremove;PROCdefine(ELEMROW VARt,INT CONSTk,INT CONSTa,b,c,d):checkelement(k," bei 'define'");WHILEt.used<kREPappend(t)PER;t.f[k][1]:=a;t.f[k][2]:=b;t.f[k][3]:=c;t.f[k][4]:=d;END PROCdefine;PROCrecall(ELEMROW CONSTt,INT CONSTk,INT VARa,b,c,d):IFk<minelementORk>t.usedTHENa:=0;b:=0;c:=0;d:=0;LEAVErecallFI;a:=t.f[k][1];b:=t.f[k][2];c:=t.f[k][3];d:=t.f[k][4];END PROCrecall;PROCfield(ELEMROW VARt,INT CONSTk,n,INT CONSTv):checkelement(k," bei 'field'");checkfield(n," bei 'field'");WHILEt.used<kREPappend(t)PER;t.f[k][n]:=v;END PROCfield;INT PROCfield(ELEMROW CONSTt,INT CONSTk,n):IFk<minelementORk>t.usedORn<minfieldORn>maxfieldTHEN LEAVEfieldWITH0;FI;t.f[k][n]END PROCfield;PROCcheckempty(INT CONSTu,TEXT CONSTmsg):IFu<minelementTHENerrorstop("Element-Anzahl = "+text(u)+" < "+text(minelement)+msg)FI;END PROCcheckempty;PROCcheckfilled(INT CONSTu,TEXT CONSTmsg):IFu>=maxelementTHENerrorstop("Element-Anzahl = "+text(u)+" >= "+text(maxelement)+msg)FI;END PROCcheckfilled;PROCcheckelement(INT CONSTn,TEXT CONSTmsg):IFn<minelementTHENerrorstop("Element-Nummer = "+text(n)+" < "+text(minelement)+msg)FI;IFn>maxelementTHENerrorstop("Element-Nummer = "+text(n)+" > "+text(maxelement)+msg)FI;END PROCcheckelement;PROCcheckfield(INT CONSTn,TEXT CONSTmsg):IFn<minfieldTHENerrorstop("Feld-Nummer = "+text(n)+" < "+text(minfield)+msg)FI;IFn>maxfieldTHENerrorstop("Feld-Nummer = "+text(n)+" > "+text(maxfield)+msg)FI;END PROCcheckfield;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d):pos(t,a,b,c,d,1)END PROCpos;INT PROCpos(ELEMROW CONSTt,INT CONSTa,b,c,d,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]=aANDt.f[p][2]=bANDt.f[p][3]=cANDt.f[p][4]=dTHEN LEAVEposWITHp;FI;pINCR1;PER;0END PROCpos;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp):sup(t,xp,yp,xp,yp,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxp,yp,INT CONSTbeg):sup(t,xp,yp,xp,yp,beg)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):sup(t,xb,yb,xe,ye,1)END PROCsup;INT PROCsup(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTbeg):INT VARp:=1MAXbegMINt.used+1;WHILEp<=t.usedREP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt.f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEsupWITHp;FI;pINCR1;PER;0END PROCsup;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye):inf(t,xb,yb,xe,ye,t.used)END PROCinf;INT PROCinf(ELEMROW CONSTt,INT CONSTxb,yb,xe,ye,INT CONSTend):INT VARp:=0MAXendMINt.used;WHILEp>=1REP IFt.f[p][1]<=xbANDt.f[p][2]<=ybANDt. +f[p][3]>=xeANDt.f[p][4]>=yeTHEN LEAVEinfWITHp;FI;pDECR1;PER;0END PROCinf;PROCmin(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);min(t,q,xb,yb,xe,ye);END PROCmin;PROCmin(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEminFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMAXxb;yb:=ylMAXyb;xe:=xhMINxe;ye:=yhMINye;END PROCmin;PROCmax(ELEMROW CONSTt,INT CONSTp,q,INT VARxb,yb,xe,ye):recall(t,p,xb,yb,xe,ye);max(t,q,xb,yb,xe,ye);END PROCmax;PROCmax(ELEMROW CONSTt,INT CONSTp,INT VARxb,yb,xe,ye):IFp<1ORp>t.usedTHEN LEAVEmaxFI;INT VARxl,yl,xh,yh;recall(t,p,xl,yl,xh,yh);xb:=xlMINxb;yb:=ylMINyb;xe:=xhMAXxe;ye:=yhMAXye;END PROCmax;INT OP MIN(INT CONSTa,b):IFa<bTHENaELSEbFI END OP MIN;INT OP MAX(INT CONSTa,b):IFa>bTHENaELSEbFI END OP MAX;OP EXC(INT VARa,b):INT CONSTd:=a;a:=b;b:=d;END OP EXC;END PACKETelementrow; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer new file mode 100644 index 0000000..84d90c5 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC formula analyzer @@ -0,0 +1,9 @@ +PACKETformulaanalyzerDEFINESclearformulaspaces,opindex,regenerateformula,arithnotation,printnotation,formulacomplexity,removeformulaobj,appendformulaobj,insertformulaobj,insertformulapars,createformulaobj,adjoinformulaobj,adjoinformulapars,getformulaposition,formulaposition,getformulanode,formulanode,getformulaterm,defformulaterm,formulaterm,getformulapos,defformulapos,formulabeg,formulaend,formulaindex,getformulaaddress,defformulaaddress,formulaaddress,getformulatree,defformulatree,expand,compress,getformulabox,defformulabox,getformulaobject,defformulaobject,getformulalength,getformula,writeformula,clearformula,outformula,out,:LETnilidx=0;INT VARnillbp,nilrbp;TEXT VARnilari;LETatomidx=1;INT VARatomlbp,atomrbp;TEXT VARatomari;LETtimesidx=2;INT VARtimeslbp,timesrbp;TEXT VARtimesari;LETapplyidx=3;INT VARapplylbp,applyrbp;TEXT VARapplyari;LETifidx=4;INT VARiflbp,ifrbp;TEXT VARifari;LETfiidx=5;INT VARfilbp,firbp;TEXT VARfiari;LETthenidx=6;INT VARthenlbp,thenrbp;TEXT VARthenari;LETelif1idx=7;INT VARelif1lbp,elif1rbp;TEXT VARelif1ari;LETelif2idx=8;INT VARelif2lbp,elif2rbp;TEXT VARelif2ari;LETelif3idx=9;INT VARelif3lbp,elif3rbp;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;INT VARlforcelbp,lforcerbp;TEXT VARlforceari;LETrforceidx=12;INT VARrforcelbp,rforcerbp;TEXT VARrforceari;LETlparidx=15;INT VARlparlbp,lparrbp;LETrparidx=16;INT VARrparlbp,rparrbp;LETinfixnpm=2;LETxmin=1,ymin=1,xmax=400,ymax=400,xsiz=400,ysiz=400;LET MEM=STRUCT(INTnodr,nodc,adrc,sp,ELEMROWstk,TEXTROWtrm,ELEMROWobj,ELEMROWadr,tre,alg,del,box);LET SCR=STRUCT(INTxbeg,ybeg,xend,yend,ROWysizTEXTrec);TEXT VARari:="",prt:="";INT VARanum:=0,alen:=0;BOOL VARariok,prtok,analyzeok;INITFLAG VARspacesok:=FALSE;DATASPACE VARmemds;BOUND MEM VARmem;DATASPACE VARscrds;BOUND SCR VARscr;INT VARdummy;TEXT VARemptyrec:=xsiz*" ";TEXT VARrec;PROCclearformulaspaces:disablestop;IFinitialized(spacesok)THENforget(memds);forget(scrds)FI;spacesok:=FALSE;END PROCclearformulaspaces;PROCinitformulaspaces:disablestop;IFinitialized(spacesok)THEN LEAVEinitformulaspacesFI;spacesok:=FALSE;enablestop;forget(memds);memds:=nilspace;mem:=memds;forget(scrds);scrds:=nilspace;scr:=scrds;ari:="";anum:=0;alen:=0;ariok:=FALSE;prt:="";prtok:=FALSE;mem.trm:=emptytextrow;clear(mem.obj);define(mem.obj,1,1,0,0,0);mem.nodr:=0;mem.nodc:=0;mem.adrc:=0;clear(mem.stk);mem.sp:=0;clear(mem.adr);clear(mem.tre);clear(mem.alg);clear(mem.del);clear(mem.box);scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;analyzeok:=TRUE;spacesok:=TRUE;initops;END PROCinitformulaspaces;PROCgetfixedops:getoppower(nilidx,nillbp,nilrbp);nilari:=oparithsymbol(nilidx);getoppower(atomidx,atomlbp,atomrbp);atomari:=oparithsymbol(atomidx);getoppower(timesidx,timeslbp,timesrbp);timesari:=oparithsymbol(timesidx);getoppower(applyidx,applylbp,applyrbp);applyari:=oparithsymbol(applyidx);getoppower(ifidx,iflbp,ifrbp);ifari:=oparithsymbol(ifidx);getoppower(fiidx,filbp,firbp);fiari:=oparithsymbol(fiidx);getoppower(thenidx,thenlbp,thenrbp);thenari:=oparithsymbol(thenidx);getoppower(elif1idx,elif1lbp,elif1rbp);elif1ari:=oparithsymbol(elif1idx);getoppower(elif2idx,elif2lbp,elif2rbp);elif2ari:=oparithsymbol(elif2idx);getoppower(elif3idx,elif3lbp,elif3rbp);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);getoppower(lforceidx,lforcelbp,lforcerbp);lforceari:=oparithsymbol(lforceidx);getoppower(rforceidx,rforcelbp,rforcerbp);rforceari:=oparithsymbol(rforceidx);getoppower(lparidx,lparlbp,lparrbp);getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;INT PROCopindex(TEXT CONSTamid,BOOL CONSTlft,rgt):INT VARidx:=opindex(amid);WHILEidx>atomidxAND(lftANDrgtANDopparams(idx)<>2OR NOTlftANDrgtANDoplbp(idx)<>lparlbpANDoplbp(idx)<>prefixlbpORlftAND NOTrgtANDoprbp(idx)<>rparrbpANDoprbp(idx)<>postfixrbp)REPidx:=opindex(amid,idx+1);PER;idxEND PROCopindex;PROCregenerateformula(INT VARnodc,adrc):initformulaspaces;mem.nodc:=nodc;mem.adrc:=adrc;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith( +ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;analyzeformula;nodc:=mem.nodc;adrc:=mem.adrc;END PROCregenerateformula;PROCarithnotation(TEXT CONSTnewari):enablestop;initformulaspaces;IFariokANDnewari=ariTHEN LEAVEarithnotationFI;ariok:=TRUE;prtok:=FALSE;analyzeok:=FALSE;ari:=newari;alen:=LENGTHari;analyzeformula;END PROCarithnotation;TEXT PROCarithnotation:enablestop;IFariokTHEN LEAVEarithnotationWITHariFI;initformulaspaces;analyzeformula;TEXT CONSToldari:=ari;ariok:=FALSE;ari:="";anum:=0;alen:=0;IFmem.nodr>0THENcatarith(ari,anum,alen,mem.nodr,FALSE,FALSE)FI;ariok:=TRUE;IFari<>oldariTHENprtok:=FALSE;analyzeok:=FALSE FI;ariEND PROCarithnotation;TEXT PROCarithnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARari:="";INT VARanum:=0;alen:=0;IFnod1>0THENcatarith(ari,anum,alen,nod1,FALSE,FALSE)FI;ariEND PROCarithnotation;TEXT PROCprintnotation:enablestop;IFprtokTHEN LEAVEprintnotationWITHprtFI;initformulaspaces;analyzeformula;prtok:=FALSE;prt:="";IFmem.nodr>0THENcatprint(prt,mem.nodr)FI;prtok:=TRUE;prtEND PROCprintnotation;TEXT PROCprintnotation(INT CONSTnod1):enablestop;initformulaspaces;analyzeformula;TEXT VARprt:="";IFnod1>0THENcatprint(prt,nod1)FI;prtEND PROCprintnotation;INT PROCformulacomplexity:initformulaspaces;mem.nodrEND PROCformulacomplexity;PROCgetformulaposition(INT CONSTapos,INT VARxpoi,ypoi):INT VARnod1,adr1;INT VARabeg,aend,idx;INT VARxdel,ydel;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHENrecall(mem.del,nod1,xpoi,ypoi,xdel,ydel);xpoiINCRapos-abeg;LEAVEgetformulaposition;FI;PER;END PROCgetformulaposition;INT PROCformulaposition(INT CONSTxpoi,ypoi):INT VARnod1,adr1;INT VARxpos,ypos,xdel,ydel;INT VARabeg,aend,idx;initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);adr1:=field(mem.adr,nod1,3);recall(mem.del,nod1,xpos,ypos,xdel,ydel);recall(mem.obj,adr1,abeg,aend,idx,dummy);abegMAXabeg+xpoi-xposMINaendEND PROCformulaposition;INT PROCformulanode(INT CONSTapos):INT VARnod1,adr1;INT VARabeg,aend,idx;initformulaspaces;FORnod1FROM1UPTOmem.nodrREPadr1:=field(mem.adr,nod1,3);recall(mem.obj,adr1,abeg,aend,idx,dummy);IFapos>=abegANDapos<=aendTHEN LEAVEformulanodeWITHnod1;FI;PER;0END PROCformulanode;PROCgetformulanode(INT CONSTapos,INT VARnod1):nod1:=formulanode(apos);END PROCgetformulanode;INT PROCformulanode(INT CONSTxpoi,ypoi):initformulaspaces;sup(mem.box,xpoi,ypoi)END PROCformulanode;PROCgetformulanode(INT CONSTxpoi,ypoi,INT VARnod1):initformulaspaces;nod1:=sup(mem.box,xpoi,ypoi);END PROCgetformulanode;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);END PROCdefformulaterm;PROCdefformulaterm(INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):initformulaspaces;ariok:=FALSE;prtok:=FALSE;rename(mem.trm,adr1,sym);field(mem.obj,adr1,3,idx);END PROCdefformulaterm;TEXT PROCformulaterm(INT CONSTadr1):initformulaspaces;name(mem.trm,adr1)END PROCformulaterm;PROCgetformulaterm(INT CONSTadr1,TEXT VARsym):sym:=formulaterm(adr1);END PROCgetformulaterm;PROCdefformulapos(INT CONSTadr1,INT CONSTabeg,aend,idx,dummy):initformulaspaces;define(mem.obj,adr1,abeg,aend,idx,dummy);END PROCdefformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend,idx,dummy):initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;PROCgetformulapos(INT CONSTadr1,INT VARabeg,aend):INT VARidx;initformulaspaces;recall(mem.obj,adr1,abeg,aend,idx,dummy);END PROCgetformulapos;INT PROCformulabeg(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,1)END PROCformulabeg;INT PROCformulaend(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,2)END PROCformulaend;INT PROCformulaindex(INT CONSTadr1):initformulaspaces;field(mem.obj,adr1,3)END PROCformulaindex;PROCformulaindex(INT CONSTadr1,idx):initformulaspaces;field(mem.obj,adr1,3,idx)END PROCformulaindex;PROCdefformulaaddress(INT CONSTnod1,INT CONSTnod2,nodx,adr1,adr2):initformulaspaces;define( +mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCdefformulaaddress;PROCgetformulaaddress(INT CONSTnod1,INT VARnod2,nodx,adr1,adr2):initformulaspaces;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);END PROCgetformulaaddress;INT PROCformulaaddress(INT CONSTnod1):initformulaspaces;field(mem.adr,nod1,3)END PROCformulaaddress;PROCdefformulatree(INT CONSTnod1,INT CONSTlnod,rnod,pnod,inod):initformulaspaces;define(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCdefformulatree;PROCgetformulatree(INT CONSTnod1,INT VARlnod,rnod,pnod,inod):initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);END PROCgetformulatree;PROCexpand(INT VARlnod,rnod):INT VARnod1;initformulaspaces;REPnod1:=lnod;lnod:=field(mem.tre,nod1,1)UNTILlnod=0PER;lnod:=nod1;REPnod1:=rnod;rnod:=field(mem.tre,nod1,2)UNTILrnod=0PER;rnod:=nod1;END PROCexpand;PROCcompress(INT VARlnod,rnod):expand(rnod,lnod);END PROCcompress;PROCdefformulabox(INT CONSTnod1,INT CONSTxbeg,ybeg,xend,yend):initformulaspaces;define(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCdefformulabox;PROCgetformulabox(INT CONSTnod1,INT VARxbeg,ybeg,xend,yend):initformulaspaces;recall(mem.box,nod1,xbeg,ybeg,xend,yend);END PROCgetformulabox;PROCdefformulaobject(INT CONSTnod1,INT CONSTxobj,yobj,xdel,ydel):initformulaspaces;define(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCdefformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj,xdel,ydel):initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCgetformulaobject(INT CONSTnod1,INT VARxobj,yobj):INT VARxdel,ydel;initformulaspaces;recall(mem.del,nod1,xobj,yobj,xdel,ydel);END PROCgetformulaobject;PROCcatarith(TEXT VARari,INT VARadrc,alen,INT CONSTnod1,BOOL CONSTforce,forcepending):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARladr,radr;INT VARoidx,rbp,lbp;INT VARlidx,llbp,lrbp;INT VARridx,rlbp,rrbp;TEXT VARlsym,rsym;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);oidx:=field(mem.obj,adr1,3);IFnodx=2THENcatterm2;catarith(ari,adrc,alen,lnod,FALSE,FALSE);catterm1;ELIFnod1<>nod2THENrnod:=field(mem.tre,nod2,1);catterm1;catarith(ari,adrc,alen,rnod,FALSE,FALSE);catterm2;ELSE IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,lforceari);FI;getoppower(oidx,lbp,rbp);IFlnod>0THENcatleftparamFI;catterm1;IFrnod>0THENcatrightparamFI;IFforceAND(lnod>0ORrnod>0)THENcatarith(ari,adrc,alen,rforceari);FI;FI;.catterm1:catarith(ari,adrc,alen,name(mem.trm,adr1));IFnod1=mem.nodcTHENmem.adrc:=adrcFI;.catterm2:catarith(ari,adrc,alen,name(mem.trm,adr2));IFnod2=mem.nodcTHENmem.adrc:=adrcFI;.catleftparam:ladr:=field(mem.adr,lnod,4);lidx:=field(mem.obj,ladr,3);lsym:=name(mem.trm,ladr);getoppower(lidx,llbp,lrbp);IFlrbp=postfixrbpTHENlrbp:=llbpFI;IFoplforce(oidx)=0ANDopoforce(lidx)=0THENcatarith(ari,adrc,alen,lnod,FALSE,forcependingORlrbp<lbp);ELIFforcependingORlrbp<lbpTHENcatarith(ari,adrc,alen,lnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,lnod,FALSE,FALSE);FI;.catrightparam:radr:=field(mem.adr,rnod,3);ridx:=field(mem.obj,radr,3);rsym:=name(mem.trm,radr);getoppower(ridx,rlbp,rrbp);IFrlbp=prefixlbpTHENrlbp:=rrbpFI;IFoprforce(oidx)=0ANDopoforce(ridx)=0THENcatarith(ari,adrc,alen,rnod,FALSE,forcependingORrbp>rlbp);ELIFforcependingORrbp>rlbpTHENcatarith(ari,adrc,alen,rnod,TRUE,FALSE);ELSEcatarith(ari,adrc,alen,rnod,FALSE,FALSE);FI;.END PROCcatarith;PROCcatarith(TEXT VARari,INT VARadrc,alen,TEXT CONSTsym):IFsym=nilariTHEN LEAVEcatarithFI;IFpos(ari,delimiter,alen,alen)<>alenTHENariCATdelimiterFI;ariCATsym;adrcINCR1;alen:=LENGTHari;END PROCcatarith;PROCcatprint(TEXT VARprt,INT CONSTnod1):INT VARlnod,rnod,pnod,inod;INT VARadr1;INT VARoidx;TEXT VARplft,pmid,prgt;IFnod1<=0THEN LEAVEcatprintFI;initformulaspaces;recall(mem.tre,nod1,lnod,rnod,pnod,inod);adr1:=field(mem.adr,nod1,3);oidx:=field(mem.obj,adr1,3);IFoidx<=atomidxTHENplft:="";pmid:=name(mem.trm,adr1);prgt:="";ELSEgetopprintsymbols(oidx,plft,pmid,prgt);FI;prtCATplft;IFopparamexc(oidx)=0THENcatprint(prt,lnod);prtCATpmid;catprint(prt,rnod);ELSEcatprint(prt,rnod);prt +CATpmid;catprint(prt,lnod);FI;prtCATprgt;END PROCcatprint;PROCremoveformulaobj(INT CONSTnod1):INT VARnod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.adr,nod1,nod2,nodx,adr1,adr2);define(mem.adr,nod1,nod1,1,adr1,adr1);define(mem.adr,nod2,nod2,1,adr2,adr2);rename(mem.trm,adr1,"");IFlnod=0THENsnod:=rnod;ELIFrnod=0THENsnod:=lnod;ELSE LEAVEremoveformulaobj;FI;IFpnod>0THENfield(mem.tre,pnod,inod,snod);FI;IFsnod>0THENfield(mem.tre,snod,3,pnod);field(mem.tre,snod,4,inod);FI;END PROCremoveformulaobj;PROCappendformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTpnod,inod,INT VARnod1):INT VARlnod,rnod;initformulaspaces;SELECTinodOF CASE1:rnod:=0;lnod:=field(mem.tre,pnod,1);CASE2:lnod:=0;rnod:=field(mem.tre,pnod,2);OTHERWISElnod:=0;rnod:=0;END SELECT;insertformulaobj(sym,idx,lnod,rnod,pnod,inod,nod1);END PROCappendformulaobj;PROCinsertformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,pnod,inod,INT VARnod1):initformulaspaces;analyzeformula;ariok:=FALSE;prtok:=FALSE;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,pnod,inod);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;IFpnod>0THENfield(mem.tre,pnod,inod,nod1)ELSEmem.nodr:=nod1FI;END PROCinsertformulaobj;PROCinsertformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,pnod,inod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);insertformulaobj(sym1,idx1,0,nod2,pnod,inod,nod1);END PROCinsertformulapars;PROCcreateformulaobj(TEXT CONSTsym,INT CONSTidx,INT VARnod1):adjoinformulaobj(sym,idx,0,0,nod1);END PROCcreateformulaobj;PROCadjoinformulaobj(TEXT CONSTsym,INT CONSTidx,INT CONSTlnod,rnod,INT VARnod1):initformulaspaces;analyzeformula;INT VARadr1;insert(mem.trm,sym);append(mem.obj,0,-1,idx,0);adr1:=length(mem.obj);append(mem.tre,lnod,rnod,0,0);nod1:=length(mem.tre);append(mem.adr,nod1,1,adr1,adr1);IFlnod>0THENfield(mem.tre,lnod,3,nod1);field(mem.tre,lnod,4,1)FI;IFrnod>0THENfield(mem.tre,rnod,3,nod1);field(mem.tre,rnod,4,2)FI;END PROCadjoinformulaobj;PROCadjoinformulapars(TEXT CONSTsym1,sym2,INT CONSTidx1,idx2,INT CONSTsnod,INT VARnod1,nod2):adjoinformulaobj(sym2,idx2,snod,0,nod2);adjoinformulaobj(sym1,idx1,0,nod2,nod1);END PROCadjoinformulapars;PROCputobjectontostack(INT VARnod1,INT CONSTadr1,TEXT CONSTsym,INT CONSTidx):INT VARlbp,rbp;getoppower(idx,lbp,rbp);getparamsfromstack(nod1,lbp);INT VARadr2;insert(mem.trm,sym,adr2);INT CONSTapos:=field(mem.obj,adr1,1)-1;define(mem.obj,adr2,apos,apos,idx,0);mem.spINCR1;define(mem.stk,mem.sp,nod1,adr2,idx,rbp);END PROCputobjectontostack;PROCgetparamsfromstack(INT VARnod1,INT CONSTlbp):INT VARstacknod,stackadr,stackidx,stackrbp;WHILEmem.sp>0REPrecall(mem.stk,mem.sp,stacknod,stackadr,stackidx,stackrbp);IFstackrbp<lbpTHEN LEAVEgetparamsfromstackFI;mem.spDECR1;IFstackidx<>lforceidxANDstackidx<>rforceidxTHENnod1INCR1;define(mem.adr,nod1,nod1,1,stackadr,stackadr);IFstackadr=mem.adrcTHENmem.nodc:=nod1FI;FI;PER;END PROCgetparamsfromstack;PROCfindprefixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindprefixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILlbp=prefixlbpPER;END PROCfindprefixop;PROCfindpostfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindpostfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILrbp=postfixrbpPER;END PROCfindpostfixop;PROCfindinfixop(TEXT CONSTsym,INT VARidx,npm,lbp,rbp):REPidx:=opindex(sym,idx+1);IFidx<=atomidxTHENidx:=opindex(sym);getopparams(idx,npm);getoppower(idx,lbp,rbp);LEAVEfindinfixop;FI;getopparams(idx,npm);getoppower(idx,lbp,rbp);UNTILnpm=infixnpmPER;END PROCfindinfixop +;PROCanalyzeformula:INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod;INT VARabeg,aend;INT VARstackidx,stackrbp;INT VARlastidx,lastnpm,lastlbp,lastrbp;INT VARnextidx,nextnpm,nextlbp,nextrbp;TEXT VARsym;INT VARtlen;INT VARxfb,yfb,xfe,yfe;INT VARpxp,pyp,pxd,pyd;INT VARoxb,oyb,oxe,oye,oxp,oyp,oxd,oyd;INT VARlxb,lyb,lxe,lye,lxp,lyp,lxa,lya,lxd,lyd;INT VARrxb,ryb,rxe,rye,rxp,ryp,rxa,rya,rxd,ryd;INT VARoxc,oyc;IFanalyzeokTHEN LEAVEanalyzeformulaFI;getfixedops;splitari;computerpn;computetre;computealgdelandbox;computescr;analyzeok:=TRUE;.splitari:mem.trm:=emptytextrow;clear(mem.obj);aend:=0;REPabeg:=aend+1;aend:=pos(ari,delimiter,abeg);IFaend>abegTHENsym:=subtext(ari,abeg,aend-1);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,aend-1,nextidx,0);FI;UNTILaend=0PER;IFabeg<=alenTHENsym:=subtext(ari,abeg,alen);insert(mem.trm,sym);nextidx:=opindex(sym)MAXatomidx;append(mem.obj,abeg,alen,nextidx,0);FI;.computerpn:clear(mem.adr);nod1:=0;clear(mem.stk);mem.sp:=0;lastidx:=nilidx;lastnpm:=0;lastlbp:=nillbp;lastrbp:=nilrbp;FORadr1FROM1UPTOlength(mem.obj)REPprocessobject;lastidx:=nextidx;lastnpm:=nextnpm;lastlbp:=nextlbp;lastrbp:=nextrbp;PER;nextidx:=nilidx;getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);mem.nodr:=nod1;.processobject:nextidx:=field(mem.obj,adr1,3);getoppower(nextidx,nextlbp,nextrbp);getopparams(nextidx,nextnpm);insertmissingobject;getparamsfromstack(nod1,nextlbp);IFnextidx=rforceidxTHEN IFfield(mem.stk,mem.sp,3)=lforceidxTHENfield(mem.stk,mem.sp,4,rforcerbp)FI;ELIFnextlbp=rparlbpTHENnod1INCR1;define(mem.adr,nod1,nod1,1,adr1,adr1);IFadr1=mem.adrcTHENmem.nodc:=nod1FI;IFfield(mem.stk,mem.sp,4)=lparrbpTHENfield(mem.stk,mem.sp,4,rparrbp)FI;ELSEmem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);FI;.insertmissingobject:IFnextidx=fiidxTHEN IFlastnpm=infixnpmORlastlbp=prefixlbpTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif3ari,elif3idx);ELIFlastidx=elif1idxTHEN IFnextidx=elif1idxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;putobjectontostack(nod1,adr1,elif2ari,elif2idx);IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastidx=atomidxORlastrbp=rparrbpORlastidx=rforceidxTHEN IFnextidx=atomidxORnextidx=lforceidxTHENputobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENputobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastrbp=postfixrbpTHEN IFnextidx=atomidxORnextidx=lforceidxTHENinfixlast;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=prefixlbpTHENinfixlast;infixnext;putobjectontostack(nod1,adr1,timesari,timesidx);ELIFnextlbp=lparlbpTHENinfixlast;putobjectontostack(nod1,adr1,applyari,applyidx);FI;ELIFlastnpm=infixnpmTHEN IFnextnpm=infixnpmTHENprefixnext;postfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENpostfixlast;putobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=prefixlbpTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpORnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;ELIFlastlbp=lparlbpORlastidx=lforceidxORlastidx=nilidxTHEN IFnextnpm=infixnpmTHENprefixnext;putobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=postfixrbpTHENputobjectontostack(nod1,adr1,atomari,atomidx);ELIFnextrbp=rparrbpORnextidx=rforceidxORnextidx=nilidxTHENputobjectontostack(nod1,adr1,atomari,atomidx);FI;FI;.prefixnext:findprefixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextlbp=prefixlbpTHENfield(mem. +obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixnext:findinfixop(name(mem.trm,adr1),nextidx,nextnpm,nextlbp,nextrbp);IFnextnpm=infixnpmTHENfield(mem.obj,adr1,3,nextidx);LEAVEinsertmissingobject;FI;.infixlast:findinfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastnpm=infixnpmTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.postfixlast:findpostfixop(name(mem.trm,adr1-1),lastidx,lastnpm,lastlbp,lastrbp);IFlastrbp=postfixrbpTHENfield(mem.stk,mem.sp,3,lastidx);field(mem.stk,mem.sp,4,lastrbp);field(mem.obj,adr1-1,3,lastidx);LEAVEinsertmissingobject;FI;.computetre:clear(mem.tre);define(mem.tre,mem.nodr,0,0,0,0);clear(mem.stk);mem.sp:=0;FORnod1FROM1UPTOlength(mem.adr)REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);field(mem.adr,nod1,2,1);nextidx:=field(mem.obj,adr1,3);getopparams(nextidx,nextnpm);getoppower(nextidx,nextlbp,nextrbp);WHILEnextnpm>0REPrecall(mem.stk,mem.sp,nod2,adr2,stackidx,stackrbp);mem.spDECR1;IFstackrbp=rparrbpANDnextlbp=lparlbpTHENdefine(mem.adr,nod2,nod1,2,adr2,adr1);define(mem.adr,nod1,nod2,1,adr1,adr2);FI;field(mem.tre,nod2,3,nod1);IFnextnpm>1ORnextlbp=lparlbpORnextlbp=prefixlbpTHENfield(mem.tre,nod1,2,nod2);field(mem.tre,nod2,4,2);ELSEfield(mem.tre,nod1,1,nod2);field(mem.tre,nod2,4,1);FI;nextnpmDECR1;PER;mem.spINCR1;define(mem.stk,mem.sp,nod1,adr1,nextidx,nextrbp);PER;.computealgdelandbox:clear(mem.alg);define(mem.alg,mem.nodr,0,0,0,0);clear(mem.del);define(mem.del,mem.nodr,0,0,0,0);clear(mem.box);define(mem.box,mem.nodr,0,0,0,0);FORnod1FROM1UPTOmem.nodrREPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);sym:=name(mem.trm,adr1);tlen:=LENGTHsym;recall(mem.obj,adr1,abeg,aend,nextidx,dummy);oxb:=0;oyb:=0;oxe:=0;oye:=0;lxd:=0;lyd:=0;rxd:=0;ryd:=0;getopalignment(nextidx,lxa,lya,rxa,rya);getopposition(nextidx,lxp,lyp,rxp,ryp);IFnextidx<=atomidxTHEN IFtlen>0THENoxe:=tlen;ELSEoxe:=LENGTHopscreensymbol(nextidx);FI;rxp:=oxe+1;getopframe(nextidx,xfb,yfb,xfe,yfe);ELSEoxe:=LENGTHopscreensymbol(nextidx);getopframe(nextidx,xfb,yfb,xfe,yfe);FI;IFlnod>0THENdefine(mem.alg,lnod,lxa,lya,lxp,lyp);recall(mem.box,lnod,lxb,lyb,lxe,lye);align(lxa,lxp,lxb,lxe,lxd);align(lya,lyp,lyb,lye,lyd);define(mem.del,lnod,0,0,lxd,lyd);oxb:=oxbMINlxb;oyb:=oybMINlyb;oxe:=oxeMAXlxe;oye:=oyeMAXlye;FI;IFlnod>0ANDrnod>0THEN IFrxa>=4THEN IFrxp>0THENrxpINCRoxeELIFrxp<0THENrxpINCRoxbFI FI;IFrya>=4THEN IFryp>0THENrypINCRoyeELIFryp<0THENrypINCRoybFI FI;FI;IFrnod>0THENdefine(mem.alg,rnod,rxa,rya,rxp,ryp);recall(mem.box,rnod,rxb,ryb,rxe,rye);align(rxa,rxp,rxb,rxe,rxd);align(rya,ryp,ryb,rye,ryd);define(mem.del,rnod,0,0,rxd,ryd);oxb:=oxbMINrxb;oyb:=oybMINryb;oxe:=oxeMAXrxe;oye:=oyeMAXrye;FI;oxbINCRxfb;oybINCRyfb;oxeINCRxfe;oyeINCRyfe;define(mem.box,nod1,oxb,oyb,oxe,oye);PER;nod1:=mem.nodr;recall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.box,nod1,oxb,oyb,oxe,oye);align(1,2,oxb,oxe,oxd);align(1,1,oyb,oye,oyd);define(mem.del,nod1,oxd,oyd,oxd,oyd);define(mem.box,nod1,oxb,oyb,oxe,oye);FORnod1FROMmem.nodr-1DOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);pnod:=field(mem.tre,nod1,3);recall(mem.del,pnod,pxp,pyp,pxd,pyd);recall(mem.del,nod1,oxp,oyp,oxd,oyd);oxp:=pxp+oxd;oyp:=pyp+oyd;define(mem.del,nod1,oxp,oyp,oxd,oyd);shiftelement(mem.box,nod1,oxp,oyp);PER;.computescr:scr.xbeg:=xmax+1;scr.ybeg:=ymax+1;scr.xend:=xmin-1;scr.yend:=ymin-1;FORnod1FROMmem.nodrDOWNTO1REPrecall(mem.adr,nod1,nod2,nodx,adr1,adr2);recall(mem.tre,nod1,lnod,rnod,pnod,inod);recall(mem.obj,adr1,abeg,aend,nextidx,dummy);recall(mem.box,nod1,oxb,oyb,oxe,oye);recall(mem.del,nod1,oxp,oyp,oxd,oyd);IFscr.ybeg>scr.yendTHENscr.ybeg:=oyb;scr.yend:=oyb-1;FI;WHILEscr.ybeg>oybANDscr.ybeg>yminREPscr.ybegDECR1;scr.rec[scr.ybeg]:=emptyrecPER;WHILEscr.yend<oyeANDscr.yend<ymaxREPscr.yendINCR1;scr.rec[scr.yend]:=emptyrecPER;scr.xbeg:=scr.xbegMINoxb;scr.xend:=scr.xendMAXoxe;IFoyb>=yminANDoye<=ymaxTHEN IFnextidx<=atomidxTHENsym:=name(mem.trm,adr1);IFsym=""THENsym:=opscreensymbol(nextidx)FI +;replace(scr.rec[oyp],oxp,sym);ELSEgetopposition(nextidx,lxp,lyp,rxp,ryp);getopalignment(nextidx,lxa,lya,rxa,rya);sym:=opscreensymbol(nextidx);IFsym=""THEN ELIFlxa=2ANDlya=3ANDrxa=2ANDrya=1THENoxc:=oxb;WHILEoxc<oxeREPreplace(scr.rec[oyp],oxc,symSUB1);oxcINCR1PER;ELIFlxa=3ANDlya=3ANDrxa=1ANDrya=0THENoxc:=oxb;oyc:=oyp;WHILEoxc<oxpREPreplace(scr.rec[oyc],oxc,symSUB1);oxcINCR1PER;oyc:=oye;WHILEoyc>oybREPreplace(scr.rec[oyc],oxc,symSUB2);oycDECR1PER;WHILEoxc<oxeREPreplace(scr.rec[oyc],oxc,symSUB3);oxcINCR1PER;ELIFnod2<>nod1THENoyc:=oyb;WHILEoyc<=oyeREPreplace(scr.rec[oyc],oxp,sym);oycINCR1PER;ELSEreplace(scr.rec[oyp],oxp,sym);FI;FI;FI;PER;.END PROCanalyzeformula;PROCshiftelement(ELEMROW VARlist,INT CONSTnod1,INT CONSTxdel,ydel):INT VARxbeg,ybeg,xend,yend;recall(list,nod1,xbeg,ybeg,xend,yend);xbegINCRxdel;ybegINCRydel;xendINCRxdel;yendINCRydel;define(list,nod1,xbeg,ybeg,xend,yend);END PROCshiftelement;PROCalign(INT CONSTali,pos,INT VARbeg,end,INT VARdel):SELECTaliAND3OF CASE0:del:=0;CASE1:del:=beg;CASE2:del:=beg+end;IFdel<0THENdelDECR1FI;del:=delDIV2;CASE3:del:=end;OTHERWISEerrorstop("unzulässige Alignment-Kennung : "+text(ali));END SELECT;del:=pos-del;begINCRdel;endINCRdel;END PROCalign;PROCgetformulalength(INT VARxbeg,ybeg,xend,yend):initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;END PROCgetformulalength;PROCgetformula(INT VARxbeg,ybeg,xend,yend,ROWymaxTEXT VARrec):INT VARypoi;initformulaspaces;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPrec[ypoi]:=subtext(scr.rec[ypoi],xbeg,xend)PER;END PROCgetformula;PROCwriteformula(FILE VARf):INT VARypoi;initformulaspaces;output(f);IFcol(f)<=16000THENline(f)FI;INT VARxbeg,ybeg,xend,yend;xbeg:=scr.xbeg;ybeg:=scr.ybeg;xend:=scr.xend;yend:=scr.yend;FORypoiFROMybegUPTOyendREPputline(f,subtext(scr.rec[ypoi],xbeg,xend))PER;END PROCwriteformula;PROCclearformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEclearformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEclearformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPclearformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;clearformula(xbeg,xend,ypoi,xoff,yoff);END PROCclearformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff);END PROCoutformula;PROCclearformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENout(xbeg+xoff,ypoi+yoff,subtext(emptyrec,xbeg,xend));FI;END PROCclearformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,INT CONSTxoff,yoff):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENout(xbeg+xoff,ypoi+yoff,subtext(scr.rec[ypoi],xbeg,xend));FI;FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,INT CONSTxoff,yoff,TEXT CONSTframe):IFxbeg>xendORxbeg>xmaxORxend<xminTHEN LEAVEoutformulaFI;IFybeg>yendORybeg>ymaxORyend<yminTHEN LEAVEoutformulaFI;INT VARypoi:=ybeg;IFybeg<yendTHENoutformula(xbeg,xend,ypoi,xoff,yoff,frame,1);ypoiINCR1;WHILEypoi<yendREPoutformula(xbeg,xend,ypoi,xoff,yoff,frame,4);ypoiINCR1;PER;outformula(xbeg,xend,ypoi,xoff,yoff,frame,7);ELSEoutformula(xbeg,xend,ypoi,xoff,yoff,frame,10);FI;END PROCoutformula;PROCoutformula(INT CONSTxbeg,xend,ypoi,xoff,yoff,TEXT CONSTframe,INT CONSTfp):IFypoi>=yminANDypoi<=ymaxTHENinitformulaspaces;IFypoi>=scr.ybegANDypoi<=scr.yendTHENrec:=scr.rec[ypoi];ELSErec:=emptyrec;FI;replace(rec,xbeg,xend," ",frameSUBfp+1);replace(rec,xend,frameSUBfp+2);replace(rec,xbeg,frameSUBfp);out(xbeg+xoff,ypoi+yoff,subtext(rec,xbeg,xend));FI;END PROCoutformula;PROCreplace(TEXT VARrec,INT CONSTb,e,TEXT CONSTold,new):INT CONSTl:=LENGTHold;IFl<>LENGTHnewTHEN LEAVEreplaceFI;INT VARp:=pos(rec,old,b,e);WHILEp>0REPreplace(rec,p,new);p:=pos(rec,old,p+l,e)PER;END PROCreplace;PROCout(INT CONSTxcur,ycur, +TEXT CONSTrec):cursor(xcur,ycur);out(rec);END PROCout;PROCcatexpr(TEXT VARrec,INT CONSTadrb,adr1,adr2,adre):INT VARadr;initformulaspaces;IFadr1=adr2THENrecCAT" ";FORadrFROMadrbUPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";ELSErecCAT" ";FORadrFROMadrbUPTOadr2REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr2+1UPTOadr1-1REPrecCATname(mem.trm,adr)PER;recCAT" ";FORadrFROMadr1UPTOadreREPrecCATname(mem.trm,adr)PER;recCAT" ";FI;END PROCcatexpr;END PACKETformulaanalyzer; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung new file mode 100644 index 0000000..dae28a7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC formula editor-anpassung @@ -0,0 +1,12 @@ +PACKETformulaeditorDEFINESresetformulaeditor,outformula,showformula,editformula,defformeditwindow,getformeditwindow,defformeditoffset,getformeditoffset,defformeditshift,getformeditshift,defformeditcursor,getformeditcursor,defformeditpointer,getformeditpointer,moveformeditpointer,defformeditexitkeys,getformeditexitkeys,formeditexitkey,defformeditbuffer,getformeditbuffer,formeditbuffer,defformeditarith,getformeditarith,formeditarith,defformediterror,getformediterror,formediterror,defformeditbeep,getformeditbeep,formeditbeep,defformeditrubin,getformeditrubin,formeditrubin,defformeditlearn,getformeditlearn,formeditlearn,defformeditkeys,getformeditkeys,formeditkeys,defformeditmark,getformeditmark,formeditmark,displayformeditbuffer,clearformeditbuffer,displayformeditarith,clearformeditarith,displayformediterror,clearformediterror,displayformeditrubin,clearformeditrubin,displayformeditlearn,clearformeditlearn,:LETnilidx=0;TEXT VARnilari;LETatomidx=1;TEXT VARatomari,atomscr;LETtimesidx=2;TEXT VARtimesari,timesscr;LETapplyidx=3;TEXT VARapplyari,applyscr;LETifidx=4;TEXT VARifari;LETfiidx=5;TEXT VARfiari;LETthenidx=6;TEXT VARthenari;LETelif1idx=7;TEXT VARelif1ari;LETelif2idx=8;TEXT VARelif2ari;LETelif3idx=9;TEXT VARelif3ari;LETmonadidx=10;INT VARprefixlbp,postfixrbp;LETlforceidx=11;TEXT VARlforceari;LETrforceidx=12;TEXT VARrforceari;LETbegdifidx=13;TEXT VARbegdifari;LETenddifidx=14;TEXT VARenddifari;LETlparidx=15;INT VARlparlbp,lparrbp;TEXT VARlparari;LETrparidx=16;INT VARrparlbp,rparrbp;TEXT VARrparari;INT VARpointermode;INT VARnodc,adrc;INT VARnod1,nod2,nodx,adr1,adr2;INT VARlnod,rnod,pnod,inod,snod;INT VARidx;TEXT VARltrm,rtrm;TEXT VARtrm;INT VARtpos,tlen;INT VARapos,abeg,aend;INT VARpbeg,pend;INT VARxobj,yobj,xbeg,ybeg,xend,yend;INT VARxpoi,ypoi,xmin,ymin,xmax,ymax;INT VARxoff,yoff;INT VARxcur,ycur,xlow,ylow,xhig,yhig;INT VARxrel,yrel;INT VARdummy;BOOL VARbufferon;BOOL VARarithon;BOOL VARerroron;BOOL VARbeepon;BOOL VARrubinon;BOOL VARlearnon;BOOL VARkeyson;BOOL VARmarkon;INT VARxbuffer,ybuffer,lbuffer;INT VARxarith,yarith,larith;INT VARxerror,yerror,lerror;INT VARxrubin,yrubin;INT VARxlearn,ylearn;INT VARxkeys,ykeys;INT VARdspxmin,dspymin,dspxmax,dspymax;INT VARdspxbeg,dspybeg,dspxend,dspyend;TEXT VARdspbuffer,clrbuffer;TEXT VARdsparith,clrarith;TEXT VARdsperror,clrerror;TEXT VARdsprubin,clrrubin;TEXT VARdsplearn,clrlearn;TEXT VARdspkeys,clrkeys;TEXT VARdspmark,clrmark;resetformulaeditor;TEXT VARbuffer:="";BOOL VARwriteenabled;BOOL VARquiteditor;BOOL VARnewdisplay,regenerate;BOOL VARlearnmode:=FALSE;BOOL VARrubinmode:=FALSE;INT VARheadpos;TEXT VARlearnedkeys:="";TEXT VARrec;TEXT VARexitkey:="";BOOL VARwashop,wasesc;TEXT VARstdkeys:="",hopkeys:="",esckeys:="";LETkeys="����� +��
�� bpdg()[]{}|<>=^_/*�BPIWDA;!";LEThopkey=1;LETrightkey=2;LETupkey=3;LETleftkey=4;LETtabkey=5;LETdownkey=6;LETrubinkey=7;LETruboutkey=8;LETreturnkey=9;LETesckey=11;LETbkey=13;LETpkey=14;LETdkey=15;LETgkey=16;LETlparkey=17;LETrparkey=18;LETlbrakey=19;LETrbrakey=20;LETlcmtkey=21;LETrcmtkey=22;LETabskey=23;LETlesskey=24;LETgreaterkey=25;LETequalskey=26;LETcircumflexkey=27;LETunderlinekey=28;LETslashkey=29;LETstarkey=30;LETrootkey=31;LETcapbkey=32;LETcappkey=33;LETcapikey=34;LETcapwkey=35;LETcapdkey=36;LETcapakey=37;LETsemicolonkey=38;LETexclamationkey=39;PROCgetfixedops:nilari:=oparithsymbol(nilidx);atomari:=oparithsymbol(atomidx);atomscr:=opscreensymbol(atomidx);timesari:=oparithsymbol(timesidx);timesscr:=opscreensymbol(timesidx);applyari:=oparithsymbol(applyidx);applyscr:=opscreensymbol(applyidx);ifari:=oparithsymbol(ifidx);fiari:=oparithsymbol(fiidx);thenari:=oparithsymbol(thenidx);elif1ari:=oparithsymbol(elif1idx);elif2ari:=oparithsymbol(elif2idx);elif3ari:=oparithsymbol(elif3idx);getoppower(monadidx,prefixlbp,postfixrbp);lforceari:=oparithsymbol(lforceidx);rforceari:=oparithsymbol(rforceidx);begdifari:=oparithsymbol(begdifidx);enddifari:=oparithsymbol(enddifidx);lparari:=oparithsymbol(lparidx);getoppower(lparidx,lparlbp,lparrbp);rparari:=oparithsymbol(rparidx) +;getoppower(rparidx,rparlbp,rparrbp);END PROCgetfixedops;PROCshowformula:editformula(FALSE);END PROCshowformula;PROCeditformula:editformula(TRUE);END PROCeditformula;PROCeditformula(BOOL CONSTwriteaccess):enablestop;dspxmin:=xlow-xoff;dspymin:=ylow-yoff;dspxmax:=xhig-xoff;dspymax:=yhig-yoff;getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;IFesckeys=""THENclearformula;outformula;LEAVEeditformula;FI;writeenabled:=writeaccess;quiteditor:=esckeys="";newdisplay:=TRUE;pointermode:=pointermodeMAX2;xrel:=0;yrel:=0;getfixedops;REPcomputepointers;displayformeditarith;IFnewdisplayTHENnewdisplay:=FALSE;clearformula;outformula;headpos:=xkeys;displayformeditbuffer;IFrubinmodeTHENdisplayformeditrubinFI;IFlearnmodeTHENdisplayformeditlearnFI;FI;processstdkey;IFregenerateTHENregenerate:=FALSE;out("�");regenerateformula(nodc,adrc);getformulalength(xmin,ymin,xmax,ymax);xminDECR1;xmaxINCR1;nod1:=nodc;adr1:=adrc;FI;UNTILquiteditorPER;out("�");.computepointers:REP SELECTpointermodeOF CASE4:computenodcfromadrc;CASE3:computepoifromnodc;CASE2:computenod1frompoi;CASE1:computetrefromnod1;OTHERWISE LEAVEcomputepointers;END SELECT;PER;.computenodcfromadrc:FORnodcFROMformulacomplexityDOWNTO1REP UNTILformulaaddress(nodc)=adrcPER;pointermode:=3;.computepoifromnodc:nod1:=nodc;adr1:=adrc;IFnod1>0THENgetformulaobject(nod1,xobj,yobj);xobjINCRxrel;xrel:=0;yobjINCRyrel;yrel:=0;ELIFadr1>0THENxobj:=xmax;yobj:=ymax;ELSExobj:=xmin;yobj:=ymin;FI;defformeditpointer(xobj,yobj);pointermode:=2;.computenod1frompoi:nod1:=formulanode(xpoi,ypoi);pointermode:=1;.computetrefromnod1:getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);getformulapos(adr1,abeg,aend,idx,dummy);getformulaterm(adr1,trm);tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;SELECTnodxOF CASE1:getformulabox(nod1,xbeg,ybeg,xend,yend);aend:=formulaend(adr2);apos:=abegMAXabeg+xpoi-xobjMINaend+1;CASE2:getformulabox(nod2,xbeg,ybeg,xend,yend);abeg:=formulabeg(adr2);apos:=abegMAXaend+xpoi-xobjMINaend+1;OTHERWISExbeg:=0;ybeg:=0;xend:=0;yend:=0;abeg:=0;aend:=0;apos:=0;END SELECT;pbeg:=abeg;pend:=aend;getformulatree(nod1,lnod,rnod,pnod,inod);nodc:=nod1;adrc:=adr1;pointermode:=0;.END PROCeditformula;PROCclearformula:clearformula(dspxminMAXxlow-xoff,dspyminMAXylow-yoff,dspxmaxMINxhig-xoff,dspymaxMINyhig-yoff,xoff,yoff);dspxmin:=xhig-xoff;dspymin:=yhig-yoff;dspxmax:=xlow-xoff;dspymax:=ylow-yoff;END PROCclearformula;PROCoutformula:outformula(xminMAXxlow-xoff,yminMAXylow-yoff,xmaxMINxhig-xoff,ymaxMINyhig-yoff,xoff,yoff);dspxmin:=xmin;dspymin:=ymin;dspxmax:=xmax;dspymax:=ymax;dspxbeg:=0;END PROCoutformula;PROCoutformula(INT CONSTxbeg,ybeg,xend,yend,TEXT CONSTframe):outformula(xbegMAXxlow-xoff,ybegMAXylow-yoff,xendMINxhig-xoff,yendMINyhig-yoff,xoff,yoff,frame);END PROCoutformula;PROCgetkey:IFxbeg<>dspxbegORybeg<>dspybegORxend<>dspxendORyend<>dspyendTHEN IFmarkonANDdspxbeg>0THENoutformula(dspxbeg-1,dspybeg,dspxend,dspyend,clrmark);FI;IFmarkonTHENoutformula(xbeg-1,ybeg,xend,yend,dspmark);FI;cursor(80,1);out("");dspxbeg:=xbeg;dspybeg:=ybeg;dspxend:=xend;dspyend:=yend;FI;cursor(xcur,ycur);getchar(exitkey);IFlearnmodeTHENlearnedkeysCATexitkeyFI;END PROCgetkey;PROCprocessstdkey:getkey;displaykey(exitkey);processkey;clearkey(exitkey);.processkey:IFpos(stdkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhopkey;CASEleftkey:processleft;CASErightkey:processright;CASEupkey:processup;CASEdownkey:processdown;CASEtabkey:processtab;CASErubinkey:processrubin;CASEruboutkey:processrubout;CASEesckey:processesckey;OTHERWISE:processother;END SELECT;.processleft:xmove(-1);.processright:xmove(+1);.processup:ymove(-1);.processdown:ymove(+1);.processtab:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processrubin:IFrubinonTHENrubinmode:=NOTrubinmode;IFrubinmodeTHEN +displayformeditrubinELSEclearformeditrubinFI;FI;.processrubout:deletechar;.processother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocessstdkey;PROCprocesshopkey:washop:=TRUE;displaykey("HOP");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("HOP");exitkey:="�"+exitkey;washop:=FALSE;.processkey:IFpos(hopkeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processhophop;CASEleftkey:processhopleft;CASErightkey:processhopright;CASEupkey:processhopup;CASEdownkey:processhopdown;CASEruboutkey:processhoprubout;CASEtabkey:CASEreturnkey:CASEesckey:processhopesc;CASElparkey:processhoplpar;CASErparkey:processhoprpar;CASElbrakey:processhoplbra;CASErbrakey:processhoprbra;CASElcmtkey:CASErcmtkey:CASEabskey:CASEcapakey:processhopcapa;CASEcapdkey:processhopcapd;OTHERWISE:processhopother;END SELECT;.processhophop:IFxcur>xlowORycur>ylowTHENxmove(xlow-xcur);ymove(ylow-ycur);ELSExmove(xlow-xhig-1);ymove(ylow-yhig-1);FI;.processhopleft:IFxcur>xlowTHENxmove(xlow-xcur)ELSExmove(xlow-xhig-1)FI;.processhopright:IFxcur<xhigTHENxmove(xhig-xcur)ELSExmove(xhig-xlow+1)FI;.processhopup:IFycur>ylowTHENymove(ylow-ycur)ELSEymove(ylow-yhig-1)FI;.processhopdown:IFycur<yhigTHENymove(yhig-ycur)ELSEymove(yhig-ylow+1)FI;.processhoprubout:IF NOTwriteenabledORnod1<1ORidx>atomidxTHENbeep;LEAVEprocesskeyFI;trm:=subtext(trm,1,tpos-1MINtlen);defformulaterm(adr1,trm);pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;.processhopesc:processesckey;push("�");.processhoplpar:insertpars("(",")",opindex("("),opindex(")"));.processhoprpar:deletepars("(",")");.processhoplbra:insertpars("[","]",opindex("["),opindex("]"));.processhoprbra:deletepars("[","]");.processhopcapa:insertpars(ifari,fiari,ifidx,fiidx);.processhopcapd:insertpars(begdifari,enddifari,begdifidx,enddifidx);.processhopother:IFexitkey<" "THEN IF NOTlearnonORpos(keys,exitkey)>0THENbeep;LEAVEprocesskeyFI;IFtasteenthaeltkommando(exitkey)THENdisablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;ELSEinsertchar(exitkey);FI;.END PROCprocesshopkey;PROCprocessesckey:wasesc:=TRUE;displaykey("ESC");getkey;displaykey(exitkey);processkey;clearkey(exitkey);clearkey("ESC");exitkey:="�"+exitkey;wasesc:=FALSE;.processkey:IFpos(esckeys,exitkey)>0THENquiteditor:=TRUE;LEAVEprocesskeyFI;SELECTpos(keys,exitkey)OF CASEhopkey:processeschop;CASEleftkey:processescleft;CASErightkey:processescright;CASErubinkey:processescrubin;CASEruboutkey:processescrubout;CASEbkey:CASEpkey:processescp;CASEdkey:processescd;CASEgkey:processescg;CASElparkey:processesclpar;CASErparkey:processescrpar;CASElesskey:CASEequalskey:processescequals;CASEgreaterkey:CASEexclamationkey:CASEupkey:processescup;CASEdownkey:CASEcircumflexkey:CASEunderlinekey:CASEslashkey:CASEstarkey:CASErootkey:CASEcapbkey:CASEcappkey:CASEcapikey:CASEcapwkey:CASEcapdkey:processesccapd;CASEcapakey:processesccapa;CASEsemicolonkey:processescsemicolon;OTHERWISE:processescother;END SELECT;.processeschop:IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;learnmode:=NOTlearnmode;IFlearnmodeTHENdisplayformeditlearn;learnedkeys:="";ELSEregenerate:=TRUE;newdisplay:=TRUE;learnedkeys:=subtext(learnedkeys,1,LENGTHlearnedkeys-2);REPgetkey;IFexitkey="�"ORpos(learnedkeys,exitkey)=0OR(exitkey>=" "ANDpos(learnedkeys,"�"+exitkey)=0)THENlernsequenzauftastelegen(exitkey,learnedkeys);clearformeditlearn;LEAVEprocesseschop;FI;out("�");PER;FI;.processescleft:adrc:=adr1;REPadrcDECR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep;LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescright:adrc:=adr1;REPadrcINCR1;idx:=formulaindex(adrc);trm:=formulaterm(adrc);IFidx=nilidxTHENbeep; +LEAVEprocesskeyFI;UNTILidx<>lforceidxANDidx<>rforceidxANDidx<>begdifidxANDidx<>enddifidxANDtrm<>nilariPER;pointermode:=4;.processescup:processesccapp;.processescrubin:processescg;.processescrubout:processescp;.processescp:IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod)FI;buffer:=arithnotation(nod1);displayformeditbuffer;defformulaaddress(nod1,nod1,1,adr1,adr1);defformulatree(nod1,0,0,pnod,inod);defformulaterm(adr1,nilari);nodc:=pnod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescd:IFnod1<1THENbeep;LEAVEprocesskeyFI;IFnodx=2THENnod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);buffer:=arithnotation(nod1);nod1EXCnod2;adr1EXCadr2;getformulatree(nod1,lnod,rnod,pnod,inod);ELSEbuffer:=arithnotation(nod1);FI;displayformeditbuffer;.processescg:IF NOTwriteenabledORnod1<1ORidx>atomidxTHENbeep;LEAVEprocesskeyFI;IFtrm=atomariTHENtrm:=nilari;tpos:=1;tlen:=0FI;change(trm,tpos,tpos-1,delimiter+buffer+delimiter);trm:=lforceari+delimiter+trm+delimiter+rforceari;defformulaterm(adr1,trm);nodc:=nod1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesclpar:push("[");.processescrpar:push("]");.processescequals:insertchar("->");.processesccapp:push("^");.processesccapd:createformulaobj("D",atomidx,lnod);nodc:=lnod;createformulaobj("D",atomidx,rnod);adjoinformulaobj("/",opindex("/"),lnod,rnod,snod);insertformulapars(begdifari,enddifari,begdifidx,enddifidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processesccapa:createformulaobj(atomari,atomidx,lnod);nodc:=lnod;createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(thenari,thenidx,lnod,rnod,snod);insertformulapars(ifari,fiari,ifidx,fiidx,snod,pnod,inod,nod1,nod2);pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.processescsemicolon:INT VARanod,bnod,tnod;IF NOTwriteenabledORnod1<1THENbeep;LEAVEprocesskeyFI;IFidx=ifidxTHEN IFtpos<=1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjINCR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILnod1<>snodANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbeforeelif;ELIFidx=fiidxTHEN IFtpos>1THENbeep;LEAVEprocesskeyFI;xobj:=xpoi;yobj:=ypoi;snod:=nod1;REPxobjDECR1;nod1:=formulanode(xobj,yobj);getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulaterm(adr1,trm);UNTILsnod<>nod1ANDtrm<>""PER;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);WHILEpnod>0ANDidx<>elif2idxANDidx<>elif3idxREPnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod);getformulaaddress(nod1,nod2,nodx,adr1,adr2);idx:=formulaindex(adr1);PER;insertelifbehindelif;ELSEbeep;LEAVEprocesskey;FI;nodc:=anod;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.insertelifbeforeelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,nod1,pnod,inod,tnod);.insertelifbehindelif:createformulaobj(atomari,atomidx,anod);createformulaobj(atomari,atomidx,bnod);adjoinformulaobj(thenari,thenidx,anod,bnod,tnod);SELECTidxOF CASEelif2idx:adjoinformulaobj(elif1ari,elif1idx,tnod,0,snod);insertformulaobj(elif2ari,elif2idx,snod,rnod,nod1,2,tnod);CASEelif3idx:defformulaterm(adr1,elif2ari,elif2idx);insertformulaobj(elif1ari,elif1idx,lnod,0,nod1,1,snod);insertformulaobj(elif3ari,elif3idx,tnod,0,nod1,2,snod);END SELECT;.processescother:IFtasteenthaeltkommando(exitkey)THEN IF NOTlearnonTHENbeep;LEAVEprocesskeyFI;disablestop;out("�");do(kommandoauftaste(exitkey));displayformediterror;clearerror;ELSEpush(lernsequenzauftaste(exitkey));FI;.END PROC +processesckey;PROCdeletechar:IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEdeletecharFI;IFtpos<1THENbeep;LEAVEdeletecharFI;out("�");IFidx=applyidxORidx=timesidxTHENdeletenilop;ELIFtpos<=tlenTHENdeletecharinobject;ELSEdeletespacebehindobject;FI;regenerate:=TRUE;newdisplay:=TRUE;.deletenilop:adr1:=formulaaddress(lnod);idx:=formulaindex(adr1);WHILEidx=lforceidxORidx=rforceidxREPadr1DECR1;idx:=formulaindex(adr1);PER;adr2:=formulaaddress(rnod);idx:=formulaindex(adr2);WHILEidx=lforceidxORidx=rforceidxREPadr2INCR1;idx:=formulaindex(adr2);PER;trm:=formulaterm(adr1);trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);nodc:=lnod;pointermode:=3;.deletecharinobject:change(trm,tpos,tpos,"");tlen:=LENGTHtrm;IFtlen>0THENdefformulaterm(adr1,trm,atomidxMAXopindex(trm));pointermode:=1;ELIFidx<=atomidxTHENdeleteatom;defformulaterm(adr1,trm,atomidx);pointermode:=3;ELSEdeletenilparams;deleteop;defformulaterm(adr1,trm,atomidx);pointermode:=3;FI;.deleteatom:nodc:=pnod;.deletenilparams:getformulatree(nod1,lnod,rnod,pnod,inod);IFlnod>0ANDformulaterm(formulaaddress(lnod))=atomariTHENlnod:=0;FI;IFrnod>0ANDformulaterm(formulaaddress(rnod))=atomariTHENrnod:=0;FI;defformulatree(nod1,lnod,rnod,pnod,inod);.deleteop:removeformulaobj(nod1);IFrnod>0THENnodc:=rnodELIFlnod>0THENnodc:=lnodELSEnodc:=pnodFI;.deletespacebehindobject:adr2:=adr1;idx:=formulaindex(adr2);IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;REPadr2INCR1;idx:=formulaindex(adr2);UNTILidx<>lforceidxANDidx<>rforceidxPER;IFoppforce(idx)>0THENbeep;LEAVEdeletecharFI;trmCATformulaterm(adr2);defformulaterm(adr1,trm,atomidxMAXopindex(trm));defformulaterm(adr2,"",atomidx);pointermode:=1;.END PROCdeletechar;PROCinsertchar(TEXT CONSTsym):INT VARsidx:=opindex(sym)MAXatomidx;INT VARslbp:=oplbp(sidx);INT VARsrbp:=oprbp(sidx);INT VARpidx;IF NOT(writeenabledANDnod1>0AND(washopORypoi=yobj))THENbeep;LEAVEinsertcharFI;out("�");IFidx=timesidxTHENtrm:=timesscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;ELIFidx=applyidxTHENtrm:=applyscr;tlen:=LENGTHtrm;tpos:=0MAXxpoi-xobj+1MINtlen+1;FI;IFidx=atomidxANDtrm=atomariTHENltrm:=nilari;rtrm:=nilari;ELIFrubinmodeOR(idx>atomidxXORsidx>atomidx)THENltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos);ELSEltrm:=subtext(trm,1,tpos-1);rtrm:=subtext(trm,tpos+1);FI;trm:=ltrm;trmCATsym;trmCATrtrm;IF NOTwashopANDidx>atomidxANDtpos>=1ANDtpos<=tlen+1THENreplaceop;FI;IFltrm=nilariTHENinsertbeforeobject;ELIFrtrm=nilariTHENinsertbehindobject;ELSEinsertintoobject;FI;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;.replaceop:IFrubinmodeORtpos=tlen+1THENreplaceopbytrm;ELIFtpos=1THENreplaceopbysym;FI;.replaceopbytrm:IFtrm=lforceariORtrm=rforceariTHEN LEAVEreplaceopbytrmFI;IFopindex(trm,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbytrmFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,trm,opindex(trm,lnod>0,rnod>0));ELSEdefformulaterm(adr1,trm,idx);FI;nodc:=nod1;xrel:=xpoi-xobj+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.replaceopbysym:IFopindex(sym,lnod>0,rnod>0)<=atomidxTHEN LEAVEreplaceopbysymFI;pidx:=formulaindex(formulaaddress(pnod));IFinod=1ANDoplforce(pidx)<>0ORinod=2ANDoprforce(pidx)<>0THENdefformulaterm(adr1,sym,opindex(sym,lnod>0,rnod>0));ELSEdefformulaterm(adr1,sym,idx);FI;nodc:=nod1;xrel:=+1;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;LEAVEinsertchar;.insertbeforeobject:IF NOTwashopANDxpoi>xbegTHENbeep;LEAVEinsertcharFI;pidx:=formulaindex(formulaaddress(pnod));WHILEpidx=enddifidxORpidx=begdifidxORoprforce(sidx)=0ANDinod=1ANDsrbp<oplbp(pidx)ANDoplforce(pidx)=0REPnod1:=pnod;idx:=pidx;getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);pidx:=formulaindex(formulaaddress(pnod));PER;rnod:=nod1;IFrtrm=nilariTHENrtrm:=atomariFI;IFidx<=atomidxTHENinsertbeforeatom;ELIFnodx=2THENinsertbeforerpar;ELIFnod1<>nod2ANDidx<>begdifidxTHENinsertbeforelpar;ELSEinsertbeforeop;FI;. +insertbeforeatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforerpar:beep;LEAVEinsertchar;.insertbeforelpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(applyari,applyidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(applyari,applyidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbeforeop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,lnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;xrel:=+1;ELIFslbp=prefixlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFslbp=lparlbpTHENinsertformulaobj(sym,sidx,0,rnod,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=postfixrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELIFsrbp=rparrbpTHENcreateformulaobj(atomari,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=lnod;ELSEcreateformulaobj(atomari,atomidx,lnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=lnod;FI;.insertbehindobject:IF NOTwashopANDxpoi<xend-1THENbeep;LEAVEinsertcharFI;IFnodx=2THENnod1:=pnod;getformulatree(nod1,lnod,rnod,pnod,inod)FI;pidx:=formulaindex(formulaaddress(pnod));WHILEpidx=enddifidxORpidx=begdifidxORoplforce(sidx)=0ANDinod=2ANDslbp<oprbp(pidx)ANDoprforce(pidx)=0REPnod1:=pnod;idx:=pidx;getformulaaddress(nod1,nod2,nodx,adr1,adr2);getformulatree(nod1,lnod,rnod,pnod,inod);getformulaobject(nod1,xobj,yobj);pidx:=formulaindex(formulaaddress(pnod));PER;lnod:=nod1;IFidx<=atomidxTHENinsertbehindatom;ELIFnodx=2THENinsertbehindrpar;ELIFnod1<>nod2ANDidx<>begdifidxTHENinsertbehindlpar;ELSEinsertbehindop;FI;.insertbehindatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);insertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod; +FI;.insertbehindrpar:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertbehindlpar:beep;LEAVEinsertchar;.insertbehindop:IFsidx<=atomidxTHENcreateformulaobj(sym,atomidx,rnod);insertformulaobj(timesari,timesidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;xrel:=+1;ELIFslbp=prefixlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(atomari,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELIFsrbp=rparrbpTHENinsertformulaobj(sym,sidx,lnod,0,pnod,inod,nod1);nodc:=nod1;xrel:=+1;ELSEcreateformulaobj(atomari,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintoobject:IFidx<=atomidxTHENinsertintoatom;ELIFnodx=2THENinsertintorpar;ELIFnod1<>nod2THENinsertintolpar;ELSEinsertintoop;FI;.insertintoatom:IFsidx<=atomidxTHENdefformulaterm(adr1,trm);nodc:=nod1;xrel:=xpoi-xobj+1;ELIFslbp=prefixlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(timesari,timesidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFslbp=lparlbpTHENcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);adjoinformulaobj(sym,sidx,0,rnod,snod);insertformulaobj(applyari,applyidx,lnod,snod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=postfixrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELIFsrbp=rparrbpTHENcreateformulaobj(ltrm,atomidx,lnod);adjoinformulaobj(sym,sidx,lnod,0,snod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(timesari,timesidx,snod,rnod,pnod,inod,nod1);nodc:=rnod;ELSEcreateformulaobj(ltrm,atomidx,lnod);createformulaobj(rtrm,atomidx,rnod);insertformulaobj(sym,sidx,lnod,rnod,pnod,inod,nod1);nodc:=rnod;FI;.insertintorpar:beep;LEAVEinsertchar;.insertintolpar:beep;LEAVEinsertchar;.insertintoop:beep;LEAVEinsertchar;.END PROCinsertchar;PROCinsertpars(TEXT CONSTlparari,rparari,INT CONSTlparidx,rparidx):IF NOTwriteenabledORnod1<1ORypoi<>yobjTHENbeep;LEAVEinsertparsFI;out("�");snod:=nod1;insertformulapars(lparari,rparari,lparidx,rparidx,snod,pnod,inod,nod1,nod2);nodc:=snod;xrel:=xpoi-xobj;pointermode:=3;regenerate:=TRUE;newdisplay:=TRUE;END PROCinsertpars;PROCdeletepars(TEXT CONSTlparari,rparari):IF NOTwriteenabledORnod1=nod2ORypoi<>yobjTHENbeep;LEAVEdeleteparsFI;out("�");IFnodx=2THENnod1EXCnod2;adr1EXCadr2FI;IF(formulaterm(adr1)<>lparariORformulaterm(adr2)<>rparari)THENbeep;LEAVEdeleteparsFI;removeformulaobj(nod1);removeformulaobj(nod2);IFlnod>0THENnodc:=lnodELIFrnod>0THENnodc:=rnodELSEnodc:=nod1FI;pointermode:=2;regenerate:=TRUE;newdisplay:=TRUE;END PROCdeletepars;PROCdisplayformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(dspbuffer+buffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCdisplayformeditbuffer;PROCclearformeditbuffer:IFbufferonTHENcursor(xbuffer,ybuffer);outtext(clrbuffer,1,lbuffer);cursor(xcur,ycur);FI;END PROCclearformeditbuffer;PROCdisplayformeditarith:IFarithonTHENrec:= +dsparith;recCAT"";INT CONSTxaoff:=LENGTHrec;INT CONSTxabeg:=xarith+xaoff;INT CONSTxasiz:=larith-xaoff;recCATarithnotation;changeall(rec,delimiter," ");cursor(xarith,yarith);outtext(rec,1,larith);IFadr1=0THEN LEAVEdisplayformeditarithFI;IFpbeg-1>=0ANDpbeg-1<xasizTHENcursor(xabeg+pbeg-2,yarith);out(dspmarkSUB10)FI;outsubtext(rec,(1MAXpbeg)+xaoff,(pendMINxasiz-1)+xaoff);IFpend+1>=0ANDpend+1<xasizTHENcursor(xabeg+pend,yarith);out(dspmarkSUB12)FI;IFapos<xasizTHENcursor(xabeg+apos-1,yarith);out(clrmarkSUB12);cursor(xabeg+apos-1,yarith);out(recSUBapos+xaoff);FI;cursor(xarith+larith-1,yarith);out("");FI;END PROCdisplayformeditarith;PROCclearformeditarith:IFarithonTHENrec:=clrarith;cursor(xarith,yarith);outtext(rec,1,larith);FI;END PROCclearformeditarith;PROCdisplayformediterror:TEXT VARpm;IFiserrorANDerrormessage<>""THENbeep;IFerroronTHENpm:=dsperror;pmCATerrormessage;IFerrorline>0THENpmCAT" bei Zeile ";pmCATtext(errorline)FI;pmCAT" ";cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xerror,yerror);pause;cursor(xcur,ycur);FI;FI;END PROCdisplayformediterror;PROCclearformediterror:IFerroronTHEN TEXT VARpm:=clrerror;cursor(xerror,yerror);outsubtext(pm,1,lerror);cursor(xcur,ycur);FI;END PROCclearformediterror;PROCbeep:IFbeeponTHENout("�");FI;END PROCbeep;PROCdisplayformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(dsprubin);cursor(xcur,ycur);FI;END PROCdisplayformeditrubin;PROCclearformeditrubin:IFrubinonTHENcursor(xrubin,yrubin);out(clrrubin);cursor(xcur,ycur);FI;END PROCclearformeditrubin;PROCdisplayformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(dsplearn);cursor(xcur,ycur);FI;END PROCdisplayformeditlearn;PROCclearformeditlearn:IFlearnonTHENcursor(xlearn,ylearn);out(clrlearn);cursor(xcur,ycur);FI;END PROCclearformeditlearn;PROCdisplaykey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENcursor(headpos,ykeys);out("");out(key);out(" ");cursor(xcur,ycur);headposINCR3+LENGTHkey;FI;END PROCdisplaykey;PROCclearkey(TEXT CONSTkey):IFkeysonAND(keySUB1)>=" "THENheadposDECR3+LENGTHkey;cursor(headpos,ykeys);out(" ");LENGTHkeyTIMESOUT" ";out(" ");cursor(xcur,ycur);FI;END PROCclearkey;PROCdefformeditbuffer(INT CONSTxp,yp,xl):xbuffer:=xp;ybuffer:=yp;lbuffer:=xl;END PROCdefformeditbuffer;PROCgetformeditbuffer(INT VARxp,yp,xl):xp:=xbuffer;yp:=ybuffer;xl:=lbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(INT CONSTxp,yp,xl):xarith:=xp;yarith:=yp;larith:=xl;END PROCdefformeditarith;PROCgetformeditarith(INT VARxp,yp,xl):xp:=xarith;yp:=yarith;xl:=larith;END PROCgetformeditarith;PROCdefformediterror(INT CONSTxp,yp,xl):xerror:=xp;yerror:=yp;lerror:=xl;END PROCdefformediterror;PROCgetformediterror(INT VARxp,yp,xl):xp:=xerror;yp:=yerror;xl:=lerror;END PROCgetformediterror;PROCdefformeditrubin(INT CONSTxp,yp):xrubin:=xp;yrubin:=yp;END PROCdefformeditrubin;PROCgetformeditrubin(INT VARxp,yp):xp:=xrubin;yp:=yrubin;END PROCgetformeditrubin;PROCdefformeditlearn(INT CONSTxp,yp):xlearn:=xp;ylearn:=yp;END PROCdefformeditlearn;PROCgetformeditlearn(INT VARxp,yp):xp:=xlearn;yp:=ylearn;END PROCgetformeditlearn;PROCdefformeditkeys(INT CONSTxp,yp):xkeys:=xp;ykeys:=yp;END PROCdefformeditkeys;PROCgetformeditkeys(INT VARxp,yp):xp:=xkeys;yp:=ykeys;END PROCgetformeditkeys;PROCdefformeditbuffer(TEXT CONSTdsp,clr):dspbuffer:=dsp;clrbuffer:=clr;END PROCdefformeditbuffer;PROCgetformeditbuffer(TEXT VARdsp,clr):dsp:=dspbuffer;clr:=clrbuffer;END PROCgetformeditbuffer;PROCdefformeditarith(TEXT CONSTdsp,clr):dsparith:=dsp;clrarith:=clr;END PROCdefformeditarith;PROCgetformeditarith(TEXT VARdsp,clr):dsp:=dsparith;clr:=clrarith;END PROCgetformeditarith;PROCdefformediterror(TEXT CONSTdsp,clr):dsperror:=dsp;clrerror:=clr;END PROCdefformediterror;PROCgetformediterror(TEXT VARdsp,clr):dsp:=dsperror;clr:=clrerror;END PROCgetformediterror;PROCdefformeditkeys(TEXT CONSTdsp,clr):dspkeys:=dsp;clrkeys:=clr;END PROCdefformeditkeys;PROCgetformeditkeys(TEXT VARdsp,clr):dsp:=dspkeys;clr:=clrkeys;END PROCgetformeditkeys;PROCdefformeditrubin(TEXT CONSTdsp,clr):dsprubin:=dsp;clrrubin:=clr;END + PROCdefformeditrubin;PROCgetformeditrubin(TEXT VARdsp,clr):dsp:=dsprubin;clr:=clrrubin;END PROCgetformeditrubin;PROCdefformeditlearn(TEXT CONSTdsp,clr):dsplearn:=dsp;clrlearn:=clr;END PROCdefformeditlearn;PROCgetformeditlearn(TEXT VARdsp,clr):dsp:=dsplearn;clr:=clrlearn;END PROCgetformeditlearn;PROCdefformeditmark(TEXT CONSTdsp,clr):replace(dspmark,1,dsp);replace(clrmark,1,clr);END PROCdefformeditmark;PROCgetformeditmark(TEXT VARdsp,clr):dsp:=dspmark;clr:=clrmark;END PROCgetformeditmark;PROCdefformeditbuffer(BOOL CONSTon):bufferon:=on;END PROCdefformeditbuffer;PROCgetformeditbuffer(BOOL VARon):on:=bufferon;END PROCgetformeditbuffer;BOOL PROCformeditbuffer:bufferonEND PROCformeditbuffer;PROCdefformeditarith(BOOL CONSTon):arithon:=on;END PROCdefformeditarith;PROCgetformeditarith(BOOL VARon):on:=arithon;END PROCgetformeditarith;BOOL PROCformeditarith:arithonEND PROCformeditarith;PROCdefformediterror(BOOL CONSTon):erroron:=on;END PROCdefformediterror;PROCgetformediterror(BOOL VARon):on:=erroron;END PROCgetformediterror;BOOL PROCformediterror:erroronEND PROCformediterror;PROCdefformeditbeep(BOOL CONSTon):beepon:=on;END PROCdefformeditbeep;PROCgetformeditbeep(BOOL VARon):on:=beepon;END PROCgetformeditbeep;BOOL PROCformeditbeep:beeponEND PROCformeditbeep;PROCdefformeditrubin(BOOL CONSTon):rubinon:=on;END PROCdefformeditrubin;PROCgetformeditrubin(BOOL VARon):on:=rubinon;END PROCgetformeditrubin;BOOL PROCformeditrubin:rubinonEND PROCformeditrubin;PROCdefformeditlearn(BOOL CONSTon):learnon:=on;END PROCdefformeditlearn;PROCgetformeditlearn(BOOL VARon):on:=learnon;END PROCgetformeditlearn;BOOL PROCformeditlearn:learnonEND PROCformeditlearn;PROCdefformeditkeys(BOOL CONSTon):keyson:=on;END PROCdefformeditkeys;PROCgetformeditkeys(BOOL VARon):on:=keyson;END PROCgetformeditkeys;BOOL PROCformeditkeys:keysonEND PROCformeditkeys;PROCdefformeditmark(BOOL CONSTon):markon:=on;END PROCdefformeditmark;PROCgetformeditmark(BOOL VARon):on:=markon;END PROCgetformeditmark;BOOL PROCformeditmark:markonEND PROCformeditmark;PROCresetformulaeditor:disablestop;xcur:=1;ycur:=1;xlow:=1;ylow:=1;xhig:=79;yhig:=24;xoff:=0;yoff:=0;xpoi:=1;ypoi:=1;xmin:=1;ymin:=1;xmax:=1;ymax:=1;pointermode:=2;buffer:="";bufferon:=FALSE;xbuffer:=0;ybuffer:=0;lbuffer:=0;arithon:=FALSE;xarith:=0;yarith:=0;larith:=0;erroron:=TRUE;xerror:=0;yerror:=0;lerror:=0;beepon:=TRUE;rubinon:=TRUE;xrubin:=0;yrubin:=0;learnon:=FALSE;xlearn:=0;ylearn:=0;keyson:=FALSE;xkeys:=0;ykeys:=0;markon:=TRUE;dspbuffer:="Puffer : ";clrbuffer:=" ";dsparith:="Formel : ";clrarith:=" ";dsperror:="FEHLER : ";clrerror:=" ";dsprubin:="RUBIN ";clrrubin:=" ";dsplearn:="LEARN ";clrlearn:=" ";dspkeys:="Tasten : ";clrkeys:=" ";dspmark:="+-+| |+-++ +";clrmark:=" ";END PROCresetformulaeditor;PROCdefformeditexitkeys(TEXT CONSTstd,hop,esc):stdkeys:=std;hopkeys:=hop;esckeys:=esc;END PROCdefformeditexitkeys;PROCgetformeditexitkeys(TEXT VARstd,hop,esc):std:=stdkeys;hop:=hopkeys;esc:=esckeys;END PROCgetformeditexitkeys;TEXT PROCformeditexitkey:exitkeyEND PROCformeditexitkey;PROCdefformeditwindow(INT CONSTxl,yl,xh,yh):disablestop;xcurDECRxlow;ycurDECRylow;xoffDECRxlow;yoffDECRylow;xlow:=xl;ylow:=yl;xhig:=xh;yhig:=yh;xoffINCRxlow;yoffINCRylow;xcurINCRxlow;ycurINCRylow;END PROCdefformeditwindow;PROCgetformeditwindow(INT VARxl,yl,xh,yh):xl:=xlow;yl:=ylow;xh:=xhig;yh:=yhig;END PROCgetformeditwindow;PROCdefformeditoffset(INT CONSTxo,yo):disablestop;xcurDECRxoff;ycurDECRyoff;xoff:=xo;yoff:=yo;xcurINCRxoff;ycurINCRyoff;END PROCdefformeditoffset;PROCgetformeditoffset(INT VARxo,yo):xo:=xoff;yo:=yoff;END PROCgetformeditoffset;PROCdefformeditshift(INT CONSTxs,ys):defformeditoffset(xs+xlow-1,ys+ylow-1);END PROCdefformeditshift;PROCgetformeditshift(INT VARxs,ys):xs:=xoff-xlow+1;ys:=yoff-ylow+1;END PROCgetformeditshift;PROCdefformeditcursor(INT CONSTxc,yc):xmove(xc-xcur);ymove(yc-ycur);END PROCdefformeditcursor;PROCgetformeditcursor(INT VARxc,yc):xc:=xcur;yc:=ycur +;END PROCgetformeditcursor;PROCdefformeditpointer(INT CONSTxp,yp):xmove(xp-xpoi);ymove(yp-ypoi);END PROCdefformeditpointer;PROCgetformeditpointer(INT VARxp,yp):xp:=xpoi;yp:=ypoi;END PROCgetformeditpointer;PROCmoveformeditpointer(INT CONSTxd,yd):xmove(xd);ymove(yd);END PROCmoveformeditpointer;PROCxmove(INT CONSTxdel):disablestop;IFxdel<0THENmoveleftELIFxdel>0THENmoverightFI;pointermode:=2;.moveleft:IFxpoi<=xminTHENbeep;LEAVEmoveleftFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi<xminTHENxcurINCRxmin-xpoi;xpoi:=xminFI;IFxcur<xlowTHENxoffINCRxlow-xcur;xcur:=xlow;newdisplay:=TRUE FI;.moveright:IFxpoi>=xmaxTHENbeep;LEAVEmoverightFI;xcurINCRxdel;xpoiINCRxdel;IFxpoi>xmaxTHENxcurINCRxmax-xpoi;xpoi:=xmaxFI;IFxcur>xhigTHENxoffINCRxhig-xcur;xcur:=xhig;newdisplay:=TRUE FI;.END PROCxmove;PROCymove(INT CONSTydel):disablestop;IFydel<0THENmoveupELIFydel>0THENmovedownELSE LEAVEymoveFI;pointermode:=2;.moveup:IFypoi<=yminTHENbeep;LEAVEmoveupFI;ycurINCRydel;ypoiINCRydel;IFypoi<yminTHENycurINCRymin-ypoi;ypoi:=yminFI;IFycur<ylowTHENyoffINCRylow-ycur;ycur:=ylow;newdisplay:=TRUE FI;.movedown:IFypoi>=ymaxTHENbeep;LEAVEmovedownFI;ycurINCRydel;ypoiINCRydel;IFypoi>ymaxTHENycurINCRymax-ypoi;ypoi:=ymaxFI;IFycur>yhigTHENyoffINCRyhig-ycur;ycur:=yhig;newdisplay:=TRUE FI;.END PROCymove;END PACKETformulaeditor; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung new file mode 100644 index 0000000..43ad1db --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC op store-anpassung @@ -0,0 +1,3 @@ +PACKETopstoreDEFINESforgetops,clearops,initops,reorganizeops,loadops,saveops,delimiter,defop,getop,getoppower,oplbp,oprbp,getopforce,oplforce,oprforce,opoforce,oppforce,getopparams,opparams,getopparamexc,opparamexc,getopposition,getopalignment,getopframe,oparithsymbol,opscreensymbol,getopprintsymbols,opindex,definedops,:LETopspacetype=12345;LET OPSTORE=STRUCT(INTused,TEXTdelim,ELEMROWpwr,ELEMROWfrc,ELEMROWpoi,ELEMROWalg,ELEMROWfrm,TEXTROWamid,TEXTROWsmid,TEXTROWplft,pmid,prgt);INITFLAG VARopspaceok:=FALSE;DATASPACE VARopspace;BOUND OPSTORE VARop;INT VARdummy;PROCforgetops:disablestop;IFinitialized(opspaceok)THENforget(opspace)FI;opspaceok:=FALSE;END PROCforgetops;PROCcheckops:disablestop;IFinitialized(opspaceok)THEN LEAVEcheckopsFI;opspaceok:=FALSE;errorstop("Keine Operatoren geladen");END PROCcheckops;PROCclearops:IFinitialized(opspaceok)THENforget(opspace)FI;opspace:=nilspace;op:=opspace;type(opspace,opspacetype);op.used:=0;op.delim:=" ";clear(op.pwr);clear(op.frc);clear(op.poi);clear(op.alg);clear(op.frm);op.amid:=emptytextrow;op.smid:=emptytextrow;op.plft:=emptytextrow;op.pmid:=emptytextrow;op.prgt:=emptytextrow;END PROCclearops;PROCinitops:BOOL VARok;LETstdops="std ops";disablestop;IFinitialized(opspaceok)THEN LEAVEinitopsFI;opspaceok:=FALSE;enablestop;ok:=exists(stdops);IFokTHENloadops(stdops);LEAVEinitops;FI;fetch(stdops,ok);IFokTHENloadops(stdops);forget(stdops,quiet);ELSEclearops;FI;END PROCinitops;PROCfetch(TEXT CONSTdsname,BOOL VARok):accesscatalogue;TASK VARtask:=myself;LETwaitstatus=2,urindex=2;ok:=FALSE;REPtask:=father(task);IFindex(task)<=urindexTHEN LEAVEfetchFI;UNTILstatus(task)=waitstatusCANDexists(dsname,task)PER;fetch(dsname,task);ok:=exists(dsname);END PROCfetch;PROCreorganizeops:enablestop;checkops;disablestop;DATASPACE VARscratchspace:=nilspace;BOUND OPSTORE VARscratch:=scratchspace;scratch:=op;IF NOTiserrorTHENforget(opspace);opspace:=scratchspace;op:=opspace;type(opspace,opspacetype);FI;forget(scratchspace);END PROCreorganizeops;PROCloadops(TEXT CONSTdsname):forgetops;disablestop;opspace:=old(dsname,opspacetype);IFiserrorTHENforgetops;LEAVEloadopsFI;op:=opspace;opspaceok:=TRUE;END PROCloadops;PROCsaveops(TEXT CONSTdsname):enablestop;checkops;disablestop;IFexists(dsname)THENforget(dsname)FI;IF NOTexists(dsname)THENreorganizeops;copy(opspace,dsname)FI;END PROCsaveops;PROCdelimiter(INT CONSTdelim):delimiter(code(delim));END PROCdelimiter;PROCdelimiter(TEXT CONSTdelim):initops;replace(op.delim,1,delim);END PROCdelimiter;TEXT PROCdelimiter:initops;op.delimEND PROCdelimiter;PROCdefop(INT CONSTidx,TEXT CONSTamid,INT CONSTlbp,rbp,npm,exc,lfc,rfc,ofc,pfc,TEXT CONSTsmid,INT CONSTlxp,lyp,rxp,ryp,lxa,lya,rxa,rya,bxf,byf,exf,eyf,TEXT CONSTplft,pmid,prgt):initops;define(op.pwr,idx,lbp,rbp,npm,exc);define(op.frc,idx,lfc,rfc,ofc,pfc);define(op.poi,idx,lxp,lyp,rxp,ryp);define(op.alg,idx,lxa,lya,rxa,rya);define(op.frm,idx,bxf,byf,exf,eyf);WHILEhighestentry(op.amid)<idxREPinsert(op.amid,"")PER;rename(op.amid,idx,amid);WHILEhighestentry(op.smid)<idxREPinsert(op.smid,"")PER;rename(op.smid,idx,smid);WHILEhighestentry(op.plft)<idxREPinsert(op.plft,"")PER;rename(op.plft,idx,plft);WHILEhighestentry(op.pmid)<idxREPinsert(op.pmid,"")PER;rename(op.pmid,idx,pmid);WHILEhighestentry(op.prgt)<idxREPinsert(op.prgt,"")PER;rename(op.prgt,idx,prgt);op.used:=op.usedMAXidx;END PROCdefop;PROCgetop(INT CONSTidx,TEXT VARamid,INT VARlbp,rbp,npm,exc,lfc,rfc,ofc,pfc,TEXT VARsmid,INT VARlxp,lyp,rxp,ryp,lxa,lya,rxa,rya,bxf,byf,exf,eyf,TEXT VARplft,pmid,prgt):checkops;recall(op.pwr,idx,lbp,rbp,npm,exc);recall(op.frc,idx,lfc,rfc,ofc,pfc);recall(op.poi,idx,lxp,lyp,rxp,ryp);recall(op.alg,idx,lxa,lya,rxa,rya);recall(op.frm,idx,bxf,byf,exf,eyf);amid:=name(op.amid,idx);smid:=name(op.smid,idx);plft:=name(op.plft,idx);pmid:=name(op.pmid,idx);prgt:=name(op.prgt,idx);END PROCgetop;PROCgetoppower(INT CONSTidx,INT VARlbp,rbp,npm,exc):checkops;recall(op.pwr,idx,lbp,rbp,npm,exc);END PROCgetoppower;PROCgetoppower(INT CONSTidx,INT VARlbp,rbp):checkops;recall(op. +pwr,idx,lbp,rbp,dummy,dummy);END PROCgetoppower;INT PROCoplbp(INT CONSTidx):checkops;field(op.pwr,idx,1)END PROCoplbp;INT PROCoprbp(INT CONSTidx):checkops;field(op.pwr,idx,2)END PROCoprbp;PROCgetopparams(INT CONSTidx,INT VARnpm):checkops;npm:=field(op.pwr,idx,3);END PROCgetopparams;INT PROCopparams(INT CONSTidx):checkops;field(op.pwr,idx,3)END PROCopparams;PROCgetopparamexc(INT CONSTidx,INT VARexc):checkops;exc:=field(op.pwr,idx,4);END PROCgetopparamexc;INT PROCopparamexc(INT CONSTidx):checkops;field(op.pwr,idx,4)END PROCopparamexc;PROCgetopforce(INT CONSTidx,INT VARlfc,rfc,ofc,pfc):checkops;recall(op.frc,idx,lfc,rfc,ofc,pfc);END PROCgetopforce;PROCgetopforce(INT CONSTidx,INT VARlfc,rfc):checkops;recall(op.frc,idx,lfc,rfc,dummy,dummy);END PROCgetopforce;INT PROCoplforce(INT CONSTidx):checkops;field(op.frc,idx,1)END PROCoplforce;INT PROCoprforce(INT CONSTidx):checkops;field(op.frc,idx,2)END PROCoprforce;INT PROCopoforce(INT CONSTidx):checkops;field(op.frc,idx,3)END PROCopoforce;INT PROCoppforce(INT CONSTidx):checkops;field(op.frc,idx,4)END PROCoppforce;PROCgetopposition(INT CONSTidx,INT VARlxp,lyp,rxp,ryp):checkops;recall(op.poi,idx,lxp,lyp,rxp,ryp);END PROCgetopposition;PROCgetopalignment(INT CONSTidx,INT VARlxa,lya,rxa,rya):checkops;recall(op.alg,idx,lxa,lya,rxa,rya);END PROCgetopalignment;PROCgetopframe(INT CONSTidx,INT VARbxf,byf,exf,eyf):checkops;recall(op.frm,idx,bxf,byf,exf,eyf);END PROCgetopframe;TEXT PROCoparithsymbol(INT CONSTidx):checkops;name(op.amid,idx)END PROCoparithsymbol;TEXT PROCopscreensymbol(INT CONSTidx):checkops;name(op.smid,idx)END PROCopscreensymbol;PROCgetopprintsymbols(INT CONSTidx,TEXT VARplft,pmid,prgt):checkops;plft:=name(op.plft,idx);pmid:=name(op.pmid,idx);prgt:=name(op.prgt,idx);END PROCgetopprintsymbols;INT PROCopindex(TEXT CONSTamid):opindex(amid,1)END PROCopindex;INT PROCopindex(TEXT CONSTamid,INT CONSTb):checkops;link(op.amid,amid,b)END PROCopindex;INT PROCdefinedops:checkops;op.usedEND PROCdefinedops;END PACKETopstore; + diff --git a/app/schulis-mathematiksystem/1.0/src/PAC text row b/app/schulis-mathematiksystem/1.0/src/PAC text row new file mode 100644 index 0000000..8e6b37a --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/PAC text row @@ -0,0 +1,3 @@ +PACKETtextrowDEFINES TEXTROW,emptytextrow,:=,highestentry,firstentry,nextentry,CONTAINS,link,name,rename,insert,delete,get,top,pop,leftmatchinglinks,rightmatchinglinks,LIKE,REV,+,-,/,*,<,<>,>,<=,=,>=,textrow,thesaurus,FILLBY,:LEThex00="�";LEThexff="�";LEThex0000="��";LEThex0001="��";LEThexfeff="��";LEThexffff="��";TEXT VARindexpat:="��ii��";replace(indexpat,2,1);TEXT VARentrypat;TYPE TEXTROW=TEXT;TEXTROW CONSTemptytextrow:=TEXTROW:(indexpat);OP:=(TEXTROW VARd,TEXTROW CONSTs):CONCR(d):=CONCR(s);END OP:=;PROCcatexpanded(TEXT VARt,TEXT CONSTentry):INT CONSTl:=LENGTHentry;INT VARb:=1;INT VARef:=pos(entry,hexff,b);IFef=0THENef:=l+1FI;INT VARe0:=pos(entry,hex00,b);IFe0=0THENe0:=l+1FI;REP IFe0<efTHENtCATsubtext(entry,b,e0-1);tCAThex0001;b:=e0+1;e0:=pos(entry,hex00,b);IFe0=0THENe0:=l+1FI;ELIFef<e0THENtCATsubtext(entry,b,ef-1);tCAThexfeff;b:=ef+1;ef:=pos(entry,hexff,b);IFef=0THENef:=l+1FI;ELSEtCATsubtext(entry,b);LEAVEcatexpanded;FI;PER;END PROCcatexpanded;PROCcatcompressed(TEXT VARt,TEXT CONSTentry):INT CONSTl:=LENGTHentry;INT VARb:=1;INT VARef:=pos(entry,hexfeff,b);IFef=0THENef:=l+1FI;INT VARe0:=pos(entry,hex0001,b);IFe0=0THENe0:=l+1FI;REP IFe0<efTHENtCATsubtext(entry,b,e0-1);tCAThex00;b:=e0+2;e0:=pos(entry,hex0001,b);IFe0=0THENe0:=l+1FI;ELIFef<e0THENtCATsubtext(entry,b,ef-1);tCAThexff;b:=ef+2;ef:=pos(entry,hexfeff,b);IFef=0THENef:=l+1FI;ELSEtCATsubtext(entry,b);LEAVEcatcompressed;FI;PER;END PROCcatcompressed;INT PROChighestentry(TEXTROW CONSTt):INT VARp:=LENGTH CONCR(t)-5;IFp>0THEN(subtext(CONCR(t),p+2,p+3)ISUB1)-1ELSE0FI END PROChighestentry;INT PROCfirstentry(TEXTROW CONSTdir):nextentry(dir,0)END PROCfirstentry;INT PROCnextentry(TEXTROW CONSTdir,INT CONSTstart):INT VARindex:=start;INT CONSTlimit:=highestentry(dir);WHILEindex<=limitREPindexINCR1UNTILname(dir,index)<>""PER;indexEND PROCnextentry;BOOL OP CONTAINS(TEXTROW CONSTt,TEXT CONSTentry):entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;pos(CONCR(t),entrypat,1)>0END OP CONTAINS;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENsubtext(CONCR(t),p-2,p-1)ISUB1ELSE0FI END PROClink;INT PROClink(TEXTROW CONSTt,TEXT CONSTentry,INT CONSTstart):INT VARp,index;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=0;REPp:=pos(CONCR(t),entrypat,p+1);IFp=0THEN LEAVElinkWITH0FI;index:=subtext(CONCR(t),p-2,p-1)ISUB1;UNTILindex>=startPER;indexEND PROClink;TEXT PROCname(TEXTROW CONSTt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);IFb=0THEN LEAVEnameWITH""FI;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe=0THEN LEAVEnameWITH""FI;entrypat:="";catcompressed(entrypat,subtext(CONCR(t),b+6,e-1));entrypatEND PROCname;PROCrename(TEXTROW VARt,TEXT CONSTold,new):INT VARp,len;entrypat:=hexffff;catexpanded(entrypat,old);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENlen:=LENGTHentrypat;entrypat:="";catexpanded(entrypat,new);change(CONCR(t),p+2,p+len-3,entrypat);FI;END PROCrename;PROCrename(TEXTROW VARt,INT CONSTindex,TEXT CONSTnew):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1);replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b+6);IFe>0THENchange(CONCR(t),b+6,e-1,new);FI;END PROCrename;PROCinsert(TEXTROW VARt,TEXT CONSTentry,INT VARindex):index:=subtext(CONCR(t),LENGTH CONCR(t)-3)ISUB1;catexpanded(CONCR(t),entry);replace(indexpat,2,index+1);CONCR(t)CATindexpat;END PROCinsert;PROCinsert(TEXTROW VARt,TEXT CONSTentry):INT VARindex;insert(t,entry,index);END PROCinsert;PROCdelete(TEXTROW VARt,TEXT CONSTentry,INT VARindex):INT VARp;entrypat:=hexffff;catexpanded(entrypat,entry);entrypatCAThex0000;p:=pos(CONCR(t),entrypat,1);IFp>0THENindex:=subtext(CONCR(t),p-2,p-1)ISUB1;change(CONCR(t),p+2,p+len-3,"");ELSEindex:=0;FI;END PROCdelete;PROCdelete(TEXTROW VARt,INT CONSTindex):replace(indexpat,2,index);INT VARb:=pos(CONCR(t),indexpat,1)+6;replace(indexpat,2,index+1);INT VARe:=pos(CONCR(t),indexpat,b); +IFe=0THEN LEAVEdeleteFI;IFindex=highestentry(t)THEN CONCR(t):=subtext(CONCR(t),1,b-1);ELSEchange(CONCR(t),b,e-1,"");FI;END PROCdelete;PROCget(TEXTROW CONSTt,TEXT VARentry,INT VARindex):INT VARb,e;indexINCR1;replace(indexpat,2,index);b:=pos(CONCR(t),indexpat,1);entry:="";REPbINCR6;indexINCR1;replace(indexpat,2,index);e:=pos(CONCR(t),indexpat,b);IFe>bTHENindexDECR1;catcompressed(entry,subtext(CONCR(t),b,e-1));LEAVEget;ELIFe=0THENindex:=0;LEAVEget;FI;PER;END PROCget;TEXT PROCtop(TEXTROW CONSTt):name(t,highestentry(t))END PROCtop;TEXT PROCpop(TEXTROW VARt):pop(t,entrypat);entrypatEND PROCpop;PROCpop(TEXTROW VARt,TEXT VARentry):entry:=top(t);delete(t,highestentry(t));END PROCpop;INT PROCleftmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:=hexffff;catexpanded(entrypat,entry);l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCleftmatchinglinks;INT PROCrightmatchinglinks(TEXTROW CONSTt,TEXT CONSTentry):INT VARp,l,n;entrypat:="";catexpanded(entrypat,entry);entrypatCAThex0000;l:=LENGTHentrypat;n:=0;p:=pos(CONCR(t),entrypat,1);WHILEp>0REPnINCR1;p:=pos(CONCR(t),entrypat,p+l)PER;nEND PROCrightmatchinglinks;TEXTROW OP LIKE(TEXTROW CONSTa,TEXT CONSTpattern):TEXTROW VARlike:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(like,entry)=0AND(entryLIKEpattern)THENinsert(like,entry)FI;PER;likeEND OP LIKE;TEXTROW OP REV(TEXTROW CONSTa):TEXTROW VARrev:=emptytextrow;INT VARindex;FORindexFROMhighestentry(a)DOWNTO1REPinsert(rev,name(a,index));PER;revEND OP REV;TEXTROW OP-(TEXTROW CONSTa):textrow(all)-aEND OP-;TEXTROW OP+(TEXTROW CONSTa,b):TEXTROW VARunion:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(union,entry)=0THENinsert(union,entry)FI;PER;unionEND OP+;TEXTROW OP-(TEXTROW CONSTa,b):TEXTROW VARdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(diff,entry)=0ANDlink(b,entry)=0THENinsert(diff,entry)FI;PER;diffEND OP-;TEXTROW OP/(TEXTROW CONSTa,b):TEXTROW VARinter:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(inter,entry)=0ANDlink(b,entry)>0THENinsert(inter,entry)FI;PER;interEND OP/;TEXTROW OP*(TEXTROW CONSTa,b):TEXTROW VARsdiff:=emptytextrow;TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(sdiff,entry)=0ANDlink(b,entry)=0THENinsert(sdiff,entry)FI;PER;FORindexFROM1UPTOhighestentry(b)REPentry:=name(b,index);IFlink(sdiff,entry)=0ANDlink(a,entry)=0THENinsert(sdiff,entry)FI;PER;sdiffEND OP*;BOOL OP<(TEXTROW CONSTa,b):a<=bAND NOT(b<=a)END OP<;BOOL OP<>(TEXTROW CONSTa,b):NOT(a=b)END OP<>;BOOL OP>(TEXTROW CONSTa,b):b<aEND OP>;BOOL OP<=(TEXTROW CONSTa,b):TEXT VARentry;INT VARindex;FORindexFROM1UPTOhighestentry(a)REPentry:=name(a,index);IFlink(b,entry)=0THEN LEAVE<=WITH FALSE FI;PER;TRUE END OP<=;BOOL OP=(TEXTROW CONSTa,b):a<=bANDb<=aEND OP=;BOOL OP>=(TEXTROW CONSTa,b):b<=aEND OP>=;TEXTROW PROCtextrow(THESAURUS CONSTdir):TEXTROW VARres:=emptytextrow;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCtextrow;THESAURUS PROCthesaurus(TEXTROW CONSTdir):THESAURUS VARres:=emptythesaurus;INT VARindex;FORindexFROM1UPTOhighestentry(dir)REPinsert(res,name(dir,index));PER;resEND PROCthesaurus;OP FILLBY(FILE VARf,TEXTROW CONSTdir):INT VARindex;output(f);FORindexFROM1UPTOhighestentry(dir)REPputline(f,name(dir,index))PER;END OP FILLBY;OP FILLBY(TEXTROW VARdir,FILE VARf):TEXT VARentry;input(f);WHILE NOTeof(f)REPgetline(f,entry);insert(dir,entry)PER;END OP FILLBY;END PACKETtextrow; + diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 Binary files differnew file mode 100644 index 0000000..373245e --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 6*10 diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 Binary files differnew file mode 100644 index 0000000..cdb76cb --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*14 diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 Binary files differnew file mode 100644 index 0000000..49b821a --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*16 diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 Binary files differnew file mode 100644 index 0000000..caff4ba --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*19 diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 Binary files differnew file mode 100644 index 0000000..f37fd1d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 8*8 diff --git a/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 Binary files differnew file mode 100644 index 0000000..46e2f95 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ZEICHEN 9*14 diff --git a/app/schulis-mathematiksystem/1.0/src/ibmoperatoren b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren Binary files differnew file mode 100644 index 0000000..23601d2 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ibmoperatoren diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe new file mode 100644 index 0000000..09a2939 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 1.mathe @@ -0,0 +1,4 @@ +PACKETlsdialog1DEFINESwaagerecht,senkrecht,eckeobenlinks,eckeobenrechts,eckeuntenlinks,eckeuntenrechts,balkenunten,balkenoben,balkenlinks,balkenrechts,kreuz,cursoron,cursoroff,clearbuffer,clearbufferandcount,center,invers,page,pageup,outframe,outmenuframe,eraseframe,stdgraphicchar,ft20graphicchar,ibmgraphicchar,AREA,:=,fill,areax,areay,areaxsize,areaysize,cursor,getcursor,out,outinvers,outwithbeam,outinverswithbeam,erase,eraseinvers,erasewithbeam,writepermanentfootnote,oldfootnote,footnote:TYPE AREA=STRUCT(INTx,y,xsize,ysize);LETblank=" ",markein="",markaus="",cleol="�";TEXT CONSTfehlermeldung:="Unzulässige Größen!";TEXT VAReol:="+",eor:="+",eul:="+",eur:="+",bo:="+",br:="+",bl:="+",bu:="+",waa:="-",sen:="|",kr:="+",cursorsichtbar:="",cursorunsichtbar:="";TEXT VARpermanentefusszeile:="";PROCwritepermanentfootnote(TEXT CONSTt):permanentefusszeile:=t;footnote(t)END PROCwritepermanentfootnote;PROColdfootnote:footnote(permanentefusszeile)END PROColdfootnote;PROCfootnote(TEXT CONSTt):INT VARx,y;getcursor(x,y);cursor(1,24);out(invers(text(t,76)));cursor(x,y)END PROCfootnote;TEXT PROCeckeobenlinks:eolEND PROCeckeobenlinks;TEXT PROCeckeobenrechts:eorEND PROCeckeobenrechts;TEXT PROCeckeuntenlinks:eulEND PROCeckeuntenlinks;TEXT PROCeckeuntenrechts:eurEND PROCeckeuntenrechts;TEXT PROCbalkenoben:boEND PROCbalkenoben;TEXT PROCbalkenlinks:blEND PROCbalkenlinks;TEXT PROCbalkenrechts:brEND PROCbalkenrechts;TEXT PROCbalkenunten:buEND PROCbalkenunten;TEXT PROCwaagerecht:waaEND PROCwaagerecht;TEXT PROCsenkrecht:senEND PROCsenkrecht;TEXT PROCkreuz:krEND PROCkreuz;PROCeckeobenlinks(TEXT CONSTt):eol:=tEND PROCeckeobenlinks;PROCeckeobenrechts(TEXT CONSTt):eor:=tEND PROCeckeobenrechts;PROCeckeuntenlinks(TEXT CONSTt):eul:=tEND PROCeckeuntenlinks;PROCeckeuntenrechts(TEXT CONSTt):eur:=tEND PROCeckeuntenrechts;PROCbalkenoben(TEXT CONSTt):bo:=tEND PROCbalkenoben;PROCbalkenlinks(TEXT CONSTt):bl:=tEND PROCbalkenlinks;PROCbalkenrechts(TEXT CONSTt):br:=tEND PROCbalkenrechts;PROCbalkenunten(TEXT CONSTt):bu:=tEND PROCbalkenunten;PROCwaagerecht(TEXT CONSTt):waa:=tEND PROCwaagerecht;PROCsenkrecht(TEXT CONSTt):sen:=tEND PROCsenkrecht;PROCkreuz(TEXT CONSTt):kr:=tEND PROCkreuz;PROCstdgraphicchar:eckeobenlinks("+");eckeobenrechts("+");eckeuntenlinks("+");eckeuntenrechts("+");balkenoben("+");balkenrechts("+");balkenlinks("+");balkenunten("+");waagerecht("-");senkrecht("|");kreuz("+");cursorsichtbar:="";cursorunsichtbar:=""END PROCstdgraphicchar;PROCft20graphicchar:eckeobenlinks("�R��S");eckeobenrechts("�RD�S");eckeuntenlinks("�RH�S");eckeuntenrechts("�RL�S");balkenoben("�RP�S");balkenrechts("�RT�S");balkenlinks("�RX�S");balkenunten("�R\�S");waagerecht("�R`�S");senkrecht("�Rd�S");kreuz("�Rh�S");cursorsichtbar:="�-1";cursorunsichtbar:="�-0";ft20statuszeilenausEND PROCft20graphicchar;PROCft20statuszeilenaus:out("�.A")END PROCft20statuszeilenaus;PROCft20statuszeilenan:out("�.�")END PROCft20statuszeilenan;PROCibmgraphicchar:eckeobenlinks("�");eckeobenrechts("�");eckeuntenlinks("̈");eckeuntenrechts("�");balkenoben("̗");balkenrechts("ω");balkenlinks("�");balkenunten("̊");waagerecht("̊");senkrecht("�");kreuz("�");cursorsichtbar:="";cursorunsichtbar:=""END PROCibmgraphicchar;PROCcursoron:out(cursorsichtbar)END PROCcursoron;PROCcursoroff:out(cursorunsichtbar)END PROCcursoroff;PROCcursoron(TEXT CONSTt):cursorsichtbar:=tEND PROCcursoron;PROCcursoroff(TEXT CONSTt):cursorunsichtbar:=tEND PROCcursoroff;PROCclearbuffer:REP UNTILincharety=""PER END PROCclearbuffer;INT PROCclearbufferandcount(TEXT CONSTzeichen):INT VARzaehler:=0;TEXT VARzeichenkette:="",ch;IFzeichen=""THENclearbuffer;LEAVEclearbufferandcountWITH0FI;ermittlediezeichenkette;untersucheaufvorhandenezeichen;zaehler.ermittlediezeichenkette:REPch:=incharety(1);zeichenketteCATchUNTILch=""PER.untersucheaufvorhandenezeichen:INT VARi;FORiFROM1UPTOlength(zeichenkette)REP IFpos(subtext(zeichenkette,i),zeichen)=1THENzaehlerINCR1FI PER.END PROCclearbufferandcount;TEXT PROCcenter(INT CONSTxsize,TEXT CONSTt):TEXT VARzeile:=compress(t +);zeile:=((xsize-length(zeile))DIV2)*blank+zeile;zeileCAT(xsize-length(zeile))*blank;zeileEND PROCcenter;TEXT PROCcenter(TEXT CONSTt):center(79,t)END PROCcenter;TEXT PROCinvers(TEXT CONSTt):TEXT VARneu:=markein;neuCATt;neuCAT" ";neuCATmarkaus;neuEND PROCinvers;PROCpage(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI;cursor(x,y).ineinemstreich:FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMyUPTOy+ysize-1REPcursor(x,zeiger);out(leerzeile)PER.END PROCpage;PROCpage(AREA CONSTa):page(a.x,a.y,a.xsize,a.ysize)END PROCpage;PROCpageup(INT CONSTx,y,xsize,ysize):INT VARzeiger;IFx+xsize=80THENineinemstreichELSEputzevorsichtigFI.ineinemstreich:FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(cleol)PER.putzevorsichtig:TEXT VARleerzeile:=xsize*blank;FORzeigerFROMy+ysize-1DOWNTOyREPcursor(x,zeiger);out(leerzeile)PER.END PROCpageup;PROCpageup(AREA CONSTa):pageup(a.x,a.y,a.xsize,a.ysize)END PROCpageup;PROCoutframe(INT CONSTx,y,xsize,ysize):TEXT VARlinie:=(xsize-2)*waagerecht;INT VARzeiger;IFx<1CORy<1CORxsize<8CORysize<3CORx+xsize>80CORy+ysize>25THEN LEAVEoutframeFI;maleoben;maleseiten;maleunten.maleoben:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).maleseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(senkrecht);cursor(x+xsize-1,y+zeiger);out(senkrecht)PER.maleunten:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts)END PROCoutframe;PROCoutframe(AREA CONSTa):IFa.x-1<1ORa.y-1<1ORa.xsize+2>79ORa.ysize+2>24ORa.x+a.xsize+1>80ORa.y+a.ysize+1>25THEN LEAVEoutframeFI;outframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutframe;PROCoutmenuframe(INT CONSTx,y,xsize,ysize):INT VARi;TEXT VARlinie;untersucheangaben;schreiberahmen.untersucheangaben:IFx<0CORy<0CORx+xsize>81CORy+ysize>26THEN LEAVEoutmenuframeFI.schreiberahmen:IFx=0CORy=0CORxsize=81CORysize=26THENlinie:=xsize*waagerecht;zeichnereduziertenrahmenELSElinie:=(xsize-2)*waagerecht;zeichnevollenrahmenFI.zeichnereduziertenrahmen:zeichneoberlinie;zeichneunterlinie.zeichneoberlinie:cursor(1,2);out(linie).zeichneunterlinie:cursor(1,23);out(linie).zeichnevollenrahmen:schreibekopf;schreiberumpf;schreibefuss;schreibekopfleiste;schreibefussleiste.schreibekopf:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreiberumpf:FORiFROMy+1UPTOy+ysize-2REPcursor(x,i);out(senkrecht);cursor(x+xsize-1,i);out(senkrecht)PER.schreibefuss:cursor(x,y+ysize-1);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).schreibekopfleiste:cursor(x,y+2);schreibebalkenlinie.schreibefussleiste:cursor(x,y+ysize-3);schreibebalkenlinie.schreibebalkenlinie:out(balkenlinks);out(linie);out(balkenrechts).END PROCoutmenuframe;PROCoutmenuframe(AREA CONSTa):outmenuframe(a.x-1,a.y-1,a.xsize+2,a.ysize+2)END PROCoutmenuframe;PROCeraseframe(INT CONSTx,y,xsize,ysize):INT VARzeiger;TEXT VARleerzeile:=xsize*blank;loescheoben;loescheseiten;loescheunten.loescheoben:cursor(x,y);out(leerzeile).loescheseiten:FORzeigerFROM1UPTOysize-2REPcursor(x,y+zeiger);out(blank);cursor(x+xsize-1,y+zeiger);out(blank)PER.loescheunten:cursor(x,y+ysize-1);out(leerzeile)END PROCeraseframe;OP:=(AREA VARziel,AREA CONSTquelle):CONCR(ziel):=CONCR(quelle)END OP:=;PROCfill(AREA VARziel,INT CONSTa,b,c,d):IFa<1CORb<1CORa>79CORb>24CORc<8CORd<1CORc>79CORd>24CORa+c>80CORb+d>25THENerrorstop(fehlermeldung)FI;ziel.x:=a;ziel.y:=b;ziel.xsize:=c;ziel.ysize:=dEND PROCfill;INT PROCareax(AREA CONSTa):a.xEND PROCareax;INT PROCareay(AREA CONSTa):a.yEND PROCareay;INT PROCareaxsize(AREA CONSTa):a.xsizeEND PROCareaxsize;INT PROCareaysize(AREA CONSTa):a.ysizeEND PROCareaysize;PROCout(TEXT CONSTt,INT CONSTbreite):outtext(t,1,breite)END PROCout;PROCerase(INT CONSTbreite):out(breite*blank)END PROCerase;PROCcursor(AREA CONSTa,INT CONSTspa,zei):cursor(a.x+spa-1,a.y+zei-1)END PROCcursor;PROCgetcursor(AREA CONSTa,INT VARspalte,zeile):INT VARx,y;getcursor(x,y);spalte:=x-a.x+1;zeile:=y-a.y+1END PROCgetcursor;PROCout(AREA CONSTa,INT CONSTspa +,zei,TEXT CONSTt):out(a,spa,zei,t,LENGTHt)END PROCout;PROCout(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEouttext(t,1,laenge)FI.ueberpruefecursorangaben:IFspa>a.xsizeCORzei>a.ysizeCORspa<1CORzei<1THEN LEAVEoutFI.positionierecursor:cursor(a.x+spa-1,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa+1.verkuerzteausgabe:outtext(t,1,a.xsize-spa+1)END PROCout;PROCerase(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):out(a,spa,zei,laenge*blank,laenge)END PROCerase;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinvers(a,spa,zei,t,LENGTHt)END PROCoutinvers;PROCoutinvers(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=markein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-1);ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;out(hilf).ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEoutinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1END PROCoutinvers;PROCeraseinvers(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+3)FI.ueberpruefecursorangaben:IFspa>(a.xsize-4)CORzei>a.ysizeCORspa<2CORzei<1THEN LEAVEeraseinversFI.positionierecursor:cursor(a.x+spa-2,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-1.verkuerzteausgabe:erase(a.xsize-spa+2).END PROCeraseinvers;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outwithbeam(a,spa,zei,t,LENGTHt)END PROCoutwithbeam;PROCoutwithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCAT" ";IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCAT" ";hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutwithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.END PROCoutwithbeam;PROCerasewithbeam(AREA CONSTa,INT CONSTspa,zei,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;IFlaengeistzugrossTHENverkuerzteausgabeELSEerase(laenge+6)FI.ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEerasewithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2.verkuerzteausgabe:erase(a.xsize-spa+4).END PROCerasewithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt):outinverswithbeam(a,spa,zei,t,LENGTHt)END PROCoutinverswithbeam;PROCoutinverswithbeam(AREA CONSTa,INT CONSTspa,zei,TEXT CONSTt,INT CONSTlaenge):ueberpruefecursorangaben;positionierecursor;TEXT VARhilf:=senkrecht;hilfCATblank;hilfCATmarkein;IFlaengeistzugrossTHENhilfCATsubtext(t,1,a.xsize-spa-2)ELSEhilfCATtext(t,laenge)FI;hilfCATblank;hilfCATmarkaus;hilfCATsenkrecht;out(hilf).ueberpruefecursorangaben:IFspa>a.xsize-7CORzei>a.ysizeCORspa<4CORzei<1THEN LEAVEoutinverswithbeamFI.positionierecursor:cursor(a.x+spa-4,a.y+zei-1).laengeistzugross:laenge>a.xsize-spa-2END PROCoutinverswithbeam;END PACKETlsdialog1; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe new file mode 100644 index 0000000..73d4c2a --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 2.mathe @@ -0,0 +1,7 @@ +PACKETlsdialog2DEFINESsome,one,lsexitkey,resetlsexitkey,infixnamen,ohnepraefix,notempty:LETmaxentries=200;LETzeichenstring="��� +
�xo? ",obenuntenreturnruboutkreuzkringelblank="� +
�xo ",qeinsneunh="w19m";LETzurueck="�",piep="�";LEThop=1,esc=2,oben=3,unten=4,return=5,rubout=6,kreuz=7,kringel=8,frage=9,leer=10;LETpunkt=".",blank=" ";INT VARx,y,xsize,ysize,maxeintraege,anzahl,ersteauswahlzeile,virtuellercursor,reellercursor;TEXT VARkennzeile1,kennzeile2,registrierkette:="",exitkey:="";BOOL VARabbruch,auswahlende;BOUND ROWmaxentriesTEXT VAReintrag;ROW2TEXT CONSTfehlermeldung:=ROW2TEXT:("Unzulässige Cursorwerte bei der Auswahl","Fenster für Auswahl zu klein (x < 56 / y < 15)");ROW16TEXT CONSThinweis:=ROW16TEXT:(" Bitte warten...!"," Info: <?> Weiter: <ESC><w> Menü: <ESC><m>"," Weiter mit beliebiger Taste!","Weitere Einträge!"," INFORMATIONEN ZUR AUSWAHL AUS DER LISTE"," Positionierung der Schreibmarke:"," Pfeil auf/ab : eine Position nach oben/unten"," HOP Pfeil auf/ab : auf erste/letzte Pos. der Seite"," ESC 1/ESC 9 : auf erste/letzte Pos. der Liste"," Ankreuzen und Löschen von Kreuzen:"," RETURN/x : den Eintrag ankreuzen"," RUBOUT/o/Leertaste: Kreuz vor dem Eintrag löschen"," HOP RETURN/HOP x : alle folgenden Eintr. ankreuzen"," HOP RUBOUT/HOP o : alle folgenden Kreuze löschen"," /HOP Leertaste"," Info: <?> Menü: <ESC><m>");TEXT PROClsexitkey:exitkeyEND PROClsexitkey;PROClsexitkey(TEXT CONSTausgang):exitkey:=ausgang;END PROClsexitkey;PROCresetlsexitkey:exitkey:=""END PROCresetlsexitkey;THESAURUS PROCauswahl(THESAURUS CONSTt,BOOL CONSTmehreremoeglich,TEXT CONSTt1,t2):TEXT VARlinie:=(xsize-2)*waagerecht;werteinitialisieren;namenbesorgen;bildschirmaufbauen;auswaehlenlassen;abgangvorbereiten.werteinitialisieren:THESAURUS VARausgabe:=emptythesaurus;DATASPACE VARds:=nilspace;eintrag:=ds;kennzeile1:=t1;kennzeile2:=t2;abbruch:=FALSE;ersteauswahlzeile:=y+5;anzahl:=0;maxeintraege:=ysize-8;virtuellercursor:=1;reellercursor:=1.namenbesorgen:fischedienamenausdemthesaurus;IFkeineintragvorhandenTHEN LEAVEauswahlWITHausgabeFI.bildschirmaufbauen:schreibekopfzeile;gibhinweisaus(kennzeile1,kennzeile2);bauebildschirmauf(1);schreibefusszeile;IFmehreremoeglichTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;reellencursorsetzen.schreibekopfzeile:cursor(x,y);out(eckeobenlinks);out(linie);out(eckeobenrechts).schreibefusszeile:cursor(x,y+ysize-2);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).auswaehlenlassen:kreuzean(mehreremoeglich).abgangvorbereiten:footnote(hinweis[1]);cursor(x+1,y+ysize-1);ausgabeerzeugen;forget(ds);ausgabe.fischedienamenausdemthesaurus:INT VARzeiger;FORzeigerFROM1UPTOhighestentry(t)REP IFname(t,zeiger)<>""THENanzahlINCR1;eintrag[anzahl]:=name(t,zeiger)FI PER.keineintragvorhanden:anzahl=0.ausgabeerzeugen:TEXT VARnummer;WHILEregistrierkette<>""REPnummer:=subtext(registrierkette,1,3);registrierkette:=subtext(registrierkette,5);insert(ausgabe,eintrag[int(nummer)])PER.END PROCauswahl;PROCreellencursorsetzen:cursor(x+1,ersteauswahlzeile+reellercursor-1);out(marke(virtuellercursor,TRUE)+8*zurueck)END PROCreellencursorsetzen;PROCbauebildschirmauf(INT CONSTanfang):TEXT VARpunktlinie:=(xsize-2)*punkt,weiterzeile:=(xsize-length(hinweis[4])-5)*punkt+invers(hinweis[4]),beamedleerzeile:=senkrecht+(xsize-2)*blank+senkrecht;gibkopfzeileaus;gibnamenstabelleaus;gibfusszeileaus;loescheggfrestbereich.gibkopfzeileaus:cursor(x,ersteauswahlzeile-1);out(senkrecht);IFreellercursor=virtuellercursorTHENout(punktlinie)ELSEout(weiterzeile)FI;out(senkrecht);line.gibnamenstabelleaus:INT VARzeiger,zaehler:=-1;TEXT VARhilf;FORzeigerFROManfangUPTOgrenzeREPzaehlerINCR1;cursor(x,ersteauswahlzeile+zaehler);hilf:=senkrecht;hilfCATmarke(zeiger,FALSE);hilfCATtext(subtext(eintrag[zeiger],1,xsize-10),xsize-10);hilfCATsenkrecht;out(hilf)PER.gibfusszeileaus:cursor(x,ersteauswahlzeile+zaehler+1);out(senkrecht);IF NOT((virtuellercursor+maxeintraege-reellercursor)<anzahl)THENout(punktlinie)ELSEout(weiterzeile)FI;out( +senkrecht).loescheggfrestbereich:IFzaehler+1<maxeintraegeTHENloeschebildschirmrestFI.loeschebildschirmrest:FORzeigerFROMrestanfangUPTOrestendeREPcursor(x,zeiger);out(beamedleerzeile)PER.restanfang:ersteauswahlzeile+zaehler+2.restende:ersteauswahlzeile+maxeintraege.grenze:min(anzahl,anfang+maxeintraege-1).END PROCbauebildschirmauf;TEXT PROCmarke(INT CONSTzeiger,BOOL CONSTmitcursor):INT VARplatz:=nr(zeiger);IFplatz=0THENleerELSEmitzahlFI.mitzahl:TEXT VARhilf;IFmitcursorTHENhilf:="==>";ELSEhilf:=" "END IF;hilfCAT(3-length(text(platz)))*blank;hilfCATtext(platz);hilfCAT"x ";hilf.leer:IFmitcursorTHEN"==> o "ELSE" o "FI.END PROCmarke;INT PROCnr(INT CONSTzeiger):IFpos(registrierkette,textstring(zeiger))=0THEN0ELSE(pos(registrierkette,textstring(zeiger))DIV4)+1FI END PROCnr;TEXT PROCtextstring(INT CONSTnr):text(nr,3)+"!"END PROCtextstring;PROCinfo:INT VARi;notierehinweisueberschrift;notierepositionierhinweise;IFnochplatzvorhandenTHENnotiereauswahlmoeglichkeitenaufalterseiteELSEwechsleaufnaechsteseite;notierehinweisueberschrift;notiereauswahlmoeglichkeitenaufneuerseiteFI;stellealtenbildschirmzustandwiederher.notierehinweisueberschrift:cursor(x+1,y+1);out(center(xsize-2,hinweis[5]));cursor(x+1,y+2);out("",xsize-2).notierepositionierhinweise:cursor(x+1,y+3);out(hinweis[6],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO7REPcursor(x+1,y+i);out(hinweis[i+2],xsize-2)PER.notiereauswahlmoeglichkeitenaufalterseite:cursor(x+1,y+8);out("",xsize-2);cursor(x+1,y+9);out(hinweis[10],xsize-2);cursor(x+1,y+10);out("",xsize-2);FORiFROM11UPTO15REPcursor(x+1,y+i);out(hinweis[i],xsize-2)PER;loeschedierestlichenzeilen;footnote(hinweis[3]);cursorinruhestellung;clearbuffer.loeschedierestlichenzeilen:FORiFROMy+16UPTOy+ysize-3REPcursor(x+1,i);out("",xsize-2)PER.wechsleaufnaechsteseite:loescheseitenrest;footnote(hinweis[3]);cursorinruhestellung;clearbuffer;pause.loescheseitenrest:INT VARzaehler;FORzaehlerFROM8UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.notiereauswahlmoeglichkeitenaufneuerseite:cursor(x+1,y+3);out(hinweis[10],xsize-2);cursor(x+1,y+4);out("",xsize-2);FORiFROM5UPTO9REPcursor(x+1,y+i);out(hinweis[i+6],xsize-2)PER;FORzaehlerFROM10UPTOysize-3REPcursor(x+1,y+zaehler);out("",xsize-2)PER.cursorinruhestellung:cursor(x+1,y+ysize-2).stellealtenbildschirmzustandwiederher:clearbuffer;pause;gibhinweisaus(kennzeile1,kennzeile2);virtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzen.nochplatzvorhanden:ysize>17.END PROCinfo;PROCkreuzean(BOOL CONSTmehrere):auswahlende:=FALSE;clearbuffer;REPzeichenlesen;zeicheninterpretierenUNTILauswahlendePER.zeichenlesen:TEXT VARzeichen;getchar(zeichen).zeicheninterpretieren:SELECTpos(zeichenstring,zeichen)OF CASEhop:hopkommandoverarbeiten(mehrere)CASEesc:esckommandoverarbeitenCASEoben:nachobenCASEunten:nachuntenCASEkreuz,return:ankreuzenweiter;evtlaufhoerenCASErubout,kringel,leer:auskreuzenweiterCASEfrage:info;IFmehrereTHENfootnote(hinweis[2])ELSEfootnote(hinweis[16])END IF;OTHERWISEout(piep)END SELECT.evtlaufhoeren:IF NOTmehrereTHEN LEAVEkreuzeanFI.END PROCkreuzean;PROChopkommandoverarbeiten(BOOL CONSTmehrere):zweiteszeichenlesen;zeicheninterpretieren.zweiteszeichenlesen:TEXT VARzweiteszeichen;getchar(zweiteszeichen).zeicheninterpretieren:SELECTpos(obenuntenreturnruboutkreuzkringelblank,zweiteszeichen)OF CASE1:hopnachobenCASE2:hopnachuntenCASE3,5:IFmehrereTHENalledarunterankreuzenFI CASE4,6,7:IFmehrereTHENalledarunterloeschenFI OTHERWISEout(piep)END SELECT.alledarunterankreuzen:INT VARi;FORiFROMvirtuellercursorUPTOanzahlREP IFnr(i)=0THENankreuzenFI PER;bildaktualisieren;reellencursorsetzen.ankreuzen:registrierketteCATtextstring(i).alledarunterloeschen:INT VARj,position;FORjFROMvirtuellercursorUPTOanzahlREPposition:=nr(j);IFposition>0THENrausschmeissen;FI PER;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,(4*position)-4)+subtext(registrierkette,(4*position)+1).hopnachoben:IFganzobenTHENout(piep)ELIFobenaufderseiteTHENraufblaettern +ELSEtopofpageFI.ganzoben:virtuellercursor=1.obenaufderseite:reellercursor=1.raufblaettern:virtuellercursorDECRmaxeintraege;virtuellercursor:=max(virtuellercursor,1);bauebildschirmauf(virtuellercursor);reellencursorsetzen.topofpage:loeschemarke;virtuellercursorDECR(reellercursor-1);reellercursor:=1;reellencursorsetzen.hopnachunten:IFganzuntenTHENout(piep)ELIFuntenaufderseiteTHENrunterblaetternELSEbottomofpageFI.ganzunten:virtuellercursor=anzahl.untenaufderseite:reellercursor>maxeintraege-1.runterblaettern:INT VARaltervirtuellercursor:=virtuellercursor;virtuellercursorINCRmaxeintraege;virtuellercursor:=min(virtuellercursor,anzahl);reellercursor:=virtuellercursor-altervirtuellercursor;bauebildschirmauf(altervirtuellercursor+1);reellencursorsetzen.bottomofpage:loeschemarke;altervirtuellercursor:=virtuellercursor;virtuellercursorINCR(maxeintraege-reellercursor);virtuellercursor:=min(anzahl,virtuellercursor);reellercursorINCR(virtuellercursor-altervirtuellercursor);reellencursorsetzen.END PROChopkommandoverarbeiten;PROCesckommandoverarbeiten:TEXT VARzweiteszeichen;getchar(zweiteszeichen);SELECTpos(qeinsneunh,zweiteszeichen)OF CASE1:auswahlende:=TRUE CASE2:zeigeanfangCASE3:zeigeendeCASE4:abbruch:=TRUE;auswahlende:=TRUE;registrierkette:=""OTHERWISEout(piep)END SELECT;exitkey:=zweiteszeichen.zeigeanfang:IFvirtuellercursor=1THENout(piep)ELIFvirtuellercursor=reellercursorTHENloeschemarke;virtuellercursor:=1;reellercursor:=1;reellencursorsetzenELSEvirtuellercursor:=1;reellercursor:=1;bauebildschirmauf(1);reellencursorsetzenFI.zeigeende:IFvirtuellercursor=anzahlTHENout(piep)ELIFendeaufbildschirmTHENloeschemarke;reellercursorINCR(anzahl-virtuellercursor);virtuellercursor:=anzahl;reellencursorsetzenELSEvirtuellercursor:=anzahl;reellercursor:=maxeintraege;bauebildschirmauf(anzahl-(maxeintraege-1));reellencursorsetzenFI.endeaufbildschirm:(reellercursor+anzahl-virtuellercursor)<maxeintraege+1.END PROCesckommandoverarbeiten;PROCankreuzen:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;reellencursorsetzenEND PROCankreuzen;PROCankreuzenweiter:INT VARplatz:=nr(virtuellercursor);IFplatz=0THENregistrierketteCATtextstring(virtuellercursor);END IF;IFvirtuellercursor<anzahlTHENnachuntenFI;IFvirtuellercursor=anzahlTHENreellencursorsetzenFI END PROCankreuzenweiter;PROCauskreuzenweiter:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissen;END IF;IFvirtuellercursor<anzahlTHENnachuntenELSEloeschemarkeFI;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzenweiter;PROCauskreuzen:INT VARposition:=nr(virtuellercursor);IFposition<>0THENrausschmeissenEND IF;loeschemarke;bildaktualisieren;reellencursorsetzen.rausschmeissen:registrierkette:=subtext(registrierkette,1,4*position-4)+subtext(registrierkette,4*position+1).END PROCauskreuzen;PROCbildaktualisieren:INT VARob,un,i,zaehler:=-1;ob:=virtuellercursor-reellercursor+1;un:=min(ob+maxeintraege-1,anzahl);FORiFROMobUPTOunREPzaehlerINCR1;cursor(x+1,ersteauswahlzeile+zaehler);out(marke(i,FALSE))PER END PROCbildaktualisieren;PROCnachoben:IFnochnichtobenTHENgehenachobenELSEout(piep)FI.nochnichtoben:virtuellercursor>1.gehenachoben:IFreellercursor=1THENscrolldownELSEcursorupFI.scrolldown:virtuellercursorDECR1;bauebildschirmauf(virtuellercursor);reellencursorsetzen.cursorup:loeschemarke;virtuellercursorDECR1;reellercursorDECR1;reellencursorsetzenEND PROCnachoben;PROCnachunten:IFnochnichtuntenTHENgehenachuntenELSEout(piep)FI.nochnichtunten:virtuellercursor<anzahl.gehenachunten:IFreellercursor>maxeintraege-1THENscrollupELSEcursordownFI.scrollup:virtuellercursorINCR1;bauebildschirmauf(virtuellercursor-(maxeintraege-1));reellencursorsetzen.cursordown:loeschemarke;virtuellercursorINCR1;reellercursorINCR1;reellencursorsetzenEND PROCnachunten;PROCloeschemarke:out(marke(virtuellercursor,FALSE))END PROCloeschemarke;PROCgibhinweisaus(TEXT CONSTt1,t2): +cursor(x,y+1);out(senkrecht);out(center(xsize-2,invers(t1)));out(senkrecht);cursor(x,y+2);out(senkrecht);out("",xsize-2);out(senkrecht);cursor(x,y+3);out(senkrecht);out(center(xsize-2,t2));out(senkrecht)END PROCgibhinweisaus;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:pos(eintrag,infix)<>0END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:eintrag<>""CANDtype(old(eintrag))=dateityp.END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,INT CONSTdateityp):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)AND(type(old(eintrag))=dateityp).END PROCinfixnamen;THESAURUS PROCinfixnamen(THESAURUS CONSTt,TEXT CONSTinfix1,infix2):THESAURUS VARtt:=emptythesaurus;INT VARi;FORiFROM1UPTOhighestentry(t)REP TEXT VAReintrag:=name(t,i);IFeintragenthaeltinfixTHENinsert(tt,eintrag)FI PER;tt.eintragenthaeltinfix:(pos(eintrag,infix1)<>0)OR(pos(eintrag,infix2)<>0)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix):infixnamen(ALLmyself,infix)END PROCinfixnamen;THESAURUS PROCinfixnamen(TEXT CONSTinfix1,infix2):infixnamen(ALLmyself,infix1,infix2)END PROCinfixnamen;THESAURUS PROCohnepraefix(THESAURUS CONSTthesaurus,TEXT CONSTpraefix):THESAURUS VARt:=emptythesaurus;INT VARzaehler;FORzaehlerFROM1UPTOhighestentry(thesaurus)REP IFname(thesaurus,zaehler)<>""ANDpos(name(thesaurus,zaehler),praefix)=1THENinsert(t,subtext(name(thesaurus,zaehler),length(praefix)+1))FI;PER;tEND PROCohnepraefix;BOOL PROCnotempty(THESAURUS CONSTt):INT VARi;FORiFROM1UPTOhighestentry(t)REP IFname(t,i)<>""THEN LEAVEnotemptyWITH TRUE FI PER;FALSE END PROCnotempty;PROCuntersuchebildschirmmasszahlen(TEXT CONSTt1,t2):IFunzulaessigecursorwerteTHENerrorstop(fehlermeldung[1])ELIFfensteristzukleinTHENerrorstop(fehlermeldung[2])FI.unzulaessigecursorwerte:(x+xsize)>80COR(y+ysize)>25CORx<1CORy<1CORxsize>79CORysize>24.fensteristzuklein:(xsize)<56COR(ysize)<15CORlength(t1)>(xsize-5)CORlength(t2)>(xsize-5).END PROCuntersuchebildschirmmasszahlen;TEXT PROCggfgekuerztertext(TEXT CONSTtext):IFlength(text)>(xsize-5)THENsubtext(text,1,xsize-7)+".."ELSEtextFI END PROCggfgekuerztertext;THESAURUS PROCsome(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);auswahl(t,TRUE,text1,text2)END PROCsome;THESAURUS PROCsome(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):some(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCsome;THESAURUS PROCsome(THESAURUS CONSTt,TEXT CONSTt1,t2):some(1,1,79,24,t,t1,t2)END PROCsome;TEXT PROCone(INT CONSTspa,zei,breite,hoehe,THESAURUS CONSTt,TEXT CONSTt1,t2):TEXT VARtext1,text2;x:=spa;y:=zei;xsize:=breite;ysize:=hoehe;text1:=ggfgekuerztertext(t1);text2:=ggfgekuerztertext(t2);untersuchebildschirmmasszahlen(text1,text2);name(auswahl(t,FALSE,text1,text2),1)END PROCone;TEXT PROCone(INT CONSTspa,zei,THESAURUS CONSTt,TEXT CONSTt1,t2):one(spa,zei,79-spa+1,24-zei+1,t,t1,t2)END PROCone;TEXT PROCone(THESAURUS CONSTt,TEXT CONSTt1,t2):one(1,1,79,24,t,t1,t2)END PROCone;END PACKETlsdialog2; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe new file mode 100644 index 0000000..3408f21 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 3.mathe @@ -0,0 +1,3 @@ +PACKETlsdialog3DEFINES WINDOW,:=,window,show,page,erase,line,remaininglines,cursor,getcursor,outframe,outmenuframe,out,put,putline,get,getline,yes,no,edit,center,stop,area,areax,areay,areaxsize,areaysize:LETpiep="�",cr="
";LETjaneinkette="jJyYnN",blank=" ",niltext="";TYPE WINDOW=STRUCT(AREAfenster,INTcspalte,czeile,belegbarezeilen,BOOLfensterendeerreicht);ROW3TEXT CONSTaussage:=ROW3TEXT:(" 'Window' ungültig!"," (j/n) ?"," Weiter mit beliebiger Taste!");TEXT VARnumberword,exitchar;OP:=(WINDOW VARlinks,WINDOW CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;WINDOW PROCwindow(INT CONSTx,y,xsize,ysize):WINDOW VARw;fill(w.fenster,x,y,xsize,ysize);initialize(w);wEND PROCwindow;PROCinitialize(WINDOW VARw):w.czeile:=1;w.cspalte:=1;w.fensterendeerreicht:=FALSE;w.belegbarezeilen:=areaysize(w.fenster)END PROCinitialize;PROCshow(WINDOW VARw):zeigerahmen;fensterputzen.zeigerahmen:outframe(w.fenster).fensterputzen:page(w).END PROCshow;PROCpage(WINDOW VARw):initialize(w);page(w,FALSE)END PROCpage;PROCpage(WINDOW CONSTw,BOOL CONSTmitrahmen):IFareax(w)=1ANDareay(w)=1ANDareaxsize(w)=79ANDareaysize(w)=24THENpage;ELSEloeschebereichFI.loeschebereich:IFmitrahmenTHENpage(areax(w)-1,areay(w)-1,areaxsize(w)+2,areaysize(w)+2)ELSEpage(area(w))FI END PROCpage;PROCerase(WINDOW VARw):page(w,TRUE)END PROCerase;PROCline(WINDOW VARw):w.cspalte:=1;IFw.czeile<w.belegbarezeilenTHENw.czeileINCR1;ELSEw.czeile:=1;w.fensterendeerreicht:=TRUE FI;cursor(w,w.cspalte,w.czeile)END PROCline;PROCline(WINDOW VARw,INT CONSTanzahl):INT VARi;FORiFROM1UPTOanzahlREPline(w)PER END PROCline;INT PROCremaininglines(WINDOW CONSTw):INT VARspalte,zeile;getcursor(w,spalte,zeile);IFspalte=0ORzeile=0THEN0ELSEw.belegbarezeilen-w.czeileFI END PROCremaininglines;PROCcursor(WINDOW VARw,INT CONSTspalte,zeile):IFspalte<1ORzeile<1ORspalte>areaxsize(w)ORzeile>areaysize(w)THENpage(w);ELSEw.cspalte:=spalte;w.czeile:=zeile;FI;cursor(w.fenster,w.cspalte,w.czeile)END PROCcursor;PROCgetcursor(WINDOW CONSTw,INT VARspalte,zeile):IF(w.cspalte<1)OR(w.cspalte>areaxsize(w.fenster))OR(w.czeile<1)OR(w.czeile>areaysize(w.fenster))THENspalte:=0;zeile:=0ELSEspalte:=w.cspalte;zeile:=w.czeileFI END PROCgetcursor;PROCout(WINDOW VARw,TEXT CONSTtext):INT VARrestlaenge;IF(w.cspalte>=1)AND(w.cspalte<=areaxsize(w.fenster))AND(w.czeile>=1)AND(w.czeile<=w.belegbarezeilen)THENputzeggffenster;cursor(w.fenster,w.cspalte,w.czeile);outtext(text,1,textende);setzefenstercursorneu;setzeausgabeggfinnaechsterzeilefortFI.putzeggffenster:IFw.fensterendeerreichtTHENpage(w);w.fensterendeerreicht:=FALSE FI.textende:restlaenge:=areaxsize(w.fenster)-w.cspalte+1;min(length(text),restlaenge).setzefenstercursorneu:IFlength(text)>=restlaengeTHENw.cspalte:=1;w.czeileINCR1;schlageggfneueseiteaufELSEw.cspalteINCRlength(text)FI.schlageggfneueseiteauf:IFw.czeile>w.belegbarezeilenTHENw.fensterendeerreicht:=TRUE;w.czeile:=1;w.cspalte:=1FI.setzeausgabeggfinnaechsterzeilefort:IFlength(text)>restlaengeTHENout(w,subtext(text,restlaenge+1))FI.END PROCout;PROCoutframe(WINDOW VARw):outframe(area(w))END PROCoutframe;PROCoutmenuframe(WINDOW VARw):outmenuframe(area(w))END PROCoutmenuframe;PROCput(WINDOW VARw,TEXT CONSTword):out(w,word);out(w,blank)END PROCput;PROCput(WINDOW VARw,INT CONSTnumber):put(w,text(number))END PROCput;PROCput(WINDOW VARw,REAL VARnumber):put(w,text(number))END PROCput;PROCputline(WINDOW VARw,TEXT CONSTtextline):out(w,textline);line(w)END PROCputline;PROCprivateget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator,INT CONSTlength):INT VARx,y;INT VARrestlaenge:=areaxsize(w.fenster)-w.cspalte-1;ggfzurnaechstenzeile;getcursor(x,y);cursoron;cursor(x,y);REPword:="";editget(word,laenge,laenge,separator,"",exitchar);out(w,word);echoeexitchar(w)UNTILword<>niltextANDword<>blankPER;cursoroff;deleteleadingblanks.ggfzurnaechstenzeile:IFrestlaenge<5THENline(w);restlaenge:=areaxsize(w.fenster)-2FI.deleteleadingblanks:WHILE(wordSUB1)=blankREPword:=subtext(word,2)PER.laenge:min(length,restlaenge).END PROCprivateget;PROCget(WINDOW VARw,TEXT VARword): +privateget(w,word," ",maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,TEXT CONSTseparator):privateget(w,word,separator,maxtextlength)END PROCget;PROCget(WINDOW VARw,TEXT VARword,INT CONSTlength):privateget(w,word,"",length)END PROCget;PROCget(WINDOW VARw,INT VARnumber):get(w,numberword);number:=int(numberword)END PROCget;PROCget(WINDOW VARw,REAL VARnumber):get(w,numberword);number:=real(numberword)END PROCget;PROCgetline(WINDOW VARw,TEXT VARtextline):privateget(w,textline,"",maxtextlength)END PROCgetline;PROCechoeexitchar(WINDOW VARfenster):IFexitchar=crTHENline(fenster)ELSEout(fenster,exitchar)FI END PROCechoeexitchar;TEXT PROCcenter(WINDOW CONSTw,TEXT CONSTtext):IFlength(text)>=areaxsize(w.fenster)THENsubtext(text,1,areaxsize(w.fenster))ELSEcenter(areaxsize(w.fenster),text)FI END PROCcenter;BOOL PROCyes(WINDOW VARw,TEXT CONSTfrage):TEXT VARzeichen,internefrage:=frage;internefrageCATaussage[2];wechselggfaufneueseite;out(w,internefrage);holeeingabezeichen;wertezeichenaus.wechselggfaufneueseite:IFremaininglines(w)<1THENpage(w)FI.holeeingabezeichen:cursoron;clearbuffer;REPinchar(zeichen);piepseggfUNTILpos(janeinkette,zeichen)>0PER;out(w,blank+zeichen);cursoroff;line(w).piepseggf:IFpos(janeinkette,zeichen)=0THENout(piep)FI.wertezeichenaus:IFpos(janeinkette,zeichen)<5THEN TRUE ELSE FALSE FI.END PROCyes;PROCedit(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);cursoron;edit(f,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoroffEND PROCedit;PROCedit(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);edit(w,f)END PROCedit;PROCshow(WINDOW VARw,FILE VARf):outframe(w.fenster);loescherechtespalten(w);openeditor(groesstereditor+1,f,FALSE,areax(w.fenster),areay(w.fenster),areaxsize(w.fenster)-1,areaysize(w.fenster));cursoron;edit(groesstereditor,"eqvw19dpgn�",PROC(TEXT CONST)stdkommandointerpreter);cursoroffEND PROCshow;PROCshow(WINDOW VARw,TEXT CONSTdateiname):FILE VARf:=sequentialfile(modify,dateiname);toline(f,1);show(w,f)END PROCshow;PROCloescherechtespalten(WINDOW VARw):INT VARi;FORiFROM1UPTOareaysize(w.fenster)REPcursor(w,areaxsize(w.fenster)-2,i);out(" ")PER END PROCloescherechtespalten;BOOL PROCno(WINDOW VARw,TEXT CONSTfrage):NOTyes(w,frage)END PROCno;PROCstop(WINDOW VARw):stop(w,2)END PROCstop;PROCstop(WINDOW VARw,INT CONSTzeilenzahl):INT VARi;FORiFROM1UPTOzeilenzahlREPline(w)PER;out(w,aussage[3]);pauseEND PROCstop;AREA PROCarea(WINDOW CONSTw):w.fensterEND PROCarea;INT PROCareax(WINDOW CONSTw):areax(w.fenster)END PROCareax;INT PROCareay(WINDOW CONSTw):areay(w.fenster)END PROCareay;INT PROCareaxsize(WINDOW CONSTw):areaxsize(w.fenster)END PROCareaxsize;INT PROCareaysize(WINDOW CONSTw):areaysize(w.fenster)END PROCareaysize;END PACKETlsdialog3 + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe new file mode 100644 index 0000000..bafd79b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 4.mathe @@ -0,0 +1,6 @@ +PACKETlsdialog4DEFINESboxinfo,boxnotice,boxalternative,boxyes,boxno,boxanswer,boxone,boxanswerone,boxsome,boxanswersome:LETdelimiter="
",piep="�",gueltigezeichen=" +�
",esc="�",auswahl="z",abbruch="m",blank=" ",trennliniensymbol="-",niltext="",janeintasten="jn";ROW8TEXT CONSTaussage:=ROW8TEXT:(" Weiter mit beliebiger Taste!"," Wählen: <Pfeile> Bestätigen: <RETURN> Menü: <ESC> <m>"," Wählen: <Pfeile> Bestätigen: <RETURN> Ja: <j> Nein: <n>"," Wählen: <Pfeile> Bestätigen: <RETURN>"," Bestätigen: <RETURN> Zeigen: <ESC><z> Menü: <ESC><m>"," Bestätigen: <RETURN> Menü: <ESC><m>","Ja
Nein"," Eingabe: ");PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);schreibebox(w,t,position,timelimit,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxinfo;PROCboxinfo(WINDOW VARw,TEXT CONSTt):boxinfo(w,t,5,maxint)END PROCboxinfo;PROCboxnotice(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);schreibenotiz(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei)END PROCboxnotice;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize):INT VARergebnis,spa,zei;getcursor(w,spa,zei);schreibealternativen(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize,ergebnis);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;INT PROCboxalternative(WINDOW VARw,TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):INT VARx,y,xsize,ysize,ergebnis,spa,zei;getcursor(w,spa,zei);ergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);ergebnisEND PROCboxalternative;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;getcursor(w,spa,zei);BOOL CONSTwert:=ja(w,t,position,x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxyes(WINDOW VARw,TEXT CONSTt,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);BOOL VARwert:=ja(w,t,position,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxyes;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):NOTboxyes(w,t,position,x,y,xsize,ysize)END PROCboxno;BOOL PROCboxno(WINDOW VARw,TEXT CONSTt,INT CONSTposition):NOTboxyes(w,t,position)END PROCboxno;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARspa,zei;TEXT VARwert;getcursor(w,spa,zei);wert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);oldfootnote;cursor(spa,zei);wertEND PROCboxanswer;TEXT PROCboxanswer(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,t,vorgabe,position,FALSE,x,y,xsize,ysize);pageup(x,y,xsize,ysize);oldfootnote;cursor(w,spa,zei);wertEND PROCboxanswer;TEXT PROCboxone(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);TEXT VARwert:=one(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));FI;oldfootnote;cursor(w,spa,zei);wertEND PROCboxone;TEXT PROCboxanswerone(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);wert.lasseauswaehlen:IFmitreinigungTHENwert:=boxone(w,thesaurus,t1,t2,TRUE)ELSEwert:=boxone(w, +thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswerone;THESAURUS PROCboxsome(WINDOW VARw,THESAURUS CONSTthesaurus,TEXT CONSTtext1,text2,BOOL CONSTmitreinigung):INT VARspa,zei;getcursor(w,spa,zei);THESAURUS VARwert:=some(areax(w),areay(w),areaxsize(w),areaysize(w),thesaurus,text1,text2);IFmitreinigungTHENpageup(areax(w),areay(w),areaxsize(w),areaysize(w));oldfootnote;FI;cursor(w,spa,zei);wertEND PROCboxsome;THESAURUS PROCboxanswersome(WINDOW VARw,TEXT CONSTtext,vorgabe,THESAURUS CONSTthesaurus,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):THESAURUS VARergebnis:=emptythesaurus;INT VARx,y,xsize,ysize,spa,zei;getcursor(w,spa,zei);TEXT VARwert:=holeantwort(w,text,vorgabe,5,TRUE,x,y,xsize,ysize);IFwert=esc+auswahlTHENlasseauswaehlenELSEuebernimmdenwertFI;cursor(w,spa,zei);ergebnis.lasseauswaehlen:IFmitreinigungTHENergebnis:=boxsome(w,thesaurus,t1,t2,TRUE)ELSEergebnis:=boxsome(w,thesaurus,t1,t2,FALSE)FI.uebernimmdenwert:IFwert<>niltextTHENinsert(ergebnis,wert)FI;IFmitreinigungTHENpageup(x,y,xsize,ysize);oldfootnote;FI.END PROCboxanswersome;PROCzerteiletexte(TEXT CONSTt,ROW24TEXT VARtexte,INT VARbelegt):TEXT VARintern:=t;INT VARende:=0;belegt:=0;entfernefuehrendedelimiter;WHILEende<>maxint-1REPende:=pos(intern,delimiter);belegtINCR1;IFende=0THENende:=maxint-1END IF;texte(belegt):=subtext(intern,1,ende-1);intern:=subtext(intern,ende+1)PER.entfernefuehrendedelimiter:WHILE(internSUB1)=delimiterREPintern:=subtext(intern,2)PER END PROCzerteiletexte;PROCermittleboxgroesse(WINDOW VARw,INT CONSTposition,zusatzlaenge,minbreite,minhoehe,belegt,ROW24TEXT CONSTtexte,INT VARx,y,xsize,ysize):ermittleboxbreiteundboxhoehe;ermittlerahmenwerte.ermittleboxbreiteundboxhoehe:xsize:=0;FORysizeFROM1UPTObelegtREPEATxsize:=max(xsize,LENGTHtexte(ysize))PER;ysize:=belegt.ermittlerahmenwerte:schlagenotwendigegroessenauf;killueberlaengen;legebildschirmpositionenfest.schlagenotwendigegroessenauf:xsize:=max(xsize,minbreite);ysize:=max(ysize,minhoehe);ysizeINCRzusatzlaenge;ysizeINCR2;xsizeINCR2.killueberlaengen:ysize:=min(ysize,areaysize(w)-4);xsize:=min(xsize,areaxsize(w)-4).legebildschirmpositionenfest:SELECTpositionOF CASE1:plazierunglinksobenCASE2:plazierungrechtsobenCASE3:plazierunglinksuntenCASE4:plazierungrechtsuntenOTHERWISEplazierungimzentrumEND SELECT.plazierunglinksoben:x:=areax(w)+2;y:=areay(w)+2.plazierungrechtsoben:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+2.plazierunglinksunten:x:=areax(w)+2;y:=areay(w)+areaysize(w)-ysize-2.plazierungrechtsunten:x:=areax(w)+areaxsize(w)-xsize-2;y:=areay(w)+areaysize(w)-ysize-2.plazierungimzentrum:x:=areax(w)+((areaxsize(w)-(xsize+2))DIV2)+1;y:=areay(w)+((areaysize(w)-ysize)DIV2)END PROCermittleboxgroesse;PROCschreibeboxtext(WINDOW VARw,TEXT CONSTt,INT CONSTposition,zusatzlaenge,mindestbreite,mindesthoehe,INT VARx,y,xsize,ysize):ROW24TEXT VARtexte;INT VARanzahltexte;INT VARi;zerteiletexte(t,texte,anzahltexte);FORiFROManzahltexte+1UPTO24REPEATtexte(i):=""PER;ermittleboxgroesse(w,position,zusatzlaenge,mindestbreite,mindesthoehe,anzahltexte,texte,x,y,xsize,ysize);schreibeboxkopf;schreibeboxrumpf.schreibeboxkopf:cursor(x,y);out(eckeobenlinks);out((xsize-2)*waagerecht);out(eckeobenrechts).schreibeboxrumpf:FORiFROM1UPTOysize-zusatzlaenge-2REPcursor(x,y+i);out(senkrecht+text(texte(i),xsize-2)+senkrecht)PER.END PROCschreibeboxtext;PROCschreibeboxfuss(WINDOW VARw,INT CONSTx,y,xsize,ysize,limit):schreibeabschlusszeile;footnote(aussage[1]);cursorinpositionundwarten.schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).cursorinpositionundwarten:cursorparken(w);clearbuffer;pause(limit)END PROCschreibeboxfuss;PROCcursorparken(WINDOW VARw):cursor(w,1,2)END PROCcursorparken;PROCschreibebox(WINDOW VARw,TEXT CONSTt,INT CONSTposition,timelimit,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibeboxfuss(w,x,y,xsize,ysize,timelimit)END PROCschreibebox;PROCschreibenotizfuss(WINDOW VARw,INT + CONSTx,y,xsize,ysize):schreibeabschlusszeile;cursorparken(w).schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).END PROCschreibenotizfuss;PROCschreibenotiz(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):schreibeboxtext(w,t,position,0,0,0,x,y,xsize,ysize);schreibenotizfuss(w,x,y,xsize,ysize)END PROCschreibenotiz;PROCschreibealternativen(WINDOW VARw,TEXT CONSTt,altzeile,sonst,INT CONSTposition,BOOL CONSTmitabbruch,INT VARx,y,xsize,ysize,ergebnis):ROW24TEXT VARtexte;TEXT VARtasten:=gueltigezeichen+sonst;INT VARbelegt,obersteauswahlzeile,untersteauswahlzeile,maxlaenge,kommando,aktpos;BOOL VARausgewaehlt:=FALSE;IFmitabbruchTHENtastenCATescFI;zerteiletexte(altzeile,texte,belegt);errechnemaximalelaengederalternativen;cursoroff;schreibeboxtext(w,t,position,belegt,maxlaenge+9,0,x,y,xsize,ysize);schreibepraefixintexte;obersteauswahlzeile:=ysize-belegt;untersteauswahlzeile:=ysize;schreibealternativenaufbildschirm;schreibefusszeile;lasseauswaehlen;cursoron.errechnemaximalelaengederalternativen:INT VARi;maxlaenge:=0;FORiFROM1UPTObelegtREPEATmaxlaenge:=max(maxlaenge,LENGTHtexte(i))PER.schreibepraefixintexte:FORiFROM1UPTObelegtREPEAT IF(sonstSUBi)=trennliniensymbolTHENtexte(i):=(xsize-2)*trennliniensymbolELSEtexte(i):=(sonstSUBi)+" "+texte(i)END IF PER.schreibealternativenaufbildschirm:WINDOW VARhilf:=window(x,y,xsize,ysize);markiere(hilf,texte(1),obersteauswahlzeile);FORiFROM2UPTObelegtREPEATdemarkiere(hilf,texte(i),obersteauswahlzeile+i-1)PER.schreibefusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks+(xsize-2)*waagerecht+eckeuntenrechts);IFmitabbruchTHENfootnote(aussage[2])ELSEberuecksichtigejaneinhinweisFI.beruecksichtigejaneinhinweis:IFsonst=janeintastenTHENfootnote(aussage[3])ELSEfootnote(aussage[4])FI.lasseauswaehlen:aktpos:=1;REPlieszeichen;interpretierezeichenUNTILausgewaehltEND REP;ergebnis:=aktpos.lieszeichen:TEXT VARzeichen;REPinchar(zeichen)UNTILzeichengueltigEND REP.zeichengueltig:kommando:=pos(tasten,zeichen);IFkommando=0THENout(piep);FALSE ELSE TRUE FI.interpretierezeichen:demarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);IFzeichen=escTHENpruefeaufescabbruchELSE SELECTkommandoOF CASE1:einsnachuntenCASE2:einsnachobenCASE3:ausgewaehlt:=TRUE OTHERWISEmittasteausgewaehltEND SELECT;IF NOTausgewaehltTHENmarkiere(hilf,texte(aktpos),obersteauswahlzeile+aktpos-1);END IF END IF.einsnachunten:REPaktpos:=aktposMODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.einsnachoben:REPaktpos:=(aktpos+belegt-2)MODbelegt+1UNTIL(sonstSUBaktpos)<>trennliniensymbolEND REPEAT.mittasteausgewaehlt:IFzeichen=trennliniensymbolTHENout(piep)ELSEaktpos:=kommando-3+100;ausgewaehlt:=TRUE END IF.pruefeaufescabbruch:inchar(zeichen);IFzeichen=abbruchTHENausgewaehlt:=TRUE;aktpos:=0ELSEout(piep)FI END PROCschreibealternativen;PROCmarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outinverswithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCmarkiere;PROCdemarkiere(WINDOW VARw,TEXT CONSTt,INT CONSTzeile):outwithbeam(area(w),4,zeile,t,areaxsize(w)-6)END PROCdemarkiere;BOOL PROCja(WINDOW VARw,TEXT CONSTt,INT CONSTposition,INT VARx,y,xsize,ysize):INT VARergebnis;schreibealternativen(w,t+"?",aussage[7],janeintasten,position,FALSE,x,y,xsize,ysize,ergebnis);ergebnis=1ORergebnis=101END PROCja;TEXT PROCholeantwort(WINDOW VARw,TEXT CONSTt,vorgabe,INT CONSTposition,BOOL CONSTmitauswahl,INT VARx,y,xsize,ysize):TEXT VAReingabe:=vorgabe;schreibeboxtext(w,t,position,2,length(aussage[8])+12,2,x,y,xsize,ysize);schreibeantwortfuss;clearbuffer;REP IFeingabe="break"THENeingabe:=""FI;lasseeintragenUNTILeingabe<>"break"PER;liefereergebnis.schreibeantwortfuss:schreibeleerzeile;schreibeeingabezeile;schreibeabschlusszeile;IFmitauswahlTHENfootnote(aussage[5])ELSEfootnote(aussage[6])FI.schreibeleerzeile:cursor(x,y+ysize-3);out(senkrecht);out((xsize-2)*blank);out(senkrecht).schreibeeingabezeile:cursor(x,y+ysize-2);out(senkrecht);out(aussage[8]);out((xsize-2-length(aussage[8]))*blank);out(senkrecht). +schreibeabschlusszeile:cursor(x,y+ysize-1);out(eckeuntenlinks);out((xsize-2)*waagerecht);out(eckeuntenrechts).lasseeintragen:TEXT VARexit:="";cursoron;cursor(x+length(aussage[8])+1,y+ysize-2);IFmitauswahlTHENeditget(eingabe,maxtextlength,textlaenge,"",abbruch+auswahl,exit)ELSEeditget(eingabe,maxtextlength,textlaenge,"",abbruch,exit)FI;cursoroff;IFexit=esc+abbruchTHENeingabe:="";lsexitkey(abbruch)ELIFmitauswahlAND(exit=esc+auswahl)THENeingabe:=esc+auswahl;lsexitkey(auswahl);ELSElsexitkey("");eingabe:=compress(eingabe)FI.textlaenge:xsize-2-length(aussage[8]).liefereergebnis:eingabeEND PROCholeantwort;END PACKETlsdialog4 + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe new file mode 100644 index 0000000..608cae7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-DIALOG 5.mathe @@ -0,0 +1,9 @@ +PACKETlsdialog5DEFINESwritehead,restorehead,menuinfo,menualternative,menuyes,menuno,menuone,menusome,menuanswer,installmenu,handlemenu,refreshsubmenu,deactivate,regeneratemenuscreen,activate,writemenunotice,erasemenunotice,menubasistext,anwendungstext,showmenuwindow,menuwindowpage,menuwindowout,menuwindowline,menuwindowyes,menuwindowno,menuwindowcursor,getmenuwindowcursor,remainingmenuwindowlines,menuwindowcenter,menuwindowstop,menukartenname,currentmenuwindow,resetdialog,ausstieg:LETmenutafeltaskname="ls-MENUKARTEN",menutafeltype=1954,menutafelpraefix="ls-MENUKARTE:",maxmenus=6,maxmenutexte=300,maxinfotexte=2000,maxhauptmenupunkte=10,maxuntermenupunkte=15,ersteuntermenuzeile=3;LETblank=" ",verlassen="q",piep="�",trennzeilensymbol="###",hauptmenuluecke=" ";LETauswahlstring1="�� +�
�?";TYPE MENUPUNKT=STRUCT(TEXTpunktkuerzel,punktname,procname,boxtext,BOOLaktiv,angewaehlt),EINZELMENU=STRUCT(INTbelegt,TEXTueberschrift,INTanfangsposition,maxlaenge,ROWmaxuntermenupunkteMENUPUNKTmenupunkt,INTaktuelleruntermenupunkt,TEXTstartprozedurname,leaveprozedurname),MENU=STRUCT(TEXTmenuname,kopfzeile,INTanzahlhauptmenupunkte,ROWmaxhauptmenupunkteEINZELMENUeinzelmenu,TEXTmenueingangsprozedur,menuausgangsprozedur,menuinfo,lizenznummer,versionsnummer,INThauptmenuzeiger,untermenuanfang,untermenuzeiger),INFOTEXT=STRUCT(INTanzahlinfotexte,ROWmaxinfotexteTEXTstelle),MENUTEXT=STRUCT(INTanzahlmenutexte,ROWmaxmenutexteTEXTplatz),MENULEISTE=STRUCT(INTbelegt,zeigeraktuell,zeigerhintergrund,ROWmaxmenusMENUmenu,MENUTEXTmenutext,INFOTEXTinfotext);BOUND MENULEISTE VARmenuleiste;DATASPACE VARds;WINDOW VARmenuwindow,schreibfenster;WINDOW VARzweitesmenu:=window(6,5,73,19);INITFLAG VARinthistask:=FALSE;INT VARanzahloffenermenus:=0;INT VARmenunotizx,menunotizxsize,menunotizy,menunotizysize,menunotizposition;TEXT VARangekoppeltemenutafel:="",menunotiztext;BOOL VARmenunotizistgesetzt:=FALSE,mitausstieg:=FALSE,hochruntererlaubt:=TRUE,activationchanged:=FALSE;ROW13TEXT CONSTfehlermeldung:=ROW13TEXT:("Die Task '"+menutafeltaskname+"' existiert nicht!","Die Menükarte '","' existiert nicht in der Task '"+menutafeltaskname+"'!","' hat falschen Typ/Bezeichnung (keine 'MENÜKARTE')!","Das Menü '","' ist nicht in der angekoppelten Menükarte!","Zu viele geöffnete Menüs ( > 2 )!","Kein Menü geöffnet!","Menü enthält keine Menüpunkte!","Menüpunkt ist nicht im Menü enthalten!","Kein Text vorhanden!","Zugriff unmöglich!","Einschränkung unzulässig!");ROW1TEXT CONSTvergleichstext:=ROW1TEXT:("gibt es nicht");ROW3TEXT CONSThinweis:=ROW3TEXT:(" Info:<ESC><?>/<?> Wählen:<Pfeile> Bestätigen:<RETURN> Verlassen:<ESC><q>"," Weiter mit beliebiger Taste!"," Bitte warten...!");ROW3TEXT CONSTinfotext:=ROW3TEXT:(" Für diesen Menüpunkt ist (noch) keine
Funktion eingetragen!"," Möchten Sie dieses Menü tatsächlich verlassen"," Leider ist zu diesem Menüpunkt
kein Info - Text eingetragen!");PROCinstallmenu(TEXT CONSTmenutafelname):installmenu(menutafelname,TRUE)END PROCinstallmenu;PROCinstallmenu(TEXT CONSTmenutafelname,BOOL CONSTmitkennung):TEXT VARletzterparameter;IFmitkennungTHENzeigemenukennungFI;initialisieremenuggf;IFmenutafelnochnichtangekoppeltTHENletzterparameter:=std;holemenutafel;kopplemenutafelan;lastparam(letzterparameter)FI.initialisieremenuggf:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI.menutafelnochnichtangekoppelt:menutafelname<>angekoppeltemenutafel.holemenutafel:IF NOTexiststask(menutafeltaskname)THENbereinigesituation;cursoron;errorstop(fehlermeldung[1])FI;disablestop;fetch(menutafelname,/menutafeltaskname);IFiserrorANDpos(errormessage,vergleichstext[1])>0THENclearerror;enablestop;bereinigesituation;cursoron;errorstop(fehlermeldung[2]+menutafelname+fehlermeldung[3])ELIFiserrorTHENclearerror;enablestop;bereinigesituation;cursoron;errorstop(errormessage)ELSEenablestopFI.kopplemenutafelan:IFtype(old(menutafelname))=menutafeltypeANDpos(menutafelname,menutafelpraefix)=1THENforget(ds);ds:=old(menutafelname +);menuleiste:=ds;angekoppeltemenutafel:=menutafelname;forget(menutafelname,quiet)ELSEbereinigesituation;cursoron;errorstop("'"+menutafelname+fehlermeldung[4])FI.END PROCinstallmenu;PROCausstieg(BOOL CONSTwert):mitausstieg:=wertEND PROCausstieg;TEXT PROCmenukartenname:IF NOTinitialized(inthistask)THENangekoppeltemenutafel:="";anzahloffenermenus:=0;menunotizistgesetzt:=FALSE;FI;angekoppeltemenutafelEND PROCmenukartenname;PROChandlemenu(TEXT CONSTmenuname):mitausstieg:=TRUE;cursoroff;bietemenuan;lassemenupunkteauswaehlen;schliessemenu;leereggfdenbildschirm.bietemenuan:oeffnemenu(menuname).leereggfdenbildschirm:IFanzahloffenermenus<1THENerasemenunotice;page;cursoronFI.lassemenupunkteauswaehlen:TEXT VARkuerzelkette:="";starteaktuelleuntermenuoperationen;disablestop;REPcursorinwarteposition;ermittleaktuellekuerzelkette(kuerzelkette);nimmzeichenauf;interpretierezeichenUNTILmenuverlassengewuenschtPER.nimmzeichenauf:TEXT CONSTerlaubtezeichen:=auswahlstring1+kuerzelkette;TEXT VAReingabezeichen;INT VARzeichenposition;REPinchar(eingabezeichen);pruefeobfehler;zeichenposition:=pos(erlaubtezeichen,eingabezeichen);piepseggfUNTILzeichenposition>0PER.piepseggf:IFzeichenposition=0THENout(piep)FI.menuverlassengewuenscht:zeichenposition=6AND(zweiteszeichen=verlassen).interpretierezeichen:SELECTzeichenpositionOF CASE1,2:geheeinenhauptmenupunktnachlinksoderrechtsCASE3:geheeinenuntermenupunktnachuntenCASE4:geheeinenuntermenupunktnachobenCASE5:fuehreaktuellenmenupunktausCASE6:holeescsequenzCASE7:zeigeerklaerungstextimmenuanOTHERWISEwertekuerzeleingabeausEND SELECT.pruefeobfehler:IFiserrorTHENclearerror;regeneratemenuscreen;menuinfo(errormessage)END IF.geheeinenhauptmenupunktnachlinksoderrechts:INT VARanzahlschritte:=1;beendeaktuelleuntermenuoperationen;loescheaktuellesuntermenuaufbildschirm;loeschealtehauptmenumarkierung;IFzeichenposition=1THENanzahlschritteINCRclearbufferandcount("�");ermittlelinkemenuposition;ELSEanzahlschritteINCRclearbufferandcount("�");ermittlerechtemenuposition;END IF;stelleaktuellenhauptmenupunktinversdar;starteaktuelleuntermenuoperationen;schreibeaktuellesuntermenuaufbildschirm.loeschealtehauptmenumarkierung:eraseinvers(area(menuwindow),startpos,1,ueberschriftlaenge);out(area(menuwindow),startpos,1,ueberschrifttext).startpos:aktuellesuntermenu.anfangsposition.ueberschriftlaenge:length(ueberschrifttext).ueberschrifttext:aktuellesuntermenu.ueberschrift.ermittlelinkemenuposition:INT VARpositionszaehler;FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwertrunterPER.ermittlerechtemenuposition:FORpositionszaehlerFROM1UPTOanzahlschritteREPdrehediemenupositionumeinenwerthochPER.drehediemenupositionumeinenwertrunter:IFaktuellesmenu.hauptmenuzeiger>1THENaktuellesmenu.hauptmenuzeigerDECR1ELSEaktuellesmenu.hauptmenuzeiger:=aktuellesmenu.anzahlhauptmenupunkteFI.drehediemenupositionumeinenwerthoch:IFaktuellesmenu.hauptmenuzeiger<aktuellesmenu.anzahlhauptmenupunkteTHENaktuellesmenu.hauptmenuzeigerINCR1ELSEaktuellesmenu.hauptmenuzeiger:=1FI.geheeinenuntermenupunktnachunten:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachuntenEND IF;INT VARnaechsteraktiver:=folgenderaktiveruntermenupunkt;nimmummarkierungvor.geheeinenuntermenupunktnachoben:IF NOThochruntererlaubtTHENout(piep);LEAVEgeheeinenuntermenupunktnachobenEND IF;naechsteraktiver:=vorausgehenderaktiveruntermenupunkt;nimmummarkierungvor.nimmummarkierungvor:IFueberhauptaktivemenupunktevorhandenTHENdemarkiereaktuellenuntermenupunkt;gehezumfolgendenuntermenupunkt;markiereaktuellenuntermenupunktFI.ueberhauptaktivemenupunktevorhanden:(aktuellesuntermenu.belegt>0)CAND(naechsteraktiver>0).gehezumfolgendenuntermenupunkt:aktuellesmenu.untermenuzeiger:=naechsteraktiver.stelleaktuellenhauptmenupunktinversdar:outinvers(area(menuwindow),startpos,1,ueberschrifttext).fuehreaktuellenmenupunktaus:IFaktuellesmenu.untermenuzeiger<>0THENkennzeichnealsangetickt;fuehreoperationaus(menuanweisung);IFactivationchangedTHENactivationchanged:=FALSE;refreshsubmenu;IF +folgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF END IF;nimmkennzeichnungzurueckELSEout(piep)FI.kennzeichnealsangetickt:aktuellermenupunkt.angewaehlt:=TRUE;markiereaktuellenuntermenupunkt.nimmkennzeichnungzurueck:IFaktuellesmenu.untermenuzeiger<>0THENaktuellermenupunkt.angewaehlt:=FALSE;markiereaktuellenuntermenupunktEND IF.menuanweisung:compress(aktuellermenupunkt.procname).aktuellermenupunkt:aktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].holeescsequenz:TEXT VARzweiteszeichen;inchar(zweiteszeichen);SELECTpos(verlassen+"?$",zweiteszeichen)OF CASE1:CASE2:menuinfo(menuleiste.menutext.platz[4],5,maxint)CASE3:gibinfoausOTHERWISEout(piep)END SELECT.wertekuerzeleingabeaus:naechsteraktiver:=pos(kuerzelkette,eingabezeichen);nimmummarkierungvor;fuehreaktuellenmenupunktaus.gibinfoaus:menuinfo(menuleiste.menutext.platz[20]).zeigeerklaerungstextimmenuan:IFaktuellesmenu.untermenuzeiger>0THEN IFcompress(erklaerungstext)=""THENmenuinfo(infotext[3])ELSEmenuinfo(erklaerungstext)FI FI.erklaerungstext:aktuellermenupunkt.boxtext.beendeaktuelleuntermenuoperationen:kuerzelkette:="".starteaktuelleuntermenuoperationen:ermittleaktuellekuerzelkette(kuerzelkette);IFstartoperation<>""THENfuehreoperationaus(startoperation)FI.startoperation:compress(aktuellesuntermenu.startprozedurname).END PROChandlemenu;PROCermittleaktuellekuerzelkette(TEXT VARkuerzelkette):kuerzelkette:="";INT VARkuerzelzeiger;FORkuerzelzeigerFROM1UPTOaktuellesuntermenu.belegtREP IFcompress(aktuellespunktkuerzel)=""THENkuerzelketteCAT"�"ELSEhaengeggfkuerzelanFI PER.aktuellespunktkuerzel:aktuellesuntermenu.menupunkt[kuerzelzeiger].punktkuerzel.haengeggfkuerzelan:IFbetrachteterpunktistaktivTHENkuerzelketteCATaktuellespunktkuerzelELSEkuerzelketteCAT"�"FI.betrachteterpunktistaktiv:aktuellesuntermenu.menupunkt[kuerzelzeiger].aktivEND PROCermittleaktuellekuerzelkette;PROCoeffnemenu(TEXT CONSTmenuname):cursoroff;sucheeingestelltesmenu;ueberpruefeanzahloffenermenus;aktuellesmenu.hauptmenuzeiger:=1;aktuellesmenu.untermenuzeiger:=0;aktuellesmenu.untermenuanfang:=0;fuehreggfmenueingangsprozeduraus;showmenu;.sucheeingestelltesmenu:INT VARi,suchzeiger;BOOL VARgefunden:=FALSE;FORiFROM1UPTOmenuleiste.belegtREP IFmenuleiste.menu[i].menuname=menunameTHENgefunden:=TRUE;suchzeiger:=iFI UNTILgefundenPER;IF NOTgefundenTHENcursoron;page;errorstop(fehlermeldung[5]+menuname+fehlermeldung[6])FI;anzahloffenermenusINCR1.ueberpruefeanzahloffenermenus:IFanzahloffenermenus=1THENmenuwindow:=window(1,2,79,23)ELIFanzahloffenermenus=2THENmenuleiste.zeigerhintergrund:=menuleiste.zeigeraktuell;menuwindow:=zweitesmenuELSEanzahloffenermenus:=0;cursoron;errorstop(fehlermeldung[7])FI;menuleiste.zeigeraktuell:=suchzeiger;hochruntererlaubt:=TRUE.fuehreggfmenueingangsprozeduraus:IFaktuellesmenu.menueingangsprozedur<>""THENfuehreoperationaus(aktuellesmenu.menueingangsprozedur)FI.END PROCoeffnemenu;PROCshowmenu:ueberpruefemenudaten;page;schreibekopfzeile;stellehauptmenuleistezusammen;zeigehauptmenuan;stelleaktuellenhauptmenupunktinversdar;schreibeaktuellesuntermenuaufbildschirm;zeigeinformationszeilean.ueberpruefemenudaten:IFanzahloffenermenus=0THENerrorstop(fehlermeldung[8])ELIFaktuellesmenu.anzahlhauptmenupunkte<1THENerrorstop(fehlermeldung[9])FI.schreibekopfzeile:IFaktuellesmenu.kopfzeile<>""THENcursor(1,1);out(invers(text(aktuellesmenu.kopfzeile,77)))END IF.stellehauptmenuleistezusammen:TEXT VARhauptmenuzeile:=aktuellesmenu.menuname;INT VARzeiger;hauptmenuzeileCAT":";FORzeigerFROM1UPTOaktuellesmenu.anzahlhauptmenupunkteREPhaengehauptmenupunktanPER.haengehauptmenupunktan:hauptmenuzeileCAThauptmenuluecke;hauptmenuzeileCAThauptmenupunktname.hauptmenupunktname:aktuellesmenu.einzelmenu[zeiger].ueberschrift.zeigehauptmenuan:cursor(1,2);out(hauptmenuzeile);cursor(1,3);out(79*waagerecht).stelleaktuellenhauptmenupunktinversdar:cursor(menuwindow,startposition,1);out(menuwindow,invers(ueberschrifttext)).startposition:aktuellesuntermenu.anfangsposition-1.ueberschrifttext: +aktuellesuntermenu.ueberschrift.zeigeinformationszeilean:writepermanentfootnote(hinweis[1])END PROCshowmenu;PROCschreibeaktuellesuntermenuaufbildschirm:ermittlelinkeobereeckedesuntermenukastens;zeichnequerlinieneu;wirfuntermenuaus;showmenunotice;cursorinwarteposition.ermittlelinkeobereeckedesuntermenukastens:aktuellesmenu.untermenuanfang:=menumitte-halbemenubreite;achteaufrandextrema.menumitte:startposition+(length(ueberschrifttext)DIV2)-1.startposition:aktuellesuntermenu.anfangsposition.ueberschrifttext:aktuellesuntermenu.ueberschrift.halbemenubreite:aktuellesuntermenu.maxlaengeDIV2.achteaufrandextrema:gleicheggflinkenrandaus;gleicheggfrechtenrandaus.zeichnequerlinieneu:cursor(1,3);out(79*waagerecht).gleicheggflinkenrandaus:IFaktuellesmenu.untermenuanfang<4THENaktuellesmenu.untermenuanfang:=4FI.gleicheggfrechtenrandaus:IF(aktuellesmenu.untermenuanfang+aktuellesuntermenu.maxlaenge)>(areaxsize(menuwindow)-3)THENaktuellesmenu.untermenuanfang:=areaxsize(menuwindow)-aktuellesuntermenu.maxlaenge-3FI.wirfuntermenuaus:TEXT VARlinie:=(aktuellesuntermenu.maxlaenge+5)*waagerecht;IFaktuellesmenu.untermenuzeiger=0THENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI;wirfuntermenukopfzeileaus;wirfuntermenurumpfaus;wirfuntermenufusszeileaus;markiereaktuellenuntermenupunkt.wirfuntermenukopfzeileaus:cursor(menuwindow,spalte,anfangszeile);out(balkenoben);out(linie);out(balkenoben).wirfuntermenufusszeileaus:cursor(menuwindow,spalte,endezeile);out(eckeuntenlinks);out(linie);out(eckeuntenrechts).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.endezeile:ersteuntermenuzeile+aktuellesuntermenu.belegt.wirfuntermenurumpfaus:INT VARlaufvar;INT CONSTaktuellepunktlaenge:=aktuellesuntermenu.maxlaenge+1;FORlaufvarFROM1UPTOaktuellesuntermenu.belegtREPwirfeineeinzelnemenuzeileausPER.wirfeineeinzelnemenuzeileaus:outwithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.aktuellerpunktname:untermenubezeichnung(laufvar).laenge:aktuellepunktlaengeEND PROCschreibeaktuellesuntermenuaufbildschirm;PROCloescheaktuellesuntermenuaufbildschirm:beendeaktuelleuntermenuoperationen;loescheuntermenuaufbildschirm;schreibebalkenwiederhin;aktuellesmenu.untermenuzeiger:=1.beendeaktuelleuntermenuoperationen:IFleaveoperation<>""THENfuehreoperationaus(leaveoperation)FI.leaveoperation:compress(aktuellesuntermenu.leaveprozedurname).loescheuntermenuaufbildschirm:INT VARlaufvar;FORlaufvarFROMaktuellesuntermenu.belegt+1DOWNTO1REPloescheeineeinzelnemenuzeilePER.loescheeineeinzelnemenuzeile:erasewithbeam(area(menuwindow),menuspalte,menuzeile,laenge).menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile+laufvar-1.laenge:aktuellesuntermenu.maxlaenge+1.schreibebalkenwiederhin:cursor(menuwindow,spalte,anfangszeile);out((aktuellesuntermenu.maxlaenge+7)*waagerecht).spalte:aktuellesmenu.untermenuanfang-3.anfangszeile:ersteuntermenuzeile-1.END PROCloescheaktuellesuntermenuaufbildschirm;PROCmarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENlaufeggfzumnaechstenaktivenmenupunkt;IFaktuellesmenu.untermenuzeiger<>0THENoutinverswithbeam(area(menuwindow),menuspalte,menuzeile,aktuellerpunktname,laenge)FI;IFfolgenderaktiveruntermenupunkt=0THENhochruntererlaubt:=FALSE ELSEhochruntererlaubt:=TRUE END IF ELSEhochruntererlaubt:=FALSE FI.laufeggfzumnaechstenaktivenmenupunkt:IF NOTaktuellesuntermenu.menupunkt[aktuellesmenu.untermenuzeiger].aktivTHENaktuellesmenu.untermenuzeiger:=folgenderaktiveruntermenupunktFI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCmarkiereaktuellenuntermenupunkt;PROCdemarkiereaktuellenuntermenupunkt:IFaktuellesmenu.untermenuzeiger<>0THENeraseinvers(area(menuwindow),menuspalte,menuzeile,laenge);out(area(menuwindow),menuspalte,menuzeile, +aktuellerpunktname,laenge)FI.menuspalte:aktuellesmenu.untermenuanfang.menuzeile:ersteuntermenuzeile-1+aktuellesmenu.untermenuzeiger.aktuellerpunktname:untermenubezeichnung(aktuellesmenu.untermenuzeiger).laenge:aktuellesuntermenu.maxlaenge+1END PROCdemarkiereaktuellenuntermenupunkt;INT PROCfolgenderaktiveruntermenupunkt:INT VARnaechster,aktueller,anzahl,zeiger;zeiger:=aktuellesmenu.untermenuzeiger;IFzeiger=0THEN IFaktuellesuntermenu.menupunkt[1].aktivTHEN LEAVEfolgenderaktiveruntermenupunktWITH1ELSEaktueller:=1END IF ELSEaktueller:=zeigerEND IF;naechster:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugenachfolger;IFnaechster=aktuellerTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[naechster].aktivTHENaktuellesmenu.untermenuzeiger:=zeiger;LEAVEfolgenderaktiveruntermenupunktWITHnaechsterEND IF PER;0.erzeugenachfolger:naechster:=(naechsterMODanzahl)+1END PROCfolgenderaktiveruntermenupunkt;INT PROCvorausgehenderaktiveruntermenupunkt:INT VARvoriger,aktueller,anzahl;aktueller:=aktuellesmenu.untermenuzeiger;voriger:=aktueller;anzahl:=aktuellesuntermenu.belegt;REPerzeugevorgaenger;IFvoriger=aktuellerTHEN LEAVEvorausgehenderaktiveruntermenupunktWITH0ELIFaktuellesuntermenu.menupunkt[voriger].aktivTHEN LEAVEvorausgehenderaktiveruntermenupunktWITHvorigerEND IF PER;0.erzeugevorgaenger:voriger:=((voriger+anzahl-2)MODanzahl)+1END PROCvorausgehenderaktiveruntermenupunkt;PROCcursorinwarteposition:cursor(areax(menuwindow),areay(menuwindow)+1)END PROCcursorinwarteposition;TEXT PROCuntermenubezeichnung(INT CONSTposition):TEXT VARbezeichnung:=kennzeichnung;bezeichnungCATpunktkennung;bezeichnung.kennzeichnung:IFaktuellermenupunkt.aktivTHEN IFaktuellermenupunkt.angewaehltTHEN"*"ELIFaktuellermenupunkt.punktkuerzel<>""THENaktuellermenupunkt.punktkuerzelELSEblankFI ELSE"-"FI.punktkennung:IFmenupunktisttrennzeileTHENstrichellinieELSEaktuellermenupunkt.punktnameFI.menupunktisttrennzeile:aktuellermenupunkt.punktname=(blank+trennzeilensymbol).strichellinie:(aktuellesuntermenu.maxlaenge+1)*"-".aktuellermenupunkt:aktuellesuntermenu.menupunkt[position]END PROCuntermenubezeichnung;PROCfuehreoperationaus(TEXT CONSToperation):disablestop;IFoperation=""THENmenuinfo(infotext[1]);LEAVEfuehreoperationausFI;do(operation);IFiserrorTHENclearerror;oldfootnote;regeneratemenuscreen;menuinfo(errormessage,5)FI;enablestop;cursoroffEND PROCfuehreoperationaus;PROCveraendereaktivierung(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereaktivierung.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;LEAVEveraendereaktivierung.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereaktivierung:veraendereaktivierung(unterpunktposition,eintrag)END PROCveraendereaktivierung;PROCveraendereaktivierung(INT CONSTpunktnummer,BOOL CONSTeintrag):IFpunktnummer>=1ANDpunktnummer<=untermenuendeTHENaktuellesuntermenu.menupunkt[punktnummer].angewaehlt:=FALSE;aktuellesuntermenu.menupunkt[punktnummer].aktiv:=eintrag;activationchanged:=TRUE;FI.untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegtEND PROCveraendereaktivierung;PROCveraendereanwahl(TEXT CONSTunterpunkt,BOOL CONSTeintrag):INT VARunterpunktposition:=0,zeiger;sucheunterpunkt;aendereanwahl.sucheunterpunkt:FORzeigerFROM1UPTOuntermenuendeREP IFuntermenupunkt=blank+compress(unterpunkt)THENunterpunktposition:=zeiger;LEAVEsucheunterpunktFI PER;enablestop;errorstop(fehlermeldung[10]).untermenuende:aktuellesmenu.einzelmenu[aktuellesmenu.hauptmenuzeiger].belegt.untermenupunkt:aktuellesuntermenu.menupunkt[zeiger].punktname.aendereanwahl:aktuellesuntermenu.menupunkt[unterpunktposition].angewaehlt:=eintragEND PROCveraendereanwahl;PROCactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,TRUE)END PROC +activate;PROCactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,TRUE)END PROCactivate;PROCdeactivate(TEXT CONSTunterpunkt):enablestop;veraendereaktivierung(unterpunkt,FALSE)END PROCdeactivate;PROCdeactivate(INT CONSTpunktnummer):enablestop;veraendereaktivierung(punktnummer,FALSE)END PROCdeactivate;PROCselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,TRUE)END PROCselect;PROCdeselect(TEXT CONSTunterpunkt):enablestop;veraendereanwahl(unterpunkt,FALSE)END PROCdeselect;PROCschliessemenu:IFaktuellesmenu.menuausgangsprozedur<>""THENfootnote(hinweis[3]);fuehreoperationaus(aktuellesmenu.menuausgangsprozedur)FI;anzahloffenermenusDECR1;IFanzahloffenermenus=1THENaktivieredasaufeisgelegtemenuFI.aktivieredasaufeisgelegtemenu:hochruntererlaubt:=TRUE;menuleiste.zeigeraktuell:=menuleiste.zeigerhintergrund;menuwindow:=window(1,2,79,23);showmenuEND PROCschliessemenu;PROCrefreshsubmenu:schreibeaktuellesuntermenuaufbildschirm;showmenunotice;activationchanged:=FALSE END PROCrefreshsubmenu;PROCregeneratemenuscreen:page;showmenu;showmenunotice;activationchanged:=FALSE.END PROCregeneratemenuscreen;PROCmenuinfo(TEXT CONSTt,INT CONSTposition,timelimit):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);boxinfo(w,t,position,timelimit);oldfootnote;schreibeaktuellesuntermenuaufbildschirmEND PROCmenuinfo;PROCmenuinfo(TEXT CONSTt,INT CONSTposition):menuinfo(t,position,maxint)END PROCmenuinfo;PROCmenuinfo(TEXT CONSTt):menuinfo(t,5,maxint)END PROCmenuinfo;INT PROCmenualternative(TEXT CONSTt,auswahlliste,zusatztasten,INT CONSTposition,BOOL CONSTmitabbruch):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);INT VARergebnis:=boxalternative(w,t,auswahlliste,zusatztasten,position,mitabbruch);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;ergebnisEND PROCmenualternative;BOOL PROCmenuyes(TEXT CONSTfrage,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);BOOL VARwert:=boxyes(w,frage,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuyes;BOOL PROCmenuno(TEXT CONSTfrage,INT CONSTposition):NOTmenuyes(frage,position)END PROCmenuno;TEXT PROCmenuone(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT CONSTwert:=boxone(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;wertEND PROCmenuone;THESAURUS PROCmenusome(THESAURUS CONSTthes,TEXT CONSTt1,t2,BOOL CONSTmitreinigung):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);THESAURUS CONSTthesaurus:=boxsome(w,thes,t1,t2,mitreinigung);IFmitreinigungTHENoldfootnote;schreibeaktuellesuntermenuaufbildschirmFI;thesaurusEND PROCmenusome;TEXT PROCmenuanswer(TEXT CONSTt,vorgabe,INT CONSTposition):WINDOW VARw:=window(areax(menuwindow),areay(menuwindow)+1,areaxsize(menuwindow),areaysize(menuwindow)-2);TEXT VARwert:=boxanswer(w,t,vorgabe,position);oldfootnote;schreibeaktuellesuntermenuaufbildschirm;wertEND PROCmenuanswer;TEXT PROCmenubasistext(INT CONSTnummer):IFnummer<=20THENfehlermeldung[12]ELIFnummer>menuleiste.menutext.anzahlmenutexteTHENfehlermeldung[11]ELSEmenuleiste.menutext.platz[nummer]FI END PROCmenubasistext;TEXT PROCanwendungstext(INT CONSTnummer):IFnummer>menuleiste.infotext.anzahlinfotexteTHENfehlermeldung[11]ELSEmenuleiste.infotext.stelle[nummer]FI END PROCanwendungstext;PROCzeigemenukennung:END PROCzeigemenukennung;PROCresetdialog:angekoppeltemenutafel:="";anzahloffenermenus:=0END PROCresetdialog;PROCwritemenunotice(TEXT CONSTt,INT CONSTposition):erasemenunotice;boxnotice(menuwindow,t,position,menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotiztext:=t;menunotizposition:=position;menunotizistgesetzt:=TRUE END PROCwritemenunotice;PROCshowmenunotice +:IFmenunotizistgesetztTHENboxnotice(menuwindow,menunotiztext,menunotizposition,menunotizx,menunotizy,menunotizxsize,menunotizysize);FI END PROCshowmenunotice;PROCerasemenunotice:INT VARspa,zei;getcursor(spa,zei);IFmenunotizistgesetztTHENpageup(menunotizx,menunotizy,menunotizxsize,menunotizysize);menunotizistgesetzt:=FALSE;cursor(spa,zei)FI END PROCerasemenunotice;PROCinitializemenuwindow:schreibfenster:=window(areax(menuwindow)+1,areay(menuwindow)+3,areaxsize(menuwindow)-2,areaysize(menuwindow)-4)END PROCinitializemenuwindow;PROCshowmenuwindow:initializemenuwindow;show(schreibfenster);END PROCshowmenuwindow;PROCmenuwindowpage:initializemenuwindow;page(schreibfenster)END PROCmenuwindowpage;PROCmenuwindowout(TEXT CONSTtext):out(schreibfenster,text)END PROCmenuwindowout;BOOL PROCmenuwindowyes(TEXT CONSTfrage):yes(schreibfenster,frage)END PROCmenuwindowyes;BOOL PROCmenuwindowno(TEXT CONSTfrage):no(schreibfenster,frage)END PROCmenuwindowno;PROCmenuwindowline:menuwindowline(1)END PROCmenuwindowline;PROCmenuwindowline(INT CONSTanzahl):line(schreibfenster,anzahl)END PROCmenuwindowline;PROCmenuwindowcursor(INT CONSTspa,zei):cursor(schreibfenster,spa,zei)END PROCmenuwindowcursor;PROCgetmenuwindowcursor(INT VARspa,zei):getcursor(schreibfenster,spa,zei)END PROCgetmenuwindowcursor;INT PROCremainingmenuwindowlines:remaininglines(schreibfenster)END PROCremainingmenuwindowlines;TEXT PROCmenuwindowcenter(TEXT CONSTt):center(schreibfenster,t)END PROCmenuwindowcenter;PROCmenuwindowstop:menuwindowstop(2)END PROCmenuwindowstop;PROCmenuwindowstop(INT CONSTanzahl):stop(schreibfenster,anzahl)END PROCmenuwindowstop;WINDOW PROCcurrentmenuwindow:initializemenuwindow;schreibfensterEND PROCcurrentmenuwindow;PROCbereinigesituation:page;forget(ds);resetdialogEND PROCbereinigesituation;PROCwritehead(TEXT CONSTt):INT VARx,y;getcursor(x,y);IFt<>""THENcursor(1,1);out(invers(text(t,77)))END IF;cursor(x,y)END PROCwritehead;PROCrestorehead:TEXT VARkopf:=menuleiste.menu[menuleiste.zeigeraktuell].kopfzeile;writehead(kopf)END PROCrestorehead;.aktuellesuntermenu:aktmenu.einzelmenu[aktmenu.hauptmenuzeiger].aktmenu:menuleiste.menu[menuleiste.zeigeraktuell].aktuellesmenu:menuleiste.menu[menuleiste.zeigeraktuell]END PACKETlsdialog5; + diff --git a/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik Binary files differnew file mode 100644 index 0000000..d547811 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/ls-MENUKARTE:Mathematik diff --git a/app/schulis-mathematiksystem/1.0/src/mat.abbildung b/app/schulis-mathematiksystem/1.0/src/mat.abbildung new file mode 100644 index 0000000..0e839e1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.abbildung @@ -0,0 +1,13 @@ +PACKETabbildungDEFINES ABBILDUNG,abbildungsterme,abbildungsvariablen,abbildung,neueabbildung,adresse,variablenidentitaet,vergleichsfunktion,aufloesung,ergebnis,ergebnisvektor,result,ableitung,komplexefunktion,:=,+,-,*,/,O,newtonvorschrift,iterationsvorschrift,loeschebenannteabbildung,loeschetemporaereabbildung,loescheabbildung,ableitungsverbot,selektionshaltigetermliste:LETpisymbol="pi",allgemeinespotenzsymbol="**",speziellespotenzsymbol="^",multiplikationssymbol="*",divisionssymbol="/",verkettungssymbol="O",plussymbol="+",minussymbol="-",strichsymbol="'",kleinersymbol="<",kleinergleichsymbol="<=",ungleichsymbol="<>",gleichsymbol="=",groessergleichsymbol=">=",odersymbol="ODER",differenziersymbol="D",esymbol="e",sinussymbol="sin",cosinussymbol="cos",tangenssymbol="tan",cotangenssymbol="cot",arcussinussymbol="arcsin",arcuscosinussymbol="arccos",arcustangenssymbol="arctan",arcuscotangenssymbol="arccot",lnsymbol="ln",log2symbol="log2",log10symbol="log10",exponentialsymbol="exp",signumsymbol="sign",betragssymbol="abs",wurzelsymbol="wurzel",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",defaultfuervariablenindex=1,defaultfuerkomponentenindex=1;TYPE ABBILDUNG=STRUCT(LISTEvariablenliste,termliste);OP:=(ABBILDUNG VARlinks,ABBILDUNG CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;LISTE PROCabbildungsterme(ABBILDUNG CONSTf):f.termlisteEND PROCabbildungsterme;LISTE PROCabbildungsvariablen(ABBILDUNG CONSTf):f.variablenlisteEND PROCabbildungsvariablen;ABBILDUNG PROCabbildung(TERM CONSTterm):IF NOT(termISfunktionsdefinition)THENerrorstop(anwendungstext(1))END IF;funktion(neueliste(LISTENANFANG VARIABLENterm,LISTENENDE VARIABLENterm),neueliste(LISTENANFANG TERMEterm,LISTENENDE TERMEterm))END PROCabbildung;ABBILDUNG PROCabbildung(TEXT CONSTabbildungsname):TERM VAReintrag:=listenposition(eigenefunktionen,abbildungsname);IFeintrag=nilTHENeintrag:=listenposition(standardfunktionen,abbildungsname);IFeintrag=nilTHENerrorstop(anwendungstext(48))END IF;kopiertestandardfunktionELSEabbildung(DEFINITIONeintrag)END IF.kopiertestandardfunktion:TERM VARneuevariable:=newvariable(1,"x"),argument:=newterm(neuevariable),ausdruck:=newterm(newfunktionsauswertung(eintrag,newtermliste(argument,argument,1),defaultfuerkomponentenindex));neueabbildung(neueliste(neuevariable,neuevariable),neueliste(ausdruck,ausdruck))END PROCabbildung;ABBILDUNG PROCneueabbildung(LISTE CONSTvariablenliste,termliste):anhaengenantemporaerefunktionen(newtemporaerefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(variablenliste),listenende(variablenliste),laenge(variablenliste)),newtermliste(listenanfang(termliste),listenende(termliste),laenge(termliste)))));funktion(variablenliste,termliste)END PROCneueabbildung;ABBILDUNG PROCfunktion(LISTE CONSTvariablen,terme):ABBILDUNG VARf;f.variablenliste:=variablen;f.termliste:=terme;fEND PROCfunktion;ABBILDUNG OP+(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,plussymbol)END OP+;ABBILDUNG OP-(ABBILDUNG CONSTl,r):additivezusammenfassung(l,r,minussymbol)END OP-;ABBILDUNG PROCadditivezusammenfassung(ABBILDUNG CONSTl,r,TEXT CONSTopsymbol):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste),terme:=neueliste(nil,nil);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste);REPanhaengen(terme,newterm(newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),opsymbol)));linkerterm:=nachfolger(linkerterm);rechterterm:=nachfolger(rechterterm)UNTILrechterterm=nilEND REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,terme)END PROC +additivezusammenfassung;ABBILDUNG OP*(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>laenge(r.termliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARlinkerterm:=listenanfang(l.termliste),rechterterm:=listenanfang(r.termliste),neuerterm:=newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol);linkerterm:=nachfolger(linkerterm);WHILElinkerterm<>nilREPrechterterm:=nachfolger(rechterterm);neuerterm:=newdyade(neuerterm,newdyade(kopie(AUSDRUCKlinkerterm,variablen),kopie(AUSDRUCKrechterterm,variablen),multiplikationssymbol),plussymbol);linkerterm:=nachfolger(linkerterm);END REP;loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neuerterm:=newterm(neuerterm);neueabbildung(variablen,neueliste(neuerterm,neuerterm))END OP*;ABBILDUNG OP/(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IF NOTvariablenidentitaet(l,r)CORlaenge(l.termliste)<>1CORlaenge(r.termliste)<>1THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(l.variablenliste);TERM VARergebnis:=newterm(newdyade(kopie(AUSDRUCKlistenanfang(l.termliste),variablen),kopie(AUSDRUCKlistenanfang(r.termliste),variablen),divisionssymbol));loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);neueabbildung(variablen,neueliste(ergebnis,ergebnis))END OP/;ABBILDUNG OP O(ABBILDUNG CONSTl,r):ueberpruefeparameter;bildeneueabbildung;loeschetemporaereabbildungenundreicheneueabbildungnachaussen.ueberpruefeparameter:testeexistenz(l);testeexistenz(r);IFselektionshaltigetermliste(listenanfang(l.termliste))CORselektionshaltigetermliste(listenanfang(r.termliste))THENerrorstop(anwendungstext(204))END IF;IFlaenge(r.termliste)<>laenge(l.variablenliste)THENerrorstop(anwendungstext(45))END IF.bildeneueabbildung:initialisieredielistenderneuenabbildung;erzeugealletermederneuenabbildung.initialisieredielistenderneuenabbildung:LISTE VARvariablen:=kopiedervariablenliste(r.variablenliste),terme:=neueliste(nil,nil).erzeugealletermederneuenabbildung:INT VARtermzaehler;TERM VARlinkeadresse:=adresse(l),rechteadresse:=adresse(r);FORtermzaehlerFROM1UPTOlaenge(l.termliste)REPerzeugeeinentermEND REP.erzeugeeinenterm:LISTE VARargumente:=neueliste(nil,nil);erstelleargumentlistederfunktionsauswertung;anhaengen(terme,newterm(newfunktionsauswertung(linkeadresse,newtermliste(listenanfang(argumente),listenende(argumente),laenge(argumente)),termzaehler))).erstelleargumentlistederfunktionsauswertung:INT VARargumentzaehler;LISTE VARliste;IFebene=1THENanhaengen(argumente,newterm(kopie(AUSDRUCKlistenanfang(r.termliste),variablen)));FORargumentzaehlerFROM2UPTOlaenge(variablen)REPanhaengen(argumente,newterm(auswahl(variablen,argumentzaehler)))END REP ELSE FORargumentzaehlerFROM1UPTOlaenge(r.termliste)REPliste:=neueliste(nil,nil);erstelleargumentlistederinnerenfunktion;anhaengen(argumente,newterm(newfunktionsauswertung(rechteadresse,newtermliste(listenanfang(liste),listenende(liste),laenge(liste)),argumentzaehler)))END REP END IF.erstelleargumentlistederinnerenfunktion:INT VARi;FORiFROM1UPTOlaenge(r.variablenliste)REPanhaengen(liste,newterm(auswahl(r.variablenliste,i)))END REP.loeschetemporaereabbildungenundreicheneueabbildungnachaussen:ABBILDUNG VARscratchfunktion:=neueabbildung(variablen,terme),exportfunktion:=aufloesung(scratchfunktion);loescheabbildung(scratchfunktion);loeschetemporaereabbildung(l);loeschetemporaereabbildung(r);exportfunktionEND OP O;ABBILDUNG + OP+(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;operandEND OP+;ABBILDUNG OP-(ABBILDUNG CONSToperand):testeexistenz(operand);IFselektionshaltigetermliste(listenanfang(operand.termliste))THENerrorstop(anwendungstext(204))END IF;bildeneueabbildung.bildeneueabbildung:LISTE VARvariablen:=kopiedervariablenliste(operand.variablenliste),terme:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(operand.termliste);REPanhaengen(terme,newterm(newmonade(kopie(AUSDRUCKlaufterm,variablen),minussymbol)));laufterm:=nachfolger(laufterm)UNTILlaufterm=nilEND REP;loeschetemporaereabbildung(operand);neueabbildung(variablen,terme)END OP-;ABBILDUNG PROCnewtonvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildenewtonvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFableitungsverbot(funktionsadresse)THENerrorstop(anwendungstext(56))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildenewtonvorschrift:ABBILDUNG VARtemp1:=aufloesung(f),temp2:=ableitung(temp1,1,varindex);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARneuerterm:=newterm(newdyade(auswahl(neuevariablen,varindex),newdyade(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen),kopie(AUSDRUCKlistenanfang(temp2.termliste),neuevariablen),divisionssymbol),minussymbol));loeschetemporaereabbildung(temp1);loeschetemporaereabbildung(temp2);neueabbildung(neuevariablen,neueliste(neuerterm,neuerterm))END PROCnewtonvorschrift;ABBILDUNG PROCiterationsvorschrift(ABBILDUNG CONSTf,INT CONSTvarindex):testeparameter;bildeiterationsvorschrift.testeparameter:enablestop;TERM CONSTfunktionsadresse:=adresse(f);IFfunktionsadresse=nilTHENerrorstop(anwendungstext(48))ELIFvarindex<1CORvarindex>laenge(f.variablenliste)THENerrorstop(anwendungstext(53))END IF.bildeiterationsvorschrift:ABBILDUNG VARtemp1:=aufloesung(f);LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);TERM VARnt:=newterm(kopie(AUSDRUCKlistenanfang(temp1.termliste),neuevariablen));loeschetemporaereabbildung(temp1);neueabbildung(neuevariablen,neueliste(nt,nt))END PROCiterationsvorschrift;VECTOR PROCergebnis(ABBILDUNG CONSTf,VECTOR CONSTvariablenvektor):enablestop;testeexistenz(f);IFlaenge(f.variablenliste)<>length(variablenvektor)THENerrorstop(anwendungstext(45))END IF;ergebnisvektor(f.termliste,variablenvektor)END PROCergebnis;VECTOR PROCergebnisvektor(LISTE CONSTzuberechnendetermliste,VECTOR CONSTvariablenvektor):INT VARanzahlterme:=laenge(zuberechnendetermliste),i;VECTOR VARergebnisse:=vector(anzahlterme);TERM VARterm:=listenanfang(zuberechnendetermliste);FORiFROM1UPTOanzahltermeREPreplace(ergebnisse,i,result(AUSDRUCKterm,variablenvektor));term:=nachfolger(term)END REP;ergebnisseEND PROCergebnisvektor;REAL PROCresult(TERM CONSTterm,VECTOR CONSTvariablenvektor):TEXT VARoperationssymbol;TERM VARobjekt;enablestop;IFtermISvariableTHENvariablenvektorSUB(PLATZterm)ELIFtermISdyadischTHENwertderdyadeELIFtermISmonadischTHENwertdermonadeELIFtermISfunktionsauswertungTHENfunktionswertELIFtermISkonstanteTHEN WERTtermELSEselektierterwertEND IF.wertderdyade:REAL VARlinks:=result(LINKSterm,variablenvektor),rechts:=result(RECHTSterm,variablenvektor);operationssymbol:=OPERATIONterm;IFoperationssymbol=plussymbolTHENlinks+rechtsELIFoperationssymbol=minussymbolTHENlinks-rechtsELIFoperationssymbol=multiplikationssymbolTHENlinks*rechtsELIFoperationssymbol=divisionssymbolTHENlinks/rechtsELSE IFlinks=0.0CANDrechts=0.0THENerrorstop(anwendungstext(101))END IF;IFrechts<=32767.0CANDrechts>=-32768.0CANDreal(int(rechts))=rechtsTHENlinks**int(rechts)ELSElinks**rechtsEND IF END IF.wertdermonade:IF OPERATIONterm=minussymbolTHEN-result(OPERANDterm,variablenvektor)ELSEresult(OPERANDterm,variablenvektor)END IF.funktionswert:objekt:=ABBILDUNGSAUSDRUCKterm;IF NOT((objektISstandardfunktion)COR(objektIS +eigenefunktion))THENerrorstop(anwendungstext(14))END IF;IFobjektISstandardfunktionTHENwertderstandardfunktionELSEwertderselbstdefiniertenfunktionEND IF.wertderstandardfunktion:REAL VARargumentwert:=result(erstesargument(term),variablenvektor);operationssymbol:=NAMEobjekt;IFoperationssymbol=sinussymbolTHENsin(argumentwert)ELIFoperationssymbol=cosinussymbolTHENcos(argumentwert)ELIFoperationssymbol=tangenssymbolTHENtan(argumentwert)ELIFoperationssymbol=cotangenssymbolTHENcot(argumentwert)ELIFoperationssymbol=arcussinussymbolTHENarcsin(argumentwert)ELIFoperationssymbol=arcuscosinussymbolTHENarccos(argumentwert)ELIFoperationssymbol=arcustangenssymbolTHENarctan(argumentwert)ELIFoperationssymbol=arcuscotangenssymbolTHENarccot(argumentwert)ELIFoperationssymbol=lnsymbolTHENln(argumentwert)ELIFoperationssymbol=log2symbolTHENlog2(argumentwert)ELIFoperationssymbol=log10symbolTHENlog10(argumentwert)ELIFoperationssymbol=exponentialsymbolTHENexp(argumentwert)ELIFoperationssymbol=signumsymbolTHENreal(sign(argumentwert))ELIFoperationssymbol=wurzelsymbolTHENsqrt(argumentwert)ELIFoperationssymbol=gaussklammersymbolTHENgauss(argumentwert)ELIFoperationssymbol=rundsymbolTHENrund(argumentwert)ELIFoperationssymbol=intsymbolTHENganz(argumentwert)ELIFoperationssymbol=fracsymbolTHENfrak(argumentwert)ELSEabs(argumentwert)END IF.wertderselbstdefiniertenfunktion:result(ausgewaehlterfunktionsterm(term),ergebnisvektor(neueliste(LISTENANFANG ARGUMENTEterm,LISTENENDE ARGUMENTEterm),variablenvektor)).selektierterwert:TERM VARhilfsterm:=term;WHILE NOTcondition(BEDINGUNGhilfsterm,variablenvektor)REPhilfsterm:=ALTERNATIVEhilfsterm;IFhilfsterm=nilTHENerrorstop(anwendungstext(106))END IF END REP;result(AKTIONhilfsterm,variablenvektor)END PROCresult;BOOL PROCcondition(TERM CONSTterm,VECTOR CONSTwerte):TEXT VARoperationssymbol;BOOL VARlinks,rechts;REAL VARlinkerwert,rechterwert;IFtermISlogischedyadeTHENlinks:=condition(LINKSterm,werte);rechts:=condition(RECHTSterm,werte);IF OPERATIONterm=odersymbolTHENlinksCORrechtsELSElinksCANDrechtsEND IF ELSEoperationssymbol:=OPERATIONterm;linkerwert:=result(LINKSterm,werte);rechterwert:=result(RECHTSterm,werte);IFoperationssymbol=kleinersymbolTHENlinkerwert<rechterwertELIFoperationssymbol=kleinergleichsymbolTHENlinkerwert<=rechterwertELIFoperationssymbol=gleichsymbolTHENlinkerwert=rechterwertELIFoperationssymbol=ungleichsymbolTHENlinkerwert<>rechterwertELIFoperationssymbol=groessergleichsymbolTHENlinkerwert>=rechterwertELSElinkerwert>rechterwertEND IF END IF END PROCcondition;BOOL PROCkomplexefunktion(ABBILDUNG CONSTf):enablestop;testeexistenz(f);komplexeliste(listenanfang(f.termliste))END PROCkomplexefunktion;BOOL PROCkomplexeliste(TERM CONSTterm):komplexerterm(AUSDRUCKterm)COR((nachfolger(term)<>nil)CANDkomplexeliste(nachfolger(term)))END PROCkomplexeliste;BOOL PROCkomplexerterm(TERM CONSTterm):IF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)THENkomplexerterm(LINKSterm)CORkomplexerterm(RECHTSterm)ELIF(termISmonadisch)THENkomplexerterm(OPERANDterm)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)ISableitungsoperation)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsdyade)COR((ABBILDUNGSAUSDRUCKterm)ISabbildungsmonade)CORkomplexeliste(LISTENANFANG ARGUMENTEterm)COR(((ABBILDUNGSAUSDRUCKterm)ISeigenefunktion)CANDkomplexerterm(ausgewaehlterfunktionsterm(term)))ELIFtermISselektionTHENkomplexerterm(BEDINGUNGterm)CORkomplexerterm(AKTIONterm)CORkomplexerterm(ALTERNATIVEterm)ELSE FALSE END IF END PROCkomplexerterm;ABBILDUNG PROCableitung(ABBILDUNG CONSTf):ableitung(f,defaultfuerkomponentenindex,defaultfuervariablenindex)END PROCableitung;ABBILDUNG PROCableitung(ABBILDUNG CONSTf,INT CONSTkompindex,varindex):enablestop;ueberpruefedieaktuellenparameter;erzeugteableitung.ueberpruefedieaktuellenparameter:testeexistenz(f);IFkompindex>laenge(f.termliste)CORkompindex<1THENerrorstop(anwendungstext(42))ELIFvarindex>laenge(f.variablenliste)CORvarindex<1THENerrorstop(anwendungstext(53))END IF.erzeugteableitung:LISTE VARneuevariablen:= +kopiedervariablenliste(f.variablenliste);TERM VARabgeleiteterterm:=newterm(diff(abzuleitenderterm,varindex,neuevariablen));neueabbildung(neuevariablen,neueliste(abgeleiteterterm,abgeleiteterterm)).abzuleitenderterm:AUSDRUCKauswahl(f.termliste,kompindex)END PROCableitung;TERM PROCdiff(TERM CONSTterm,INT CONSTvariablenindex,LISTE CONSTvariablen):TERM VARzeiger,objekt;TEXT VARoperation;REAL VARwert;IFtermISselektionTHENerrorstop(anwendungstext(57))END IF;IFtermISvariableTHENableitungeinervariablenELIFtermISmonadischTHENabgeleitetermonadeELIFtermISkonstanteTHENableitungeinerkonstantenELIFtermISdyadischTHENabgeleitetedyadeELSEabgeleitetefunktionsauswertungEND IF.ableitungeinervariablen:IF PLATZterm=variablenindexTHENnewkonstante(1.0,"1")ELSEnewkonstante(0.0,"0")END IF.abgeleitetermonade:signreduce(diff(OPERANDterm,variablenindex,variablen),OPERATIONterm).ableitungeinerkonstanten:newkonstante(0.0,"0").abgeleitetedyade:TERM VARlinkeableitung:=diff(LINKSterm,variablenindex,variablen),rechteableitung;operation:=OPERATIONterm;IFoperation<>speziellespotenzsymbolTHENrechteableitung:=diff(RECHTSterm,variablenindex,variablen)END IF;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELIFoperation=allgemeinespotenzsymbolTHENallgemeinepotenzregelELSEspeziellepotenzregelEND IF.additionsregel:reduce(linkeableitung,rechteableitung,operation).multiplikationsregel:reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),plussymbol).divisionsregel:reduce(reduce(reduce(linkeableitung,rechtekopie,multiplikationssymbol),reduce(linkekopie,rechteableitung,multiplikationssymbol),minussymbol),reduce(rechtekopie,newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).allgemeinepotenzregel:reduce(reduce(newkonstante(e,esymbol),reduce(rechtekopie,argumentterm,multiplikationssymbol),allgemeinespotenzsymbol),reduce(reduce(rechteableitung,argumentterm,multiplikationssymbol),reduce(reduce(rechtekopie,linkeableitung,multiplikationssymbol),linkekopie,divisionssymbol),plussymbol),multiplikationssymbol).argumentterm:IF(LINKStermISkonstante)CAND(NAME LINKSterm=esymbol)THENnewkonstante(1.0,"1")ELSEzeiger:=newterm(linkekopie);newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex)END IF.speziellepotenzregel:IF(RECHTStermISkonstante)THENwert:=WERT RECHTStermELSE IF(OPERATION RECHTSterm=minussymbol)THENwert:=-WERT OPERAND RECHTStermELSEwert:=WERT OPERAND RECHTStermEND IF END IF;reduce(linkeableitung,reduce(newkonstante(wert,text(int(wert))),reduce(linkekopie,newkonstante(wert-1.0,text(int(wert-1.0))),speziellespotenzsymbol),multiplikationssymbol),multiplikationssymbol).linkekopie:kopie(LINKSterm,variablen).rechtekopie:kopie(RECHTSterm,variablen).abgeleitetefunktionsauswertung:INT VARlambda:=1,anzahlderargumente:=LAENGE ARGUMENTEterm;TERM VARkettenregel:=newkonstante(0.0,"0");FORlambdaFROM1UPTOanzahlderargumenteREPkettenregel:=reduce(kettenregel,reduce(aeussereableitung,innereableitung,multiplikationssymbol),plussymbol)END REP;kettenregel.innereableitung:diff(AUSDRUCK((ARGUMENTEterm)ELEMENTlambda),variablenindex,variablen).aeussereableitung:objekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISstandardfunktionTHENstandardableitungELIF(objektISabbildungsdyade)COR(objektISabbildungsmonade)THENnewfunktionsauswertung(difffunktionsoperation(objekt),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)ELSEnewfunktionsauswertung(newableitungsoperation(abbildungskopie(objekt),lambda,KOMPONENTEterm,differenzieroperator),kopie(ARGUMENTEterm,variablen),KOMPONENTEterm)END IF.differenzieroperator:IFobjektISableitungsoperationTHEN OPERATIONobjektELIFtermanzahl(objekt)>1CORvariablenanzahl(objekt)>1THENdifferenziersymbolELSEstrichsymbolEND IF.standardableitung:operation:=NAMEobjekt;IFabschnittweisedefiniertefunktion(operation)THENerrorstop( +anwendungstext(56))END IF;IFoperation=sinussymbolTHENableitungdersinusfunktionELIFoperation=cosinussymbolTHENableitungdercosinusfunktionELIFoperation=tangenssymbolTHENableitungdertangensfunktionELIFoperation=cotangenssymbolTHENableitungdercotangensfunktionELIFoperation=arcussinussymbolTHENableitungderarcussinusfunktionELIFoperation=arcuscosinussymbolTHENableitungderarcuscosinusfunktionELIFoperation=arcustangenssymbolTHENableitungderarcustangensfunktionELIFoperation=arcuscotangenssymbolTHENableitungderarcuscotangensfunktionELIFoperation=lnsymbolTHENableitungderlnfunktionELIFoperation=log2symbolTHENableitungderlog2funktionELIFoperation=log10symbolTHENableitungderlog10funktionELIFoperation=wurzelsymbolTHENableitungderwurzelfunktionELSEableitungderexponentialfunktionEND IF.ableitungdersinusfunktion:newfunktionsauswertung(listenposition(standardfunktionen,cosinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex).ableitungdercosinusfunktion:newmonade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),minussymbol).ableitungdertangensfunktion:newdyade(newdyade(newfunktionsauswertung(listenposition(standardfunktionen,tangenssymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),newkonstante(1.0,"1"),plussymbol).ableitungdercotangensfunktion:newdyade(newkonstante(-1.0,"-1"),newdyade(newfunktionsauswertung(listenposition(standardfunktionen,sinussymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),newkonstante(2.0,"2"),speziellespotenzsymbol),divisionssymbol).ableitungderarcussinusfunktion:reduce(newkonstante(1.0,"1"),reduce(reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),minussymbol),newkonstante(0.5,"0.5"),allgemeinespotenzsymbol),divisionssymbol).ableitungderarcuscosinusfunktion:signreduce(ableitungderarcussinusfunktion,minussymbol).ableitungderarcustangensfunktion:reduce(newkonstante(1.0,"1"),reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newkonstante(2.0,"2"),speziellespotenzsymbol),plussymbol),divisionssymbol).ableitungderarcuscotangensfunktion:signreduce(ableitungderarcustangensfunktion,minussymbol).ableitungderlnfunktion:reduce(newkonstante(1.0,"1"),kopie(erstesargument(term),variablen),divisionssymbol).ableitungderlog2funktion:zeiger:=newterm(newkonstante(2.0,"2"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderlog10funktion:zeiger:=newterm(newkonstante(10.0,"10"));reduce(newkonstante(1.0,"1"),reduce(kopie(erstesargument(term),variablen),newfunktionsauswertung(listenposition(standardfunktionen,lnsymbol),newtermliste(zeiger,zeiger,1),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderwurzelfunktion:newdyade(newkonstante(1.0,"1"),newdyade(newkonstante(2.0,"2"),newfunktionsauswertung(listenposition(standardfunktionen,wurzelsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex),multiplikationssymbol),divisionssymbol).ableitungderexponentialfunktion:newfunktionsauswertung(listenposition(standardfunktionen,exponentialsymbol),kopie(ARGUMENTEterm,variablen),defaultfuerkomponentenindex)END PROCdiff;TERM PROCdifffunktionsoperation(TERM CONSTterm):IFtermISabbildungsdyadeTHENabgeleiteterdyadischertermELIFtermISabbildungsmonadeTHENabgeleitetermonadischertermELSEeinfacheableitungEND IF.abgeleiteterdyadischerterm:TEXT VARoperation:=OPERATIONterm;IFoperation=plussymbolCORoperation=minussymbolTHENadditionsregelELIFoperation=multiplikationssymbolTHENmultiplikationsregelELIFoperation=divisionssymbolTHENdivisionsregelELSEkettenregelEND IF.additionsregel:newabbildungsdyade(difffunktionsoperation(LINKSterm),difffunktionsoperation(RECHTSterm), +operation).multiplikationsregel:newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),plussymbol).divisionsregel:newabbildungsdyade(newabbildungsdyade(newabbildungsdyade(difffunktionsoperation(LINKSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),newabbildungsdyade(abbildungskopie(LINKSterm),difffunktionsoperation(RECHTSterm),multiplikationssymbol),minussymbol),newabbildungsdyade(abbildungskopie(RECHTSterm),abbildungskopie(RECHTSterm),multiplikationssymbol),divisionssymbol).kettenregel:newabbildungsdyade(aeussereableitung,innereableitung,multiplikationssymbol).aeussereableitung:newabbildungsdyade(newableitungsoperation(abbildungskopie(LINKSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol),abbildungskopie(RECHTSterm),verkettungssymbol).innereableitung:newableitungsoperation(abbildungskopie(RECHTSterm),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).abgeleitetermonadischerterm:IF(OPERATIONterm=minussymbol)THENnewabbildungsmonade(difffunktionsoperation(OPERANDterm),minussymbol)ELSEdifffunktionsoperation(OPERANDterm)END IF.einfacheableitung:IFableitungsverbot(term)THENerrorstop(anwendungstext(56))END IF;newableitungsoperation(abbildungskopie(term),defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol).END PROCdifffunktionsoperation;TERM PROCreduce(TERM CONSTl,r,TEXT CONSToperator):REAL VARwert;TERM VARlinks:=l,rechts:=r;IFlISdyadischTHENlinks:=reduce(LINKSl,RECHTSl,OPERATIONl);LOESCHElEND IF;IFrISdyadischTHENrechts:=reduce(LINKSr,RECHTSr,OPERATIONr);LOESCHErEND IF;IFoperator=plussymbolTHENvereinfachteadditionELIFoperator=minussymbolTHENvereinfachtesubtraktionELIFoperator=multiplikationssymbolTHENvereinfachtemultiplikationELIFoperator=divisionssymbolTHENvereinfachtedivisionELIFoperator=speziellespotenzsymbolTHENvereinfachtespeziellepotenzELSEvereinfachteallgemeinepotenzEND IF.vereinfachteaddition:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHErechts;newdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOTvordefiniertekonstante(links)CAND NOTvordefiniertekonstante(rechts)THENwert:=WERTlinks+WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;rechtsELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewdyade(newkonstante(2.0,"2"),links,multiplikationssymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtesubtraktion:IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;LOESCHErechts;newkonstante(0.0,"0")ELIF((linksISkonstante)CAND(rechtsISkonstante))CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks-WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIFrechtsIST0.0THEN LOESCHErechts;linksELIFidentischevariablen(links,rechts)THENnewkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);rechtsELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(rechts);linksELSEnewdyade(links,rechts,operator)END IF.vereinfachtemultiplikation:TERM VARneuerterm;IFidentischevordefiniertekonstanten(links,rechts)THEN LOESCHElinks;newdyade(newkonstante(2.0,"2"),rechts,speziellespotenzsymbol)ELIF(linksISkonstante)CAND(rechtsISkonstante)CAND NOT(vordefiniertekonstante(links)CORvordefiniertekonstante(rechts))THENwert:=WERTlinks*WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST0.0THENbeseitige(rechts);linksELIFlinksIST1.0THEN LOESCHElinks;rechtsELIFlinksIST-1.0THEN LOESCHElinks;signreduce(rechts,minussymbol)ELIF(linksIS +konstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(LINKSrechtsISkonstante)CAND NOTvordefiniertekonstante(LINKSrechts)THENwert:=WERTlinks*WERT LINKSrechts;LOESCHElinks;LOESCHE LINKSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISdyadisch)CAND(OPERATIONrechts=multiplikationssymbol)CAND(RECHTSrechtsISkonstante)CAND NOTvordefiniertekonstante(RECHTSrechts)THENwert:=WERTlinks*WERT RECHTSrechts;LOESCHElinks;LOESCHE RECHTSrechts;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSrechts,multiplikationssymbol);LOESCHErechts;neuertermELIFrechtsIST0.0THENbeseitige(links);rechtsELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(LINKSlinksISkonstante)CAND NOTvordefiniertekonstante(LINKSlinks)THENwert:=WERTrechts*WERT LINKSlinks;LOESCHErechts;LOESCHE LINKSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),RECHTSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(rechtsISkonstante)CAND NOTvordefiniertekonstante(rechts)CAND(linksISdyadisch)CAND(OPERATIONlinks=multiplikationssymbol)CAND(RECHTSlinksISkonstante)CAND NOTvordefiniertekonstante(RECHTSlinks)THENwert:=WERTrechts*WERT RECHTSlinks;LOESCHErechts;LOESCHE RECHTSlinks;neuerterm:=reduce(newkonstante(wert,text(wert)),LINKSlinks,multiplikationssymbol);LOESCHElinks;neuertermELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THEN LOESCHElinks;beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);LOESCHErechts;newkonstante(0.0,"0")ELIF(linksISmonadisch)CAND((OPERANDlinks)IST1.0)THEN IF(OPERATIONlinks=minussymbol)THENbeseitige(links);signreduce(rechts,minussymbol)ELSEbeseitige(links);rechtsEND IF ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,multiplikationssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewdyade(links,newkonstante(2.0,"2"),speziellespotenzsymbol)ELSEnewdyade(links,rechts,operator)END IF.vereinfachtedivision:IFlinksIST0.0THENbeseitige(rechts);linksELIFrechtsIST1.0THEN LOESCHErechts;linksELIFrechtsIST-1.0THEN LOESCHErechts;signreduce(links,minussymbol)ELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST1.0)THEN IF(OPERATIONrechts=minussymbol)THENbeseitige(rechts);signreduce(links,minussymbol)ELSEbeseitige(rechts);linksEND IF ELIF(linksISmonadisch)CAND(rechtsISmonadisch)THEN IF(OPERATIONlinks)=(OPERATIONrechts)THENnewdyade(OPERANDlinks,OPERANDrechts,divisionssymbol)ELSEnewmonade(newdyade(OPERANDlinks,OPERANDrechts,divisionssymbol),minussymbol)END IF ELIFidentischevariablen(links,rechts)THENnewkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.vereinfachteallgemeinepotenz:IFrechtsistganzzahlCAND(linksISkonstante)CAND NOTvordefiniertekonstante(links)THENwert:=WERTlinks**WERTrechts;LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHElinks;beseitige(rechts);newkonstante(1.0,"1")ELIFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISmonadisch)CAND((OPERANDlinks)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(0.0,"0")ELIF(rechtsISmonadisch)CAND((OPERANDrechts)IST0.0)THENbeseitige(links);beseitige(rechts);newkonstante(1.0,"1")ELSEnewdyade(links,rechts,operator)END IF.rechtsistganzzahl:(rechtsIS +konstante)CAND(floor(WERTrechts)=WERTrechts).vereinfachtespeziellepotenz:IFrechtsIST0.0THENbeseitige(links);LOESCHErechts;newkonstante(1.0,"1")ELIFrechtsIST1.0THEN LOESCHErechts;linksELIF(linksISkonstante)CAND NOTvordefiniertekonstante(links)CAND(rechtsISkonstante)CAND(real(int(WERTrechts))=WERTrechts)THENwert:=(WERTlinks)**int(WERTrechts);LOESCHElinks;LOESCHErechts;newkonstante(wert,text(wert))ELIFlinksIST1.0THEN LOESCHErechts;linksELIFlinksIST-1.0THEN IFwertvonrechtsistgeradeTHEN LOESCHElinks;LOESCHErechts;newkonstante(1.0,"1")ELSE LOESCHErechts;linksEND IF ELSEnewdyade(links,rechts,operator)END IF.wertvonrechtsistgerade:(rechtsISkonstante)CANDint(WERTrechts)MOD2=0.END PROCreduce;TERM PROCsignreduce(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm;IFoperandISmonadischTHEN IFresultierendertermistnegativTHENneuerterm:=newmonade(OPERANDoperand,minussymbol);ELSEneuerterm:=OPERANDoperandEND IF;LOESCHEoperandELIFoperandIST0.0THENneuerterm:=operandELSEneuerterm:=newmonade(operand,operator)END IF;neuerterm.resultierendertermistnegativ:OPERATIONoperand<>operator.END PROCsignreduce;ABBILDUNG PROCaufloesung(ABBILDUNG CONSTf):enablestop;testeexistenz(f);loeseauf.loeseauf:LISTE VARneuevariablen:=kopiedervariablenliste(f.variablenliste);neueabbildung(neuevariablen,aufgeloestetermliste(listenanfang(f.termliste),neuevariablen))END PROCaufloesung;LISTE PROCaufgeloestetermliste(TERM CONSTtermlistenanfang,LISTE CONSTneuevariablen):LISTE VARneueterme:=neueliste(nil,nil);TERM VARlaufterm:=termlistenanfang;WHILElaufterm<>nilREPanhaengen(neueterme,newterm(aufloesendekopie(AUSDRUCKlaufterm,neuevariablen)));laufterm:=nachfolger(laufterm)END REP;neuetermeEND PROCaufgeloestetermliste;TERM PROCaufloesendekopie(TERM CONSTterm,LISTE CONSTvariablen):IFtermISvariableTHENauswahl(variablen,PLATZterm)ELIFtermISdyadischTHENreduce(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(aufloesendekopie(OPERANDterm,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(aufloesendekopie(BEDINGUNGterm,variablen),aufloesendekopie(AKTIONterm,variablen),aufloesendekopie(ALTERNATIVEterm,variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(aufloesendekopie(LINKSterm,variablen),aufloesendekopie(RECHTSterm,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;LISTE VARargumente:=aufgeloestetermliste(LISTENANFANG ARGUMENTEterm,variablen);IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,argumente,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(listenanfang(argumente),listenende(argumente),1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF END PROCaufloesendekopie;TERM PROCersetzung(TERM CONSTterm,LISTE CONSTargumentliste,variablen):IFtermISvariableTHENkopie(AUSDRUCKauswahl(argumentliste,PLATZterm),variablen)ELIFtermISdyadischTHENreduce(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISmonadischTHENsignreduce(ersetzung(OPERANDterm,argumentliste,variablen),OPERATIONterm)ELIFtermISfunktionsauswertungTHENaufloesungderauswertungELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(ersetzung(BEDINGUNGterm,argumentliste,variablen),ersetzung(AKTIONterm,argumentliste,variablen),ersetzung(ALTERNATIVEterm,argumentliste, +variablen))ELIFtermISlogischedyadeTHENnewlogischedyade(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(ersetzung(LINKSterm,argumentliste,variablen),ersetzung(RECHTSterm,argumentliste,variablen),OPERATIONterm)ELSEnilEND IF.aufloesungderauswertung:ABBILDUNG VARscratchfunktion;TERM VARobjekt;IF(ABBILDUNGSAUSDRUCKterm)ISstandardfunktionTHENaufgeloestestandardfunktionELSEobjekt:=ersetzung(zuersetzenderterm,ersetzteargumentliste,variablen);loeschetemporaereabbildung(scratchfunktion);loescheterme(listenanfang(argumente));objektEND IF.aufgeloestestandardfunktion:TERM VARargument:=newterm(ersetzung(erstesargument(term),argumentliste,variablen));newfunktionsauswertung(ABBILDUNGSAUSDRUCKterm,newtermliste(argument,argument,1),defaultfuerkomponentenindex).zuersetzenderterm:IF(ABBILDUNGSAUSDRUCKterm)ISeigenefunktionTHENausgewaehlterfunktionsterm(term)ELSEscratchfunktion:=auswertung(ABBILDUNGSAUSDRUCKterm);AUSDRUCKlistenanfang(scratchfunktion.termliste)END IF.ersetzteargumentliste:LISTE VARargumente:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANG ARGUMENTEterm;WHILElaufterm<>nilREPanhaengen(argumente,newterm(ersetzung(AUSDRUCKlaufterm,argumentliste,variablen)));laufterm:=nachfolger(laufterm)END REP;argumenteEND PROCersetzung;PROCloeschebenannteabbildung(TEXT CONSTname):enablestop;IFlistenposition(eigenefunktionen,name)=nilTHENerrorstop(anwendungstext(48))END IF;loescheabbildung(abbildung(name))END PROCloeschebenannteabbildung;PROCloeschetemporaereabbildung(ABBILDUNG CONSTf):enablestop;IFadresse(f)IStemporaerefunktionTHENloescheabbildung(f)END IF END PROCloeschetemporaereabbildung;PROCloescheabbildung(ABBILDUNG CONSTf):enablestop;TERM VARdefinition,eintrag:=adresse(f);IF(eintragISeigenefunktion)COR(eintragIStemporaerefunktion)THENloescheterme(listenanfang(f.termliste));loeschevariablen(listenanfang(f.variablenliste));definition:=DEFINITIONeintrag;LOESCHE VARIABLENdefinition;LOESCHE TERMEdefinition;LOESCHEdefinition;IFeintragIStemporaerefunktionTHENentfernenaustemporaerenfunktionen(eintrag)ELSEentfernenauseigenenfunktionen(eintrag)END IF;LOESCHEeintragELSEerrorstop(anwendungstext(48))END IF END PROCloescheabbildung;PROCloescheterme(TERM CONSTtermlistenanfang):TERM VARloeschelement:=termlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);beseitige(loeschelement);loeschelement:=naechsteselementEND REP END PROCloescheterme;PROCloeschevariablen(TERM CONSTvariablenlistenanfang):TERM VARloeschelement:=variablenlistenanfang,naechsteselement;WHILEloeschelement<>nilREPnaechsteselement:=nachfolger(loeschelement);LOESCHEloeschelement;loeschelement:=naechsteselementEND REP END PROCloeschevariablen;PROCbeseitige(TERM CONSTterm):IFtermISausdruckTHENbeseitige(AUSDRUCKterm)ELIF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENbeseitige(LINKSterm);beseitige(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENbeseitige(OPERANDterm);ELIFtermISfunktionsauswertungTHENbeseitige(ABBILDUNGSAUSDRUCKterm);loescheterme(LISTENANFANG ARGUMENTEterm);LOESCHE ARGUMENTEtermELIFtermISableitungsoperationTHENbeseitige(ABBILDUNGSAUSDRUCKterm)ELIFtermISselektionTHENbeseitige(BEDINGUNGterm);beseitige(AKTIONterm);IF(ALTERNATIVEterm)<>nilTHENbeseitige(ALTERNATIVEterm)END IF;ELIF NOT(termISkonstante)THEN LEAVEbeseitigeEND IF;LOESCHEtermEND PROCbeseitige;BOOL PROCableitungsverbot(TERM CONSTterm):IF(termISdyadisch)COR(termISabbildungsdyade)THENableitungsverbot(LINKSterm)CORableitungsverbot(RECHTSterm)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENableitungsverbot(OPERANDterm)ELIFtermISstandardfunktionTHENabschnittweisedefiniertefunktion(NAMEterm)ELIF(termISeigenefunktion)COR(termIStemporaerefunktion)THENgetesteteliste(LISTENANFANG TERME DEFINITIONterm)ELIFtermISfunktionsauswertungTHENableitungsverbot(auswertungsobjekt)CORgetesteteliste(LISTENANFANG ARGUMENTEterm)ELIFtermIS +ableitungsoperationTHENableitungsverbot(ABBILDUNGSAUSDRUCKterm)ELSEtermISselektionEND IF.auswertungsobjekt:TERM VARobjekt:=ABBILDUNGSAUSDRUCKterm;IFobjektISeigenefunktionTHEN AUSDRUCK((TERME DEFINITIONobjekt)ELEMENT(KOMPONENTEterm))ELSEobjektEND IF END PROCableitungsverbot;BOOL PROCabschnittweisedefiniertefunktion(TEXT CONSTname):name=signumsymbolCORname=betragssymbolCORname=intsymbolCORname=gaussklammersymbolCORname=rundsymbolCORname=fracsymbolEND PROCabschnittweisedefiniertefunktion;BOOL PROCgetesteteliste(TERM CONSTlistenelement):IFlistenelement=nilTHEN FALSE ELSEableitungsverbot(AUSDRUCKlistenelement)CORgetesteteliste(nachfolger(listenelement))END IF END PROCgetesteteliste;BOOL PROCvariablenidentitaet(ABBILDUNG CONSTl,r):variablenidentitaet(l.variablenliste,r.variablenliste)END PROCvariablenidentitaet;ABBILDUNG PROCvergleichsfunktion(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermISabbildungsdyadeTHENvergleichsfunktion(LINKSterm)ELIFtermISabbildungsmonadeTHENvergleichsfunktion(OPERANDterm)ELSEvergleichsfunktion(ABBILDUNGSAUSDRUCKterm)END IF END PROCvergleichsfunktion;TERM PROCadresse(ABBILDUNG CONSTf):TERM VARvergleichsterm:=listenanfang(f.termliste),suchterm:=nil;durchforste(temporaerefunktionen,suchterm,vergleichsterm);IFsuchterm=nilTHENdurchforste(eigenefunktionen,suchterm,vergleichsterm)END IF;suchtermEND PROCadresse;PROCdurchforste(LISTE CONSTsuchliste,TERM VARsuchterm,TERM CONSTvergleichsterm):IFlaenge(suchliste)>0THENsuchterm:=listenanfang(suchliste);WHILE(suchterm<>nil)CAND NOTgefundenREPsuchterm:=nachfolger(suchterm)END REP;END IF.gefunden:vergleichsterm=LISTENANFANG TERME DEFINITIONsuchterm.END PROCdurchforste;PROCtesteexistenz(ABBILDUNG CONSTf):IFadresse(f)=nilTHENerrorstop(anwendungstext(48))END IF END PROCtesteexistenz;LISTE PROCkopiedervariablenliste(LISTE CONSToriginal):LISTE VARkopie:=neueliste(nil,nil);TERM VARlaufterm:=listenanfang(original);WHILElaufterm<>nilREPanhaengen(kopie,newvariable(PLATZlaufterm,NAMElaufterm));laufterm:=nachfolger(laufterm)END REP;kopieEND PROCkopiedervariablenliste;ABBILDUNG PROCauswertung(TERM CONSTterm):IF(termISstandardfunktion)COR(termISeigenefunktion)THENabbildung(NAMEterm)ELIFtermIStemporaerefunktionTHENabbildung(DEFINITIONterm)ELIFtermISabbildungsdyadeTHENausgewerteteabbildungsdyadeELIFtermISabbildungsmonadeTHENausgewerteterabbildungsmonadeELSEausgewerteteableitungsoperationEND IF.ausgewerteteabbildungsdyade:IF OPERATIONterm=plussymbolTHENauswertung(LINKSterm)+auswertung(RECHTSterm)ELIF OPERATIONterm=minussymbolTHENauswertung(LINKSterm)-auswertung(RECHTSterm)ELIF OPERATIONterm=multiplikationssymbolTHENauswertung(LINKSterm)*auswertung(RECHTSterm)ELIF OPERATIONterm=divisionssymbolTHENauswertung(LINKSterm)/auswertung(RECHTSterm)ELSEauswertung(LINKSterm)Oauswertung(RECHTSterm)END IF.ausgewerteterabbildungsmonade:IF OPERATIONterm=minussymbolTHEN-auswertung(OPERANDterm)ELSEauswertung(OPERANDterm)END IF.ausgewerteteableitungsoperation:ABBILDUNG VARloeschelement:=auswertung(ABBILDUNGSAUSDRUCKterm),neuefunktion:=ableitung(loeschelement,KOMPONENTEterm,INDEXterm);loeschetemporaereabbildung(loeschelement);neuefunktionEND PROCauswertung;TERM PROCkopie(TERM CONSTterm,LISTE CONSTvariablenliste):IFtermISvariableTHENauswahl(variablenliste,PLATZterm)ELIFtermIStermlisteTHENtermlistenkopie(term,variablenliste)ELIFtermISdyadischTHENnewdyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELIFtermISmonadischTHENnewmonade(kopie(OPERANDterm,variablenliste),OPERATIONterm)ELIFtermISfunktionsauswertungTHENnewfunktionsauswertung(abbildungskopie(ABBILDUNGSAUSDRUCKterm),kopie(ARGUMENTEterm,variablenliste),KOMPONENTEterm)ELIFtermISkonstanteTHENnewkonstante(WERTterm,NAMEterm)ELIFtermISselektionTHENnewselektion(kopie(BEDINGUNGterm,variablenliste),kopie(AKTIONterm,variablenliste),kopie(ALTERNATIVEterm,variablenliste))ELIFtermISlogischedyadeTHENnewlogischedyade(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste), +OPERATIONterm)ELIFtermISvergleichTHENnewvergleich(kopie(LINKSterm,variablenliste),kopie(RECHTSterm,variablenliste),OPERATIONterm)ELSEtermEND IF END PROCkopie;TERM PROCabbildungskopie(TERM CONSTterm):IFtermISabbildungsdyadeTHENnewabbildungsdyade(abbildungskopie(LINKSterm),abbildungskopie(RECHTSterm),OPERATIONterm)ELIFtermISabbildungsmonadeTHENnewabbildungsmonade(abbildungskopie(OPERANDterm),OPERATIONterm)ELIFtermISableitungsoperationTHENnewableitungsoperation(abbildungskopie(ABBILDUNGSAUSDRUCKterm),INDEXterm,KOMPONENTEterm,OPERATIONterm)ELSEtermEND IF END PROCabbildungskopie;TERM PROCtermlistenkopie(TERM CONSTterm,LISTE CONSTvariablenliste):LISTE VARausdruecke:=neueliste(nil,nil);TERM VARlaufterm:=LISTENANFANGterm;WHILElaufterm<>nilREPanhaengen(ausdruecke,newterm(kopie(AUSDRUCKlaufterm,variablenliste)));laufterm:=nachfolger(laufterm)END REP;newtermliste(listenanfang(ausdruecke),listenende(ausdruecke),laenge(ausdruecke))END PROCtermlistenkopie;TERM PROCausgewaehlterfunktionsterm(TERM CONSTterm):IF NOT(termISfunktionsauswertung)THENerrorstop(anwendungstext(1))END IF;AUSDRUCK((TERME DEFINITION ABBILDUNGSAUSDRUCKterm)ELEMENT(KOMPONENTEterm))END PROCausgewaehlterfunktionsterm;BOOL PROCidentischevordefiniertekonstanten(TERM CONSTl,r):vordefiniertekonstante(l)CANDvordefiniertekonstante(r)CAND NAMEl=NAMErEND PROCidentischevordefiniertekonstanten;BOOL PROCidentischevariablen(TERM CONSTl,r):(lISvariable)CAND(rISvariable)CAND(PLATZl=PLATZr)END PROCidentischevariablen;BOOL PROCvordefiniertekonstante(TERM CONSTpruefterm):(prueftermISkonstante)CAND((NAMEpruefterm=esymbol)COR(NAMEpruefterm=pisymbol))END PROCvordefiniertekonstante;BOOL PROCselektionshaltigetermliste(TERM CONSTt):IF NOT(tISausdruck)THENerrorstop(anwendungstext(203))END IF;TERM VARlauf:=t;WHILElauf<>nilREP IF(AUSDRUCKlauf)ISselektionTHEN LEAVEselektionshaltigetermlisteWITH TRUE END IF;lauf:=nachfolger(lauf)END REP;FALSE END PROCselektionshaltigetermliste;BOOL OP IST(TERM CONSTpruefterm,REAL CONSTpruefwert):(prueftermISkonstante)CAND(WERTpruefterm=pruefwert)END OP IST;TERM PROCerstesargument(TERM CONSTterm):AUSDRUCK LISTENANFANG ARGUMENTEtermEND PROCerstesargument;END PACKETabbildung + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ausgabe b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe new file mode 100644 index 0000000..41f9677 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.ausgabe @@ -0,0 +1,2 @@ +PACKETausgabeDEFINES:=,plot,endgeraetbreite:LETtypnummer=1055;REAL VARdruckerfaktor:=1.0,horcm,vertcm,width,height;INT VARpixhor,pixvert;drawingarea(horcm,vertcm,pixhor,pixvert);width:=horcm;height:=vertcm;REAL VARbuchsthoehe:=stdhoehe,minyabstand:=0.1;REAL VARhoehe:=buchsthoehe+3.0*minyabstand,links:=0.0,rechts:=horcm,oben:=vertcm-hoehe,unten:=hoehe,rahmenoben:=vertcm,rahmenunten:=0.0;TYPE PICROW=BOUND STRUCT(INTeofROW128PICTUREzeichnungROW4REALfenstergroesseREALquellbreite,quellhoehe);OP:=(PICROW VARneu,DATASPACE CONSTspace):CONCR(neu):=space;END OP:=;PROCplot(THESAURUS CONSTth):do(PROC(TEXT CONST)plot,th)END PROCplot;PROCplot(TEXT CONSTdsname):enablestop;IFexists(dsname)THEN PICROW VARobjekt:=old(dsname);IFtype(old(dsname))<>typnummerTHEN LEAVEplotEND IF ELSE LEAVEplotEND IF;beginplot;setzeabmessungenbezueglichendgeraet;clear;viewport(druckerfaktor*links,druckerfaktor*rechts,druckerfaktor*rahmenunten,druckerfaktor*rahmenoben);window(objekt.fenstergroesse(1),objekt.fenstergroesse(2),objekt.fenstergroesse(3),objekt.fenstergroesse(4));pen(0,1,0,1);plottedarstellung;plotend.setzeabmessungenbezueglichendgeraet:IFwidth>horcmTHENwidth:=horcmEND IF;height:=width/objekt.quellbreite*objekt.quellhoehe;IFheight>vertcmTHENheight:=vertcm;width:=height/objekt.quellhoehe*objekt.quellbreiteEND IF;hoehe:=0.0;rechts:=objekt.quellbreite;oben:=objekt.quellhoehe;unten:=hoehe;rahmenoben:=objekt.quellhoehe;rahmenunten:=0.0;druckerfaktor:=width/objekt.quellbreite;cmfaktor(druckerfaktor).plottedarstellung:INT VARi;pen(1,1,1,1);box;FORiFROM1UPTOobjekt.eofREP IFlength(objekt.zeichnung(i))<>0THENpen(1,1,1,pen(objekt.zeichnung(i)));plot(objekt.zeichnung(i))END IF END REP END PROCplot;PROCendgeraetbreite(REAL CONSTbreite):width:=min(breite,horcm)END PROCendgeraetbreite;REAL PROCendgeraetbreite:widthEND PROCendgeraetbreite;END PACKETausgabe; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.basis plot b/app/schulis-mathematiksystem/1.0/src/mat.basis plot new file mode 100644 index 0000000..3581885 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.basis plot @@ -0,0 +1,2 @@ +PACKETbasisplotDEFINESviewport,window,windowxmin,windowxmax,windowymin,windowymax,move,draw,where,box,xpixel,ypixel:INT VARxpixelanzahl,ypixelanzahl;REAL VARxpixelprocm,ypixelprocm,xcmgroesse,ycmgroesse,xpos,ypos,viewxmin:=0.0,viewxmax:=1.0,viewymin:=0.0,viewymax:=1.0,winxmin:=0.0,winxmax:=1.0,winymin:=0.0,winymax:=1.0,xkonst,ykonst,xfaktor,yfaktor;initialisierewerte;PROCinitialisierewerte:drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);xpixelprocm:=real(xpixelanzahl)/xcmgroesse;ypixelprocm:=real(ypixelanzahl)/ycmgroesse;viewport(0.0,xcmgroesse,0.0,ycmgroesse);window(0.0,xcmgroesse,0.0,ycmgroesse);homeEND PROCinitialisierewerte;PROCviewport(REAL CONSTxmin,xmax,ymin,ymax):IFxmin<0.0CORxmax>xcmgroesseCORymin<0.0CORymax>ycmgroesseCORxmin=xmaxCORymin=ymaxCORaltewerteTHEN LEAVEviewportEND IF;viewxmin:=xmin;viewxmax:=xmax;viewymin:=ymin;viewymax:=ymax;setvalues.altewerte:viewxmin=xminCANDviewxmax=xmaxCANDviewymin=yminCANDviewymax=ymaxEND PROCviewport;PROCwindow(REAL CONSTxmin,xmax,ymin,ymax):IFxmin>=xmaxCORymin>=ymaxCORaltewerteTHEN LEAVEwindowEND IF;winxmin:=xmin;winxmax:=xmax;winymin:=ymin;winymax:=ymax;setvalues.altewerte:winxmin=xminCANDwinxmax=xmaxCANDwinymin=yminCANDwinymax=ymaxEND PROCwindow;REAL PROCwindowxmin:winxminEND PROCwindowxmin;REAL PROCwindowxmax:winxmaxEND PROCwindowxmax;REAL PROCwindowymin:winyminEND PROCwindowymin;REAL PROCwindowymax:winymaxEND PROCwindowymax;PROCsetvalues:xkonst:=0.5+viewxmin*xpixelprocm;ykonst:=0.5+viewymin*ypixelprocm;xfaktor:=xpixelprocm*(viewxmax-viewxmin)/(winxmax-winxmin);yfaktor:=ypixelprocm*(viewymax-viewymin)/(winymax-winymin)END PROCsetvalues;PROCmove(REAL CONSTx,y):INT VARi,j;IFx>winxmaxCORx<winxminCORy>winymaxCORy<winyminTHEN LEAVEmoveEND IF;xpos:=x;ypos:=y;transform(x,y,i,j);move(i,j)END PROCmove;PROCdraw(REAL CONSTx,y):INT VARi,j;IFx>winxmaxCORx<winxminCORy>winymaxCORy<winyminTHEN LEAVEdrawEND IF;transform(x,y,i,j);xpos:=x;ypos:=y;draw(i,j)END PROCdraw;PROCtransform(REAL CONSTx,y,INT VARi,j):i:=xpixel(x);j:=ypixel(y)END PROCtransform;INT PROCxpixel(REAL CONSTx):int(xkonst+(x-winxmin)*xfaktor)END PROCxpixel;INT PROCypixel(REAL CONSTy):int(ykonst+(y-winymin)*yfaktor)END PROCypixel;PROCbox:move(winxmin,winymax);draw(winxmax,winymax);draw(winxmax,winymin);draw(winxmin,winymin);draw(winxmin,winymax)END PROCbox;PROCwhere(REAL VARx,y):x:=xpos;y:=yposEND PROCwhere;PROChome:xpos:=winxmin;ypos:=winyminEND PROChome;END PACKETbasisplot + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.binder plot b/app/schulis-mathematiksystem/1.0/src/mat.binder plot new file mode 100644 index 0000000..8a8d227 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.binder plot @@ -0,0 +1,4 @@ +PACKETbinderplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz,plotterkanal:LEThorpixelmaxdurch16=85,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",unterstreichenaus="Y",fettdruckaus="""",zeilenabstand="T15",druckrichtung=">",druckart="I",schrifttyp="H",formfeed="�",linefeed=" +",cr="
";INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord,anzahldernadelspalten,i,printerchannel:=15;REAL VARhorfaktor,vertfaktor,faktor;horpixel:=1360;verpixel:=900;anzahldernadelspalten:=900;horfaktor:=50.3937;vertfaktor:=47.24409;REAL VARbuchstabenhoehe:=0.762,buchstabenbreite:=0.3373438;BOUND ROWhorpixelmaxdurch16TEXT VARbitmap;INT VARplotterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=26.9875;ycm:=19.05;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1).ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT VARspaltenzaehler;bitmap:=old(namederbitmap);druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+unterstreichenaus);out(esc+fettdruckaus);out(esc+zeilenabstand);out(esc+druckrichtung);out(esc+schrifttyp).seitenvorschub:out(formfeed).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask,plotterchannel).bitmapdrucken:FORspaltenzaehlerFROM(groesstexkoordDIV16)+1DOWNTO1REPbefehlssequenzschickenPER.zeilenbeginn:groessteykoord+1.befehlssequenzschicken:out(esc+druckart+neueanzahldernadelspalten);teilzeileausgeben;out(cr+linefeed).neueanzahldernadelspalten:nullen+text(zeilenbeginn).nullen:(4-LENGTHtext(zeilenbeginn))*"0".teilzeileausgeben:outsubtext(bitmap(spaltenzaehler),vontextpos,bistextpos).vontextpos:2*(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:2*anzahldernadelspaltenEND PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet)END PROCplotend;PROCclear:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);xpos:=0;ypos:=0;pen(0,1,0,1);INT VARj;TEXT VARleerespalte:=(2*verpixel)*"�";FORjFROM1UPTOhorpixelmaxdurch16REPbitmap(j):=leerespaltePER;groesstexkoord:=0;groessteykoord:=0END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSE +macheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz '"+name+"' existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1ELSEausgewaehlt:=3FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2ELSEausgewaehlt:=3FI;faktor:=matrixfaktor(ausgewaehlt).beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorEND IF PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);setbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCplot;PROCunplot(INT CONSTx,y):INT VARintausrow;intausrow:=bitmap(xDIV16+1)ISUB(verpixel-y);resetbit(intausrow,15-xMOD16);replace(bitmap(xDIV16+1),verpixel-y,intausrow)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETbinderplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.cga plot b/app/schulis-mathematiksystem/1.0/src/mat.cga plot new file mode 100644 index 0000000..94b7ae7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.cga plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldout,oldcursor,oldgetcursor:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETcgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,out,cursor,getcursor,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=14.59854,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,anzahlx=640,anzahly=200,maximumx=639,maximumy=199,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.525167,buchstabenbreite:=0.275;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IF(textcopySUB1)>code(31)THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die CGA-Karte (oder eine kompatible");putline("Karte, z.B. EGA-Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"cga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE;ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE;ENDPROCplotend;PROCclear:control(-5,6,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,anzahly-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THEN +oldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,anzahly-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,anzahly-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>maximumxTHENx:=maximumxELIFx<0THENx:=0END IF;IFy>maximumyTHENy:=maximumyELIFy<0THENy:=0END IF END PROCgrenzkontrolle;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:8END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETcgaplot;zeichensatz("ZEICHEN 8*8") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen new file mode 100644 index 0000000..d76be56 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.dialoghilfen @@ -0,0 +1,5 @@ +PACKETdialoghilfenDEFINESscratchfunctionname,scroll,belegeparameter,schreibestatuszeile,schreibearbeitsfunktion,gibmeldung,gibinfofensteraus,warte,strich,definieredruckseitenformat,druckseitenformat,druckspalten,aufbereitetdrucken,druckversuch:LETniltext="",bell="�",carrreturn="
",beginmark="",endmark="",left="�",right="�",runter=" +",hoch="�",hop="�",esc="�",blank=" ",unterstrichzeichen="_",systemname=" s c h u l i s - Mathematiksystem",niveau="Ebene ",seitenvorschub="#page#",stddruckbreite=45,stddrucklaenge=60;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,basiszeile:=beginmark+systemname+44*blank+endmark;TEXT PROCscratchfunctionname:TEXT VARfunctionname:="hilfsfunktion";INT VARi:=1;WHILElistenposition(eigenefunktionen,functionname+text(i))<>nilREPiINCR1END REP;functionname+text(i)END PROCscratchfunctionname;PROCscroll(WINDOW VARw,TEXT CONSTdatname,INT CONSTxscroll,yscroll,horizontalscroll,INT VARerstersatz,erstespalte,TEXT CONSTsonderzeichen,TEXT VARausstiegzeichen):BOOL VARveraenderungderkopfzeilen:=TRUE,veraenderungdervariablenspalte:=TRUE;bestimmemaximalwertederdatei;bereiteausgabevor;REPzeigedateiausschnitt;IFsonderzeichen=niltextTHEN LEAVEscrollEND IF;werteeingabezeichenaus;veraenderungdervariablenspalte:=NOTveraenderungderkopfzeilenEND REP.bestimmemaximalwertederdatei:TEXT VARzeile;FILE VARf:=sequentialfile(input,datname);INT VARmaxspalten:=0,maxzeilen:=lines(f);WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>maxspaltenTHENmaxspalten:=length(zeile)END IF END REP.bereiteausgabevor:INT CONSTbreite:=areaxsize(w),laenge:=areaysize(w),xbeginn:=areax(w),ybeginn:=areay(w),letzterzeilenanfang:=maxzeilen-laenge+yscroll,ausgabebreite:=breite-xscroll-1,ausgabelaenge:=laenge-yscroll+1,letzterspaltenanfang:=jenachdem;modify(f).jenachdem:INT VARsucher:=xscroll;WHILEsucher<maxspaltenREPsucherINCRhorizontalscrollEND REP;sucher-horizontalscroll.zeigedateiausschnitt:TEXT VARsatz,ausgabezeile;INT VARi,ypos;IFveraenderungderkopfzeilenTHENypos:=ybeginn;FORiFROM1UPTOyscroll-1REPtoline(f,i);readrecord(f,satz);ausgabezeile:=subtext(satz,1,xscroll-1);ausgabezeileCATsubtext(satz,erstespalte,erstespalte+ausgabebreite+1);cursor(xbeginn,ypos);out(text(ausgabezeile,breite));yposINCR1END REP ELSEypos:=ybeginn+yscroll-1END IF;i:=erstersatz;REPtoline(f,i);readrecord(f,satz);IFveraenderungdervariablenspalteTHENcursor(xbeginn,ypos);out(text(satz,xscroll-1,1))END IF;cursor(xbeginn+xscroll-1,ypos);out(text(satz,breite-xscroll+1,erstespalte));yposINCR1;iINCR1UNTILypos-ybeginn>laenge-1END REP.werteeingabezeichenaus:TEXT VARch;REPinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENscrollelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENscrollerechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENscrollezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENscrollevorEND IF ELIFch=hopTHENinchar(ch);IFch=leftTHEN IFerstespalte>xscrollTHENblaetterelinksEND IF ELIFch=rightTHEN IFerstespalte<letzterspaltenanfangTHENblaettererechtsEND IF ELIFch=hochTHEN IFerstersatz>yscrollTHENblaetterezurueckEND IF ELIFch=runterTHEN IFerstersatz<letzterzeilenanfangTHENblaetterevorEND IF ELSEout(bell)END IF ELIFch=escTHENinchar(ausstiegzeichen);IFausstiegzeichen="1"CANDerstersatz>yscrollTHENspringeandenanfangELIFausstiegzeichen="9"CANDerstersatz<letzterzeilenanfangTHENspringeandasendeELIFpos(sonderzeichen,ausstiegzeichen)<>0THEN LEAVEscrollEND IF END IF END REP.scrollelinks:erstespalteDECRhorizontalscroll;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollerechts:erstespalteINCRhorizontalscroll;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.scrollezurueck:erstersatzDECR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.scrollevor:erstersatzINCR1;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterelinks:erstespalteDECRausgabebreite;erstespalte:=max(erstespalte,xscroll);veraenderungderkopfzeilen:=TRUE;LEAVE +werteeingabezeichenaus.blaettererechts:erstespalteINCRausgabebreite;erstespalte:=min(erstespalte,letzterspaltenanfang);veraenderungderkopfzeilen:=TRUE;LEAVEwerteeingabezeichenaus.blaetterezurueck:erstersatzDECRausgabelaenge;erstersatz:=max(erstersatz,yscroll);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.blaetterevor:erstersatzINCRausgabelaenge;erstersatz:=min(erstersatz,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandenanfang:erstersatz:=yscroll;veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenaus.springeandasende:erstersatz:=max(yscroll,letzterzeilenanfang);veraenderungderkopfzeilen:=FALSE;LEAVEwerteeingabezeichenausEND PROCscroll;PROCbelegeparameter(VECTOR VARv,INT CONSTvarindex,LISTE CONSTvariablenliste,TEXT CONSTescapeausstieg,TEXT VARausstieg):TEXT VAReingabetext,ausstiegszeichen;INT CONSTende:=laenge(variablenliste),eingabelaenge:=40,scrollbeginn:=12;TEXT CONSTseparatoren:=hoch+runter;INT VARxpos,ypos,aktuellerparameterindex:=naechsterparameter(ende,varindex,0);getcursor(xpos,ypos);REPzeigeaktuellenparameter;editieredenaktuellenparameter;werteausstiegscodeausEND REP.zeigeaktuellenparameter:TEXT VARvariablenname:=text(NAMEauswahl(variablenliste,aktuellerparameterindex),8);variablennameCAT" = ";cursor(xpos,ypos);out(variablenname).editieredenaktuellenparameter:eingabetext:=compress(wandle(vSUBaktuellerparameterindex));eingabetextCATkurzerstrich;IFsystemimgraphicmodusTHENgrapheditget(eingabetext,scrollbeginn,escapeausstieg,ausstiegszeichen)ELSEout(beginmark);out(left);editget(eingabetext,eingabelaenge,scrollbeginn,separatoren,escapeausstieg,ausstiegszeichen);out(endmark)END IF.werteausstiegscodeaus:IFausstiegszeichen=niltextCORpos(hoch+runter+carrreturn,ausstiegszeichen)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);REAL VAReingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert);IFausstiegszeichen<>hochTHENaktuellerparameterindex:=naechsterparameter(ende,varindex,aktuellerparameterindex)ELSEaktuellerparameterindex:=letzterparameter(ende,varindex,aktuellerparameterindex)END IF ELSEclearerrorEND IF ELSE IFsystemimgraphicmodusTHENausstieg:=ausstiegszeichenELSEausstieg:=ausstiegszeichenSUB2END IF;IFpos(escapeausstieg,ausstieg)<>0THENchangeall(eingabetext,unterstrichzeichen,niltext);eingegebenerwert:=realzahl(eingabetext);IF NOTiserrorTHENreplace(v,aktuellerparameterindex,eingegebenerwert)ELSEclearerrorEND IF;LEAVEbelegeparameterEND IF END IF END PROCbelegeparameter;INT PROCnaechsterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=aktuellerwertMODende+1;IFnaechsterwert=verbotenTHENnaechsterparameter(ende,verboten,aktuellerwert+1)ELSEnaechsterwertEND IF END PROCnaechsterparameter;INT PROCletzterparameter(INT CONSTende,verboten,aktuellerwert):INT CONSTnaechsterwert:=(aktuellerwert-2)MODende+1;IFnaechsterwert=verbotenTHENletzterparameter(ende,verboten,aktuellerwert-1)ELSEnaechsterwertEND IF END PROCletzterparameter;PROCschreibestatuszeile(TEXT CONSTverfahrensname):TEXT VARzeile:=basiszeile,teilbereich:=niveau+text(ebene)+" "+verfahrensname;replace(zeile,78-length(teilbereich),teilbereich);cursor(1,1);out(zeile)END PROCschreibestatuszeile;PROCschreibearbeitsfunktion(ABBILDUNG CONSTfkt):cursor(1,2);out(text(funktionsstring(fkt),80))END PROCschreibearbeitsfunktion;PROCstrich(INT CONSTzeile):cursor(1,zeile);out(79*waagerecht)END PROCstrich;PROCwarte:clearbuffer;footnote(anwendungstext(77));pauseEND PROCwarte;PROCgibmeldung(TEXT CONSTmeldung):WINDOW VARstdmeldungsfenster:=window(2,22,77,1);outframe(stdmeldungsfenster);out(stdmeldungsfenster,text(meldung,77));warte;page(stdmeldungsfenster,TRUE)END PROCgibmeldung;PROCgibinfofensteraus(WINDOW VARw,INT CONSTn):outframe(w);show(formular(n));warte;page(w,TRUE)END PROCgibinfofensteraus;ROW2INT VARdruckbreite:=ROW2INT:(stddruckbreite,stddruckbreite),drucklaenge:=ROW2INT:(stddrucklaenge,stddrucklaenge);PROCdefinieredruckseitenformat(INT CONST +breite,laenge):druckbreite(ebene):=breite;drucklaenge(ebene):=laengeEND PROCdefinieredruckseitenformat;INT PROCdruckspalten:druckbreite(ebene)END PROCdruckspalten;PROCdruckseitenformat(INT VARspalten,zeilen):spalten:=druckbreite(ebene);zeilen:=drucklaenge(ebene)END PROCdruckseitenformat;PROCaufbereitetdrucken(TEXT CONSTfname,ueberschrift,INT CONSTspaltenbeginn,zeilenbeginn,spaltenbreite):FILE VARf,fdruck;INT VARdateibreite,dateilaenge,i,j,verfuegbarerplatz,zulaessigebreite;TEXT CONSTneuername:=scratchdateiname;TEXT VARzeile,druckzeile;testeumfangderzudruckendendatei;bereitedateiauf;druckversuch(neuername);forget(neuername,quiet).testeumfangderzudruckendendatei:f:=sequentialfile(input,fname);dateilaenge:=lines(f);dateibreite:=0;WHILE NOTeof(f)REPgetline(f,zeile);IFlength(zeile)>dateibreiteTHENdateibreite:=length(zeile)END IF END REP;verfuegbarerplatz:=drucklaenge(ebene)-zeilenbeginn+1;IFueberschrift<>niltextTHENverfuegbarerplatzDECR2END IF;zulaessigebreite:=0;REPzulaessigebreiteINCRspaltenbreiteUNTILzulaessigebreite>druckbreite(ebene)-spaltenbeginn+1END REP;zulaessigebreiteDECRspaltenbreite.bereitedateiauf:INT VARspaltenpointer,zeilenpointer;modify(f);fdruck:=sequentialfile(output,neuername);spaltenpointer:=spaltenbeginn;WHILEspaltenpointer<dateibreiteREPschreibeseiten;spaltenpointerINCRzulaessigebreiteEND REP.schreibeseiten:zeilenpointer:=zeilenbeginn;REPschreibekopfzeilen;schreiberumpfzeilenEND REP.schreibekopfzeilen:putline(fdruck,seitenvorschub);IFueberschrift<>niltextTHENputline(fdruck,ueberschrift);line(fdruck)END IF;FORjFROM1UPTOzeilenbeginn-1REPdruckzeile:=niltext;toline(f,j);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile)END REP.schreiberumpfzeilen:FORiFROM1UPTOverfuegbarerplatzREPdruckzeile:=niltext;toline(f,zeilenpointer);readrecord(f,zeile);druckzeileCATsubtext(zeile,1,spaltenbeginn-1);druckzeileCATsubtext(zeile,spaltenpointer,spaltenpointer+zulaessigebreite-1);putline(fdruck,druckzeile);zeilenpointerINCR1;IFzeilenpointer>dateilaengeTHEN LEAVEschreibeseitenEND IF END REP END PROCaufbereitetdrucken;PROCdruckversuch(TEXT CONSTdatname):disablestop;print(datname);IFiserrorTHENgibmeldung(errormessage);clearerror;ELSEgibmeldung(anwendungstext(219))END IF END PROCdruckversuch;END PACKETdialoghilfen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.druckermenu b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu new file mode 100644 index 0000000..45b036d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.druckermenu @@ -0,0 +1,2 @@ +PACKETdruckermenuDEFINESdruckeingang,druckezeichnungen,loeschezeichnungen,stellezeichenbreiteein,definieredruckerkanal,stoppedrucker,plottereingestellt:LETdepottaskname="MATHE-PRINTERDEPOT",druckprocindex=1,loeschprocindex=2,untenlinks=3,zentral=5,bell="�",abbruch="!",niltext="",arbeitertaskname="workertask",minimalekanalnr=2,maximalekanalnr=32,text1="Bitte warten bis der letzte Druckauftrag bearbeitet ist.",text2="Drucken von Zeichnungen",text3="Auswahl der Zeichnungen durch ankreuzen",text4="Löschen von Zeichnungen",text5="Sollen die ausgewählten Zeichnungen gelöscht werden",text6="Die Zeichnungen werden gelöscht: ",text7=" Wert zwischen 5.0 cm und ",text8=" cm eingeben! ",text9=" Bitte Zahl zwischen 2 und 32 für Kanalnummer des Druckers eingeben! ",text10="Speicher für Zeichnungen ist nicht eingerichtet.",text11="Ist für die nächste Zeichnung Papier eingelegt",text12="Auswahl einer Zeichnung durch ankreuzen";TEXT VARzeichnungsname;TASK VARarbeitertask,depottask;BOOL VARplotteraktiv:=TRUE;THESAURUS VARauswahl;PROCdruckeingang:IF NOTexiststask(depottaskname)THENerrorstop(text10)END IF;depottask:=/depottaskname;IFhighestentry(ALLdepottask)=0THENdeactivate(druckprocindex);deactivate(loeschprocindex)ELSEactivate(druckprocindex);activate(loeschprocindex)END IF END PROCdruckeingang;PROCdruckezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEdruckezeichnungenEND IF;IF NOTplottereingestelltTHENauswahl:=menusome(ALLdepottask,text2,text3,TRUE);IFnotempty(auswahl)THENbegin(arbeitertaskname,PROCzeichnungendrucken,arbeitertask)END IF ELSEzeichnungsname:=menuone(ALLdepottask,text2,text12,TRUE);IFzeichnungsname<>niltextCANDmenuyes(text11,zentral)THENbegin(arbeitertaskname,PROCdruckeeinezeichnung,arbeitertask)END IF END IF END PROCdruckezeichnungen;PROCzeichnungendrucken:disablestop;fetch(auswahl,depottask);plot(auswahl);end(myself)END PROCzeichnungendrucken;PROCdruckeeinezeichnung:disablestop;fetch(zeichnungsname,depottask);plot(zeichnungsname);end(myself)END PROCdruckeeinezeichnung;PROCloeschezeichnungen:IFexiststask(arbeitertaskname)THENmenuinfo(text(text1,76),untenlinks);LEAVEloeschezeichnungenEND IF;auswahl:=menusome(ALLdepottask,text4,text3,TRUE);IF NOTnotempty(auswahl)THEN LEAVEloeschezeichnungenEND IF;IFmenuyes(text5,zentral)THENcommanddialogue(FALSE);footnote(text6);cursor(36,24);erase(auswahl,depottask);commanddialogue(TRUE);oldfootnote;druckeingangEND IF END PROCloeschezeichnungen;PROCstellezeichenbreiteein:LETminimum=5.0;REAL VARmaximum,maxlaenge,breite;INT VARxpixel,ypixel;TEXT VAReingabe;drawingarea(maximum,maxlaenge,xpixel,ypixel);maximum:=floor(maximum);IFendgeraetbreite>maximumTHENendgeraetbreite(maximum)END IF;REPeingabe:=menuanswer(text7+text(maximum)+text8,text(endgeraetbreite),zentral);IFcompress(eingabe)=niltextTHEN LEAVEstellezeichenbreiteeinEND IF;breite:=real(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHENendgeraetbreite(breite);LEAVEstellezeichenbreiteeinEND IF;out(bell)END REP END PROCstellezeichenbreiteein;PROCdefinieredruckerkanal:TEXT VAReingabe;INT VARnr;REPeingabe:=menuanswer(text9,text(plotterkanal),zentral);IFcompress(eingabe)=niltextTHEN LEAVEdefinieredruckerkanalEND IF;nr:=int(eingabe);IFlastconversionokCANDnr>=minimalekanalnrCANDnr<=maximalekanalnrTHENplotterkanal(nr);LEAVEdefinieredruckerkanalEND IF;out(bell)END REP END PROCdefinieredruckerkanal;PROCstoppedrucker:IFexiststask(arbeitertaskname)THENend(/arbeitertaskname)END IF END PROCstoppedrucker;PROCplottereingestellt(BOOL CONSTwert):plotteraktiv:=wertEND PROCplottereingestellt;BOOL PROCplottereingestellt:plotteraktivEND PROCplottereingestellt;END PACKETdruckermenu; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.ega plot b/app/schulis-mathematiksystem/1.0/src/mat.ega plot new file mode 100644 index 0000000..5fc377b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.ega plot @@ -0,0 +1,4 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETegaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenbreite,zeichenhoehe,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=25.54745,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=350,ykonst=349,xkonst=639,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die EGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"ega"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARx,y):xcm:=22.0;ycm:=13.7;x:=xkonst;y:=ykonstEND PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,16,0,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,-1,foregroundcode,dummy).foregroundcode:IFforeground=deleteTHEN0ELSElinetypecodeFI.linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:15CASEgepunktet:13CASEkurzgestrichelt:12CASElanggestrichelt:11CASEstrichpunkt:10OTHERWISElinetypeEND SELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):xDRAWy;pos:=POS:(x,y)END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y,xold:=xpos,yold:=ypos;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;xoldMOVEyold;pos.x:=xold;pos.y:=yold.setcharacterheightandwidth:IFwidth=0.0CANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];pos.xMOVEpos.y;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExpos+xDRAWypos+yFI;pos.x:=xpos+x;pos.y:=ypos+yPER;xposINCRxstep;yposINCRystep;pos.x:=xpos;pos.y:=ypos;.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ykonst-ywert, +dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y,anfang:=ykonst-pos.y,ziel;grenzkontrolle(xwert,ywert);ziel:=ykonst-ywert;IFgeradelinienTHENcontrol(-6,pos.x,anfang,dummy);control(-6,xwert,ziel,dummy)ELSEcontrol(-6,xwert,ziel,dummy);control(-6,pos.x,anfang,dummy);control(-7,xwert,ziel,dummy)END IF.geradelinien:xwert=pos.xCORywert=pos.yEND OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xkonstTHENx:=xkonstELIFx<0THENx:=0END IF;IFy>ykonstTHENy:=ykonstELIFy<0THENy:=0FI END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=ypixel-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>xpixelDIVzeichen.widthTHENtextcopy:=subtext(text,1,xpixelDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>xpixelDIVzeichen.widthTHENspalte:=xpixelDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>ypixelDIVzeichen.heightTHENzeile:=ypixelDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=14;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(14,2,3,4,9,8,7,6,5,13,12,11,10,1);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:12END PROCsekantenstift;INT PROCnormalenstift:12END PROCnormalenstift;INT PROCtangentenstift:12END PROCtangentenstift;INT PROClotstift:10END PROClotstift;INT PROCpunktstift:12END PROCpunktstift;END PACKETegaplot;zeichensatz("ZEICHEN 8*14") + + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot new file mode 100644 index 0000000..508b9b2 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.epson-fx plot @@ -0,0 +1,4 @@ +PACKETepsonfxplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",esc="�",modus="L",schrifttyp="P",formfeed="�",zeilenvorschub="J�",minivorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=2328;verpixel:=905;horfaktor:=85.03937;vertfaktor:=47.24409;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);LET GRUPPE=STRUCT(ROW3TEXTspalte);BOUND ROWhorpixelmaxdurch24GRUPPE VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7662334,buchstabenbreite:=0.3421944;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code(zeilenbeginnMOD256)+code(zeilenbeginnDIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REP FORjFROM3DOWNTO1REPdruckeeinespalteeinergruppe;PER;vorschubPER.druckeeinespalteeinergruppe:out(esc+modus+neueanzahldernadelspalten);teilzeileausgeben;out(esc+minivorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i).spalte(j),vontextpos,bistextpos).vontextpos:(anzahldernadelspalten-zeilenbeginn)+1.bistextpos:anzahldernadelspalten.vorschub:out(esc+zeilenvorschub+cr).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=verpixel*"�";FORiFROM1UPTOhorpixeldurch24REP FORjFROM1UPTO3REPbitmap(i).spalte(j):=leerPER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:= +totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxmod24:=xMOD24,xdiv24:=xDIV24;replace(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,setzebitintext(byte,xmod24DIV3,wert)).byte:subtext(bitmap(1+xdiv24).spalte(1+(xmod24MOD3)),verpixel-y,verpixel-y).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code(subtext(byte,1,1));IFwertTHENsetbit( +intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonfxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot b/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot new file mode 100644 index 0000000..704f3f7 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.epson-sq plot @@ -0,0 +1,4 @@ +PACKETepsonsqplotDEFINESdrawingarea,beginplot,clear,endplot,plotend,stdhoehe,stdbreite,move,draw,pen,zeichensatz,plotterkanal:LEThorpixelmaxdurch24=97,bit14=16384,nameofspooltask="PRINTER",namederbitmap="Plotter",abstand=100,esc="�",modus="*'",schrifttyp="P",unidirektional="U�",formfeed="�",zeilenvorschub="J�",cr="
";INT VARhorpixel,verpixel,horpixeldurch24,ausgewaehlt,groesstexkoord,groessteykoord;TEXT VARneueanzahldernadelspalten;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,plotterchannel:=15;horpixel:=1968;verpixel:=1346;horfaktor:=70.86614;vertfaktor:=70.86614;horpixeldurch24:=horpixelDIV24;neueanzahldernadelspalten:=code(verpixelMOD256)+code(verpixelDIV256);BOUND ROWhorpixelmaxdurch24TEXT VARbitmap;INT VARprinterchannel:=15,xpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.7597422,buchstabenbreite:=0.3471333;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=real(horpixel)/horfaktor;ycm:=real(verpixel)/vertfaktor;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCdrucken:INT CONSTmeinkanal:=channel;INT VARi,j;INT CONSTvontextpos:=3*(anzahldernadelspalten-zeilenbeginn)+1,bistextpos:=3*anzahldernadelspalten;TEXT CONSTrand:=(3*abstand)*"�";bitmap:=old("Plotter");druckerkanalankoppeln;druckervoreinstellen;bitmapdrucken;seitenvorschub;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).druckervoreinstellen:out(esc+schrifttyp);out(esc+unidirektional).seitenvorschub:out(formfeed+cr).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bitmapdrucken:neueanzahldernadelspalten:=code((abstand+zeilenbeginn)MOD256)+code((abstand+zeilenbeginn)DIV256);FORiFROM(groesstexkoordDIV24)+1DOWNTO1REPdruckeeinespalte;PER.druckeeinespalte:out(esc+modus+neueanzahldernadelspalten);out(rand);teilzeileausgeben;out(esc+zeilenvorschub+cr).zeilenbeginn:groessteykoord+1.anzahldernadelspalten:verpixel.teilzeileausgeben:outsubtext(bitmap(i),vontextpos,bistextpos).END PROCdrucken;PROCplotend:drucken;forget(namederbitmap,quiet);END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;.richtebitmapein:forget(namederbitmap,quiet);bitmap:=new(namederbitmap);groesstexkoord:=0;groessteykoord:=0.loeschebitmap:INT VARi,j;TEXT CONSTleer:=3*verpixel*"�";FORiFROM1UPTOhorpixeldurch24REPbitmap(i):=leerPER END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:819CASE3:975CASE4:255CASE5:3711OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0 +UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y,TRUE)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;zeichensatzauswaehlen;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:REAL VARdiff:=0.0;TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENplot(x,y,FALSE)ELSEplot(x,y,TRUE)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y,BOOL CONSTwert):INT CONSTxdiv24:=xDIV24,xdiv8:=xDIV8;replace(bitmap(1+xdiv24),posnrder3ergruppe+bytenrinnerhalbdernadelspalte,setzebitintext(byte,xMOD8,wert)).posnrder3ergruppe:(verpixel-y-1)*3+1.bytenrinnerhalbdernadelspalte:2-(xMOD24)DIV8.byte:bitmap(1+xdiv24)SUB(posnrder3ergruppe+bytenrinnerhalbdernadelspalte).END PROCplot;TEXT PROCsetzebitintext(TEXT CONSTbyte,INT CONSTstelle,BOOL CONSTwert):INT VARintwert;TEXT VARrechtesbyte:=2*"�";intwert:=code( +subtext(byte,1,1));IFwertTHENsetbit(intwert,stelle);ELSEresetbit(intwert,stelle);FI;rechtesbyte:=code(intwert);rechtesbyte.ENDPROCsetzebitintext;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETepsonsqplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager b/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager new file mode 100644 index 0000000..0b722df --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.formeleditormanager @@ -0,0 +1,4 @@ +PACKETformeleditormanagerDEFINESformelmanager:LETniltext="",funktionsauswertungssymbol="A",unsichtbareklammerauf="(:",unsichtbareklammerzu=":)",klammeraufsymbol="(",klammerzusymbol=")",differenziersymbol="D",diffklammeraufsymbol="D:",diffklammerzusymbol=":D",selektionsklammeraufsymbol="{{",selektionsklammerzusymbol="}}",ifsymbol="<",endifsymbol=">",elifsymbol=";",thensymbol=":",selektionsthensymbol="::",selektionselifsymbol=";;",formeleditorundsymbol="&",undsymbol="UND",formeleditorodersymbol="$",odersymbol="ODER",formelindateischreiben=1,zeichensatzumstellen=2,formeleditieren=3,allesok=5,fehler=6,offset=258,erlaubtezeichen="?ilmw",tempdatname="temporaerer datenraum",anzahlzeilen=67,erstefensterzeile=6,fensterzeilen=12,erstefensterspalte=2,verlasszeichen="19wm",auf="�",bell="�",ab=" +",hop="�",esc="�";TEXT VARaktuellearbeitsfkt:=niltext;PROCformelmanager:DATASPACE VARds;TASK VARsourcetask;INT VARnachricht;disablestop;grundeinstellungen;REPwait(ds,nachricht,sourcetask);SELECTnachrichtOF CASEformelindateischreiben:schreibeformelindateiCASEzeichensatzumstellen:stellezeichensatzumCASEformeleditieren:continue(1);cursorgrundeinstellungen;editieredieformel;break(quiet)END SELECT;send(sourcetask,nachricht,ds);forget(ds);forget(tempdatname,quiet)END REP.schreibeformelindatei:BOUND TEXT VARformelstring:=ds;arithnotation(formelstring);IFiserrorTHENclearerror;nachricht:=fehler;LEAVEschreibeformelindateiEND IF;forget(tempdatname,quiet);FILE VARf:=sequentialfile(output,tempdatname);writeformula(f);IFiserrorTHENclearerror;forget(tempdatname,quiet);nachricht:=fehler;LEAVEschreibeformelindateiEND IF;line(f);forget(ds);ds:=old(tempdatname);forget(tempdatname,quiet);nachricht:=allesok.stellezeichensatzum:BOUND TEXT VARanzukoppelnderzeichensatz:=ds;loadops(anzukoppelnderzeichensatz);arithnotation(niltext);nachricht:=allesok.editieredieformel:BOUND TEXT VARzueditierendeformel:=ds;IFzueditierendeformel<>niltextTHENarithnotation(aktuellearbeitsfkt);ELSEaktuellearbeitsfkt:=niltext;arithnotation(niltext)END IF;footnote(anwendungstext(326));REP REP IFiserrorTHENclearerror;out(bell);loescheformelfenster;aktuellearbeitsfkt:=niltextEND IF;editformulaUNTIL NOTiserrorEND REP;TEXT VARausstieg:=formeditexitkeySUB2;SELECTpos(erlaubtezeichen,ausstieg)OF CASE1:gibinformationenzumformeleditorCASE2:schaltemarkierungumCASE3:loescheformelfensterCASE4:arithnotation(niltext);verlasseformeleditorCASE5:verlasseformeleditorEND SELECT END REP.gibinformationenzumformeleditor:footnote(anwendungstext(327));formeleditorinfo(ausstieg);IFausstieg="m"THENarithnotation(niltext);verlasseformeleditorEND IF;footnote(anwendungstext(326)).schaltemarkierungum:defformeditmark(NOTformeditmark).loescheformelfenster:cursorgrundeinstellungen;arithnotation(niltext).verlasseformeleditor:forget(tempdatname,quiet);aktuellearbeitsfkt:=arithnotation;BOUND TEXT VARfstring:=new(tempdatname);fstring:=parserformat(aktuellearbeitsfkt);forget(ds);ds:=old(tempdatname);forget(tempdatname,quiet);nachricht:=allesok;LEAVEeditieredieformelEND PROCformelmanager;PROCgrundeinstellungen:resetformulaeditor;defformeditwindow(2,6,78,18);defformeditexitkeys(niltext,niltext,erlaubtezeichen);defformeditmark(" "," ");defformeditmark(TRUE);defformeditbeep(FALSE);defformeditlearn(FALSE);defformeditbuffer(0,0,78);defformeditarith(0,0,78);defformediterror(1,21,78);defformeditrubin(2,20);defformeditlearn(0,0);defformeditkeys(0,0);aktuellearbeitsfkt:=niltext;arithnotation(niltext)END PROCgrundeinstellungen;PROCcursorgrundeinstellungen:defformeditoffset(1,5);defformeditcursor(3,5)END PROCcursorgrundeinstellungen;TEXT PROCparserformat(TEXT CONSTstring):TEXT VARstr:=string;IFpos(str,differenziersymbol)<>0THENsonderbehandlungableitungenEND IF;defaultbehandlung;IFpos(str,selektionsklammeraufsymbol)<>0THENsonderbehandlungselektionEND IF;str.sonderbehandlungableitungen:changeall(str,diffklammeraufsymbol,niltext);changeall(str,diffklammerzusymbol,niltext);changeall(str,"(: D ",differenziersymbol);changeall(str, +":) / D","/ D").defaultbehandlung:changeall(str,funktionsauswertungssymbol,niltext);changeall(str,unsichtbareklammerauf,klammeraufsymbol);changeall(str,unsichtbareklammerzu,klammerzusymbol).sonderbehandlungselektion:changeall(str,selektionsklammeraufsymbol,ifsymbol);changeall(str,selektionsklammerzusymbol,endifsymbol);changeall(str,selektionsthensymbol,thensymbol);changeall(str,selektionselifsymbol,elifsymbol);changeall(str,formeleditorundsymbol,undsymbol);changeall(str,formeleditorodersymbol,odersymbol)END PROCparserformat;PROCformeleditorinfo(TEXT VARausstieg):INT VARersteausgabezeile:=1,maximum:=anzahlzeilen-fensterzeilen;BOOL VARneuausgeben:=TRUE;REP IFneuausgebenTHENgibteiltextausEND IF;werteeingabezeichenausEND REP.gibteiltextaus:INT VARi,zeile:=erstefensterzeile,letzteausgabezeile:=ersteausgabezeile+fensterzeilen;FORiFROMersteausgabezeileUPTOletzteausgabezeileREPcursor(erstefensterspalte,zeile);out(text(anwendungstext(i+offset),77));zeileINCR1END REP.werteeingabezeichenaus:TEXT VARch;inchar(ch);IFch=aufCANDersteausgabezeile>1THENersteausgabezeileDECR1;neuausgeben:=TRUE ELIFch=abCANDersteausgabezeile<maximumTHENersteausgabezeileINCR1;neuausgeben:=TRUE ELIFch=hopTHENinchar(ch);IFch=aufCANDersteausgabezeile<>1THENersteausgabezeileDECRfensterzeilen;ersteausgabezeile:=max(ersteausgabezeile,1);neuausgeben:=TRUE ELIFch=abTHENersteausgabezeileINCRfensterzeilen;ersteausgabezeile:=min(ersteausgabezeile,maximum);neuausgeben:=TRUE ELSEneuausgeben:=FALSE END IF ELIFch=escTHENinchar(ch);SELECTpos(verlasszeichen,ch)OF CASE1:neuausgeben:=ersteausgabezeile<>1;ersteausgabezeile:=1CASE2:neuausgeben:=ersteausgabezeile<>maximum;ersteausgabezeile:=maximumCASE3,4:ausstieg:=ch;LEAVEformeleditorinfoOTHERWISEneuausgeben:=FALSE END SELECT ELSEneuausgeben:=FALSE END IF END PROCformeleditorinfo;END PACKETformeleditormanager; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek new file mode 100644 index 0000000..0be980c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.funktionsbibliothek @@ -0,0 +1,2 @@ +PACKETfunktionsbibliothekDEFINEScot,arcsin,arccos,arccot,gauss,rund,ganz,frak,realzahl,wandle,setzenachkommastellen,gesamtstellen,nachkomma,scratchdateiname:LETpisymbol="pi",esymbol="e",pihalbe=1.570796326794896619231,epsilon=0.000000000000000000001,meldung="Falscher Parameter bei realzahl",multiplikationssymbol="*",divisionssymbol="/",minussymbol="-",plussymbol="+",niltext="",blank=" ",zahlentyp=3;REAL PROCcot(REAL CONSTx):IFabs(tan(x))<epsilonTHENerrorstop(anwendungstext(55))END IF;1.0/tan(x)END PROCcot;REAL PROCarcsin(REAL CONSTx):IFabs(x)>1.0THENerrorstop(anwendungstext(54))END IF;arctan(x/sqrt(1.0-x*x))END PROCarcsin;REAL PROCarccos(REAL CONSTx):pihalbe-arcsin(x)END PROCarccos;REAL PROCarccot(REAL CONSTx):pihalbe-arctan(x)END PROCarccot;REAL PROCgauss(REAL CONSTx):IFx>=0.0CORfloor(x)=xTHENfloor(x)ELSEfloor(x)-1.0END IF END PROCgauss;REAL PROCrund(REAL CONSTx):round(x,0)END PROCrund;REAL PROCganz(REAL CONSTx):floor(x)END PROCganz;REAL PROCfrak(REAL CONSTx):frac(x)END PROCfrak;TEXT VARsym;INT VARtyp;REAL PROCrealzahl(TEXT CONSTt):enablestop;REAL VARzahl:=0.0;scan(t);nextsymbol(sym,typ);IFsym=minussymbolTHENnextsymbol(sym,typ);zahl:=-ueberprueftezahlELIFsym=plussymbolTHENnextsymbol(sym,typ);zahl:=ueberprueftezahlELSEzahl:=ueberprueftezahlEND IF;WHILEsym=multiplikationssymbolCORsym=divisionssymbolREP IFsym=multiplikationssymbolTHENnextsymbol(sym,typ);zahl:=zahl*ueberprueftezahlELIFsym=divisionssymbolTHENnextsymbol(sym,typ);zahl:=zahl/ueberprueftezahlEND IF END REP;IFsym<>niltextTHENerrorstop(meldung)END IF;zahlEND PROCrealzahl;REAL PROCueberprueftezahl:REAL VARwert;IFsym=esymbolTHENwert:=eELIFsym=pisymbolTHENwert:=piELIFtyp=zahlentypTHENwert:=real(sym)ELSEerrorstop(meldung)END IF;nextsymbol(sym,typ);wertEND PROCueberprueftezahl;ROW2INT VARnachk:=ROW2INT:(4,4),gesamtst:=ROW2INT:(18,18),grenze:=ROW2INT:(10,10);PROCsetzenachkommastellen(INT CONSTi):nachk(ebene):=i;gesamtst(ebene):=i+14;grenze(ebene):=gesamtst(ebene)-i-4END PROCsetzenachkommastellen;INT PROCgesamtstellen(INT CONSTi):gesamtst(i)END PROCgesamtstellen;INT PROCnachkomma(INT CONSTi):nachk(i)END PROCnachkomma;TEXT PROCwandle(REAL CONSTx):TEXT VARt;INT VARi;IFwertsehrgrossTHENwissenschaftlichesformatELIFwertsehrkleinTHEN IFwertnochdezimaldarstellbarTHENlangesdezimalesformatELSEwissenschaftlichesformatEND IF ELSEkurzesdezimalesformatEND IF.wertsehrgross:abs(x)>10.0**grenze(ebene).wertsehrklein:(abs(x)<10.0**(-nachk(ebene))CANDx<>0.0).wertnochdezimaldarstellbar:INT VARexponent:=abs(decimalexponent(x));exponent<gesamtst(ebene)-2.wissenschaftlichesformat:t:=text(x);INT VARn:=pos(t,"e")-1;IFn>0THEN WHILE(tSUBn)="0"REP IF(tSUB(n-1))<>"."THENchange(t,n,n,niltext);END IF;nDECR1END REP;END IF;(gesamtst(ebene)-length(t))*blank+t.kurzesdezimalesformat:t:=text(x,gesamtst(ebene),nachk(ebene));i:=gesamtst(ebene);WHILE(tSUBi)="0"REPreplace(t,i,blank);iDECR1END REP;IF(tSUBi)="."THEN IFnachk(ebene)<>0THENreplace(t,i,blank)ELSEt:=blank+text(t,i-1)END IF END IF;t.langesdezimalesformat:t:=text(x,gesamtst(ebene),exponent);i:=gesamtst(ebene);WHILE(tSUBi)="0"REPt:=blank+text(t,i-1)END REP;t.END PROCwandle;TEXT PROCscratchdateiname:TEXT VARname:="MATHEMATIKDATEI "+date+" "+timeofday;IFexists(name)THEN INT VARzaehler:=1;nameCAT":";WHILEexists(name+text(zaehler))REPzaehlerINCR1END REP;nameCATtext(zaehler)END IF;nameEND PROCscratchdateiname;END PACKETfunktionsbibliothek; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren new file mode 100644 index 0000000..2f073b1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.graphicverfahren @@ -0,0 +1,14 @@ +PACKETgraphicverfahrenDEFINESerstellegraph,normalgraphzeichnen,setzedefaultgraph,bauegraphbildschirmauf,initkoordinatensystem,berechnekoordinatensystem,nullpunkteinbeziehen,zeichnekoordinatensystem,zeichnefunktionsgraphen,zeichneasymptote,zeichnefusszeile,graphfenstereinstellen,gesamtfenstereinstellen,definitionsmenu,initprotokoll,gibprotokollaus,druckegraph,druckeprotokoll,loescheprotokoll,beendegraphikarbeit,gibgraphicmeldung,koordinatensystemxmin,koordinatensystemxmax,koordinatensystemymin,koordinatensystemymax,automatischerskalierungsmodus,zeichnetexte,loeschetexte:LETsondermenubeginn=0.65,graphrand=0.2,links="�",rechts="�",bell="�",verfahrenverlassen="qm",standardoptionen="wqm",graphicausschalten="üqmv",protokolloptionen="dwüqm",drucken="d",ueberlagerung="ü",weiterarbeit="w",graphicdefinieren="e",protokollzeigen="p",punktmarkierungszeichen="p",sekantenzeichen="s",tangentenzeichen="t",normalenzeichen="n",ableitungszeichen="a",xlotzeichen="x",ylotzeichen="y",druckzeichen="D",wischzeichen="L",parameterwahl="P",bereichswahl="B",achsenbereichzeichen="a",achsenbezeichnungszeichen="b",rasterzeichen="r",xtransformationszeichen="x",ytransformationszeichen="y",linienmoduszeichen="z",punktanzahlzeichen="p",zeichnungabbrechen="!",zeichnunganhalten=":",escapezeichen="�",minimumstuetzpunkte=5,niltext="",blank=" ",unterstrich="_",durchgezogen=TRUE,anzahltestpunkte=20.0,defaultstuetzpunkte=150,korrekturfaktor=0.4,erstemenuzeile=7,erstemenuspalte=55,punkteingabezeile=21,punkteingabelaenge=12,anzahlsondermenupunkte=12,anzahldefinitionspunkte=8,grundstift=1,stdtransformation1="y * cos (x)",stdtransformation2="y * sin (x)",xsymbol="x",ysymbol="y",maximalerachsenbetrag=1000000.0,minimaledifferenz=0.0000001,seitenabstand=8,hoehenabstand=8;TEXT VARxachsenbezeichnung:=niltext,yachsenbezeichnung:=niltext;TEXT CONSTkurzeleerzeile:=(80-erstemenuspalte)*blank,langeleerzeile:=60*blank,kurzerstrich:=12*unterstrich,loeschzeile:=kurzeleerzeile+" ";REAL VARxmin:=0.0,xmax:=1.0,ymin:=0.0,ymax:=1.0,xdistanz:=1.0,ydistanz:=1.0,deltax:=1.0,deltay:=1.0,cmbreite,cmhoehe,graphmaximum,graphminimum,graphbreite;INT VARpixelbreite,pixelhoehe,stuetzpunktanzahl:=defaultstuetzpunkte,imin,imax,i0,j0,jmin,jmax;ROW2ABBILDUNG VARtransformation;ROW2TEXT VARtransformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);ROW2BOOL VARtransformiert:=ROW2BOOL:(FALSE,FALSE);ROWanzahlsondermenupunkteTEXT CONSTsmpunkt:=ROWanzahlsondermenupunkteTEXT:(anwendungstext(191),anwendungstext(192),anwendungstext(193),anwendungstext(194),anwendungstext(195),anwendungstext(196),anwendungstext(197),anwendungstext(198),anwendungstext(199),anwendungstext(200),anwendungstext(201),anwendungstext(202));ROWanzahldefinitionspunkteTEXT CONSTdefpunkt:=ROWanzahldefinitionspunkteTEXT:(anwendungstext(118),anwendungstext(120),anwendungstext(121),anwendungstext(122),anwendungstext(123),anwendungstext(124),anwendungstext(125),anwendungstext(126));ABBILDUNG VARfkt,fktstrich;VECTOR VARfunktionsparameter;INT VARlaufvariablenindex:=1;REAL VARanfangswert:=-5.0,endwert:=5.0;BOOL VARlinienmodus:=durchgezogen,ursprungobligatorisch:=TRUE,automatischeskalierung:=TRUE,graphgerastert:=FALSE,bereichseingabegewuenscht:=TRUE,parametereingabegewuenscht:=TRUE,mitkoordinatensystem:=TRUE,asymptotensichtbar:=TRUE,parameterdarstellung:=FALSE,vorzeitigerabbruch:=FALSE,unterbrechenerlaubt:=TRUE,koordinatensysteminitialisiert:=FALSE,ueberlagern:=FALSE;PICTURE VARkoordinatensystem:=nilpicture;PROCerstellegraph(ABBILDUNG CONSTf):TEXT VARausstieg;disablestop;ueberpruefeverwendbarkeitderfunktion;bauegraphbildschirmauf(f,titel);initialisierediebearbeitung;bearbeitefunktion;beendearbeit.ueberpruefeverwendbarkeitderfunktion:fkt:=f;IFlaenge(abbildungsterme(fkt))>2THENgibmeldung(anwendungstext(88));LEAVEerstellegraphEND IF;IFueberlagernCAND NOT(parameterdarstellungXORlaenge(abbildungsterme(fkt))=1)THENgibmeldung(anwendungstext(177));LEAVEerstellegraphEND IF;parameterdarstellung:=laenge(abbildungsterme(f))=2;IFkomplexefunktion(fkt) +THENfkt:=aufloesung(fkt)END IF.initialisierediebearbeitung:unterbrechenerlaubt:=TRUE;IFueberlagernTHENgraphfenstereinstellen;plotscreenmemoryELSEinitkoordinatensystemEND IF.titel:IFparameterdarstellungTHEN"Graph - Parameterdarstellung"ELSE"Graph"END IF.bearbeitefunktion:TEXT VARvariablenname:=NAMElistenanfang(abbildungsvariablen(fkt));laufvariablenindex:=1;funktionsparameter:=vector(laenge(abbildungsvariablen(fkt)));cursor(2,3);out("Variable :");cursor(22,3);out("von");cursor(39,3);out("bis");bereichseingabegewuenscht:=TRUE;WHILEbereichseingabegewuenschtREPbestimmelaufvariablenindexundbereich;mitkoordinatensystem:=NOTueberlagern;parametereingabegewuenscht:=TRUE;WHILEparametereingabegewuenschtREPbestimmeggfparameterwerte;zeichnefusszeile(anwendungstext(144));IFmitkoordinatensystemTHENinitkoordinatensystem;bestimmekoordinatenundzeichnekoordinatensystem;mitkoordinatensystem:=FALSE END IF;vorzeitigerabbruch:=FALSE;zeichnediefunktion;graphictools(ausstieg)END REP END REP.bestimmelaufvariablenindexundbereich:initialisierebereichseingabemaske;REPbearbeitebereichseingabemaske;werteausstiegausEND REP.initialisierebereichseingabemaske:LETfeldanzahl=3,yposition=3;INT VARi,feldptr;TEXT VARerlaubteausstiegszeichen:=graphicdefinieren+standardoptionen,verlasszeichen;ROWfeldanzahlTEXT VARfeld:=ROWfeldanzahlTEXT:(variablenname,compress(wandle(anfangswert)),compress(wandle(endwert)));ROWfeldanzahlINT CONSTxposition:=ROWfeldanzahlINT:(13,26,43),feldlaenge:=ROWfeldanzahlINT:(8,12,12);ROWfeldanzahlBOOL CONSTgesperrt:=ROWfeldanzahlBOOL:(ebene=1CORlaenge(abbildungsvariablen(fkt))=1,ueberlagern,ueberlagern);FORfeldptrFROM1UPTOfeldanzahlREP IF NOTgesperrt(feldptr)THENfeld(feldptr)CATkurzerstrichEND IF;cursor(xposition(feldptr),yposition);out(text(feld(feldptr),feldlaenge(feldptr)))END REP;feldptr:=0;bereichseingabegewuenscht:=NOT(gesperrt(1)CANDgesperrt(2)CANDgesperrt(3));IF NOTbereichseingabegewuenschtTHEN LEAVEbestimmelaufvariablenindexundbereichEND IF;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;verlasszeichen:=erlaubteausstiegszeichen+links+rechts.bearbeitebereichseingabemaske:IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(128))END IF;REP IFausstieg=linksTHEN IFfeldptr>1THENfeldptrDECR1END IF ELSEfeldptr:=feldptrMODfeldanzahl+1END IF;IFgesperrt(feldptr)THEN IFfeldptr=1THENfeldptr:=2ELIFfeldptr=2THENfeldptr:=1END IF END IF;cursor(xposition(feldptr),yposition);grapheditget(feld(feldptr),feldlaenge(feldptr),verlasszeichen,ausstieg)UNTILpos(erlaubteausstiegszeichen,ausstieg)<>0END REP.werteausstiegaus:SELECTpos(erlaubteausstiegszeichen,ausstieg)OF CASE1:IF NOTueberlagernTHENdefinitionsmenu(FALSE,ausstieg);IFpos(verfahrenverlassen,ausstieg)<>0THENverfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF END IF;CASE2:IFwertekorrektTHENbereichseingabegewuenscht:=FALSE;LEAVEbestimmelaufvariablenindexundbereichELSE FORiFROM1UPTOfeldanzahlREP IF NOTgesperrt(i)THENfeld(i)CATkurzerstrichEND IF END REP END IF OTHERWISEverfahrensende(ausstieg);ueberlagern:=ausstieg=ueberlagerung;LEAVEbearbeitefunktionEND SELECT.wertekorrekt:FORiFROM1UPTO3REPchangeall(feld(i),unterstrich,niltext)END REP;(gesperrt(1)CORkorrektervariablenname)CAND(gesperrt(2)CORkorrekteranfangswert)CAND(gesperrt(3)CORkorrekterendwert).korrektervariablenname:TERM VARt:=listenposition(abbildungsvariablen(fkt),feld(1));IFt=nilTHENfeldptr:=0;FALSE ELSEvariablenname:=NAMEt;laufvariablenindex:=PLATZt;TRUE END IF.korrekteranfangswert:REAL VARwert:=realzahl(feld(2));IFiserrorTHENbehandlefehler;feldptr:=1;FALSE ELIFabs(wert)>maximalerachsenbetragTHENfeldptr:=1;FALSE ELSEanfangswert:=wert;replace(funktionsparameter,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:wert:=realzahl(feld(3));IFiserrorTHENbehandlefehler;feldptr:=2;FALSE ELIFwert-anfangswert<=minimaledifferenzCORabs(wert)>maximalerachsenbetragTHENfeldptr:=2;FALSE ELSEendwert:=wert;TRUE END IF.bestimmeggfparameterwerte:IFlength(funktionsparameter)=1THENparametereingabegewuenscht +:=FALSE;LEAVEbestimmeggfparameterwerteEND IF;cursor(2,4);out("Parameter:");IFueberlagernTHENzeichnefusszeile(anwendungstext(176))ELSEzeichnefusszeile(anwendungstext(100))END IF;erlaubteausstiegszeichen:=standardoptionen;IFueberlagernTHENerlaubteausstiegszeichenCATueberlagerungEND IF;cursor(13,4);belegeparameter(funktionsparameter,laufvariablenindex,abbildungsvariablen(fkt),erlaubteausstiegszeichen,ausstieg);IFausstieg=weiterarbeitTHENparametereingabegewuenscht:=FALSE;cursor(2,4);out(langeleerzeile)ELSEueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEbearbeitefunktionEND IF.bestimmekoordinatenundzeichnekoordinatensystem:IFautomatischeskalierungTHENberechnekoordinatensystemELIF NOTparameterdarstellungCAND NOTtransformiert(1)THENxmin:=anfangswert;xmax:=endwertEND IF;zeichnekoordinatensystem.zeichnediefunktion:pen(1,1,1,neuerstift);vorzeitigerabbruch:=FALSE;zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEbearbeitefunktionEND IF.beendearbeit:IF NOTueberlagernTHENclearscreenmemoryEND IF;loeschetemporaereabbildung(fkt);loeschetemporaereabbildung(fktstrich);plotendEND PROCerstellegraph;PROCgraphictools(TEXT VARausstieg):TEXT VARch;TEXT CONSTgueltigerausstieg:=verfahrenverlassen+ueberlagerung;REAL VARpx:=0.0,py;BOOL VARvollerfunktionsumfang,ableitunggezeichnet:=FALSE;BOOL CONSTzeichnungerweiterbar:=NOTtransformiert(1)CAND NOTtransformiert(2)CAND NOTparameterdarstellung;IFzeichnungerweiterbarTHENtestefunktionsumfangEND IF;zeichnesondermenu;REPclearbuffer;inchar(ch);IFch=punktmarkierungszeichenCANDzeichnungerweiterbarTHENmarkiereauszuwaehlendenpunktELIFch=sekantenzeichenCANDzeichnungerweiterbarTHENzeichneauszuwaehlendesekanteELIFch=tangentenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendetangenteELIFch=normalenzeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangTHENzeichneauszuwaehlendenormaleELIFch=xlotzeichenCANDzeichnungerweiterbarTHENzeichnexlotELIFch=ylotzeichenCANDzeichnungerweiterbarTHENzeichneylotELIFch=ableitungszeichenCANDzeichnungerweiterbarCANDvollerfunktionsumfangCAND NOTableitunggezeichnetTHENzeichneableitungsfunktionELIFch=wischzeichenTHENerneueregraphicELIFch=druckzeichenTHENdruckegraphELIFch=parameterwahlCANDlaenge(abbildungsvariablen(fkt))<>1THENparametereingabegewuenscht:=TRUE;loeschesondermenu;LEAVEgraphictoolsELIFch=bereichswahlTHENbereichseingabegewuenscht:=TRUE;ueberlagern:=FALSE;loeschesondermenu;graphfenstereinstellen;loeschezeichnung;LEAVEgraphictoolsELIFch=escapezeichenTHENinchar(ausstieg);IFpos(gueltigerausstieg,ausstieg)<>0THENverlassegraphicbildschirmELIFausstieg=protokollzeigenTHENzeigeparameterbelegungELSEout(bell)END IF ELSEout(bell)END IF END REP.testefunktionsumfang:IFadresse(fktstrich)=nilTHENfktstrich:=ableitung(fkt,1,laufvariablenindex);IFiserrorTHENclearerror;vollerfunktionsumfang:=FALSE ELSEvollerfunktionsumfang:=TRUE END IF ELSEvollerfunktionsumfang:=TRUE END IF.zeichnesondermenu:INT VARi,zeile:=erstemenuzeile,anfang:=1;gesamtfenstereinstellen;IF NOTzeichnungerweiterbarTHENanfang:=9END IF;FORiFROManfangUPTOanzahlsondermenupunkteREP IF(laenge(abbildungsvariablen(fkt))<>1CANDi=10)CORi<>10CAND(vollerfunktionsumfangCOR(i<>2CANDi<>4CANDi<>5))THENcursor(erstemenuspalte,zeile);out(smpunkt(i));zeileINCR1END IF END REP;zeichnefusszeile(anwendungstext(178)).markiereauszuwaehlendenpunkt:punkteingabe;IFiserrorTHENbehandlefehlerELSEmarkierepunkt(px,py)END IF.zeichneauszuwaehlendetangente:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnetangente(px,py)END IF.zeichneauszuwaehlendesekante:REAL VARpx1:=px,px2:=0.0,py1,py2;liesdiebeidenpunkteein;zeichnefusszeile(anwendungstext(178));graphfenstereinstellen;zeichnegerade(px1,py1,px2,py2).liesdiebeidenpunkteein:liespunktein("x1 = ",anwendungstext(179),px1,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;replace(funktionsparameter,laufvariablenindex,px1);py1:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF; +REPliespunktein("x2 = ",niltext,px2,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;IFpx2=px1THENout(bell)END IF UNTILpx2<>px1END REP;replace(funktionsparameter,laufvariablenindex,px2);py2:=ergebnis(fkt,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichneauszuwaehlendesekanteEND IF.zeichneauszuwaehlendenormale:punkteingabe;IFiserrorTHENbehandlefehlerELSEzeichnenormale(px,py)END IF.zeichnexlot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;newpicture(lotstift);pen(1,1,1,lotstift);matmove(px,py);matdraw(px,0.0)END IF.zeichneylot:punkteingabe;IFiserrorTHENbehandlefehlerELSEgraphfenstereinstellen;pen(1,1,1,lotstift);newpicture(lotstift);matmove(px,py);matdraw(0.0,py)END IF.zeichneableitungsfunktion:asymptotensichtbar:=FALSE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fktstrich);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));asymptotensichtbar:=TRUE;ableitunggezeichnet:=TRUE.erneueregraphic:ueberlagern:=FALSE;graphfenstereinstellen;loeschezeichnungpartiell;initprotokoll;asymptotensichtbar:=TRUE;replace(funktionsparameter,laufvariablenindex,anfangswert);zeichnefusszeile(anwendungstext(144));initstift;pen(1,1,1,neuerstift);zeichnefunktionsgraphen(fkt);IFvorzeitigerabbruchTHENsetzewertezurueck;LEAVEgraphictoolsEND IF;zeichnefusszeile(anwendungstext(178));ableitunggezeichnet:=FALSE.zeigeparameterbelegung:gibprotokollaus(anwendungstext(214),protokolloptionen,ausstieg);IFausstieg=weiterarbeitTHENzeichnesondermenuELSEverlassegraphicbildschirmEND IF.verlassegraphicbildschirm:ueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictools.loeschesondermenu:INT VARende:=anzahlsondermenupunkte;IF NOTzeichnungerweiterbarTHENende:=4ELIF NOTvollerfunktionsumfangTHENendeDECR3END IF;IFlaenge(abbildungsvariablen(fkt))=1THENendeDECR1END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1).punkteingabe:liespunktein("x = ",anwendungstext(179),px,gueltigerausstieg,ausstieg,punkteingabezeile);testevorzeitigenausstieg;zeichnefusszeile(anwendungstext(178));replace(funktionsparameter,laufvariablenindex,px);py:=ergebnis(fkt,funktionsparameter)SUB1.testevorzeitigenausstieg:IFausstieg<>niltextTHENueberlagern:=ausstieg=ueberlagerung;verfahrensende(ausstieg);LEAVEgraphictoolsEND IF END PROCgraphictools;PROCmarkierepunkt(REAL CONSTx,y):INT VARi,j;INT CONSTstrichlaenge:=4;REAL VARunten,oben,links,rechts;graphfenstereinstellen;IFx<xminCORx>xmaxCORy<yminCORy>ymaxTHEN LEAVEmarkierepunktEND IF;pen(1,1,1,punktstift);i:=xpixel(x);j:=ypixel(y);links:=xweltkoordinate(i-strichlaenge);rechts:=xweltkoordinate(i+strichlaenge);unten:=yweltkoordinate(j-strichlaenge);oben:=yweltkoordinate(j+strichlaenge);newpicture(punktstift);matmove(links,oben);matdraw(rechts,unten);matmove(links,unten);matdraw(rechts,oben)END PROCmarkierepunkt;PROCzeichnetangente(REAL CONSTx,y):REAL VARm;IFx<xminCORx>xmaxTHEN LEAVEzeichnetangenteEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnetangenteEND IF;graphfenstereinstellen;pen(1,1,1,tangentenstift);newpicture(tangentenstift);matmove(xmin,m*(xmin-x)+y);matdraw(xmax,m*(xmax-x)+y)END PROCzeichnetangente;PROCzeichnenormale(REAL CONSTx,y):REAL VARm;IFx<xminCORx>xmaxTHEN LEAVEzeichnenormaleEND IF;replace(funktionsparameter,laufvariablenindex,x);m:=ergebnis(fktstrich,funktionsparameter)SUB1;IFiserrorTHENbehandlefehler;LEAVEzeichnenormaleEND IF;graphfenstereinstellen;pen(1,1,1,normalenstift);newpicture(normalenstift);IFm=0.0THENmatmove(x,ymax);matdraw(x,ymin)ELSEmatmove(xmin,-1.0/m*(xmin-x)+y);matdraw(xmax,-1.0/m*(xmax-x)+y)END IF END PROCzeichnenormale;PROCzeichnegerade(REAL CONSTx1,y1,x2,y2):REAL VARm:=(y2-y1)/(x2-x1);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(xmin,m*(xmin-x1)+y1);matdraw(xmax,m*(xmax-x1)+y1)END PROCzeichnegerade; +PROCbauegraphbildschirmauf(ABBILDUNG CONSTf,TEXT CONSTueberschrift):initgraphic;zeichnestatuszeile(ueberschrift);zeichnearbeitsfunktion(f);zeichnebildschirmrasterEND PROCbauegraphbildschirmauf;PROCzeichnestatuszeile(TEXT CONSTverfahrensname):TEXT VARgrundlage:=text(anwendungstext(102),78),anhang:="Ebene "+text(ebene)+" "+verfahrensname;replace(grundlage,77-length(anhang),anhang);cursor(2,1);out(grundlage)END PROCzeichnestatuszeile;PROCzeichnearbeitsfunktion(ABBILDUNG CONSTf):cursor(2,2);out(text(funktionsstring(f),78))END PROCzeichnearbeitsfunktion;PROCzeichnebildschirmraster:pen(1,1,1,grundstift);IFanpassungstyp<>"cga"THENboxEND IF;move(0.0,graphmaximum);draw(cmbreite,graphmaximum);move(graphbreite,graphmaximum);draw(graphbreite,graphminimum);move(0.0,graphminimum);draw(cmbreite,graphminimum)END PROCzeichnebildschirmraster;PROCzeichnefusszeile(TEXT CONSTt):cursor(2,24);out(text(t,78))END PROCzeichnefusszeile;PROCgibgraphicmeldung(TEXT CONSTinhalt):TEXT VARt:=78*waagerecht;cursor(1,21);out(eckeobenlinks+t+eckeobenrechts);cursor(1,22);out(senkrecht+text(inhalt,78)+senkrecht);cursor(1,23);out(eckeuntenlinks+t+eckeuntenrechts);zeichnefusszeile(anwendungstext(77));pauseEND PROCgibgraphicmeldung;PROCsetzedefaultgraph:automatischeskalierung:=TRUE;ursprungobligatorisch:=TRUE;linienmodus:=durchgezogen;xachsenbezeichnung:="A1";yachsenbezeichnung:="A2";stuetzpunktanzahl:=defaultstuetzpunkte;graphgerastert:=FALSE;transformiert:=ROW2BOOL:(FALSE,FALSE);transformationsvorgabe:=ROW2TEXT:(stdtransformation1,stdtransformation2);xmin:=-5.0;xmax:=5.0;ymin:=-5.0;ymax:=5.0;ueberlagern:=FALSE;anfangswert:=-5.0;endwert:=5.0END PROCsetzedefaultgraph;PROCinitkoordinatensystem:koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;initprotokoll;initscreenmemory;initstiftEND PROCinitkoordinatensystem;PROCbeendegraphikarbeit:clearscreenmemory;loescheprotokoll;loescheggftransformation(1);loescheggftransformation(2)END PROCbeendegraphikarbeit;PROCloescheggftransformation(INT CONSTi):IFtransformiert(i)THENloescheabbildung(transformation(i))ENDIF END PROCloescheggftransformation;PROCinitgraphic:beginplot;clear;drawingarea(cmbreite,cmhoehe,pixelbreite,pixelhoehe);move(cmbreite,cmhoehe);gesamtfenstereinstellen;berechnebildschirmaufteilungskonstanten.berechnebildschirmaufteilungskonstanten:graphmaximum:=cmhoehe-4.5*stdhoehe;graphminimum:=cmhoehe-23.0*stdhoehe;graphbreite:=sondermenubeginn*cmbreiteEND PROCinitgraphic;PROCgesamtfenstereinstellen:viewport(0.0,cmbreite,0.0,cmhoehe);window(0.0,cmbreite,0.0,cmhoehe)END PROCgesamtfenstereinstellen;PROCgraphfenstereinstellen:viewport(graphrand,graphbreite-graphrand,graphminimum+graphrand,graphmaximum-graphrand);window(xmin,xmax,ymin,ymax)END PROCgraphfenstereinstellen;PROCberechnekoordinatensystem(ABBILDUNG CONSTabb,REAL CONSTlinks,rechts,VECTOR CONSTparam,INT CONSTvindex):parameterdarstellung:=FALSE;fkt:=abb;IFlinks<rechtsTHENanfangswert:=links;endwert:=rechtsELSEanfangswert:=rechts;endwert:=linksEND IF;anfangswert:=max(anfangswert,-maximalerachsenbetrag);endwert:=min(endwert,maximalerachsenbetrag);IFendwert-anfangswert<=minimaledifferenzTHENanfangswert:=anfangswert-minimaledifferenz;endwert:=anfangswert+minimaledifferenzEND IF;funktionsparameter:=param;laufvariablenindex:=vindex;IFautomatischeskalierungTHENberechnekoordinatensystemEND IF END PROCberechnekoordinatensystem;PROCberechnekoordinatensystem:ROW2BOOL VARdefinierterwertgefunden:=ROW2BOOL:(FALSE,FALSE);BOOL VARxachseaendern:=transformiert(1)CORparameterdarstellung;INT VARi,j;VECTOR VAReingaben:=funktionsparameter;REAL CONSTteststep:=(endwert-anfangswert)/(anzahltestpunkte-1.0);REAL VARx:=anfangswert,ertrag1,ertrag2;TERM VARfktterm1:=listenanfang(abbildungsterme(fkt)),fktterm2;ymin:=maximalerachsenbetrag;ymax:=-ymin;IFxachseaendernTHENxmin:=maximalerachsenbetrag;xmax:=-xmin;ELSExmin:=anfangswert;xmax:=endwertEND IF;IFparameterdarstellungTHENfktterm2:=AUSDRUCKnachfolger(fktterm1)END IF;fktterm1:=AUSDRUCKfktterm1;berechnetransformationsparameter; +WHILEx<=endwertREPberechne;x:=x+teststepEND REP;IF NOTdefinierterwertgefunden(2)THENymin:=-5.0;ymax:=5.0END IF;IFxachseaendernTHEN IF NOTdefinierterwertgefunden(1)THENxmin:=-5.0;xmax:=5.0END IF;korrigiereachse(xmin,xmax)END IF;korrigiereachse(ymin,ymax);IFursprungobligatorischTHENnullpunkteinbeziehenEND IF.berechnetransformationsparameter:ROW2VECTOR VARvect;ROW2TERM VARterm;FORiFROM1UPTO2REP IFtransformiert(i)THENvect(i):=vector(laenge(abbildungsvariablen(transformation(i))));term(i):=AUSDRUCKlistenanfang(abbildungsterme(transformation(i)))END IF END REP.berechne:replace(eingaben,laufvariablenindex,x);ertrag1:=result(fktterm1,eingaben);IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(2):=NOTparameterdarstellungCAND NOTtransformiert(2);definierterwertgefunden(1):=parameterdarstellungCAND NOTtransformiert(1)END IF;IFparameterdarstellungTHENertrag2:=result(fktterm2,eingaben);IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(2):=NOTtransformiert(2)END IF END IF;transformiere;vergleiche.transformiere:ROW2REAL VARy;ROW2REAL VARp;IFparameterdarstellungTHENy:=ROW2REAL:(ertrag1,ertrag2)ELSEy:=ROW2REAL:(x,ertrag1)END IF;FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTOlength(vect(i))REPreplace(vect(i),j,y(j))END REP;p(i):=result(term(i),vect(i));IFiserrorTHENclearerror;LEAVEberechneELSEdefinierterwertgefunden(i):=TRUE END IF ELSEp(i):=y(i)END IF END REP.vergleiche:IFtransformiert(1)CORparameterdarstellungTHENxmax:=min(max(p(1),xmax),maximalerachsenbetrag);xmin:=max(min(p(1),xmin),-maximalerachsenbetrag)END IF;ymax:=min(max(p(2),ymax),maximalerachsenbetrag);ymin:=max(min(p(2),ymin),-maximalerachsenbetrag)END PROCberechnekoordinatensystem;PROCkorrigiereachse(REAL VARminimum,maximum):minimum:=max(minimum-korrekturfaktor*abs(minimum),-maximalerachsenbetrag);maximum:=min(maximum+korrekturfaktor*abs(maximum),maximalerachsenbetrag);IFminimum=maximumTHEN IFminimum=maximalerachsenbetragTHENminimum:=0.9*maximalerachsenbetragELIFminimum=-maximalerachsenbetragTHENmaximum:=0.9*minimumELSEminimum:=minimum-0.5;maximum:=maximum+0.5END IF END IF END PROCkorrigiereachse;PROCnullpunkteinbeziehen:IFxmax<=0.0THENxmax:=-0.15*xminELIFxmin>=0.0THENxmin:=-0.15*xmaxEND IF;IFymax<=0.0THENymax:=-0.15*yminELIFymin>=0.0THENymin:=-0.15*ymaxEND IF END PROCnullpunkteinbeziehen;PROCzeichnekoordinatensystem:graphfenstereinstellen;IF NOTkoordinatensysteminitialisiertTHENstellekoordinatensystemneuzusammenEND IF;gibkoordinatensystemaus.stellekoordinatensystemneuzusammen:ueberpruefesichtbarkeit;bestimmepixelmarkanterpunkte;zeichnedasbild;koordinatensysteminitialisiert:=TRUE;putscreenmemory(koordinatensystem).ueberpruefesichtbarkeit:BOOL CONSTxachsesichtbar:=ymin<=0.0CANDymax>=0.0,yachsesichtbar:=xmin<=0.0CANDxmax>=0.0.bestimmepixelmarkanterpunkte:imin:=xpixel(xmin);imax:=xpixel(xmax);jmin:=ypixel(ymin);jmax:=ypixel(ymax);IFxachsesichtbarTHENj0:=ypixel(0.0)END IF;IFyachsesichtbarTHENi0:=xpixel(0.0)END IF.zeichnedasbild:TEXT VARstring;INT VARtextlaenge,schreibzeile,schreibspalte,verfuegbarerplatz;REAL VARwert,letzterwert,start,anfang,ende,schriftbreite:=stdbreite,schrifthoehe:=stdhoehe;BOOL VARwertausgeben;berechneabstaende;pen(koordinatensystem,grundstift);IFxachsesichtbarTHENzeichnexachse;skalierexachse;beschriftexachseEND IF;IFyachsesichtbarTHENzeichneyachse;skaliereyachse;beschrifteyachseEND IF;IFgraphgerastertTHENlegerasteruebergraphEND IF.berechneabstaende:deltax:=xmax-xmin;deltay:=ymax-ymin;xdistanz:=10.0**decimalexponent(max(abs(xmax),abs(xmin)));ydistanz:=10.0**decimalexponent(max(abs(ymax),abs(ymin)));WHILExdistanz>=0.33*deltaxREPxdistanz:=0.1*xdistanzEND REP;WHILEydistanz>=0.33*deltayREPydistanz:=0.1*ydistanzEND REP.zeichnexachse:move(koordinatensystem,xmin,0.0);draw(koordinatensystem,xmax,0.0).skalierexachse:bestimmelaengederxskalierungsstriche;zeichnediexachsenstriche.bestimmelaengederxskalierungsstriche:REAL CONSTyabstand:=deltay/80.0;anfang:=min(yabstand,ymax);ende:=max(-yabstand,ymin).zeichnediexachsenstriche:start:=xmax-xmax +MODxdistanz;WHILEstart>=xminREPmove(koordinatensystem,start,anfang);draw(koordinatensystem,start,ende);start:=start-xdistanzEND REP.beschriftexachse:gibxeinheitenaus;gibxachsenbezeichnungaus.gibxeinheitenaus:INT VARrechtegrenze:=imax,linkegrenze:=imin;REAL VARschreibzeilenweltlage;schreibzeile:=j0-zeichenhoehe-hoehenabstand;IFschreibzeile<jminTHEN LEAVEgibxeinheitenausEND IF;wertausgeben:=TRUE;schreibzeilenweltlage:=yweltkoordinate(schreibzeile);IFyachsesichtbarTHENlinkegrenze:=i0+seitenabstandEND IF;letzterwert:=xdistanz;wert:=xmax-xmaxMODxdistanz;WHILEwert>=xminREP IFwertausgebenTHENstring:=compress(wandle(wert));textlaenge:=length(string)*zeichenbreite;schreibspalte:=xpixel(wert)-textlaengeDIV2;IFschreibspalte+textlaenge<=rechtegrenzeCANDschreibspalte>=linkegrenzeTHENmove(koordinatensystem,xweltkoordinate(schreibspalte),schreibzeilenweltlage);draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;rechtegrenze:=schreibspalte-3*zeichenbreiteEND IF ELSEwertausgeben:=TRUE END IF;wert:=wert-xdistanz;IFwert=0.0THENwert:=-letzterwert;rechtegrenze:=i0-seitenabstand;wertausgeben:=TRUE END IF;IFwert<xdistanzTHENlinkegrenze:=iminEND IF END REP.gibxachsenbezeichnungaus:schreibzeile:=j0+hoehenabstand;IFschreibzeile+zeichenhoehe>jmaxTHEN LEAVEgibxachsenbezeichnungausEND IF;IFyachsesichtbarTHENlinkegrenze:=i0+seitenabstandELSElinkegrenze:=iminEND IF;verfuegbarerplatz:=imax-linkegrenze;IFverfuegbarerplatz<zeichenbreiteTHEN LEAVEgibxachsenbezeichnungausEND IF;textlaenge:=length(xachsenbezeichnung);WHILEverfuegbarerplatz<zeichenbreite*textlaengeREPtextlaengeDECR1END REP;move(koordinatensystem,xweltkoordinate(imax-zeichenbreite*textlaenge),yweltkoordinate(schreibzeile));draw(koordinatensystem,text(xachsenbezeichnung,textlaenge),0.0,schrifthoehe,schriftbreite).zeichneyachse:move(koordinatensystem,0.0,ymax);draw(koordinatensystem,0.0,ymin).skaliereyachse:bestimmelaengederyskalierungsstriche;zeichnedieyachsenstriche.bestimmelaengederyskalierungsstriche:REAL CONSTxabstand:=deltax/80.0;anfang:=max(-xabstand,xmin);ende:=min(xabstand,xmax).zeichnedieyachsenstriche:start:=ymax-ymaxMODydistanz;WHILEstart>=yminREPmove(koordinatensystem,anfang,start);draw(koordinatensystem,ende,start);start:=start-ydistanzEND REP.beschrifteyachse:gibyeinheitenaus;gibyachsenbezeichnungaus.gibyeinheitenaus:INT VARoberegrenze:=jmax,unteregrenze:=jmin,zentrierung:=zeichenhoeheDIV2;REAL VARschreibspaltenweltlage;schreibspalte:=i0+seitenabstand;IFschreibspalte>imaxTHEN LEAVEgibyeinheitenausEND IF;schreibspaltenweltlage:=xweltkoordinate(schreibspalte);IFxachsesichtbarTHENunteregrenze:=j0+hoehenabstandEND IF;wertausgeben:=ymax<=2.5*ydistanz;letzterwert:=ydistanz;verfuegbarerplatz:=imax-i0-seitenabstand;wert:=ymax-ymaxMODydistanz;WHILEwert>=yminREP IFwertausgebenTHENschreibzeile:=ypixel(wert)-zentrierung;IFschreibzeile+zeichenhoehe<=oberegrenzeCANDschreibzeile>=unteregrenzeTHENstring:=compress(wandle(wert));IFlength(string)*zeichenbreite<=verfuegbarerplatzTHENmove(koordinatensystem,schreibspaltenweltlage,yweltkoordinate(schreibzeile));draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite);wertausgeben:=FALSE;letzterwert:=wert;oberegrenze:=schreibzeile-zeichenhoeheEND IF END IF ELSEwertausgeben:=TRUE END IF;wert:=wert-ydistanz;IFwert=0.0THENwert:=-letzterwert;oberegrenze:=j0-hoehenabstand;wertausgeben:=TRUE END IF;IFwert<ydistanzTHENunteregrenze:=jminEND IF END REP.gibyachsenbezeichnungaus:schreibzeile:=jmax-zeichenhoehe;IFxachsesichtbarCANDj0+hoehenabstand>schreibzeileTHEN LEAVEgibyachsenbezeichnungausEND IF;verfuegbarerplatz:=i0-imin-seitenabstand;IFverfuegbarerplatz<zeichenbreiteTHEN LEAVEgibyachsenbezeichnungausEND IF;string:=yachsenbezeichnung;WHILEverfuegbarerplatz<zeichenbreite*length(string)REPstring:=subtext(string,2,length(string))END REP;move(koordinatensystem,xweltkoordinate(i0-seitenabstand-length(string)*zeichenbreite),yweltkoordinate(schreibzeile));draw(koordinatensystem,string,0.0,schrifthoehe,schriftbreite). +legerasteruebergraph:ende:=ymax-ymaxMODydistanz;WHILEende>=yminREPanfang:=xmax-xmaxMODxdistanz;WHILEanfang>=xminREPmove(koordinatensystem,anfang,ende);draw(koordinatensystem,anfang,ende);anfang:=anfang-xdistanzEND REP;ende:=ende-ydistanzEND REP.gibkoordinatensystemaus:pen(1,1,1,pen(koordinatensystem));plot(koordinatensystem)END PROCzeichnekoordinatensystem;PROCnormalgraphzeichnen(ABBILDUNG CONSTabb,VECTOR CONSTparam,INT CONSTvindex):initstift;pen(1,1,1,neuerstift);parameterdarstellung:=FALSE;fkt:=abb;anfangswert:=xmin;endwert:=xmax;unterbrechenerlaubt:=FALSE;funktionsparameter:=param;laufvariablenindex:=vindex;zeichnefunktionsgraphen(fkt)END PROCnormalgraphzeichnen;PROCzeichnefunktionsgraphen(ABBILDUNG CONSTf):graphfenstereinstellen;newpicture(aktuellerstift);IFtransformiert(1)CORtransformiert(2)CORparameterdarstellungTHENzeichnefunktiontransformiert(f)ELIFlinienmodusTHENzeichnefunktionmitasymptotenroutine(f)ELSEzeichnefunktioneinfach(f)END IF;protokollierekurve(f,funktionsparameter,laufvariablenindex)END PROCzeichnefunktionsgraphen;PROCzeichnefunktiontransformiert(ABBILDUNG CONSTf):INT VARi,j;TERM VARfktterm1:=listenanfang(abbildungsterme(f)),fktterm2;REAL VARx:=anfangswert,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1);ROW2REAL VARy;VECTOR VARv:=funktionsparameter;BOOL VARfehlerzustand:=TRUE;IFparameterdarstellungTHENfktterm2:=AUSDRUCKnachfolger(fktterm1)END IF;fktterm1:=AUSDRUCKfktterm1;bestimmegegebenenfallstransformationsparameter;WHILEx<endwertREPberechne;befragetastatur;x:=x+stepEND REP.bestimmegegebenenfallstransformationsparameter:ROW2VECTOR VARvect;ROW2TERM VARterm;FORiFROM1UPTO2REP IFtransformiert(i)THENvect(i):=vector(laenge(abbildungsvariablen(transformation(i))));term(i):=AUSDRUCKlistenanfang(abbildungsterme(transformation(i)))END IF END REP.berechne:replace(v,laufvariablenindex,x);y(1):=result(fktterm1,v);IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF;IFparameterdarstellungTHENy(2):=result(fktterm2,v);IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF ELSEy(2):=y(1);y(1):=xEND IF;berechnegegebenenfallstransformation;zeichne.berechnegegebenenfallstransformation:ROW2REAL VARp;FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTOlength(vect(i))REPreplace(vect(i),j,y(j))END REP;p(i):=result(term(i),vect(i));IFiserrorTHENclearerror;fehlerzustand:=TRUE;LEAVEberechneEND IF ELSEp(i):=y(i)END IF END REP.zeichne:IF NOTlinienmodusCORfehlerzustandTHENmatmove(p(1),p(2))END IF;matdraw(p(1),p(2));fehlerzustand:=FALSE.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktiontransformiertELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktiontransformiert;PROCzeichnefunktioneinfach(ABBILDUNG CONSTf):graphfenstereinstellen;VECTOR VARv:=funktionsparameter;REAL VARx:=anfangswert,y,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1);TERM CONSTfktterm:=AUSDRUCKlistenanfang(abbildungsterme(f));WHILEx<=endwertREPreplace(v,laufvariablenindex,x);y:=result(fktterm,v);IFiserrorTHENclearerrorELSEmatmove(x,y);matdraw(x,y)END IF;befragetastatur;x:=x+stepEND REP.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktioneinfachELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktioneinfach;PROCzeichnefunktionmitasymptotenroutine(ABBILDUNG CONSTf):BOOL VARwertdirektgefunden,mindestenseindefinierterwert:=FALSE;REAL VARx1:=anfangswert,step:=(endwert-anfangswert)/real(stuetzpunktanzahl-1),x2,x3,y1,y2,y3,xundef,xdef,ydef;TERM CONSTfktterm:=AUSDRUCKlistenanfang(abbildungsterme(f));REPuntersuchedreiaufeinanderfolgendewerteEND REP.untersuchedreiaufeinanderfolgendewerte:sucheerstenwert;zeichneerstenwert;suchezweitenwert;REPsuchedrittenwert;untersuchediewerteEND REP.sucheerstenwert:wertdirektgefunden:=TRUE;suchschleife; +verfeineregegebenenfalls.suchschleife:REPbefragetastatur;replace(funktionsparameter,laufvariablenindex,x1);y1:=result(fktterm,funktionsparameter);IFiserrorTHENclearerror;wertdirektgefunden:=FALSE;x1:=x1+step;IFx1>endwertTHEN IFmindestenseindefinierterwertTHENxundef:=xdef+step;ydef:=verfeinerterwert(fktterm,xdef,xundef);zeichneasymptote(xundef);END IF;LEAVEzeichnefunktionmitasymptotenroutineEND IF ELSExdef:=x1;IFxdef>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;LEAVEsuchschleifeEND IF END REP.verfeineregegebenenfalls:IF NOTwertdirektgefundenTHENxundef:=x1-step;y1:=verfeinerterwert(fktterm,x1,xundef);zeichneasymptote(xundef)END IF.zeichneerstenwert:mindestenseindefinierterwert:=TRUE;matmove(x1,y1);matdraw(x1,y1).suchezweitenwert:x2:=x1+step;replace(funktionsparameter,laufvariablenindex,x2);y2:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x1,x2);x1:=x2;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x2END IF.suchedrittenwert:x3:=x2+step;replace(funktionsparameter,laufvariablenindex,x3);y3:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x2,x3);x1:=x3;LEAVEuntersuchedreiaufeinanderfolgendewerteELSExdef:=x3END IF.untersuchediewerte:IFsign(y3-y2)<>sign(y2-y1)THENspezialroutineEND IF;befragetastatur;matdraw(x2,y2);IFx2>endwertTHEN LEAVEzeichnefunktionmitasymptotenroutineEND IF;x1:=x2;y1:=y2;x2:=x3;y2:=y3.spezialroutine:REAL VARx11:=x1,y11:=y1,x22:=x2,y22:=y2,x33:=x3,y33:=y3,xm,ym;INT VARcounter:=0;REPxm:=0.5*(x22+x33);replace(funktionsparameter,laufvariablenindex,xm);ym:=result(fktterm,funktionsparameter);IFiserrorTHENfehlerroutine(fktterm,x22,xm);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFcounter=20THENmatdraw(xm,ym);x1:=xm;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFidentischebildpunkteTHEN LEAVEspezialroutineELIFasymptotenbedingungTHENmatdraw(x22,y22);zeichneasymptote(xm);x1:=x33;LEAVEuntersuchedreiaufeinanderfolgendewerteELIFsign(y22-y11)=sign(ym-y22)THENx11:=x22;y11:=y22;x22:=xm;y22:=ymELSEx33:=xm;y33:=ymEND IF;counterINCR1END REP.asymptotenbedingung:IFautomatischeskalierungTHENabs(y22)>4.0*deltayCANDabs(y33)>4.0*deltayELSEabs(y22)>1000000.0CANDabs(y33)>1000000.0END IF.identischebildpunkte:INT VARp1:=ypixel(y11),p2:=ypixel(y22),p3:=ypixel(ym),p4:=ypixel(y33);IFiserrorTHENclearerror;FALSE ELSEp1=p2CANDp2=p3CANDp3=p4END IF.befragetastatur:IF NOTunterbrechenerlaubtTHEN LEAVEbefragetastaturEND IF;TEXT VARtaste:=incharety;IFtaste=zeichnungabbrechenTHENvorzeitigerabbruch:=TRUE;LEAVEzeichnefunktionmitasymptotenroutineELIFtaste=zeichnunganhaltenTHENunterbrechezeichnungEND IF END PROCzeichnefunktionmitasymptotenroutine;PROCfehlerroutine(TERM CONSTfktterm,REAL CONSTx1,x2):REAL VARxdef,ydef,xundef;clearerror;xdef:=x1;xundef:=x2;ydef:=verfeinerterwert(fktterm,xdef,xundef);matdraw(xdef,ydef);zeichneasymptote(xundef)END PROCfehlerroutine;REAL PROCverfeinerterwert(TERM CONSTfktterm,REAL VARxdef,xundef):REAL VARxneu,yneu;INT VARcounter:=0;WHILEweiteresuchesinnvollREPxneu:=0.5*(xundef+xdef);replace(funktionsparameter,laufvariablenindex,xneu);yneu:=result(fktterm,funktionsparameter);IFiserrorTHENclearerror;xundef:=xneuELSExdef:=xneuEND IF;counterINCR1END REP;replace(funktionsparameter,laufvariablenindex,xdef);result(fktterm,funktionsparameter).weiteresuchesinnvoll:counter<40CANDxpixel(xdef)<>xpixel(xundef)END PROCverfeinerterwert;LETdoppelpunkt=":",gleichzeichen="=",graphname="Graph ",ueberschrift1=" Dargestellte Graphen ",ueberschrift2=" Dargestellter Graph ",linie="--------------------------";TEXT VARprotokollname:=niltext;FILE VARf;WINDOW VARfenster:=window(54,8,26,14);INT VARgraphzaehler:=1;PROCinitprotokoll:forget(protokollname,quiet);protokollname:=scratchdateiname;f:=sequentialfile(output,protokollname);graphzaehler:=1END PROCinitprotokoll;PROCprotokollierekurve(ABBILDUNG CONSTabb,VECTOR CONSTbetraege,INT CONSTvarindex):IFlines(f)>=4000THEN LEAVEprotokollierekurveEND IF;protokollierefktstring;protokolliereparameter;setzezaehlerweiter. +protokollierefktstring:output(f);IFgraphzaehler>=2THENputline(f,graphname+text(graphzaehler)+doppelpunkt)END IF;putline(f,funktionsstring(abb));IFgraphzaehler=2THENmodify(f);toline(f,1);insertrecord(f);writerecord(f,graphname+"1")END IF.protokolliereparameter:INT VARi;LISTE CONSTvarliste:=abbildungsvariablen(abb);output(f);FORiFROM1UPTOlaenge(varliste)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(varliste,i),8)+gleichzeichen+compress(wandle(betraegeSUBi)))END IF END REP.setzezaehlerweiter:line(f);graphzaehlerINCR1END PROCprotokollierekurve;PROCergaenzetransformationen:INT VARi;ROW2TEXT CONSTkennung:=ROW2TEXT:("x","y");output(f);FORiFROM1UPTO2REP IFtransformiert(i)THENputline(f,kennung(i)+"-Transformation");putline(f,reststring)END IF;END REP.reststring:TEXT VARt:=funktionsstring(transformation(i));subtext(t,1+pos(t,":"))END PROCergaenzetransformationen;PROCentfernetransformationen:INT VARi,j;modify(f);FORiFROM1UPTO2REP IFtransformiert(i)THEN FORjFROM1UPTO2REPtoline(f,lines(f));deleterecord(f)END REP END IF END REP END PROCentfernetransformationen;PROCgibprotokollaus(TEXT CONSTfussnote,zeichen,TEXT VARausstieg):LETverfuegbarezeilenanzahl=14;INT VARspalte:=1,zeile:=1,letzteausgegebenezeile:=6,i;schreibeprotokollueberschrift;ergaenzetransformationen;IFlines(f)>verfuegbarezeilenanzahlTHENzeile:=lines(f)-verfuegbarezeilenanzahl+1END IF;zeichnefusszeile(fussnote);REPscroll(fenster,protokollname,1,1,1,zeile,spalte,zeichen,ausstieg);IFausstieg=druckenTHENdruckeprotokollEND IF UNTILausstieg<>druckenEND REP;letzteausgegebenezeileINCRleerzeilen;IFletzteausgegebenezeile>22THENletzteausgegebenezeile:=22END IF;entfernetransformationen;loeschegegebenenfallsbildschirmausgabe.schreibeprotokollueberschrift:cursor(54,6);out(ausgewaehlteueberschrift);cursor(54,7);out(linie).ausgewaehlteueberschrift:IFgraphzaehler=2THENueberschrift2ELSEueberschrift1END IF.leerzeilen:2+lines(f)-zeile.loeschegegebenenfallsbildschirmausgabe:IFpos(graphicausschalten,ausstieg)=0THEN FORiFROMletzteausgegebenezeileDOWNTO6REPcursor(54,i);out(kurzeleerzeile+blank)END REP END IF END PROCgibprotokollaus;PROCdruckeprotokoll:disablestop;IFprotokollname<>niltextTHENergaenzetransformationen;print(protokollname);entfernetransformationen;IF NOTiserrorTHEN LEAVEdruckeprotokollEND IF;behandlefehlerEND IF;out(bell)END PROCdruckeprotokoll;PROCloescheprotokoll:forget(protokollname,quiet);protokollname:=niltextEND PROCloescheprotokoll;REAL PROCkoordinatensystemxmin:xminEND PROCkoordinatensystemxmin;REAL PROCkoordinatensystemxmax:xmaxEND PROCkoordinatensystemxmax;REAL PROCkoordinatensystemymin:yminEND PROCkoordinatensystemymin;REAL PROCkoordinatensystemymax:ymaxEND PROCkoordinatensystemymax;BOOL PROCautomatischerskalierungsmodus:automatischeskalierungEND PROCautomatischerskalierungsmodus;PROCzeichneasymptote(REAL CONSTx):IFasymptotensichtbarTHEN REAL CONSTschritt:=deltay/20.0;REAL VARlauf:=ymax;WHILElauf>=yminREPmatmove(x,lauf);matdraw(x,lauf-0.5*schritt);lauf:=lauf-schrittEND REP END IF END PROCzeichneasymptote;PROCdefinitionsmenu(BOOL CONSTspezialverfahren,TEXT VARausstieg):INT VARi,eingabezeile:=16;koordinatensystem:=nilpicture;koordinatensysteminitialisiert:=FALSE;bauemenuauf;verarbeiteeingaben;IFausstieg=weiterarbeitTHENloeschemenuEND IF.bauemenuauf:INT VARausgabezeile:=erstemenuzeile;gesamtfenstereinstellen;FORiFROM1UPTOanzahldefinitionspunkteREPcursor(erstemenuspalte,ausgabezeile);IFzulaessigermenupunktTHENout(defpunkt(i));ausgabezeileINCR1END IF END REP;IFebene=1CORspezialverfahrenTHENeingabezeileDECR2END IF.zulaessigermenupunkt:IFi=4CORi=5THENebene=2CAND NOTspezialverfahrenELSE TRUE END IF.verarbeiteeingaben:TEXT VARch;BOOL VARfusszeileschreiben:=TRUE;REPclearbuffer;IFfusszeileschreibenTHENzeichnefusszeile(anwendungstext(100))END IF;fusszeileschreiben:=TRUE;inchar(ch);IFch=achsenbereichzeichenTHENlegedarstellungsbereichfestELIFch=achsenbezeichnungszeichenTHENlegeachsenbezeichnungfestELIFch=rasterzeichenTHENlegerasterungfestELIFch=linienmoduszeichenTHENlegelinienmodusfestELIFch +=punktanzahlzeichenTHENlegepunktanzahlfestELIF NOTspezialverfahrenCANDch=xtransformationszeichenCANDebene=2THENlegextransformationfestELIF NOTspezialverfahrenCANDch=ytransformationszeichenCANDebene=2THENlegeytransformationfestELIFch=escapezeichenTHENinchar(ausstieg)ELSEfusszeileschreiben:=FALSE END IF UNTILpos(standardoptionen,ausstieg)<>0END REP.legedarstellungsbereichfest:REAL VARx1:=xmin,x2:=xmax,y1:=ymin,y2:=ymax;automatischeskalierung:=graphyes(anwendungstext(103),eingabezeile);IF NOTautomatischeskalierungTHEN IFspezialverfahrenCORparameterdarstellungCORtransformiert(1)THENliesxminimumein;liesxmaximumein;xmin:=x1;xmax:=x2;IFspezialverfahrenTHENanfangswert:=xmin;endwert:=xmaxEND IF END IF;liesyminimumein;liesymaximumein;ymin:=y1;ymax:=y2;ursprungobligatorisch:=FALSE ELSEursprungobligatorisch:=graphyes(anwendungstext(109),eingabezeile)END IF.liesxminimumein:REPliespunktein(anwendungstext(104),anwendungstext(186),x1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx1>=-maximalerachsenbetragEND REP.liesxmaximumein:REPliespunktein(anwendungstext(105),niltext,x2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILx2>x1CANDx2<=maximalerachsenbetragEND REP.liesyminimumein:REPliespunktein(anwendungstext(107),anwendungstext(186),y1,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy1>=-maximalerachsenbetragEND REP.liesymaximumein:REPliespunktein(anwendungstext(108),niltext,y2,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVElegedarstellungsbereichfestEND IF UNTILy2>y1CANDy2<=maximalerachsenbetragEND REP.legeachsenbezeichnungfest:liesxbezeichnungein;liesybezeichnungein.liesxbezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(110));grapheditget(xachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegeachsenbezeichnungfestEND IF.liesybezeichnungein:cursor(erstemenuspalte,eingabezeile);out(anwendungstext(111));grapheditget(yachsenbezeichnung,punkteingabelaenge,standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHEN LEAVElegeachsenbezeichnungfestEND IF.legerasterungfest:graphgerastert:=graphyes(anwendungstext(112),eingabezeile).legelinienmodusfest:linienmodus:=graphyes(anwendungstext(113),eingabezeile).legepunktanzahlfest:TEXT VAReingabe;INT VARwert;cursor(erstemenuspalte,eingabezeile);out(anwendungstext(129));zeichnefusszeile(anwendungstext(186));REPcursor(68,eingabezeile);eingabe:=text(stuetzpunktanzahl);grapheditget(eingabe,punkteingabelaenge,standardoptionen,ausstieg);IFausstieg<>niltextTHENradiere(eingabezeile);LEAVElegepunktanzahlfestEND IF;wert:=int(eingabe);IFiserrorTHENbehandlefehlerELIFwert>=minimumstuetzpunkteTHENradiere(eingabezeile);stuetzpunktanzahl:=wert;LEAVElegepunktanzahlfestELSEbehandlefehlerEND IF END REP.legextransformationfest:BOOL VARachsewartransformiert:=transformiert(1);loescheggftransformation(1);transformiert(1):=graphyes(anwendungstext(131),eingabezeile);IF NOTtransformiert(1)THEN LEAVElegextransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("x-Transformation:");liestransformationsfunktionein(transformation(1),transformationsvorgabe(1),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(1):=FALSE END IF;IFtransformiert(1)CAND NOTachsewartransformiertCAND NOTautomatischeskalierungTHENliesextremafuerxachseeinEND IF.liesextremafuerxachseein:REAL VARxlow:=xmin,xhigh:=xmax;liesxminein;liesxmaxein;xmin:=xlow;xmax:=xhigh.liesxminein:REPliespunktein(anwendungstext(104),anwendungstext(186),xlow,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN LEAVEliesextremafuerxachseeinEND IF UNTILxlow>=-maximalerachsenbetragEND REP.liesxmaxein:REPliespunktein(anwendungstext(105),niltext,xhigh,standardoptionen,ausstieg,eingabezeile);IFausstieg<>niltextTHEN + LEAVEliesextremafuerxachseeinEND IF UNTILxhigh>xlowCANDxhigh<=maximalerachsenbetragEND REP.legeytransformationfest:loescheggftransformation(2);transformiert(2):=graphyes(anwendungstext(143),eingabezeile);IF NOTtransformiert(2)THEN LEAVElegeytransformationfestEND IF;cursor(erstemenuspalte,eingabezeile);out("y-Transformation:");liestransformationsfunktionein(transformation(2),transformationsvorgabe(2),standardoptionen,ausstieg);radiere(eingabezeile);IFausstieg<>niltextTHENradiere(eingabezeile+1);transformiert(2):=FALSE END IF.loeschemenu:INT VARende:=anzahldefinitionspunkte;IFebene=1THENendeDECR2END IF;radiere(erstemenuzeile,erstemenuzeile+ende-1)END PROCdefinitionsmenu;PROCliestransformationsfunktionein(ABBILDUNG VARtransfunktion,TEXT VARvorgabetext,TEXT CONSTerlaubteausstiegszeichen,TEXT VARausstieg):initialisiereeingaben;liesformelein.initialisiereeingaben:TEXT CONSTfname:=scratchfunctionname;TEXT VAReingabe:=vorgabetext;ausstieg:=niltext.liesformelein:LETeingabezeile=16;INT VARcursorx,cursory;zeichnefusszeile(anwendungstext(186));cursor(erstemenuspalte,eingabezeile+1);out("x,y -> ");getcursor(cursorx,cursory);REPcursor(cursorx,cursory);grapheditget(eingabe,15,erlaubteausstiegszeichen,ausstieg);IFausstieg<>niltextCANDpos(erlaubteausstiegszeichen,ausstieg)<>0THEN LEAVEliestransformationsfunktioneinEND IF;bildefunktionsstring;bewertefunktionsstringEND REP.bildefunktionsstring:TEXT VARsym,formel;BOOL VARxvorhanden:=FALSE,yvorhanden:=FALSE;scan(eingabe);nextsymbol(sym);WHILEsym<>niltextREPxvorhanden:=xvorhandenCORsym=xsymbol;yvorhanden:=yvorhandenCORsym=ysymbol;nextsymbol(sym)END REP;formel:=fname;IFxvorhandenCAND NOTyvorhandenTHENformelCAT":x->"ELSEformelCAT":x,y->"END IF;formelCATeingabe.bewertefunktionsstring:transfunktion:=neuefunktion(formel);IFiserrorTHENbehandlefehler;eingabe:=vorgabetextELSEtransfunktion:=aufloesung(transfunktion);loeschebenannteabbildung(fname);vorgabetext:=eingabe;radiere(cursory);LEAVEliesformeleinEND IF END PROCliestransformationsfunktionein;PROCbehandlefehler:clearerror;out(bell)END PROCbehandlefehler;PROCradiere(INT CONSTzeile):cursor(erstemenuspalte,zeile);out(kurzeleerzeile)END PROCradiere;PROCradiere(INT CONSTvon,bis):INT VARi;FORiFROMbisDOWNTOvonREPradiere(i)END REP END PROCradiere;BOOL PROCgraphyes(TEXT CONSTfrage,INT CONSTzeile):LETerlaubt="JYjyNn";INT VARi;cursor(erstemenuspalte,zeile);out(frage+" (j/n)?");zeichnefusszeile(anwendungstext(141));clearbuffer;REPi:=pos(erlaubt,incharety);UNTILi<>0END REP;radiere(zeile);i<5END PROCgraphyes;PROCliespunktein(TEXT CONSTcommando,fussnotiz,REAL VARxp,TEXT CONSTescausstieg,TEXT VARexit,INT CONSTzeile):TEXT VARt:=compress(wandle(xp))+kurzerstrich;initialisiereeingabe;gibein;loescheeingabefeld.initialisiereeingabe:gesamtfenstereinstellen;IFfussnotiz<>niltextTHENzeichnefusszeile(fussnotiz)END IF;cursor(erstemenuspalte,zeile);out(commando).gibein:REPgrapheditget(t,punkteingabelaenge,escausstieg,exit);IFexit<>niltextTHEN LEAVEgibeinEND IF;changeall(t,unterstrich,niltext);xp:=realzahl(t);IF NOTiserrorTHEN LEAVEgibeinEND IF;behandlefehler;tCATkurzerstrich;cursor(erstemenuspalte+length(commando),zeile)END REP.loescheeingabefeld:radiere(zeile)END PROCliespunktein;PROCsetzewertezurueck:ueberlagern:=FALSE;asymptotensichtbar:=TRUE;initkoordinatensystemEND PROCsetzewertezurueck;PROCunterbrechezeichnung:INT VARxkoord,ykoord;where(xkoord,ykoord);zeichnefusszeile(anwendungstext(77));clearbuffer;pause;zeichnefusszeile(anwendungstext(144));pen(1,1,1,aktuellerstift);move(xkoord,ykoord);graphfenstereinstellenEND PROCunterbrechezeichnung;REAL PROCxweltkoordinate(INT CONSTxpic):xmin+(xmax-xmin)*real(xpic-imin)/real(imax-imin)END PROCxweltkoordinate;REAL PROCyweltkoordinate(INT CONSTypic):ymin+(ymax-ymin)*real(ypic-jmin)/real(jmax-jmin)END PROCyweltkoordinate;PROCdruckegraph:vervollstaendigeaktuellezeichnung(xmin,xmax,ymin,ymax,graphbreite-2.0*graphrand,graphmaximum-graphminimum-2.0*graphrand);druckeaktuellezeichnungEND PROCdruckegraph;PROCzeichnetexte:zeichnefusszeile( +anwendungstext(210));cursor(54,10);out(anwendungstext(247));cursor(54,12);out(anwendungstext(248));cursor(54,15);out(anwendungstext(249));cursor(54,18);out(anwendungstext(250));cursor(54,19);out(anwendungstext(251));cursor(54,20);out(anwendungstext(252))END PROCzeichnetexte;PROCloeschetexte:cursor(54,20);out(loeschzeile);cursor(54,19);out(loeschzeile);cursor(54,18);out(loeschzeile);cursor(54,16);out(loeschzeile);cursor(54,15);out(loeschzeile);cursor(54,13);out(loeschzeile);cursor(54,12);out(loeschzeile);cursor(54,10);out(loeschzeile);END PROCloeschetexte;END PACKETgraphicverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hercules plot b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot new file mode 100644 index 0000000..e4607b3 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hercules plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETsimselherculesplotDEFINESbeginplot,endplot,clear,move,draw,stdhoehe,stdbreite,pen,plotend,zeichensatz,cursor,getcursor,out,terminalkorrekt,anpassungstyp,drawingarea,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=30.6383,vertfaktor=19.33333,bit14=16384,anzahlx=720,anzahly=348;INT VARxalt,yalt;ROW5INT VARzaehler:=ROW5INT:(0,0,0,0,0),i:=zaehler;INT VARlinientyp:=0,foreground:=0,background:=0;INT VARdummy;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=23.5;ycm:=18.0;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:0.72END PROCstdhoehe;REAL PROCstdbreite:0.29375END PROCstdbreite;PROCbeginplot:xalt:=0;yalt:=0;graphicon:=TRUE END PROCbeginplot;PROCendplot:END PROCendplot;PROCclear:control(-5,512,0,dummy);pen(0,1,0,1);move(0,0)END PROCclear;PROCplotend:control(-5,2,0,dummy);graphicon:=FALSE END PROCplotend;PROCpen(INT CONSTb,f,t,l):IF NOT(f=0)THENforeground:=1ELSEforeground:=0;FI;linientyp:=l;SELECTfOF CASE0:loeschstift;CASE1:sichtbarelinien;ENDSELECT.loeschstift:control(-9,0,0,dummy);control(-10,0,0,dummy).sichtbarelinien:SELECTlOF CASE0:CASE1:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)CASE2:control(-9,257,257,dummy);control(-10,257,257,dummy)CASE3:control(-9,17,17,dummy);control(-10,17,17,dummy)CASE4:control(-9,0,4369,dummy);control(-10,0,4369,dummy)CASE5:control(-9,256,4369,dummy);control(-10,256,4369,dummy)OTHERWISE:control(-9,4369,4369,dummy);control(-10,4369,4369,dummy)ENDSELECT.END PROCpen;PROCmove(INT CONSTx,y):xMOVEyEND PROCmove;PROCdraw(INT CONSTx,y):xDRAWyEND PROCdraw;ZEICHENSATZ VARzeichen;INT VARxfak,yfak;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichenELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=xalt,ypos:=yalt,x0:=xalt,y0:=yalt,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;x0MOVEy0.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+yELSExpos+xDRAWypos+yFI PER;xposINCRxstep;yposINCRystepEND PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT CONSTx,y):control(-7,x,347-y,dummy);xalt:=x;yalt:=yEND OP MOVE;OP DRAW(INT CONSTx,y):IFlinientyp>0THENcontrol(-11,foreground,zaehler(linientyp),i(linientyp));control(-6,xalt,347-yalt,dummy);control(-6,x,347-y,dummy);control(-11,foreground,zaehler(linientyp),i(linientyp));zaehler(linientyp):=((i(linientyp)-2)MOD16);FI;xalt:=x;yalt:=y;END OP DRAW;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE; +PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an ");putline("Bildschirmen mit HERCULES-Karte arbeiten.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"hercules"END PROCanpassungstyp;PROCwhere(INT VARx,y):x:=xalt;y:=yaltEND PROCwhere;INT PROCzeichenbreite:9END PROCzeichenbreite;INT PROCzeichenhoehe:14END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETsimselherculesplot;zeichensatz("ZEICHEN 9*14") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot new file mode 100644 index 0000000..d197007 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hp72xx plot @@ -0,0 +1,3 @@ +PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=37.0,ycm=27.7,papierx1=1200,papierx2=16000,papiery1=320,papiery2=11400,plotterunitspercm=100.0;TEXT CONSTschlange:=code(126),terminator:=code(125);INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);BOUND TEXT VARpicture;INT VARterminalchannel,plotterchannel:=5;LET POS=STRUCT(INTx,y);POS VARposition:=POS:(0,0);REAL VARbuchstabenhoehe:=1.108,buchstabenbreite:=0.4625;INT VARvelocity:=10;LETbackspace="�",alt="",stand="",pktklein="}",pktgross="{";PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):IFx>0ANDx<37THENvelocity:=xFI END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:TEXT VARhp:="";move(0,0);sendepicture;hpCAT("v"+sbn(0));hpCAT"�"+".)";toplotterchannel;out(hp);toterminalchannel;ENDPROCplotend;PROCclear:terminalchannel:=channel;forget("picture ds",quiet);picture:=new("picture ds");picture:="";TEXT VARhp;hp:="�.(";hpout(hp);hp:="�.M:";hpout(hp);hp:="�.I1000;17;13:";hpout(hp);hp:=schlange;hpCAT"W";hpCATplotput(papierx1,papiery1);hpCATplotput(papierx2,papiery2);hpCATterminator;hpout(hp);hp:=schlange;hpCAT"S";hpCATplotput(xunits,yunits);hpCATterminator;hpout(hp);hpout("vA");hpout(schlange+"Q");hpout(schlange+"V"+sbn(velocity)+terminator);hpout(schlange+"P"+plotput(0,3));END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linetypesenden;verifypen;switchtopen;.verifypen:INT VARpen;pen:=max(0,foreground);pen:=min(4,pen).switchtopen:TEXT VARhp;hp:=("v"+sbn(pen));hpout(hp).linetypesenden:hp:=schlange+"Q";hpCATlinetypecode;hpout(hp).linetypecode:TEXT VARtt;tt:="";IFlinetype=0THENtt:=terminator;ELIFlinetype=1THENtt:=terminator;ELIFlinetype=2THENtt:=sbn(32+0)+sbn(1)+mbn(15)+terminator;ELIFlinetype=3THENtt:=sbn(32+1)+sbn(2)+mbn(15)+terminator;ELIFlinetype=4THENtt:=sbn(32+1)+sbn(2)+mbn(30)+terminator;ELIFlinetype=5THENtt:=sbn(32+1)+sbn(2)+sbn(32+2)+sbn(2)+mbn(28)+terminator;ELSEtt:=terminatorFI;ttEND PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:="";hpCAT"p";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:="";hpCAT"q";hpCAT(plotput(xx,yy)+terminator);hpout(hp);position:=POS:(x,y)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp;INT VARspace:=int(width*plotterunitspercm),size:=int(height*plotterunitspercm*1.5);hp:=schlange+"%";hpCATplotput(space,size);hpout(hp);hp:=schlange+"'";ersetzeumlaute;hpCATumgesetztertext;hpCATcode(3);hpout(hp);move(position.x,position.y).ersetzeumlaute:TEXT VARumgesetztertext:="";INT VARi;FORiFROM1UPTO LENGTHrecordREPbildeneuentextPER.bildeneuentext:IF(pos("äöüÄÖÜß",(recordSUBi)))=0THENumgesetztertextCAT(recordSUBi)ELSEumgesetztertextCATersetzterumlautFI.ersetzterumlaut:IF"ä"=(recordSUBi)THENalt+"a"+pktklein+standELIF"ö"=(recordSUBi)THENalt+"o"+pktklein+standELIF"ü"=(recordSUBi)THENalt+"u"+pktklein+standELIF"Ä"=(recordSUBi)THENalt+"A"+pktgross+standELIF"Ö"=(recordSUBi)THENalt+"O"+pktgross+standELIF"Ü"=(recordSUBi)THENalt+"U"+pktgross+standELIF"ß"=(recordSUBi)THEN"P"+backspace+"p"ELSE""FI.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;TEXT PROCplotput(INT CONSTnx,ny):INT VARn,nx1,nx2,nx3,ny2,ny3,ny4,ny5,nxr,nyr;TEXT VARmbpformat;INT VARnp1,np2,np3,np4,np5;n:=nx;IF NOT(nx>ny)THENn:=ny;FI;IFn<256THEN IFn>31 +THENthreebyteformatELIFn>3THENtwobyteformatELSEonebyteformatFI;ELSE IFn<2048THENfourbyteformatELIFn<16384THENfivebyteformatELSEerrorstop("out of range: "+text(n));FI;FI;mbpformat.onebyteformat:np1:=ny+96+4*nx;mbpformat:=code(np1);.twobyteformat:nx1:=nxDIV2;nx2:=nx-2*nx1;np1:=nx1+96;np2:=ny+32*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;mbpformat:=code(np1)+code(np2);.threebyteformat:nx1:=nxDIV16;nx2:=nx-16*nx1;ny2:=nyDIV64;ny3:=ny-64*ny2;np1:=nx1+96;np2:=ny2+4*nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3;IF NOT(np3>31)THENnp3:=np3+64;FI;mbpformat:=code(np1)+code(np2)+code(np3);.fourbyteformat:nx1:=nxDIV128;nxr:=nx-128*nx1;nx2:=nxrDIV2;nx3:=nxr-2*nx2;ny3:=nyDIV64;ny4:=ny-64*ny3;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+32*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4);.fivebyteformat:nx1:=nxDIV1024;nxr:=nx-1024*nx1;nx2:=nxrDIV16;nx3:=nxr-16*nx2;ny3:=nyDIV4096;nyr:=ny-4096*ny3;ny4:=nyrDIV64;ny5:=nyr-64*ny4;np1:=96+nx1;np2:=nx2;IF NOT(np2>31)THENnp2:=np2+64;FI;np3:=ny3+4*nx3;IF NOT(np3>31)THENnp3:=np3+64;FI;np4:=ny4;IF NOT(np4>31)THENnp4:=np4+64;FI;np5:=ny5;IF NOT(np5>31)THENnp5:=np5+64;FI;mbpformat:=code(np1)+code(np2)+code(np3)+code(np4)+code(np5);.END PROCplotput;TEXT PROCmbn(INT CONSTnn):TEXT VARmbnformat;INT VARnp1,np2,np3,nn1,nn2,nn3,nr;IFnn<16THENonebyteformatELIFnn<1024THENtwobyteformatELIFnn<=32767THENthreebyteformatELSEerrorstop("out of range: "+text(nn));FI;mbnformat.onebyteformat:np1:=nn+96;mbnformat:=code(np1).twobyteformat:nn1:=nnDIV64;nn2:=nn-64*nn1;assemble2;mbnformat:=code(np1)+code(np2);.threebyteformat:nn1:=nnDIV4096;nr:=nn-nn1*4096;nn2:=nrDIV64;nn3:=nr-64*nn2;assemble1;assemble2;mbnformat:=code(np1)+code(np2)+code(np3);.assemble1:np3:=nn3;IF NOT(np3>31)THENnp3:=np3+64;FI;.assemble2:np2:=nn2;IF NOT(np2>31)THENnp2:=np2+64;FI;np1:=nn1+96;.END PROCmbn;TEXT PROCsbn(INT CONSTnn):INT VARnp;np:=nn;IF NOT(np>31)THENnp:=np+64;FI;code(np).END PROCsbn;PROChpout(TEXT CONSTplotcommand):pictureCATplotcommand;IFlength(picture)>800THENsendepictureFI END PROChpout;PROCsendepicture:getlen;toplotterchannel;out(text(picture,len));picture:="";getacknowledge.getlen:INT VARlen:=min(1000,length(picture)).getacknowledge:clearinputbuffer;out("�");readhandshakechar.clearinputbuffer:WHILEincharety<>""REP PER.readhandshakechar:TEXT VARchar:="";INT VARsession;WHILEchar<>"
"REPinchar(char)PER;toterminalchannel.END PROCsendepicture;PROCtoplotterchannel:continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot new file mode 100644 index 0000000..137f6c6 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.hp74xx plot @@ -0,0 +1,3 @@ +PACKEThpplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,geschwindigkeit,clear,pen,move,draw:LETxcm=40.19,ycm=27.46,plotterunitspercm=402.0,buffersize=1024;LETinitcmd="IN",textcmd="LB",separator=",",terminator=";",outputterminator="
",movecmd="PU",drawcmd="PD",pencmd="SP",charsizecmd="SI",linetypecmd="LT",plotabscmd="PA",askbuffersize="�.B",stdcharpre="�CS33;LB",stdcharpost="�SS;LB",etx="�";ROW22TEXT CONSTnichtasciizeichen:=ROW22TEXT:(stdcharpre+"["+stdcharpost,stdcharpre+"\"+stdcharpost,stdcharpre+"]"+stdcharpost,stdcharpre+"{"+stdcharpost,stdcharpre+"|"+stdcharpost,stdcharpre+"}"+stdcharpost,"k","-","#"," ",stdcharpre+"~"+stdcharpost,"�UC3,0,99,0,16,-99,0,-8,99,-3,0;LB","�UC3,0,99,0,16;LB","�UC3,0,99,0,8,-4,0;LB","�UC0,8,99,3,0,0,8;LB","�UC3,16,99,0,-8,3,0;LB","�UC3,0,99,0,8,3,0;LB","�UC0,8,99,6,0,-99,-3,0,99,0,8;LB","�UC0,8,99,6,0,-99,-3,0,99,0,-8;LB","�UC3,0,99,0,16,-99,0,-8,99,3,0;LB","�UC0,8,99,6,0;LB","�UC0,8,99,6,0,-99,-3,-8,99,0,16;LB");INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=5;INT VARfreebytes;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;PROCgeschwindigkeit(INT CONSTx):END PROCgeschwindigkeit;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoehe;END PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breite;END PROCstdbreite;PROCbeginplot:freebytes:=9;toplotterchannel;clear;TEXT VARhp:=pencmd;hpCAT"1";hpCATterminator;sendtoplotter(hp)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:clear;TEXT VARhp:=pencmd;hpCAT"0";hpCATterminator;hpCATinitcmd;hpCATterminator;sendtoplotter(hp);toterminalchannelENDPROCplotend;PROCclear:TEXT VARhp:=initcmd;hpCATterminator;hpCATplotabscmd;hpCATterminator;sendtoplotter(hp);END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):TEXT VARhp:=pencmd;IFforeground>6ORforeground<1THENhpCAT"1"ELSEhpCATtext(foreground)END IF;hpCATterminator;hpCATlinetypecmd;IFlinetype>1ANDlinetype<6THENhpCATtext(linetype-1);hpCATseparator;hpCAT"0.75";END IF;hpCATterminator;sendtoplotter(hp)END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).movetoxy:TEXT VARhp:=movecmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy).drawtoxy:TEXT VARhp:=drawcmd;hpCATtext(xx);hpCATseparator;hpCATtext(yy);hpCATterminator;sendtoplotter(hp)END PROCdraw;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):TEXT VARhp:=charsizecmd,konvertiertertext:="";konvertieretext;hpCATtext(width*0.66666667,8,4);hpCATseparator;hpCATtext(height*0.5,8,4);hpCATterminator;hpCATtextcmd;hpCATkonvertiertertext;hpCATetx;sendtoplotter(hp).konvertieretext:INT VARstelle;INT VARzeichen;FORstelleFROM1UPTO LENGTHrecordREPEATzeichen:=code(recordSUBstelle);IFzeichen=251THENkonvertiertertextCATnichtasciizeichen[11]ELIFzeichen>=185ANDzeichen<=188THENkonvertiertertextCATnichtasciizeichen[zeichen-173]ELIFzeichen>=200ANDzeichen<=206THENkonvertiertertextCATnichtasciizeichen[zeichen-184]ELIFzeichen>=214ANDzeichen<=223THENkonvertiertertextCATnichtasciizeichen[zeichen-213]ELSEkonvertiertertextCATcode(zeichen)END IF END REPEAT END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,stdhoehe,stdbreite)END PROCdraw;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:END PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;PROCsendtoplotter(TEXT CONSTstring):INT VARlaenge;laenge:= +LENGTHstring;IFfreebytes<buffersizeDIV2ORfreebytes-9<laengeTHENwarteaufgenugfreienpufferEND IF;out(string);freebytesDECRlaenge;checkforerror.warteaufgenugfreienpuffer:TEXT VARplotteroutput,char;INT VARdelay:=0;REPplotteroutput:="";pause(delay);REP UNTILincharety=""PER;out(askbuffersize);freebytesDECR3;REPinchar(char);plotteroutputCATcharUNTILchar=outputterminatorPER;plotteroutput:=subtext(plotteroutput,1,LENGTHplotteroutput-1);freebytes:=int(plotteroutput);delay:=1;UNTILfreebytes>buffersizeDIV2ANDfreebytes-9>=laengePER.checkforerror:out("OE;");TEXT VARc,t;inchar(c);inchar(t);IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)FI;out("�.E");inchar(c);inchar(t);IFt<>outputterminatorTHENcCATt;inchar(t);END IF;IFc<>"0"THENtoterminalchannel;errorstop("Fehler durch String: "+string+" Nr.: "+c)END IF;freebytesDECR6END PROCsendtoplotter;END PACKEThpplot;plotterkanal(7) + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren new file mode 100644 index 0000000..a8ae08d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.integrationsverfahren @@ -0,0 +1,7 @@ +PACKETintegrationsverfahrenDEFINESberechneintegral:LETweiter="w",naechste="q",menue="m",graphdefinieren="e",protokoll="p",escdrucken="d",drucken="D",info="?",abbruch="!",blank=" ",del="�",bell="�",esc="�",folgenvariable="n",folgentext=" a(n)",defaultfolge="n",varstellen=8,zahlstellen=12,maxiter=4048,rowlaenge=4049,rombergmaxspalten=13,anzahlnumerischeverfahren=4,anzahlverfahreninsgesamt=6,maxueberschriftlaenge=17,maxfehlermeldunglaenge=46,rechteckverfahren=1,trapezverfahren=2,simpsonverfahren=3,rombergverfahren=4;ROW4TEXT CONSTfehlermeldung:=ROW4TEXT:(anwendungstext(51),anwendungstext(52),"-","-");ROWanzahlnumerischeverfahrenTEXT CONSTueberschrift:=ROWanzahlnumerischeverfahrenTEXT:(anwendungstext(220),anwendungstext(221),anwendungstext(222),anwendungstext(223));ROW2TEXT CONSTunterstrich:=ROW2TEXT:("-----------------","---------------");ROWanzahlverfahreninsgesamtTEXT CONSTverfahrensname:=ROWanzahlverfahreninsgesamtTEXT:(anwendungstext(235),anwendungstext(236),anwendungstext(237),anwendungstext(238),anwendungstext(239),anwendungstext(240));ROW3TEXT CONSTrechteckstuetztext:=ROW3TEXT:(anwendungstext(89),anwendungstext(90),anwendungstext(91));ROWrombergmaxspaltenROWrombergmaxspaltenREAL VARmatrix;THESAURUS VARverfuegbareverfahren;INT VARzaehler,spaltenbreite,nrofinitializedpoints:=0;TEXT VARintegrationsfehler:="",tabellenname;BOUND ROWrowlaengeREAL VARstuetzpunkte;DATASPACE VARds;BOOL VARfirsttime:=TRUE;REAL VARschrittweite;TEXT CONSTloeschzeile:=23*" ";verfuegbareverfahren:=emptythesaurus;FORzaehlerFROM1UPTOanzahlverfahreninsgesamtREPinsert(verfuegbareverfahren,verfahrensname[zaehler])PER PROCinitstuetzpunkte(ABBILDUNG CONSTabb,REAL CONSTuntergrenze,obergrenze,INT CONSTanzahlstuetzpunkte,varnr,VECTOR CONSTparameter,BOOL VARfehler):INT VARi;TERM CONSTt:=AUSDRUCKlistenanfang(abbildungsterme(abb));schrittweite:=(obergrenze-untergrenze)/real(anzahlstuetzpunkte-1);VECTOR VARvec:=parameter;nrofinitializedpoints:=0;forget(ds);ds:=nilspace;stuetzpunkte:=ds;FORiFROM1UPTOanzahlstuetzpunkteREPreplace(vec,varnr,untergrenze+real(i-1)*schrittweite);stuetzpunkte[i]:=result(t,vec);IFiserrorTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[1];LEAVEinitstuetzpunkteEND IF END REP;nrofinitializedpoints:=anzahlstuetzpunkteEND PROCinitstuetzpunkte;BOOL PROCispoweroftwo(INT VARi):INT VARdoppel:=1,log:=0;REPEAT IFdoppel=iTHENi:=log;LEAVEispoweroftwoWITH TRUE END IF;doppelINCRdoppel;logINCR1UNTILdoppel>iCORiserrorPER;clearerror;FALSE END PROCispoweroftwo;REAL PROCtrapezintegration:INT VARi;REAL VARsumme:=0.5*(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints]);FORiFROM2UPTOnrofinitializedpoints-1REPsumme:=summe+stuetzpunkte[i]END REPEAT;summe*schrittweiteEND PROCtrapezintegration;LETlinks=1,mitte=2,rechts=3;INT VARrechteckstuetze:=links;REAL PROCrechtecksintegration:REAL VARsumme;INT VARi;IFrechteckstuetze<rechtsTHENsumme:=stuetzpunkte[1]ELSEsumme:=stuetzpunkte[nrofinitializedpoints]END IF;FORiFROM2UPTOnrofinitializedpoints-1REPsumme:=summe+stuetzpunkte[i]END REPEAT;summe*schrittweiteEND PROCrechtecksintegration;REAL PROCsimpsonintegration:IF(nrofinitializedpointsAND1)=0THENintegrationsfehler:=fehlermeldung[4];LEAVEsimpsonintegrationWITH0.0END IF;REAL VARsumme:=stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints];INT VARi:=2;REP IFiMOD2=0THENsumme:=summe+4.0*stuetzpunkte[i]ELSEsumme:=summe+2.0*stuetzpunkte[i]END IF;iINCR1UNTILi>nrofinitializedpoints-1PER;summe*schrittweite/3.0END PROCsimpsonintegration;REAL PROCrombergintegration:INT VARintervallgroesse,anzahlschachtelungen,i,j;REAL VARnenner:=4.0;berechneanzahlderschachtelungen;berechneintegrale;erzeugerombergschema;ergebnis.berechneanzahlderschachtelungen:anzahlschachtelungen:=nrofinitializedpoints-1;IF NOTispoweroftwo(anzahlschachtelungen)THENintegrationsfehler:=fehlermeldung[3];LEAVErombergintegrationWITH0.0END IF.berechneintegrale:intervallgroesse:=1;FORiFROManzahlschachtelungenDOWNTO0REPmatrix[1][i+1]:=trapezintegralspezial;intervallgroesseINCRintervallgroesseEND REP. +trapezintegralspezial:REAL VARsumme:=(stuetzpunkte[1]+stuetzpunkte[nrofinitializedpoints])/2.0;j:=1+intervallgroesse;WHILEj<nrofinitializedpointsREPsumme:=summe+stuetzpunkte[j];jINCRintervallgroessePER;summe*schrittweite*real(intervallgroesse).erzeugerombergschema:FORjFROM1UPTOanzahlschachtelungenREP FORiFROM1UPTOanzahlschachtelungen-j+1REPmatrix[j+1][i]:=matrix[j][i+1]+(matrix[j][i+1]-matrix[j][i])/(nenner-1.0);PER;nenner:=nenner*4.0PER.ergebnis:matrix[anzahlschachtelungen+1][1]END PROCrombergintegration;PROCerzeugenaeherungsfolge(REAL CONSTuntergrenzefkt,obergrenzefkt,INT CONSTuntergrenzefolge,obergrenzefolge,ABBILDUNG CONSTfolge,funktion,INT CONSTvarnr,VECTOR CONSTparameter,ROWanzahlnumerischeverfahrenINT CONSTreihenfolge,INT VARerstersatz,erstespalte):BOOL VARfehler;INT VARntesfolgenglied,i,j;ROWanzahlnumerischeverfahrenTEXT VARnaeherungen;VECTOR VARfolgenvector:=nilvector;TERM VARfolgenterm:=AUSDRUCKlistenanfang(abbildungsterme(folge));BOOL VARmatrixzeigen:=nurrombergverfahrenausgewaehltCANDnureinfolgengliedCANDfolgengliedistzweierpotenz;FILE VARf:=sequentialfile(output,tabellenname);berechnespaltenbreite;schreibetabellenkopf;berechnewerteundschreibeindatei;setzekoordinaten.nurrombergverfahrenausgewaehlt:reihenfolge[1]=rombergverfahrenANDreihenfolge[2]=0.nureinfolgenglied:untergrenzefolge=obergrenzefolge.folgengliedistzweierpotenz:i:=untergrenzefolge;ermittlefolgenglied;INT VARschachtelungen:=ntesfolgenglied;ispoweroftwo(schachtelungen).berechnespaltenbreite:IF NOTmatrixzeigenTHENspaltenbreite:=max(gesamtstellen(ebene),maxueberschriftlaenge)+2;IFlaenge(abbildungsvariablen(funktion))<>1THENspaltenbreite:=max(spaltenbreite,varstellen+zahlstellen+2)END IF;ELSEspaltenbreite:=gesamtstellen(ebene)+1END IF.schreibetabellenkopf:TEXT VARkopfzeile,trennlinie;IFlength(parameter)<=10THENtrageparametereinEND IF;IFmatrixzeigenTHENkopfzeile:=ueberschrift[rombergverfahren]+" "+folgenvariable+" = "+text(untergrenzefolge)+" "+folgentext+" = "+text(ntesfolgenglied);trennlinie:=(schachtelungen+1)*spaltenbreite*waagerecht;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))ELSEkopfzeile:=" "+folgenvariable+" "+senkrecht;kopfzeileCATfolgentext;trennlinie:=5*waagerecht+kreuz+5*waagerecht;FORiFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[i]<>0THENkopfzeileCATsenkrecht+center(spaltenbreite,ueberschrift[reihenfolge[i]]);trennlinieCATkreuz+spaltenbreite*waagerechtEND IF PER;maxlinelength(f,max(LENGTHtrennlinie+1,maxfehlermeldunglaenge+16))END IF;write(f,kopfzeile);line(f);write(f,trennlinie);line(f).trageparameterein:FORiFROM1UPTO LENGTHparameterREP IFi<>varnrTHENwrite(f,text(NAMEauswahl(abbildungsvariablen(funktion),i),varstellen)+"="+(12-varstellen)*blank+wandle(parameterSUBi));line(f)END IF END REPEAT.berechnewerteundschreibeindatei:cursor(36,24);FORiFROMuntergrenzefolgeUPTOobergrenzefolgeREPcout(i);ermittlefolgenglied;IF NOTfehlerTHENinitstuetzpunkte(funktion,untergrenzefkt,obergrenzefkt,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEberechnewerteundschreibeindateiELIFfehlerTHENschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF ELSEschreibefehlermeldungindatei;LEAVEberechnewerteundschreibeindateiEND IF;ermittlenaeherungenEND REP.ermittlefolgenglied:replace(folgenvector,1,real(i));ntesfolgenglied:=int(result(folgenterm,folgenvector));IFiserrorORntesfolgenglied<=0ORntesfolgenglied>maxiterTHENclearerror;fehler:=TRUE;integrationsfehler:=fehlermeldung[2]ELSEfehler:=FALSE END IF.ermittlenaeherungen:FORjFROM1UPTOanzahlnumerischeverfahrenREPnaeherungen[j]:=itesangekreuztesverfahrenPER;IFmatrixzeigenTHENschreiberombergmatrixELSEschreibeergebnisseindateiEND IF.itesangekreuztesverfahren:SELECTreihenfolge[j]OF CASErechteckverfahren:sonderbehandlungrechteckverfahrenCASEtrapezverfahren:berechneundueberpruefefehler(REAL PROCtrapezintegration)CASEsimpsonverfahren:berechneundueberpruefefehler(REAL PROCsimpsonintegration)CASErombergverfahren:berechneundueberpruefefehler(REAL PROC +rombergintegration)OTHERWISE""END SELECT.sonderbehandlungrechteckverfahren:IFrechteckstuetze<>mitteTHENberechneundueberpruefefehler(REAL PROCrechtecksintegration)ELSE DATASPACE VARstdstuetzpunkte:=ds;REAL VARhalbesintervall:=(obergrenzefkt-untergrenzefkt)/real(ntesfolgenglied)/2.0;TEXT VARzwischenergebnis;initstuetzpunkte(funktion,untergrenzefkt+halbesintervall,obergrenzefkt+halbesintervall,ntesfolgenglied+1,varnr,parameter,fehler);IFincharety=abbruchTHEN LEAVEermittlenaeherungenEND IF;IFfehlerTHENintegrationsfehlerELSEzwischenergebnis:=berechneundueberpruefefehler(REAL PROCrechtecksintegration);forget(ds);ds:=stdstuetzpunkte;forget(stdstuetzpunkte);zwischenergebnisEND IF END IF.schreibefehlermeldungindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));write(f,senkrecht+blank+integrationsfehler);line(f);fehler:=FALSE.schreibeergebnisseindatei:put(f,text(i,4)+blank+senkrecht+text(ntesfolgenglied,4));FORjFROM1UPTOanzahlnumerischeverfahrenREP IFreihenfolge[j]<>0THENwrite(f,senkrecht+text(naeherungen[j],spaltenbreite))END IF PER;line(f).schreiberombergmatrix:INT VARzeile,spalte;FORzeileFROM1UPTOschachtelungen+1REP FORspalteFROM1UPTOzeileREPput(f,wandle(matrix[spalte][zeile+1-spalte]))PER;line(f)PER.setzekoordinaten:IFmatrixzeigenTHENerstespalte:=1ELSEerstespalte:=13;END IF;erstersatz:=2+LENGTHparameterEND PROCerzeugenaeherungsfolge;TEXT PROCberechneundueberpruefefehler(REAL PROCverfahren):REAL VARergebnis;TEXT VARzeile;integrationsfehler:="";ergebnis:=verfahren;IFintegrationsfehler=""THENzeile:=wandle(ergebnis)ELSEzeile:=center(spaltenbreite,integrationsfehler)END IF;zeileEND PROCberechneundueberpruefefehler;PROCberechneintegral(ABBILDUNG CONSTeingegebenefunktion):ABBILDUNG VARabb:=eingegebenefunktion,folge;VECTOR VARvec:=vector(laenge(abbildungsvariablen(abb)));TERM VARvarterm;TAG VARt:=formular(20);ROW100TEXT VARtexte;INT VARfeldnummer,varindex,lowerfolge,upperfolge,nrgraphverfahren,i,zeile,spalte;REAL VARlowerfkt,upperfkt;TEXT VARfolgenname,fehlermeldung;BOOL VARnumerisch;ROWanzahlnumerischeverfahrenINT VARreihenfolge;WINDOW VARw:=window(2,7,77,16);FORiFROM1UPTOlength(vec)REPreplace(vec,i,0.0)END REP;disablestop;setzedefaultgraph;firsttime:=TRUE;ueberpruefeeingangsfunktion;schreibearbeitsfunktion(eingegebenefunktion);setzedefaultwerteinmaske;REPfootnote(anwendungstext(115));bearbeiteeinefunktionUNTILausstiegszeichen=naechsteORausstiegszeichen=menueEND REPEAT;forget(ds);verfahrensende(ausstiegszeichen).ueberpruefeeingangsfunktion:IFlaenge(abbildungsterme(abb))<>1THENverfahrensende(naechste);gibmeldung(anwendungstext(155));LEAVEberechneintegralELIFkomplexefunktion(abb)THENabb:=aufloesung(abb)END IF.setzedefaultwerteinmaske:BOOL VARfeld2sperren:=ebene=1CORlaenge(abbildungsvariablen(abb))=1;INT VARersteseingabefeld;feldnummer:=2;IFfeld2sperrenTHENsetfieldinfos(t,2,TRUE,TRUE,FALSE);feldnummer:=3END IF;texte[2]:=NAMElistenanfang(abbildungsvariablen(abb));texte[3]:="0.0";texte[4]:="1.0";texte[5]:=defaultfolge;texte[6]:="1";texte[7]:="10";ersteseingabefeld:=feldnummer.bearbeiteeinefunktion:strich(6);show(t);REPergaenzeunterstriche;putget(t,texte,feldnummer,ausstiegszeichen);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstiegszeichen:=naechsteEND IF UNTILpos(weiter+naechste+menue+info,ausstiegszeichen)>0END REPEAT;ueberpruefeverlasszeichen.ergaenzeunterstriche:FORiFROMersteseingabefeldUPTO7REPtexte[i]CAT((zahlstellen-length(texte[i]))*"_")PER.ueberpruefeverlasszeichen:IFausstiegszeichen=naechsteORausstiegszeichen=menueTHENverfahrensende(ausstiegszeichen);LEAVEberechneintegralELIFausstiegszeichen=infoTHEN IFfeld2sperrenTHENgibinfofensteraus(w,18)ELSEgibinfofensteraus(w,19)END IF ELSEueberpruefeargumente;lasseggfparametereingeben;lasseverfahrenauswaehlen;berechneundzeigeergebnis;loeschetemporaerevariablenEND IF.ueberpruefeargumente:FORiFROM2UPTO7REPchangeall(texte[i],"_","")PER;ueberpruefevariable;ueberpruefefunktionsgrenzen;ueberpruefefolge;ueberpruefefolgengrenzen.ueberpruefevariable:varterm:=listenposition( +abbildungsvariablen(abb),texte[2]);IFvarterm=nilTHENgibmeldung(anwendungstext(147)+compress(texte[2])+anwendungstext(148));feldnummer:=2;zurueckzumaskeELSEvarindex:=PLATZvartermEND IF.ueberpruefefunktionsgrenzen:lowerfkt:=realzahl(texte[3]);IFiserrorTHENclearerror;feldnummer:=3;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfkt:=realzahl(texte[4]);IFiserrorTHENclearerror;feldnummer:=4;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfkt>upperfktTHENfeldnummer:=4;gibmeldung(anwendungstext(160));zurueckzumaskeEND IF.ueberpruefefolge:folgenname:=scratchfunctionname;folge:=neuefunktion(folgenname+":n->"+texte[5]);IFkomplexefunktion(folge)THEN ABBILDUNG VARzwischen:=folge;folge:=aufloesung(folge);loescheabbildung(zwischen)END IF;IFiserrorTHENclearerror;gibmeldung(errormessage);feldnummer:=5;zurueckzumaskeELIFlaenge(abbildungsvariablen(folge))<>1THENgibmeldung(anwendungstext(151));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeELIFlaenge(abbildungsterme(folge))<>1THENgibmeldung(anwendungstext(162));loescheabbildung(folge);feldnummer:=4;zurueckzumaskeEND IF.ueberpruefefolgengrenzen:lowerfolge:=int(realzahl(texte[6]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=6;gibmeldung(anwendungstext(149));zurueckzumaskeEND IF;upperfolge:=int(realzahl(texte[7]));IFiserrorTHENclearerror;loescheabbildung(folge);feldnummer:=7;gibmeldung(anwendungstext(150));zurueckzumaskeEND IF;IFlowerfolge>upperfolgeTHENfeldnummer:=6;gibmeldung(anwendungstext(161));loescheabbildung(folge);zurueckzumaskeEND IF.zurueckzumaske:ausstiegszeichen:=weiter;LEAVEbearbeiteeinefunktion.lasseggfparametereingeben:IF LENGTHvec<>1THENcursor(1,5);out(anwendungstext(74));REPcursor(12,5);belegeparameter(vec,varindex,abbildungsvariablen(abb),menue+weiter+naechste+info,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfofensteraus(w,8);strich(6);footnote(anwendungstext(115))ELIFausstiegszeichen=menueORausstiegszeichen=naechsteTHENverfahrensende(ausstiegszeichen);loescheabbildung(folge);LEAVEberechneintegralEND IF UNTILausstiegszeichen=weiterEND REPEAT;cursor(1,5);out(del)END IF.lasseverfahrenauswaehlen:THESAURUS VARth:=emptythesaurus;REPth:=some(24,7,56,15,verfuegbareverfahren,anwendungstext(173),anwendungstext(182));IFlsexitkey=menueTHENverfahrensende(menue);loescheabbildung(folge);LEAVEberechneintegralEND IF;IFauswahlgueltig(th,reihenfolge,nrgraphverfahren,fehlermeldung,numerisch)THEN LEAVElasseverfahrenauswaehlenEND IF;gibmeldung(fehlermeldung)END REP.berechneundzeigeergebnis:INT VARerstersatz,erstespalte;TEXT VARausstiegszeichen;IFrechteckverfahrenausgewaehltTHENsonderfunktionenrechteckverfahren;IFrechteckstuetze=0THENloescheabbildung(folge);verfahrensende(menue);LEAVEberechneintegralEND IF END IF;IFnumerischTHENfootnote(anwendungstext(117));tabellenname:=scratchdateiname;erzeugenaeherungsfolge(lowerfkt,upperfkt,lowerfolge,upperfolge,folge,abb,varindex,vec,reihenfolge,erstersatz,erstespalte);zeile:=erstersatz;spalte:=erstespalte;outframe(w);REPfootnote(anwendungstext(115));scroll(w,tabellenname,spalte,zeile,spaltenbreite+1,erstersatz,erstespalte,weiter+naechste+menue+info+escdrucken,ausstiegszeichen);IFausstiegszeichen=infoTHENgibinfoaus(9)ELIFausstiegszeichen=escdruckenTHENdruckedietabelleEND IF UNTILausstiegszeichen<>infoCANDausstiegszeichen<>escdruckenEND REPEAT;forget(tabellenname,quiet)ELSEgraphischeveranschaulichung(nrgraphverfahren,texte,eingegebenefunktion,abb,varindex,lowerfkt,upperfkt,vec,folge,lowerfolge,upperfolge,ausstiegszeichen)END IF.druckedietabelle:aufbereitetdrucken(tabellenname,funktionsstring(eingegebenefunktion),spalte,zeile,spaltenbreite+1);outframe(w).loeschetemporaerevariablen:loescheabbildung(folge);feldnummer:=ersteseingabefeld.rechteckverfahrenausgewaehlt:nrgraphverfahren=rechteckverfahrenOR(thCONTAINSverfahrensname[1])END PROCberechneintegral;PROCgibinfoaus(INT CONSTnr):show(formular(nr));warteEND PROCgibinfoaus;BOOL PROCauswahlgueltig(THESAURUS CONSTauswahl,ROWanzahlnumerischeverfahrenINT VARreihenfolge,INT + VARnrgraphverfahren,TEXT VARevtlfehlertext,BOOL VARnumerisch):INT VARindex:=0,index2,naechstereintraginreihung:=1,numerischeverfahrenausgewaehlt:=0,graphischeverfahrenausgewaehlt:=0;TEXT VAReintrag;bildelisten;listensindkorrekt.bildelisten:nrgraphverfahren:=0;get(auswahl,eintrag,index);WHILEeintrag<>""REPindex2:=link(verfuegbareverfahren,eintrag);IFindex2=2CORindex2=4THENgraphischeverfahrenausgewaehltINCR1;nrgraphverfahren:=index2DIV2ELSEnumerischeverfahrenausgewaehltINCR1;reihenfolge[naechstereintraginreihung]:=(index2+2)DIV2;naechstereintraginreihungINCR1END IF;get(auswahl,eintrag,index)END REPEAT;FORindexFROMnaechstereintraginreihungUPTOanzahlnumerischeverfahrenREPreihenfolge[index]:=0END REPEAT.listensindkorrekt:numerisch:=numerischeverfahrenausgewaehlt<>0;IFnumerischTHEN IFgraphischeverfahrenausgewaehlt<>0THENevtlfehlertext:=anwendungstext(164);FALSE ELSE TRUE END IF ELSE IFgraphischeverfahrenausgewaehlt=1THEN TRUE ELSE IFgraphischeverfahrenausgewaehlt=0THENevtlfehlertext:=anwendungstext(167)ELSEevtlfehlertext:=anwendungstext(165)END IF;FALSE END IF END IF END PROCauswahlgueltig;PROCgraphischeveranschaulichung(INT CONSTnr,ROW100TEXT VARtexte,ABBILDUNG CONSToriginal,fkt,INT CONSTvarind,REAL CONSTlinkegrenze,rechtegrenze,VECTOR CONSTparameterwerte,ABBILDUNG CONSTfolge,INT CONSTfolgenanfang,folgenende,TEXT VARausstiegszeichen):TEXT VARmessage;BOOL VARzeichnungliegtvor:=FALSE;bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(original,"Integral");cursor(2,3);out(funktionszeile);cursor(2,4);out(folgenzeile);schreibebegleittext(nr).funktionszeile:"Variable "+texte[2]+" von "+texte[3]+" bis "+texte[4].folgenzeile:"Anzahl der Intervalle a(n) = "+texte[5]+" für n von "+texte[6]+" bis "+texte[7].fuehregraphischeveranschaulichungdurch:BOOL VARaufbauen;initialisierevariablen;REPaufbauen:=TRUE;gibdasbildderfunktionaus;berechnedasfolgenglied;berechnestuetzpunkte;gibinfos;zeichnevierecke;verarbeiteeingabezeichen;zeichnefusszeile("");IF NOTaufbauenTHENzeichnevierecke;deletelastpictureEND IF PER.initialisierevariablen:BOOL VARfehler:=FALSE;INT VARaktuellesfolgenglied:=folgenanfang,folgenresultat,offset1,offset2;VECTOR VARfolgenvector:=vector(1);TERM VARfolgenterm:=AUSDRUCKlistenanfang(abbildungsterme(folge));REAL VARrand:=0.1*(rechtegrenze-linkegrenze),linkerrand:=linkegrenze-rand,rechterrand:=rechtegrenze+rand;IFnr=2THENoffset1:=1;offset2:=2ELIFrechteckstuetze<rechtsTHENoffset1:=1;offset2:=1ELSEoffset1:=2;offset2:=2END IF.gibdasbildderfunktionaus:IFfirsttimeTHENberechnekoordinatensystem(fkt,linkerrand,rechterrand,parameterwerte,varind);firsttime:=FALSE END IF;IFzeichnungliegtvorTHENplotscreenmemoryELSEzeichnekoordinatensystem;normalgraphzeichnen(fkt,parameterwerte,varind);graphfenstereinstellen;pen(1,1,1,sekantenstift);newpicture(sekantenstift);zeichneasymptote(linkegrenze);zeichneasymptote(rechtegrenze);zeichnungliegtvor:=TRUE END IF.berechnedasfolgenglied:replace(folgenvector,1,real(aktuellesfolgenglied));folgenresultat:=int(round(result(folgenterm,folgenvector),0));IFiserrorCORfolgenresultat<=0CORfolgenresultat>maxiterTHENclearerror;fehler:=TRUE;message:=anwendungstext(212);LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechnestuetzpunkte:IFnr=1CANDrechteckstuetze=mitteTHEN REAL VARhalbesintervall:=(rechtegrenze-linkegrenze)/real(folgenresultat*2);initstuetzpunkte(fkt,linkegrenze+halbesintervall,rechtegrenze+halbesintervall,folgenresultat+1,varind,parameterwerte,fehler)ELSEinitstuetzpunkte(fkt,linkegrenze,rechtegrenze,folgenresultat+1,varind,parameterwerte,fehler)END IF;IFfehlerTHENmessage:=anwendungstext(213);LEAVEfuehregraphischeveranschaulichungdurchEND IF.gibinfos:cursor(56,11);out(text(folgenresultat,4));cursor(56,14);out(text(compress(wandle(wert)),23)).wert:IFnr=1THENrechtecksintegrationELSEtrapezintegrationEND IF.zeichnevierecke:INT VARz;REAL VARxwert1:=linkegrenze, +streifenbreite:=(rechtegrenze-linkegrenze)/real(folgenresultat);IFaufbauenTHENpen(1,1,1,lotstift)ELSEpen(0,0,0,1)END IF;newpicture(lotstift);FORzFROM0UPTOfolgenresultat-1REPmatmove(xwert1,0.0);matdraw(xwert1,stuetzpunkte[z+offset1]);xwert1:=linkegrenze+real(z+1)*streifenbreite;matdraw(xwert1,stuetzpunkte[z+offset2]);matdraw(xwert1,0.0)END REP;IF NOTaufbauenTHENdeletelastpictureEND IF.verarbeiteeingabezeichen:TEXT VARch;zeichnefusszeile(anwendungstext(206));REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstiegszeichen);SELECTpos(graphdefinieren+weiter+naechste+menue,ausstiegszeichen)OF CASE1:definierebereich;LEAVEverarbeiteeingabezeichenCASE2,3,4:LEAVEfuehregraphischeveranschaulichungdurchOTHERWISEout(bell)END SELECT ELIFmehrerefolgengliederCANDch="+"CANDaktuellesfolgenglied<folgenendeTHENaktuellesfolgengliedINCR1;aufbauen:=FALSE;LEAVEverarbeiteeingabezeichenELIFmehrerefolgengliederCANDch="-"CANDaktuellesfolgenglied>folgenanfangTHENaktuellesfolgengliedDECR1;aufbauen:=FALSE;LEAVEverarbeiteeingabezeichenELIFch=druckenTHENdruckegraphELIFch=protokollTHENzeigeprotokolldesgraphenELSEout(bell)END IF END REP.zeigeprotokolldesgraphen:gibprotokollaus(anwendungstext(99),"dwqm",ausstiegszeichen);IFausstiegszeichen=weiterTHENschreibebegleittext(nr);gibinfos;zeichnefusszeile(anwendungstext(206))ELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.mehrerefolgenglieder:folgenanfang<>folgenende.definierebereich:cursor(56,19);out(loeschzeile);cursor(56,18);out(loeschzeile);cursor(56,17);out(loeschzeile);cursor(56,16);out(loeschzeile);cursor(56,14);out(loeschzeile);cursor(56,13);out(loeschzeile);graphfenstereinstellen;loeschezeichnung;definitionsmenu(TRUE,ausstiegszeichen);IFausstiegszeichen<>weiterTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;initkoordinatensystem;zeichnungliegtvor:=FALSE;firsttime:=TRUE;linkerrand:=koordinatensystemxmin;rechterrand:=koordinatensystemxmax;schreibebegleittext(nr).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(message);fehler:=FALSE END IF;beendegraphikarbeit;endplot;plotend;IFausstiegszeichen=weiterTHENschreibestatuszeile("Integral");schreibearbeitsfunktion(original);IFfehlerTHENgibmeldung(message)END IF END IF END PROCgraphischeveranschaulichung;PROCschreibebegleittext(INT CONSTnr):cursor(56,7);out(ueberschrift[nr]);cursor(56,8);out(unterstrich[nr]);cursor(56,10);out(anwendungstext(241));cursor(56,13);out(anwendungstext(242));cursor(56,16);out(anwendungstext(243));cursor(56,17);out(anwendungstext(244));cursor(56,18);out(anwendungstext(245));cursor(56,19);out(anwendungstext(246))END PROCschreibebegleittext;PROCsonderfunktionenrechteckverfahren:THESAURUS VARth:=emptythesaurus;INT VARi;FORiFROM1UPTO3REPinsert(th,rechteckstuetztext[i])PER;rechteckstuetze:=0;REPrechteckstuetze:=link(th,one(24,7,56,15,th,anwendungstext(79),anwendungstext(80)));IFrechteckstuetze=0ANDlsexitkey<>menueTHENgibmeldung(anwendungstext(167))END IF UNTILrechteckstuetze<>0ORlsexitkey=menuePER END PROCsonderfunktionenrechteckverfahren;END PACKETintegrationsverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren new file mode 100644 index 0000000..5c6c90e --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.iterationsverfahren @@ -0,0 +1,5 @@ +PACKETiterationsverfahrenDEFINESberechnefixpunkt:LETesc="�",bell="�",unterstrich="_",graphicstandardtasten="wvqm",protokoll="p",protokolldrucken="d",drucken="D",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",graphdefinieren="e",anzahlmoeglicherteilverfahren=2,fixpunktverfahren1="Iterationsverfahren - tabellarisch",fixpunktverfahren2="Iterationsverfahren - graphisch",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;PROCberechnefixpunkt(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1CANDlaenge(abbildungsvariablen(f))<>laenge(abbildungsterme(f))THENgibmeldung(anwendungstext(183));LEAVEberechnefixpunktEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).bestimmeanzuwendendeoperation:WINDOW VARwausgabe:=window(2,7,77,16);TEXT VARverfahrensname;INT VARzeile;schreibestatuszeile("Iteration");IFlaenge(abbildungsterme(f))<>1THENverfahrensname:=fixpunktverfahren1;LEAVEbestimmeanzuwendendeoperationEND IF;REPverfahrensname:=one(24,7,56,15,fixpunktverfahrensnamen,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnefixpunktEND IF END REP.initialisieredienoetigenvariablen:INT VARvariablenindex:=1,anzahlderiterationsschritte:=10;REAL VARstartwert:=0.0;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,variablenindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;setzedefaultgraph.fuehreoperationaus:REP IFlaenge(abbildungsterme(f))=1THENbestimmevorgabenfuereinfacheiterationsfolgeELSE IFverfahrensname=fixpunktverfahren2THENgibmeldung(anwendungstext(88));LEAVEfuehreoperationausEND IF;bestimmevorgabenfuerkomplexeiterationsfolgeEND IF;IFverfahrensname=fixpunktverfahren1THEN TEXT VARdatname:=scratchdateiname;FILE VARsf:=sequentialfile(output,datname);iteration(sf,f,eingabevektor,variablenindex,anzahlderiterationsschritte);zeigeergebnisse;forget(datname,quiet)ELSEzeichnecobwebmusterEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmevorgabenfuereinfacheiterationsfolge:initialisiereeingabemaskefueriterationsfolge;REPeditiereeingabemaske;werteausstiegszeichenausEND REP.initialisiereeingabemaskefueriterationsfolge:TAG VAReingabemaske:=formular(6);PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;IFvariablenindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),variablenindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaske:IF NOTvariablenindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(startwert)+kurzerstrich;raster(4):=text(anzahlderiterationsschritte)+kurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegszeichenaus:INT VARhilf1;REAL VARhilf2;SELECTpos(standardtasten,ausstieg)OF CASE1:IFvariablenindexbestimmtTHENgibinfofensteraus(wausgabe,15)ELSEgibinfofensteraus(wausgabe,14)END IF;CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHENanzahlderiterationsschritte:=hilf1;startwert:=hilf2;IF NOTvariablenvectorbestimmtTHENcursor(1,4);out("Parameter :");belegediefunktionsparameterEND IF;LEAVEbestimmevorgabenfuereinfacheiterationsfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT.alleeingabenkorrekt:korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:= +listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvariablenindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);hilf2:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,variablenindex,hilf2);TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);hilf1:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(97));clearerror;FALSE ELIFlastconversionokCANDhilf1>0CANDhilf1<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(14,4);belegeparameter(eingabevektor,variablenindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:outframe(wausgabe);show(formular(8));warte;page(wausgabe,TRUE)CASE2:cursor(1,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT;END REP.bestimmevorgabenfuerkomplexeiterationsfolge:bestimmeschrittanzahl;bestimmestartwerte.bestimmeschrittanzahl:INT VARhilf;cursor(1,3);out(anwendungstext(98));REPfootnote(anwendungstext(184));TEXT VAReingabe:=text(anzahlderiterationsschritte);eingabeCATkurzerstrich;cursor(32,3);enablestop;editget(eingabe,20,5,niltext,standardtasten,ausstieg);disablestop;SELECTpos(standardtasten,ausstiegSUB2)OF CASE1:gibinfofensteraus(wausgabe,21)CASE2:IFeingabekorrektTHENanzahlderiterationsschritte:=hilf;LEAVEbestimmeschrittanzahlELSEgibmeldung(anwendungstext(116))END IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstiegSUB2);LEAVEberechnefixpunktEND SELECT END REP.eingabekorrekt:changeall(eingabe,unterstrich,niltext);hilf:=int(eingabe);IFiserrorTHENclearerror;FALSE ELSElastconversionokCANDhilf>0CANDhilf<4001END IF.bestimmestartwerte:variablenindex:=0;cursor(1,4);out(anwendungstext(119));belegediefunktionsparameter.zeigeergebnisse:INT VARersterauszugebendersatz:=3,ersteauszugebendespalte:=8,scrzeile;IFlaenge(abbildungsterme(f))=1THENersterauszugebendersatzINCR(length(eingabevektor)-1)END IF;scrzeile:=ersterauszugebendersatz;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,scrzeile,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,scrzeile,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnefixpunktEND SELECT END REP.zeichnecobwebmuster:bereitegraphischeveranschaulichungvor;fuehreveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,"Iteration");cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+" "+"Anzahl der Iterationsschritte: "+raster[4].fuehreveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARfbild:=f;BOOL VARloeschflag:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvariablenindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f)THENloeschflag:=TRUE;fbild:=aufloesung(f)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(fbild,linkerrand, +rechterrand,eingabevektor,variablenindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(fbild,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehreveranschaulichungdurchEND IF;gibinfos;graphfenstereinstellen;pen(1,1,1,aktuellerstift);move(folgenwert,folgenwert);matdraw(folgenwert,funktionswert);matdraw(funktionswert,funktionswert).gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)).verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehreveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgenglied<anzahlderiterationsschritteTHENaktuellesfolgengliedINCR1;folgenwert:=funktionswert;replace(eingaben,variablenindex,folgenwert);LEAVEverarbeiteeingabezeichenELIFch=protokollTHENzeigeprotokollELIFch=druckenTHENdruckegraphEND IF;out(bell)END REP.definierebereich:loeschetexte;graphfenstereinstellen;loeschezeichnung;initkoordinatensystem;firsttime:=FALSE;definitionsmenu(TRUE,ausstieg);IFausstieg<>weiterarbeitTHEN LEAVEfuehreveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,variablenindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(fbild,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,variablenindex)END IF;zeichnegraphenderarbeitsfunktion(fbild,eingabevektor,variablenindex,linkerrand,rechterrand,folgenwert).zeigeprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehreveranschaulichungdurchEND IF.beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5)CASE2:schreibestatuszeile("Iteration");schreibearbeitsfunktion(f);strich(5);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);IFloeschflagTHENloescheabbildung(fbild)END IF;LEAVEberechnefixpunktEND SELECT END PROCberechnefixpunkt;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTvariablenindex,REAL CONSTlinkerrand,rechterrand,folgenwert):zeichnekoordinatensystem;normalgraphzeichnen(f,eingabevektor,variablenindex);newpicture(sekantenstift);pen(1,1,1,sekantenstift);matmove(linkerrand,linkerrand);matdraw(rechterrand,rechterrand);pen(1,1,1,neuerstift);newpicture(aktuellerstift);zeichnetexte;graphfenstereinstellen;matmove(folgenwert,0.0)END PROCzeichnegraphenderarbeitsfunktion;THESAURUS PROCfixpunktverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(fixpunktverfahren1,fixpunktverfahren2);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCfixpunktverfahrensnamen;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,VECTOR CONSTeingaben,INT CONSTvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion;BOOL VARloeschflag:=FALSE;IFkomplexefunktion(f1)THENf1:=aufloesung(f1);loeschflag:=TRUE END IF;footnote(anwendungstext(117));cursor(36,24);maxlinelength(f,1000);schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflagTHENloescheabbildung(f1)END IF.schreibetabellenueberschriften:IFlaenge(abbildungsterme(f1))>1THENspeziellestabellentitelformatELSEallgemeinestabellentitelformatEND IF.speziellestabellentitelformat:TEXT VARtitelzeile:="n ";FORiFROM1UPTOlength(eingaben)REP +titelzeileCATsenkrecht;titelzeileCATtext(NAMEauswahl(abbildungsvariablen(f1),i),gesamtstellen(ebene))END REP;putline(f,titelzeile);titelzeile:=6*waagerecht;FORiFROM1UPTOlength(eingaben)REPtitelzeileCATkreuz;titelzeileCATgesamtstellen(ebene)*waagerechtEND REP;putline(f,titelzeile).allgemeinestabellentitelformat:FORiFROM1UPTOlength(eingaben)REP IFi<>varindexTHENputline(f,text(NAMEauswahl(abbildungsvariablen(f1),i),8)+" = "+wandle(eingabenSUBi))END IF END REP;putline(f,"n "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),varindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevector:=eingaben;INT VARi,j;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6));IFlaenge(abbildungsterme(f1))>1THENspeziellestabellenzeilenformatELSEallgemeinestabellenzeilenformatEND IF END REP.speziellestabellenzeilenformat:FORjFROM1UPTOlength(eingaben)REPwrite(f,senkrecht+wandle(eingabevectorSUBj))END REP;line(f);eingabevector:=ergebnis(f1,eingabevector);IFiserrorTHENclearerror;putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF.allgemeinestabellenzeilenformat:REAL VARy:=ergebnis(f1,eingabevector)SUB1;IFiserrorTHENclearerror;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF;putline(f,senkrecht+wandle(eingabevectorSUBvarindex)+senkrecht+wandle(y));replace(eingabevector,varindex,y).testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF END PROCiteration;END PACKETiterationsverfahren; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot new file mode 100644 index 0000000..781c3f9 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.kyocera plot @@ -0,0 +1,3 @@ +PACKETkyoceraplotDEFINESdrawingarea,plotterkanal,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,draw,zeichensatz:LETxcm=29.7,ycm=19.7,bit14=16384,plotterunitspercm=118.1102;LETinitcmd="!R! UNIT d; SPO L;";LETleavecmd="SPO P; EXIT;",separator=",",terminator=";",movecmd="MZP ",drawcmd="DZP ";INT CONSTxunits:=int(xcm*plotterunitspercm),yunits:=int(ycm*plotterunitspercm);INT VARterminalchannel,plotterchannel:=15;REAL VARbuchstabenhoehe:=ycm/25.0,buchstabenbreite:=xcm/80.0;INT VARhorpixel,verpixel,ausgewaehlt,groesstexkoord,groessteykoord;REAL VARhorfaktor,vertfaktor,faktor;INT VARi,printerchannel:=15;horpixel:=3507;verpixel:=2330;horfaktor:=300.0/2.54;vertfaktor:=300.0/2.54;INT VARxpos,ypos,xfak,yfak,nextpointnr,linienraster,linientyp;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARx1,y1,INT VARxpixel,ypixel):x1:=xcm;y1:=ycm;xpixel:=xunits;ypixel:=yunits;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:toplotterchannel;out(initcmd)ENDPROCbeginplot;PROCendplot:plotendENDPROCendplot;PROCplotend:IFchannel=plotterchannelTHENout(leavecmd);toterminalchannelEND IF ENDPROCplotend;PROCclear:END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):END PROCpen;PROCmove(INT CONSTx,y):verifyxy;movetoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.movetoxy:xpos:=xx;ypos:=yy;TEXT VARky:=movecmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCmove;PROCdraw(INT CONSTx,y):verifyxy;drawtoxy.verifyxy:INT VARxx,yy;xx:=max(0,x);xx:=min(xunits,xx);yy:=max(0,y);yy:=min(yunits,yy);IFxx<>xTHENout(" x out of range ")END IF;IFyy<>yTHENout(" y out of range ")FI.drawtoxy:xpos:=xx;ypos:=yy;TEXT VARky:=drawcmd;kyCATtext(xx);kyCATseparator;kyCATtext(verpixel-yy);kyCATterminator;out(ky)END PROCdraw;PROCzeichensatz(INT CONSTnr,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(nr):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move( +xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCtoplotterchannel:terminalchannel:=channel(myself);continue(plotterchannel);END PROCtoplotterchannel;PROCtoterminalchannel:disablestop;continue(terminalchannel);IFiserrorTHENclearerror;break(quiet)END IF;enablestopEND PROCtoterminalchannel;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETkyoceraplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot new file mode 100644 index 0000000..d7a888d --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.laserjet plot @@ -0,0 +1,3 @@ +PACKETlaserjetplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LETesc="�",reset="�E",graphicsresolution="�*t75R",formfeed="�",landscape="�&I1O",horpixel=800,verpixel=560,intsperscanline=50,horfaktor=29.52756,vertfaktor=29.52756,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARxpos,ypos,xfak,yfak,plotterchannel,groesstexkoord,groessteykoord,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.76,buchstabenbreite:=0.3375,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=27.0;ycm:=19.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARspaltenbeginn:=(groesstexkoordDIV16)+1,zeilenbeginn:=groessteykoord+1;TEXT VARdoppelbyte:="xx";druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterchannel).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out(reset);out(landscape);out(graphicsresolution);out("�*r1A").gibdiebitmapaus:INT VARzeilenzaehler;FORzeilenzaehlerFROMzeilenbeginnDOWNTO1REPbefehlssequenzschickenPER.befehlssequenzschicken:out(esc+"*b"+text(neueanzahlderbytes)+"W");gibteilzeileaus.neueanzahlderbytes:(spaltenbeginnDIV8)+1.gibteilzeileaus:INT VARspaltenzaehler;FORspaltenzaehlerFROM1UPTOneueanzahlderbytesDIV2REPreplace(doppelbyte,1,bitmap(zeilenzaehler)(spaltenzaehler));out(doppelbyte)PER.druckedieseite:out("�*rB");out("�E").END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):ueberpruefeaktuellekoordinatenmitbishergroessten;IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;ueberpruefeaktuellekoordinatenmitbishergroessten;korrigierenextpointnr.ueberpruefeaktuellekoordinatenmitbishergroessten:IFxpos>groesstexkoordTHENgroesstexkoord:=xposFI;IFypos>groessteykoordTHENgroessteykoord:=yposFI.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs<totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD +12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;INT PROCplotterkanal:plotterchannelEND PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETlaserjetplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.masken b/app/schulis-mathematiksystem/1.0/src/mat.masken new file mode 100644 index 0000000..972f0fc --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.masken @@ -0,0 +1,4 @@ +PACKETmaskenDEFINES TAG,:=,tagsankoppeln,formular,show,putget,setfieldinfos:LETbeginmark="",endmark="",chome=1,choch=3,cfeldrueck=19,crunter=10,ctab=9,cfeldvor=13,cesc=27,right="�",left="�",taglines=24,maxfields=100;TEXT VARabc:="";INT VARi;FORiFROM33UPTO39REPabcCATcode(i)PER;FORiFROM42UPTO59REPabcCATcode(i)PER;FORiFROM62UPTO90REPabcCATcode(i)PER;FORiFROM97UPTO122REPabcCATcode(i)PER;FORiFROM214UPTO220REPabcCATcode(i)PER;abcCATcode(251);BOOL VARclosedbit,protectbit,darstbit,tabbit,leftbit,exitbit,rollbit,normal:=TRUE;INT VARworkint;TYPE TAG=STRUCT(TEXTerstel,darst,diainfo,dbnam,ausknam,feld,x,y,len,tab,ROWtaglinesTEXTformblatt,INTxmax,ymax,xs,ys,dbp,ver,durchs,art);OP:=(TAG VARa,TAG CONSTb):CONCR(a):=CONCR(b)END OP:=;BOOL PROCfieldexists(TAG CONSTa,INT CONSTfeldnr):(a.erstelVSUBfeldnr)>0END PROCfieldexists;PROCsetinfo(TEXT CONSTstring,INT CONSTpos):workint:=stringVSUBpos;IFworkint>0THENsetallvaluesELSEnormal:=TRUE END IF.setallvalues:closedbit:=hbit;protectbit:=hbit;darstbit:=hbit;tabbit:=hbit;leftbit:=hbit;exitbit:=hbit;rollbit:=hbit;normal:=FALSE.hbit:workint:=workint*2;IFworkint>255THENworkintDECR256;TRUE ELSE FALSE END IF END PROCsetinfo;PROCfieldinfos(TAG CONSTt,INT CONSTfeld,INT VARgeheimcode,BOOL VARclosed,protected,secret,special,left):geheimcode:=code(t.darstSUBfeld);setinfo(t.diainfo,feld);IFnormalTHENclosed:=FALSE;protected:=FALSE;secret:=FALSE;special:=FALSE;left:=FALSE ELSEclosed:=closedbit;protected:=protectbit;secret:=darstbit;special:=tabbit;left:=leftbitEND IF END PROCfieldinfos;PROCsetfieldinfos(TAG VARt,INT CONSTfeld,BOOL CONSTclosed,protected,secret):INT VARcd:=(t.diainfoVSUBfeld)MOD32;IFsecretTHENcdINCR32END IF;IFprotectedTHENcdINCR64END IF;IFclosedTHENcdINCR128END IF;replaceiac(t.diainfo,feld,code(cd))END PROCsetfieldinfos;INT VARafeld,ax,ay,al,ael,tlen,tout;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld):eput(ff,t,elfeld,1)END PROCeput;PROCeput(TAG CONSTff,TEXT CONSTt,INT CONSTelfeld,INT CONSTabwo):zumerstenelementarfeld;WHILEnochgenugtextdaREPfuelleelementarfeld;elementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;PER;gibrestaus;REPelementarfeldweiterzaehlen;IFgehoertzumnaechstenfeldTHEN LEAVEeputEND IF;zumelementarfeld;gibhintergrundausPER.zumerstenelementarfeld:tlen:=LENGTHt;tout:=abwo-1;afeld:=ff.feldVSUBelfeld;ael:=elfeld;positionieren(ff).fuelleelementarfeld:outsubtext(t,tout+1,tout+al);toutINCRal.nochgenugtextda:tout+al<tlen.elementarfeldweiterzaehlen:aelINCR1.zumelementarfeld:positionieren(ff).gehoertzumnaechstenfeld:(ff.feldVSUBael)<>afeld.gibrestaus:outsubtext(t,tout+1,tlen);IFtout+al>tlenTHENoutsubtext(grund,ax+tlen-tout,ax+al-1)END IF.gibhintergrundaus:outsubtext(grund,ax,ax+al-1).grund:ff.formblatt(ay)END PROCeput;PROCpositionieren(TAG CONSTff):al:=ff.lenVSUBael;ax:=ff.xVSUBael;ay:=ff.yVSUBael;cursor(ax,ay)END PROCpositionieren;PROCcursor(TAG CONSTff,INT CONSTfeld):ael:=ff.erstelVSUBfeld;positionieren(ff)END PROCcursor;INT PROClength(TAG CONSTff,INT CONSTfeld):zumerstenelementarfeld;IFael<1THEN LEAVElengthWITH0END IF;INT VARlen:=0;REPlenINCRfeldlaenge;zumnaechstenelementarfeldUNTILgehoertzumnaechstenfeldPER;len.zumerstenelementarfeld:ael:=ff.erstelVSUBfeld.zumnaechstenelementarfeld:aelINCR1.gehoertzumnaechstenfeld:(ff.feldVSUBael)<>feld.feldlaenge:ff.lenVSUBaelEND PROClength;PROCshow(TAG CONSTff):INT VARi;FORiFROM1UPTOff.ymaxREPcursor(1,i);out(ff.formblatt(i))END REP END PROCshow;INT VARcharcode:=0,lastx,lasty;INT VARaktbegin,aktfeld,aktel,wo;INT VARnextfeld,nextel,nextwo,nextbegin;PROCsetneweditvalues:aktfeld:=nextfeld;aktbegin:=nextbegin;aktel:=nextel;wo:=nextwo;END PROCsetneweditvalues;PROCsearchfield(TAG CONSTt,INT CONSTx,y,BOOL VARerfolg):erfolg:=FALSE;nextel:=0;REPsucheelementinrichtigerzeileUNTILkeinsmehrdaCORxposstimmtPER;IFerfolgTHENnextfeld:=t.feldVSUBnextel;nextbegin:=1;INT VARi:=t.erstelVSUBnextfeld;WHILEi<nextelREPnextbeginINCR(t.lenVSUBi);iINCR1PER;nextwo:=nextbegin+x-anfangEND IF.sucheelementinrichtigerzeile:nextel:=pos(t.y,code(y), +nextel+1).keinsmehrda:nextel=0.xposstimmt:erfolg:=anfang<=xANDende>x;erfolg.anfang:t.xVSUBnextel.ende:(t.xVSUBnextel)+(t.lenVSUBnextel).END PROCsearchfield;PROCputget(TAG CONSTff,ROWmaxfieldsTEXT VARv,INT VAReinstieg,TEXT VARtaste):enablestop;put(ff,v);get(ff,v,einstieg,taste)END PROCputget;PROCput(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues):INT VARiFORiFROM1UPTO LENGTHff.erstelREP IFfieldexists(ff,i)THENput(ff,fieldvalues(i),i)END IF PER END PROCput;PROCput(TAG CONSTff,TEXT CONSTv,INT CONSTfeld):setinfo(ff.diainfo,feld);INT VARerstelem:=ff.erstelVSUBfeld;IFerstelem>0THEN IFnormalCOR NOTdarstbitTHENeput(ff,v,erstelem)ELSEeput(ff,LENGTHv*(ff.darstSUBfeld),erstelem)END IF END IF END PROCput;PROCget(TAG CONSTff,ROWmaxfieldsTEXT VARfieldvalues,INT VARfeld,TEXT VARtaste):TEXT VARexittaste:="";INT VARaltesfeld;IF NOTfieldexists(ff,feld)THENerrorstop("startfeld nicht im tag")ELSE REPaltesfeld:=feld;setinfo(ff.diainfo,feld);IF NOTgeschuetztTHENeingabefeldELSEgeschuetztesfeldEND IF;charcode:=code(subtext(exittaste,1,1));IFcharcode=ctabTHENcharcode:=cfeldrueckELIFcharcode=cescTHEN IFsubtext(exittaste,2,2)=leftTHENcharcode:=cfeldrueckELIFsubtext(exittaste,2,2)=rightTHENcharcode:=cfeldvorEND IF END IF;executecommandcode(ff,feld);IFfeld=1THENfeld:=2END IF UNTILcharcode=cescPER;END IF.geschuetzt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);protect.ankreuzen:cl.geschuetztesfeld:cursor(ff,feld);getcursor(lastx,lasty);REPinchar(exittaste)UNTILexittaste="�"PER;inchar(taste).eingabefeld:cursor(ff,feld);getcursor(lastx,lasty);out(beginmark);cursor(lastx,lasty);editget(fieldvalues(feld),length(ff,feld)+30,length(ff,feld),code(cfeldvor)+code(choch)+code(crunter),abc+right+left,exittaste);cursor(lastx+length(ff,feld),lasty);out(endmark);IFankreuzenTHENerrorstop("Ankreuzfelder gibt's bei 'Mathe' nicht!")END IF;cursor(lastx,lasty);put(ff,fieldvalues(feld),feld);IFlength(exittaste)>1THENtaste:=subtext(exittaste,2,2)END IF END PROCget;PROCexecutecommandcode(TAG CONSTff,INT VARfeld):SELECTcharcodeOF CASEcfeldrueck:topriorfieldCASEcfeldvor:tonextfieldCASEchoch:goupifpossibleCASEcrunter:godownifpossibleCASEchome:tohomefieldCASEctab:END SELECT.topriorfield:REPEATfeld:=priorfield(ff,feld)UNTILwarerstesCORnichtgesperrtPER;IFwarerstesTHENtohomefieldEND IF.tonextfield:REPfeld:=nextfield(ff,feld)UNTILwarletztesCORnichtgesperrtPER;IFwarletztesTHENtohomefieldEND IF.tohomefield:feld:=firstfield(ff);WHILEgesperrtREPfeld:=nextfield(ff,feld)PER.goupifpossible:BOOL VARerfolg;searchfield(ff,lastx,lasty-1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.godownifpossible:searchfield(ff,lastx,lasty+1,erfolg);IFerfolgANDnextnichtgesperrtTHENsetneweditvalues;feld:=nextfeldEND IF.nichtgesperrt:INT VARgeheim;BOOL VARcl,protect,s,sp,l;fieldinfos(ff,feld,geheim,cl,protect,s,sp,l);NOTprotect.nextnichtgesperrt:fieldinfos(ff,nextfeld,geheim,cl,protect,s,sp,l);NOTprotect.gesperrt:NOTnichtgesperrt.warletztes:feld<1.warerstes:feld<1.END PROCexecutecommandcode;INT PROCfirstfield(TAG CONSTt):t.feldVSUB1END PROCfirstfield;INT PROCnextfield(TAG CONSTt,INT CONSTfeld):INT VARel:=(t.erstelVSUBfeld)+1;WHILE(t.feldVSUBel)=feldREPelINCR1PER;t.feldVSUBelEND PROCnextfield;INT PROCpriorfield(TAG CONSTt,INT CONSTfeld):t.feldVSUB((t.erstelVSUBfeld)-1)END PROCpriorfield;LETmaxtags=50,dsname="mathe formulare",depottask="ls-MENUKARTEN";BOUND ROWmaxtagsTAG VARmatheformulare;PROCtagsankoppeln:IF NOTexists(dsname)THENfetch("mathe formulare",/depottask)END IF;matheformulare:=old("mathe formulare")END PROCtagsankoppeln;TAG PROCformular(INT CONSTi):IFi>maxtagsTHENerrorstop("So viele TAGs gibt es nicht: "+text(i))END IF;matheformulare(i)END PROCformular;LETnil13byte="�������������",nil4byte="����",nilbyte="�";PROCreplaceiac(TEXT VARstring,INT CONSTwo,TEXT CONSTwas):IF LENGTHstring<=LENGTHwas+wo-1THENstretch(string,LENGTHwas+wo-1)FI;replace(string,wo,was)END PROCreplaceiac;PROCstretch(TEXT VARt,INT CONSTwo):WHILE LENGTHt<=wo-13REPtCAT +nil13bytePER;WHILE LENGTHt<=wo-4REPtCATnil4bytePER;WHILE LENGTHt<woREPtCATnilbytePER END PROCstretch;INT OP VSUB(TEXT CONSTstring,INT CONSTpos):code(stringSUBpos)END OP VSUB;END PACKETmasken + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen b/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen new file mode 100644 index 0000000..a574469 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.menufunktionen @@ -0,0 +1,7 @@ +PACKETmenufunktionenDEFINESeingang1,eingang2,funktionsverwaltungseingang,ausgang,eingabe,ausgabe,zeigen,beseitigen,sichern,laden,bestimmenachkommastellen,bestimmehalbgraphiczeichen,bestimmeformeleditoreinsatz,bestimmeformeleditorzeichensatz,bestimmedruckseitenformat,verfahren,verfahrensende,formeleditoraktiv,liefereformeleditorformat,raeumeauf:LETzentral=5,mitreinigung=TRUE,ohnereinigung=FALSE,ohneabbruch=FALSE,niltext="",bell="�",del="�",blank=" ",unterstrichzeichen="_",doppelpunkt=":",trennzeichen="!",maxfunktionen=10,maxfelder=100,menupunktende="m",zusatztasten="fsm",eingabeprocname="eingeben",ladeprocname="laden",loeschprocname="löschen",ausgabeprocname="ausgeben",sicherungsprocname="sichern",niveau="Ebene ",fktdatname="Funktionendatei",maximalanzahlfunktionen=200,PARAMETER=ROWmaxfelderTEXT,allesok=5,fetaskname="FORMELEDITOR",formelindateischreiben=1,zeichensatzumstellen=2,formeleditieren=3;ROWmaxfunktionenTEXT VARfkttext;TEXT VARletztesescapezeichen;INT VARletztearbeitsfkt:=2;TEXT CONSTlangerstrich:=100*unterstrichzeichen;BOOL VARausgabeaktiviert:=FALSE,eingabeaktiviert:=FALSE;THESAURUS VARverzeichnisderstandardfunktionen,archivinhalt;TASK VARformeleditor;PROCeingang1:disablestop;lowlevel;initialisierefunktionentextunddeaktiviereggfEND PROCeingang1;PROCeingang2:disablestop;highlevel;initialisierefunktionentextunddeaktiviereggfEND PROCeingang2;PROCinitialisierefunktionentextunddeaktiviereggf:INT VARi;tagsankoppeln;IFexiststask(fetaskname)THENformeleditor:=/fetasknameELSEformeleditor:=niltaskEND IF;ausgabeaktiviert:=laenge(eigenefunktionen)>0;eingabeaktiviert:=laenge(eigenefunktionen)<maximalanzahlfunktionen;IF NOTausgabeaktiviertTHENdeaktiviereELSEaktiviereEND IF;IF NOTeingabeaktiviertTHENdeactivate(eingabeprocname);deactivate(ladeprocname)END IF;verzeichnisderstandardfunktionen:=standardfunktionsthesaurus;FORiFROM1UPTOmaxfunktionenREPfkttext(i):=langerstrichEND REP;letztearbeitsfkt:=2END PROCinitialisierefunktionentextunddeaktiviereggf;PROCfunktionsverwaltungseingang:disablestop;IFausgabeaktiviertTHENaktiviereEND IF;IF NOTeingabeaktiviertTHENdeactivate(eingabeprocname);deactivate(ladeprocname)END IF END PROCfunktionsverwaltungseingang;PROCausgang:disablestop;THESAURUS VARth:=all;TEXT VARdsname;INT VARn:=laenge(temporaerefunktionen),i;FORiFROM1UPTOnREPloescheabbildung(abbildung(DEFINITIONlistenanfang(temporaerefunktionen)));END REP;i:=0;get(th,dsname,i);WHILEi<>0REP IFdsname<>"mathematikobjekte 1"CANDdsname<>"mathematikobjekte 2"CANDdsname<>"mathe formulare"THENforget(dsname,quiet)END IF;get(th,dsname,i)END REP END PROCausgang;PROCeingabe:disablestop;ABBILDUNG VARg;TEXT VARstring:=niltext;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge),ueberschriftfenster;IFeingabeuebereditorTHENueberschriftfenster:=window(2,3,77,1);outframe(ueberschriftfenster);out(ueberschriftfenster,center(ueberschriftfenster,invers("Funktionseingabe")));show(eingabefenster)END IF;REPnimmeingabenentgegen;werteeingabenausEND REP.nimmeingabenentgegen:clearbuffer;IFeingabeuebereditorTHENlasseformeleditorarbeitenELSEstring:=boxanswer(eingabefenster,text(anwendungstext(63),74),string,zentral,x0,y0,xbreite,ylaenge)END IF;IFstring=niltextTHENregeneratemenuscreen;LEAVEeingabeEND IF.lasseformeleditorarbeiten:initialisierevorgabenfuerformeleditor;werteformeleditoreingabeaus.initialisierevorgabenfuerformeleditor:INT VARreplycode,workchannel:=channel;BOUND TEXT VARtextstring:=new("datenbehaelter");textstring:=string;DATASPACE VARds:=old("datenbehaelter");forget("datenbehaelter",quiet);break(quiet);call(formeleditor,formeleditieren,ds,replycode);continue(workchannel).werteformeleditoreingabeaus:textstring:=ds;string:=textstring;forget(ds).werteeingabenaus:g:=neuefunktion(string);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(134));IF NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE ELIFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHEN +eingabeaktiviert:=FALSE;deactivate(eingabeprocname);deactivate(ladeprocname);regeneratemenuscreen;LEAVEeingabeEND IF;string:=niltextEND IF END PROCeingabe;PROCausgabe:disablestop;THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(64),niltext,ohnereinigung);IFnotempty(wunschliste)THENschreibedieausgewaehltenfunktionenineinedatei;gibdiegewuenschtenfunktionenausEND IF;regeneratemenuscreen.schreibedieausgewaehltenfunktionenineinedatei:ABBILDUNG VARfkt;TEXT CONSTdatname:=scratchdateiname;FILE VARf:=sequentialfile(output,datname);TEXT VARfunktionsname;INT VARi:=0;REPget(wunschliste,funktionsname,i);IFfunktionsname=niltextTHEN LEAVEschreibedieausgewaehltenfunktionenineinedateiEND IF;fkt:=abbildung(funktionsname);IFformeleditoraktivTHENliefereformeleditorformat(f,fkt);line(f)ELSEputline(f,funktionsstring(fkt))END IF END REP.gibdiegewuenschtenfunktionenaus:WINDOW VARu:=window(2,4,77,1),w:=window(2,7,77,16);INT VARersterauszugebendersatz:=1,ersteauszugebendespalte:=1;TEXT CONSTerlaubtezeichen:="?dm";show(u);out(u,center(u,anwendungstext(154)));outframe(w);REPfootnote(anwendungstext(135));scroll(w,datname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,erlaubtezeichen,letztesescapezeichen);werteausstiegausEND REP.werteausstiegaus:SELECTpos(erlaubtezeichen,letztesescapezeichen)OF CASE1:show(formular(13));warteCASE2:druckversuch(datname);outframe(w)CASE3:forget(datname,quiet);LEAVEgibdiegewuenschtenfunktionenausEND SELECT END PROCausgabe;PROCzeigen:disablestop;WINDOW VARw:=window(35,10,40,12);zeigeelementarefunktionsnamen;zeigebenutzerdefiniertefunktionsnamen;warte;page(w,TRUE);oldfootnote.zeigeelementarefunktionsnamen:TEXT VARtheselement,zeile;INT VARi:=0;show(w);cursor(w,1,1);out(w,center(w,anwendungstext(68)));get(verzeichnisderstandardfunktionen,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(verzeichnisderstandardfunktionen,theselement,i)END REP;out(w,center(w,zeile))END REP;line(w).zeigebenutzerdefiniertefunktionsnamen:THESAURUS VARthes:=funktionsnamenthesaurus;i:=0;out(w,center(w,anwendungstext(69)));get(thes,theselement,i);WHILEtheselement<>niltextREPzeile:=niltext;IFlength(theselement)>40THENzeileCATtheselement;get(thes,theselement,i);ELSE WHILEtheselement<>niltextCANDlength(zeile)+length(theselement)<40REPzeileCATtheselement;zeileCATblank;get(thes,theselement,i)END REP END IF;out(w,center(w,zeile));IFremaininglines(w)=0THENwarte;page(w)END IF;END REP;out(w,center(w,anwendungstext(70)+text(laenge(eigenefunktionen))))END PROCzeigen;PROCbeseitigen:disablestop;clearbuffer;SELECTmenualternative(anwendungstext(34),anwendungstext(50),zusatztasten,zentral,ohneabbruch)MOD100OF CASE1:waehlediezuloeschendenfunktionenaus;IFnotempty(auswahl)THENzeigeloeschfensterundinitialisierevariablen;IFebene=1THENloeschedieausgewaehltenfunktionenELSEloeschedieausgewaehltenfunktionenvorsichtigEND IF;warte;IFlaenge(eigenefunktionen)=0THENdeaktiviere;ausgabeaktiviert:=FALSE ELIFlaenge(eigenefunktionen)<maximalanzahlfunktionenTHENeingabeaktiviert:=TRUE;activate(eingabeprocname);activate(ladeprocname)END IF END IF;regeneratemenuscreenCASE2:footnote(anwendungstext(61));initialisieren;deaktiviere;ausgabeaktiviert:=FALSE;oldfootnote;refreshsubmenuEND SELECT.waehlediezuloeschendenfunktionenaus:THESAURUS VARauswahl:=menusome(funktionsnamenthesaurus,anwendungstext(73),niltext,ohnereinigung).zeigeloeschfensterundinitialisierevariablen:TEXT VARname,frage;TERM VAReintrag;INT VARi:=0;WINDOW VARw:=window(2,4,77,19);show(w);out(w,center(w,anwendungstext(142)));line(w).loeschedieausgewaehltenfunktionen:get(auswahl,name,i);WHILEname<>niltextREPeintrag:=listenposition(eigenefunktionen,name);frage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;get(auswahl,name,i)END REP. +loeschedieausgewaehltenfunktionenvorsichtig:THESAURUS VARfunktionenmitloeschverbot:=emptythesaurus;get(auswahl,name,i);WHILEname<>niltextREPeintrag:=listenposition(eigenefunktionen,name);IFreferenziertefunktion(eintrag)THENfunktionenmitloeschverbot:=funktionenmitloeschverbot+nameELSEfrage:=anwendungstext(75)+funktionsstring(abbildung(name))+anwendungstext(76);footnote(anwendungstext(141));IFyes(w,frage)THENloeschebenannteabbildung(name);putline(w,anwendungstext(137))END IF;auswahl:=auswahl-name;funktionenmitloeschverbot:=funktionenmitloeschverbot-nameEND IF;get(auswahl,name,i)END REP;IFnotempty(funktionenmitloeschverbot)THENgibhinweisaufreferenziertefunktionenEND IF.gibhinweisaufreferenziertefunktionen:line(w);putline(w,anwendungstext(152));i:=0;get(funktionenmitloeschverbot,name,i);WHILEname<>niltextREPput(w,name);get(funktionenmitloeschverbot,name,i)END REP;line(w);putline(w,anwendungstext(153))END PROCbeseitigen;PROCsichern:disablestop;TEXT VARmeldung:=niltext,dateiname;IFarchivangemeldet(meldung)THENclearbuffer;sichereausgewaehltefunktionenELIFmeldung<>niltextTHENgibmeldung(meldung)END IF;release(archive);oldfootnote.sichereausgewaehltefunktionen:waehlefunktionenaus;IFnotempty(wunschliste)THENwaehlefunktionendateikennung;schreibefunktioneninausgewaehltedatei;sicheredateiaufdasarchiv(dateiname)END IF.waehlefunktionenaus:THESAURUS VARwunschliste:=menusome(funktionsnamenthesaurus,anwendungstext(139),niltext,mitreinigung).waehlefunktionendateikennung:TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);dateiname:=eingegebenerdateiname(fktdateipraefix);IFdateiname=niltextTHEN LEAVEsichereausgewaehltefunktionenEND IF.schreibefunktioneninausgewaehltedatei:TEXT VARfunktionsname;INT VARi:=0;FILE VARf:=sequentialfile(output,dateiname);get(wunschliste,funktionsname,i);WHILEfunktionsname<>niltextREPwrite(f,funktionsstring(abbildung(funktionsname))+trennzeichen);get(wunschliste,funktionsname,i)END REP END PROCsichern;TEXT PROCeingegebenerdateiname(TEXT CONSTpraefix):TEXT VARkurzname:=niltext,langname:=niltext;REPclearbuffer;kurzname:=compress(menuanswer(anwendungstext(65),kurzname,zentral))UNTILkurzname=niltextCORdateinamefreigegebenEND REP;IFkurzname=niltextTHENniltextELSElangnameEND IF.dateinamefreigegeben:langname:=praefix+doppelpunkt+kurzname;NOT(archivinhaltCONTAINSlangname)CORmenuyes(anwendungstext(66),zentral)END PROCeingegebenerdateiname;PROCsicheredateiaufdasarchiv(TEXT CONSTdateiname):footnote(anwendungstext(67));commanddialogue(FALSE);save(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerrorELSEgibmeldung(anwendungstext(72))END IF;commanddialogue(TRUE);forget(dateiname,quiet)END PROCsicheredateiaufdasarchiv;PROCladen:disablestop;TEXT VARmeldung:=niltext,dateiname:=niltext;TEXT CONSTfktdateipraefix:=fktdatname+text(ebene,2);IFarchivangemeldet(meldung)THEN IFnotempty(archivinhaltLIKE(fktdateipraefix+":*"))THENholeausgewaehltefunktionen;release(archive);ueberpruefeaktivierungELSErelease(archive);gibmeldung(anwendungstext(78))END IF ELIFmeldung<>niltextTHENrelease(archive);gibmeldung(meldung)END IF;oldfootnote.holeausgewaehltefunktionen:bestimmedateinamen;IFdateierfolgreicheingelesen(dateiname)THENlesefunktionenein;forget(dateiname,quiet)END IF.bestimmedateinamen:dateiname:=ausgewaehlterdateiname(fktdateipraefix,anwendungstext(81),anwendungstext(82));IFdateiname=niltextTHEN LEAVEholeausgewaehltefunktionenEND IF.lesefunktionenein:ABBILDUNG VARfkt;FILE VARf:=sequentialfile(input,dateiname);TEXT VARfunktionstext;WHILE NOTeof(f)REPget(f,funktionstext,trennzeichen);footnote(anwendungstext(145)+funktionstext+anwendungstext(146));versuchefunktioneinzutragenEND REP.versuchefunktioneinzutragen:REP IFlaenge(eigenefunktionen)>=maximalanzahlfunktionenTHENgibmeldung(anwendungstext(205));eingabeaktiviert:=FALSE;LEAVElesefunktioneneinEND IF;fkt:=neuefunktion(funktionstext);IFiserrorTHENclearerror;clearbuffer;funktionstext:=menuanswer(anwendungstext(83),funktionstext,zentral);IFlsexitkey=menupunktendeTHEN LEAVElesefunktionenein +ELIFfunktionstext=niltextTHEN LEAVEversuchefunktioneinzutragenEND IF ELSE LEAVEversuchefunktioneinzutragenEND IF END REP END PROCladen;TEXT PROCausgewaehlterdateiname(TEXT CONSTpraefix,botschaft,ueberschrift):THESAURUS VARarchivdateien:=archivinhaltLIKE(praefix+":*");IFnotempty(archivdateien)THENmenuone(archivdateien,ueberschrift,niltext,mitreinigung)ELSEgibmeldung(botschaft);niltextEND IF END PROCausgewaehlterdateiname;BOOL PROCdateierfolgreicheingelesen(TEXT CONSTdateiname):forget(dateiname,quiet);footnote(anwendungstext(163));fetch(dateiname,archive);IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE TRUE END IF END PROCdateierfolgreicheingelesen;BOOL PROCarchivangemeldet(TEXT VARmeldung):TEXT CONSTvorlaeufigerarchivname:="Mathematik";IFmenuno(anwendungstext(84),zentral)THEN LEAVEarchivangemeldetWITH FALSE END IF;footnote(anwendungstext(138));archive(vorlaeufigerarchivname);IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENergebnisderzweitenanmeldungELSE TRUE END IF END IF.ergebnisderzweitenanmeldung:meldung:=errormessage;clearerror;IFsubtext(meldung,1,14)="Archiv heisst "CANDsubtext(meldung,16,20)<>"?????"THENarchive(subtext(meldung,16,length(meldung)-1));IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSEarchivinhalt:=ALLarchive;IFiserrorTHENmeldung:=errormessage;clearerror;FALSE ELSE TRUE END IF END IF ELSEmeldung:=anwendungstext(85);FALSE END IF END PROCarchivangemeldet;LETmaxnachkommastellen=12;PROCbestimmenachkommastellen:INT VARzahl;REPclearbuffer;TEXT VARanzahlnachkommastellen:=menuanswer(anwendungstext(86),text(nachkomma(ebene)),zentral);IFcompress(anzahlnachkommastellen)=niltextTHEN LEAVEbestimmenachkommastellenEND IF;zahl:=int(anzahlnachkommastellen);IFlastconversionokCANDzahl>-1CANDzahl<=maxnachkommastellenTHENsetzenachkommastellen(zahl);LEAVEbestimmenachkommastellenEND IF;out(bell)END REP END PROCbestimmenachkommastellen;PROCbestimmehalbgraphiczeichen:SELECTmenualternative(anwendungstext(93),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:ibmgraphiccharCASE2:stdgraphiccharOTHERWISE LEAVEbestimmehalbgraphiczeichenEND SELECT;regeneratemenuscreenEND PROCbestimmehalbgraphiczeichen;PROCbestimmeformeleditoreinsatz:SELECTmenualternative(anwendungstext(94),anwendungstext(95),"1234m",zentral,ohneabbruch)MOD100OF CASE1:formeleditoraktiv(TRUE);eingabeuebereditor(TRUE)CASE2:formeleditoraktiv(FALSE);eingabeuebereditor(TRUE)CASE3:formeleditoraktiv(TRUE);eingabeuebereditor(FALSE)CASE4:formeleditoraktiv(FALSE);eingabeuebereditor(FALSE)END SELECT END PROCbestimmeformeleditoreinsatz;PROCbestimmeformeleditorzeichensatz:forget("formelzeichensatz",quiet);BOUND TEXT VARformelzeichensatz:=new("formelzeichensatz");SELECTmenualternative(anwendungstext(207),anwendungstext(92),"ism",zentral,ohneabbruch)MOD100OF CASE1:formelzeichensatz:="ibmoperatoren"CASE2:formelzeichensatz:="standardoperatoren"OTHERWISEforget("formelzeichensatz",quiet);LEAVEbestimmeformeleditorzeichensatzEND SELECT;DATASPACE VARds:=old("formelzeichensatz");INT VARreplycode;call(formeleditor,zeichensatzumstellen,ds,replycode);forget(ds);forget("formelzeichensatz",quiet)END PROCbestimmeformeleditorzeichensatz;PROCbestimmedruckseitenformat:LETminimum=20,maximum=200;INT VARspaltenanzahl,zeilenanzahl,breite,laenge;TEXT VAReingabe;INT VARx0:=2,y0:=6,xbreite:=77,ylaenge:=13;WINDOW VAReingabefenster:=window(x0,y0,xbreite,ylaenge);druckseitenformat(spaltenanzahl,zeilenanzahl);liesspaltenanzahlein;lieszeilenanzahlein;definieredruckseitenformat(breite,laenge).liesspaltenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(215),74),text(spaltenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;breite:=int(eingabe);IFlastconversionokCANDbreite>=minimumCANDbreite<=maximumTHEN LEAVEliesspaltenanzahleinEND IF;out(bell)END REP.lieszeilenanzahlein:REPclearbuffer;eingabe:=boxanswer(eingabefenster,text(anwendungstext(216 +),74),text(zeilenanzahl),zentral,x0,y0,xbreite,ylaenge);IFcompress(eingabe)=niltextTHENraeumebildschirmauf;LEAVEbestimmedruckseitenformatEND IF;laenge:=int(eingabe);IFlastconversionokCANDlaenge>=minimumCANDlaenge<=maximumTHENraeumebildschirmauf;LEAVElieszeilenanzahleinEND IF;out(bell)END REP END PROCbestimmedruckseitenformat;PROCraeumebildschirmauf:INT VARi;FORiFROM9UPTO14REPcursor(1,i);out(del)END REP;refreshsubmenuEND PROCraeumebildschirmauf;ROW2BOOL VARformeleditoreingeschaltet:=ROW2BOOL:(FALSE,FALSE),formeleditoreingabe:=ROW2BOOL:(FALSE,FALSE);PROCformeleditoraktiv(BOOL CONSTschalter):formeleditoreingeschaltet(ebene):=schalterEND PROCformeleditoraktiv;BOOL PROCformeleditoraktiv:formeleditoreingeschaltet(ebene)END PROCformeleditoraktiv;PROCeingabeuebereditor(BOOL CONSTschalter):formeleditoreingabe(ebene):=schalterEND PROCeingabeuebereditor;BOOL PROCeingabeuebereditor:formeleditoreingabe(ebene)END PROCeingabeuebereditor;PROCliefereformeleditorformat(FILE VARf,ABBILDUNG CONSTfkt):forget("temporaerer datenraum",quiet);BOUND TEXT VARtextformat:=new("temporaerer datenraum");textformat:=formel(fkt);DATASPACE VARds:=old("temporaerer datenraum");INT VARreplycode;call(formeleditor,formelindateischreiben,ds,replycode);wertereplycodeaus;forget(ds);forget("temporaerer datenraum",quiet).wertereplycodeaus:TEXT VARzeile,tempdat:=scratchdateiname;IFreplycode=allesokTHENcopy(ds,tempdat);FILE VARf2:=sequentialfile(input,tempdat);output(f);WHILE NOTeof(f2)REPgetline(f2,zeile);putline(f,zeile)END REP;forget(tempdat,quiet)ELSEputline(f,funktionsstring(fkt))END IF END PROCliefereformeleditorformat;PROCverfahren(PROC(ABBILDUNG CONST)auszufuehrendeprozedur,TEXT CONSTprozedurname):disablestop;ABBILDUNG VARarbeitsfunktion;REPeditierearbeitsfunktionen;ergaenzeumunterstriche;IFletztesescapezeichen=menupunktendeTHENregeneratemenuscreen;LEAVEverfahrenEND IF;auszufuehrendeprozedur(arbeitsfunktion);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage)END IF;loeschetemporaereabbildung(arbeitsfunktion)UNTILletztesescapezeichen=menupunktendeEND REP;regeneratemenuscreen.editierearbeitsfunktionen:initialisieredievariablen;schreibestatuszeile(prozedurname);editiere.initialisieredievariablen:PARAMETER VARraster;INT VARi;TAG VAReingabemaske:=formular(1);raster(1):=niltext;FORiFROM1UPTOmaxfunktionenREPraster(i+1):=fkttext(i)END REP.editiere:REPbearbeiteeingabeformular;werteausstiegausEND REP.bearbeiteeingabeformular:footnote(anwendungstext(189));show(eingabemaske);putget(eingabemaske,raster,letztearbeitsfkt,letztesescapezeichen);IFiserrorTHENclearerror;schreibestatuszeile(prozedurname);show(eingabemaske);gibmeldung(errormessage);letztesescapezeichen:=menupunktende;LEAVEeditiereEND IF.werteausstiegaus:SELECTpos("?zwm",letztesescapezeichen)OF CASE1:gibinformationzumformularCASE2:zeigenCASE3:IFkorrekteeingabeTHEN LEAVEeditierearbeitsfunktionenEND IF CASE4:LEAVEeditiereEND SELECT.korrekteeingabe:INT VARdoppelpunktlage:=pos(raster(letztearbeitsfkt),doppelpunkt);TEXT VARfstring:=raster(letztearbeitsfkt);footnote(anwendungstext(114));changeall(fstring,unterstrichzeichen,niltext);IFcompress(fstring)=niltextTHENgibmeldung(anwendungstext(190));FALSE ELSE IFselbstdefiniertefunktionTHEN IF NOTeingabeaktiviertTHENgibmeldung(anwendungstext(205));LEAVEkorrekteeingabeWITH FALSE END IF;arbeitsfunktion:=neuefunktion(fstring)ELSEarbeitsfunktion:=funktionsaufruf(fstring)END IF;IFiserrorTHENgibmeldung(errormessage);clearerror;FALSE ELSE IFselbstdefiniertefunktionTHENraster(letztearbeitsfkt):=text(raster(letztearbeitsfkt),doppelpunktlage-1);ausgabeaktiviert:=laenge(eigenefunktionen)>=1;eingabeaktiviert:=laenge(eigenefunktionen)<maximalanzahlfunktionen;END IF;TRUE END IF END IF.selbstdefiniertefunktion:doppelpunktlage<>0.gibinformationzumformular:WINDOW VARw:=window(3,6,75,17);outframe(w);IFebene=1THENshow(formular(4))ELSEshow(formular(23))END IF;warte.ergaenzeumunterstriche:FORiFROM1UPTOmaxfunktionenREPchangeall(raster(i+1),blank, +unterstrichzeichen);raster(i+1)CAT((100-length(raster(i+1)))*unterstrichzeichen);fkttext(i):=raster(i+1)END REP END PROCverfahren;PROCraeumeauf:schreibeselbstdefiniertefunktionenindatei;initialisieren;trageselbstdefiniertefunktionenein;oldfootnote.schreibeselbstdefiniertefunktionenindatei:TEXT VARbeliebig:=scratchdateiname;FILE VARf:=sequentialfile(output,beliebig);TERM VARt:=listenanfang(eigenefunktionen);WHILEt<>nilREPputline(f,funktionsstring(abbildung(NAMEt)));t:=nachfolger(t)END REP.trageselbstdefiniertefunktionenein:TEXT VARzeile;ABBILDUNG VARabb;f:=sequentialfile(input,beliebig);WHILE NOTeof(f)REPgetline(f,zeile);abb:=neuefunktion(zeile)END REP;forget(beliebig,quiet)END PROCraeumeauf;PROCverfahrensende(TEXT CONSTzeichen):letztesescapezeichen:=zeichenEND PROCverfahrensende;PROCueberpruefeaktivierung:IFlaenge(eigenefunktionen)>0CAND NOTausgabeaktiviertTHENaktiviere;ausgabeaktiviert:=TRUE;refreshsubmenuELIFlaenge(eigenefunktionen)=0CANDausgabeaktiviertTHENdeaktiviere;ausgabeaktiviert:=FALSE;refreshsubmenuEND IF END PROCueberpruefeaktivierung;PROCaktiviere:activate(loeschprocname);activate(ausgabeprocname);activate(sicherungsprocname)END PROCaktiviere;PROCdeaktiviere:deactivate(loeschprocname);deactivate(ausgabeprocname);deactivate(sicherungsprocname)END PROCdeaktiviere;END PACKETmenufunktionen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.nullstellen b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen new file mode 100644 index 0000000..3900a28 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.nullstellen @@ -0,0 +1,6 @@ +PACKETnullstellenDEFINESberechnenullstelle:LETesc="�",bell="�",unterstrich="_",abbruchzeichen="!",niltext="",del="�",maxfelder=100,menupunktende="m",weiterarbeit="w",graphdefinieren="e",naechste="q",protokoll="p",protokolldrucken="d",drucken="D",graphicstandardtasten="wvqm",standardtasten="?wvqm",standardunddrucktasten="?dwvqm",anzahlmoeglicherteilverfahren=3,nullstellenverfahrensname="Nullstellen",nullstellenverfahren1="Intervallhalbierungsverfahren - tabellarisch",nullstellenverfahren2="Newtonverfahren - tabellarisch",nullstellenverfahren3="Newtonverfahren - graphisch",titelzeile12="Nullstellen: Newtonverfahren",titelzeile3="Nullstellen: Intervallhalbierung",PARAMETER=ROWmaxfelderTEXT,kurzerstrich="____________________";TEXT VARausstieg;THESAURUS CONSTmoeglicheteilverfahren:=nullstellenverfahrensnamen;PROCberechnenullstelle(ABBILDUNG CONSTf):pruefedieverwendbarkeitderfunktion;zeigeaktuellearbeitsfunktion;initialisieredienoetigenvariablen;REPbestimmeanzuwendendeoperation;fuehreoperationausEND REP.pruefedieverwendbarkeitderfunktion:IFlaenge(abbildungsterme(f))<>1THENgibmeldung(anwendungstext(88));LEAVEberechnenullstelleEND IF.zeigeaktuellearbeitsfunktion:page;schreibearbeitsfunktion(f);strich(5).initialisieredienoetigenvariablen:WINDOW VARwausgabe:=window(2,7,77,16);TAG VAReingabemaske;PARAMETER VARraster;INT VARstartfeld:=2,ersterauszugebendersatz,ersteauszugebendespalte,varindex:=1,anzahlderiterationsschritte:=10,parameingabespalte,endederueberschrift;VECTOR VAReingabevektor:=vector(laenge(abbildungsvariablen(f)),0.0);ABBILDUNG VARfbild;BOOL VARvariablenvectorbestimmt:=LENGTHeingabevektor=1,varindexbestimmt:=ebene=1CORvariablenvectorbestimmt,firsttime:=TRUE;TEXT VARverfahrensname;setzedefaultgraph.bestimmeanzuwendendeoperation:INT VARzeile;schreibestatuszeile(nullstellenverfahrensname);REPverfahrensname:=one(24,7,56,15,moeglicheteilverfahren,anwendungstext(173),anwendungstext(185));IFverfahrensname<>niltextTHEN FORzeileFROM7UPTO20REPcursor(24,zeile);out(del)END REP;LEAVEbestimmeanzuwendendeoperationELIFlsexitkey=menupunktendeTHENverfahrensende(menupunktende);LEAVEberechnenullstelleEND IF END REP.fuehreoperationaus:TEXT VARdatname;FILE VARsf;IFverfahrensname=nullstellenverfahren1THENintervallhalbierungsverfahrenELSEbildedienewtonfolgeEND IF.bildedienewtonfolge:REAL VARstartwert:=0.0;anzahlderiterationsschritte:=10;schreibestatuszeile(titelzeile12);IFableitungsverbot(adresse(f))THENgibmeldung(anwendungstext(87));LEAVEbildedienewtonfolgeEND IF;REPbestimmeparameterfuernewtonfolge;bildenewtonvorschrift;IFverfahrensname=nullstellenverfahren2THENermittleergebnisse;zeigeergebnisse;raeumeaufELSEgraphischeveranschaulichungdesnewtonverfahrensEND IF UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuernewtonfolge:initialisiereeingabemaskefuernewtonfolge;REPeditiereeingabemaske;werteausstiegausEND REP.initialisiereeingabemaskefuernewtonfolge:eingabemaske:=formular(6);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF;raster(3):=text(startwert);raster(4):=text(anzahlderiterationsschritte).editiereeingabemaske:IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3)CATkurzerstrich;raster(4)CATkurzerstrich;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);LEAVEfuehreoperationausEND IF.werteausstiegaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IF NOTvarindexbestimmtTHENgibinfofensteraus(wausgabe,14)ELSEgibinfofensteraus(wausgabe,15)END IF CASE2:footnote(anwendungstext(114));IFalleeingabenkorrektTHEN IF NOTvariablenvectorbestimmtTHENparameingabespalte:=1;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuernewtonfolgeEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT.alleeingabenkorrekt: +korrektervariablenbezeichnerCANDkorrekteranfangswertCANDkorrektefolgengliedanzahl.korrektervariablenbezeichner:TERM VARvaradresse:=listenanfang(abbildungsvariablen(f));IFebene=1CORlaenge(abbildungsvariablen(f))=1THENvarindex:=1;TRUE ELSEchangeall(raster(2),unterstrich,niltext);varadresse:=listenposition(abbildungsvariablen(f),raster(2));IFvaradresse<>nilTHENvarindex:=PLATZvaradresse;TRUE ELSEstartfeld:=2;gibmeldung(anwendungstext(147)+raster(2)+anwendungstext(148));FALSE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrich,niltext);REAL VARanfangswert:=realzahl(raster(3));IF NOTiserrorTHENreplace(eingabevektor,varindex,anfangswert);startwert:=anfangswert;TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrektefolgengliedanzahl:changeall(raster(4),unterstrich,niltext);anzahlderiterationsschritte:=int(raster(4));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDanzahlderiterationsschritte>0CANDanzahlderiterationsschritte<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=4;FALSE END IF.bildenewtonvorschrift:fbild:=newtonvorschrift(f,varindex);IFiserrorTHENgibmeldung(errormessage);clearerror;LEAVEbildedienewtonfolgeEND IF.ermittleergebnisse:datname:=scratchdateiname;sf:=sequentialfile(output,datname);iteration(sf,f,fbild,eingabevektor,varindex,anzahlderiterationsschritte).zeigeergebnisse:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnisseCASE4:page(wausgabe,TRUE);raeumeauf;LEAVEfuehreoperationausCASE5,6:raeumeauf;verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.raeumeauf:forget(datname,quiet);loescheabbildung(fbild).graphischeveranschaulichungdesnewtonverfahrens:bereitegraphischeveranschaulichungvor;fuehregraphischeveranschaulichungdurch;beendegraphischeveranschaulichung.bereitegraphischeveranschaulichungvor:initkoordinatensystem;bauegraphbildschirmauf(f,titelzeile12);cursor(2,3);out(funktionszeile).funktionszeile:"Anfangswert "+raster[2]+" = "+raster[3]+" "+anwendungstext(98)+raster[4].fuehregraphischeveranschaulichungdurch:initialisierevariablen;zeichnegraphenderarbeitsfunktion(f1,eingaben,varindex);REPberechneundzeichnedenfunktionswert;verarbeiteeingabezeichenPER.initialisierevariablen:INT VARaktuellesfolgenglied:=0;ABBILDUNG VARf1:=f,f2:=fbild;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE,fehler:=FALSE;VECTOR VAReingaben:=eingabevektor;REAL VARfolgenwert:=eingabenSUBvarindex,funktionswert,linkerrand,rechterrand;IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;berechnegraphintervall;IFfirsttimeTHENberechnekoordinatensystem(f1,linkerrand,rechterrand,eingabevektor,varindex);firsttime:=FALSE END IF.berechnegraphintervall:linkerrand:=startwert-5.0;rechterrand:=startwert+5.0;IFlinkerrand>0.0THENlinkerrand:=-linkerrandEND IF;IFrechterrand<0.0THENrechterrand:=-rechterrandEND IF.berechneundzeichnedenfunktionswert:funktionswert:=ergebnis(f1,eingaben)SUB1;IFiserrorTHENclearerror;fehler:=TRUE;ausstieg:=weiterarbeit;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matmove(folgenwert,0.0);matdraw(folgenwert,funktionswert);gibinfos.gibinfos:cursor(54,10);out(text(aktuellesfolgenglied,4));cursor(54,13);out(text(compress(wandle(folgenwert)),25));cursor(54,16);out(text(compress(wandle(funktionswert)),25)). +verarbeiteeingabezeichen:TEXT VARch;REPclearbuffer;inchar(ch);IFch=escTHENinchar(ausstieg);IFpos(graphicstandardtasten,ausstieg)<>0THEN LEAVEfuehregraphischeveranschaulichungdurchELIFausstieg=graphdefinierenTHENdefinierebereich;LEAVEverarbeiteeingabezeichenEND IF;out(bell)ELIFch="+"CANDaktuellesfolgenglied<anzahlderiterationsschritteTHENaktuellesfolgengliedINCR1;berechneundzeichnenaechstesfolgenglied;LEAVEverarbeiteeingabezeichenELIFch=protokollTHENzeigedasprotokollELIFch=druckenTHENdruckegraphELSEout(bell)END IF;END REP.definierebereich:loeschetexte;graphfenstereinstellen;loeschezeichnung;initkoordinatensystem;firsttime:=FALSE;definitionsmenu(TRUE,ausstieg);IFausstieg<>weiterarbeitTHEN LEAVEfuehregraphischeveranschaulichungdurchEND IF;aktuellesfolgenglied:=0;folgenwert:=startwert;replace(eingaben,varindex,startwert);IFautomatischerskalierungsmodusTHENberechnekoordinatensystem(f1,koordinatensystemxmin,koordinatensystemxmax,eingabevektor,varindex)END IF;zeichnegraphenderarbeitsfunktion(f1,eingabevektor,varindex).zeigedasprotokoll:gibprotokollaus(anwendungstext(211),protokolldrucken+graphicstandardtasten,ausstieg);IFausstieg=weiterarbeitTHENzeichnetexte;gibinfosELSE LEAVEfuehregraphischeveranschaulichungdurchEND IF.berechneundzeichnenaechstesfolgenglied:graphfenstereinstellen;move(folgenwert,funktionswert);folgenwert:=naechstesfolgenglied(f2,eingaben,varindex);IFiserrorTHENclearerror;fehler:=TRUE;LEAVEfuehregraphischeveranschaulichungdurchEND IF;pen(1,1,1,aktuellerstift);matdraw(folgenwert,0.0).beendegraphischeveranschaulichung:IFfehlerTHENgibgraphicmeldung(anwendungstext(175))END IF;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF;endplot;plotend;beendegraphikarbeit;SELECTpos(graphicstandardtasten,ausstieg)OF CASE1:erneuerebildschirmCASE2:erneuerebildschirm;loeschetemporaereabbildung(fbild);LEAVEfuehreoperationausCASE3,4:verfahrensende(ausstieg);loeschetemporaereabbildung(fbild);LEAVEberechnenullstelleEND SELECT.erneuerebildschirm:schreibestatuszeile(titelzeile12);schreibearbeitsfunktion(f);strich(5).intervallhalbierungsverfahren:REAL VARlinkegrenze:=-5.0,rechtegrenze:=5.0;schreibestatuszeile(titelzeile3);REPbestimmeparameterfuerintervallhalbierung;datname:=scratchdateiname;sf:=sequentialfile(output,datname);intervallhalbierung(sf,f,eingabevektor,varindex,anzahlderiterationsschritte,linkegrenze,rechtegrenze);zeigeergebnissederintervallhalbierung;forget(datname,quiet)UNTILausstieg<>weiterarbeitEND REP.bestimmeparameterfuerintervallhalbierung:initialisiereeingabemaskefuerintervallhalbierung;REPeditiereeingabemaskefuerintervallhalbierung;werteausstiegbeiintervallhalbierungausEND REP.initialisiereeingabemaskefuerintervallhalbierung:eingabemaske:=formular(7);startfeld:=2;raster(1):=niltext;IFvarindexbestimmtTHENraster(2):=NAMEauswahl(abbildungsvariablen(f),varindex);setfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2):=NAMElistenanfang(abbildungsvariablen(f))END IF.editiereeingabemaskefuerintervallhalbierung:REAL VARhilf1,hilf2;INT VARhilf3,i;IF NOTvarindexbestimmtTHENraster(2)CATkurzerstrichEND IF;raster(3):=text(linkegrenze);raster(4):=text(rechtegrenze);raster(5):=text(anzahlderiterationsschritte);FORiFROM3UPTO5REPraster(i)CATkurzerstrichEND REP;footnote(anwendungstext(184));show(eingabemaske);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENgibmeldung(errormessage);clearerror;ausstieg:=naechsteEND IF.werteausstiegbeiintervallhalbierungaus:SELECTpos(standardtasten,ausstieg)OF CASE1:IFebene=2CANDlaenge(abbildungsvariablen(f))>1THENgibinfofensteraus(wausgabe,17)ELSEgibinfofensteraus(wausgabe,16)END IF CASE2:footnote(anwendungstext(114));IFallebisektionseingabenkorrektTHENlinkegrenze:=hilf1;rechtegrenze:=hilf2;anzahlderiterationsschritte:=hilf3;IF NOTvariablenvectorbestimmtTHENparameingabespalte:=40;belegediefunktionsparameterEND IF;LEAVEbestimmeparameterfuerintervallhalbierungEND IF CASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg); +LEAVEberechnenullstelleEND SELECT.allebisektionseingabenkorrekt:korrektervariablenbezeichnerCANDkorrektelinkegrenzeCANDkorrekterechtegrenzeCANDkorrekteteilungsanzahl.korrektelinkegrenze:changeall(raster(3),unterstrich,niltext);hilf1:=realzahl(raster(3));IF NOTiserrorTHEN TRUE ELSEclearerror;startfeld:=3;gibmeldung(anwendungstext(157));FALSE END IF.korrekterechtegrenze:changeall(raster(4),unterstrich,niltext);hilf2:=realzahl(raster(4));IF NOTiserrorTHEN IFhilf1>=hilf2THENstartfeld:=4;gibmeldung(anwendungstext(160));FALSE ELSE TRUE END IF ELSEclearerror;startfeld:=4;gibmeldung(anwendungstext(157));FALSE END IF.korrekteteilungsanzahl:changeall(raster(5),unterstrich,niltext);hilf3:=int(raster(5));IFiserrorTHENgibmeldung(anwendungstext(187));clearerror;FALSE ELIFlastconversionokCANDhilf3>0CANDhilf3<4001THEN TRUE ELSEgibmeldung(anwendungstext(187));startfeld:=5;FALSE END IF.zeigeergebnissederintervallhalbierung:endederueberschrift:=3;IFlength(eingabevektor)>1CANDlength(eingabevektor)<=10THENendederueberschriftINCR(length(eingabevektor)-1)END IF;ersterauszugebendersatz:=endederueberschrift;ersteauszugebendespalte:=8;outframe(wausgabe);REPfootnote(anwendungstext(184));scroll(wausgabe,datname,8,endederueberschrift,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,standardunddrucktasten,ausstieg);SELECTpos(standardunddrucktasten,ausstieg)OF CASE1:show(formular(9));warteCASE2:aufbereitetdrucken(datname,text(funktionsstring(f),druckspalten),8,endederueberschrift,gesamtstellen(ebene)+1);outframe(wausgabe)CASE3:page(wausgabe,TRUE);LEAVEzeigeergebnissederintervallhalbierungCASE4:page(wausgabe,TRUE);forget(datname,quiet);LEAVEfuehreoperationausCASE5,6:forget(datname,quiet);verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP.belegediefunktionsparameter:REPfootnote(anwendungstext(184));cursor(parameingabespalte,4);out("Parameter :");cursor(parameingabespalte+13,4);belegeparameter(eingabevektor,varindex,abbildungsvariablen(f),standardtasten,ausstieg);SELECTpos(standardtasten,ausstieg)OF CASE1:gibinfofensteraus(wausgabe,8)CASE2:cursor(parameingabespalte,4);out(del);LEAVEbelegediefunktionsparameterCASE3:LEAVEfuehreoperationausCASE4,5:verfahrensende(ausstieg);LEAVEberechnenullstelleEND SELECT END REP END PROCberechnenullstelle;PROCzeichnegraphenderarbeitsfunktion(ABBILDUNG CONSTf,VECTOR CONSTeingaben,INT CONSTvarindex):zeichnekoordinatensystem;normalgraphzeichnen(f,eingaben,varindex);zeichnetexte;pen(1,1,1,neuerstift);newpicture(aktuellerstift)END PROCzeichnegraphenderarbeitsfunktion;PROCiteration(FILE VARf,ABBILDUNG CONSToriginalfunktion,iterationsfunktion,VECTOR CONSTeingaben,INT CONSTlaufvarindex,anzahlfolgenglieder):ABBILDUNG VARf1:=originalfunktion,f2:=iterationsfunktion;BOOL VARloeschflag1:=FALSE,loeschflag2:=FALSE;footnote(anwendungstext(117));cursor(36,24);IFkomplexefunktion(f1)THENloeschflag1:=TRUE;f1:=aufloesung(f1)END IF;IFkomplexefunktion(f2)THENloeschflag2:=TRUE;f2:=aufloesung(f2)END IF;schreibetabellenueberschriften;schreibetabellenzeilen;IFloeschflag1THENloeschetemporaereabbildung(f1)END IF;IFloeschflag2THENloeschetemporaereabbildung(f2)END IF.schreibetabellenueberschriften:ergaenzeparameter(f,originalfunktion,eingaben,laufvarindex);putline(f,"n "+senkrecht+text(NAMEauswahl(abbildungsvariablen(originalfunktion),laufvarindex),gesamtstellen(ebene))+senkrecht+text("Fktswert",gesamtstellen(ebene)));putline(f,6*waagerecht+2*(kreuz+gesamtstellen(ebene)*waagerecht)).schreibetabellenzeilen:VECTOR VAReingabevektor:=eingaben;INT VARi;REAL VARfolgenglied:=eingabevektorSUBlaufvarindex,funktionswert;FORiFROM0UPTOanzahlfolgengliederREPcout(i);testetaste;write(f,text(i,6)+senkrecht);write(f,wandle(folgenglied)+senkrecht);funktionswert:=ergebnis(f1,eingabevektor)SUB1;testefehler;putline(f,wandle(funktionswert));folgenglied:=naechstesfolgenglied(f2,eingabevektor,laufvarindex);testefehlerEND REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEschreibetabellenzeilenEND IF.testefehler:IFiserrorTHENclearerror; +putline(f,gesamtstellen(ebene)*"-");putline(f,anwendungstext(175));LEAVEschreibetabellenzeilenEND IF END PROCiteration;REAL PROCnaechstesfolgenglied(ABBILDUNG CONSTbildungsvorschrift,VECTOR VAReingaben,INT CONSTindexfuereingabevektor):REAL VARneuerwert:=ergebnis(bildungsvorschrift,eingaben)SUB1;replace(eingaben,indexfuereingabevektor,neuerwert);neuerwertEND PROCnaechstesfolgenglied;PROCintervallhalbierung(FILE VARf,ABBILDUNG CONSTfunktion,VECTOR VAReingabevektor,INT CONSTvarindex,anzahliterationsschritte,REAL CONSTlinks,rechts):BOOL VARloeschflag:=FALSE;ABBILDUNG VARfkt:=funktion;TERM VARfktterm;INT VARi;erstellegegebenenfallsaufloesungderfunktion;footnote(anwendungstext(117));cursor(36,24);ergaenzeparameter(f,funktion,eingabevektor,varindex);schreibekopfzeileninausgabedatei;berechnemittlerenwert;IFloeschflagTHENloescheabbildung(fkt)END IF.erstellegegebenenfallsaufloesungderfunktion:IFkomplexefunktion(fkt)THENfkt:=aufloesung(fkt);loeschflag:=TRUE END IF;fktterm:=AUSDRUCKlistenanfang(abbildungsterme(fkt)).schreibekopfzeileninausgabedatei:LETanzahlueberschriften=6;ROWanzahlueberschriftenTEXT CONSTueberschrift:=ROWanzahlueberschriftenTEXT:(anwendungstext(253),anwendungstext(254),anwendungstext(255),anwendungstext(256),anwendungstext(257),anwendungstext(258));TEXT VARtitelzeile:="n ";FORiFROM1UPTOanzahlueberschriftenREPtitelzeileCAT(senkrecht+text(ueberschrift(i),gesamtstellen(ebene)))END REP;maxlinelength(f,2000);putline(f,titelzeile);titelzeile:=6*waagerecht+anzahlueberschriften*(kreuz+(gesamtstellen(ebene)*waagerecht));putline(f,titelzeile).berechnemittlerenwert:REAL VARx1:=links,x2:=rechts,xm,y1,y2,ym;FORiFROM0UPTOanzahliterationsschritteREPcout(i);testetaste;xm:=0.5*(x1+x2);write(f,text(i,6));write(f,senkrecht+wandle(x1));write(f,senkrecht+wandle(xm));write(f,senkrecht+wandle(x2));IFwertdefiniert(f,fktterm,eingabevektor,varindex,x1,y1)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,xm,ym)CANDwertdefiniert(f,fktterm,eingabevektor,varindex,x2,y2)THENvergleiche;line(f)ELSE LEAVEberechnemittlerenwertEND IF END REP.testetaste:IFincharety=abbruchzeichenTHEN LEAVEberechnemittlerenwertEND IF.vergleiche:IFym=0.0THEN LEAVEberechnemittlerenwertELIFym*y1<=0.0THENx2:=xmELSEx1:=xmEND IF.END PROCintervallhalbierung;BOOL PROCwertdefiniert(FILE VARf,TERM CONSTfktterm,VECTOR VAReingabevektor,INT CONSTlaufvarindex,REAL CONSTx,REAL VARy):replace(eingabevektor,laufvarindex,x);y:=result(fktterm,eingabevektor);IFiserrorTHENclearerror;write(f,senkrecht+gesamtstellen(ebene)*"-");line(f);write(f,anwendungstext(175));FALSE ELSEwrite(f,senkrecht+wandle(y));TRUE END IF END PROCwertdefiniert;THESAURUS PROCnullstellenverfahrensnamen:THESAURUS VARt:=emptythesaurus;INT VARi;ROWanzahlmoeglicherteilverfahrenTEXT CONSTvname:=ROWanzahlmoeglicherteilverfahrenTEXT:(nullstellenverfahren1,nullstellenverfahren2,nullstellenverfahren3);FORiFROM1UPTOanzahlmoeglicherteilverfahrenREPt:=t+vname(i)END REP;tEND PROCnullstellenverfahrensnamen;PROCergaenzeparameter(FILE VARsf,ABBILDUNG CONSTf,VECTOR CONSTeingabevektor,INT CONSTlaufvarindex):INT VARi,varlistenlaenge:=laenge(abbildungsvariablen(f));IFvarlistenlaenge>10THEN LEAVEergaenzeparameterEND IF;FORiFROM1UPTOvarlistenlaengeREP IFi<>laufvarindexTHENputline(sf,text(NAMEauswahl(abbildungsvariablen(f),i),8)+"="+wandle(eingabevektorSUBi))END IF END REP END PROCergaenzeparameter;END PACKETnullstellen; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.parser b/app/schulis-mathematiksystem/1.0/src/mat.parser new file mode 100644 index 0000000..fc53883 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.parser @@ -0,0 +1,12 @@ +PACKETparserDEFINESneuefunktion,funktionsaufruf,funktionsstring,formel,gibnamen,loescheunreferenzierteabbildung,referenziertefunktion,funktionsnamenthesaurus,standardfunktionsthesaurus:LETniltext="",blank=" ",ifsymbol="<",fuersymbol=":",elifsymbol=";",endifsymbol=">",undsymbol="UND",odersymbol="ODER",zuweisungssymbol="->",kleinersymbol="<",kleinergleichsymbol="<=",groessersymbol=">",groessergleichsymbol=">=",gleichsymbol="=",ungleichsymbol="<>",plussymbol="+",minussymbol="-",divisionssymbol="/",multiplikationssymbol="*",speziellespotenzsymbol="^",allgemeinespotenzsymbol="**",strichsymbol="'",klammeraufsymbol="(",klammerzusymbol=")",doppelpunktsymbol=":",dezimalpunktsymbol=".",esymbol="e",pisymbol="pi",betragssymbol="abs",signumsymbol="sign",gaussklammersymbol="gauss",rundsymbol="rund",intsymbol="ganz",fracsymbol="frak",funktionsklammeraufsymbol="[",funktionsklammerzusymbol="]",punktsymbol=".",kommasymbol=",",verkettungssymbol="O",differenziersymbol="D",selektionssymbol="S",bruchsymbol="/",unsichtbareklammerauf=" (: ",unsichtbareklammerzu=" :) ",selektionsklammeraufsymbol=" {{ ",selektionsklammerzusymbol=" }} ",selektionsfuersymbol=" :: ",selektionselifsymbol=" ;; ",funktionsauswertungssymbol=" A ",diffklammeraufsymbol=" D: ",diffklammerzusymbol=" :D ",bezeichnertyp=1,konstantentyp=3,begrenzertyp=6,defaultfuerkomponentenindex=1,defaultfuervariablenindex=1,defaultstdfktvarname="x";TEXT VARsymbol,symbolspeicher,aktuellerabbildungsname;INT VARsymboltyp,speichertyp;LISTE VARlistedervariablen,listederterme;TERM VARknoten;BOOL VAReliferwartet:=FALSE;ABBILDUNG PROCneuefunktion(TEXT CONSTfunktionsstring):enablestop;TEXT VARfehlzeichen:=niltext;IFfunktionsstring=niltextTHENerrorstop(anwendungstext(58))ELIFfehlerhaftebuchstabenvorhanden(funktionsstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;listedervariablen:=neueliste(nil,nil);listederterme:=neueliste(nil,nil);aktuellerabbildungsname:=niltext;knoten:=nil;IFebene=1THENparseeinfachefunktion(funktionsstring)ELSEsymbolspeicher:=niltext;speichertyp:=0;parsekomplexefunktion(funktionsstring)END IF END PROCneuefunktion;ABBILDUNG PROCparseeinfachefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;verarbeitenderlinkenhaelfte;verarbeitezuweisungssymbol;verarbeitendesfunktionsterms;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nextsymbol(symbol,symboltyp).verarbeitenderlinkenhaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nextsymbol(symbol,symboltyp);testegueltigkeit;anhaengen(listedervariablen,newvariable(1,symbol));nextsymbol(symbol,symboltyp).verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nextsymbol(symbol,symboltyp);IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitendesfunktionsterms:nextsymbol(symbol,symboltyp);IFsymboltyp>6THENerrorstop(anwendungstext(33))ELIFsymbol=ifsymbolTHENeliferwartet:=FALSE;nextsymbol(symbol,symboltyp);abschnittweisedefinierteeinfachefunktion(listederterme)ELSEeinfacherausdruck(listederterme)END IF;IFsymboltyp<7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparseeinfachefunktion;PROCabschnittweisedefinierteeinfachefunktion(LISTE VARtermliste):knoten:=naechsteeinfacheklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;anhaengen(termliste,newterm(knoten));IFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nextsymbol(symbol,symboltyp)END PROCabschnittweisedefinierteeinfachefunktion;TERM PROCnaechsteeinfacheklausel:TERM VARthenzeiger,bedingungszeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nextsymbol(symbol,symboltyp);ELSEeliferwartet:=TRUE END IF;einfacherarithmetischerausdruck;thenzeiger:=knoten; +IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nextsymbol(symbol,symboltyp);einfachebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechsteeinfacheklausel)END IF END PROCnaechsteeinfacheklausel;PROCeinfachebedingung:TEXT VARoperator;TERM VARlinkszeiger;einfacheslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacheslogischeselement;knoten:=newlogischedyade(linkszeiger,knoten,operator)END REP END PROCeinfachebedingung;PROCeinfacheslogischeselement:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfachebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitevergleich:einfacherarithmetischerausdruck;IF(symbol<>kleinersymbol)CAND(symbol<>kleinergleichsymbol)CAND(symbol<>groessersymbol)CAND(symbol<>groessergleichsymbol)CAND(symbol<>ungleichsymbol)CAND(symbol<>gleichsymbol)THENerrorstop(anwendungstext(40))END IF;operator:=symbol;linkszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;knoten:=newvergleich(linkszeiger,knoten,operator)END PROCeinfacheslogischeselement;PROCeinfacherausdruck(LISTE VARtermliste):einfacherarithmetischerausdruck;anhaengen(termliste,newterm(knoten))END PROCeinfacherausdruck;PROCeinfacherarithmetischerausdruck:TEXT VARoperator;TERM VARlinkszeiger;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newmonade(knoten,operator)ELSEeinfachertermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherterm;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherarithmetischerausdruck;PROCeinfacherterm:TEXT VARoperator;TERM VARlinkszeiger;einfacherfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinkszeiger:=knoten;operator:=symbol;nextsymbol(symbol,symboltyp);einfacherfaktor;knoten:=newdyade(linkszeiger,knoten,operator)END REP END PROCeinfacherterm;PROCeinfacherfaktor:TERM VARbasiszeiger;TEXT VARpotenzsymbol;einfacheselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasiszeiger:=knoten;nextsymbol(symbol,symboltyp);einfacheselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basiszeiger,knoten,potenzsymbol)END REP END PROCeinfacherfaktor;PROCeinfacheselement:TERM VARobjektzeiger;LISTE VARlistederargumente;IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFsymboltyp=bezeichnertypTHENverarbeitebezeichnerELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nextsymbol(symbol,symboltyp).verarbeitegeklammertenausdruck:nextsymbol(symbol,symboltyp);einfacherarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp).verarbeitebezeichner:IFsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFelementarefunktionTHENverarbeiteabbildungsausdruckELSEverarbeitevariableEND IF.elementarefunktion:objektzeiger:=listenposition(standardfunktionen,symbol);objektzeiger<>nil.verarbeiteabbildungsausdruck:TEXT VARfunktionsname:=symbol;nextsymbol(symbol,symboltyp);IFsymbol=strichsymbolCAND(funktionsname=betragssymbolCORfunktionsname=signumsymbolCORfunktionsname=gaussklammersymbolCORfunktionsname=rundsymbolCORfunktionsname=intsymbolCORfunktionsname=fracsymbol)THENerrorstop(anwendungstext(56))END IF;WHILEsymbol=strichsymbolREPobjektzeiger:=newableitungsoperation(objektzeiger,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nextsymbol(symbol,symboltyp)END REP;knoten:=newfunktionsauswertung( +objektzeiger,argumentzeiger,defaultfuerkomponentenindex).argumentzeiger:IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;nextsymbol(symbol,symboltyp);listederargumente:=neueliste(nil,nil);einfacherausdruck(listederargumente);IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nextsymbol(symbol,symboltyp);newtermliste(listenanfang(listederargumente),listenende(listederargumente),1).verarbeitevariable:knoten:=listenposition(listedervariablen,symbol);IFknoten=nilTHENknoten:=alphasort(listedervariablen,symbol)END IF;nextsymbol(symbol,symboltyp)END PROCeinfacheselement;ABBILDUNG PROCparsekomplexefunktion(TEXT CONSTfunktionsstring):initialisieredenscanvorgang;linkehaelfte;verarbeitezuweisungssymbol;verarbeitenderfunktionsterme;eintragenderfunktion;abbildung(aktuellerabbildungsname).initialisieredenscanvorgang:scan(funktionsstring);nimmsymbol.linkehaelfte:testegueltigkeit;IFlistenposition(eigenefunktionen,symbol)<>nilTHENerrorstop(hinweisaufungueltigennamen)END IF;aktuellerabbildungsname:=symbol;nimmsymbol;IFsymbol<>doppelpunktsymbolTHENerrorstop(anwendungstext(15))END IF;nimmsymbol;variablenliste.verarbeitezuweisungssymbol:IFsymbol<>minussymbolTHENerrorstop(anwendungstext(32))END IF;nimmsymbol;IFsymbol<>groessersymbolTHENerrorstop(anwendungstext(32))END IF.verarbeitenderfunktionsterme:komplexeausdruecke(listederterme);IFsymboltyp<>7THENerrorstop(hinweisauffehlerhaftessymbol)END IF END PROCparsekomplexefunktion;PROCvariablenliste:testegueltigkeit;WHILEsymboltyp=bezeichnertypREPanhaengen(listedervariablen,newvariable(laenge(listedervariablen)+1,symbol));nimmsymbol;IFsymbol=kommasymbolTHENnimmsymbol;testegueltigkeitEND IF END REP END PROCvariablenliste;PROCkomplexeausdruecke(LISTE VARtermliste):REPnimmsymbol;IFsymbol=ifsymbolTHENeliferwartet:=FALSE;nimmsymbol;abschnittweisedefinierterkomplexertermELSEkomplexerarithmetischerausdruckEND IF;anhaengen(termliste,newterm(knoten))UNTILsymbol<>kommasymbolEND REP END PROCkomplexeausdruecke;PROCabschnittweisedefinierterkomplexerterm:knoten:=naechstekomplexeklausel;IFknoten=nilTHENerrorstop(hinweisauffehlerhaftessymbol)ELIFsymbol<>endifsymbolTHENerrorstop(anwendungstext(39))END IF;nimmsymbolEND PROCabschnittweisedefinierterkomplexerterm;TERM PROCnaechstekomplexeklausel:TERM VARbedingungszeiger,thenzeiger;IFsymbol=endifsymbolTHENnilELSE IFeliferwartetTHEN IFsymbol<>elifsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEeliferwartet:=TRUE END IF;komplexerarithmetischerausdruck;thenzeiger:=knoten;IFsymbol<>fuersymbolTHENerrorstop(anwendungstext(38))END IF;nimmsymbol;komplexebedingung;bedingungszeiger:=knoten;newselektion(bedingungszeiger,thenzeiger,naechstekomplexeklausel)END IF END PROCnaechstekomplexeklausel;PROCkomplexebedingung:TEXT VARoperator;TERM VARlinks;komplexeslogischeselement;WHILEsymbol=undsymbolCORsymbol=odersymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexeslogischeselement;knoten:=newlogischedyade(links,knoten,operator)END REP END PROCkomplexebedingung;PROCkomplexeslogischeselement:IFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELSEverarbeitevergleichEND IF.verarbeitegeklammertenausdruck:nimmsymbol;komplexebedingung;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.verarbeitevergleich:TERM VARlinks;TEXT VARoperator;komplexerarithmetischerausdruck;IFsymbol<>kleinersymbolCANDsymbol<>kleinergleichsymbolCANDsymbol<>groessersymbolCANDsymbol<>groessergleichsymbolCANDsymbol<>ungleichsymbolCANDsymbol<>gleichsymbolTHENerrorstop(anwendungstext(40))END IF;operator:=symbol;links:=knoten;nimmsymbol;komplexerarithmetischerausdruck;knoten:=newvergleich(links,knoten,operator).END PROCkomplexeslogischeselement;PROCkomplexerarithmetischerausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;komplexerterm;knoten:=newmonade(knoten,operator)ELSEkomplexerterm;END IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol; +komplexerterm;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerarithmetischerausdruck;PROCkomplexerterm:TEXT VARoperator;TERM VARlinks;komplexerfaktor;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;komplexerfaktor;knoten:=newdyade(links,knoten,operator)END REP END PROCkomplexerterm;PROCkomplexerfaktor:TERM VARbasis;TEXT VARpotenzsymbol;komplexeselement;WHILEsymbol=allgemeinespotenzsymbolCORsymbol=speziellespotenzsymbolREPbasis:=knoten;nimmsymbol;komplexeselement;IFganzzahligerexponentTHENpotenzsymbol:=speziellespotenzsymbolELSEpotenzsymbol:=allgemeinespotenzsymbolEND IF;knoten:=newdyade(basis,knoten,potenzsymbol)END REP END PROCkomplexerfaktor;PROCkomplexeselement:IFsymboltyp=konstantentypCORsymbol=esymbolCORsymbol=pisymbolTHENverarbeitekonstanteELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFvariablenbezeichnerTHENverarbeitevariablenbezeichnerELSEverarbeitefunktionsauswertungEND IF.verarbeitekonstante:knoten:=newkonstante(wert,symbol);nimmsymbol.verarbeitegeklammertenausdruck:nimmsymbol;komplexerarithmetischerausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbol.variablenbezeichner:symboltyp=bezeichnertypCANDbezeichnerfuervariable.bezeichnerfuervariable:knoten:=listenposition(listedervariablen,symbol);knoten<>nil.verarbeitevariablenbezeichner:nimmsymbol.verarbeitefunktionsauswertung:INT VARtermzahl,variablenzahl,komponentenindex;TERM VARausdruckzeiger;abbildungsobjekt(termzahl,variablenzahl);ausdruckzeiger:=knoten;komponentenindex:=komponente(termzahl);argumentliste(variablenzahl);knoten:=newfunktionsauswertung(ausdruckzeiger,knoten,komponentenindex)END PROCkomplexeselement;BOOL VARelementeinerfunktionsverknuepfunggefunden;TEXT VARerlaubtervariablenname;PROCabbildungsobjekt(INT VARanzahlterme,anzahlvariablen):IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;IFanzahlterme=1CANDanzahlvariablen=1THENeinfachesableitungsformatEND IF ELIFsymbol=funktionsklammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHENverarbeiteallgemeinesableitungsformatELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:IFelementarefunktionCORselbstdefiniertefunktionTHENverarbeiteabbildungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFknoten<>nilCANDselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeiteabbildung:anzahlterme:=termanzahl(knoten);anzahlvariablen:=variablenanzahl(knoten);nimmsymbol.verarbeitegeklammertenausdruck:elementeinerfunktionsverknuepfunggefunden:=FALSE;nimmsymbol;abbildungsausdruck;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(anwendungstext(35))END IF;anzahlterme:=1;anzahlvariablen:=1;nimmsymbol.verarbeiteallgemeinesableitungsformat:allgemeinesableitungsformat(anzahlvariablen);anzahlterme:=1.END PROCabbildungsobjekt;PROCeinfachesableitungsformat:WHILEsymbol=strichsymbolREP IFableitungsverbot(knoten)THENerrorstop(anwendungstext(56))END IF;knoten:=newableitungsoperation(knoten,defaultfuervariablenindex,defaultfuerkomponentenindex,strichsymbol);nimmsymbolEND REP END PROCeinfachesableitungsformat;PROCallgemeinesableitungsformat(INT VARvariablenzahl):INT VARableitungsgrad,komponentenindex,termzahl;ABBILDUNG VARvergleichsabbildung;bestimmeableitungsgrad;bestimmeobjektderableitungsoperation;überlesebruchsymbol;bestimmevariablenundallokiereableitungspointer.bestimmeableitungsgrad:nimmsymbol;IFsymboltyp=konstantentypTHEN IFpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(47))END IF;ableitungsgrad:=int(symbol);IFableitungsgrad<1THENerrorstop(anwendungstext(47))END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitungsoperation:abbildungsobjekt(termzahl,variablenzahl);IFableitungsverbot(knoten)THEN +errorstop(anwendungstext(56))END IF;vergleichsabbildung:=vergleichsfunktion(knoten);komponentenindex:=komponente(termzahl).überlesebruchsymbol:IFsymbol<>bruchsymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol.bestimmevariablenundallokiereableitungspointer:INT VARzaehler,variablenindex;FORzaehlerFROM1UPTOableitungsgradREPbestimmeabzuleitendevariable;trageableitungein;nimmsymbolEND REP;loeschetemporaereabbildung(vergleichsabbildung).bestimmeabzuleitendevariable:TERM VARvergleichszeiger;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(44))END IF;nimmsymbol;vergleichszeiger:=listenposition(abbildungsvariablen(vergleichsabbildung),symbol);IFvergleichszeiger=nilTHENerrorstop(hinweisaufungueltigennamen)END IF;variablenindex:=PLATZvergleichszeiger.trageableitungein:TERM VARpruefterm;IFknotenISeigenefunktionTHENpruefterm:=(TERME DEFINITIONknoten)ELEMENTkomponentenindexELSEpruefterm:=knotenEND IF;knoten:=newableitungsoperation(knoten,variablenindex,komponentenindex,differenziersymbol).END PROCallgemeinesableitungsformat;PROCabbildungsausdruck:TEXT VARoperator;TERM VARlinks;IFsymbol=plussymbolCORsymbol=minussymbolTHENoperator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsmonade(knoten,operator)ELSEabbildungstermEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsterm;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsausdruck;PROCabbildungsterm:TEXT VARoperator;TERM VARlinks;abbildungsverkettung;WHILE(symbol=multiplikationssymbol)COR(symbol=divisionssymbol)REPlinks:=knoten;operator:=symbol;nimmsymbol;abbildungsverkettung;knoten:=newabbildungsdyade(links,knoten,operator)END REP END PROCabbildungsterm;PROCabbildungsverkettung:TERM VARlinks;abbildungselement;WHILEsymbol=verkettungssymbolREPlinks:=knoten;nimmsymbol;abbildungselement;knoten:=newabbildungsdyade(links,knoten,verkettungssymbol)END REP END PROCabbildungsverkettung;PROCabbildungselement:IFsymboltyp=bezeichnertypTHENverarbeitebezeichner;einfachesableitungsformatELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruck;einfachesableitungsformatELIFsymbol=differenziersymbolTHEN INT VARanzahlvariablen:=1;allgemeinesableitungsformat(anzahlvariablen)ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF.verarbeitebezeichner:TEXT VARneuervariablenname;IFelementarefunktionTHEN IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=defaultstdfktvarname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFerlaubtervariablenname<>defaultstdfktvarnameTHENerrorstop(anwendungstext(45))END IF ELIFselbstdefiniertefunktionTHEN IF(termanzahl(knoten)<>1)COR(variablenanzahl(knoten)<>1)THENerrorstop(anwendungstext(45))ELIFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;neuervariablenname:=NAMElistenanfang(abbildungsvariablen(abbildung(symbol)));IF NOTelementeinerfunktionsverknuepfunggefundenTHENerlaubtervariablenname:=neuervariablenname;elementeinerfunktionsverknuepfunggefunden:=TRUE ELIFneuervariablenname<>erlaubtervariablennameTHENerrorstop(anwendungstext(45))END IF ELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol.elementarefunktion:knoten:=listenposition(standardfunktionen,symbol);knoten<>nil.selbstdefiniertefunktion:knoten:=listenposition(eigenefunktionen,symbol);IFselektionshaltigetermliste(LISTENANFANG TERME DEFINITIONknoten)THENerrorstop(anwendungstext(188))END IF;knoten<>nil.verarbeitegeklammertenausdruck:nimmsymbol;abbildungsausdruck;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))END IF;nimmsymbolEND PROCabbildungselement;INT PROCkomponente(INT CONSTtermzahl):INT VARkompwert:=defaultfuerkomponentenindex;IFtermzahl>1THEN IFsymbol<>selektionssymbolTHENerrorstop(anwendungstext(42))END IF;nimmsymbol;IFsymboltyp<>konstantentypCORpos(symbol,dezimalpunktsymbol)<>0THENerrorstop(anwendungstext(42))END IF;kompwert:=int(symbol);IFkompwert>termzahlCORkompwert<1THENerrorstop(anwendungstext(42))END IF;nimmsymbol +END IF;kompwertEND PROCkomponente;PROCargumentliste(INT CONSTnotwendigeargumentanzahl):LISTE VARlistederargumente;IFsymbol<>klammeraufsymbolTHENerrorstop(anwendungstext(37))END IF;listederargumente:=neueliste(nil,nil);REPnimmsymbol;komplexerarithmetischerausdruck;anhaengen(listederargumente,newterm(knoten))UNTILsymbol<>kommasymbolEND REP;IFsymbol<>klammerzusymbolTHENerrorstop(anwendungstext(35))ELIFlaenge(listederargumente)<>notwendigeargumentanzahlTHENerrorstop(anwendungstext(46))END IF;nimmsymbol;knoten:=newtermliste(listenanfang(listederargumente),listenende(listederargumente),laenge(listederargumente))END PROCargumentliste;BOOL PROCganzzahligerexponent:REAL VARhilfswert;IF(knotenISkonstante)COR((knotenISmonadisch)CAND(OPERANDknotenISkonstante))THEN IFknotenISkonstanteTHENhilfswert:=WERTknotenELSEhilfswert:=WERT OPERANDknotenEND IF;IFhilfswert>32767.0CORhilfswert<-32768.0THEN FALSE ELSEhilfswert=floor(hilfswert)END IF ELSE FALSE END IF END PROCganzzahligerexponent;PROCtestegueltigkeit:IFsymboltyp<>bezeichnertypCORlistenposition(standardfunktionen,symbol)<>nilCORsymbol=esymbolCORsymbol=pisymbolCORsymbol=aktuellerabbildungsnameTHENerrorstop(hinweisaufungueltigennamen)ELIFebene=2CAND(listenposition(listedervariablen,symbol)<>nil)THENerrorstop(anwendungstext(41))END IF END PROCtestegueltigkeit;REAL PROCwert:IFsymbol=esymbolTHENeELIFsymbol=pisymbolTHENpiELSEreal(symbol)END IF END PROCwert;PROCeintragenderfunktion:anhaengenaneigenefunktionen(neweigenefunktion(newfunktionsdefinition(newvariablenliste(listenanfang(listedervariablen),listenende(listedervariablen),laenge(listedervariablen)),newtermliste(listenanfang(listederterme),listenende(listederterme),laenge(listederterme))),aktuellerabbildungsname))END PROCeintragenderfunktion;ABBILDUNG PROCfunktionsaufruf(TEXT CONSTaufrufstring):TEXT VARfehlzeichen:=niltext;ABBILDUNG VARarbeitsobjekt;enablestop;scan(aufrufstring);symbolspeicher:=niltext;nimmsymbol;IFsymbol=niltextTHENerrorstop(anwendungstext(33))ELIFfehlerhaftebuchstabenvorhanden(aufrufstring,fehlzeichen)THENerrorstop(anwendungstext(170)+fehlzeichen)END IF;arbeitsobjekt:=funktionsterm;IFsymbol<>niltextTHENloeschetemporaereabbildung(arbeitsobjekt);errorstop(hinweisauffehlerhaftessymbol)END IF;arbeitsobjektEND PROCfunktionsaufruf;ABBILDUNG PROCfunktionsterm:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result;IFsymbol=plussymbolTHENnimmsymbol;result:=funktionsfaktorELIFsymbol=minussymbolTHENnimmsymbol;result:=-funktionsfaktorELSEresult:=funktionsfaktorEND IF;WHILEsymbol=plussymbolCORsymbol=minussymbolREPlinks:=result;operator:=symbol;nimmsymbol;rechts:=funktionsfaktor;IF NOTvariablenidentitaet(links,rechts)CORlaenge(abbildungsterme(links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=plussymbolTHENresult:=links+rechtsELSEresult:=links-rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsterm;ABBILDUNG PROCfunktionsfaktor:TEXT VARoperator;ABBILDUNG VARlinks,rechts,result:=funktionsverkettung;WHILEsymbol=multiplikationssymbolCORsymbol=divisionssymbolREPoperator:=symbol;links:=result;nimmsymbol;rechts:=funktionsverkettung;IF NOTvariablenidentitaet(links,rechts)COR(laenge(abbildungsterme(rechts))<>laenge(abbildungsterme(links)))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;IFoperator=multiplikationssymbolTHENresult:=links*rechtsELSE IFebene=2CANDlaenge(abbildungsterme(links))<>1THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=links/rechtsEND IF;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsfaktor;ABBILDUNG PROCfunktionsverkettung:ABBILDUNG VARlinks,rechts,result:=funktionselement;WHILEsymbol=verkettungssymbolREPlinks:=result;nimmsymbol;rechts:=funktionselement;IFlaenge(abbildungsvariablen( +links))<>laenge(abbildungsterme(rechts))THENloeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts);errorstop(anwendungstext(45))END IF;result:=linksOrechts;loeschetemporaereabbildung(links);loeschetemporaereabbildung(rechts)END REP;resultEND PROCfunktionsverkettung;ABBILDUNG PROCfunktionselement:ABBILDUNG VARelement;IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENverarbeitebezeichnerELIFsymbol=klammeraufsymbolTHENverarbeitegeklammertenausdruckELIFebene=2CANDsymbol=differenziersymbolTHENelement:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;element.verarbeitebezeichner:element:=abbildung(symbol);IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF.verarbeitegeklammertenausdruck:nimmsymbol;element:=funktionsterm;IFsymbol<>klammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFebene=1COR(laenge(abbildungsterme(element))=1CANDlaenge(abbildungsvariablen(element))=1CAND NOTableitungsverbot(adresse(element)))THENelement:=einfachefunktionsableitung(element)ELSEnimmsymbolEND IF END PROCfunktionselement;ABBILDUNG PROCeinfachefunktionsableitung(ABBILDUNG VARelement):ABBILDUNG VARobjekt;nimmsymbol;WHILEsymbol=strichsymbolREPobjekt:=element;element:=ableitung(objekt,1,1);loeschetemporaereabbildung(objekt);nimmsymbolEND REP;elementEND PROCeinfachefunktionsableitung;ABBILDUNG PROCkomplexefunktionsableitung:ABBILDUNG VARelement,objekt;INT VARableitungsgrad,komponentenindex,variablenindex,i;bestimmeableitungsgrad;bestimmeobjektderableitung;leiteab;element.bestimmeableitungsgrad:nimmsymbol;IFpos(symbol,punktsymbol)<>0THENerrorstop(hinweisauffehlerhaftessymbol)ENDIF;ableitungsgrad:=int(symbol);IFlastconversionokTHEN IFableitungsgrad<1THENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEableitungsgrad:=1END IF.bestimmeobjektderableitung:IF(listenposition(standardfunktionen,symbol)<>nil)COR(listenposition(eigenefunktionen,symbol)<>nil)THENobjekt:=abbildung(symbol);IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=funktionsklammeraufsymbolTHENnimmsymbol;objekt:=funktionsterm;IFsymbol<>funktionsklammerzusymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsvariablen(objekt))=1CANDlaenge(abbildungsterme(objekt))=1CAND NOTableitungsverbot(adresse(objekt))THENobjekt:=einfachefunktionsableitung(objekt)ELSEnimmsymbolEND IF ELIFsymbol=differenziersymbolTHENobjekt:=komplexefunktionsableitungELSEerrorstop(hinweisauffehlerhaftessymbol)END IF;IFlaenge(abbildungsterme(objekt))>1THEN IFsymbol<>selektionssymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;komponentenindex:=int(symbol);IF NOTlastconversionokTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbolELSEkomponentenindex:=1END IF;IFableitungsverbot(adresse(objekt))THENerrorstop(anwendungstext(56))END IF.leiteab:TERM VARsuchterm;INT VARtempkompindex:=komponentenindex;IFsymbol<>bruchsymbolTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;nimmsymbol;FORiFROM1UPTOableitungsgradREP IFi>1THENtempkompindex:=1END IF;IFsymbol<>differenziersymbolTHENerrorstop(anwendungstext(43))END IF;nimmsymbol;suchterm:=listenposition(abbildungsvariablen(objekt),symbol);IFsuchterm=nilTHENerrorstop(hinweisauffehlerhaftessymbol)END IF;variablenindex:=PLATZsuchterm;element:=ableitung(objekt,tempkompindex,variablenindex);loeschetemporaereabbildung(objekt);objekt:=element;nimmsymbolEND REP END PROCkomplexefunktionsableitung;PROCnimmsymbol:TEXT VARsym1,sym2;INT VARtyp1,typ2;besorgedaserstesymbol;besorgegegebenenfallseinzweitessymbol;reichesymbolundtypnachaussen.besorgedaserstesymbol:IFspeichergefuelltTHENverarbeitespeicher;loeschespeicherELSEnextsymbol(sym1,typ1);END IF. +speichergefuellt:symbolspeicher<>niltext.verarbeitespeicher:sym1:=symbolspeicher;typ1:=speichertyp.loeschespeicher:symbolspeicher:=niltext;speichertyp:=0.besorgegegebenenfallseinzweitessymbol:IFsym1=klammeraufsymbolTHENnextsymbol(sym2,typ2);IFsym2=punktsymbolTHENsym1:=funktionsklammeraufsymbol;typ1:=begrenzertypELSEfuellespeicherEND IF ELIFsym1=punktsymbolTHENnextsymbol(sym2,typ2);IFsym2=klammerzusymbolTHENsym1:=funktionsklammerzusymbol;typ1:=begrenzertypELSEfuellespeicherEND IF END IF.fuellespeicher:symbolspeicher:=sym2;speichertyp:=typ2.reichesymbolundtypnachaussen:symbol:=sym1;symboltyp:=typ1END PROCnimmsymbol;BOOL PROCfehlerhaftebuchstabenvorhanden(TEXT CONSTt,TEXT VARz):LETanzahlfehler=8;ROWanzahlfehlerTEXT CONSTungueltigezeichen:=ROWanzahlfehlerTEXT:("ä","ö","ü","ß","{","}","(*","*)");INT VARi;z:=niltext;FORiFROM1UPTOanzahlfehlerREP IFpos(t,ungueltigezeichen(i))<>0THENzCATungueltigezeichen(i)END IF END REP;z<>niltextEND PROCfehlerhaftebuchstabenvorhanden;TEXT PROChinweisauffehlerhaftessymbol:anwendungstext(36)+strichsymbol+symbol+strichsymbolEND PROChinweisauffehlerhaftessymbol;TEXT PROChinweisaufungueltigennamen:anwendungstext(31)+strichsymbol+symbol+strichsymbolEND PROChinweisaufungueltigennamen;BOOL VARlinear;FILE VARfktdat;TEXT PROCfunktionsstring(ABBILDUNG CONSTfkt):linear:=TRUE;fktstring(fkt)END PROCfunktionsstring;TEXT PROCformel(ABBILDUNG CONSTfkt):linear:=FALSE;fktstring(fkt)END PROCformel;TEXT PROCfktstring(ABBILDUNG CONSTfunktion):enablestop;pruefeparameter;erstellefunktionsstring;reichetextnachaussen.pruefeparameter:TERM VARsuchterm:=adresse(funktion);IFsuchterm=nilTHENerrorstop(anwendungstext(48))END IF.erstellefunktionsstring:sammletextbestandteileindatei;wandledateiintextum.sammletextbestandteileindatei:TEXT CONSTdatname:=scratchdateiname;fktdat:=sequentialfile(output,datname);disablestop;darstellung(suchterm);IFiserrorTHENclearerror;enablestop;forget(datname,quiet);errorstop(anwendungstext(49))END IF;enablestop.wandledateiintextum:TEXT VARstring:=niltext,zeile;input(fktdat);WHILE NOTeof(fktdat)REPgetline(fktdat,zeile);stringCATzeileEND REP;forget(datname,quiet).reichetextnachaussen:stringEND PROCfktstring;PROCdarstellung(TERM CONSTterm):enablestop;IFtermISeigenefunktionTHENgibfunktionsnamenausEND IF;variablenausgabe;gibzuweisungssymbolaus;gibtermlisteaus.gibfunktionsnamenaus:write(fktdat,NAMEterm);write(fktdat,doppelpunktsymbol).variablenausgabe:giberstevariableaus;IFebene=2THENgibweiterevariablenausEND IF.giberstevariableaus:TERM VARlaufterm:=LISTENANFANG VARIABLEN DEFINITIONterm;write(fktdat,NAMElaufterm).gibweiterevariablenaus:laufterm:=nachfolger(laufterm);WHILElaufterm<>nilREPwrite(fktdat,kommasymbol);write(fktdat,NAMElaufterm);laufterm:=nachfolger(laufterm)END REP.gibzuweisungssymbolaus:put(fktdat,blank+zuweisungssymbol).gibtermlisteaus:ausgabederterme(LISTENANFANG TERME DEFINITIONterm)END PROCdarstellung;PROCausgabederterme(TERM CONSTlaufterm):IFlaufterm<>nilTHENausgabe(AUSDRUCKlaufterm);IFnachfolger(laufterm)<>nilTHENput(fktdat,kommasymbol);ausgabederterme(nachfolger(laufterm))END IF END IF END PROCausgabederterme;PROCausgabe(TERM CONSTterm):TEXT VARoperator;TERM VARoperand;BOOL VARunsichtbareklammernnoetig;IF(termISstandardfunktion)COR(termISeigenefunktion)COR(termISvariable)THENgibnamenausELIFtermISkonstanteTHENgibkonstanteausELIFtermISdyadischTHENgibdyadeausELIFtermISmonadischTHENgibmonadeausELIFtermISfunktionsauswertungTHENgibfunktionsauswertungausELIFtermISableitungsoperationTHENgibableitungsoperationausELIFtermISabbildungsdyadeTHENgibabbildungsdyadeausELIFtermISabbildungsmonadeTHENgibabbildungsmonadeausELIFtermISselektionTHENgibselektionausELIFtermISlogischedyadeTHENgiblogischedyadeausELIFtermISvergleichTHENgibvergleichausELSEerrorstop(anwendungstext(49))END IF.gibnamenaus:write(fktdat,NAMEterm).gibkonstanteaus:REAL VARwert:=WERTterm;IF(NAMEterm=esymbol)COR(NAMEterm=pisymbol)THENwrite(fktdat,NAMEterm)ELIFwert=floor(wert)CANDwert<=32767.0CANDwert>=-32768.0THENwrite(fktdat,text(int(wert)))ELSE +write(fktdat,text(wert))END IF.gibdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCAND(operator=divisionssymbolCORoperator=allgemeinespotenzsymbolCORoperator=speziellespotenzsymbol);IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;IFoperator=allgemeinespotenzsymbolTHENput(fktdat,blank+speziellespotenzsymbol)ELSEput(fktdat,blank+operator)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;operand:=RECHTSterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibfunktionsauswertungaus:operand:=ABBILDUNGSAUSDRUCKterm;IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand)END IF;IF(operandISeigenefunktion)CANDlaenge(abbildungsterme(abbildung(NAMEoperand)))>1THENput(fktdat,selektionssymbol+text(KOMPONENTEterm))END IF;IF NOTlinearTHENwrite(fktdat,funktionsauswertungssymbol)END IF;write(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabederterme(LISTENANFANG ARGUMENTEterm);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol).gibableitungsoperationaus:bestimmeanzahlderableitungen;operator:=OPERATIONterm;IFoperator=strichsymbolTHENgibeinfachesableitungsformatausELSEgibkomplexesableitungsformatausEND IF.bestimmeanzahlderableitungen:INT VARableitungsgrad:=1,komponentenindex:=KOMPONENTEterm;operand:=ABBILDUNGSAUSDRUCKterm;WHILEoperandISableitungsoperationREPkomponentenindex:=KOMPONENTEoperand;operand:=ABBILDUNGSAUSDRUCKoperand;ableitungsgradINCR1END REP.gibeinfachesableitungsformataus:IF(operandISeigenefunktion)COR(operandISstandardfunktion)THENausgabe(operand)ELSEwrite(fktdat,funktionsklammeraufsymbol);ausgabe(operand);write(fktdat,funktionsklammerzusymbol)END IF;write(fktdat,ableitungsgrad*strichsymbol).gibkomplexesableitungsformataus:ABBILDUNG VARvergleichsabbildung;IF NOTlinearTHENwrite(fktdat,unsichtbareklammerauf);write(fktdat,diffklammeraufsymbol)END IF;write(fktdat,differenziersymbol);IFableitungsgrad<>1THENwrite(fktdat,text(ableitungsgrad))END IF;write(fktdat,blank);IF(operandISabbildungsdyade)COR(operandISabbildungsmonade)THENwrite(fktdat,funktionsklammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,funktionsklammerzusymbol)ELSEausgabe(operand);IF NOT((operandISstandardfunktion)COR(laenge(abbildungsterme(abbildung(NAMEoperand)))=1))THENwrite(fktdat,selektionssymbol+text(komponentenindex))END IF END IF;IFlinearTHENwrite(fktdat,bruchsymbol);ELSEwrite(fktdat,unsichtbareklammerzu);write(fktdat,bruchsymbol+blank)END IF;vergleichsabbildung:=vergleichsfunktion(operand);ableitungsvariablenausgabe(term,abbildungsvariablen(vergleichsabbildung));IF NOTlinearTHENwrite(fktdat,diffklammerzusymbol)END IF;loeschetemporaereabbildung(vergleichsabbildung).gibabbildungsdyadeaus:operator:=OPERATIONterm;operand:=LINKSterm;unsichtbareklammernnoetig:=NOTlinearCANDoperator=divisionssymbol; +IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFlinkeklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF;put(fktdat,blank+operator);operand:=RECHTSterm;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerauf)END IF;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF;IFunsichtbareklammernnoetigTHENwrite(fktdat,unsichtbareklammerzu)END IF.gibabbildungsmonadeaus:operator:=OPERATIONterm;write(fktdat,operator);operand:=OPERANDterm;IFrechteklammernnoetig(operand,operator)THENwrite(fktdat,klammeraufsymbol);IF NOTlinearTHENwrite(fktdat,blank)END IF;ausgabe(operand);IF NOTlinearTHENwrite(fktdat,blank)END IF;write(fktdat,klammerzusymbol)ELSEausgabe(operand)END IF.gibselektionaus:IFlinearTHENput(fktdat,ifsymbol);ausgabe(AKTIONterm);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPput(fktdat,blank+elifsymbol);ausgabe(AKTIONoperand);put(fktdat,blank+fuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,blank+endifsymbol)ELSEwrite(fktdat,selektionsklammeraufsymbol);ausgabe(AKTIONterm);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGterm);operand:=ALTERNATIVEterm;WHILEoperand<>nilREPwrite(fktdat,selektionselifsymbol);ausgabe(AKTIONoperand);write(fktdat,selektionsfuersymbol);ausgabe(BEDINGUNGoperand);operand:=ALTERNATIVEoperandEND REP;write(fktdat,selektionsklammerzusymbol)END IF.giblogischedyadeaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);IF(RECHTSterm)ISlogischedyadeTHENwrite(fktdat,klammeraufsymbol);ausgabe(RECHTSterm);write(fktdat,klammerzusymbol)ELSEausgabe(RECHTSterm)END IF.gibvergleichaus:ausgabe(LINKSterm);put(fktdat,blank+OPERATIONterm);ausgabe(RECHTSterm)END PROCausgabe;PROCableitungsvariablenausgabe(TERM CONSTterm,LISTE CONSTvglvariablenliste):IF(ABBILDUNGSAUSDRUCKterm)ISableitungsoperationTHENableitungsvariablenausgabe(ABBILDUNGSAUSDRUCKterm,vglvariablenliste)END IF;write(fktdat,differenziersymbol+NAME(auswahl(vglvariablenliste,INDEXterm)))END PROCableitungsvariablenausgabe;BOOL PROClinkeklammernnoetig(TERM CONSToperand,TEXT CONSToperator):IF NOTlinearCANDoperator=divisionssymbolTHEN FALSE ELSEregel1CORregel2END IF.regel1:((operandISdyadisch)COR(operandISabbildungsdyade))CAND(prioritaet(OPERATIONoperand)<prioritaet(operator)).regel2:((operandISmonadisch)COR(operandISabbildungsmonade))CAND(operator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbol)END PROClinkeklammernnoetig;BOOL PROCrechteklammernnoetig(TERM CONSToperand,TEXT CONSToperator):IF NOTlinearCANDoperator=divisionssymbolTHEN FALSE ELIF NOTlinearCAND(operator=allgemeinespotenzsymbolCORoperator=speziellespotenzsymbol)THEN(operandISdyadisch)CAND((OPERATIONoperand=allgemeinespotenzsymbol)COR(OPERATIONoperand=speziellespotenzsymbol))ELSEregel1CORregel2CORregel3END IF.regel1:(operandISmonadisch)COR(operandISabbildungsmonade).regel2:((operandISdyadisch)COR(operandISabbildungsdyade))CAND(fall1CORfall2CORfall3).fall1:prioritaet(OPERATIONoperand)<prioritaet(operator).fall2:prioritaet(OPERATIONoperand)=prioritaet(operator)CAND(operator=minussymbolCORoperator=divisionssymbolCORoperator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbolCORoperator=verkettungssymbol).fall3:TERM VARt:=LINKSoperand;WHILE(tISdyadisch)COR(tISabbildungsdyade)REPt:=LINKStEND REP;(tISmonadisch)COR(tISabbildungsmonade)COR((tISkonstante)CAND(WERTt<0.0)).regel3:(operandISkonstante)CAND(WERToperand<0.0)END PROCrechteklammernnoetig;INT PROCprioritaet(TEXT CONSToperator):IFoperator=undsymbolCORoperator=odersymbolTHEN4ELIFoperator=verkettungssymbolTHEN3 +ELIFoperator=speziellespotenzsymbolCORoperator=allgemeinespotenzsymbolTHEN2ELIFoperator=multiplikationssymbolCORoperator=divisionssymbolTHEN1ELSE0END IF END PROCprioritaet;PROCgibnamen(ABBILDUNG CONSTf,TEXT VARname):enablestop;testeparameter;fuehreaktionaus.testeparameter:ueberpruefeexistenzderabbildung;ueberpruefesyntaxdesnamens;ueberpruefegueltigkeitdesnamens.ueberpruefeexistenzderabbildung:TERM VAReintrag:=adresse(f);IF NOT(eintragIStemporaerefunktion)THENerrorstop(anwendungstext(59))END IF.ueberpruefesyntaxdesnamens:TEXT VARsymbol;INT VARsymboltyp;changeall(name,blank,niltext);scan(name);nextsymbol(symbol,symboltyp);IFsymboltyp<>bezeichnertypTHENerrorstop(anwendungstext(31))END IF;nextsymbol(symbol);IFsymbol<>niltextTHENerrorstop(anwendungstext(31))END IF.ueberpruefegueltigkeitdesnamens:TEXT VARzk;IFfehlerhaftebuchstabenvorhanden(name,zk)COR(name=esymbol)COR(name=pisymbol)COR(listenposition(standardfunktionen,name)<>nil)THENerrorstop(anwendungstext(31))ELIFlistenposition(abbildungsvariablen(f),name)<>nilTHENerrorstop(anwendungstext(3))ELIFlistenposition(eigenefunktionen,name)<>nilTHENerrorstop(anwendungstext(60))END IF.fuehreaktionaus:anhaengenaneigenefunktionen(neweigenefunktion(DEFINITIONeintrag,name));entfernenaustemporaerenfunktionen(eintrag);LOESCHEeintragEND PROCgibnamen;PROCloescheunreferenzierteabbildung(TEXT CONSTfunktionsname):enablestop;TERM VAReintrag:=listenposition(eigenefunktionen,funktionsname);IFreferenziertefunktion(eintrag)THENerrorstop(NAMEeintrag+anwendungstext(71))END IF;loeschebenannteabbildung(funktionsname)END PROCloescheunreferenzierteabbildung;BOOL PROCreferenziertefunktion(TERM CONSTeintrag):TERM VARlaufterm:=listenanfang(eigenefunktionen);BOOL VARreferenziert:=FALSE;WHILE(laufterm<>nil)CAND NOTreferenziertREP IFlaufterm<>eintragTHENreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag)END IF;laufterm:=nachfolger(laufterm)END REP;IF NOTreferenziertTHENlaufterm:=listenanfang(temporaerefunktionen);WHILE(laufterm<>nil)CAND NOTreferenziertREPreferenziert:=durchsuchteliste(LISTENANFANG TERME DEFINITIONlaufterm,eintrag);laufterm:=nachfolger(laufterm);END REP END IF;referenziertEND PROCreferenziertefunktion;BOOL PROCdurchsuchteliste(TERM CONSTterm,eintrag):durchsuchterterm(AUSDRUCKterm,eintrag)COR((nachfolger(term)<>nil)CANDdurchsuchteliste(nachfolger(term),eintrag))END PROCdurchsuchteliste;BOOL PROCdurchsuchterterm(TERM CONSTterm,eintrag):IFtermISeigenefunktionTHENterm=eintragELIF(termISdyadisch)COR(termISlogischedyade)COR(termISvergleich)COR(termISabbildungsdyade)THENdurchsuchterterm(LINKSterm,eintrag)CORdurchsuchterterm(RECHTSterm,eintrag)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENdurchsuchterterm(OPERANDterm,eintrag)ELIFtermISfunktionsauswertungTHEN((ABBILDUNGSAUSDRUCKterm)=eintrag)CORdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)CORdurchsuchteliste(LISTENANFANG ARGUMENTEterm,eintrag)ELIFtermISableitungsoperationTHENdurchsuchterterm(ABBILDUNGSAUSDRUCKterm,eintrag)ELIFtermISselektionTHENdurchsuchterterm(BEDINGUNGterm,eintrag)CORdurchsuchterterm(AKTIONterm,eintrag)CORdurchsuchterterm(ALTERNATIVEterm,eintrag)ELSE FALSE END IF END PROCdurchsuchterterm;THESAURUS PROCfunktionsnamenthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(eigenefunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCfunktionsnamenthesaurus;THESAURUS PROCstandardfunktionsthesaurus:THESAURUS VARthes:=emptythesaurus;TERM VARfunktion:=listenanfang(standardfunktionen);WHILEfunktion<>nilREPinsert(thes,NAMEfunktion);funktion:=nachfolger(funktion)END REP;thesEND PROCstandardfunktionsthesaurus;END PACKETparser + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.picture b/app/schulis-mathematiksystem/1.0/src/mat.picture new file mode 100644 index 0000000..e6af50f --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.picture @@ -0,0 +1,2 @@ +PACKETpictureDEFINES PICTURE,:=,nilpicture,move,draw,length,pen,plot,cmfaktor:LETdrawkey=1,movekey=2,textkey=3,max2dim=31983,maxtext=31974;TYPE PICTURE=STRUCT(INTpen,TEXTpoints);INT VARreadpos;REAL VARfak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;PICTURE PROCnilpicture:PICTURE:(1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCdraw(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright):write(p,t,angle,height,bright,textkey)END PROCdraw;PROCwrite(PICTURE VARp,TEXT CONSTt,REAL CONSTangle,height,bright,INT CONSTkey):IFmaxtext-length(p.points)>=length(t)THENp.pointsCATcode(key);replace(i1,1,length(t));p.pointsCATi1;p.pointsCATt;replace(r3,1,angle);replace(r3,2,height);replace(r3,3,bright);p.pointsCATr3FI END PROCwrite;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTkey):IFlength(p.points)<max2dimTHENp.pointsCATcode(key);replace(r2,1,x);replace(r2,2,y);p.pointsCATr2ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCpen(PICTURE VARp,INT CONSTpen):IFpen<0ORpen>16THENerrorstop("pen out of range [0-16]")END IF;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;PROCplot(PICTURE CONSTp):INT CONSTpiclength:=length(p.points);readpos:=0;plottwodimpic.plottwodimpic:WHILEreadpos<piclengthREPplottwodimpositionPER.plottwodimposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:draw(nextreal,nextreal)CASEmovekey:move(nextreal,nextreal)CASEtextkey:draw(nexttext,nextreal,fak*nextreal,fak*nextreal)OTHERWISEerrorstop("wrong key code")END SELECT.nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nexttext:INT CONSTtextlength:=nextint;readposINCRtextlength;subtext(p.points,readpos-textlength+1,readpos).nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1END PROCplot;PROCcmfaktor(REAL CONSTn):fak:=nEND PROCcmfaktor;END PACKETpicture + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte b/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte new file mode 100644 index 0000000..1a12aed --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.referenzobjekte @@ -0,0 +1,8 @@ +PACKETreferenzobjekteDEFINES TERM,LISTE,=,<>,:=,nil,lowlevel,highlevel,ebene,initialisieren,neueliste,anhaengen,nachfolger,listenanfang,listenende,laenge,auswahl,standardfunktionen,eigenefunktionen,temporaerefunktionen,listenposition,termanzahl,variablenanzahl,anhaengenaneigenefunktionen,anhaengenantemporaerefunktionen,entfernenauseigenenfunktionen,entfernenaustemporaerenfunktionen,alphasort,variablenidentitaet,standardfunktion,eigenefunktion,temporaerefunktion,funktionsdefinition,variablenliste,variable,termliste,ausdruck,dyadisch,monadisch,funktionsauswertung,abbildungsdyade,abbildungsmonade,ableitungsoperation,konstante,selektion,logischedyade,vergleich,neweigenefunktion,newtemporaerefunktion,newfunktionsdefinition,newvariablenliste,newvariable,newtermliste,newterm,newdyade,newmonade,newfunktionsauswertung,newabbildungsdyade,newabbildungsmonade,newableitungsoperation,newkonstante,newselektion,newlogischedyade,newvergleich,LOESCHE,IS,LINKS,RECHTS,OPERAND,WERT,OPERATION,NAME,ARGUMENTE,DEFINITION,TERME,VARIABLEN,PLATZ,LISTENANFANG,LISTENENDE,LAENGE,ELEMENT,ABBILDUNGSAUSDRUCK,KOMPONENTE,INDEX,AUSDRUCK,BEDINGUNG,AKTION,ALTERNATIVE:LETtabellengroesse=16000,OBJEKTTABELLE=STRUCT(TERMzeigerauffreientabellenplatz,LISTElistederstandardfunktionen,listeeigenerfunktionen,listetemporaererfunktionen,dummyROWtabellengroesseTEXTzeile);TYPE TERM=INT,LISTE=STRUCT(TERManfang,ende,INTlaenge),ART=INT;TERM CONSTwurzel:=TERM:(tabellengroesse),nil:=TERM:(0);ART CONSTstandardfunktion:=ART:(1),eigenefunktion:=ART:(2),temporaerefunktion:=ART:(3),funktionsdefinition:=ART:(4),variablenliste:=ART:(5),variable:=ART:(6),termliste:=ART:(7),ausdruck:=ART:(8),dyadisch:=ART:(9),monadisch:=ART:(10),funktionsauswertung:=ART:(11),abbildungsdyade:=ART:(12),abbildungsmonade:=ART:(13),ableitungsoperation:=ART:(14),konstante:=ART:(15),selektion:=ART:(16),logischedyade:=ART:(17),vergleich:=ART:(18);BOUND OBJEKTTABELLE VARtabelle;TEXT VARdatenraumname:="mathematikobjekte 1";TEXT CONSTtextvonnil:=textvon(nil);OP:=(TERM VARlinks,TERM CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;BOOL OP=(TERM CONSTlinks,rechts):CONCR(links)=CONCR(rechts)END OP=;BOOL OP<>(TERM CONSTlinks,rechts):CONCR(links)<>CONCR(rechts)END OP<>;OP:=(LISTE VARlinks,LISTE CONSTrechts):links.anfang:=rechts.anfang;links.ende:=rechts.ende;links.laenge:=rechts.laengeEND OP:=;TERM PROClistenanfang(LISTE CONSTliste):liste.anfangEND PROClistenanfang;TERM PROClistenende(LISTE CONSTliste):liste.endeEND PROClistenende;INT PROClaenge(LISTE CONSTliste):liste.laengeEND PROClaenge;LISTE PROCneueliste(TERM CONSTanfang,ende):LISTE VARliste;initialisierediezeiger;bestimmelistenlaenge;liste.initialisierediezeiger:liste.anfang:=anfang;liste.ende:=ende.bestimmelistenlaenge:TERM VARzeiger:=liste.anfang;liste.laenge:=0;WHILEzeiger<>nilREPliste.laengeINCR1;zeiger:=nachfolger(zeiger)END REP END PROCneueliste;PROCanhaengen(LISTE VARliste,TERM CONSTneueselement):IFneueselement=nilTHENerrorstop(anwendungstext(1))END IF;IFleerelisteTHENliste.anfang:=neueselementELSEliste.endeZEIGTAUFneueselementEND IF;liste.ende:=neueselement;neueselementZEIGTAUFnil;liste.laengeINCR1.leereliste:liste.laenge=0END PROCanhaengen;PROCentfernen(LISTE VARliste,TERM CONSTloeschelement):IF(loeschelement=nil)CORleerelisteTHENerrorstop(anwendungstext(1))ELIFloeschelement=liste.anfangTHENliste.anfang:=nachfolger(liste.anfang);IFliste.laenge=1THENliste.ende:=nilEND IF ELIFloeschelement=listenende(liste)THENliste.ende:=vorgaenger(liste,loeschelement);vorgaenger(liste,loeschelement)ZEIGTAUFnilELSEvorgaenger(liste,loeschelement)ZEIGTAUFnachfolger(loeschelement)END IF;loeschelementZEIGTAUFnil;liste.laengeDECR1.leereliste:liste.laenge=0END PROCentfernen;TERM PROCnachfolger(TERM CONSTp):TERM VARnaechster;IF(p=nil)COR(tabelle.zeile(CONCR(p))="")THENerrorstop(anwendungstext(1))END IF;CONCR(naechster):=subtext(tabelle.zeile(CONCR(p)),2)ISUB1;naechsterEND PROCnachfolger;TERM PROCvorgaenger(LISTE CONSTliste,TERM CONSTzeiger):TERM VARlaufterm,merker;IF(zeiger=liste. +anfang)COR(liste.laenge<=1)THENerrorstop(anwendungstext(4))END IF;laufterm:=liste.anfang;WHILE(laufterm<>zeiger)CAND(laufterm<>nil)REP IFlaufterm<>zeigerTHENmerker:=laufterm;laufterm:=nachfolger(laufterm)END IF END REP;IFlaufterm=nilTHENerrorstop(anwendungstext(4))END IF;merkerEND PROCvorgaenger;OP ZEIGTAUF(TERM CONSTlinks,rechts):IFlinks=nilTHENerrorstop(anwendungstext(1))END IF;replace(tabelle.zeile(CONCR(links)),2,textvon(rechts))END OP ZEIGTAUF;TERM PROCauswahl(LISTE CONSTliste,INT CONSTgewuenschteselement):TERM VARsuchzeiger:=listenanfang(liste);INT VARi;IFlaenge(liste)<gewuenschteselementCORgewuenschteselement<1THENerrorstop(anwendungstext(4))END IF;FORiFROM2UPTOgewuenschteselementREPsuchzeiger:=nachfolger(suchzeiger)END REP;suchzeigerEND PROCauswahl;TERM PROClistenposition(LISTE CONSTobjektliste,TEXT CONSTname):TERM VARsuchzeiger:=listenanfang(objektliste);TEXT VARnameohneblanks:=name;changeall(nameohneblanks," ","");WHILE(suchzeiger<>nil)REP IFnameohneblanks=NAMEsuchzeigerTHEN LEAVElistenpositionWITHsuchzeigerELSEsuchzeiger:=nachfolger(suchzeiger)END IF END REP;suchzeigerEND PROClistenposition;INT PROCtermanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE TERME DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(5));1END IF END PROCtermanzahl;INT PROCvariablenanzahl(TERM CONSTabbildungszeiger):IFabbildungszeigerISstandardfunktionTHEN1ELIF(abbildungszeigerISeigenefunktion)COR(abbildungszeigerIStemporaerefunktion)THEN LAENGE VARIABLEN DEFINITIONabbildungszeigerELSEerrorstop(anwendungstext(6));1END IF END PROCvariablenanzahl;LISTE PROCstandardfunktionen:tabelle.listederstandardfunktionenEND PROCstandardfunktionen;LISTE PROCeigenefunktionen:tabelle.listeeigenerfunktionenEND PROCeigenefunktionen;LISTE PROCtemporaerefunktionen:tabelle.listetemporaererfunktionenEND PROCtemporaerefunktionen;PROCanhaengenanstandardfunktionen(TERM CONSTneueselement):anhaengen(tabelle.listederstandardfunktionen,neueselement)END PROCanhaengenanstandardfunktionen;PROCanhaengenaneigenefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listeeigenerfunktionen,neueselement)END PROCanhaengenaneigenefunktionen;PROCanhaengenantemporaerefunktionen(TERM CONSTneueselement):anhaengen(tabelle.listetemporaererfunktionen,neueselement)END PROCanhaengenantemporaerefunktionen;PROCentfernenauseigenenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listeeigenerfunktionen,zeiger)END PROCentfernenauseigenenfunktionen;PROCentfernenaustemporaerenfunktionen(TERM CONSTzeiger):entfernen(tabelle.listetemporaererfunktionen,zeiger)END PROCentfernenaustemporaerenfunktionen;TERM PROCalphasort(LISTE VARliste,TEXT CONSTvariablenname):testeparameter;sortiereein.testeparameter:IF NOT((liste.anfang<>nil)CAND(liste.anfangISvariable))THENerrorstop(anwendungstext(1))END IF.sortiereein:TERM VARvorgaenger:=liste.anfang,lauf:=nachfolger(vorgaenger),neuerterm;INT VARanzahl:=2;WHILE(lauf<>nil)CAND(NAMElauf)<variablennameREPanzahlINCR1;vorgaenger:=lauf;lauf:=nachfolger(lauf)END REP;neuerterm:=newvariable(anzahl,variablenname);neuertermZEIGTAUFlauf;vorgaengerZEIGTAUFneuerterm;IFlauf=nilTHENliste.ende:=neuertermELSE WHILElauf<>nilREPanzahlINCR1;replace(tabelle.zeile(CONCR(lauf)),4,textvon(anzahl));lauf:=nachfolger(lauf)END REP END IF;liste.laenge:=anzahl;neuertermEND PROCalphasort;BOOL PROCvariablenidentitaet(LISTE CONSTlinks,rechts):laenge(links)=laenge(rechts)CANDidentischenamen.identischenamen:TERM VARlauf1:=listenanfang(links),lauf2:=listenanfang(rechts)WHILElauf2<>nilREP IF(NAMElauf1<>NAMElauf2)THEN LEAVEvariablenidentitaetWITH FALSE END IF;lauf1:=nachfolger(lauf1);lauf2:=nachfolger(lauf2)END REP;TRUE END PROCvariablenidentitaet;TERM PROCnewstandardfunktion(TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewstandardfunktion;TERM PROC +neweigenefunktion(TERM CONSTdefinition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCneweigenefunktion;TERM PROCnewtemporaerefunktion(TERM CONSTdefinition):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(definition);neuertermEND PROCnewtemporaerefunktion;TERM PROCnewfunktionsdefinition(TERM CONSTvariablenliste,termliste):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(variablenliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(termliste);neuertermEND PROCnewfunktionsdefinition;TERM PROCnewvariablenliste(TERM CONSTerstevariable,letztevariable,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(erstevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(letztevariable);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewvariablenliste;TERM PROCnewvariable(INT CONSTposition,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(position);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewvariable;TERM PROCnewtermliste(TERM CONSTersterterm,letzterterm,INT CONSTlaenge):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(ersterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(letzterterm);tabelle.zeile(CONCR(neuerterm))CATtextvon(laenge);neuertermEND PROCnewtermliste;TERM PROCnewterm(TERM CONSTarithmetischerausdruck):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(arithmetischerausdruck);neuertermEND PROCnewterm;TERM PROCnewdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewdyade;TERM PROCnewmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):=" +";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewmonade;TERM PROCnewfunktionsauswertung(TERM CONSTabbildungsausdruck,argumentliste,INT CONSTkomponente):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(argumentliste);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);neuertermEND PROCnewfunktionsauswertung;TERM PROCnewabbildungsdyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsdyade;TERM PROCnewabbildungsmonade(TERM CONSToperand,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="
";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(operand);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewabbildungsmonade;TERM PROCnewableitungsoperation(TERM CONST +abbildungsausdruck,INT CONSTvariable,komponente,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(abbildungsausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(variable);tabelle.zeile(CONCR(neuerterm))CATtextvon(komponente);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewableitungsoperation;TERM PROCnewkonstante(REAL CONSTwert,TEXT CONSTname):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(wert);tabelle.zeile(CONCR(neuerterm))CATname;neuertermEND PROCnewkonstante;TERM PROCnewselektion(TERM CONSTbedingung,ausdruck,naechsteselektion):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(bedingung);tabelle.zeile(CONCR(neuerterm))CATtextvon(ausdruck);tabelle.zeile(CONCR(neuerterm))CATtextvon(naechsteselektion);neuertermEND PROCnewselektion;TERM PROCnewlogischedyade(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuertermEND PROCnewlogischedyade;TERM PROCnewvergleich(TERM CONSTlinks,rechts,TEXT CONSToperator):TERM VARneuerterm:=allokiereterm;tabelle.zeile(CONCR(neuerterm)):="�";tabelle.zeile(CONCR(neuerterm))CATtextvonnil;tabelle.zeile(CONCR(neuerterm))CATtextvon(links);tabelle.zeile(CONCR(neuerterm))CATtextvon(rechts);tabelle.zeile(CONCR(neuerterm))CAToperator;neuerterm.END PROCnewvergleich;TERM PROCallokiereterm:TERM VARfreierterm;bestimmedenallokiertenzeiger;tabelle.zeigerauffreientabellenplatz:=naechsterfreierplatz;freierterm.bestimmedenallokiertenzeiger:IFtabelle.zeigerauffreientabellenplatz=nilTHENerrorstop(anwendungstext(2))END IF;freierterm:=tabelle.zeigerauffreientabellenplatz.naechsterfreierplatz:TERM VARsucher:=freierterm;REP CONCR(sucher)DECR1;IFsucher=nilTHEN CONCR(sucher):=tabellengroesse+1ELIFsucher=freiertermTHEN LEAVEnaechsterfreierplatzWITHnilELIFtabelle.zeile(CONCR(sucher))=""THEN LEAVEnaechsterfreierplatzWITHsucherEND IF END REP;sucherEND PROCallokiereterm;TEXT PROCtextvon(REAL CONSTwert):TEXT VARachtbyte:=" ";replace(achtbyte,1,wert);achtbyteEND PROCtextvon;TEXT PROCtextvon(INT CONSTwert):TEXT VARzweibyte:=" ";replace(zweibyte,1,wert);zweibyteEND PROCtextvon;TEXT PROCtextvon(TERM CONSTzeiger):textvon(CONCR(zeiger))END PROCtextvon;TEXT OP NAME(TERM CONSTterm):IFtermISstandardfunktionTHENsubtext(tabelle.zeile(CONCR(term)),4)ELIF(termISvariable)COR(termISeigenefunktion)THENsubtext(tabelle.zeile(CONCR(term)),6)ELIFtermISkonstanteTHENsubtext(tabelle.zeile(CONCR(term)),12)ELSEerrorstop(anwendungstext(12));""END IF END OP NAME;TERM OP DEFINITION(TERM CONSTterm):TERM VARdefinition;IF(termISeigenefunktion)COR(termIStemporaerefunktion)THEN CONCR(definition):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(16))END IF;definitionEND OP DEFINITION;TERM OP VARIABLEN(TERM CONSTterm):TERM VARvariablen;IFtermISfunktionsdefinitionTHEN CONCR(variablen):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(19))END IF;variablenEND OP VARIABLEN;TERM OP TERME(TERM CONSTterm):TERM VARterme;IF(termISfunktionsdefinition)THEN CONCR(terme):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(17))END IF;termeEND OP TERME;TERM OP LISTENANFANG(TERM CONSTterm):TERM VARanfang;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(anfang):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(21))END IF;anfangEND OP LISTENANFANG;TERM OP LISTENENDE(TERM CONSTterm):TERM VARende;IF(termISvariablenliste)COR(termIStermliste)THEN CONCR(ende):=subtext(tabelle.zeile(CONCR( +term)),6)ISUB1ELSEerrorstop(anwendungstext(22))END IF;endeEND OP LISTENENDE;INT OP LAENGE(TERM CONSTterm):IF NOT((termISvariablenliste)COR(termIStermliste))THENerrorstop(anwendungstext(20))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP LAENGE;TERM OP ELEMENT(TERM CONSTlistenzeiger,INT CONSTnteselement):IF NOT((listenzeigerIStermliste)XOR(listenzeigerISvariablenliste))THENerrorstop(anwendungstext(18))END IF;auswahl(neueliste(LISTENANFANGlistenzeiger,LISTENENDElistenzeiger),nteselement)END OP ELEMENT;INT OP PLATZ(TERM CONSTterm):IF NOT(termISvariable)THENerrorstop(anwendungstext(25))END IF;subtext(tabelle.zeile(CONCR(term)),4)ISUB1END OP PLATZ;TERM OP AUSDRUCK(TERM CONSTterm):TERM VARformel;IF(termISausdruck)THEN CONCR(formel):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(27))END IF;formelEND OP AUSDRUCK;TERM OP LINKS(TERM CONSTterm):TERM VARlinks;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(links):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(7))END IF;linksEND OP LINKS;TERM OP RECHTS(TERM CONSTterm):TERM VARrechts;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THEN CONCR(rechts):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(8))END IF;rechtsEND OP RECHTS;TEXT OP OPERATION(TERM CONSTterm):TEXT VARop;IF(termISdyadisch)COR(termISabbildungsdyade)COR(termISlogischedyade)COR(termISvergleich)THENop:=subtext(tabelle.zeile(CONCR(term)),8)ELIF(termISmonadisch)COR(termISabbildungsmonade)THENop:=subtext(tabelle.zeile(CONCR(term)),6)ELIFtermISableitungsoperationTHENop:=subtext(tabelle.zeile(CONCR(term)),10)ELSEerrorstop(anwendungstext(10))END IF;opEND OP OPERATION;TERM OP OPERAND(TERM CONSTterm):TERM VARoperand;IF(termISmonadisch)COR(termISabbildungsmonade)THEN CONCR(operand):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(9))END IF;operandEND OP OPERAND;TERM OP ABBILDUNGSAUSDRUCK(TERM CONSTterm):TERM VARfunktionsterm;IF(termISfunktionsauswertung)COR(termISableitungsoperation)THEN CONCR(funktionsterm):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(23))END IF;funktionstermEND OP ABBILDUNGSAUSDRUCK;TERM OP ARGUMENTE(TERM CONSTterm):TERM VARargumente;IF(termISfunktionsauswertung)THEN CONCR(argumente):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(13))END IF;argumenteEND OP ARGUMENTE;INT OP KOMPONENTE(TERM CONSTterm):IF NOT((termISfunktionsauswertung)COR(termISableitungsoperation))THENerrorstop(anwendungstext(24))END IF;subtext(tabelle.zeile(CONCR(term)),8)ISUB1END OP KOMPONENTE;INT OP INDEX(TERM CONSTterm):IF NOT(termISableitungsoperation)THENerrorstop(anwendungstext(26))END IF;subtext(tabelle.zeile(CONCR(term)),6)ISUB1END OP INDEX;REAL OP WERT(TERM CONSTterm):IF NOT(termISkonstante)THENerrorstop(anwendungstext(11))END IF;subtext(tabelle.zeile(CONCR(term)),4)RSUB1END OP WERT;TERM OP BEDINGUNG(TERM CONSTterm):TERM VARbedingung;IFtermISselektionTHEN CONCR(bedingung):=subtext(tabelle.zeile(CONCR(term)),4)ISUB1ELSEerrorstop(anwendungstext(28))END IF;bedingungEND OP BEDINGUNG;TERM OP AKTION(TERM CONSTterm):TERM VARaktion;IFtermISselektionTHEN CONCR(aktion):=subtext(tabelle.zeile(CONCR(term)),6)ISUB1ELSEerrorstop(anwendungstext(29))END IF;aktionEND OP AKTION;TERM OP ALTERNATIVE(TERM CONSTterm):TERM VARalternative;IFtermISselektionTHEN CONCR(alternative):=subtext(tabelle.zeile(CONCR(term)),8)ISUB1ELSEerrorstop(anwendungstext(30))END IF;alternativeEND OP ALTERNATIVE;PROClowlevel:datenraumname:="mathematikobjekte 1";ankoppelnEND PROClowlevel;PROChighlevel:datenraumname:="mathematikobjekte 2";ankoppelnEND PROChighlevel;INT PROCebene:int(datenraumnameSUB19)END PROCebene;PROCankoppeln:IFexists(datenraumname)THENtabelle:=old(datenraumname);IFdatenraumstrukturokCAND NOTiserrorTHENenablestop;LEAVEankoppelnEND IF;IFiserrorTHENclearerror;enablestopEND IF END IF;initialisieren.datenraumstrukturok:disablestop;( +listenanfang(standardfunktionen)ISstandardfunktion)AND NAMEnachfolger(listenanfang(standardfunktionen))="cos"END PROCankoppeln;PROCinitialisieren:LETanzahlelementarerfunktionen=19;INT VARi;ROWanzahlelementarerfunktionenTEXT CONSTname:=ROWanzahlelementarerfunktionenTEXT:("sin","cos","tan","cot","arcsin","arccos","arctan","arccot","ln","log2","log10","exp","sign","abs","wurzel","gauss","rund","ganz","frak");disablestop;footnote(anwendungstext(61));koppleeinendatenrauman;initialisieredieobjekttabelle;initialisieredielisten;tragedieelementarenabbildungenein;enablestop.koppleeinendatenrauman:forget(datenraumname,quiet);tabelle:=new(datenraumname).initialisieredieobjekttabelle:FORiFROMtabellengroesseDOWNTO1REPtabelle.zeile(i):=""END REP.initialisieredielisten:tabelle.zeigerauffreientabellenplatz:=wurzel;tabelle.listederstandardfunktionen:=neueliste(nil,nil);tabelle.listeeigenerfunktionen:=neueliste(nil,nil);tabelle.listetemporaererfunktionen:=neueliste(nil,nil);tabelle.dummy:=neueliste(nil,nil).tragedieelementarenabbildungenein:FORiFROM1UPTOanzahlelementarerfunktionenREPanhaengenanstandardfunktionen(newstandardfunktion(name(i)))END REP.END PROCinitialisieren;OP LOESCHE(TERM CONSTp):tabelle.zeile(CONCR(p)):="";IFtabellevoelliggefuelltTHENtabelle.zeigerauffreientabellenplatz:=pEND IF.tabellevoelliggefuellt:tabelle.zeigerauffreientabellenplatz=nil.END OP LOESCHE;BOOL OP IS(TERM CONSTt,ART CONSTtyp):(t<>nil)CAND(tabelle.zeile(CONCR(t))<>"")CANDcode(tabelle.zeile(CONCR(t))SUB1)=CONCR(typ)END OP IS;OP:=(ART VARlinks,ART CONSTrechts):CONCR(links):=CONCR(rechts)END OP:=;END PACKETreferenzobjekte; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic new file mode 100644 index 0000000..2de7226 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.specialgraphic @@ -0,0 +1,4 @@ +PACKETspezialgraphicDEFINESmatmove,matdraw,grapheditget,initscreenmemory,clearscreenmemory,plotscreenmemory,loeschezeichnung,loeschezeichnungpartiell,putscreenmemory,newpicture,deletelastpicture,vervollstaendigeaktuellezeichnung,druckeaktuellezeichnung:LEThop="�",rechts="�",bell="�",links="�",rubin="�",rubout="�",return="
",escapezeichen="�",rubinmark="^",cursorverschiebung=1,blank=" ",niltext="",bildspeichertyp=1055,maximalanzahl=128,maxzeichnungen=25,printerdepot="MATHE-PRINTERDEPOT";TYPE PICROW=STRUCT(INTeof,ROWmaximalanzahlPICTUREzeichnung,ROW4REALfenstergroesseREALquellbreite,quellhoehe);BOUND PICROW VARscreenmemory;DATASPACE VARds;INT CONSTcursorbreite:=zeichenbreite-1;BOOL VARcursoron:=FALSE;INT VARaltx,alty,xpixelanzahl,ypixelanzahl;REAL VARxcmgroesse,ycmgroesse,startpunktx,startpunkty;PROCmatmove(REAL CONSTx,y):startpunktx:=x;startpunkty:=yEND PROCmatmove;PROCmatdraw(REAL CONSTx,y):BOOL VARunsichtbar;REAL VARendpunktx:=x,endpunkty:=y,letzterendpunktx,letzterendpunkty;clip(startpunktx,startpunkty,endpunktx,endpunkty,unsichtbar);IF NOTunsichtbarTHEN IFlength(screenmemory.zeichnung(screenmemory.eof))>31960THENstretchpictureEND IF;where(letzterendpunktx,letzterendpunkty);IFstartpunktx<>letzterendpunktxCORstartpunkty<>letzterendpunktyTHENmove(startpunktx,startpunkty);move(screenmemory.zeichnung(screenmemory.eof),startpunktx,startpunkty)END IF;IFletzterendpunktx<>endpunktxCORletzterendpunkty<>endpunktyTHENdraw(endpunktx,endpunkty);draw(screenmemory.zeichnung(screenmemory.eof),endpunktx,endpunkty)END IF END IF;matmove(x,y)END PROCmatdraw;PROCclip(REAL VARxbeg,ybeg,xend,yend,BOOL VARnothingvisible):REAL VARdifbeg,difend;REAL CONSTxdif:=xend-xbeg,ydif:=yend-ybeg;BOOL VARcutbeg,cutend;windowlinksclip;windowrechtsclip;windowuntenclip;windowobenclip.windowlinksclip:difbeg:=windowxmin-xbeg;difend:=windowxmin-xend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxminELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxminEND IF.windowrechtsclip:difbeg:=windowxmax-xbeg;difend:=windowxmax-xend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENybeg:=ybeg+ydif/xdif*difbeg;xbeg:=windowxmaxELIFcutendTHENyend:=yend+ydif/xdif*difend;xend:=windowxmaxEND IF.windowuntenclip:difbeg:=windowymin-ybeg;difend:=windowymin-yend;cutbeg:=(difbeg>0.0);cutend:=(difend>0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowyminELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowyminEND IF.windowobenclip:difbeg:=windowymax-ybeg;difend:=windowymax-yend;cutbeg:=(difbeg<0.0);cutend:=(difend<0.0);nothingvisible:=cutbegANDcutend;IFnothingvisibleTHEN LEAVEclipELIFcutbegTHENxbeg:=xbeg+xdif/ydif*difbeg;ybeg:=windowymaxELIFcutendTHENxend:=xend+xdif/ydif*difend;yend:=windowymaxEND IF END PROCclip;PROCeditgetcursor(INT CONSTi,j):loeschecursor;altx:=(i-1)*zeichenbreite;alty:=ypixelanzahl-(j*zeichenhoehe)-cursorverschiebung;move(altx,alty);draw(altx+cursorbreite,alty);cursoron:=TRUE;cursor(i,j)END PROCeditgetcursor;PROCloeschecursor:IFcursoronTHENpen(0,0,0,1);move(altx,alty);draw(altx+cursorbreite,alty);pen(1,1,1,1);cursoron:=FALSE END IF END PROCloeschecursor;PROCgrapheditget(TEXT VAReingabe,INT CONSTfeldlaenge,TEXT CONSTescausstiegszeichen,TEXT VARausstieg):TEXT VARch;INT VARxanfang,yanfang,cursorpos,textpointer,maxcursorpos,zielpos;BOOL VARrubinmode;initialisiereeditor;REPinchar(ch);IFch=returnTHENausstieg:=niltext;loeschecursor;eingabe:=compress(eingabe);LEAVEgrapheditgetELIFch=escapezeichenTHENinchar(ausstieg);IFpos(escausstiegszeichen,ausstieg)<>0THENloeschecursor;LEAVEgrapheditgetEND IF ELIFch=linksTHENfuehrecursorlinksausELIFch=rechtsTHENfuehrecursorrechtsausELIFch=rubinTHENfuehrerubinausELIFch=ruboutTHENfuehreruboutausELIFch=hopTHENinchar(ch);IFch=linksTHENfuehrehoplinksausELIFch=rechtsTHENfuehrehoprechtsausELIFch= +ruboutTHENfuehrehopruboutausEND IF ELIFcode(ch)>=32THENfuehrenormaleszeichenausEND IF END REP.initialisiereeditor:clearbuffer;drawingarea(xcmgroesse,ycmgroesse,xpixelanzahl,ypixelanzahl);rubinmode:=FALSE;textpointer:=1;getcursor(xanfang,yanfang);cursorpos:=xanfang;maxcursorpos:=xanfang+feldlaenge;out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang).fuehrecursorlinksaus:IFcursorpos>xanfangTHENcursorposDECR1;editgetcursor(cursorpos,yanfang)ELIFtextpointer>1THENtextpointerDECR1;cursor(xanfang,yanfang);out(text(eingabe,feldlaenge,textpointer));editgetcursor(xanfang,yanfang)END IF.fuehrecursorrechtsaus:IFcursorpos-xanfang+textpointer<=length(eingabe)THEN IFcursorpos<maxcursorposTHENcursorposINCR1;editgetcursor(cursorpos,yanfang)ELSEtextpointerINCR1;cursor(xanfang,yanfang);out(text(eingabe,feldlaenge,textpointer));editgetcursor(maxcursorpos,yanfang)END IF END IF.fuehrerubinaus:TEXT VARt;rubinmode:=NOTrubinmode;IFrubinmodeTHEN IFcursorpos<maxcursorposTHENout(rubinmark);pause(3);cursor(cursorpos,yanfang);t:=eingabeSUB(cursorpos-xanfang+textpointer);IFt=niltextTHENt:=blankEND IF;out(t);editgetcursor(cursorpos,yanfang)END IF END IF.fuehreruboutaus:zielpos:=cursorpos-xanfang+textpointer;change(eingabe,zielpos,zielpos,niltext);out(text(eingabe,feldlaenge-(cursorpos-xanfang),zielpos));editgetcursor(cursorpos,yanfang).fuehrehoplinksaus:IFtextpointer>1THENcursor(xanfang,yanfang);textpointer:=1;out(text(eingabe,feldlaenge,textpointer))END IF;cursorpos:=xanfang;editgetcursor(cursorpos,yanfang).fuehrehoprechtsaus:IFlength(eingabe)<feldlaengeTHENcursorpos:=length(eingabe)+xanfangELIFcursorpos-xanfang+textpointer<=length(eingabe)THENzielpos:=length(eingabe)+1-feldlaenge;cursor(xanfang,yanfang);textpointer:=zielpos;out(text(eingabe,feldlaenge,zielpos));getcursor(cursorpos,yanfang)END IF;editgetcursor(cursorpos,yanfang).fuehrehopruboutaus:zielpos:=cursorpos-xanfang;eingabe:=subtext(eingabe,1,zielpos+textpointer-1);out((feldlaenge-zielpos)*blank);editgetcursor(cursorpos,yanfang).fuehrenormaleszeichenaus:IFrubinmodeTHENzielpos:=cursorpos-xanfang+textpointer;eingabe:=subtext(eingabe,1,zielpos-1)+ch+subtext(eingabe,zielpos,length(eingabe));IFcursorpos<maxcursorposTHENout(text(eingabe,maxcursorpos-cursorpos,zielpos))ELSEcursor(xanfang,yanfang);textpointerINCR1;out(text(eingabe,feldlaenge,textpointer))END IF ELSEzielpos:=cursorpos-xanfang+textpointer;IFzielpos>length(eingabe)THENeingabeCATblankEND IF;replace(eingabe,zielpos,ch);IFcursorpos<maxcursorposTHENout(ch)ELSEcursor(xanfang,yanfang);textpointerINCR1;out(text(eingabe,feldlaenge,textpointer))END IF END IF;IFcursorpos<maxcursorposTHENcursorposINCR1END IF;editgetcursor(cursorpos,yanfang)END PROCgrapheditget;PROCinitscreenmemory:forget(ds);ds:=nilspace;screenmemory:=ds;screenmemory.eof:=1;screenmemory.zeichnung(screenmemory.eof):=nilpictureEND PROCinitscreenmemory;PROCclearscreenmemory:forget(ds)END PROCclearscreenmemory;PROCplotscreenmemory:INT VARi;FORiFROM1UPTOscreenmemory.eofREP IFlength(screenmemory.zeichnung(i))<>0THENpen(1,1,1,pen(screenmemory.zeichnung(i)));plot(screenmemory.zeichnung(i))END IF END REP END PROCplotscreenmemory;PROCloeschezeichnung:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO1REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP END PROCloeschezeichnung;PROCloeschezeichnungpartiell:INT VARi;pen(0,0,0,1);FORiFROMscreenmemory.eofDOWNTO2REP IFlength(screenmemory.zeichnung(i))<>0THENplot(screenmemory.zeichnung(i))END IF END REP;screenmemory.eof:=2;plotscreenmemoryEND PROCloeschezeichnungpartiell;PROCputscreenmemory(PICTURE CONSTp):IFscreenmemory.eof=maximalanzahlTHENscreenmemory.eof:=1END IF;screenmemory.zeichnung(screenmemory.eof):=p;screenmemory.eofINCR1;screenmemory.zeichnung(screenmemory.eof):=nilpictureEND PROCputscreenmemory;PROCvervollstaendigeaktuellezeichnung(REAL CONSTxmin,xmax,ymin,ymax,breite,hoehe):screenmemory.fenstergroesse(1):=xmin;screenmemory.fenstergroesse(2):=xmax;screenmemory.fenstergroesse(3):= +ymin;screenmemory.fenstergroesse(4):=ymax;screenmemory.quellbreite:=breite;screenmemory.quellhoehe:=hoeheEND PROCvervollstaendigeaktuellezeichnung;INT VARanzahlfolgebilder:=0;PROCstretchpicture:anzahlfolgebilderINCR1;setzeweiter(pen(screenmemory.zeichnung(screenmemory.eof)))END PROCstretchpicture;PROCnewpicture(INT CONSTnr):anzahlfolgebilder:=0;setzeweiter(nr)END PROCnewpicture;PROCsetzeweiter(INT CONSTnr):screenmemory.eofINCR1;IFscreenmemory.eof>maximalanzahlTHENscreenmemory.eof:=2END IF;screenmemory.zeichnung(screenmemory.eof):=nilpicture;pen(screenmemory.zeichnung(screenmemory.eof),nr)END PROCsetzeweiter;PROCdeletelastpicture:IFscreenmemory.eof>1+anzahlfolgebilderTHENscreenmemory.eofDECR(1+anzahlfolgebilder)END IF END PROCdeletelastpicture;PROCdruckeaktuellezeichnung:enablestop;bestimmezieltaskname;benennedatenraum;versendedatenraum.bestimmezieltaskname:IF NOTexiststask(printerdepot)CORinhalt(ALL(/printerdepot))>=maxzeichnungenTHENout(bell);LEAVEdruckeaktuellezeichnungEND IF.benennedatenraum:TEXT VARbilddatenraum:="ZEICHNUNG "+date+" "+timeofday;IFexists(bilddatenraum,/printerdepot)THEN INT VARzaehler:=1;bilddatenraumCAT":";WHILEexists(bilddatenraum+text(zaehler),/printerdepot)REPzaehlerINCR1END REP;bilddatenraumCATtext(zaehler)END IF;type(ds,bildspeichertyp);copy(ds,bilddatenraum).versendedatenraum:IFstatus(/printerdepot)=2THENsave(bilddatenraum,/printerdepot)ELSEout(bell)END IF;forget(bilddatenraum,quiet)END PROCdruckeaktuellezeichnung;INT PROCinhalt(THESAURUS CONSTth):INT VARi:=0,zaehler:=0;TEXT VARname;get(th,name,i);WHILEi<>0REP IFname<>niltextTHENzaehlerINCR1END IF;get(th,name,i);END REP;zaehlerEND PROCinhalt;END PACKETspezialgraphic + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.umformung b/app/schulis-mathematiksystem/1.0/src/mat.umformung new file mode 100644 index 0000000..001c0ca --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.umformung @@ -0,0 +1,3 @@ +PACKETumformungDEFINESinitialisiereausgabedatei,formeum,loescheausgabedatei:LETniltext="",bell="�",beginmark="",endmark="",left="�",right="�",del="�",esc="�",blank=" ",arbeitsfunktionstitel="Arbeitsfunktion",titel1="Ableitung",titel2="Auflösung",titel3="aufgelöste Ableitung";FILE VARufdat;TEXT VARufdatname;INT VARausgabezeilennummer;INT VARfktwahl;PROCinitialisiereausgabedatei:ufdatname:=scratchdateiname;ufdat:=sequentialfile(output,ufdatname);ausgabezeilennummer:=1;fktwahl:=1END PROCinitialisiereausgabedatei;PROCformeum(ABBILDUNG CONSTf):WINDOW VARwt:=window(2,4,77,19);INT VARzeilenoffset:=0,ersteauszugebendespalte,ersteauszugebendezeile,alterwert;BOOL VARtemporaerefktexistiert:=FALSE;ABBILDUNG VARtempfkt;TEXT VARzulaessigeeingaben,ausstieg;bereiteprotokolldateivor;bearbeitedasobjekt;bereiteprotokolldateinach.bereiteprotokolldateivor:ersteauszugebendespalte:=1;ersteauszugebendezeile:=ausgabezeilennummer;output(ufdat);putline(ufdat,arbeitsfunktionstitel);IF NOTformeleditoraktivTHENputline(ufdat,funktionsstring(f));zeilenoffsetINCR3ELSEalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,f);line(ufdat);zeilenoffsetINCR(2+lines(ufdat)-alterwert)END IF;outframe(wt).bearbeitedasobjekt:REPzeigeprotokolldatei;bestimmeaktivitaet;fuehreaktivitaetausEND REP.zeigeprotokolldatei:scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bestimmeaktivitaet:TEXT VARchar;ROW3TEXT CONSTkommandozeile:=ROW3TEXT:(anwendungstext(230),anwendungstext(231),anwendungstext(232));REPclearbuffer;cursor(3,2);out(kommandozeile(fktwahl));cursor(78,24);inchar(char);IFchar=leftTHENfktwahl:=(fktwahl-2)MOD3+1ELIFchar=rightTHENfktwahl:=fktwahlMOD3+1ELIFchar=escTHENwerteescapesequenzausEND IF END REP.werteescapesequenzaus:zulaessigeeingaben:="?fnwqmd";inchar(ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(10));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))CASE2:betrachtedieausgabedateiCASE3:IFtemporaerefktexistiertTHENbenennedieletztetemporaerefunktion;outframe(wt);scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132))END IF CASE4:LEAVEbestimmeaktivitaetCASE5,6:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektCASE7:druckversuch(ufdatname);outframe(wt);footnote(anwendungstext(132))END SELECT.betrachtedieausgabedatei:zulaessigeeingaben:="?dwqm";INT VARersterauszugebendersatz:=ausgabezeilennummer;cursor(1,2);out(del);REPfootnote(anwendungstext(133));scroll(wt,ufdatname,1,1,1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigeeingaben,ausstieg);SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:show(formular(12));warteCASE2:druckversuch(ufdatname);outframe(wt)CASE3:LEAVEbetrachtedieausgabedateiCASE4,5:IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT END REP.benennedieletztetemporaerefunktion:TEXT VARvorgesehenername:=niltext;cursor(3,2);out(del);cursor(3,2);out(anwendungstext(172));REPfootnote(anwendungstext(174));cursor(23,2);out(beginmark);out(left);enablestop;editget(vorgesehenername,40,20);disablestop;cursor(43,2);out(endmark);IFvorgesehenername=niltextTHEN LEAVEbenennedieletztetemporaerefunktionEND IF;gibnamen(tempfkt,vorgesehenername);IFiserrorTHENgibmeldung(errormessage+vorgesehenername);clearerrorELSEgibmeldung(anwendungstext(227)+vorgesehenername+anwendungstext(228));temporaerefktexistiert:=FALSE;LEAVEbenennedieletztetemporaerefunktionEND IF END REP.fuehreaktivitaetaus:TEXT VARueberschrift;IFfktwahl<>2THENbestimmeableitungsparameterEND IF;footnote(anwendungstext(166));IFtemporaerefktexistiertTHENloeschetemporaereabbildung(tempfkt)END IF;SELECTfktwahlOF CASE1:ueberschrift:=titel1+ueberschriftrest;tempfkt:=ableitung(f,kompindex,varindex)CASE2:ueberschrift:=titel2;tempfkt:=aufloesung(f)CASE3:ueberschrift:=titel3+ +ueberschriftrest;ABBILDUNG VARtemp:=aufloesung(f);tempfkt:=ableitung(temp,kompindex,varindex);loeschetemporaereabbildung(temp)END SELECT;output(ufdat);putline(ufdat,ueberschrift);IFiserrorTHENclearerror;putline(ufdat,errormessage);zeilenoffsetINCR2ELIFformeleditoraktivTHENalterwert:=lines(ufdat);liefereformeleditorformat(ufdat,tempfkt);line(ufdat);temporaerefktexistiert:=TRUE;zeilenoffsetINCR(1+lines(ufdat)-alterwert)ELSEputline(ufdat,funktionsstring(tempfkt));temporaerefktexistiert:=TRUE;zeilenoffsetINCR2END IF.bestimmeableitungsparameter:INT VARkompindex:=1,varindex:=1;BOOL CONSTtermeingabeerforderlich:=laenge(abbildungsterme(f))>1,variableneingabeerforderlich:=(ebene=2)CANDlaenge(abbildungsvariablen(f))>1;TEXT VARueberschriftrest:=niltext,variablenname:=NAMElistenanfang(abbildungsvariablen(f));IFtermeingabeerforderlichCORvariableneingabeerforderlichTHEN IFtermeingabeerforderlichTHENcursor(51,2);out("des Terms")END IF;IFvariableneingabeerforderlichTHENcursor(64,2);out("nach "+text(variablenname,8))END IF;lieswerteein;IFtermeingabeerforderlichTHENueberschriftrestCAT(" des "+text(kompindex)+". Terms")END IF;IFvariableneingabeerforderlichTHENueberschriftrestCAT(" nach "+variablenname)END IF;cursor(51,2);out(del)END IF.lieswerteein:zulaessigeeingaben:="?wqm";footnote(anwendungstext(209));REP IFtermeingabeerforderlichTHENbestimmeterm;werteausstiegausEND IF;IFvariableneingabeerforderlichTHENbestimmevariable;werteausstiegausEND IF END REP.bestimmeterm:TEXT VARtermziffer:=text(kompindex);BOOL VARgueltigerterm;REPcursor(61,2);out("�");enablestop;editget(termziffer,12,2,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);kompindex:=int(termziffer);gueltigerterm:=NOTiserrorCANDkorrektetermbezeichnung;IFgueltigertermTHENcursor(61,2);out(termziffer);LEAVEbestimmetermEND IF;IFiserrorTHENclearerrorEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektetermbezeichnung:lastconversionokCANDkompindex>0CANDkompindex<=laenge(abbildungsterme(f)).bestimmevariable:BOOL VARgueltigevariable;REPcursor(69,2);out("�");enablestop;editget(variablenname,20,8,niltext,zulaessigeeingaben,ausstieg);disablestop;out(endmark);cursor(69,2);out(text(variablenname,8,1));gueltigevariable:=korrektevariablenbezeichnung;IFgueltigevariableTHENvarindex:=PLATZt;LEAVEbestimmevariableEND IF;out(bell)UNTILpos(zulaessigeeingaben,(ausstiegSUB2))<>0END REP.korrektevariablenbezeichnung:changeall(variablenname,blank,niltext);TERM VARt:=listenposition(abbildungsvariablen(f),variablenname);t<>nil.werteausstiegaus:ausstieg:=ausstiegSUB2;SELECTpos(zulaessigeeingaben,ausstieg)OF CASE1:gibinformationzurparametereingabeCASE2:IFtermeingabeerforderlichCAND NOTgueltigertermTHEN LEAVEwerteausstiegausEND IF;IFvariableneingabeerforderlichCAND NOTgueltigevariableTHEN LEAVEwerteausstiegausEND IF;LEAVElieswerteeinCASE3,4:loeschetemporaereabbildung(tempfkt);verfahrensende(ausstieg);LEAVEbearbeitedasobjektEND SELECT.gibinformationzurparametereingabe:show(formular(11));warte;scroll(wt,ufdatname,1,1,1,ausgabezeilennummer,ersteauszugebendespalte,niltext,ausstieg);footnote(anwendungstext(132)).bereiteprotokolldateinach:output(ufdat);line(ufdat);ausgabezeilennummerINCRzeilenoffsetEND PROCformeum;PROCloescheausgabedatei:forget(ufdatname,quiet)END PROCloescheausgabedatei;END PACKETumformung; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vector b/app/schulis-mathematiksystem/1.0/src/mat.vector new file mode 100644 index 0000000..03439bc --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.vector @@ -0,0 +1,2 @@ +PACKETvectorDEFINES VECTOR,:=,vector,SUB,LENGTH,length,nilvector,replace,=,<>,+,-,*,/:TYPE VECTOR=STRUCT(INTlng,TEXTelem),INITVECTOR=STRUCT(INTlng,REALvalue);INT VARi;TEXT VARt:="12345678";VECTOR VARv:=nilvector;OP:=(VECTOR VARl,VECTOR CONSTr):l.lng:=r.lng;l.elem:=r.elemEND OP:=;OP:=(VECTOR VARl,INITVECTOR CONSTr):l.lng:=r.lng;replace(t,1,r.value);l.elem:=r.lng*tEND OP:=;INITVECTOR PROCnilvector:vector(1,0.0)END PROCnilvector;INITVECTOR PROCvector(INT CONSTlng,REAL CONSTvalue):IFlng<=0THENerrorstop("PROC vector : lng <= 0")FI;INITVECTOR:(lng,value)END PROCvector;INITVECTOR PROCvector(INT CONSTlng):vector(lng,0.0)END PROCvector;REAL OP SUB(VECTOR CONSTv,INT CONSTi):test("REAL OP SUB : ",v,i);v.elemRSUBiEND OP SUB;INT OP LENGTH(VECTOR CONSTv):v.lngEND OP LENGTH;INT PROClength(VECTOR CONSTv):v.lngEND PROClength;PROCreplace(VECTOR VARv,INT CONSTi,REAL CONSTr):test("PROC replace : ",v,i);replace(v.elem,i,r)END PROCreplace;BOOL OP=(VECTOR CONSTl,r):l.elem=r.elemEND OP=;BOOL OP<>(VECTOR CONSTl,r):l.elem<>r.elemEND OP<>;VECTOR OP+(VECTOR CONSTv):vEND OP+;VECTOR OP+(VECTOR CONSTl,r):test("VECTOR OP + : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)+(r.elemRSUBi))PER;vEND OP+;VECTOR OP-(VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,-(a.elemRSUBi))PER;vEND OP-;VECTOR OP-(VECTOR CONSTl,r):test("VECTOR OP - : ",l,r);v:=l;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(l.elemRSUBi)-(r.elemRSUBi))PER;vEND OP-;REAL OP*(VECTOR CONSTl,r):test("REAL OP * : ",l,r);REAL VARx:=0.0;FORiFROM1UPTOl.lngREPxINCR((l.elemRSUBi)*(r.elemRSUBi))PER;xEND OP*;VECTOR OP*(VECTOR CONSTv,REAL CONSTr):r*vEND OP*;VECTOR OP*(REAL CONSTr,VECTOR CONSTa):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,r*(a.elemRSUBi))PER;vEND OP*;VECTOR OP/(VECTOR CONSTa,REAL CONSTr):v:=a;FORiFROM1UPTOv.lngREPreplace(v.elem,i,(a.elemRSUBi)/r)PER;vEND OP/;TEXT VARerror:="";PROCtest(TEXT CONSTproc,VECTOR CONSTv,INT CONSTi):IFi>v.lngTHENerror:=proc;errorCAT"subscript overflow (LENGTH v=";errorCATtext(v.lng);errorCAT", i=";errorCATtext(i);errorCAT")";errorstop(error)ELIFi<1THENerror:=proc;errorCAT"subscript underflow (i = ";errorCATtext(i);errorCAT")";errorstop(error)FI END PROCtest;PROCtest(TEXT CONSTproc,VECTOR CONSTa,b):IFa.lng<>b.lngTHENerror:=proc;errorCAT"LENGTH a (";IFa.lng<=0THENerrorCAT"undefined"ELSEerrorCATtext(a.lng)FI;errorCAT") <> LENGTH b (";errorCATtext(b.lng);errorCAT")";errorstop(error)FI END PROCtest;END PACKETvector; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.verwaltung b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung new file mode 100644 index 0000000..c65e789 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.verwaltung @@ -0,0 +1,1032 @@ +PACKET mathe verwaltung DEFINES mathe, + installiere mathesystem: + +(**************************************************) +(* G l o b a l e D e k l a r a t i o n e n *) +(**************************************************) + +(* L E T - D e n o t e r *) + +(* Ausgabetexte *) + +LET systemname = "s c h u l i s - Mathematiksystem Version 1.0", + titel 1 = "Systemverwaltung", + titel 2 = "Installation", + titel 3 = "Installation: Drucker", + meldung 1 = "Das Mathematiksystem ist noch nicht installiert.", + meldung 2 = "Kein Druckertreiber für Graphiken installiert.", + meldung 3 = "1 ... Mathematiksystem - Ebene 1", + meldung 4 = "2 ... Mathematiksystem - Ebene 2", + meldung 5 = "3 ... Zeichnungen drucken", + meldung 6 = "---------------------------------------", + meldung 7 = "4 ... Neuinstallation: Mathematiksystem", + meldung 8 = "5 ... Neuinstallation: Graphikdrucker", + meldung 9 = "q ... Mathematiksystem verlassen", + meldung 10 = "Gewünschte Funktion:", + meldung 11 = "Bitte wählen Sie unter folgenden Anpassungen eine", + meldung 12 = "für Ihr Terminal und die zugehörige Grafikkarte", + meldung 13 = "angemessene heraus:", + meldung 14 = " hercules-Anpassung", + meldung 15 = " cga-Anpassung", + meldung 16 = " ega-Anpassung", + meldung 17 = " vga-Anpassung", + meldung 18 = "Solange vorgeschlagene Anpassung verneinen <n/N>", + meldung 19 = "bis passende genannt wird.", + meldung 20 = "Diese bejahen <j/J/y/Y>.", + meldung 21 = "Installation korrekt beendet", + meldung 22 = "Installation wegen Systemfehler gestoppt", + meldung 23 = "Verfügt das Terminal über den IBM-Zeichensatz", + meldung 24 = "Soll das vorhandene Mathematiksystem gelöscht werden", + meldung 25 = "Soll der vorhandene Druckertreiber gelöscht werden", + meldung 26 = "Weiter mit beliebiger Taste", + meldung 27 = "Geladen wird Datei Nr. ", + meldung 28 = "Die benötigten Dateien sind vollständig geladen.", + meldung 29 = "Sie können die Diskette aus dem Laufwerk nehmen.", + meldung 30 = "Bitte warten - das Mathematiksystem wird installiert.", + meldung 31 = "Installiert wird Datei von ", + meldung 32 = "Fehler bei der Übersetzung der Programme.", + meldung 33 = " richtige Anpassung", + meldung 34 = "für Ihren Drucker geeigenete aus:", + meldung 35 = " DRUCKER PLOTTER", + meldung 36 = " xerox 4045 hp 72xx", + meldung 37 = " epson sq hp 74xx", + meldung 38 = " epson fx", + meldung 39 = " binder 8600", + meldung 40 = " kyocera", + meldung 41 = " hp laserjet", + meldung 42 = "Bitte warten - der Druckertreiber wird installiert", + meldung 43 = "Bitte zunächst das Mathematiksystem installieren.", + meldung 44 = + "Zunächst müssen die erforderlichen Dateien geladen werden.", + meldung 45 = "Passwort: ", + meldung 46 = "Soll das System mit einem Passwort geschützt werden", + meldung 47 = + "Fehler: Die Diskette ist ungültig oder nicht korrekt eingelegt!", + meldung 49 = "Installation vorzeitig abgebrochen", + meldung 50 = "Bitte legen sie eine Diskette der Anwendung", + meldung 51 = "in das Laufwerk und schließen es.", + meldung 52 = "Installation fortsetzen: <w>", + meldung 53 = "Installation abbrechen : <ESC>", + meldung 54 = "Bitte legen Sie eine weitere Diskette der Anwendung", + menutasten = "12345q", + zeilen menu 1 = 10, + zeilen menu 2 = 12, + zeilen menu 3 = 14, + +(* d o - Kommandos *) + + menu ankoppeln = "install menu (""ls-MENUKARTE:Mathematik"", FALSE)", + ebene 1 handle = "handle menu (""Ebene 1"")", + ebene 2 handle = "handle menu (""Ebene 2"")", + druckmenu handle = "handle menu (""Drucken"")", + ibmsatzzeichen = "ibmgraphicchar", + stdsatzzeichen = "stdgraphicchar", + ibmops ankoppeln = "load ops (""ibmoperatoren"")", + stdops ankoppeln = "load ops (""standardoperatoren"")", + fe manager = "formelmanager", + plotter ein = "plotter eingestellt (TRUE)", + plotter aus = "plotter eingestellt (FALSE)", + +(* Tasknamen *) + + depot taskname = "mathe depot", + ls mk taskname = "ls-MENUKARTEN", + ls taskname = "ls-ANWENDUNG", + fe taskname = "FORMELEDITOR", + mathe taskname = "Mathematik", + printer taskname = "MATHE-PRINTER", + pridepot taskname = "MATHE-PRINTERDEPOT", + umstell taskname = "DRUCKERANPASSUNGEN", + archivname = "mathe", + +(* Bezeichner für Menükarte, Maskendatenraum und Programmanzahl *) + + menukarte = "ls-MENUKARTE:Mathematik", + maskenname = "mathe formulare", + mathe kuerzel = "mat.", + plot kuerzel = " plot", + ls kuerzel = "ls-DIALOG ", + mathe extension = ".mathe", + operatorendatei 1 = "ibmoperatoren", + operatorendatei 2 = "standardoperatoren", + anzahl gesamt = 29, + anzahl feprocs = 6, + anzahl ls procs = 5, + anzahl matheprocs = 18, + anzahl pri procs = 6, + anzahl drucker ds = 16, + +(* Codes für Task-Kommunikation *) + + ok = 1111, + fehler = 9999, + insertieren = 2525, + drucker erzeugen = 3260, + drucker1 erzeugen = 3261, + drucker8 erzeugen = 3268, + system starten = 4444, + ebene 1 behandeln = 4445, + ebene 2 behandeln = 4446, + arbeitskanal = 1, (* Es wird ohnehin nur das Terminal 1 genutzt!*) + +(* Sonstiges *) + + del = ""5"", + delpage = ""4"", + bell = ""7"", + left = ""8"", + beginmark = ""15"", + endmark = ""14"", + weiter = "w", + abbruch = ""27"", + niltext = ""; + +(* G l o b a l e V a r i a b l e n *) + +TASK VAR depot task, ls mk task, fe task, mathe task, ls task, + pridepot task, printer task, order task, umstelltask; +THESAURUS VAR archivinhalt; +TEXT VAR graphicart, + installationspassword := niltext; +INT VAR druckerindex; +BOOL VAR ibmsatz; +INT VAR installationszaehler, antwort, order code; +DATASPACE VAR message ds; +BOOL VAR mathematiksystem installiert := FALSE, + graphikdrucker installiert := FALSE; +ROW anzahl druckerds TEXT CONST druckerdatei :: +ROW anzahl druckerds TEXT : ("ZEICHEN 8*8", + "ZEICHEN 6*10", + "ZEICHEN 8*16", + "spool cmd", + "mat.xerox4045 plot", + "mat.epson-sq plot", + "mat.epson-fx plot", + "mat.binder plot", + "mat.kyocera plot", + "mat.laserjet plot", + "mat.hp72xx plot", + "mat.hp74xx plot", + "mat.basis plot", + "mat.picture", + "mat.ausgabe", + "mat.druckermenu"); +ROW zeilen menu 1 TEXT CONST menu 1 :: +ROW zeilen menu 1 TEXT : (meldung 3, meldung 4, meldung 5, meldung 6, + meldung 7, meldung 8, niltext, meldung 9, + niltext, meldung 10); +ROW zeilen menu 2 TEXT CONST menu 2 :: +ROW zeilen menu 2 TEXT : (meldung 11, meldung 12, meldung 13, niltext, + meldung 14, meldung 15, meldung 16, meldung 17, + niltext, meldung 18, meldung 19, meldung 20); +ROW zeilen menu 3 TEXT CONST menu 3 :: +ROW zeilen menu 3 TEXT : (meldung 11, meldung 34, niltext, meldung 35, + meldung 36, meldung 37, meldung 38, meldung 39, + meldung 40, meldung 41, niltext, meldung 18, + meldung 19, meldung 20); + +(**************************************************************************) +(* H a u p t m e n ü *) +(**************************************************************************) +(* Die folgende Prozeduren realisieren ein Menü mit 6 Optionen: *) +(* 1, 2: Ausführung des Mathematiksystems - sofern es noch nicht ein- *) +(* gerichtet ist erfolgt eine Meldung. *) +(* Die Ausführung erfolgt durch Übergabe des Bildschirms an die *) +(* Task 'Mathematik' *) +(* 3 : Ausführung eines Menüs in der Druckertask. Die Option setzt *) +(* voraus, daß eine entsprechende Task eingerichtet ist. Ist dies*) +(* nicht der Fall erfolgt eine Meldung *) +(* 4 : Installation des Mathematiksystems. Sofern es schon eingerich-*) +(* tet ist, erfolgt die Installation nur bei der Bejahung einer *) +(* Abfrage, ob das vorhandene System gelöscht werden soll. *) +(* 5 : Installation des Druckertreibers. Sofern er schon eingerichtet*) +(* ist, erfolgt die Installation nur bei der Bejahung einer Ab- *) +(* frage, ob das vorhandene System gelöscht werden soll. *) +(* Ferner gilt: Ohne Mathematiksystem kann kein Druckertreiber *) +(* eingerichtet werden. Ein Löschen des Mathematik- *) +(* systems löscht automatisch auch den Druckertrei- *) +(* ber *) +(* q : Verlassen des Menüs *) +(* *) +(* Die exportierte Schnittstelle 'mathe' dient als Fängerebene für die *) +(* eigentliche Menü-Prozedur 'start system' *) +(**************************************************************************) + +PROC mathe: + + disable stop; + zeige kopierhinweis; (* 5.2.1991 *) + start system; + WHILE is error REP + clear error; + command dialogue (FALSE); + forget (all); + commanddialogue (TRUE); + zeige titelzeile (titel 1); + gib meldung (errormessage); + start system + END REP + +END PROC mathe; + +PROC start system: + + TEXT VAR ch; + INT VAR rang, zeile, xpos, ypos; + grundeinstellungen; + REP + zeige verwaltungsmenu; + warte auf korrekte eingabe; + werte eingabe aus + END REP. + + grundeinstellungen: + enable stop; + check off; + warnings off. + + zeige verwaltungsmenu: + zeige titelzeile (titel 1); + FOR zeile FROM 7 UPTO 16 REP + cursor (24, zeile); out (menu 1 (zeile - 6)) + END REP; + clear buffer. + + warte auf korrekte eingabe: + get cursor (xpos, ypos); + REP + inchar (ch); + rang := pos (menutasten, ch); + IF rang = 0 THEN + out (bell) + ELSE + cursor (xpos + 1, ypos); out (ch); + END IF + UNTIL rang <> 0 END REP. + + werte eingabe aus: + SELECT rang OF + CASE 1, 2: fuehre mathesystem aus + CASE 3 : fuehre druckermenu aus + CASE 4 : installiere mathesystem + CASE 5 : installiere druckeranpassung + OTHERWISE LEAVE start system (* = 6 *) + END SELECT. + + fuehre mathesystem aus: + IF NOT mathematiksystem installiert THEN + out (bell); + gib meldung (meldung 1); + LEAVE fuehre mathesystem aus + END IF; + uebergib bildschirm (mathe task, system starten + rang). + + fuehre druckermenu aus: + IF NOT graphikdrucker installiert THEN + out (bell); + gib meldung (meldung 2); + LEAVE fuehre druckermenu aus + END IF; + uebergib bildschirm (/printer taskname, system starten). + + installiere druckeranpassung: + IF NOT mathematiksystem installiert THEN + out (bell); + gib meldung (meldung 43); + LEAVE installiere druckeranpassung + END IF; + IF graphikdrucker installiert CAND NOT ja (meldung 25) THEN + LEAVE installiere druckeranpassung + END IF; + start printer installation; + IF is error THEN + clear error; + gib meldung (errormessage); + ELSE + zeige installationsergebnis (titel 3, graphikdrucker installiert) + END IF + +END PROC start system; + +PROC zeige kopierhinweis: (* Eingefügt 5.2.1991 - R.Kraft *) + +LET z1 = "schulis - Mathematiksystem", + z2 = "Lizenzfreie Software der", + z3 = "Gesellschaft für Mathematik und Datenverarbeitung mbH", + z4 = "Die Nutzung der Software ist nur im Schul- und Hochschulbereich", + z5 = "für nichtkommerzielle Zwecke gestattet.", + z6 = "Gewährleistung und Haftung werden ausgeschlossen.", + z7 = "Weiter mit beliebiger Taste"; + + page; + cursor (26, 3); out (z1); + cursor (27, 8); out (z2); + cursor (13,10); out (z3); + cursor ( 8,14); out (z4); + cursor (20,15); out (z5); + cursor (16,17); out (z6); + cursor (26,23); out (z7); + pause (50) + +END PROC zeige kopierhinweis; + +(***********************************************************************) +(* I n s t a l l a t i o n d e s M a t h e m a t i k s y s t e m s *) +(***********************************************************************) +(* Das folgende Programm installiert das Mathematiksystem. *) +(* Dabei werden ggf existierende Tasks eines alten Mathematiksystems *) +(* gelöscht. Es handelt sich dabei um die ls-Task als Vatertask für *) +(* Druckeranpassung, Formeleditor und Mathematiksystem sowie die *) +(* Depottask (= Zwischenspeicher für die benötigten Quelldateien). *) +(* Die erforderliche Graphik und Halbgraphikanpassung werden im Dialog *) +(* bestimmt. *) +(* Die Dateien werden vom Archiv gelesen und in die Zwischenspeicher *) +(* Tasks geschickt. Anschließend erfolgt die Installation folgender *) +(* Taskstruktur: ls-ANWENDUNG *) +(* Mathematik *) +(* FORMELEDITOR *) +(* ls-MENUKARTEN *) +(* DRUCKERANPASSUNGEN *) +(* Die Zwischenspeichertask wird abschließend gelöscht. *) +(***********************************************************************) + +PROC installiere mathesystem: + + IF NOT korrektes password THEN + LEAVE installiere mathesystem + END IF; + IF mathematiksystem installiert CAND NOT ja (meldung 24) THEN + LEAVE installiere mathesystem + END IF; + start mathe installation; + zeige installationsergebnis (titel 2, mathematiksystem installiert); + IF mathematiksystem installiert THEN + definiere password + END IF; + graphikdrucker installiert := FALSE. + +END PROC installiere mathesystem; + +PROC start mathe installation: + + INT VAR i; + bestimme graphic und halbgraphic; + IF NOT erforderliche systemdateien eingelesen THEN + errorstop (meldung 49) + END IF; + loesche ggf vorhandene tasks; + richte ggf lsmenukarten ein; + richte sicherungstasks ein; + sichere dateien; + melde installationsbeginn; + richte ls task ein; + richte formeleditor ein; + richte mathetask ein; + loesche depottask. + + bestimme graphic und halbgraphic: + graphicart := graphikkarte; + ibmsatz := ja (meldung 23). + + loesche ggf vorhandene tasks: + IF exists task (depot taskname) THEN end (/depot taskname) END IF; + IF exists task (ls taskname) THEN end (/ls taskname) END IF. + + richte ggf lsmenukarten ein: + IF NOT exists task (ls mk taskname) THEN + begin (ls mk taskname, PROC free global manager, ls mk task) + ELSE + ls mk task := /ls mk taskname + END IF. + + richte sicherungstasks ein: + begin (depot taskname, PROC free global manager, depot task); + IF NOT exists task (umstell taskname) THEN + begin (umstell taskname, PROC free global manager, umstell task) + ELSE + umstell task := /umstell taskname + END IF. + + sichere dateien: + commanddialogue (FALSE); + save (menukarte, ls mk task); + save (maskenname, ls mk task); + save (archivinhalt, depot task); + FOR i FROM 1 UPTO anzahl drucker ds REP + IF NOT exists (druckerdatei (i), umstelltask) THEN + save (druckerdatei (i), umstelltask) + END IF + END REP; + forget (archivinhalt). + + melde installationsbeginn: + zeige titelzeile (titel 2); + cursor (15, 10); out (meldung 30); + cursor (15, 12); out (meldung 31 + text (anzahl gesamt) + " Dateien"); + installationszaehler := 0. + + richte ls task ein: + begin (ls taskname, PROC install ls, ls task); + FOR i FROM 1 UPTO anzahl ls procs REP + insertiere programme (ls task) + END REP. + + richte formeleditor ein: + REP UNTIL exists task (fe taskname) CAND + status (/fe taskname) = 2 END REP; + fe task := /fe taskname; + FOR i FROM 1 UPTO anzahl fe procs REP + insertiere programme (fe task) + END REP. + + richte mathetask ein: + REP UNTIL exists task (mathe taskname) CAND + status (/mathe taskname) = 2 END REP; + mathe task := /mathe taskname; + FOR i FROM 1 UPTO anzahl mathe procs REP + insertiere programme (mathe task) + END REP. + + loesche depottask: + end (depot task) + +END PROC start mathe installation; + +(* Einlesen der benötigten Dateien *) + +BOOL PROC erforderliche systemdateien eingelesen: + + LET dateien = 53, + nicht geladen = "0", + geladen = "1"; + ROW dateien TEXT CONST systemdatei :: + ROW dateien TEXT : ("mat.ega plot", "mat.cga plot", + "mat.hercules plot", "mat.vga plot", + "ls-DIALOG 1.mathe", "ls-DIALOG 2.mathe", + "ls-DIALOG 3.mathe", "ls-DIALOG 4.mathe", + "ls-DIALOG 5.mathe", "PAC text row", + "PAC element row", "PAC op store-anpassung", + "PAC formula analyzer", "PAC formula editor-anpassung", + "mat.formeleditormanager", "mat.vector", + "mat.referenzobjekte", "mat.funktionsbibliothek", + "mat.abbildung", "mat.parser", + "mat.basis plot", "mat.picture", + "mat.specialgraphic", "mat.dialoghilfen", + "mat.masken", "mat.menufunktionen", + "mat.wertetabelle", "mat.graphicverfahren", + "mat.integrationsverfahren", "mat.iterationsverfahren", + "mat.nullstellen", "mat.umformung", + "mat.xerox4045 plot", "mat.epson-sq plot", + "mat.epson-fx plot", "mat.binder plot", + "mat.kyocera plot", "mat.laserjet plot", + "mat.hp72xx plot", "mat.hp74xx plot", + "spool cmd", "mat.ausgabe", + "mat.druckermenu", "ZEICHEN 8*8", + "ZEICHEN 9*14", "ZEICHEN 8*19", + "ZEICHEN 8*14", "ZEICHEN 6*10", + "ZEICHEN 8*16", "mathe formulare", + "ls-MENUKARTE:Mathematik", "ibmoperatoren", + "standardoperatoren"); + TEXT VAR anweisung := meldung 50, + pruefleiste := dateien * nicht geladen; + TEXT CONST ziel := dateien * geladen, + anpassung := mathe kuerzel + graphicart + plot kuerzel; + INT VAR i, zaehler := 1; + THESAURUS VAR diskinhalt; + zeige titelzeile (titel 2); + archivinhalt := empty thesaurus; + FOR i FROM 1 UPTO 4 REP + IF systemdatei (i) <> anpassung THEN + replace (pruefleiste, i, geladen) + END IF + END REP; + REP + warte auf eingabe; + FOR i FROM 1 UPTO dateien REP + IF (pruefleiste SUB i) = nicht geladen CAND + (diskinhalt CONTAINS systemdatei (i)) THEN + lade die datei + END IF + END REP; + anweisung := meldung 54 + UNTIL pruefleiste = ziel END REP; + abschlussaktivitaeten; + TRUE. + + zeige texte: + cursor (8, 8); out (meldung 44); + cursor (8, 9); out (anweisung); + cursor (8, 10); out (meldung 51); + cursor (8, 12); out (meldung 52); + cursor (8, 13); out (meldung 53). + + warte auf eingabe: + TEXT VAR ch; + REP + zeige texte; + inchar (ch); + IF ch = abbruch THEN + release (archive); + LEAVE erforderliche systemdateien eingelesen WITH FALSE + ELIF ch = weiter THEN + disable stop; + cursor (8, 9); out (del); + cursor (8,10); out (del); + cursor (8,12); out (del); + cursor (8,13); out (del); + cursor (8,15); out (del); + archive (archivname); + diskinhalt := ALL archive; + IF is error THEN + clear error; + cursor (8, 15); out (meldung 47); + enable stop; + ELSE + enable stop; + LEAVE warte auf eingabe + END IF + ELSE + out (bell) + END IF + END REP. + + lade die datei: + cursor (8, 9); out (meldung 27 + text (zaehler) + " von 50 Dateien"); + fetch (systemdatei (i), archive); + replace (pruefleiste, i, geladen); + insert (archivinhalt, systemdatei (i)); + zaehler INCR 1. + + abschlussaktivitaeten: + release (archive); + cursor (8, 8); out (meldung 28 + del); + cursor (8, 9); out (meldung 29 + del); + pause (50) + +END PROC erforderliche systemdateien eingelesen; + +(* Installation der ls task *) + +PROC install ls: + + INT VAR i; + FOR i FROM 1 UPTO anzahl ls procs REP + insertiere (lskuerzel + text (i) + mathe extension, depot task) + END REP; + do (menu ankoppeln); + IF ibmsatz THEN + do (ibmsatzzeichen) + ELSE + do (stdsatzzeichen) + END IF; + begin (fe taskname, PROC install formeleditor, fe task); + begin (mathe taskname, PROC install mathe, mathe task); + disable stop; + REP + REP + warte auf auftrag + UNTIL order code >= drucker1 erzeugen CAND + order code <= drucker8 erzeugen END REP; + druckerindex := order code - drucker erzeugen; + begin (printer taskname, PROC install printer, printer task); + gib antwort (ok) + END REP + +END PROC install ls; + +(* Installation des Formeleditors *) + +PROC install formeleditor: + + ROW anzahl feprocs TEXT CONST feproc :: + ROW anzahl feprocs TEXT : ("PAC text row", + "PAC element row", + "PAC op store-anpassung", + "PAC formula analyzer", + "PAC formula editor-anpassung", + "mat.formeleditormanager"); + INT VAR i; + FOR i FROM 1 UPTO anzahl fe procs REP + insertiere (feproc (i), depot task) + END REP; + do (menu ankoppeln); + hole notfalls (operatorendatei 1, depot task); + hole notfalls (operatorendatei 2, depot task); + IF ibmsatz THEN + do (ibmops ankoppeln) + ELSE + do (std ops ankoppeln) + END IF; + do (fe manager) + +END PROC install formeleditor; + +(* Installation des eigentlichen Mathematiksystems *) + +PROC install mathe: + + ROW anzahl matheprocs TEXT CONST dname := + ROW anzahl matheprocs TEXT : ("mat.vector", + "mat.referenzobjekte", + "mat.funktionsbibliothek", + "mat.abbildung", + "mat.parser", + "mat.masken", + mathekuerzel + graphicart + plotkuerzel, + "mat.basis plot", + "mat.picture", + "mat.specialgraphic", + "mat.dialoghilfen", + "mat.menufunktionen", + "mat.graphicverfahren", + "mat.wertetabelle", + "mat.nullstellen", + "mat.umformung", + "mat.integrationsverfahren", + "mat.iterationsverfahren"); + INT VAR i; + TEXT CONST zugehoerende zeichen := passender zeichensatz; + insertiere mathesystem; + beende installation. + + passenderzeichensatz: + IF graphicart = "vga" THEN + "ZEICHEN 8*19" + ELIF graphicart = "ega" THEN + "ZEICHEN 8*14" + ELIF graphicart = "cga" THEN + "ZEICHEN 8*8" + ELSE (* "hercules" *) + "ZEICHEN 9*14" + END IF. + + insertiere mathesystem: + do (menu ankoppeln); + hole notfalls (zugehoerende zeichen, depot task); + FOR i FROM 1 UPTO anzahl matheprocs REP + insertiere (dname (i), depot task) + PER. + + beende installation: + TEXT VAR arbeitsauftrag; + commanddialogue (FALSE); + forget (all - maskenname); + commanddialogue (TRUE); + disable stop; + REP + REP + warte auf auftrag + UNTIL order code = ebene 1 behandeln COR + order code = ebene 2 behandeln END REP; + continue (arbeitskanal); + IF order code = ebene 1 behandeln THEN + arbeitsauftrag := ebene 1 handle + ELSE + arbeitsauftrag := ebene 2 handle + END IF; + do (arbeitsauftrag); + gib bildschirm frei (ok) + END REP + +END PROC install mathe; + +(*********************************************************************) +(* I n s t a l l a t i o n d e s D r u c k e r t r e i b e r s *) +(*********************************************************************) + +PROC start printer installation: + + loesche ggf vorhandene task; + bestimme druckeranpassung; + melde installationsbeginn; + richte druckertasks ein. + + loesche ggf vorhandene task: + IF exists task (printer taskname) THEN end (/printer taskname) END IF. + + bestimme druckeranpassung: + druckerindex := druckertreiber. + + melde installationsbeginn: + INT VAR ende := anzahl pri procs; + IF druckerindex > 6 THEN + ende DECR 1 + END IF; + zeige titelzeile (titel 2); + cursor (15, 10); out (meldung 42); + cursor (15, 12); out (meldung 31 + text (ende) + " Dateien"); + installationszaehler := 0. + + richte druckertasks ein: + INT VAR i; + IF NOT exists task (pridepot taskname) THEN + begin (pridepot taskname, PROC free global manager, pridepot task) + END IF; + ls task := /ls taskname; + rufe (ls task, drucker erzeugen + druckerindex); + REP UNTIL exists task (printer taskname) CAND + status (/printer taskname) = 2 END REP; + printer task := /printer taskname; + FOR i FROM 1 UPTO ende REP + insertiere programme (printer task) + END REP + +END PROC start printer installation; + +(* Installation des Druckers *) + +PROC install printer: + + LET anzahl zeichensaetze = 3; + ROW anzahl priprocs TEXT CONST programm :: + ROW anzahl priprocs TEXT : (druckerdatei (4), + druckerdatei (4 + druckerindex), + druckerdatei (13), druckerdatei (14), + druckerdatei (15), druckerdatei (16)); + INT VAR i; + BOOL VAR plotter wird installiert := druckerindex > 6; + do (menu ankoppeln); + IF NOT plotter wird installiert THEN + hole zeichensaetze + END IF; + insertiere die einzelnen programme; + abschlussaktivitaet. + + hole zeichensaetze: + FOR i FROM 1 UPTO anzahl zeichensaetze REP + hole notfalls (druckerdatei (i), /umstell taskname) + PER. + + insertiere die einzelnen programme: + INT VAR anfang := 1; + IF plotter wird installiert THEN + anfang := 2 + END IF; + FOR i FROM anfang UPTO anzahl pri procs REP + insertiere (programm (i), /umstell taskname) + END REP. + + abschlussaktivitaet: + IF NOT plotter wird installiert THEN + FOR i FROM 1 UPTO anzahl zeichensaetze REP + forget (druckerdatei (i), quiet) + END REP + END IF; + IF plotter wird installiert THEN + do (plotter ein) + ELSE + do (plotter aus) + END IF; + disable stop; + REP + REP + warte auf auftrag + UNTIL order code = system starten END REP; + continue (arbeitskanal); + do (druckmenu handle); + gib bildschirm frei (ok) + END REP + +END PROC install printer; + +(*********************************) +(* H i l f s p r o g r a m m e *) +(*********************************) + +(* Programme zur Ausführung des 'insert' *) + +PROC insertiere programme (TASK VAR zieltask): + + installationszaehler INCR 1; + cursor (40, 12); out (text (installationszaehler)); + rufe (zieltask, insertieren); + IF antwort <> ok THEN + errorstop (meldung 32) + END IF + +END PROC insertiere programme; + +PROC insertiere (TEXT CONST name, TASK CONST herkunft): + + REP + warte auf auftrag + UNTIL order code = insertieren END REP; + disable stop; + hole notfalls (name, herkunft); + insert (name); + IF is error THEN + clear error; + gib antwort (fehler) + ELSE + gib antwort (ok) + END IF; + forget (name, quiet); + enable stop + +END PROC insertiere; + +PROC hole notfalls (TEXT CONST name, TASK CONST herkunft): + + IF NOT exists (name) THEN + fetch (name, herkunft) + END IF + +END PROC hole notfalls; + +(***********************************************) +(* Prozeduren zur Intertaskkommunikation *) +(***********************************************) + +(* Die folgenden Prozeduren werden immer da eingesetzt, wo bei + 'call', 'send' und 'wait' der übergebene Datenraum ignoriert + werden kann *) + +PROC rufe (TASK CONST zieltask, INT CONST auftrag): + + message ds := nilspace; + call (zieltask, auftrag, message ds, antwort); + forget (message ds) + +END PROC rufe; + +PROC warte auf auftrag: + + wait (message ds, order code, order task); + forget (message ds) + +END PROC warte auf auftrag; + +PROC gib antwort (INT CONST antwortcode): + + message ds := nilspace; + send (order task, antwortcode, message ds); +(*forget (message ds) *) + +END PROC gib antwort; + +PROC uebergib bildschirm (TASK CONST t, INT CONST auftrag): + + break (quiet); + rufe (t, auftrag); + continue (arbeitskanal) + +END PROC uebergib bildschirm; + +PROC gib bildschirm frei (INT CONST antwortcode): + + break (quiet); + gib antwort (antwortcode) + +END PROC gib bildschirm frei; + +(********************************************************) +(* Auswahlmenüs für Endgeräteanpassungen *) +(********************************************************) + +TEXT PROC graphikkarte: + + LET anzahl plotprocs = 4; + ROW anzahl plotprocs TEXT CONST plotname := + ROW anzahl plotprocs TEXT : ("hercules","cga","ega","vga"); + INT VAR i := 1, zeile; + commanddialogue (TRUE); + zeige titelzeile (titel 2); + FOR zeile FROM 6 UPTO 17 REP + cursor (16, zeile); out (menu 2 (zeile - 5)) + END REP; + REP + cursor (16, 20); out (invers (text (plotname (i), 11))); + IF yes (meldung 33) THEN + commanddialogue (FALSE); + LEAVE graphikkarte WITH plotname (i) + END IF; + i := i MOD anzahl plotprocs + 1 + END REP; + plotname (i) + +END PROC graphikkarte; + +INT PROC druckertreiber: + + LET anzahl plotterprocs = 8; + ROW anzahl plotterprocs TEXT CONST plotname := + ROW anzahl plotterprocs TEXT : ("xerox4045", "epson-sq", "epson-fx", + "binder", "kyocera", "laserjet", + "hp72xx", "hp74xx"); + INT VAR i, zeile; + commanddialogue (TRUE); + zeige titelzeile (titel 3); + FOR zeile FROM 3 UPTO 16 REP + cursor (16, zeile); out (menu 3 (zeile - 2)) + END REP; + i := 1; + REP + cursor (16, 20); out (invers (text (plotname (i), 11))); + IF yes (meldung 33) THEN + commanddialogue (FALSE); + LEAVE druckertreiber WITH i + END IF; + i := i MOD anzahl plotterprocs + 1 + END REP; + i + +END PROC druckertreiber; + +(************************************************) +(* Bildschirmausgaben *) +(************************************************) + +PROC zeige titelzeile (TEXT CONST fktbezeichner): + + TEXT CONST zeile := text (systemname, 78 - length (fktbezeichner)) + + fktbezeichner; + page; + cursor (1,1); out (invers (text (zeile, 79))) + +END PROC zeige titelzeile; + +PROC zeige installationsergebnis (TEXT CONST ziel, BOOL VAR erfolg): + + zeige titelzeile (ziel); + IF is error THEN + clear error; + gib meldung (meldung 22); + erfolg := FALSE + ELSE + gib meldung (meldung 21); + erfolg := TRUE + END IF + +END PROC zeige installationsergebnis; + +PROC gib meldung (TEXT CONST meldungstext): + + cursor (1, 23); out (meldungstext); + cursor (1, 24); out (invers (text (meldung 26, 77))); + clear buffer; pause + +END PROC gib meldung; + +PROC clear buffer: + + REP UNTIL incharety = niltext PER + +END PROC clear buffer; + +BOOL PROC ja (TEXT CONST frage): + + BOOL VAR antwort; + commanddialogue (TRUE); + cursor (1, 22); antwort := yes (frage); + cursor (1, 22); out (del); + commanddialogue (FALSE); + antwort + +END PROC ja; + +TEXT PROC invers (TEXT CONST t): + + beginmark + t + endmark + +END PROC invers; + +(*************************************************************************) +(* P a s s w o r t s c h u t z *) +(*************************************************************************) +(* Zur Vermeidung einer irrtümlichen oder 'böswilligen' Neuinstallation *) +(* des Mathesystems kann nach erfolgter Installation ein Passwort verge- *) +(* ben werden, das beim Versuch der Neuinstallation abgefragt wird. *) +(*************************************************************************) + +BOOL PROC korrektes password: + + installationspassword = niltext COR password getroffen. + + password getroffen: + TEXT VAR eingabe; + cursor (24, 18); out (meldung 45 + del); + get secret line (eingabe); + IF eingabe = installationspassword THEN + cursor (24, 18); out (del); + LEAVE password getroffen WITH TRUE + END IF; + out (bell); + FALSE + +END PROC korrektes password; + +PROC definiere password: + + installationspassword := niltext; + cursor (1, 23); out (delpage); + IF ja (meldung 46) THEN + cursor (1, 23); out (meldung 45 + beginmark + left); + editget (installationspassword, 40, 20); + out (endmark) + END IF + +END PROC definiere password; + +END PACKET mathe verwaltung; + + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.vga plot b/app/schulis-mathematiksystem/1.0/src/mat.vga plot new file mode 100644 index 0000000..730434b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.vga plot @@ -0,0 +1,3 @@ +PACKEToldproceduresDEFINESoldcursor,oldgetcursor,oldout:PROColdcursor(INT CONSTa,b):cursor(a,b)END PROColdcursor;PROColdgetcursor(INT VARa,b):getcursor(a,b)END PROColdgetcursor;PROColdout(TEXT CONSTtext):out(text)END PROColdoutEND PACKEToldprocedures;PACKETvgaplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,terminalkorrekt,anpassungstyp,clear,pen,move,draw,cursor,getcursor,out,zeichensatz,where,zeichenhoehe,zeichenbreite,systemimgraphicmodus,initstift,aktuellerstift,neuerstift,sekantenstift,normalenstift,tangentenstift,lotstift,punktstift:LEThorfaktor=29.09091,vertfaktor=35.0365,anzahlx=640,anzahly=480,delete=0,nothing=0,durchgehend=1,gepunktet=2,kurzgestrichelt=3,langgestrichelt=4,strichpunkt=5,colourcode=256,xpixel=640,ypixel=480,bit14=16384;LET POS=STRUCT(INTx,y);LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ZEICHENSATZ VARzeichen;INT VARactthick:=0,dummy;POS VARpos:=POS:(0,0);REAL VARbuchstabenhoehe:=0.5422916,buchstabenbreite:=0.275;BOOL PROCterminalkorrekt:page;putline("Mit Ihrer Task können Sie nur an Graphik-Bildschirmen");putline("arbeiten, die durch die VGA-Karte (oder eine kompatible");putline("Karte) unterstützt werden.");line;yes("Ist Ihr Bildschirm von diesem Typ")END PROCterminalkorrekt;TEXT PROCanpassungstyp:"vga"END PROCanpassungstyp;PROCzeichensatz(TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARnewzeichen:=old(name);zeichen:=newzeichen;ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=22.0;ycm:=13.7;xpixel:=anzahlx-1;ypixel:=anzahly-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCbeginplot:graphicon:=TRUE ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:control(-5,3,0,dummy);graphicon:=FALSE ENDPROCplotend;PROCclear:control(-5,17,0,dummy);control(-4,0,colourcode,dummy);actthick:=0;END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):actthick:=thickness;control(-8,linetypecode,foregroundcode,dummy).linetypecode:SELECTlinetypeOF CASEnothing:0CASEdurchgehend:-1CASEgepunktet:21845CASEkurzgestrichelt:3855CASElanggestrichelt:255CASEstrichpunkt:4351OTHERWISElinetypeEND SELECT.foregroundcode:IFforeground=deleteTHEN0ELIFforeground<0THEN128ELSEforegroundFI.END PROCpen;PROCmove(INT CONSTx,y):xMOVEy;pos:=POS:(x,y)END PROCmove;PROCdraw(INT CONSTx,y):pos.xDRAWpos.y;control(-6,x,ypixel-1-y,dummy);pos:=POS:(x,y).END PROCdraw;INT VARxfak:=zeichen.width,yfak:=zeichen.height;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxpos:=pos.x,ypos:=pos.y,i,n,x,y;BOOL VARmoveorder;setcharacterheightandwidth;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;pos.xMOVEpos.y.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen.width;yfak:=zeichen.heightELSExfak:=int(horfaktor*width+0.5);yfak:=int(vertfaktor*height+0.5)FI.characterxstep:IFwidth<>0.0THENint(cosd(angle)*horfaktor*width+0.5)ELSEint(cosd(angle)*real(zeichen.width)+0.5)FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height+0.5)ELSEint(sind(angle)*real(zeichen.height)+0.5)FI.drawcharacteri:IFcode(recordSUBi)<32THENsteuerzeichenELSEnormalezeichenFI.steuerzeichen:IFcode(recordSUBi)=7THENoldout("�")FI.normalezeichen:TEXT CONSTchar:=zeichen.char[code(recordSUBi)];INT VARxold:=xpos,yold:=ypos;FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENxpos+xMOVEypos+y;ELSExoldDRAWyold;xpos+xDRAWypos+yFI;xold:=xpos+x;yold:=ypos+y;PER;xposINCRxstep;yposINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=(x*xfak)DIVzeichen.width;y:=(y*yfak)DIVzeichen.heightEND PROCvalue;OP MOVE(INT + CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-7,xwert,ypixel-1-ywert,dummy)END OP MOVE;OP DRAW(INT CONSTx,y):INT VARxwert:=x,ywert:=y;grenzkontrolle(xwert,ywert);control(-6,xwert,ypixel-1-ywert,dummy)END OP DRAW;PROCgrenzkontrolle(INT VARx,y):IFx>xpixel-1THENx:=xpixel-1ELIFx<0THENx:=0END IF;IFy>ypixel-1THENy:=ypixel-1ELIFy<0THENy:=0END IF END PROCgrenzkontrolle;PROCout(TEXT CONSTtext):TEXT VARtextcopy:=text;IF NOTgraphiconTHENoldout(text)ELSEneuesoutFI.neuesout:INT CONSTxpos:=(spalte-1)*zeichen.width,ypos:=anzahly-(zeile*zeichen.height);pruefetext;loeschealtentext;gibneuentextaus.pruefetext:IFspalte+(LENGTHtext)-1>anzahlxDIVzeichen.widthTHENtextcopy:=subtext(text,1,anzahlxDIVzeichen.width-spalte+1)FI.loeschealtentext:IFcode(textcopySUB1)>31THENclearFI.clear:INT CONSTxbis:=xpos+(LENGTHtextcopy)*zeichen.width-1;INT VARi;pen(0,0,0,1);FORiFROM0UPTOzeichen.height-1REPmove(xpos,ypos+i);draw(xbis,ypos+i)PER;move(xpos,ypos);pen(0,1,0,1).gibneuentextaus:draw(textcopy);cursor(spalte+(LENGTHtextcopy),zeile)END PROCout;INT VARzeile:=1,spalte:=1;BOOL VARgraphicon:=FALSE;PROCgetcursor(INT VARa,b):IFgraphiconTHENa:=spalte;b:=zeileELSEoldgetcursor(a,b)FI END PROCgetcursor;PROCcursor(INT CONSTa,b):IFgraphiconTHEN IFa>anzahlxDIVzeichen.widthTHENspalte:=anzahlxDIVzeichen.widthELIFa<=0THENspalte:=1ELSEspalte:=aFI;IFb>anzahlyDIVzeichen.heightTHENzeile:=anzahlyDIVzeichen.heightELIFb<=0THENzeile:=1ELSEzeile:=bFI ELSEoldcursor(a,b)FI END PROCcursor;PROCwhere(INT VARx,y):x:=pos.x;y:=pos.yEND PROCwhere;INT PROCzeichenbreite:8END PROCzeichenbreite;INT PROCzeichenhoehe:19END PROCzeichenhoehe;BOOL PROCsystemimgraphicmodus:graphiconEND PROCsystemimgraphicmodus;LETanzahlfktstifte=5;ROWanzahlfktstifteINT CONSTstiftpalette:=ROWanzahlfktstifteINT:(1,2,3,4,5);INT VARstiftzeiger:=0;PROCinitstift:stiftzeiger:=0END PROCinitstift;INT PROCneuerstift:stiftzeiger:=stiftzeigerMODanzahlfktstifte+1;aktuellerstiftEND PROCneuerstift;INT PROCaktuellerstift:stiftpalette(stiftzeiger)END PROCaktuellerstift;INT PROCsekantenstift:2END PROCsekantenstift;INT PROCnormalenstift:2END PROCnormalenstift;INT PROCtangentenstift:2END PROCtangentenstift;INT PROClotstift:2END PROClotstift;INT PROCpunktstift:1END PROCpunktstift;END PACKETvgaplot;zeichensatz("ZEICHEN 8*19") + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle new file mode 100644 index 0000000..223d7b8 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.wertetabelle @@ -0,0 +1,4 @@ +PACKETwertetabelleDEFINESerstellewertetabelle:LETniltext="",del="�",blank=" ",unterstrichzeichen="_",maximalanzahl=4000.0,maxfelder=100,weiterarbeit="w",naechste="q",abbruchzeichen="!",fktbezeichnung="Fktswert",PARAMETER=ROWmaxfelderTEXT;PROCerstellewertetabelle(ABBILDUNG CONSTfunktion):VECTOR VAReingabewerte;REAL VARendwert,schrittweite;INT VARlaufvariablenindex,durchgangsnummer:=1,i;WINDOW VARwt:=window(2,7,77,16);TEXT VARausstieg,zulaessigezeichen;TEXT CONSTkurzerstrich:=25*unterstrichzeichen,wert1:="-5.0"+kurzerstrich,wert2:="5.0"+kurzerstrich,wert3:="1.0"+kurzerstrich,tabellendateiname:=scratchdateiname;FILE VARh:=sequentialfile(modify,tabellendateiname);schreibearbeitsfunktion(funktion);bestimmelaufvariablenwerte;erstellegegebenenfallsaufloesungderfunktion;bearbeitediefunktion;loeschegegebenenfallsaufloesungderfunktion.bestimmelaufvariablenwerte:TAG VAReingabemaske:=formular(2);initialisierelaufvariablenformular;editierelaufvariablenformular.initialisierelaufvariablenformular:PARAMETER VARraster;INT VARstartfeld:=2;raster(1):=niltext;raster(2):=NAMElistenanfang(abbildungsvariablen(funktion));raster(3):=wert1;raster(4):=wert2;raster(5):=wert3;IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENsetfieldinfos(eingabemaske,2,TRUE,TRUE,FALSE);startfeld:=3ELSEraster(2)CATkurzerstrichEND IF;zulaessigezeichen:="?wqm".editierelaufvariablenformular:REPbearbeitelaufvariablenformular;werteausstiegszeichenausEND REP.bearbeitelaufvariablenformular:footnote(anwendungstext(115));show(eingabemaske);strich(5);putget(eingabemaske,raster,startfeld,ausstieg);IFiserrorTHENclearerror;gibmeldung(errormessage);ausstieg:=naechsteEND IF.werteausstiegszeichenaus:SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:gibinformationenzumlaufvariablenformularCASE2:verarbeiteeingabenCASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleEND SELECT.verarbeiteeingaben:footnote(anwendungstext(114));IFkorrektervariablenindexCANDkorrekteranfangswertCANDkorrekterendwertCANDkorrekteschrittweiteTHEN FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP;LEAVEeditierelaufvariablenformularEND IF;FORiFROM2UPTO5REPraster(i)CAT((20-length(raster(i)))*unterstrichzeichen);changeall(raster(i),blank,unterstrichzeichen)END REP.korrektervariablenindex:TERM VARvaradresse:=listenanfang(abbildungsvariablen(funktion));IFebene=1CORlaenge(abbildungsvariablen(funktion))=1THENlaufvariablenindex:=1;TRUE ELSEchangeall(raster(2),unterstrichzeichen,blank);varadresse:=listenposition(abbildungsvariablen(funktion),raster(2));IFvaradresse=nilTHENgibmeldung(anwendungstext(156));startfeld:=2;FALSE ELSElaufvariablenindex:=PLATZvaradresse;TRUE END IF END IF.korrekteranfangswert:changeall(raster(3),unterstrichzeichen,blank);REAL VARanfangswert:=realzahl(raster(3));IFiserrorTHENclearerror;gibmeldung(anwendungstext(157));startfeld:=3;FALSE ELSEeingabewerte:=vector(laenge(abbildungsvariablen(funktion)));replace(eingabewerte,laufvariablenindex,anfangswert);TRUE END IF.korrekterendwert:changeall(raster(4),unterstrichzeichen,blank);endwert:=realzahl(raster(4));IFiserrorTHENclearerror;gibmeldung(anwendungstext(158));startfeld:=4;FALSE ELIFendwert<anfangswertTHENgibmeldung(anwendungstext(96));startfeld:=4;FALSE ELSE TRUE END IF.korrekteschrittweite:changeall(raster(5),unterstrichzeichen,blank);schrittweite:=realzahl(raster(5));IFiserrorCORanfangswert+maximalanzahl*schrittweite<endwertTHEN IFiserrorTHENclearerrorEND IF;gibmeldung(anwendungstext(159));startfeld:=5;FALSE ELSE TRUE END IF.gibinformationenzumlaufvariablenformular:outframe(wt);show(formular(5));warte.erstellegegebenenfallsaufloesungderfunktion:BOOL VARloeschflag:=komplexefunktion(funktion);ABBILDUNG VARf:=funktion;IFloeschflagTHENf:=aufloesung(f)END IF.bearbeitediefunktion:INT VARersterauszugebendersatz,ersteauszugebendespalte;REPbestimmeparameterwerte;berechnediewertetabelle;zeigewertetabelle;IFlaenge(abbildungsvariablen(f))=1THENforget( +tabellendateiname,quiet);LEAVEbearbeitediefunktionEND IF;durchgangsnummerINCR1END REP.bestimmeparameterwerte:IFlaenge(abbildungsvariablen(f))=1THEN LEAVEbestimmeparameterwerteEND IF;cursor(1,4);out(anwendungstext(208));REPmacheeingabe;werteausstiegausEND REP.macheeingabe:zulaessigezeichen:="?wqm";footnote(anwendungstext(115));cursor(12,4);belegeparameter(eingabewerte,laufvariablenindex,abbildungsvariablen(f),zulaessigezeichen,ausstieg).werteausstiegaus:SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:gibinformationzurparametereingabeCASE2:cursor(1,4);out(del);LEAVEbestimmeparameterwerteCASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEbearbeitediefunktionEND SELECT.gibinformationzurparametereingabe:outframe(wt);show(formular(8));warte;page(wt,TRUE).berechnediewertetabelle:VECTOR VARparameter:=eingabewerte,y:=vector(laenge(abbildungsterme(f)));REAL VARx;INT VARzeilennummer:=1;INT CONSTyscrollbeginn:=laenge(abbildungsvariablen(f))+2;TEXT VARausgabezeile;TEXT CONSTvariablenname:=NAMEauswahl(abbildungsvariablen(f),laufvariablenindex);IFlaenge(abbildungsvariablen(f))>1CANDlaenge(abbildungsvariablen(f))<10THENtrageparameterbelegunginwertetabelleeinEND IF;schreibediewertetabellenueberschriften;schreibewertetabellenzeilen.trageparameterbelegunginwertetabelleein:INT VARk:=1;WHILEk<=laenge(abbildungsvariablen(f))REP IFk<>laufvariablenindexTHEN IFdurchgangsnummer=1THENergaenzewertetabellendatei(h,zeilennummer,text(NAMEauswahl(abbildungsvariablen(f),k),gesamtstellen(ebene)))END IF;ergaenzewertetabellendatei(h,zeilennummer,senkrecht+text(wandle(eingabewerteSUBk),laenge(abbildungsterme(f))*gesamtstellen(ebene)+laenge(abbildungsterme(f))-1));zeilennummerINCR1END IF;kINCR1END REP.schreibediewertetabellenueberschriften:ergaenzewertetabellendatei(h,zeilennummer,ueberschrift);zeilennummerINCR1;ergaenzewertetabellendatei(h,zeilennummer,unterstrich).ueberschrift:TEXT VARzeile:=niltext;IFdurchgangsnummer=1THENzeileCATtext(variablenname,gesamtstellen(ebene))END IF;IFlaenge(abbildungsterme(f))=1THENzeileCATtext(senkrecht+fktbezeichnung,gesamtstellen(ebene)+1)ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPzeileCATtext(senkrecht+fktbezeichnung+text(i,2),gesamtstellen(ebene)+1)END REP END IF;zeile.unterstrich:TEXT VARus:=niltext;IFdurchgangsnummer=1THENusCAT(gesamtstellen(ebene)*waagerecht);END IF;FORiFROM1UPTOlaenge(abbildungsterme(f))REPusCAT(kreuz+gesamtstellen(ebene)*waagerecht)END REP;us.schreibewertetabellenzeilen:footnote(anwendungstext(117));cursor(36,24);REPbefragetastatur;zeilennummerINCR1;x:=parameterSUBlaufvariablenindex;ausgabezeile:=niltext;IFdurchgangsnummer=1THENausgabezeileCATwandle(x)END IF;y:=ergebnis(f,parameter);IFiserrorTHENclearerror;FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATgesamtstellen(ebene)*"-"END REP ELSE FORiFROM1UPTOlaenge(abbildungsterme(f))REPausgabezeileCATsenkrecht;ausgabezeileCATwandle(ySUBi)END REP END IF;ergaenzewertetabellendatei(h,zeilennummer,ausgabezeile);cout(zeilennummer-yscrollbeginn+1);IFx=endwertTHEN LEAVEberechnediewertetabelleELIFx+schrittweite>endwertTHENx:=endwertELSEx:=x+schrittweiteEND IF;replace(parameter,laufvariablenindex,x)END REP.befragetastatur:IFincharety=abbruchzeichenTHENforget(tabellendateiname,quiet);LEAVEbearbeitediefunktionEND IF.zeigewertetabelle:TEXT VARfusszeile;zulaessigezeichen:="?dqm";IFlaenge(abbildungsvariablen(f))<>1THENzulaessigezeichenCATweiterarbeit;fusszeile:=anwendungstext(133)ELSEfusszeile:=anwendungstext(171)END IF;ersterauszugebendersatz:=yscrollbeginn;ersteauszugebendespalte:=gesamtstellen(ebene)+2+(durchgangsnummer-1)*laenge(abbildungsterme(f))*(gesamtstellen(ebene)+1);outframe(wt);REPfootnote(fusszeile);scroll(wt,tabellendateiname,gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1,ersterauszugebendersatz,ersteauszugebendespalte,zulaessigezeichen,ausstieg);SELECTpos(zulaessigezeichen,ausstieg)OF CASE1:zeigeinformationstextCASE2:aufbereitetdrucken(tabellendateiname,text(funktionsstring(funktion), +druckspalten),gesamtstellen(ebene)+2,yscrollbeginn,gesamtstellen(ebene)+1);outframe(wt)CASE3,4:forget(tabellendateiname,quiet);verfahrensende(ausstieg);LEAVEerstellewertetabelleCASE5:LEAVEzeigewertetabelleEND SELECT END REP.zeigeinformationstext:show(formular(9));warte.loeschegegebenenfallsaufloesungderfunktion:IFloeschflagTHENloescheabbildung(f)END IF END PROCerstellewertetabelle;PROCergaenzewertetabellendatei(FILE VARf,INT CONSTzeile,TEXT CONSTergaenzung):TEXT VARsatz;toline(f,zeile);readrecord(f,satz);IFsatz=niltextTHENinsertrecord(f);END IF;writerecord(f,satz+ergaenzung)END PROCergaenzewertetabellendatei;END PACKETwertetabelle; + diff --git a/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot new file mode 100644 index 0000000..ec5eb2c --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mat.xerox4045 plot @@ -0,0 +1,4 @@ +PACKETxeroxplotDEFINESdrawingarea,beginplot,endplot,plotend,stdhoehe,stdbreite,clear,pen,move,zeichensatz,draw,plotterkanal:LEThorpixel=720,verpixel=532,intsperscanline=45,horfaktor=29.528,vertfaktor=29.528,bit14=16384,namederbitmap="Plotter",nameofspooltask="PRINTER",datenraumtypfuerbitmap=1055;BOUND ROWverpixelROWintsperscanlineINT VARbitmap;INT VARanzahlgleichersixel,altessixel,plotterchannel:=15;INT VARxpos,ypos,xfak,yfak,ausgewaehlt,nextpointnr,linienraster,linientyp;REAL VARbuchstabenhoehe:=0.75,buchstabenbreite:=0.305,faktor;BOOL VARloeschstift,characterdefined:=FALSE;LET ZEICHENSATZ=STRUCT(ROW255TEXTchar,INTwidth,height);ROW3ZEICHENSATZ VARzeichen;PROCdrawingarea(REAL VARxcm,ycm,INT VARxpixel,ypixel):xcm:=24.4;ycm:=18.0;xpixel:=horpixel-1;ypixel:=verpixel-1;END PROCdrawingarea;REAL PROCstdhoehe:buchstabenhoeheEND PROCstdhoehe;REAL PROCstdbreite:buchstabenbreiteEND PROCstdbreite;PROCstdhoehe(REAL CONSThoehe):buchstabenhoehe:=hoeheEND PROCstdhoehe;PROCstdbreite(REAL CONSTbreite):buchstabenbreite:=breiteEND PROCstdbreite;PROCbeginplot:xpos:=0;ypos:=0;pen(0,1,0,1)ENDPROCbeginplot;PROCendplot:ENDPROCendplot;PROCplotend:INT VARbitsleft:=0,bits,hilfsvariable,buffer;anzahlgleichersixel:=1;druckerkanalankoppeln;bereitedruckeraufgrafikausgabevor;gibdiebitmapaus;druckedieseite;gibdruckerkanalfrei.druckerkanalankoppeln:spoolcontrolpassword("");waitforhalt(/nameofspooltask);continue(plotterkanal).gibdruckerkanalfrei:break(quiet);spoolcontrolpassword("");startspool(/nameofspooltask).bereitedruckeraufgrafikausgabevor:out("�+X
�+0XCP12.5iso-L
�0"+"�+P
�m2480,0,0,0,3508
�gw");magnification4;out(";236,312,"+text(horpixel)+","+text(verpixel)+"
");altessixel:=-53.magnification4:out("4").gibdiebitmapaus:INT VARi;FORiFROMverpixelDOWNTO1REPgibeinezeilederbitmapausPER.gibeinezeilederbitmapaus:INT VARj;FORjFROM1UPTOintsperscanlineREPbits:=bitmap(i)(j);gibdie16bitsalssixelausPER.gibdie16bitsalssixelaus:SELECTbitsleftOF CASE0:sendemitshift0CASE2:sendemitshift2CASE4:sendemitshift4END SELECT.sendemitshift0:sixelsend(firstsixbits);sixelsend((bitsAND1008)DIV16);buffer:=((bitsAND15)*4);bitsleft:=4.firstsixbits:hilfsvariable:=bits;rotate(hilfsvariable,6);hilfsvariableAND63.sendemitshift2:sixelsend(buffer+firstfourbits);sixelsend((bitsAND4032)DIV64);sixelsend(bitsAND63);bitsleft:=0.firstfourbits:hilfsvariable:=bits;rotate(hilfsvariable,4);hilfsvariableAND15.sendemitshift4:sixelsend(buffer+firsttwobits);sixelsend((bitsAND16128)DIV256);sixelsend((bitsAND252)DIV4);buffer:=((bitsAND3)*16);bitsleft:=2.firsttwobits:hilfsvariable:=bits;rotate(hilfsvariable,2);hilfsvariableAND3.druckedieseite:sendeletztessixel;out("��+P
").sendeletztessixel:sixelsend(-1).END PROCplotend;PROCclear:richtebitmapein;loeschebitmap;beginplot.richtebitmapein:IFexists(namederbitmap)THENforget(namederbitmap,quiet)FI;bitmap:=new(namederbitmap);type(old(namederbitmap),datenraumtypfuerbitmap).loeschebitmap:INT VARi,j;FORiFROM1UPTOverpixelREP FORjFROM1UPTOintsperscanlineREPbitmap(i)(j):=0PER PER.END PROCclear;PROCpen(INT CONSTbackground,foreground,thickness,linetype):linientyp:=linetype;linienraster:=neueslinienraster;nextpointnr:=0;loeschstift:=foreground=0.neueslinienraster:SELECTlinientypOF CASE2:1365CASE3:975CASE4:255CASE5:639OTHERWISE0END SELECT.END PROCpen;PROCmove(INT CONSTx,y):xpos:=x;ypos:=yEND PROCmove;PROCdraw(INT CONSTgoalx,goaly):IFlinientyp<>0THENzeichnelinieFI;xpos:=goalx;ypos:=goaly;korrigierenextpointnr.zeichnelinie:bereitezeichnenvor;verteilegeradeundschraegeschrittemoeglichstgleichmaessig.bereitezeichnenvor:INT VARdx:=goalx-xpos,dy:=goaly-ypos,xdir:=sign(dx),ydir:=sign(dy),xsteps:=abs(dx),ysteps:=abs(dy),totalsteps,biassteps,horstep,verstep;IFxsteps>ystepsTHENtotalsteps:=xsteps;biassteps:=ysteps;horstep:=xdir;verstep:=0ELSEtotalsteps:=ysteps;biassteps:=xsteps;horstep:=0;verstep:=ydirFI.verteilegeradeundschraegeschrittemoeglichstgleichmaessig:INT VARs:=totalstepsDIV2,x:=xpos,y:=ypos;INT VARi;FORiFROM0UPTOtotalstepsREPzeichneaktuellenpunktderlinie;sINCRbiassteps;IFs< +totalstepsTHENmachegeradenschrittELSEmacheschraegenschritt;sDECRtotalstepsFI PER.zeichneaktuellenpunktderlinie:IFlinienraster=0THENplotpixel(x,y)ELSEzeichnepunktnurwennerwuenschtFI.zeichnepunktnurwennerwuenscht:IFbit(linienraster,nextpointnr)THENplot(x,y)FI;nextpointnr:=(nextpointnr+1)MOD12.machegeradenschritt:xINCRhorstep;yINCRverstep.macheschraegenschritt:xINCRxdir;yINCRydir.korrigierenextpointnr:IFnextpointnr=0THENnextpointnr:=11ELSEnextpointnrDECR1FI.END PROCdraw;PROCzeichensatz(INT CONSTi,TEXT CONSTname):IFexists(name)THEN BOUND ZEICHENSATZ VARneuerzeichensatz:=old(name);zeichen(i):=neuerzeichensatz;characterdefined:=TRUE ELSEerrorstop("Der Zeichensatz "+name+" existiert nicht")FI END PROCzeichensatz;PROCdraw(TEXT CONSTrecord,REAL CONSTangle,height,width):REAL VARdiff:=0.0;setcharacterheightandwidth;zeichensatzauswaehlen;IFlinientyp<>0ANDcharacterdefinedTHENdrawgraphiccharacterFI.drawgraphiccharacter:INT CONSTxstep:=characterxstep,ystep:=characterystep;INT VARxposition:=xpos,yposition:=ypos,i,n,x,y;BOOL VARmoveorder;FORiFROM1UPTOlength(record)REPdrawcharacteriPER;move(xpos,ypos).characterxstep:REAL VARrundungsfehler:=0.0;IFwidth<>0.0THENrundungsfehler:=frac(cosd(angle)*horfaktor*width);int(cosd(angle)*horfaktor*width)ELSEint(cosd(angle)*real(zeichen(ausgewaehlt).width))FI.characterystep:IFheight<>0.0THENint(sind(angle)*vertfaktor*height)ELSEint(sind(angle)*real(zeichen(ausgewaehlt).height))FI.setcharacterheightandwidth:IFwidth=0.0ANDheight=0.0THENxfak:=zeichen(2).width;yfak:=zeichen(2).heightELSExfak:=int(horfaktor*width);yfak:=int(vertfaktor*height)FI.zeichensatzauswaehlen:beurteilenutzenderzeichensaetze;IFqualitaet(1)<qualitaet(2)THEN IFqualitaet(1)<=qualitaet(3)THENausgewaehlt:=1;faktor:=matrixfaktor(1)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI ELIFqualitaet(2)<=qualitaet(3)THENausgewaehlt:=2;faktor:=matrixfaktor(2)ELSEausgewaehlt:=3;faktor:=matrixfaktor(3)FI.beurteilenutzenderzeichensaetze:ROW6INT CONSTdimens:=ROW6INT:(6,10,8,8,8,16);ROW3INT VARqualitaet:=ROW3INT:(100,100,100);ROW3REAL VARmatrixfaktor:=ROW3REAL:(1.0,1.0,1.0);INT VARmatrixbreite,matrixhoehe;FORiFROM1UPTO3REPn:=1;matrixbreite:=dimens(2*i-1);matrixhoehe:=dimens(2*i)-freizeilen;WHILExfakDIV(n*matrixbreite)>0CANDyfakDIV(n*matrixhoehe)>0REPqualitaet(i):=(xfak-n*matrixbreite)+(yfak-n*matrixhoehe);nINCR1PER;matrixfaktor(i):=real(n-1);IFn=1THENmatrixfaktor(i):=verkleinerungsfaktorFI PER.verkleinerungsfaktor:IF(matrixbreite-xfak)>(matrixhoehe-yfak)THENreal(xfak)/real(matrixbreite)ELSEreal(yfak)/real(matrixhoehe)FI.freizeilen:SELECTiOF CASE1:0CASE2:0CASE3:1OTHERWISE0END SELECT.drawcharacteri:TEXT CONSTchar:=zeichen(ausgewaehlt).char[code(recordSUBi)];FORnFROM1UPTOlength(char)DIV4REPvalue(char,n,x,y,moveorder);IFmoveorderTHENmove(xposition+x,yposition+y)ELSEdraw(xposition+x,yposition+y)FI PER;diffINCRrundungsfehler;xpositionINCRxstep;IFdiff>1.0THENxpositionINCR1;diffDECR1.0FI;ypositionINCRystep.END PROCdraw;PROCdraw(TEXT CONSTrecord):draw(record,0.0,0.0,0.0)END PROCdraw;PROCvalue(TEXT CONSTchar,INT CONSTn,INT VARx,y,BOOL VARmove):x:=charISUBn+n-1;y:=charISUBn+n;IFx<0THEN IF(xANDbit14)<>0THENmove:=FALSE ELSEmove:=TRUE;x:=xXORbit14FI ELSE IF(xANDbit14)<>0THENmove:=TRUE;x:=xXORbit14ELSEmove:=FALSE FI FI;x:=int(real(x)*faktor);y:=int(real(y)*faktor)END PROCvalue;PROCplotpixel(INT CONSTx,y):IFgueltigerpunktTHEN IFloeschstiftTHENunplot(x,y)ELSEplot(x,y)FI FI.gueltigerpunkt:x<horpixelANDy<verpixel.END PROCplotpixel;PROCplot(INT CONSTx,y):setbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCplot;PROCunplot(INT CONSTx,y):resetbit(bitmap(y+1)(xDIV16+1),15-xMOD16)END PROCunplot;PROCsixelsend(INT CONSTneuessixel):IFneuessixel<>altessixelTHENsendealtessixel;altessixel:=neuessixelELIFanzahlgleichersixel<32000THENanzahlgleichersixelINCR1ELSEsendealtessixel;altessixel:=neuessixelFI.sendealtessixel:IFanzahlgleichersixel=1THENout(code(altessixel+63))ELSEout(text(anzahlgleichersixel)+code(altessixel+63));anzahlgleichersixel:=1FI.END PROCsixelsend;INT PROCplotterkanal:plotterchannel +END PROCplotterkanal;PROCplotterkanal(INT CONSTnr):plotterchannel:=nr;END PROCplotterkanal;END PACKETxeroxplot;plotterkanal(15);zeichensatz(1,"ZEICHEN 6*10");zeichensatz(2,"ZEICHEN 8*8");zeichensatz(3,"ZEICHEN 8*16"); + diff --git a/app/schulis-mathematiksystem/1.0/src/mathe formulare b/app/schulis-mathematiksystem/1.0/src/mathe formulare Binary files differnew file mode 100644 index 0000000..8a6400e --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/mathe formulare diff --git a/app/schulis-mathematiksystem/1.0/src/spool cmd b/app/schulis-mathematiksystem/1.0/src/spool cmd new file mode 100644 index 0000000..6a78cc1 --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/spool cmd @@ -0,0 +1,3 @@ +PACKETspoolcmdDEFINESspoolcontrolpassword,killspool,firstspool,startspool,stopspool,haltspool,waitforhalt:LETerrornak=2,entrylinecode=23,killercode=24,firstcode=25,startcode=26,stopcode=27,haltcode=28,waitforhaltcode=29;DATASPACE VARds;BOUND STRUCT(TEXTentryline,INTindex,TEXTactualentries,password)VARcontrolmsg;BOUND TEXT VARerrormsg;INT VARreply;INITFLAG VARinthistask:=FALSE;BOOL VARdialogue;TEXT VARcontrolpassword,password;controlpassword:="";PROCspoolcontrolpassword(TEXT CONSTnewpassword):IFonlineTHENsay("�
�")FI;disablestop;do("enter spool control password (""+newpassword+"")");clearerror;nodoagain;covertracks;covertracks(controlpassword);controlpassword:=newpassword;END PROCspoolcontrolpassword;PROCcallspool(INT CONSTopcode,TEXT CONSTname,TASK CONSTspool):dialogue:=commanddialogue;password:=writepassword;passwordCAT"/";passwordCATreadpassword;disablestop;commanddialogue(FALSE);enterpassword(controlpassword);commanddialogue(dialogue);call(opcode,name,spool);commanddialogue(FALSE);enterpassword(password);commanddialogue(dialogue);END PROCcallspool;PROCstartspool(TASK CONSTspool):enablestop;callspool(haltcode,"",spool);callspool(startcode,"",spool);END PROCstartspool;PROCstartspool(TASK CONSTspool,INT CONSTnewchannel):enablestop;callspool(haltcode,"",spool);callspool(startcode,text(newchannel),spool);END PROCstartspool;PROCstopspool(TASK CONSTspool):callspool(stopcode,"",spool);END PROCstopspool;PROCstopspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(stopcode,deactivemsg,spool);END PROCstopspool;PROChaltspool(TASK CONSTspool):callspool(haltcode,"",spool);END PROChaltspool;PROChaltspool(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(haltcode,deactivemsg,spool);END PROChaltspool;PROCwaitforhalt(TASK CONSTspool):callspool(waitforhaltcode,"",spool);END PROCwaitforhalt;PROCwaitforhalt(TASK CONSTspool,TEXT CONSTdeactivemsg):callspool(waitforhaltcode,deactivemsg,spool);END PROCwaitforhalt;PROCcontrolspool(TASK CONSTspool,INT CONSTcontrolcode,TEXT CONSTquestion,BOOL CONSTleave):enablestop;initializecontrolmsg;WHILEvalidspoolentryREP IFcontrolquestionTHENcontrolspoolentryFI PER;.initializecontrolmsg:IF NOTinitialized(inthistask)THENds:=nilspaceFI;forget(ds);ds:=nilspace;controlmsg:=ds;controlmsg.entryline:="";controlmsg.password:=controlpassword;controlmsg.index:=0;say("
+");.validspoolentry:call(spool,entrylinecode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;controlmsg.index<>0.controlquestion:say(controlmsg.entryline);yes(question).controlspoolentry:call(spool,controlcode,ds,reply);IFreply=errornakTHENerrormsg:=ds;errorstop(errormsg);FI;IFleaveTHEN LEAVEcontrolspoolFI;END PROCcontrolspool;PROCkillspool(TASK CONSTspool):controlspool(spool,killercode," loeschen",FALSE)END PROCkillspool;PROCfirstspool(TASK CONSTspool):controlspool(spool,firstcode," als erstes",TRUE)END PROCfirstspool;END PACKETspoolcmd; + diff --git a/app/schulis-mathematiksystem/1.0/src/standardoperatoren b/app/schulis-mathematiksystem/1.0/src/standardoperatoren Binary files differnew file mode 100644 index 0000000..647611b --- /dev/null +++ b/app/schulis-mathematiksystem/1.0/src/standardoperatoren |