Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
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";