⟦acecce8ba⟧

TextFile

(
;1982-02-17 AL
scope temp plotform plotsubform plottext plotpoint
clear temp plotform plotsubform plottext plotpoint
 plotform=set 10
 plotsubform=set 2
 plottext=set 13
 plotpoint=set 2
 scope user plotform plotsubform plottext plotpoint
)

message plotform in tplf
plotform=algol message.no list.no
external

boolean procedure plotform (type, xstor, ystor);
value type, xstor, ystor;
real xstor, ystor;
integer type;
begin 
integer xsize, ysize, i, time;
boolean draw;
integer array M(1:10);
real timed,hour;
if plottstst
then begin
       write(out,<:<10>plotform 0:>,type,xstor,ystor);outendcur(32);
     end;

   if type>=10 then
   begin
    type:=type-10;
    draw:=false;
   end else draw:=true;

   if plotbs then
   begin integer j,k; integer array tail(1:10);
    k:=firstaddr(plotbsadd)-3;
    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);
   end;

if if type=0 then xstor>0 and ystor>0 else
   if type=1 then xstor>=0 and xstor<=7 else
   if type=2 then xstor>=1 and xstor<=7 else
   false then
begin
comment the format is allowed;
plotform:=true;
if type=0 then begin
   comment the format is xstor cm/inch times ystor cm/inch;
   xsize:=entier( xstor-.0001)+1;
   ysize:=entier( ystor-.0001)+1 end else
if type=1 or type=2 then begin
   comment the format is an a-format number round xstor
   placed along the document for type=1;
   xsize:=(case round (xstor+1) of
          (8410,5940,4200,2970,2100,1480,1050,740))/100;
   ysize:=(case round (xstor+1) of
          (11890,8410,5940,4200,2970,2100,1480,1050))/100 end;
if type=2 then begin
   comment the format is an a-format number round xstor
   placed across the document;
   i:=xsize; xsize:=ysize; ysize:=i end;
end else begin 
plotform:=false;
 alarm(<:***plotform format not allowed. type,xsize,ysize = :>,
          type,xstor,ystor,xsize,ysize,plotxstep,plotystep);
end;

if false then
begin
i:=44;
systime(1,0,timed);
systime(4,timed,hour);
hour:=hour/10000;
if minutelim>=0 and (hour>9 and hour<17) and (xsize>i or ysize>i) 
  and parent<>description(<:s:>) then
alarm(<:***plotform format too big size=:>,<<d>,xsize,<:,:>,ysize);
end;

if unitscale<>1.0 and type>0 then begin
   comment other unit format;
   xsize:=(xsize/unitscale);
   ysize:=(ysize/unitscale) end;
if autoscale then
   plotunit:=(if absymax//ysize<absxmax//xsize then
       absymax//ysize else absxmax//xsize);
   if plotunit<=0 then alarm(<:<10>***plotform :>,
      if autoscale then <:autoscale :> else <::>,
      <: plotunit = 0:>);

time:=0;

REP:
if plottstst
then begin
       write(out,<:<10>plotform 1:>,plotunit,xsize,ysize);outendcur(32);
     end;
plotxpos:=plotypos:=plotxform:=plotyform:=plotsubxmax:=
plotsubymax:=plotsubymin:=plotsubxmin:=plotxmax:=plotymax:=
plotxmin:=plotymin:=plotxcoor:=plotycoor:=0.0;
if plotoff then goto ENDF;
plotopen(true);
   i:=if (hour<9 or hour>16) then 4*60 else minutelim;
   if parent=description(<:s:>) then i:=8*60;

   if minutelim>=0 then plottimeout:=extend i*60*10000 + getclock;
   plotsettext(0.25/unitscale,0.35/unitscale,0,0,0.7/unitscale);
netsize:=plotunit/5;
plotxform:=plotxmax:=plotsubxmax:=xsize;
plotyform:=plotymax:=plotsubymax:=ysize;
if plottstst
then begin
       write(out,<:<10>plotform 2:>,netsize,plotxform,plotyform);outendcur(32);
     end;
plotmove(maxreal,plotxform*plotunit);
plotmove(plotyform*plotunit,maxreal);
deltax:=deltay:=1;
writeplot(<::>);
   if xsize*plotunit>absxmax or ysize*plotunit>absymax then 
     alarm(<:<10>***formaterror :>,plotunit,xstor,ystor);
   plotxy(1);
   if convtype=2 then
   begin
     plotxstep:=xsize*plotunit;
     plotystep:=ysize*plotunit;
     plotdraw:=    draw;
     plotxy(7);
   end calcomp81 else
   if draw then
   begin
     if penstatus=1 then penup;
     plotmove(0,0);
     pendown;
     plotmove(xsize,0);  plotmove(xsize,ysize);
     plotmove(0,ysize); plotmove(0,0);
     penup;
   end;

ENDF:
if plottstst
then begin
       write(out,<:<10>plotform 9:>);outendcur(32);
     end;
end plotform;
end;
\f



message plotsubform in tplf
plotsubform=algol message.no list.no


external
boolean procedure plotsubform(xmin,xmax,ymin,ymax,draw);
value ymin, ymax, xmin, xmax, draw;
integer ymin, ymax, xmin, xmax;
boolean draw;
begin
if xmin>xmax or ymin>ymax or xmin<0 or ymin<0
   or xmax>plotxform or ymax>plotyform then 
   alarm(<:***plotsubform illegal format.:>,xmin,xmax,ymin,ymax,
         plotxform,plotyform);

plotxpos:=(plotxpos*deltax+plotxcoor)+plotsubxmin;
plotypos:=(plotypos*deltay+plotycoor)+plotsubymin;
deltax:=deltay:=1;
plotsubxmax:=plotxmax:=plotxform;
plotsubymax:=plotymax:=plotyform;
plotxcoor:=plotsubxmin:=plotsubymin:=plotycoor:=
plotxmin:=plotymin:=0;
plotmove(xmin,ymin);
plotsubxmin:=xmin; plotsubymin:=ymin;
plotsubxmax:=xmax; plotsubymax:=ymax;
plotxmax:=xmax-xmin; plotymax:=ymax-ymin;
plotxpos:=plotypos:=0.0;
if draw then begin
  pendown;
  plotmove(0,plotymax); plotmove(plotxmax,plotymax);
  plotmove(plotxmax,0); plotmove(0,0);
  penup;
  end;

end plotsubform;

end;
\f



message plottext in tplf
plottext=algol message.no list.no
21 05 73
1977 11 22
external
procedure plottext(z,s,b);
zone z;
integer s, b;
begin
  comment blockprocedure to plotz,
          takes care of the characteroutput;
  real zidx,curx,cury,xpos,ypos;
  own integer adr,displ;
  boolean array field IDX, P;
  integer shifts, sh2, idx, charval, segno, segin,
  point, n, n1, i, j, fit, nextfit, xdis, ydis,
  cellno, xval, yval, zonelast,zd, res;
  boolean draw;
  array X, Y(-1:20);
  integer array XI,YI(0:20),SLOPES(1:4);
  if charname1=real <::> then
  begin
    charname1:=real <:charr:> add 111;
    charname2:=real <:man:>;
  end;
  zd:=zonedes(z);
  if adr=0 then adr:=owndescr;
  i:=wordload(zd-34)-wordload(zd-36)+2;
  wordstore(zd+4, i);
  zonelast:=i shift (-2);
  i:=1;
  if byteload(adr+26)<2 then alarm(<:bufferclaim:>,0);
  if byteload(adr+27)<1 then alarm(<:areaclaim:>,0);
  if charoff then goto NO_CHAR;
  res:=connectcuri(firstaddr(charname1)-4);
  i:=1;
  if res<>0 then alarm(<:<10>***character set :>,string
  (if i=1 then charname1+(increase(i)-1) else charname2),
  <: missing:>);
  segin:=-1; 
  n:=0;
  IDX:=0; P:=0;
  shifts:=-40; idx:=1; zidx:=z(idx);
REP:
  fit:=-1;
  curx:=plotxpos; cury:=plotypos;
  xpos:=ypos:=0.0;
  charval:=zidx shift shifts extract 8;
  if charval>0 and (charval<8 or charval>15) then charval:=charval+displ;
  if charval=0 or(idx=zonelast and shifts=0) then goto END;
  if shifts=0 then
  begin
    shifts:=-40; idx:=idx+1; zidx:=z(idx); 
  end
  else shifts:=shifts+8;
  if charval-displ>126 then goto REP;
  if charval=15 then
  begin
    displ:=0;
    goto REP;
  end; 
  if charval=14 then
  begin
    displ:=128;
    goto REP;
  end;
  if charval=12 then
  begin
    penup;
    plotmove((marginx-plotxcoor)/deltax,
    (marginy-plotycoor)/deltay);
    goto REP;
  end;
  if charval=10 or charval=13 then
  begin
    real mx,my;
    mx:=(marginx-plotxcoor)/deltax; my:=(marginy-plotycoor)/deltay;
    penup;
    plotmove(mx*costhetax*costhetax+
    plotxpos*sinthetax*sinthetax+
    (my-plotypos)*sinthetax*costhetax+
    (if charval=10 then linediff/deltax*sinthetax else 0),
    plotypos*costhetax*costhetax+
    my*sinthetax*sinthetax+
    (mx-plotxpos)*sinthetax*costhetax+
    (if charval=10 then -costhetax*linediff/deltay else 0));
    goto REP;
  end;

  if plotalpha then
  begin
    if charval>=32 then
    begin
      plotxstep:=charval; plotxy(9);
    end;
    goto REP; 
  end;

  if segin<>0 then
  begin
    setposition(in,0,0); segin:=0; inrec6(in,512); 
  end;
  cellno:= in.IDX(charval+1) extract 12;
  if cellno=0 then cellno:=in.IDX(33) extract 12;
  segno:=cellno//512;
  if segno<>segin then
  begin
    setposition(in,0,segno);
    inrec6(in,512);
    segin:=segno;
  end;
  cellno:=cellno extract 9;
  xdis:=ydis:=0;
  draw:=false;
  sh2:=-6;
  n1:=0;

READ:
  point:= in.P(cellno) shift sh2 extract 6;
  if sh2=0 then
  begin
    sh2:=-6; cellno:=cellno+1 
  end
  else sh2:=sh2+6;
  xval:=point shift (-3) extract 3;
  yval:=point extract 3;
  if xval<0 or xval>7 or yval<0 or yval>7 then goto READ;
  if xval=5 then ydis:=ydis+yval
  else
  if xval=6 then ydis:=ydis-yval
  else
  if xval=7 then
  begin
    case yval+1 of
    begin
      draw:=false;
      xdis:=xdis-1;
      xdis:=xdis+1;
      begin
        draw:=true; n1:=-2;
        nextfit:=if plotspline then 1 else 2; 
      end;
      draw:=true;
      begin
        draw:=true; nextfit:=2; 
      end;
      begin
        nextfit:=4; draw:=true; 
      end;
      begin
        nextfit:=3; draw:=true;  
      end;
    end case;
  end
  else
  if -,draw then
  begin
    if n1<0 then
    begin
      n1:=n1+1;
      X(n1):=xval*plotsize/5;
      Y(n1):=yval*plotheight/7;
    end
    else
    begin
      n:=n+1;
      X(n):=(xval+xdis)*plotsize/5;
      Y(n):=(yval+ydis)*plotheight/7;
    end read a point;
  end;
  if -, draw then goto READ;
  if draw and fit<3 and n<=0 then 
  begin
    fit:=nextfit; draw:=false; goto READ; 
  end;
  draw:=false;

  if fit=1 or fit=2 and (X(1)<>xpos or Y(1)<>ypos) then 
  begin
    penup;
    plotmove(curx+(X(1)*costhetax-Y(1)*sinthetay)/deltax,
    cury+(X(1)*sinthetax+Y(1)*costhetay)/deltay);
  end;
  if fit=1 and -,plotspline1 then

  begin
    comment splinefit;
    real z, stepp, x, y;
    real array UX(1:n),UY(1:n),W(1:n-1);
    real xi1, xi, uxi1, uxi, yi1, yi, uyi1, uyi;
    W(1):=UX(1):=UY(1):=UX(n):=UY(n):=0;
    for i:=2 step 1 until n-1 do
    begin
      W(i):=1/(4-W(i-1));
      UX(i):=( (X(i+1)-2*X(i)+X(i-1))*6-UX(i-1))*W(i);
      UY(i):=( (Y(i+1)-2*Y(i)+Y(i-1))*6-UY(i-1))*W(i);
    end i;
    for i:=n-1 step -1 until 2 do
    begin
      UX(i):=UX(i)-W(i)*UX(i+1);
      UY(i):=UY(i)-W(i)*UY(i+1);
    end;
    pendown; penstatus:=1;
    for i:=1 step 1 until n-1 do
    begin
      xi1:=X(i+1); xi:=X(i);
      uxi1:=UX(i+1); uxi:=UX(i);
      yi1:=Y(i+1); yi:=Y(i);
      uyi1:=UY(i+1); uyi:=UY(i);
      z:=(if abs(xi1-xi)<abs(yi1-yi) then abs(yi1-yi) 
      else abs(xi1-xi))*netsize;
      stepp:= if z<1 then 1 else 1/z;
      for z:=stepp step stepp until 1,1 do
      begin
        x:=xi+(xi1-xi+(z-1)*(2*uxi+uxi1+(uxi1-uxi)*z)/6)*z;
        y:=yi+(yi1-yi+(z-1)*(2*uyi+uyi1+(uyi1-uyi)*z)/6)*z;
        plotmove(curx+(x*costhetax-y*sinthetay)/deltax,
        cury+(x*sinthetax+y*costhetay)/deltay)
      end;
    end;
  end splinefit else
  if false and fit=1 and plotspline1 then 
  begin
    comment splinefit of characters unpacked in plotsteps; 
    pendown;
    for i:=1 step 1 until n-1 do 
    begin
      XI(i):=(X(i+1)-X(i))*netsize;
      YI(i):=(Y(i+1)-Y(i))*netsize 
    end;
    SLOPES(1):=(if XI(1)<0 then -X(-1) else X(-1))*netsize;
    SLOPES(2):=(if XI(n-1)<0 then -X(0) else X(0))*netsize;
    SLOPES(3):=(if YI(1)<0 then -Y(-1) else Y(-1))*netsize;
    SLOPES(4):=(if YI(0)<0 then -Y(0) else Y(0))*netsize;
    comment
    spln3step(n,XI,YI,SLOPES,(plotsize/4+plotheight/7)*netsize,netsize);
  end splinefit1 else
  if fit=2 then 
  begin
    pendown;
    for i:=2 step 1 until n do
    plotmove(curx+(X(i)*costhetax-Y(i)*sinthetay)/deltax,
    cury+(X(i)*sinthetax+Y(i)*costhetay)/deltay)
  end;
  if fit=1 or fit=2 then
  begin
    xpos:=X(n); ypos:=Y(n)
  end;

  fit:=nextfit;
  n:=0;
  if fit=3 or fit=4 then 
  begin
    penup;
    plotmove(curx+(7-2*fit)*plotsize/deltax*costhetax,
    cury+(7-2*fit)*plotsize/deltay*sinthetax); 
  end;
  goto (if fit=3 or fit=4 then REP else READ);
END:
NO_CHAR:
  cleararray(z);
  wordstore(zd,wordload(18+zd));
  wordstore(zd+2,wordload(zd-34));
  unstackcuri;
  pda:=firstaddr(charname1)-2;
  if description(pda)>0 then removeproc(pda);
end plottext;
end;
\f



message plotpoint in tplf
plotpoint=algol message.no list.no
external
boolean procedure plotpoint(x,y,type);
value x,y, type;
real x, y;
integer type;
begin
real dx,dy,sq2;
integer acpoint, sh, point,
        ptype, sht,px,py;
sq2:=sqrt(2);
sht:=0;
plotpoint:=plotmove(x,y);
if ptype=0 and autoscale then begin pendown; penup end;
for ptype:=type shift sht extract 4 while
     ptype>0  do
begin
sht:=sht-4;

acpoint:=case ptype of (338010,6576414,75433,
                        174094,1479710,1737198,
                        6817518,-7329298,4367598,
                        2428654,2469614,-5927186,
                        364270,6614766,1699566);
sh:=-24;
penup;

REP:
sh:=sh+4;
if ptype=3 and sh=4 then begin
  sh:=-20; acpoint:=-8122642;
  end;
point:=acpoint shift sh extract 4;
if sh>0 or point=14 then goto END;
px:=point shift (-2) extract 2-1;
py:=point extract 2-1;
dx:=px/2*pointsize; dy:=py/2*pointsize;
if px<>0 and py<>0 then begin dx:=dx/sq2; dy:=dy/sq2; end;
plotmove(x+dx/deltax,y+dy/deltay);
pendown;
goto REP;

END:
penup;  plotmove(x,y);
end ptype;


end plotpoint;
end

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦acecce8ba⟧ TextFile

Derivation

TextFile
