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 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";