1
2
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;
|
