|
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◀