|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 3840 (0xf00)
Types: TextFile
Names: »ramplix«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »ramplix«
clear user rampli
rampli=set 1 disc5
scope user rampli
rampli=algol list.no
\f
RAMAN ANALYSE PLI
external procedure rampli(name,pl,fmin,fmax,df,dt,delta);
long array name; integer pl,fmin,fmax,df,dt,delta;
begin integer h,j,i,k,m,v,pol,seg,nr,save;
real smin,smax,bmin,bmax,deltaf,skax,skay,f1,x,y,ymax,u,u0,p,u1,max;
boolean nl;
array head(1:12);
long array BS,TE(1:2); integer array tBS,tsp,tTE(1:10);
zone zBS,sp(128,1,stderror);
nl:=false add 10; p:=10;
open(sp,4,name,0); inrec(sp,128);
seg:=sp(1); v:=sp(2); max:=sp(6); nr:=sp(10);
bmin:=sp(11); bmax:=sp(12);
for j:=1 step 1 until 12 do head(j):=sp(j+99);
deltaf:=fmax-fmin;
smin:=if fmin<bmin then bmin else fmin;
smax:=if fmax>bmax then bmax else fmax;
x:=26; y:=18;
skax:=(x-2)/deltaf; skay:=(y-4)/max;
m:=pl/10; save:=pl-m*10; pl:=m;
setplotname(case pl of(<:tek4006a:>,<:houstona:>,<:tek4006c:>,<:tek4006d:>),
if pl=4 then 3 else 0);
ramng(nr,TE,5);
if lookupentry(TE)=0 then removeentry(TE);
cleararray(tTE); tTE(1):=200;
reservesegm(TE,200); permentry(TE,15);
j:=1; saveplot(save,string TE(increase(j)),0);
plotform(10,x,y+1);
plotsize:=1.5*.2; plotheight:=1.5*.28; linediff:=1.5*.56;
setmargin(1,y-0.75);
writeplot(<:<12>I(<14>n<15>):>);
setmargin(3,y-0.75);
writeplot(<:<12>:>,<:nr::>,<<ddd>,nr);
setmargin(6,y-0.75);
writeplot(<:<12>:>,string inc(head));
setmargin(7,y-0.75);
plotmove(1,1); pendown;
for j:=fmin step df until fmax do
begin f1:=(j-fmin)*skax+1;
if j<>fmin then
begin plotmove(f1,1);
plotmove(f1,1+y/(if j mod dt=0 then 25 else 50));
plotmove(f1,1);
end;
if j mod dt=0 then
begin setmargin(f1-plotsize*0.5*cif(j),0.8-plotheight);
writeplot(<:<12>:>,case cif(j) of(
<<d>,<<dd>,<<ddd>,<<dddd>),j);
plotmove(f1,1); pendown;
end;
end;
plotmove(x-1,1); plotmove(x-1,y-1);
for j:=fmin step df until fmax do
if j mod df=0 then i:=j;
for j:=i step -df until fmin do
begin f1:=(j-fmin)*skax+1;
if j<>fmin then
begin plotmove(f1,y-1);
plotmove(f1,y-1-y/(if j mod dt=0 then 25 else 50));
plotmove(f1,y-1);
end;
end;
plotmove(1,y-1); plotmove(1,1);
plotsubform(1,x-1,1,y-1,false);
penup;
u0:=(smin-bmin)*10; h:=entier(u0/128); u0:=u0-h*128;
if u0=0 then u0:=1;
setposition(sp,0,h+2); inrec(sp,128);
u1:=sp(u0)*skay+1;
u:=(smin-fmin)*skax; ymax:=y-2;
plotmove(u,if u1>ymax then ymax else u1);
pendown;
setposition(sp,0,2);
for k:=0 step 1 until seg-3 do
begin inrec(sp,128);
for j:=1 step 1 until 128 do
begin i:=k*128+j;
if i<v and (k*128+j) mod delta = 0 then
begin u:=(bmin-fmin+i/p)*skax;
if u< (smin-fmin)*skax then goto S1;
if u> (smax-fmin)*skax then goto S2;
u1:=sp(j)*skay+1;
plotmove(u,if u1>ymax then ymax else u1);
end;
S1: end j;
end k;
S2: plotend;
penup;
plotclose;
lookuptail(TE,tTE); tTE(1):=tTE(10);
changetail(TE,tTE);
slut: close(sp,true); end; end
\f
▶EOF◀