⟦6f58ef722⟧

TextFile

(
scope temp plotclose ploterror,
       plotzscale scalexcoor scaleycoor plotscale,
       alphabet changepen setmask
clear temp plotclose ploterror, 
       plotzscale scalexcoor scaleycoor plotscale,
       alphabet changepen setmask
 plotclose=set 3
 ploterror=set 2
 plotzscale=set 4
 scalexcoor=set 1
 scaleycoor=set 1
 plotscale=set 3
 alphabet=set 1
 changepen=set 1
 setmask=set 1
)
\f


message plotclose in tpls
plotclose=algol message.no list.no
external
procedure plotclose;
comment closes the plotter;

if -,plotclosed then
begin
long field L;
integer i,j,k;
integer array M(1:8),tail(1:10);
   plotclosed:=true;

   comment for paper plotters: move pen to lower right corner;
   penup;

   plotsubform(0,plotxform,0,plotyform,false);

   if -,autoscale then
   plotmove(0,0);
   plotend; comment output last part ;

   if convtype=2 then
   begin
     plotxstep:=plotxform+4; plotxy(14);
   end calcomp81;
   M(1):=0;
   waitanswer(sendmessage(plotpda,M),M);
   comment wait for drawing to be finished;

   if plotpl then
   releaseproc(firstaddr(plotname1)-2);

   if plotbs then
   begin
    k:=firstaddr(plotbsadd)-3;
    removeproc(k);
    lookuptail(k,tail);
    i:=firstaddr(plotname1);
    for j:=2,3,4,5 do
    begin tail(j):=wordload(i); i:=i+2; end;
    tail(10):=plotbssegm - tail(7);
    changetail(k,tail);
    plotbs:=false;
   end;

comment save plot statistic;

end plotclose;

end;
\f


message ploterror in tpls
ploterror=algol message.no list.no
external
procedure ploterror(str,type);
value type;
string str;
integer type;
comment type= 0 : soft error, return.
            = 3 : wait error, stop program.;
begin
array field a;
integer array M(1:8);

cleararray(M);
M(1):=13 shift 13 add type;
a:=2;
movestring(M.a,1,str);
waitanswer(sendmessage(parent,M),M);
if type extract 1 = 1 then wait(2);

end ploterror;

end;
\f


message plotzscale in tpls
plotzscale=algol message.no list.no
external

procedure plotzscale(zl,zh,zmin,zmax,zc,dz,zpos);
value zl,zh;
real zl,zh,zmin,zmax,zc,dz,zpos;
comment zmin,zmax in format-coordinates;
begin
real z0,miz,maz,zzm,zzp;
integer k,minz,maxz,zexp,zi,zz0,dzl;
miz:=zmin; maz:=zmax;
zpos:=round(100*(zpos*dz+zc))/100;
z0:=origor(zl,zh,zi);
if testbit(plottest,7) then
write(out,<:<10>zl,zh,z0,minz,maxz =:>,<< -d.ddd'+ddd>,zl,zh,z0,zmin,zmax);
dz:=(maz-miz)/(zh-zl);
zexp:=entier(ln(dz)/ln(10));
dzl:=entier(dz*10**(-zexp));
if 1<=dzl and dzl<2 then k:=3 else
if 2<=dzl and dzl<5 then k:=1 else k:=2;
if testbit(plottest,7) then
  write(out,<:<10>dz,:>,<<  -d.ddd'+ddd>,<:dzl,zexp =:>,dz,dzl,zexp);
l: case k of begin
  begin dz:=2*10**zexp; k:=3; end;
  begin dz:=5*10**zexp; k:=1; end;
  begin dz:=10**zexp; k:=2; zexp:=zexp-1; end;
end;
zzp:=(zh-z0)*dz; zzm:=(z0-zl)*dz;
zz0:=entier(zzm+miz-'-3)+1;
if testbit(plottest,7) then
  begin
  write(out,<:<10>dz,zz0,miz,maz,zzm,zzp =:>,
  dz,zz0,miz,maz,zzm,zzp);
  outendcur(10);
  end;
if zz0+zzp>maz then goto l;
zc:=round(zz0-z0*dz);
zmin:=(miz-zc)/dz;
zmax:=(maz-zc)/dz;
zpos:=round(100*(zpos-zc))/100/dz;
if testbit(plottest,7) then
  begin
  write(out,<:<10>user zc:>,<< -d.ddd'+ddd>,<:,zmax,zmin,zpos =:>,
  zc,zmax,zmin,zpos);
  outendcur(10);
  end;
end plotzscale;
end;
\f


message scalexcoor in tpls
scalexcoor=algol message.no list.no
external
boolean procedure scalexcoor(xmin,xmax,xlref,xhref);
value xmin,xmax,xlref,xhref;
real xmin,xmax,xlref,xhref;
begin
scalexcoor:=false;
if xmin<xmax and xlref<xhref and plotxmin<plotxmax then begin
plotxmin:=plotxmin*deltax+plotxcoor;
if plotxmin<xlref then plotxmin:=xlref;
if plotxmin<0 then plotxmin:=0;
plotxmax:=plotxmax*deltax+plotxcoor;
if plotxmax>xhref then plotxmax:=xhref;
if plotxmax>plotsubxmax-plotsubxmin then
   plotxmax:=plotsubxmax-plotsubxmin;
plotzscale(xmin,xmax,plotxmin,plotxmax,plotxcoor,deltax,plotxpos);
scalexcoor:=true end;
end scalexcoor;
end;
\f


message scaleycoor in tpls
scaleycoor=algol message.no list.no
external
boolean procedure scaleycoor(ymin,ymax,ylref,yhref);
value ymin,ymax,ylref,yhref;
real ymin,ymax,ylref,yhref;
begin
scaleycoor:=false;
if ymin<ymax and ylref<yhref and plotymin<plotymax then begin
plotymin:=plotymin*deltay+plotycoor;
if plotymin<ylref then plotymin:=ylref;
if plotymin<0 then plotymin:=0;
plotymax:=plotymax*deltay+plotycoor;
if plotymax>yhref then plotymax:=yhref;
if plotymax>plotsubymax-plotsubymin then
   plotymax:=plotsubymax-plotsubymin;
plotzscale(ymin,ymax,plotymin,plotymax,plotycoor,deltay,plotypos);
scaleycoor:=true end;
end scaleycoor;
end;
\f


message plotscale in tpls
plotscale=algol message.no list.no
external
boolean procedure plotscale(xmin,xmax,ymin,ymax);
value xmin,xmax,ymin,ymax;
real xmin,xmax,ymin,ymax;
begin
boolean res;
res:=scalexcoor(xmin,xmax,0,plotsubxmax-plotsubxmin)
     and scaleycoor(ymin,ymax,0,plotsubymax-plotsubymin);
if testbit(plottest,3) then begin
     write(out,<< -d.dddd'+ddd>,
               <:<10>xcoor,ycoor = :>,plotxcoor,plotycoor,
               <:<10>deltax,deltay = :>,deltax,deltay,
               <:<10>xpos,ypos = :>,plotxpos,plotypos,
               <:<10>xmin,ymin ; xmax,ymax = :>,
                plotxmin,plotymin,<: ; :>,plotxmax,plotymax);
     outendcur(10);
     end;
plotscale:=res;
 
if testbit(plottest,3) and -,res then
  begin
  write(out,<:<10>no scaling possible:>);
  outendcur(10);
  end;
end plotscale;
end;
\f


message alphabet in tpls
alphabet=algol message.no list.no
external
procedure alphabet(spline,area);
value spline; boolean spline;
string area;
begin
movetext(firstaddr(charname1)-2,area);
plotspline:=spline;
end alfabet;
end;
\f


message changepen in tpls
changepen=algol message.no list.no
external
procedure change_pen(str);
string str;
begin
ploterror(str,3);
end changepen;
end;
\f


message setmask in tpls
setmask=algol message.no list.no
external
procedure setmask(d1,u,d2);
value d1,u,d2; real d1,u,d2;
begin integer k;
case convtype of
begin
  begin <*tektronix*>
   k:=u * plotunit;
   plotxstep:=round(d1*plotunit) shift 8
              add (k shift (-8) extract 8);
   plotystep:=k shift 16
              add (round(d2*plotunit) extract 16);
   plotxy(3);
  end tektronix;
  if d1>=0 and d1<=4 then
  begin <*calcomp81*>
    <*u in cm*>
    u:=u/0.126;
    plotxstep:=d1;
    plotystep:=u;
    if plotystep >0 and plotystep<256 then plotxy(3);
  end calcomp81;
end case;
end setmask;
end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦6f58ef722⟧ TextFile

Derivation

TextFile
