DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »extreadstru«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦58ca399f1⟧ »extbib« 
            └─⟦this⟧ 

TextFile

readstruct=algol list.yes index.no

external
boolean procedure readstruct(res,X,N);
value N; integer N; zone res; array X;
begin
integer i,j,k,l,m,n,p,s,t,Ni,Nj,Nk,Nl;
real r,v,s1,s2,rad,li,lj,lz,sinv,cosv,sn2;
boolean lin,nl;
array ei,ej,ez(1:3);
real procedure vector(e,Ni,Nj);
   value Ni,Nj; integer Ni,Nj; array e;
   begin
   real l,r; integer k;
   r:= 0;
   for k:=1 step 1 until 3 do begin
      e(k):= l:= X(Nj+k)-X(Ni+k); r:= r+ l*l end;
   r:= vector:= sqrt(r); r:= 1/r;
   for k:= 1 step 1 until 3 do e(k):= e(k)*r
end vector;
procedure wd(i,j,r);
value i,j,r; integer i,j; real r;
begin
   write(res,nl,1,<:dist(:>,<<d>,i,<:,:>,j,
   <:) = :>,<<d.dddd>,r)
end;
procedure wa(i,j,k,v,p);
value i,j,k,v,p; integer i,j,k,p; real v;
begin
   write(res,<:  angle(:>,<<d>,i,<:,:>,j,<:,:>,k);
   if p=111 then write(res,<:':>);
   write(res,<:) = :>,<<ddd.dd>,v)
end;
procedure ws(i,j,k,l,st,v);
value i,j,k,l,v; integer i,j,k,l; real v; string st;
begin
   write(res,<:  :>,st,<<d>,i,<:,:>,j,<:,:>,k,
   <:,:>,l,<:) = :>,<<ddd.dd>,v)
end;
nl:= false add 10; rad:= pi/180;
read(in,i,j,k,s1,s2,v);  p:= 0;
wd(i,j,s1); wd(j,k,s2); wa(i,j,k,v,0);
lin:= v=180 or v=0; v:= v*rad;
Ni:= (i-1)*3; Nj:= (j-1)*3; Nk:= (k-1)*3;
for m:=1 step 1 until 3 do
  X(Ni+m):= X(Nj+m):= X(Nk+m):= 0;
X(Ni+1):= -s1; X(Nk+1):= -cos(v)*s2; X(Nk+2):= sin(v)*s2;
for n:=4 step 1 until N do begin
  read(in,i,j,k);
  Ni:= (i-1)*3; Nj:= (j-1)*3; Nk:= (k-1)*3;
  if lin then begin
    read(in,r,v); lin:= v=180 or v=0;
    wd(j,k,r); wa(i,j,k,v,0); v:= v*rad;
    X(Nk+1):= X(Nj+1)+cos(v)*r*sign(X(Ni+1)-X(Nj+1));
    X(Nk+2):= sin(v)*r; X(Nk+3):= 0
  end else begin
    read(in,l,r);
    if l=180 or l=0 then begin
      wd(j,k,r); wa(i,j,k,l,0);
      vector(ei,Nj,Ni); li:= if l=0 then 1 else -1;
      lj:= lz:= 0; Nl:= Nk; Nk:= Nj; p:= 0
    end else begin
      repeatchar(in); readchar(in,p);
      read(in,s1,s2);  Nl:= (l-1)*3;
      vector(ei,Nk,Ni); vector(ej,Nk,Nj); sn2:= cosv:= 0;
      for m:=1 step 1 until 3 do begin
        s:= m mod 3 + 1; t:= (m+1) mod 3 + 1;
        ez(m):= li:= ei(s)*ej(t)-ei(t)*ej(s);
        cosv:= cosv+ei(m)*ej(m); sn2:= sn2+li*li
      end;
      sinv:= sqrt(sn2); wd(k,l,r); wa(j,k,l,s1,p); s1:= s1*rad;
    end;
    if p=97 then begin real pi,pj;
      wa(i,k,l,s2,0); pi:= cos(s2*rad); pj:= cos(s1);
      li:= (pi-pj*cosv)/sn2;  lj:= (pj-pi*cosv)/sn2;
      lz:= sqrt(1-li*li-lj*lj-2*li*lj*cosv)/sinv; p:= 0
    end angle;
    if p=111 then begin
      ws(i,j,k,l,<:outo(:>,s2); s2:= s2*rad;
      lz:= cos(s2); li:= -sin(s1)*lz/sinv;
      lj:= cos(s1)*lz-li*cosv; lz:= sin(s2)/sinv; p:= 0
    end outo;
    if p=116 then begin
      ws(i,j,k,l,<:tors(:>,s2); s2:= s2*rad;
      li:= sin(s1)/sinv; lz:= -sin(s2)*li;
      li:= cos(s2)*li;   lj:= cos(s1)-cosv*li; p:= 0
    end;
    if p<>0 then begin
      write(res,<:
***readstruct error. Illegal del. after dist.: :>,
      false add p,1,<: = (:>,<<d>,p,<:)<10>:>);
      goto stop end;
    for m:=1 step 1 until 3 do
      X(Nl+m):= X(Nk+m)+(ei(m)*li+ej(m)*lj+ez(m)*lz)*r;
end end n;
stop: readstruct:= p<>0 end;
end
▶EOF◀