DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦36edb3ff0⟧ TextFile

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

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »ramplix« 

TextFile

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◀