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
|
