1
2
3
|
PACKETsimselpictureDEFINES PICTURE,:=,CAT,nilpicture,cmfaktor,draw,drawr,drawcm,drawcmr,move,mover,movecm,movecmr,circle,length,dim,pen,where,extrema,rotate,stretch,translate,text,picture,plot:LETdrawkey=1,movekey=2,textkey=3,moverkey=4,drawrkey=5,movecmkey=6,drawcmkey=7,movecmrkey=8,drawcmrkey=9,circlekey=11,max2dim=31983,maxtext=31974,maxbar=31982,maxcircle=31974,maxlength=32000;TYPE PICTURE=STRUCT(INTdim,pen,TEXTpoints);INT VARreadpos;REAL VARx,y,z,fak:=1.0;TEXT VARr2:=16*"�",r3:=24*"�",i1:="��",i2:="����";OP:=(PICTURE VARl,PICTURE CONSTr):CONCR(l):=CONCR(r)END OP:=;OP CAT(PICTURE VARl,PICTURE CONSTr):IFl.dim<>r.dimTHENerrorstop("OP CAT : left dimension <> right dimension")ELIFlength(l.points)>maxlength-length(r.points)THENerrorstop("OP CAT : Picture overflow")FI;l.pointsCATr.pointsEND OP CAT;PICTURE PROCnilpicture:PICTURE:(2,1,"")END PROCnilpicture;PROCdraw(PICTURE VARp,TEXT CONSTtext):draw(p,text,0.0,0.0,0.0)END PROCdraw;PROCcmfaktor(REAL CONSTn):fak:=nEND PROCcmfaktor;PROCdraw(PICTURE VARp,TEXT CONSTtext,REAL CONSTangle,height,bright):write(p,text,angle,height,bright,textkey)END PROCdraw;PROCdraw(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawkey)END PROCdraw;PROCdrawr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawrkey)END PROCdrawr;PROCdrawcm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmkey)END PROCdrawcm;PROCdrawcmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,drawcmrkey)END PROCdrawcmr;PROCmove(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movekey)END PROCmove;PROCmover(PICTURE VARp,REAL CONSTx,y):write(p,x,y,moverkey)END PROCmover;PROCmovecm(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmkey)END PROCmovecm;PROCmovecmr(PICTURE VARp,REAL CONSTx,y):write(p,x,y,movecmrkey)END PROCmovecmr;PROCcircle(PICTURE VARp,REAL CONSTradius,from,to,INT CONSTpattern):write(p,radius,from,to,pattern,circlekey)END PROCcircle;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;PROCwrite(PICTURE VARp,REAL CONSTx,y,INT CONSTn,key):IFlength(p.points)<maxbarTHENp.pointsCATcode(key);replace(r2,1,x);replace(r2,2,y);p.pointsCATr2;replace(i1,1,n);p.pointsCATi1ELSEerrorstop("Picture overflow")FI END PROCwrite;PROCwrite(PICTURE VARp,REAL CONSTx,y,z,INT CONSTn,key):IFlength(p.points)<maxcircleTHENp.pointsCATcode(key);replace(r3,1,x);replace(r3,2,y);replace(r3,3,z);p.pointsCATr3;replace(i1,1,n);p.pointsCATi1ELSEerrorstop("Picture overflow")FI END PROCwrite;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;INT PROClength(PICTURE CONSTp):length(p.points)END PROClength;INT PROCdim(PICTURE CONSTpic):pic.dimEND PROCdim;PROCpen(PICTURE VARp,INT CONSTpen):IFpen<0ORpen>16THENerrorstop("pen out of range [0-16]")FI;p.pen:=penEND PROCpen;INT PROCpen(PICTURE CONSTp):p.penEND PROCpen;PROCwhere(PICTURE CONSTp,REAL VARx,y):IFp.dim=0THENx:=0.0;y:=0.0ELIFp.dim=3THENerrorstop("Picture is 3 dimensional")ELSEx:=subtext(p.points,length(p.points)-15,length(p.points)-8)RSUB1;y:=subtext(p.points,length(p.points)-7,length(p.points))RSUB1FI END PROCwhere;PROCextrema(PICTURE CONSTp,REAL VARxmin,xmax,ymin,ymax):xmin:=maxreal;xmax:=-maxreal;ymin:=maxreal;ymax:=-maxreal;readpos:=0;INT CONSTpiclength:=length(p.points);WHILEreadpos<piclengthREPcheckpositionPER.checkposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:calcextremaCASEmovekey:calcextremaCASEmoverkey:calcrelextremaCASEdrawrkey:calcrelextremaCASEmovecmkey:readposINCR16CASEdrawcmkey:readposINCR16CASEmovecmrkey:readposINCR16CASEdrawcmrkey:readposINCR16CASEtextkey:readposINCRnextint+24CASEcirclekey:readposINCR26OTHERWISEerrorstop("wrong key code")END SELECT.calcextrema:x:=nextreal;y:=nextreal;xmin:=min(xmin,x);xmax:=max(xmax,x);ymin:=min(ymin,y);ymax:=
max(ymax,y).calcrelextrema:xINCRnextreal;yINCRnextreal;xmin:=min(xmin,x);xmax:=max(xmax,x);ymin:=min(ymin,y);ymax:=max(ymax,y).nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.END PROCextrema;PROCrotate(PICTURE VARp,REAL CONSTangle):REAL CONSTs:=sind(angle),c:=cosd(angle);transform(p,ROW4ROW3REAL:(ROW3REAL:(1.0,0.0,0.0),ROW3REAL:(0.0,c,s),ROW3REAL:(0.0,-s,c),ROW3REAL:(0.0,0.0,0.0)))END PROCrotate;PROCstretch(PICTURE VARpic,REAL CONSTsx,sy):stretch(pic,sx,sy,1.0)END PROCstretch;PROCstretch(PICTURE VARp,REAL CONSTsx,sy,sz):transform(p,ROW4ROW3REAL:(ROW3REAL:(sx,0.0,0.0),ROW3REAL:(0.0,sy,0.0),ROW3REAL:(0.0,0.0,sz),ROW3REAL:(0.0,0.0,0.0)))END PROCstretch;PROCtranslate(PICTURE VARp,REAL CONSTdx,dy):translate(p,dx,dy,0.0)END PROCtranslate;PROCtranslate(PICTURE VARp,REAL CONSTdx,dy,dz):transform(p,ROW4ROW3REAL:(ROW3REAL:(1.0,0.0,0.0),ROW3REAL:(0.0,1.0,0.0),ROW3REAL:(0.0,0.0,1.0),ROW3REAL:(dx,dy,dz)))END PROCtranslate;PROCtransform(PICTURE VARp,ROW4ROW3REAL CONSTa):INT CONSTpiclength:=length(p.points);INT VARbeginpos;readpos:=0;x:=0.0;y:=0.0;z:=0.0;transform2dimpic.transform2dimpic:WHILEreadpos<piclengthREPtransform2dimpositionPER.transform2dimposition:readposINCR1;SELECTcode(p.pointsSUBreadpos)OF CASEdrawkey:transform2dimpointCASEmovekey:transform2dimpointCASEmoverkey:transform2dimpointCASEdrawrkey:transform2dimpointCASEmovecmkey:readposINCR16CASEdrawcmkey:readposINCR16CASEmovecmrkey:readposINCR16CASEdrawcmrkey:readposINCR16CASEtextkey:readposINCRnextint+24CASEcirclekey:readposINCR26OTHERWISEerrorstop("wrong key code")END SELECT.transform2dimpoint:beginpos:=readpos+1;x:=nextreal;y:=nextreal;transform(a,x,y,z);replace(r2,1,x);replace(r2,2,y);replace(p.points,beginpos,r2).nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.END PROCtransform;PROCtransform(ROW4ROW3REAL CONSTa,REAL VARx,y,z):REAL CONSTox:=x,oy:=y,oz:=z;x:=ox*a(1)(1)+oy*a(2)(1)+oz*a(3)(1)+a(4)(1);y:=ox*a(1)(2)+oy*a(2)(2)+oz*a(3)(2)+a(4)(2);z:=ox*a(1)(3)+oy*a(2)(3)+oz*a(3)(3)+a(4)(3)END PROCtransform;TEXT PROCtext(PICTURE CONSTpic):replace(i2,1,pic.dim);replace(i2,2,pic.pen);i2+pic.pointsEND PROCtext;PICTURE PROCpicture(TEXT CONSTtext):PICTURE:(textISUB1,textISUB2,subtext(text,5))END PROCpicture;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)CASEmoverkey:mover(nextreal,nextreal)CASEdrawrkey:drawr(nextreal,nextreal)CASEmovecmkey:movecm(fak*nextreal,fak*nextreal)CASEdrawcmkey:drawcm(fak*nextreal,fak*nextreal)CASEmovecmrkey:movecmr(fak*nextreal,fak*nextreal)CASEdrawcmrkey:drawcmr(fak*nextreal,fak*nextreal)CASEtextkey:draw(nexttext,nextreal,fak*nextreal,fak*nextreal)CASEcirclekey:circle(fak*nextreal,nextreal,nextreal,nextint)OTHERWISEerrorstop("wrong key code")END SELECT.nextreal:readposINCR8;subtext(p.points,readpos-7,readpos)RSUB1.nextint:readposINCR2;subtext(p.points,readpos-1,readpos)ISUB1.nexttext:INT CONSTtextlength:=nextint;readposINCRtextlength;subtext(p.points,readpos-textlength+1,readpos).END PROCplot;END PACKETsimselpicture;
|
