Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50416/pintrp.sai
There are 2 other files named pintrp.sai in the archive. Click here to see a list.
ENTRY;
COMMENT
.SOSPAGE_1
.SEC(PINTRP - PROC10 Picture Operation Interpreter)
.index(PINTRP - PROC10 Picture Operation Interpreter)
.;
BEGIN "PINTRP.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
Rev Nov 14, 1976 - Lemkin, fixed PIXDMP
Rev Oct 12, 1976 - Lemkin, removed SMSG/DEBUG
Rev oct 2, 1976 - lemkin modify GRAD4 and PDIFF
Revised Aug 25, 1976 - Lemkin, fixed thr!density use
Revised Aug 24, 1976 - Lemkin, fixed WHITENOISE args
Revised Aug 23, 1976 - Lemkin, fixed SMSG comments
Revised July 7, 1976 - Lemkin changed READ
Revised June 11, 1976 - Lemkin changed - to MINUS, DIRLST
Revised May 27, 1976 - Lemkin changed - to MINUS, DIRLST
Revised May 26, 1976 - Lemkin added R/W NUMBER opt
Revised May 25, 1976 - Lemkin added mask size checker
Revised May 24, 1976 - Lemkin fixed PTEX2 args
Revised May 21, 1976 - Lemkin fixed SEGMENT,
Revised May 22, 1976 - Lemkin fixed SEGMENT, AND READ/WRITE SIZE ERR
Revised May 19, 1976 - Lemkin fixed SEGMENT,
Revised May 17, 1976 - Lemkin fixed SEGMENT, added TEXTUREi
Revised May 13, 1976 - Lemkin fixed dmin/dmax setups
Revised April 19, 1976 - fixed for 50,752
Revised April 13, 1976 - fixed SHOW (x0,y0)==>(xp,yp)
MARCH 20, 1976
;
COMMENT
.ss(PINTRP REQUIRE files)
.INDEX(PINTRP REQUIRE files)
.;
Comment
" ================================"
" = R E Q U I R E ="
" ================================"
" The following files are required for use by PROC10.
They all reside in the Image Processing Unit's common user area
";
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 "GETABL.REQ" source!file;
Require "IO.REQ" source!file;
Require "SYS:DISPRM.SAI" source!file;
Require "PPAK.REQ" source!file;
Require "LINPAK.REQ" source!file;
Require "SPAK.REQ" source!file;
Require "CVT.REQ" source!file;
Require "BOUND.REQ" source!file;
Require "DARRAY.REQ" source!file;
Require "HLFTON.REQ" source!file;
Require "CROSSH.REQ" source!file;
Require "PIXDMP.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
.SS(Procedure PIX!ASSIGNMENT)
.INDEX(Procedure PIX!ASSIGNMENT)
.;
Internal Procedure PIX!ASSIGNMENT;
Begin "PIX!ASSIGNMENT"
String
smask,
s1,
s2,
s3,
s,
ss,
sss;
Boolean direction;
Integer delta,
i,
j,
k,
ival,
jval,
index,
pix!index1,
pix!index2,
pix!index3;
Label pix!a!dispatch;
Real val;
" clear the itemvar names"
mskimage_image1_image2_image3_none;
" Find the operator index"
For index_1 Step 1 Until max!number!pixops Do
If equ(cmd,lgl!pops[index]) Then Done;
If db=2 Then Goto pix!a!dispatch;
" see if have a mask anywhere"
smask_GUESSER(sip1,lgl!mnames)&
GUESSER(sip2,lgl!mnames)&
GUESSER(sip3,lgl!mnames)&
GUESSER(sip4,lgl!mnames)&
GUESSER(sip5,lgl!mnames)&
GUESSER(sip6,lgl!mnames);
" See if the mask is being used, then get the item"
If not Equ(smask, null)
Then
Begin "set mask"
usemask_true;
mskimage_GET!MASK(smask);
" check to see if mask same size as current image"
i_Sqrt(36*(-1+(ARRINFO(Datum(mskimage),0))));
If i neq imsiz+1
Then
Begin "bad size"
Outstr("Wrong mask size " & CVS(i) &
" from pix size "&CVS(imsiz+1)&crlf);
Return;
End "bad size";
End "set mask"
Else usemask_false;
" See if have output"
If Equ(GUESSER(cmd,lgl!noutput!ops),null)
Then
Begin "get output image"
If (image3_GET!IMAGE(sout))=none Then Return;
" copy the image3 index "
pix!index3_p!index;
" Get the image title if null and not READ"
If not (image3 = none)
Then
If auto!title
Then pix!title[pix!index3]_strcopy
Else
If pix!title[pix!index3]=null and
not Equ(cmd,"READ")
Then
SBOUND(pix!title[pix!index3],"any",
"Picture "&sout&" title", sout&
" title");
End "get output image"
Else
If not Equ(cmd,"WRITE")
Then
Begin "shift args right"
" Shift the input args right since sout is
really sip1 etc."
sip6_sip5;
sip5_sip4;
sip4_sip3;
sip3_sip2;
sip2_sip1;
sip1_sout;
sout_null;
image1_none;
End "shift args right";
" Note: test for operators which take no picture args and
then do not get an input picture"
If Equ(GUESSER(cmd,lgl!ninput!ops), null)
Then
Begin "get input image"
image1_GET!IMAGE(sip1);
pix!index1_p!index;
" test for now input image"
If image1 = none Then
Begin "bad pix"
If image3 neq none
Then
DEL!PIX(sout);
return;
End "bad pix";
End "get input image";
" If we have a unary operation (sip2) will be none";
If not Equ((s_GUESSER(sip2,lgl!pnames)), null)
Then Begin "get image 2"
image2_GET!IMAGE(s);
pix!index2_p!index;
End "get image 2";
" DISPATCH and TEST FOR UNARY IN EACH CASE"
pix!a!dispatch: CASE (index-1) of
Begin "DO OPERATIONS"
Begin "1 +"
COMMENT
.sss(PLUS)
.INDEX(PLUS)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."
&crlf);
DEL!PIX(sout);
Return;
End "Not enough";
PADD(Datum(image1),Datum(image2),Datum(image3));
End "1 +";
Begin "2 MINUS"
COMMENT
.sss(MINUS)
.INDEX(MINUS)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."&
crlf);
DEL!PIX(sout);
Return;
End "Not enough";
PSUB(Datum(image1),Datum(image2),Datum(image3));
End "2 MINUS";
Begin "3 *"
COMMENT
.sss(TIMES)
.INDEX(TIMES)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."
&crlf);
DEL!PIX(sout);
Return;
End "Not enough";
PMUL(Datum(image1),Datum(image2),Datum(image3));
End "3 *";
Begin "4 /"
COMMENT
.sss(DIVIDED BY)
.INDEX(DIVIDED BY)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."
&crlf);
DEL!PIX(sout);
Return;
End "Not enough";
PDIV(Datum(image1),Datum(image2),Datum(image3));
End "4 /";
Begin "5 MAX"
COMMENT
.sss(MAX)
.INDEX(MAX)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."
&crlf);
DEL!PIX(sout);
Return;
End "Not enough";
PMAX(Datum(image1),Datum(image2),Datum(image3));
End "5 MAX";
Begin "6 MIN"
COMMENT
.sss(MIN)
.INDEX(MIN)
.;
If (image2 = none)
Then Begin "Not enough"
outstr("Bad 2nd input image name."
&crlf);
Return;
End "Not enough";
PMIN(Datum(image1),Datum(image2),Datum(image3));
End "6 MIN";
Begin "7 SCALE"
COMMENT
.sss(SCALE)
.INDEX(SCALE)
.;
Own Real val;
If not( (sip2=null) or (sip2="M"))
Then val_abs(realscan(sip2,flag))
Else
BOUND("-inf",val,"inf","Scaler?",
"Scaler?");
PSCALE(Datum(image1),Datum(image3),val);
End "7 SCALE";
Begin "8 ROTATE"
COMMENT
.sss(ROTATE)
.INDEX(ROTATE)
.;
Own Integer row!val,col!val;
Own Real val;
If not( (sip2=null) or (sip2="M"))
Then row!val_Intscan(sip2,flag)
Else
IBOUND(firstrow,row!val,lastrow,
"row center", "row center");
If not( (sip3=null) or (sip3="M"))
Then col!val_Intscan(sip3,flag)
Else
IBOUND(firstcolumn,col!val,lastcolumn,
"column center", "column center");
If not( (sip4=null) or (sip4="M"))
Then val_Realscan(sip4,flag)
Else
BOUND(-360,val,360,"Degrees?","Degrees?");
PROTATE(Datum(image1),Datum(image3),
row!val,col!val,val)
End "8 ROTATE";
Begin "9 COPY"
COMMENT
.sss(COPY)
.INDEX(COPY)
.;
PCOPY(Datum(image1),Datum(image3));
End "9 COPY";
Begin "10 AVG4"
COMMENT
.sss(AVG4)
.INDEX(AVG4)
.;
PAVG4(Datum(image1),Datum(image3));
End "10 AVG4";
Begin "11 AVG8"
COMMENT
.sss(AVG8)
.INDEX(AVG8)
.;
PAVG8(Datum(image1),Datum(image3));
End "11 AVG8";
Begin "12 GRAD4"
COMMENT
.sss(GRAD4)
.INDEX(GRAD4)
.;
If sip2="D"
Then direction_true
Else direction_false;
PGRAD4(Datum(image1),Datum(image3),direction);
End "12 GRAD4";
Begin "13 GRAD8"
COMMENT
.sss(GRAD8)
.INDEX(GRAD8)
.;
If sip2="D"
Then direction_true
Else direction_false;
PGRAD8(Datum(image1),Datum(image3),direction);
End "13 GRAD8";
Begin "14 FILLPINHOLES"
COMMENT
.sss(FILLPINHOLES)
.INDEX(FILLPINHOLES)
.;
Own Integer ival;
If (sip2 neq null) and (sip2 neq "M")
Then
ival_(Intscan(sip2,flag) max 0)
min trunc!max
Else
IBOUND(0,ival,trunc!max,"Delta density",
"Delta density");
outstr("Filled: "&cvs(PFILLPIN(Datum(image1),
Datum(image3), ival))&crlf);
End "14 FILLPINHOLES";
Begin "15 SLICE"
COMMENT
.sss(SLICE)
.INDEX(SLICE)
.;
Own Integer dmin, dmax;
" Do initial init for dmax"
If dmax=0
Then dmax_trunc!max;
If sip2="U"
Then
Begin "use global thrshold"
dmin_thr!density;
dmax_trunc!max;
End "use global thrshold"
Else
Begin "use local density"
If (sip2 neq null) and (sip2 neq "M")
Then
dmin_(Intscan(sip2,flag) max 0) min
trunc!max;
" get the upper limit and check if sip3 is Mi"
If (sip3 neq null) and (sip3 neq "M")
Then
dmax_(Intscan(sip3,flag) max dmin) min
trunc!max;
End "use local density";
PSLICE(Datum(image1),Datum(image3),dmin,dmax);
End "15 SLICE";
Begin "16 NOT"
COMMENT
.sss(COMPLEMENT)
.INDEX(COMPLEMENT)
.;
PCOMPLEMENT(Datum(image1),Datum(image3));
End "16 NOT";
Begin "17 EXPAND"
COMMENT
.sss(EXPAND)
.INDEX(EXPAND)
.;
Own Integer ival;
If (sip1 neq null) and (sip1 neq "M")
Then
ival_(Intscan(sip1,flag) max 0)
min imsiz
Else
IBOUND(-imsiz,ival,imsiz,"#points","#points");
PEXPAND(Datum(image3),ival);
End "17 EXPAND";
Begin "18 SHRINK"
COMMENT
.sss(SHRINK)
.INDEX(SHRINK)
.;
If (sip1 neq null) and (sip1 neq "M")
Then
ival_(Intscan(sip1,flag) max 0 )
min imsiz
Else
IBOUND(-imsiz,ival,imsiz,"#points","#points");
PSHRINK(Datum(image3),ival);
End "18 SHRINK";
Begin "19 SHIFT"
COMMENT
.sss(SHIFT)
.INDEX(SHIFT)
.;
Own Integer ival,jval;
If (sip2 neq null) and (sip2 neq "M")
Then
ival_(Intscan(sip2,flag) max -imsiz)
min imsiz
Else
IBOUND(-imsiz,ival,imsiz,"Delta X","Del X");
If (sip3 neq null) and (sip3 neq "M")
Then
jval_(Intscan(sip3,flag) max -imsiz)
min imsiz
Else
IBOUND(-imsiz,jval,imsiz,"Delta Y","Del Y");
PSHIFT(Datum(image1),Datum(image3),ival,jval);
End "19 SHIFT";
Begin "20 SEGMENT"
COMMENT
.sss(SEGMENT)
.INDEX(SEGMENT)
.;
String ss;
Boolean save!boundaries;
Integer b,
size!lower,
size!upper;
Boolean fill!holes;
" [20.1] See if save the boundaries then pass the
output picture name to be used in
making the boundary PNAMES"
If Equ(sip2[1 for 3],"NOB") or
Equ(sip3[1 for 3],"NOB") or
Equ(sip4[1 for 3],"NOB")
Then save!boundaries_false
Else save!boundaries_true;
" [20.2] see if do not fill holes in segments"
If Equ(sip2[1 for 3],"NOF") or
Equ(sip3[1 for 3],"NOF") or
Equ(sip4[1 for 3],"NOF") or
Equ(sip5[1 for 3],"NOF")
Then fill!holes_false
Else fill!holes_true;
" [20.3] get the size limets, default to 2:2047"
size!lower_2;
size!upper_2047;
If ((ival_Intscan(s_sip2,flag)) > 1 and
(jval_Intscan(s_sip3,flag)) > ival)
Then
Begin "set size"
size!lower_ival;
size!upper_jval;
End "set size";
" [20.4] go segment the image"
PSEGMENT(Datum(image1), Datum(image3), ival, jval,
image1,image3,save!boundaries,fill!holes,
size!lower, size!upper, strcopy);
" [20.5] print the number of segments and holes"
outstr("Found "&cvs(ival)&" segments, "
&cvs(jval)&" holes."&crlf);
End "20 SEGMENT";
Begin "21 WHITENOISE"
COMMENT
.sss(WHITENOISE)
.INDEX(WHITENOISE)
.;
If not Equ(sip1,null)
Then
std!dev_0 Max (Intscan(sip1,flag)
Min ((trunc!max+1)/2));
If not Equ(sip2,null)
Then
density!value_0 Max
(Intscan(sip2,flag) Min trunc!max);
PGAUSS(Datum(image3),std!dev,density!value);
End "21 WHITENOISE";
Begin "22 ZERO"
COMMENT
.sss(ZERO)
.INDEX(ZERO)
.;
PZERO(Datum(image3));
End "22 ZERO";
Begin "23 DELSQPIX"
COMMENT
.sss(DELSQPIX)
.INDEX(DELSQPIX)
.;
If image2=none
Then
Begin "Bad 2nd param"
Outstr("Bad 2nd parameter");
Return;
End "Bad 2nd param";
delta_PDELSQ(Datum(image1),Datum(image2));
Outstr("Sum of gray scale differences Squared="&
cvs(delta)&crlf);
End "23 DELSQPIX";
Begin "24 FINDWINDOW"
COMMENT
.sss(FINDWINDOW)
.INDEX(FINDWINDOW)
.;
Integer f!row,f!column,l!row,l!column;
ival_0;
If (sip2 neq "U") or (sip2 neq "M")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
If sip2="U"
Then ival_thr!density;
PFINDWINDOW(Datum(image1), f!row, l!row,
f!column, l!column, ival);
outstr("Max window (" & cvs(f!row) & ":"
& cvs(l!row) & "," &cvs(f!column) &
":" & cvs(l!column) &") size " &
cvs(l!row-f!row+1) & " x "
& cvs(l!column-f!column+1) &
" pixels using density threshold " &
cvs(ival) & crlf);
" see if set up RECTANGLE mask parameters"
If LBOUND(trn!rectangle,
"Transfer window parameters to RECTANGLE"
&" mask generator,"&" ok?",
"Trans. to Rectangle?")
Then
Begin "yes, transfer parameters"
row!side_l!row-f!row;
column!side_l!column-f!column;
rect!row!center_(l!row-f!row)/2;
rect!column!center_(l!column-
f!column)/2;
End "yes, transfer parameters";
If LBOUND(trn!window,
"Transfer window parameters to "
&"computation window, ok?",
"Trans. to computation window?")
Then
Begin "yes, transfer working window"
firstrow_f!row;
lastrow_l!row;
firstcolumn_f!column;
lastcolumn_l!column;
End "yes, transfer working window";
End "24 FINDWINDOW";
Begin "25 HISTOGRAMPIX"
COMMENT
.sss(HISTOGRAMPIX)
.INDEX(HISTOGRAMPIX)
.;
Integer p,q,imax,imin,count,maximum;
Own Boolean see!histogram;
getformat(p,q);
Begin "Histogrampix"
Safe Integer Array average[0:511];
Integer avgbin,i,k,m,avgmax,rc!switch;
" [25.1] set the window to that of the current pix
get the averaging number of gray values/bin"
i_Sqrt(4*ARRINFO(Datum(image1),0));
If imsiz neq i-1
Then PINI(-1,i);
avgbin_(1 max Intscan(sip2,flag)) min trunc!max;
rc!switch_0;
" [25.2] See if do just Row or Column"
rc!switch_0;
If sip2="R" or sip3="R" Then rc!switch_"R";
If sip2="C" or sip3="C" Then rc!switch_"C";
" [25.3] get the histogram"
PHIST(Datum(image1),hist,
maxima,minima,imax,imin,
rc!switch);
" If sout eq T<number>
then put it into Ti datum"
If (sout="T") and ("0" leq sout[2 for 1] leq "9")
Then
Begin "make Ti"
iname_NEW(hist);
New!Pname(iname,sout);
PROPS(iname)_512;
Make a!transform XOR iname EQV v!HISTtransform;
End "make Ti";
" [25.4] Determine the display type"
If equ(trm!name,"4012") or
Equ(trm!name,"GT40")
Then
Begin "4012 or GT40"
Itemvar xxx;
xxx_CVSI("HIST"&sip1,flag);
If flag
Then
Begin "make it"
xxx_NEW;
New!Pname(xxx,"HIST"&sip1);
End "make it";
" [25.4.1] Display on 4012 or GT40"
If not autoOMNInumber
Then
Begin "clearing"
Itemvar xxx;
Foreach xxx Such That
xxx In omni!post Do
DEL!OMNI!NUMBER(
CVIS(xxx,flag));
DREL;
DGET;
End "clearing";
" Setup new OMNI numbers"
npict_GET!OMNI!NUMBER("HIST"&sip1);
xxx_CVSI("HIST"&sip1,flag);
Put xxx In omni!post;
" [25.4.2] display"
DOPEN(npict);
DARRAY(hist,0,255,0,255,null);
DPOST(npict);
DDONE1;
" [25.4.3] get cross hairs if needed"
If r!cross and Equ(trm!name,"4012")
Then
Begin "do c-h"
PFRAME("SAV");
firstrow_firstcolumn_0;
lastrow_lastcolumn_779;
CROSSHAIRS;
PFRAME("RES");
End "do c-h";
End "4012 or GT40"
Else
Begin "TTY"
" [25.4.2] Display on ASR33 type terminal"
Outstr("Histogram of "&sip1&crlf&
"Title: "&pix!title[pix!index1]&crlf);
count_0;
maximum_0;
For i_ 0 Step avgbin Until trunc!max Do
Begin "Histogrampix scan"
avgmax_0;
For k_ i step 1 until 255 min (i+avgbin-1) Do
Begin "AVG-hist"
If hist[k] > 0
Then count_count+1;
avgmax_avgmax+hist[k];
End "AVG-hist";
maximum_maximum max avgmax;
average[i]_avgmax;
End "Histogrampix scan";
LBOUND(see!histogram,
"Histogram has " & cvs(count) &
" nonzero entries." & crlf &
"Do you want to see them as a graph?",
cvs(count)&" histogram entries. Ok?");
If see!histogram
Then
For i_ 0 Step avgbin Until trunc!max Do
If average[i] > 0
Then
Begin "output"
setformat(3,0);
outstr(cvs(i) & ":");
setformat(5,0);
outstr(cvs(average[i]) & ":");
For j_ 0 Step 1 Until
(61.*average[i])/maximum Do
outstr("X");
outstr(crlf);
End "output";
End "TTY";
End "Histogrampix";
setformat(p,q);
End "25 HISTOGRAMPIX";
Begin "26 SHOW"
COMMENT
.sss(SHOW)
.INDEX(SHOW)
.;
" Set the frame to image1 size after save frame"
PFRAME("SAV");
i_Sqrt(4*ARRINFO(Datum(image1),0));
If imsiz neq (i-1)
Then PINI(-1,i);
" If using the mask, then make a new pix display it and
then trash it"
If usemask
Then
Begin "get a copy under mask"
image3_PMAKIMAGE("TRASH");
PCOPY(Datum(image1),Datum(image3));
image1_image3;
outstr("Display under mask "&smask&crlf);
End "get a copy under mask";
If equ(trm!name,"4012") or Equ(trm!name,"GT40")
Then
Begin "4012 or GT40"
" [26.1] Display on 4012 or GT40"
If not autoOMNInumber
Then
Begin "clearing"
Itemvar xxx;
Foreach xxx Such That
xxx In omni!post Do
DEL!OMNI!NUMBER(CVIS(
xxx,flag));
DREL;
DGET;
End "clearing";
" Setup new OMNI numbers"
npict_GET!OMNI!NUMBER(sip1);
Put image1 In omni!post;
End "4012 or GT40";
" display the image"
HLFTON(Datum(image1),firstrow,lastrow,firstcolumn,
lastcolumn, sampled, pix!title[p!index],
xp, yp, dmin, dmax, scaling, npict, r!cross,
c!cross, trm!name);
" If used mask, then delete the trash image"
If usemask Then PDELIMAGE("TRASH");
" Restore the computing frame"
PFRAME("RES");
End "26 SHOW";
Begin "27 READ"
COMMENT
.sss(READ)
.INDEX(READ)
.;
PFRAME("SAV");
" Get the input file name if specified in sip1"
If not Equ(sip1,null)
Then
Begin "From args"
file!name_sip1&proj!programmer;
" Lookup the file"
s_dev!name;
If s=":" or s=null
Then s_"DSK"
Else s_s[1 to inf-1];
Open(i_Getchan,s,0,0,0,1,j,flag);
Lookup(i,file!name,flag);
Release(i);
file!name_dev!name&file!name;
End "From args"
Else
flag_true;
If flag
Then
Begin "Not found"
Outstr("File not found."&crlf);
Return;
End "Not found";
If sip2 neq "N"
Then
Begin "check size"
" Get the header and check to see if it is non
256x256 size"
header[0]_1;
GETDDTG(file!name,header);
CLOSEINDATA;
" See if the type is neq current image size"
If ((header[5]=15) and (header[80] neq imsiz))
or ((header[5]=9) and (imsiz neq 255))
Then
Begin "change image size"
Outstr("Computing size ="&cvs(imsiz+1)&
" inconsistant with file size ="&
cvs(header[80]+1)&"."&crlf&
"To read the file in, the current picture "&
"must be deleted"&crlf&
"otherwise the READ is not performed."&crlf);
If not DEL!PIX(sout)
Then
Begin "ok, make new pix"
ival_(16 Max header[80]) Min 256;
PINI(trunc!max,ival);
image3_GET!IMAGE(sout);
pix!index3_p!index;
End "ok, make new pix"
Else
Begin "forget it"
PFRAME("RES");
Return;
End "forget it";
End "change image size";
End "check size";
outstr("Reading "&file!name&crlf);
" Setup NUMBER switch if exists"
header[0]_sip2;
If flag_GETPIX(Datum(image3), file!name,
pix!title[pix!index3], header)
Then
outstr("Bad Picture file header"&crlf);
" print the picture title"
outstr("Title:"&crlf&pix!title[pix!index3]&crlf);
PFRAME("RES");
If not flag Then Return
Else DEL!PIX(sout);
End "27 READ";
Begin "28 WRITE"
COMMENT
.sss(WRITE)
.INDEX(WRITE)
.;
If not Equ(sout,null)
Then outfile_dev!name&sout&proj!programmer
Else
While FBOUND(outfile,"any","Output file",
"file") Do
outstr("file " & outfile &
" already exists" & crlf);
If equ(pix!title[pix!index1],null)
Then SBOUND(pix!title[pix!index1],"any",
"Picture title","Title");
outstr("Writing picture " & outfile & crlf);
" Force it to generate a picture header"
header[0]_0;
PUTPIX(Datum(image1),outfile,pix!title[pix!index1],
header);
outstr(crlf);
End "28 WRITE";
Begin "29 DELETE"
COMMENT
.sss(DELETE)
.INDEX(DELETE)
.;
DEL!PIX(sout);
End "29 DELETE";
Begin "30 AREA"
COMMENT
.sss(AREA)
.INDEX(AREA)
.;
" get optional threshold"
ival_0;
If (sip2 neq "M") or (sip2 neq "U")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
If sip2="U"
Then ival_thr!density;
Outstr("Computing AREA > threshold "&
cvs(ival)&", Frame area="&
CVS((lastrow-firstrow)*
(lastcolumn-firstcolumn))&crlf);
Outstr("Image "&sip1&" AREA = "&cvs(
PAREA(Datum(image1),ival))&
" pixels"&crlf);
End "30 AREA";
Begin "31 DENSITY"
COMMENT
.sss(DENSITY)
.INDEX(DENSITY)
.;
" get optional threshold"
ival_0;
If (sip2 neq "M") or (sip2 neq "U")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
If sip2="U"
Then ival_thr!density;
Outstr("computing DENSITY > threshold "&
cvs(ival)&", Frame area="&
CVS((lastrow-firstrow)*
(lastcolumn-firstcolumn))&crlf);
Outstr("Image "&sip1&" DENSITY = "&cvs(
PDENSITY(Datum(image1),ival))&crlf);
End "31 DENSITY";
Begin "32 PERIMETER"
COMMENT
.sss(PERIMETER)
.INDEX(PERIMETER)
.;
" get optional threshold"
ival_0;
If (sip2 neq "M") or (sip2 neq "U")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
If sip2="U"
Then ival_thr!density;
Outstr("computing PERIMETER > threshold "&
cvs(ival)&", Frame area="&
CVS((lastrow-firstrow)*
(lastcolumn-firstcolumn))&crlf);
Outstr("Image "&sip1&" PERIMETER = "&cvs(
PPERIMETER(Datum(image1),ival))&crlf);
End "32 PERIMETER";
Begin "33 MOMENTS"
COMMENT
.sss(MOMENTS)
.INDEX(MOMENTS)
.;
Integer r,c,p,q;
Real Array moments[0:3,0:3];
Getformat(p,q);
PMOMENTS(Datum(image1),moments);
Outstr("Image "&sip1&crlf);
Setformat(6,0);
Outstr(" M0r M1r M2r M3r"&crlf);
For r_0 step 1 until 3 Do
Begin "row"
Setformat(0,0);
Outstr("Mc"&cvs(r));
Setformat(6,0);
For c_0 step 1 until 3 Do
Outstr(Cvs(moments[r,c]&" "));
outstr(crlf);
End "row";
Setformat(p,q);
End "33 MOMENTS";
Begin "34 DIFFERENCE"
COMMENT
.sss(DIFFERENCE)
.INDEX(DIFFERENCE)
.;
Integer threshold;
threshold_Intscan(sip3,flag);
PDIFF(Datum(image1),Datum(image2),Datum(image3),
threshold);
End "34 DIFFERENCE";
Begin "35 LAPLACE8"
COMMENT
.sss(LAPLACE8)
.INDEX(LAPLACE8)
.;
PLAPC8(Datum(image1),Datum(image3));
End "35 LAPLACE8";
Begin "36 INSERT"
COMMENT
.sss(INSERT)
.INDEX(INSERT)
.;
If PINSERT(Datum(image1),Datum(image3))
Then
Begin "Bad insert"
Outstr("Bad insert"&crlf);
DEL!PIX(sout);
Return;
End "Bad insert";
End "36 INSERT";
Begin "37 EXTRACT"
COMMENT
.sss(EXTRACT)
.INDEX(EXTRACT)
.;
If (image3_PEXTRACT(Datum(image1),sout)) = none
Then
Begin "Bad EXTRACT"
Outstr("EXTRACT failed"&crlf);
DEL!PIX(sout);
Return;
End "Bad EXTRACT";
End "37 EXTRACT";
Begin "38 EXTREMA"
COMMENT
.sss(EXTREMA)
.INDEX(EXTREMA)
.;
Integer
i,
j,
rc!switch,
mean,
use!mean,
imax,
imin;
Own Boolean
see!extrema,
use!extrema;
" Get the use density index"
ival_0;
" test if USEMEAN"
If sip2="U"
Then use!mean_true
Else use!mean_false;
If "1" geq sip2 leq "9"
Then ival_Intscan(ss_lop(sip2),flag);
" Get the RC switch"
If sip2="R" or sip3="R"
Then rc!switch_"R";
If sip2="C" or sip3="C"
Then rc!switch_"C";
" Get the extrema"
PHIST(Datum(image1),hist,
maxima,minima,imax,imin,
rc!switch);
" See if print the extrema"
If ival = 0
Then
LBOUND(see!extrema,"Histogram has "&
cvs(imin)&" minima: "&cvs(imax)&
" maxima."&crlf&
"Do you want them listed?", "Extrema "&
cvs(imin)&":"&cvs(imax)&". List?")
Else see!extrema_true;
If see!extrema
Then
Begin "list extrema"
For i_1 step 1 until imax Do
outstr("MAX "&Cvs(j_maxima[i])&
":"&cvs(hist[j])&crlf);
Outstr(crlf);
For i_1 step 1 until imin Do
outstr("MIN "&Cvs(j_minima[i])&
":"&cvs(hist[j])&crlf);
End "list extrema";
" See if take the last max and set dmin with it"
If ival = 0
Then
LBOUND(use!extrema,
"Set threshold at last min?",
null)
Else
Begin "auto"
use!extrema_true;
imin_ival;
End "auto";
If use!extrema
Then
Begin "use extrema"
thr!density_minima[imin];
End "use extrema";
" compute the mean density"
j_0;
For i_0 step 1 until trunc!max Do
j_j+hist[i];
mean_j/trunc!max;
If use!mean
Then
thr!density_mean;
End "38 EXTREMA";
Begin "39 LINCOMB"
COMMENT
.sss(LINCOMB)
.INDEX(LINCOMB)
.;
Own Real Aj,Bk;
" Get Aj, Bk"
If (sip3 neq null) and (sip3 neq "M")
Then Aj_Realscan(sip3,flag)
Else
BOUND("-inf",Aj,"inf","Aj?","Aj");
If (sip4 neq null) and (sip4 neq "M")
Then Bk_Realscan(sip4,flag)
Else
BOUND("-inf",Bk,"inf","Bk?","Bk");
PLINCOMB(Datum(image1),Datum(image2),Datum(image3),
Aj,Bk);
End "39 LINCOMB";
Begin "40 LISTSEGMENTS"
COMMENT
.sss(LISTSEGMENTS)
.index(LISTSEGMENTS)
.;
sout_sip2;
ACTIVE!DATA;
End "40 LISTSEGMENTS";
Begin "41 ZOOM"
COMMENT
.sss(ZOOM)
.INDEX(ZOOM)
.;
Real magnif;
If (sip2 neq null) and (sip2 neq "M")
Then
magnif_Realscan(sip2,flag);
If ((1./256.) > magnif) or (magnif > 256.)
Then
BOUND(1./256.,magnif,256.,"Magnification?",
null);
PZOOM(Datum(image1),Datum(image3),magnif);
End "41 ZOOM";
Begin "42 MAKEPIX"
COMMENT
.sss(MAKEPIX)
.INDEX(MAKEPIX)
.;
Boolean fillsw;
Integer xf,xl,yf,yl;
" get the boundary name"
If (iname_GET!BOUNDARY(sip1)) = none
Then
Begin "Not B name"
Outstr(sip1&" is not a boundary name"&crlf);
Return;
End "Not B name";
" Check and set fill switch value"
If "0" leq sip2 leq "9"
Then fillsw_true
Else fillsw_false;
If fillsw
Then ival_Intscan(sip2,flag)
Else ival_trunc!max;
" Save the current frame and swap in the boundary frame"
PFRAME("SAV");
FIND!REC(Datum(iname),PROPS(iname),xf,xl,yf,yl);
firstrow_yf;
lastrow_yl;
firstcolumn_xf;
lastcolumn_xl;
" now fill up the output image with line data"
For i_0 step 1 until PROPS(iname) Do
Begin "build pix"
Integer r,c;
c_((0 Max X!BND!FETCH({Datum(iname)},i))
Min imsiz);
r_((0 Max Y!BND!FETCH({Datum(iname)},i))
Min imsiz);
If MSK!BOOL(r,c)
and (firstrow leq r leq lastrow)
and (firstcolumn leq c leq lastcolumn)
Then
PACK2D({Datum(image3)},r,c,ival);
End "build pix";
" Test if fill then fill"
If fillsw
Then
PFILLHOLES(Datum(image3),ival,ival);
" Restore the frame"
PFRAME("RES");
End "42 MAKEPIX";
Begin "43 PRINT"
COMMENT
.sss(PRINT)
.INDEX(PRINT)
.;
String print!mode;
" Set the print mode to sip2, note default is
8 character gray scale"
" let the LPT file name be the picture name"
file!name_sip1;
print!mode_sip2&(If Equ(sip3,"TTY")
Then "TTY" Else null);
PIXDMP(Datum(image1),file!name,
pix!title[pix!index3],print!mode,
scaling);
End "43 PRINT";
Begin "44 TEXTURE1"
COMMENT
.sss(TEXTURE1)
.INDEX(TEXTURE1)
.;
If (sip2 neq "U")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
ival_thr!density;
PTEX1(Datum(image1),ival);
End "44 TEXTURE1";
Begin "45 TEXTURE2"
COMMENT
.sss(TEXTURE2)
.INDEX(TEXTURE2)
.;
PTEX2(Datum(image1));
End "45 TEXTURE2";
Begin "46 TEXTURE3"
COMMENT
.sss(TEXTURE3)
.INDEX(TEXTURE3)
.;
If (sip2 neq "U")
Then
ival_(0 max Intscan(sip2,flag))
min trunc!max
Else
ival_thr!density;
PTEX3(Datum(image1),ival);
End "46 TEXTURE3";
Begin "47 FILTER"
COMMENT
.sss(FILTER)
.INDEX(FILTER)
.;
Real Array dlist[0:8];
" Get the direction list into dlist"
j_length(strcopy);
s_strcopy;
If usemask
Then
Begin "look for mask"
k_length(smask);
For i_1 step 1 until j Do
If Equ(smask,s[i for k])
Then Done;
End "look for mask"
Else
Begin "look for input pix"
k_length(sip1);
For i_1 step 1 until j Do
If Equ(sip1,s[i for k])
Then Done;
End "look for input pix";
s_strcopy[i+k to Inf];
i_-1;
While not Equ(s,null) or (i<7) Do
Begin "get from string"
i_i+1;
dlist[i]_Realscan(s,flag);
End "get from string";
If i < 8
Then
For j_i step 1 until 8 Do
BOUND("-inf",dlist[j],"inf",
"Dlist["&CVS(j)&"]?",null);
Outstr(
CVF(dlist[3])&" "&CVF(dlist[2])&" "&CVF(dlist[1])&crlf&
CVF(dlist[4])&" "&CVF(dlist[8])&" "&CVF(dlist[0])&crlf&
CVF(dlist[5])&" "&CVF(dlist[6])&" "&CVF(dlist[7])&crlf&crlf);
PFILTER(Datum(image1),Datum(image3),dlist);
End "47 FILTER";
End "DO OPERATIONS";
End "PIX!ASSIGNMENT";
End "PINTRP.SAI";