Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0110/hlfton.sai
There are 2 other files named hlfton.sai in the archive. Click here to see a list.
00100	entry;
00200	COMMENT
00300	.SEC(HLFTON.SAI - gray scale display package)
00400	.INDEX(HLFTON.SAI - gray scale display package)
00500	.;
00600	Begin "HLFTON.SAI"
00700	comment
00800	
00900	                         Richard Gordon
01000	                     Image Processing Unit
01100	                   National Cancer Institute
01200	                 National Institutes of Health
01300	                     Building 36 Room 4D28
01400	                  Bethesda, Maryland 20014 USA
01500	                       phone 301-496-2394
01600	
01700	
01800	Revised Nov 14, 1976 - add Number mode
01900	Revised Oct 12, 1976 - Lemkin, added Gamma correction to ASR33
02000	Revised Aug 6, 1976 - Lemkin, make display normalization compat.
02100			all displays.
02200	Revised May 26, 1976 -Lemkin  deleted INSPOOL and BOUND.REQ, reversed
02300				display so get better contrast
02400	Revised May 20, 1976 -Lemkin added Q to quit display
02500	Revised April 27, 1976 -Lemkin and Shapiro x0,yo==>xlcs,ylcs and ASR33
02600	Revised March 22, 1976 -Gordon, call to CROSSHAIRS put in
02700	Revised Jan 5, 1976  - Peter Lemkin
02800	Revised January 15, 1976, R. Gordon, errors in error msgs
02900	Revised Feb 1, 1976  - Peter Lemkin added ASR33 print
03000	Revised Feb 6, 1976  - Peter Lemkin fixed ASR33 rows/columns mixup
03100	Revised Feb 9, 1976 - Lemkin, changed terminal names
03200	Revised March 12, 1976- density reversed for compatibility with
03300		the Dicomed -Gordon
03400	Revised March 16, 1976- Shapiro added GT40 intensity level
03500		display capability
03600	
03700	
03800	
03900	
04000	
04100		Introduction
04200		------------
04300	Procedure for displaying standard RTPP DDTG formated images  as
04400	gray scale windows on the GT40, Tektronix 4012 or 4023 graphics
04500	terminals, or an ASR33 like terminal.;
04600	
04700	Require "DEFINE.REQ" source!file;
04800	Require "SYS:DISPRM.SAI" Source!file;
04900	Require "LOWER.REQ" Source!file;
05000	Require "TK4012.REQ" Source!file;
05100	Require "TK4023.REQ" Source!file;
05200	Require "GTDISP.REQ" Source!file;
05300	Require "PRCMAX.REQ" Source!file;
05400	Require "PRCINV.REQ" Source!file;
05500	Require "PPAK.REQ" Source!file;
05600	Require "CROSSH.REQ" source!file;
     
00100	    Internal Procedure HLFTON(  Integer Array image;
00200				Integer first!row,last!row,first!column,
00300					    last!column,sampling;
00400				String title;
00500				Real xlcs,ylcs;
00600				Integer dmin,dmax;
00700				Real scaling;
00800				Integer npict;
00900				Reference Integer row!cross,
01000				    column!cross;
01100				String terminal);
01200	    Begin "Display pix"
01300	
01400	Integer
01500		nrows,
01600		ncolumns,
01700		pict!row,
01800		pict!column,
01900		sampled!row,
02000		sampled!column,
02100		pictval,
02200		row,
02300		column,
02400		character,
02500		last!sampled!column,
02600		last!sampled!row;
02700	
02800	String subtitle;
02900	
03000	
03100	External Integer 
03200		crossrow,
03300		crosscolumn;
03400	
03500	
03600	Real Array 
03700		xy[1:2];
     
00100	comment 	[HT.1] Set subtitle. Check the picture sampling
00200			 limits;
00300			subtitle_ "(" & cvs(first!row) & ":" & cvs(last!row)
00400			   &","&cvs(first!column)&":"&cvs(last!column) &
00500			    ")/" & cvs(sampling);
00600	
00700		ncolumns_(last!column-first!column+1)/abs(sampling);
00800		nrows_(last!row-first!row+1)/abs(sampling);
00900		If  nrows leq 0 or ncolumns leq 0
01000		Then
01100		Begin "error"
01200		    outstr("No points in picture: " & title & crlf);
01300		    return;
01400		End "error";
01500		If  sampling=0
01600		Then
01700		Begin "error"
01800		    outstr("Error in HLFTON: sampling=0" & crlf);
01900		    return;
02000		End "error";
     
00100	comment 	[HT.2] sample the image into array 'PICT'.;
00200		Begin "get pictures"
00300	
00400		    Integer Array pict[0:nrows-1,0:ncolumns-1];
00500	
00600	comment For displays which glow, the density is flipped for
00700	compatibility with DICOMED images.
00800	Comment - May 20, 1976 - lemkin, reversed it so
00900	that white is 255, black is 0;
01000	
01100	
01200	
     
00100	Procedure DENSITY!FLIP;
00200	Begin "DENSITY!FLIP"
00300	For pict!row_0 step 1 until nrows-1 do
00400	    For pict!column_0 step 1 until ncolumns-1 do
00500		pict[pict!row,pict!column]_trunc!max-pict[
00600			    pict!row,pict!column];
00700	End "DENSITY!FLIP";
     
00100	
00200	"	[HT.2.0] compute a sampled image"
00300		    pict!row_0;
00400		    pict!column_0;
00500		    For sampled!row_first!row step abs(sampling) until last!row
00600				-abs(sampling)+1 do
00700		    Begin "row"
00800			for sampled!column_first!column step abs(sampling) until
00900				    last!column-abs(sampling)+1 do
01000			Begin "column"
01100			    If  sampling<0
01200			    Then pict[pict!row,pict!column]_FETCH2D(image,
01300				    sampled!row,sampled!column)
01400			    Else
01500			    Begin "averaging over square"
01600				pictval_0;
01700				for row_sampled!row step 1 until (
01800					    last!sampled!row_last!row MIN
01900					    sampled!row+abs(sampling)-1) do
02000				Begin "summing"
02100				    For column_sampled!column step 1 until (
02200						last!sampled!column_last!column
02300						MIN sampled!column+abs(sampling)
02400						-1) do
02500					pictval_pictval+FETCH2D(image,row,
02600					    column);
02700				End "summing";
02800				pict[pict!row,pict!column]_pictval/((
02900				    last!sampled!column-sampled!column+1)*(
03000				    last!sampled!row-sampled!row+1));
03100			    End "averaging over square";
03200			    pict!column_pict!column+1;
03300			End "column";
03400			pict!row_pict!row+1;
03500			pict!column_0;
03600		    End "row";
     
00100	
00200	Comment		[HT.2.0] If NUMBER mode then
00300			print it on the TTY: as decimal numbers;
00400	If sip2="N"
00500	   Then
00600	   Begin "Print numbers"
00700		Integer p,q,qchar;
00800		GETFORMAT(p,q);
00900		SETFORMAT(3,0);
01000		For pict!row_0 step 1 until (nrows-1) do
01100		Begin "print line"
01200		Outstr(CVS(pict!row)&":");
01300		If (qchar_INCHRS)="q" or qchar="Q"
01400			Then Return;
01500		For pict!column_0 step 1 until (ncolumns-1) Min 18 do
01600		Outstr(" "&CVS(pict[pict!row,pict!column]));
01700		Outstr(crlf);
01800		End "print line";
01900	   SETFORMAT(p,q);
02000	   Return;
02100	   End "Print numbers";
02200			
02300			
     
00100	comment 	[HT.2.1]  Display  the image on Tektronix 4012.;
00200		    If  equ(LOWER(terminal),LOWER("4012"))
00300		    Then
00400		    Begin "4012"
00500	#  -- not flipped 5/20/76 - 		DENSITY!FLIP;
00600			setformat(0,7);
00700	
00800			TK4012(title,subtitle,xlcs,ylcs,pict,
00900				nrows,ncolumns,0 max (255 min dmin),
01000				0 max (255 min dmax),scaling,"POS",
01100				npict);
01200			If  row!cross neq 0
01300			Then crosshairs;
01400	comment TEMPORARY PATCH:;
01500			row!cross_crossrow;
01600			column!cross_crosscolumn;
01700		    End "4012";
     
00100	comment 	[HT.2.2]  Display  the image on Tektronix 4023 if
00200	selected.;
00300		    If  equ(LOWER(terminal),LOWER("4023"))
00400		    Then
00500		    Begin "4023"
00600	#  -- not flipped 5/20/76 - 		DENSITY!FLIP;
00700			TK4023(title,subtitle,xlcs,ylcs,pict,nrows,ncolumns,
00800				0 max(255 min dmin),0 max (255 min dmax),
00900				scaling,"POS", npict);
01000		    End "4023";
     
00100	comment 	[HT.2.3]  Display  the image on ASR33 if selected.;
00200		    If  equ(LOWER(terminal),LOWER("ASR33"))
00300		    Then
00400		    Begin "ASR33"
00500	
00600			Integer i,j;
00700	
00800			Preload!with
00900	
01000	
01100		" ",
01200		".",
01300		",",
01400	
01500		":",
01600		"!",
01700		"/",
01800		"&",
01900		"#";
02000	
02100			Own String Array pp[0:7];
02200	
02300			Integer avg, qchar;
02400	comment 	display the image;
02500	
02600			For i_ 0 Step 1 Until nrows-1 Do
02700			Begin "Print Line"
02800			    For j_0 Step 1 Until (ncolumns-1) Min 72 Do
02900			    Begin "print pixel"
03000				If (qchar_INCHRS)="q" or qchar="Q"
03100					Then Return;
03200				pictval_(dmin Max pict[i,j]) Min dmax;
03300	"			Contrast stretch it"
03400				avg_If scaling=0
03500					Then
03600					(255/(dmax-dmin))*(pictval-dmin)
03700					Else
03800					255*scaling*(pictval/(dmax-dmin));
03900				outstr(pp[(avg lsh -5) Land '7]);
04000			    End "print pixel";
04100			    outstr(crlf);
04200			End "Print Line";
04300			Outstr(Title & crlf & subtitle & crlf);
04400		    End "ASR33";
     
00100	comment	    [HT 2.4] GT-40 display;
00200		    If  Equ(LOWER(terminal),LOWER("GT40"))
00300		    then
00400		    Begin "GT40"
00500			DENSITY!FLIP;
00600			GTDISP(Title,xlcs,ylcs,Pict,Nrows,Ncolumns,
00700				dmin,dmax,Scaling,Npict);
00800		    End "GT40";
00900		End "get pictures";
01000	    End "Display pix";
01100	
01200	End "HLFTON.SAI";