Trailing-Edge
-
PDP-10 Archives
-
decuslib20-04
-
decus/20-0110/spak.sai
There are 2 other files named spak.sai in the archive. Click here to see a list.
ENTRY;
COMMENT
.SOSPAGE_1
.SEC(SPAK - worker routines for SINTRP)
.index(SPAK - worker routines for SINTRP)
.;
BEGIN "SPAK.SAI"
COMMENT
P. LEMKIN, R. GORDON, B. SHAPIRO
IMAGE PROCESSING UNIT
DIVISION OF CANCER BIOLOGY AND DIAGNOSIS
NATIONAL CANCER INSTITUTE
NATIONAL INSTITUTES OF HEALTH
BETHESDA, MD 20014
301-496-2394
Revised Nov 14, 1976 - Lemkin, set initial scaling to 0.
REVISED Aug 24, 1976 - Lemkin modified SETDENSITY
REVISED Aug 6, 1976 - Lemkin changed SETXY to SETLCS
Revised May 21, 1976 - Lemkin, modify activedata for seglist
Revised May 17, 1976 - Lemkin, added Touching field to ACTIVE Pi
Revised April 28, 1976 - Shapiro - fixed DWIND in SET!TERMINAL
Revised April 21, 1976 -Shapiro- added SET!BND!SCALE!FACT
Revised April 13, 1976 - Lemkin, - fixed SET!WINDOW
Revised April 12, 1976 - Lemkin, Shapiro fixed PARAMETERS for movie
Revised April 10, 1976 - Lemkin, fixed PARAMETERS for movie
Revised April 9, 1976 - Lemkin, fixed LISTCOMMANDS FOR BOUNDARY
Revised April 7, 1976 - Lemkin, fixed DWIND in setterminal, settitle
Revised April 5, 1976 - Lemkin, fixed fixe ACTIVEDTA
Revised April 3, 1976 - Lemkin, fixed SET!LCS limits
Revised April 1, 1976 - Lemkin, fixed parameters and SET!LCS
Revised March 30, 1976 - Lemkin, added TRANSFORMs to ACTIVE!DATA
;
COMMENT
.SSS(REQUIRE files)
.INDEX(REQUIRE files)
.;
Comment
" ================================"
" = R E Q U I R E ="
" ================================"
" The following files are required for use by PROC10."
;
Comment
note the following REQ's are for debugging and will be removed;
Require "ARINFO.REQ" source!file;
Comment Permanent REQ's;
Require "DEFINE.REQ" source!file;
Require "PPAK.REQ" source!file;
Require "LINPAK.REQ" source!file;
Require "SYS:DISPRM.SAI" source!file;
Require "CVT.REQ" source!file;
Require "BOUND.REQ" source!file;
" The following require files are used to link this
interpreter with PROC10 itself"
Require "PRCMAX.REQ" source!file;
Require "PRCINV.REQ" source!file;
Require "PRCWRK.REQ" source!file;
COMMENT
.next page
.SS(Procedure DEL!WINDOW)
.INDEX(Procedure DEL!WINDOW)
.;
Internal Simple Procedure DEL!WINDOW;
"----------------------------------------"
Begin "DELETE WINDOW"
Integer i,j;
" Look for WINDOW number"
If Equ((sout_GUESSER(sout,lgl!wnames)),null) or
(1 > (i_Intscan(sout,flag)) > max!number!computing!windows)
Then
Begin "Bad WINDOW number"
Outstr("Bad WINDOW number"&crlf);
return;
End "Bad WINDOW number";
" Zero computing!window"
cw!in!use[i]_false;
cw!title[i]_null;
For j_1 step 1 until 7 Do
c!wind[j,i]_0;
End "DELETE WINDOW";
COMMENT
.Next page
.SS(Procedure SET!BND!SCALE!FACT)
.INDEX(Procedure SET!BND!SCALE!FACT)
.;
Internal Simple Procedure SET!BND!SCALE!FACT;
"--------------------------------------------"
Begin "BND!SCALE"
"sets a multiplication factor for determining value
for a DWIND with boundary display"
If not Equ(Sout,null)
Then
bnd!scale!fact_(0.1 max realscan(sout,flag) min 10)
else
bnd!scale!fact_1;
End "BND!SCALE";
COMMENT
.next page
.SS(Procedure SET!DENSITY)
.INDEX(Procedure SET!DENSITY)
.;
Internal Simple Procedure SET!DENSITY;
"----------------------------------------"
Begin "DEN"
Integer i;
" Use value if given else request it"
If not Equ(sout,null)
Then thr!density_(0 max intscan(sout,flag)) min 511
Else IBOUND(0,thr!density,trunc!max,
"Mean density value ",NULL);
If not Equ(sip1,null)
Then
trunc!max_(1 Max Intscan(sip1,flag)) Min 511
Else
IBOUND(1,trunc!max,511,"Compute density precision",null);
If not Equ(sip2,null)
Then dmin_(0 max intscan(sip2,flag)) min 511
Else IBOUND(0,dmin,511,
"Minimum density value ","Min");
If not Equ(sip3, null)
Then dmax_(dmin max intscan(sip3,flag)) min 511
Else IBOUND(dmin,dmax,511,
"Maximum density value ","Max");
End "DEN";
COMMENT
.next page
.SS(Procedure SET!SAMPLING)
.INDEX(Procedure SET!SAMPLING)
.;
Internal Simple Procedure SET!SAMPLING ;
"----------------------------------------"
Begin "SET!SAMPLING"
Integer sizemax;
" Set up the sampling distance for doing a SHOW"
" compute the maximum sampling size"
sizemax_(lastrow-firstrow) min (lastcolumn-firstcolumn);
If not Equ(sout,null)
Then
Begin "Get from sout"
If "0" leq sout leq "9"
Then Begin "use it"
sampled_Intscan(sout,flag);
If sampled=0 or sampled=1
Then sampled_-1;
If sampled > 0
Then sampled_sampled min sizemax
Else sampled_sampled max -sizemax;
Return;
End "use it";
Outstr("Bad sampling specification"&crlf);
Return;
End "Get from sout"
Else
IBOUND(-sizemax,sampled,sizemax,
"Set sampling frequency for displayed pixels" &
" (negative for no averaging)","Set sampling");
If sampled=0 or sampled=1
Then sampled_-1;
Outstr("Display sampling distance set to: "&CVS(sampled)&crlf);
End "SET!SAMPLING";
COMMENT
.next page
.SS(Procedure SET!SCALING)
.INDEX(Procedure SET!SCALING)
.;
Internal Simple Procedure SET!SCALING ;
"----------------------------------------"
Begin "SET!SCALING"
" Set up the SCALING for doing a SHOW"
If not Equ(sout, null)
Then scaling_(0 max Realscan(sout,flag)) min maxinteger
Else
BOUND(0,scaling,"inf",
"Scaling ratio between max and min densities (=0 For linear scaling)",
null);
End "SET!SCALING";
COMMENT
.next page
.SS(Procedure SET!SIZE)
.INDEX(Procedure SET!SIZE)
.;
Internal Simple Procedure SET!SIZE ;
"----------------------------------------"
Begin "SET!SIZE"
" Set up the size for computation window"
If 3 > (im!size_Intscan(sout,flag)) > 256
Then
IBOUND(3,im!size,256,"Image size","Size");
" set the parameters to this size"
PINI(-1,im!size);
Outstr("Size set to "&CVS(imsiz+1)&"X"&CVS(imsiz+1)&crlf);
End "SET!SIZE";
COMMENT
.next page
.SS(Procedure SET!TERMINAL)
.INDEX(Procedure SET!TERMINAL)
.;
Internal Simple Procedure SET!TERMINAL;
"----------------------------------------"
Begin "TER"
TTYUP(true);
If Equ(sout,"ASR33") or Equ(sout,"GT40") or Equ(sout,"4012")
or Equ(sout,"4023")
Then trm!name_sout
Else
SBOUND(trm!name,"GT40,ASR33,4012,4023",
"Terminal type","Terminal type");
TTYUP(false);
" Set LCS to top of screen for ASR33 and 4023"
xp_0;
yp_0;
" set up for OMNI display"
If Equ(trm!name,"4012") or Equ(trm!name,"GT40")
Then
Begin "4012 or GT40"
" Set the LCS to the middle of the screen"
xp_256;
yp_256;
cross!hairs_false;
If Equ(trm!name,"4012")
Then
Begin "4012"
LBOUND(cross!hairs,
"Do you want to see cross hairs?",
"Cross hairs?");
End "4012";
If cross!hairs
Then
Begin "set cross"
r!cross_1;
Outstr("Reply Q when cross hairs are positioned"
& crlf);
End "set cross";
" only setup the OMNI terminal once!"
If not setupOMNI
Then
Begin "Init OMNI"
setupOMNI_true;
If Equ(trm!name,"GT40")
Then
Begin "Set GT40"
DINI(5,0,0,0);
DWIND(0,767,0,767);
End "Set GT40"
Else
Begin "Set 4012"
DINI(4,0,0,0);
DWIND(0,779,0,779);
End "Set 4012";
DGET;
End "Init OMNI"
Else Outstr("OMNI already INITed"&crlf);
End "4012 or GT40";
" Set the scaling"
scaling_0;
Outstr("Setting terminal type to: "&trm!name&crlf&
"Scaling set to: "&CVS(scaling)&crlf);
End "TER";
COMMENT
.next page
.SS(Procedure SET!TITLE)
.INDEX(Procedure SET!TITLE)
.;
Internal Simple Procedure SET!TITLE;
"----------------------------------------"
Begin "SET!TITLE"
" [1] test for output mask name"
If not Equ(GUESSER(sout,lgl!mnames), null)
Then
Begin "set mask name"
If (mask3_GET!MASK(sout))=none Then Return;
SBOUND(mask!title[m!index],"any",
"Mask title", "Title");
Return;
End "set mask name";
" [2] test for output picture name"
If not Equ(GUESSER(sout,lgl!pnames), null)
Then
Begin "set Picturename"
If (image3_GET!IMAGE(sout))=none Then Return;
SBOUND(pix!title[p!index],"any",
"Picture title", "Title");
Return;
End "set Picturename";
" [3] test for output window name"
If not Equ(GUESSER(sout,lgl!wnames), null)
Then
Begin "set window name"
w!index_Intscan(sout_sout[2 to Inf],flag) min 1;
SBOUND(cw!title[w!index],"any",
"Window title", "Title");
Return;
End "set window name";
" [4] test for output boundary name"
If not Equ(GUESSER(sout,lgl!bnames), null)
Then
Begin "set boundary name"
If (bnd3_GET!BOUNDARY(sout))=none Then Return;
SBOUND(bnd!title[b!index],"any",
"Boundary title", "Title");
Return;
End "set boundary name";
" [4] test for output transform name"
If not Equ(GUESSER(sout,lgl!bnames), null)
Then
Begin "set transform name"
If (trn3_GET!transform(sout))=none Then Return;
SBOUND(trn!title[t!index],"any",
"transform title", "Title");
Return;
End "set transform name";
Outstr("Bad specification"&crlf);
End "SET!TITLE";
COMMENT
.next page
.SS(Procedure SET!WINDOW)
.INDEX(Procedure SET!WINDOW)
.;
Internal Simple Procedure SET!WINDOW;
"----------------------------------------"
Begin "WIN"
" If all 4 args are specified and valid then use them"
If not Equ(sout,null) and not Equ(sip1,null) and
not Equ(sip2,null) and not Equ(sip3,null)
Then
Begin "use them"
Integer fr,lr,fc,lc;
fr_Intscan(sout,flag);
lr_Intscan(sip1,flag);
fc_Intscan(sip2,flag);
lc_Intscan(sip3,flag);
If (0 leq fr leq imsiz) and (fr leq lr leq imsiz)
and (0 leq fc leq imsiz) and (fc leq lc leq imsiz)
Then Begin "ok"
firstrow_fr;
firstcolumn_fc;
lastrow_lr;
lastcolumn_lc;
Return;
End "ok"
Else
Outstr("Bad window spec."&crlf);
End "use them";
IBOUND(0,firstrow,imsiz,"first row of display window","1st row");
IBOUND(firstrow,lastrow,imsiz,"last row of display window","last row");
IBOUND(0,firstcolumn,imsiz,"first column of display window",
"1st column");
IBOUND(firstcolumn,lastcolumn,imsiz,
"last column of display window","last column");
End "WIN";
COMMENT
.next page
.SS(Procedure SET!LCS)
.INDEX(Procedure SET!LCS)
.;
Internal Simple Procedure SET!LCS;
"----------------------------------------"
Begin "SET!LCS"
" test if get from command line"
If not Equ(sout, null)
Then xp_(0 max Intscan(sout,flag)) min 1023
Else
IBOUND(0,xp,1023,"X coordinate of upper left hand corner",
"X");
" test if get from command line"
If not Equ(sip1,null)
Then yp_(0 max Intscan(sip1,flag)) min 1023
Else
IBOUND(0,yp,1023,"Y coordinate of upper left hand corner",
"Y");
End "SET!LCS";
COMMENT
.next page
.SS(Procedure GET!WINDOW)
.INDEX(Procedure GET!WINDOW)
.;
Internal Simple Procedure GET!WINDOW;
"----------------------------------------"
Begin "GET!WINDOW"
Integer i;
" test if get from command line"
If Equ((sout_GUESSER(sout,lgl!wnames)),null) or
(1 > (i_Intscan(ss_sout[2 to inf],flag)) >
max!number!computing!windows)
Then
IBOUND(1,i,max!number!computing!windows,"Window number?",
"Window number?");
" GET the window"
Outstr("Restoring window: ("&
CVS(firstrow_c!wind[1,i])&":"&
CVS(lastrow_c!wind[2,i])&","&
CVS(firstcolumn_c!wind[3,i])&":"&
CVS(lastcolumn_c!wind[4,i])&")/"&
CVS(sampled_c!wind[5,i])&crlf);
" restore the image size and shift parameters"
imsiz_c!wind[6,i];
imsiz1_imsiz-1;
imshift_c!wind[7,i];
imarray!size_((4^imshift)%4)-1;
" print the window title"
Outstr("Title:"&crlf&cw!title[i]&crlf);
End "GET!WINDOW";
COMMENT
.next page
.SS(Procedure SAVE!WINDOW)
.INDEX(Procedure SAVE!WINDOW)
.;
Internal Simple Procedure SAVE!WINDOW;
"----------------------------------------"
Begin "SAVE!WINDOW"
Integer i;
" test if get from command line"
If Equ((sout_GUESSER(sout,lgl!wnames)),null) or
(1 > (i_Intscan(ss_sout[2 to inf],flag)) >
max!number!computing!windows)
Then
IBOUND(1,i,max!number!computing!windows,"Window number?",
"Window number?");
" Saving the window"
Outstr("Saving window: ("&
CVS(c!wind[1,i]_firstrow)&":"&
CVS(c!wind[2,i]_lastrow)&","&
CVS(c!wind[3,i]_firstcolumn)&":"&
CVS(c!wind[4,i]_lastcolumn)&")/"&
CVS(c!wind[5,i]_sampled)&crlf);
" save the window size and shift param"
c!wind[6,i]_imsiz;
c!wind[7,i]_imshift;
" Get the window title"
SBOUND(cw!title[i],"any","Title?","Title?");
" turn on in!use flag"
cw!in!use[i]_true;
End "SAVE!WINDOW";
COMMENT
.next page
.SS(Procedure PARAMETERS)
.INDEX(Procedure PARAMETERS)
.;
Internal Simple Procedure PARAMETERS;
"----------------------------------------"
Begin "PAR"
Integer i;
Itemvar xxx;
Label bad!gettab, good!gettab;
" setup the GETTAB call for .GTCOR - see page 420 of 1973
Decsystem assembly language handbook"
i_'777777000027;
Start!code;
MOVE 4,i ;
CALLI 4, '41 ; Comment GETTAB, 0;
JRST bad!gettab;
bad!gettab:
JRST good!gettab;
good!gettab:
MOVEM 4,i ; Comment save core size;
End;
Outstr("Mean density: " & CVS(density!value) & crlf &
"Standard deviation: " & CVT(std!dev) & crlf &
"Computing density to precision of: " &
CVS(trunc!max) & crlf &
"Display density extrema (min:max)= ("
& CVS(dmin) & ":" &
CVS(dmax) & ")" & crlf&
"Computing window: (" &
CVS(firstrow) & ":" & CVS(lastrow) & "," &
CVS(firstcolumn) & ":" & CVS(lastcolumn) &
")/" & CVS( sampled) & crlf&
"Terminal type: "& trm!name & crlf&
"Scaling: "&CVS(scaling)&crlf&
"Display (LCS) [Xp:Yp]=["&
CVS(xp)&":"&CVS(yp)&"]"&crlf&
"Auto title is:" & (If auto!title
Then "on" else "off") & crlf &
"Auto OMNI numbering is:" & (If autoOMNInumber
Then "on" else "off") & crlf &
(If setupOMNI Then "OMNI display is setup"
else null) & crlf &
"Free core left: " & CVS(i) & crlf
);
If not (omni!post = PHI)
Then
Begin "Search"
Foreach xxx Such That xxx In omni!post Do
Outstr("Post image="&CVIS(xxx,flag)&
crlf);
End "Search";
If not (omni!unpost = nil)
Then
Begin "Search"
Foreach xxx Such That xxx In omni!unpost Do
Outstr("Unposted image="&CVIS(xxx,flag)&
crlf);
End "Search";
i_0;
Foreach xxx Such That xxx In movie Do
Outstr("Movie frame["&CVS(i_i+1)&
"]="&CVIS(xxx,flag)&crlf);
End "PAR";
COMMENT
.next page
.SS(Procedure LIST!COMMANDS)
.INDEX(Procedure LIST!COMMANDS)
.;
Internal Simple Procedure LIST!COMMANDS;
Begin "LIST!COMMANDS"
Integer i;
If ((sout neq null) and (sout="C")) or (sout=null) Then
Begin "Do command"
Outstr(crlf);
Outstr("VALID COMMANDS:" & crlf & "---------------" &crlf);
For i_ 1 Step 1 Until max!number!special!commands Do
Begin "Find and print non-null command"
If length(lgl!spclcmds[i])= 0
Then Done
Else Outstr(lgl!spclcmds[i]);
If (i mod 6)=0
Then Outstr("," & crlf)
Else Outstr(", ");
End "Find and print non-null command";
Outstr(crlf&crlf);
End "Do command";
If ((sout neq null) and (sout="P")) or (sout=null) Then
Begin "Do picture"
Outstr(crlf&"VALID PICTURE OPERATORS:" & crlf &
"------------------------" &crlf);
For i_ 1 Step 1 Until max!number!pixops Do
Begin "Find and print non-null operator"
If length(lgl!pops[i])= 0
Then Done
Else Outstr(lgl!pops[i]);
If (i mod 7)=0
Then Outstr("," & crlf)
Else Outstr(", ");
End "Find and print non-null operator";
Outstr(crlf&crlf);
End "Do picture";
If ((sout neq null) and (sout="M")) or (sout=null) Then
Begin "Do mask"
Outstr(crlf&"VALID MASK OPERATORS:" & crlf
& "---------------------" &crlf);
For i_ 1 Step 1 Until max!number!maskops Do
Begin "Find and print non-null maskoperator"
If length(lgl!mops[i])= 0
Then Done
Else Outstr(lgl!mops[i]);
If (i mod 7)=0
Then Outstr("," & crlf)
Else Outstr(", ");
End "Find and print non-null maskoperator";
Outstr(crlf&crlf);
End "Do mask";
If ((sout neq null) and (sout="B")) or (sout=null) Then
Begin "Do boundary"
Outstr(crlf&"VALID BOUNDARY OPERATORS:" & crlf
& "-------------------------" &crlf);
For i_ 1 Step 1 Until max!number!boundaryops Do
Begin "Find and print non-null boundaryoperator"
If length(lgl!bops[i])= 0
Then Done
Else Outstr(lgl!bops[i]);
If (i mod 5)=0
Then Outstr("," & crlf)
Else Outstr(", ");
End "Find and print non-null boundaryoperator";
Outstr(crlf&crlf);
End "Do boundary";
End "LIST!COMMANDS";
COMMENT
.next page
.SS(Procedure ACTIVE!DATA)
.INDEX(Procedure ACTIVE!DATA)
.;
Internal Simple Procedure ACTIVE!DATA;
Begin "ACTIVE!DATA"
String touching, sss,ss, original;
Integer
org!cvn,
component,
x,
y,
parea,
pperim,
pdensity,
b!cvn,
i,
j,
p,
q,
r,
c;
Integer Array Itemvar
p!item,
b!item,
s!item;
" [1] save the print format"
Getformat(p,q);
" set it for no leading blanks"
Setformat(0,q);
" see if mention explicit datum"
sip1_GUESSER(sout,lgl!pnames)&
GUESSER(sout,lgl!mnames)&
GUESSER(sout,lgl!bnames)&
GUESSER(sout,lgl!wnames);
" [2] Do pictures"
If (sout="P") or (sout=null)
Then
Begin "do Pix"
Outstr(crlf&"VALID PICTURES:" & crlf &
"---------------" & crlf);
" test if picture specified"
For i_ 1 Step 1 Until max!number!pix Do
Begin "Find and print non-null pix"
If pix!in!use[i] and (sip1=null or
Equ(lgl!pnames[i],sip1))
Then Begin "print pix"
Outstr((s_"P"&CVS(i))&crlf);
image1_GET!IMAGE(s);
ss_CVS(Sqrt(4*ARRINFO(Datum(image1),0)));
Outstr(ss & "X" & ss & crlf);
Outstr("Title="& pix!title[i]&crlf);
Foreach b!item, s!item Such That
image1 XOR b!item EQV s!item Do
Begin "print segment"
component_Datum(s!item)[0];
r_Datum(s!item)[1];
c_Datum(s!item)[2];
parea_Datum(s!item)[3];
pperim_Datum(s!item)[4];
pdensity_
Datum(s!item)[5];
" get the integer eqv of bnd item"
sss_CVXSTR(Datum(s!item)[6]);
touching_If Datum(s!item)[7]
Then
"touching frame, "
Else null;
original_"Derived from " &
CVXSTR(Datum(s!item)[8]) &
", ";
If not flag
Then
original_null;
Outstr(" Component "&
CVS(component)&"=[("&
CVS(r)&","&CVS(c)&")"&
", Area="&CVS(parea)&
", Perimeter pts="&
CVS(pperim)&
", Density="&
CVS(pdensity)&crlf&
" " & touching&
original &
"boundary name="&
sss & "]" &crlf);
End "print segment";
End "print pix";
End "Find and print non-null pix";
Outstr(crlf);
End "do Pix";
" [3] Do masks"
If (sout="M") or (sout=null)
Then
Begin "do Masks"
Outstr(crlf&"VALID MASKS:" & crlf &
"------------" &crlf);
" test if mask specified"
For i_ 1 Step 1 Until max!number!masknames Do
Begin "Find and print non-null mask"
If mask!in!use[i] and (Equ(sip1,lgl!mnames[i]) or
sip1=null)
Then
Begin "Print masks"
Outstr((s_"M"&CVS(i))&crlf);
ss_CVS(Sqrt(36*(ARRINFO(Datum(image1_
CVSI(s,flag)),0)-1)));
Outstr(ss & "X" & ss & crlf);
Outstr("Title="& mask!title[i]&crlf);
End "Print masks";
End "Find and print non-null mask";
Outstr(crlf);
End "do Masks";
" [4] Do boundaries"
If (sout="B") or (sout=null)
Then
Begin "do Boundary"
Outstr(crlf&"VALID BOUNDARIES:" & crlf &
"----------------" &crlf);
" test if boundary specified"
For i_ 1 Step 1 Until max!number!boundaries Do
Begin "Find and print non-null boundary"
If bnd!in!use[i] and (sip1=null or
Equ(lgl!bnames[i],sip1))
Then
Begin "print boundary info"
Integer fr,fc,lr,lc;
" get the boundary window"
s_lgl!bnames[i];
b!item_GET!BOUNDARY(s);
If Bind p!item XOR b!item EQV Bind s!item
Then
ss_", component of " & CVIS(p!item,flag)
Else
ss_null;
FIND!REC(Datum(b!item),PROPS(b!item),
fc,lc,fr,lr);
Outstr(s & ss &", SIZE="&CVS(PROPS(CVSI(s,flag)))&
" pixels at ("&CVS(fr)&":"&CVS(lr)&","&
CVS(fc)&":"&CVS(lc)&")"&crlf
&"Title="& bnd!title[i]&crlf);
End "print boundary info";
End "Find and print non-null boundary";
Outstr(crlf);
End "do Boundary";
" [5] Do transforms"
If (sout="T") or (sout=null)
Then
Begin "DO TRANSFORM"
Outstr(crlf&"VALID TRANSFORMS:" & crlf &
"----------------" &crlf);
" test if transform specified"
For i_ 1 Step 1 Until max!number!transforms Do
Begin "Find and print non-null transform"
If trn!in!use[i] and (sip1=null or
Equ(lgl!tnames[i],sip1))
Then
Begin "print transform info"
trn1_CVSI(s_lgl!tnames[i],flag);
If flag Then trn1_none;
Outstr(CVIS(trn1,flag)&
", number transform values="&
cvs(PROPS(trn1))&crlf&
"Title="& trn!title[i]&crlf);
Foreach iname Such That
a!transform XOR trn1 EQV iname Do
Begin "print type"
s_CVIS(iname,flag);
Outstr("Transform:"&s&crlf);
End "print type";
End "print transform info";
End "Find and print non-null transform";
Outstr(crlf);
End "DO TRANSFORM";
" [6] Do windows"
If (sout="W") or (sout=null)
Then
Begin "do Window"
Outstr(crlf&"VALID WINDOWS:" & crlf &
"--------------" &crlf);
" test if computing window specified"
For i_ 1 Step 1 Until max!number!computing!windows Do
Begin "Find and print non-null computing!window"
If cw!in!use[i] and (sip1=null or
Equ(lgl!wnames[i],sip1))
Then
Begin "print c w"
Outstr("Computing window["&CVS(i)&"]"&crlf&
"Title="&cw!title[i]&crlf);
" compute the image size"
s_CVS(j_c!wind[6,i]+1);
Outstr("("&
CVS(c!wind[1,i])&":"&
CVS(c!wind[2,i])&","&
CVS(c!wind[3,i])&":"&
CVS(c!wind[4,i])&")/"&
CVS(c!wind[5,i])&
" --- Size: "& s & "X" & s &crlf);
End "print c w";
End "Find and print non-null computing!window";
End "do Window";
Outstr(crlf);
" [6] restore format"
Setformat(p,q);
End "ACTIVE!DATA";
End "SPAK.SAI";