Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50416/darray.sai
There are 2 other files named darray.sai in the archive. Click here to see a list.
entry ;
COMMENT
.SEC(DARRAY.SAI - histogram display from array)
.index(DARRAY.SAI - histogram display from array)
.;
Begin
Internal Integer Procedure DARRAY(
Reference Integer Array Arrayed;
Integer index0,index1;
Real start,finish;
string flags );
Begin "DARRAY"
Require "sys:disprm.sai" source!file ;
Require "DEFINE.REQ" source!file ;
Require "FORT.REQ" source!file ;
Require "CVT.REQ" source!file ;
comment quick display of preload!with stored in an 'Arrayed' of
given 'size'.;
comment 'start' is the x coordinate assigned to 'Arrayed(index0)'.;
comment 'finish' is the x coordinate assigned to 'Arrayed(index1)'.;
comment 'DARRAY' returns the approximate number of vectors used.;
comment up to 5 flags may be used at once, stored as characters;
comment in 'flags'.;
comment flags are:;
comment w use last window;
comment t no tic marks;
comment s skip points to speed output;
comment x-axis is labeled starting with 'start'.;
comment 'DARRAY' cannot be used in overlay programming.;
string astring;
Integer size;
Integer iskip,ilast,vectors,alast;
Integer amax,amin,i,a,starto,fino,beginning,cmax,yint,jstart,
jEnd,j;
label label150,label132,label133,label220,label651;
comment user's coordinate system.;
Real Array plotpr[1:23];
Real left,right,bottom,top,chrhgt;
Real dx,fi,y;
Real intrvl;
comment window used by 'DARRAY':;
Internal Real dleft,dright,dbot,dtop;
Boolean Realv;
COMMENT
.next page
.SS(Procedure FLAGED)
.index(Procedure FLAGED)
.;
Boolean Procedure FLAGED( string x );
Begin "FLAGED"
Integer i;
For i_ 1 step 1 until length(flags) do
if equ(x,flags[i For 1])
then return(true);
return(false);
End "FLAGED";
comment End declarations;
comment save previous plotting window;
denq(plotpr[1]);
left_plotpr[20];
right_plotpr[21];
bottom_plotpr[22];
top_plotpr[23];
chrhgt_plotpr[9];
comment set display mode allowing characters to be seen which are;
comment outside of the window:;
dtscal(-1.);
comment obtain flags;
comment flags implemented:;
comment w use previous window;
comment t do not draw tic marks;
size_index1-index0+1;
if size<1
then
Begin "error"
outstr("bad indices: (" & cvs(index0) & ","
& cvs(index1) &
") passed to DARRAY" & crlf);
return(0);
End "error";
comment find extreme values;
if not (FLAGED("w"))
then
Begin "finding extreme values"
amax_minInteger;
amin_maxInteger;
For i_ index0 step 1 until index1 do
Begin "loop 40"
a_Arrayed[i];
if a<amin
then amin_a
else if a>amax
then amax_a;
End "loop 40";
starto_start;
fino_finish;
if (amin<amax)
then go to label150;
outstr(
"constant Array passed to Procedure DARRAY of value: " &
cvs(amin) & crlf);
return(0);
End "finding extreme values";
comment inform user of window For plotting through through
Internal variables (dleft,dright,dbot,dtop);
label150:
dwind(starto,fino,amin,amax);
dleft_starto;
dright_fino;
dbot_amin;
dtop_amax;
comment "alast" is used to draw horizontal lines in a single stroke;
ilast_1;
iskip_1;
if ( not FLAGED("s"))
then go to label133;
For i_ 1 step 1 until 5 do
Begin "loop 132"
if (flags[i For 1] neq "s")
then go to label132;
if (flags[i+1 For 1]="1")
then iskip_10;
if (flags[i+1 For 1]="2")
then iskip_100;
if (flags[i+1 For 1]="3")
then iskip_1000;
if (iskip=1)
then iskip_1 max size/100.;
if (flags[i+1 For 1]="0")
then iskip_1;
go to label133;
label132:
End "loop 132";
label133:
vectors_0;
dx_(finish-start)/size;
For i_ index0-1 step iskip until index1-1 do
Begin "loop 511"
label label511;
a_Arrayed[i+1];
if (a=alast and i+1<index1)
then go to label511;
fi_start+dx*i;
if (ilast<i)
then ddraw(fi,alast);
if i leq 0
then
Begin "move"
dmove(fi+dx,a);
alast_a;
go to label511;
End "move";
ddraw(fi,a);
vectors_vectors+1;
alast_a;
ilast_i;
label511:
;
End "loop 511";
if (FLAGED("t"))
then go to label220;
comment draw tic marks;
comment horizontal;
intrvl_10.^(ifix(alog10(finish-start)));
beginning_intrvl*ifix((start/intrvl));
cmax_amin+.95*(amax-amin);
For fi_ beginning step intrvl until finish do
Begin "loop 640"
dmove(fi,amin);
dtext(CVT(fi));
dmove(fi,cmax);
dtext(CVT(fi));
End "loop 640";
comment vertical;
yint_10.^(ifix(alog10(amax-amin))-1);
jstart_amin/yint;
jEnd_amax/yint;
if jEnd-jstart geq 10
then if jEnd-jstart>40
then yint_yint*10
else
else yint_yint/10;
jstart_amin/yint;
jEnd_amax/yint;
For j_ jstart step 1 until jEnd do
Begin "loop 650"
y_yint*j;
dmove(start,y);
dtext(CVT(y));
End "loop 650";
comment restore user coordinate system and character scaling;
label220:
if ( not FLAGED("w"))
then dwind(left,right,bottom,top);
dtscal(chrhgt);
return(vectors);
End "DARRAY";
End;