Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0110/tk4012.sai
There are 2 other files named tk4012.sai in the archive. Click here to see a list.
entry ;
COMMENT
.SEC(TK4012.SAI - Tektronix 4012 handler)
.index(TK4012.SAI - Tektronix 4012 handler)
.;
Begin
comment

file: TK4012.sai
TK4012: Subroutine for displaying halftone pictures with 17 gray
levels on a Tektronix 4012 graphics terminal. Written by:

        Richard Gordon, Lee Silver and Darrell S. Rigel
                     Image Processing Unit
                   National Cancer Institute
                 National Institutes of Health
                     Building 36, Room 4D28
                  Bethesda, Maryland 20014 USA

                              and

                    Department of Radiology
          George Washington University Medical Center
                        Washington, D.C.
Revised Nov. 1, 1976 - DENQ call fixed
Revised May 26, 1976 - Lemkin - removed BOUND.REQ since
		 don't care if INSPOOL
Revised May 20, 1976 - Lemkin - added Q to quit
Revised April 27, 1976 - Lemkin and Shapiro - fixed LCS
Revised March 18, 1976 - Lemkin and Shapiro - added DINI(4,0,0,0)
Revised April 13, 1976 - Lemkin and Shapiro  OMNI==>LCS
Revised March 19, 1976 - Lemkin and Shapiro - removed DINI(4,0,0,0)
Revised March 18, 1976 - Shapiro added DGET

The tube should be in its sharpest focus. (This may conflict
with the defocus needed for a hard copy device.)


The following parameters must be passed:

title_ an ASCII String
subtitle_ an ASCII String
(xlcs,ylcs)_ the coordinates of the LCS
pict_ an Integer mode Array dimensioned 
      pict[0:nrows-1,0:ncolumns-1]
nrows_ number of rows
ncolumns_ number of columns
dnsmin _ minimum density of Array pict
dnsmax _ maximum density of Array pict
         note: if dnsmin geq dnsmax then the minimum and
         maximum densities are calculated from pict
scaling_ 0 for linear scaling, otherwise the ratio
         between the brightnesses of the maximum and minimum
         densities
film _ "neg" for a negative
       "pos" for a positive
npict_ the number to be assigned to the picture
       (negative to cause image to be retained in core)

;
Internal Procedure TK4012( String title,subtitle;
				Real xlcs,ylcs;
				Integer Array pict;
				Integer nrows,ncolumns,dnsmin,dnsmax;
				Real scaling;
				String film;
				Integer npict  );
    Begin "TK4012"
comment Display routines in the Omnigraph package used at NIH:
DENQ saves user's plotting parameters in Array plotr;



Require "DEFINE.REQ" source!file;

	External Procedure DENQ(  Real Array plotr  );

"DTSCAL allows characters to be drawn outside the plotting
window for lines" 
	External Procedure DTSCAL( Real var);
"DDONE1 updates the screen without erasing previous pictures"
	External Procedure DDONE1;
"DMOVE moves the beam to position (x,y)"
	External Procedure DMOVE( Real x,y);
"DTEXT types a String of characters starting at the current
plotting position" 
	External Procedure DTEXT( String a);
"DOPEN opens a new picture"
	External Procedure DOPEN( Integer npict);
"DPOST posts the given picture"
	External Procedure DPOST( Integer npict);
"DAPPEND allows continued drawing of the given picture"
	External Procedure DAPPEND( Integer npict);
"DWIND specifies the viewing window which is mapped onto the
screen"
	 External Procedure DWIND( Real left,right,bottom,top);
"DKILL removes a picture from core"
	External Procedure DKILL( Integer npict);
Real left,
	right,
	bottom,
	top,
	chrhgt,
	scale,
	x,
	y,
	range,
	xomni,
	yomni;
Internal Integer
	halfx,
	halfy,
	character!count;

Integer dmin,
	dmax,
	i,
	j,
	density,
	last!row,
	last!column,
	ncolumns!over!2,
	odd!or!even,
	line!number,
	beginning,
	ending,
	segment!Beginning,
	segment!Ending;

Label forgetit;

String Array line[1:6,0:1];

String lchar,line!out;

Boolean negative,found!7!blanks;

Real Array plotpr[1:23];

"The Array c[offset#,density] specifies which character is to
be typed for the given density, for each offset line which is
produced"
Own String Array c[1:6,0:16];
Own Integer Array xoffset[1:6],yoffset[1:6];
Own Integer start;
Procedure TITLES;
"Plot title, truncating it at the width of the picture"
	Begin "TITLES"
	    DMOVE(halfx,halfy-7.0043*3);
	    DTEXT(title[1 for ncolumns/2]);
	    DMOVE(halfx,halfy-7.0043*5-5);
	    DTEXT(subtitle[1 for ncolumns/2]);
	End "TITLES";
"	Init the display for a 4012 here!!!"

	last!row_nrows-1;
	last!column_ncolumns-1;
	ncolumns!over!2_(ncolumns+1)/2;
"Save user's coordinate system"
	DENQ(plotpr[1]);
	left_plotpr[20];
	right_plotpr[21];
	bottom_plotpr[22];
	top_plotpr[23];
	chrhgt_plotpr[9];
	if  start=0
	then
	Begin "initialization"
	    xoffset[1]_-2;
	    yoffset[1]_-10;
	    xoffset[2]_-4;
	    yoffset[2]_-10;
	    xoffset[3]_-4;
	    yoffset[3]_0;
	    xoffset[4]_-2;
	    yoffset[4]_0;
	    xoffset[5]_-6;
	    yoffset[5]_-4;
	    xoffset[6]_0;
	    yoffset[6]_-10;
	    for line!number_1 step 1 until 6 do
		for density_0 step 1 until 16 do
		    c[line!number,density]_" ";
	    c[3,1]_".";
	    c[3,2]_".";
	    c[4,2]_".";
	    c[3,3]_",";
	    c[2,4]_"'";
	    c[2,5]_"'";
	    c[3,5]_".";
	    c[3,6]_",";
	    c[4,6]_",";
	    c[1,7]_"'";
	    c[3,7]_",";
	    c[1,8]_"""";
	    c[1,9]_"""";
	    c[4,9]_".";
	    c[1,10]_"""";
	    c[4,10]_",";
	    c[1,11]_"""";
	    c[2,11]_"'";
	    c[1,12]_"""";
	    c[2,12]_"'";
	    c[4,12]_".";
	    c[1,13]_"""";
	    c[2,13]_"'";
	    c[5,13]_":";
	    c[1,14]_"""";
	    c[2,14]_"'";
	    c[4,14]_".";
	    c[5,14]_":";
	    c[1,15]_"""";
	    c[2,15]_"'";
	    c[4,15]_".";
	    c[5,15]_":";
	    c[6,15]_"`";
	    c[1,16]_"""";
	    c[2,16]_"""";
	    start_1;
	End "initialization";
"Convert coordinates of lower left hand corner from user
coordinate system to raster coordinates. The horizontal spacing
between characters is 8 dots or 2*7.0043 raster units. Since each
character spacing is split, the unit distance between
pixels is 7.0043 raster units."

	 DWIND(0.,779.,0.,779.);
"	map LCS to (-1:+1,-1:+1)"
	xomni_(xlcs-389.500)/389.500;
	yomni_-(ylcs+nrows*7.0043-389.500)/389.500;
	halfx_779*(xomni+1)/2.0+11;
	halfy_779*(yomni+1)/2.0+11;
"Set display mode allowing characters to be seen which
are outside of the window:" DTSCAL(-1);
	DOPEN(abs(npict));
comment Density scaling for "pict";
	dmin_dnsmin;
	dmax_dnsmax;
	if  dmax leq dmin
	then
	Begin "calculating minimum and maximum"
	    dmin_34359738367;
"=largest Integer in one word"
	    dmax_-dmin;
	    for i_  0 step 1 until last!row do
		for j_  0 step 1 until last!column do
		Begin "find extrema"
		    density_pict[i,j];
		    dmin_dmin min density;
		    dmax_dmax max density;
		End "find extrema";
	    if  dmax leq dmin
	    then
	    Begin "no picture"
		TITLES;
		DMOVE(halfx,halfy+7.0043*(nrows-2));
		DTEXT("all " & cvs(density));
		DPOST(abs(npict));
		DDONE1;
		return;
	    End "no picture";
	End "calculating minimum and maximum";
	range_dmax-dmin;
	scale_17./(dmax-dmin);
	TITLES;
	negative_ if  equ(film[1 for 1],"n") or equ(film[1 for 1],"N")
		  then true
		  else false;
	"Create halftone picture. A new display routine picture
is created for each picture element and then displayed on the
screen, when npict > 0. Since the same picture number is used
each time, the display commands generating the whole picture are
not stored in core." DPOST(abs(npict));
	DDONE1;
	character!count_0;
	for i_  last!row step -1 until 0 do
	Begin "row"

	    Real xReal;

	    Integer xInt;

	    for line!number_1 step 1 until 6 do
		for odd!or!even_0 step 1 until 1 do
		    line[line!number,odd!or!even]_null;
comment The spacing of picture elements in the y direction
is taken as 7 instead of 7.0043, to avoid roundoff error.
This leads to less than a part in a thousand distortion of
the picture.;
	    y_halfy+7*(last!row-i);
	    odd!or!even_1;
	    for j_  0 step 1 until last!column do
	    Begin "build row"
		Integer qchar;
		If (qchar_INCHRS)="Q" or qchar="q"
			Then
			Begin "done"
			DDONE1;
			Goto forgetit;
			End "done";
		density_ if  scaling=0
			 then scale*(pict[i,j]-dmin)
			 else 17*scaling^(((dmin max (dmax min pict[i,j]))
				 -dmax)/range);
		if  negative
		then density_16-density;
		density_0 max (16 min density);
		if  npict<0
		then DAPPEND(-npict)
		else DOPEN(npict);
		odd!or!even_1-odd!or!even;
		for line!number_1 step 1 until 6 do
		    line[line!number,odd!or!even]_line[line!number,
			odd!or!even] & c[line!number,density];
	    End "build row";
	    for line!number_1 step 1 until 6 do
	    Begin "line output"
		for odd!or!even_0 step 1 until 1 do
		Begin "String setup"
		    line!out_line[line!number,odd!or!even];
		    for Beginning_1 step 1 until ncolumns!over!2 do
			if  not equ(line!out[Beginning for 1]," ")
			then done ;
		    if  Beginning leq ncolumns!over!2
		    then
		    Begin "line not empty"
			for Ending_ncolumns!over!2 step -1 until 1 do
			    if  not equ(line!out[Ending for 1]," ")
			    then done ;
			segment!Beginning_Beginning;
			while segment!Beginning leq Ending do
			Begin "segments"
			    found!7!blanks_false;
			    for segment!Ending_segment!Beginning+1 step
					1 until Ending-6 do
				if  found!7!blanks_equ("       ",
					line!out[segment!Ending for 7])
				then done ;
			    segment!Ending_ if found!7!blanks
					    then segment!Ending-1
					    else Ending;
			    xReal_halfx+xoffset[line!number]+7.0043*
				odd!or!even+(segment!Beginning-1)*2*
				7.0043;
			    xInt_xReal;
comment Each segment is extEnded by a blank to the left
until roundoff error in x is less than 0.23;
			    while abs(xInt-xReal)>0.23 and
				segment!Beginning>1 do
			    Begin "backtracking"
				segment!Beginning_segment!Beginning-1;
				line!out_line!out[1 to segment!Beginning
				    -1] & " " & line!out[
				    segment!Beginning+1 to Ending];
				xReal_halfx+xoffset[line!number]+7.0043
				    *odd!or!even+(segment!Beginning-1)*
				    2*7.0043;
				xInt_xReal;
			    End "backtracking";
			    DMOVE(xInt,.5+y+yoffset[line!number]);
			    DTEXT(line!out[segment!Beginning to
				segment!Ending]);
"The character count includes 6 characters for every DMOVE executed"
			    character!count_character!count+6+
				segment!Ending-segment!Beginning+1;
			    for segment!Beginning_segment!Ending+8 step
					1 until Ending do
				if  not equ(" ",line!out[
					segment!Beginning for 1])
				then done ;
			End "segments";
		    End "line not empty";
		End "String setup";
	    End "line output";
	    DPOST(abs(npict));
	    DDONE1;
	End "row";
"Restore user coordinate system and character scaling"
forgetit:	DWIND(left,right,bottom,top);
	DTSCAL(chrhgt);
	If npict>0 then Dkill(npict);
    End "TK4012";

End;