DataMuseum.dk

top - metrics - download

    Length: 9216 (0x2400)
    Types: TextFile
    Names: »tpla«

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »tpla« 
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦dd2c1b53f⟧ »tplot« 
            └─⟦this⟧ 

TextFile

scope temp plotaxis plotcoor plotframe setcoor plotadmini,
           plotrect plotautcoor

clear temp plotaxis plotcoor plotframe setcoor plotadmini,
           plotrect plotautcoor

plotaxis=set 2 
plotcoor=set 2 
plotframe=set 8 
setcoor=set 1
plotadmini=set 6 
plotrect=set 2 
plotautcoor=set 1

message plotaxis in tpla
plotaxis=algol message.no list.no
external
procedure plotaxis(zc,z0,zc1,zform,omv,j);
value zc,z0,zc1,zform,j,omv;
real zc,z0,zc1,zform;
integer j;
boolean omv;
begin
real x,y,zunit,zounit;
integer k;

procedure move(x,y);
real x,y;
if omv then plotmove(y,x) else plotmove(x,y);

if omv then begin
  zunit:=1/deltay; zounit:=1/deltax;
  end else begin
  zunit:=1/deltax; zounit:=1/deltay;
  end;
zc:=(entier(zc/zunit-'-3)+1)*zunit;
x:=zc+.5*zunit; y:=plotheight*zounit/6;
penup;
move(x,z0);
for k:=1,k+1 while j<>1 and k<=zform-1.75 do begin
  pendown;
  x:=(if j=1 then zc1 else zc)+k*zunit; move(x,z0);
  move(x,y+z0);
  move(x,-y+z0);
  move(x,z0);
  end for;
y:=2*y;
move(zc+(zform-1)*zunit,z0);
x:=zc+(zform-1)*zunit-plotheight*zunit;
move(x,y+z0);
move(zc+(zform-1)*zunit,z0);
move(x,-y+z0);
penup;
end plotaxis;
end;
\f


message plotcoor in tpla
plotcoor=algol message.no list.no
external
boolean procedure plotcoor(x0,y0,j);
value x0,y0,j; real x0,y0;
integer j;
begin
real cm,cm1;
boolean omv;
if plotsubxmax-plotsubxmin<2.5 or plotsubymax-plotsubymin<2.5 then 
begin
      plotcoor:=false; goto END
      end;
plotaxis(plotymin,
    x0,y0,(plotymax-plotymin)*deltay,true,j);
plotaxis(plotxmin,
    y0,x0,(plotxmax-plotxmin)*deltax,false,j);
penup;
plotcoor:=plotmove(x0,y0);
END:
penup;
end plotcoor;
end;
\f


message plotframe in tpla
plotframe=algol message.no list.no
external
procedure plotframe(layx,layy);
value layx,layy; real layx,layy;
begin
integer n,nx,ny,posx,posy,dframe,xstep,ystep,i,j,l,kx,ky;
real x0,y0,px,py,xm,ym,phx,phy,dx,dy,p,q,s;
dframe:=1;
x0:=(2-plotxcoor)/deltax;
y0:=(1-plotycoor)/deltay;
dx:=deltax; dy:=deltay;
deltax:=deltay:=1;
plotxmin:=plotymin:=plotxcoor:=plotycoor:=0;
plotxmax:=plotsubxmax-plotsubxmin-1;
plotymax:=plotsubymax-plotsubymin-1;
nx:=(entier plotxmax-2)//dframe*dframe+2;
ny:=(entier plotymax-1)//dframe*dframe+1;
numbdigit(dy,n,dy);
ystep:=(if n=1 or n=5 then 5 else 4);
ym:=y0+(ny-1)/dy;
p:=origo(y0,ym,n);
if (p-y0)*dy<ystep and (ym-p)*dy<ystep then ystep:=2;
ky:=round((p-y0)*dy) mod ystep +1;
p:=y0+(ky-1)/dy;
ym:=p+(ny-ky)//ystep*ystep/dy;
if ym+p<=0 then ym:=-p;
if p<0 then ym:=-ym;
numbdigit(dx,n,dx);
xstep:=(if n=1 or n=5 then 5 else 4);
xm:=x0+(nx-2)/dx;
p:=origo(x0,xm,n);
if (p-x0)*dx<xstep and (xm-p)*dx<xstep then xstep:=2;
kx:=round((p-x0)*dx) mod xstep +2;
p:=x0+(kx-2)/dx;
xm:=p+(nx-kx)//xstep*xstep/dx;
if xm+p<=0 then xm:=-p;
if p<0 then xm:=-xm;
plotmove(2,1);
pendown;
i:=1;
for i:=i+dframe while i<plotymax do
begin
   plotmove(2,i);
   plotmove(2+(if (i-ky)mod ystep=0 then plotsize else plotsize/3),i);
   plotmove(2,i)
end;
plotmove(2,plotymax);
i:=2;
for i:=i+dframe while i<plotxmax do
begin
   plotmove(i,plotymax);
   plotmove(i,plotymax
            -(if (i-kx)mod xstep=0 then plotsize else plotsize/3));
   plotmove(i,plotymax)
end;
plotmove(plotxmax,plotymax);
i:=(if ny=plotymax then ny-dframe else ny);
plotmove(plotxmax,i);
for i:=i-dframe step -dframe until 1 do
begin
   plotmove(plotxmax-(if (i+dframe-ky)mod ystep=0 then plotsize
            else plotsize/3),i+dframe);
   plotmove(plotxmax,i+dframe);
   plotmove(plotxmax,i)
end;
i:=(if nx=plotxmax then nx-dframe else nx);
plotmove(i,1);
for i:=i-dframe step -dframe until 2 do
begin
   plotmove(i+dframe,1+(if (i+dframe-kx)mod xstep=0 then plotsize
            else plotsize/3));
   plotmove(i+dframe,1);
   plotmove(i,1)
end;
penup;
if layy=0.0 then
begin
  q:=ystep*dframe/dy;
  n:=entier(ln(q)/ln10)-3;
  for j:=q/10**n,j//10 while j*10=i do
  begin
    i:=j; n:=n+1
  end;
  layy:=minlay(ym,-10**(n-1),posy,ym);
end
else
posy:=laypos(layy,n);
if layx=0.0 then
begin
  q:=xstep*dframe/dx;
  n:=entier(ln(q)/ln10)-3;
  for j:=q/10**n,j//10 while j*10=i do
  begin
    i:=j; n:=n+1
  end;
  layx:=minlay(xm,-10**(n-1),posx,xm)
end
else
posx:=laypos(layx,n);
s:=1;
if (2+posy)*plotsize>2 then s:=2/(2+posy)/plotsize;
if (2+posx)*plotsize*s>xstep then s:=xstep/(2+posx)/plotsize/s;
linediff:=linediff*s;
plotsize:=plotsize*s;
plotheight:=plotheight*s;
py:=(1+posy)*plotsize;
phy:=(if ky=1 then 0 else -plotheight/2);
for i:=ky step ystep until ny do
begin
   plotmove(2-py,i+phy);
   phy:=(if i=ny-ystep then -plotheight else -plotheight/2);
   writeplot(string fixexplay(layy,ym,y0-1/dy+i/dy,q),q)
end;
n:=(if xm<0 then posx+1 else posx);
phx:=1-linediff;
for i:=kx step xstep until nx do
begin
   p:=fixexplay(layx,xm,x0-2/dx+i/dx,q);
   l:=p shift (-24) extract 24;
   j:=0; for l:=l shift 1 while l<0 do j:=j+1;
   if q=0.0 and xm<0 then j:=j-1;
   px:=(if nx=i then posx*plotsize else (n+j-.5)*plotsize/2);
   plotmove(i-px,phx);
   writeplot(string p,q)
end;
plotsize:=plotsize/s;
linediff:=linediff/s;
plotheight:=plotheight/s;
plotmove(2,1);
deltax:=dx;deltay:=dy;
plotxmin:=x0;
plotymin:=y0;
plotxcoor:=2-dx*x0;
plotycoor:=1-dy*y0;
plotxmax:=(plotxmax-plotxcoor)/dx;
plotymax:=(plotymax-plotycoor)/dy
end plotframe;
end
\f


message setcoor in tpla
setcoor=algol message.no list.no
external
procedure setcoor(x0pos,x0,dx,y0pos,y0,dy);
comment dx dy user unit per cm;
value x0pos,x0,dx,y0pos,y0,dy;
real x0,y0,dx,dy; integer x0pos,y0pos;
begin
real xc,yc;
dx:=1/dx;
dy:=1/dy;
xc:=x0pos-x0*dx;
yc:=y0pos-y0*dy;
plotxmin:=(plotxmin*deltax+plotxcoor-xc)/dx;
plotymin:=(plotymin*deltay+plotycoor-yc)/dy;
plotxmax:=(plotxmax*deltax+plotxcoor-xc)/dx;
plotymax:=(plotymax*deltay+plotycoor-yc)/dy;
plotxpos:=round(100*(plotxpos*deltax+plotxcoor-xc))/100/dx;
plotypos:=round(100*(plotypos*deltay+plotycoor-yc))/100/dy;
deltax:=dx; plotxcoor:=xc;
deltay:=dy; plotycoor:=yc;
end setcoor;
end
\f


message plotadmini in tpla
plotadmini=algol message.no list.no
external
boolean procedure plotadmini(xmin,xmax,ymin,ymax,coortype);
value xmin, xmax, ymin, ymax,coortype;
integer coortype;
real xmin, xmax, ymin, ymax;
comment Plots a coordinatesystem at least 1 cm into the format;
begin
real x0, y0, layx, layy;
integer nposx, nposy, d;

plotadmini:=false;
if xmin>=xmax or ymin>=ymax or plotsubxmax-plotsubxmin<4 
   or plotsubymax-plotsubymin<4 then goto END;
plotxmax:=plotxmax-1/deltax;
plotymax:=plotymax-1/deltay;
plotscale(xmin,xmax,ymin,ymax);
plotxmax:=plotxmax+1/deltax;
plotymax:=plotymax+1/deltay;
x0:=-plotxcoor/deltax;
d:=entier((xmin-x0)*deltax-1);
x0:=x0+d/deltax;
if testbit(plottest,9) then
   write(out,<:<10>  x0,d :>,x0,d);
y0:=-plotycoor/deltay;
d:=entier((ymin-y0)*deltay-1);
y0:=y0+d/deltay;
if testbit(plottest,9) then 
   write(out,<:<10> y0,d :>,y0,d);

movecoor(-x0-plotxcoor/deltax,-y0-plotycoor/deltay);

   if coortype=2 then goto NOaxis;

x0:=origo(plotxmin+1/deltax,(plotxmin+plotxmax)/2,d);
layx:=minlay(x0,-10**d,nposx,x0);
y0:=origo(plotymin+1/deltay,(plotymin+plotymax*9)/10,d);
layy:=minlay(y0,-10**d,nposy,y0);
if testbit(plottest,9) then
   write(out,<:<10>min x0 max :>,plotxmin+1/deltax,x0,
      (plotxmin+plotxmax)/2,
      <:<10>min y0 max :>,plotymin+1/deltay,y0,
      (9*plotymin+plotymax)/10);
penup;
plotmove(x0-(nposy+1)*plotsize/deltax,y0+plotheight/deltay);
writeplot(string layy,y0);
plotaxis(plotymin,
    x0,y0,(plotymax-plotymin)*deltay,true,coortype);
plotmove(x0, plotypos);
writeplot(<: :>,string minlay(1/deltay,1,0,xmin),1/deltay);
plotmove(x0,y0-1.4*plotheight/deltay);
writeplot(<: :>,string layx,x0);
plotaxis(plotxmin,
    y0,x0,(plotxmax-plotxmin)*deltax,false,coortype);
layx:=minlay(1/deltax,1,nposx,xmin);
plotmove(plotxpos-nposx*plotsize/deltax,
         y0-1.4*plotheight/deltay);
writeplot(string layx,1/deltax);
NOaxis:
plotadmini:=true;

END:
end plotadmini;
end
\f


message plotrect in tpla
plotrect=algol message/no
external
procedure plotrect(x,y,l,h);
value x,y,l,h; real x,y,l,h;
begin
real dx,dy;
  dx:=l/2/deltax; dy:=h/2/deltay;
  plotmove(x-dx,y-dy);
  pendown;
  plotmove(x+dx,y-dy);
  plotmove(x+dx,y+dy);
  plotmove(x-dx,y+dy);
  plotmove(x-dx,y-dy);
  penup;
  end plotrect;
end
\f


message plotautcoor in tpla
plotautcoor=algol message.no list.no
external
boolean procedure plotautcoor(xmin,xmax,ymin,ymax);
value xmin,xmax,ymin,ymax; real xmin,xmax,ymin,ymax;
begin
plotautcoor:=false;
if scalexcoor(xmin,xmax,2,plotsubxmax-plotsubxmin-.5)
and scaleycoor(ymin,ymax,1,plotsubymax-plotsubymin-.5)
then begin
   plotautcoor:=true;
   plotframe(0.0,0.0) end
else alarm(<:*** scaling impossible:>);
end plotautcoor;
end


mode 10.no message.no list.no
▶EOF◀