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;