Google
 

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;