include include include define A_IN Memr[$1-1+(2*mx+1)*($3-1)+$2] # T_RREMOVEX -- fill in reseau marks in an image # # D. Giaretta, 01-Aug-87 Original SPP version # D. Giaretta, 26-Apr-88 Correct param input1 to input # Phil Hodge, 20-Sep-89 In xrremove, replace RES_TYPE_MEM with Meml, # and change mx,my to rmx,rmy in call to foc_incheck. procedure t_rremovex() char input[SZ_FNAME] # input image char output[SZ_FNAME] # output image char coordfile[SZ_FNAME] # File with approximate coords bool cabs # are coords absolute? #-- pointer xpt, ypt # pointers to x, y coordinates int nres bool clgetb() char imtemp[SZ_FNAME] long xcoord_type() errchk clgetb, xcoord_type begin call clgstr( "input", input, SZ_FNAME) call clgstr( "output", output, SZ_FNAME) call clgstr( "coordfile", coordfile, SZ_FNAME) cabs = clgetb( "cabs") call xt_mkimtemp( input, output, imtemp, SZ_FNAME) # get the coordinates nres = xcoord_type( coordfile, "entry", "xcol", "ycol", xpt, ypt) # fix the marks call xrremove ( input, output, nres, xpt, ypt, cabs) # juggle if same name call xt_delimtemp( output, imtemp) end # XRREMOVE -- This subroutine examines each mark and fills it in with data # derived from the surrounding area. Initially a 4 by 4 aea centred # on the given coordinates is filed in, but a larger area may be filled # if the slope at the boundary of the 4 by 4 area does not change by # at least a factor of 2. The fill values are taken as the weighted # average of the bounding pixels in the line and sample directions. procedure xrremove( input, output, nres, rx, ry, cabs ) char input[SZ_FNAME] # i: input file char output[SZ_FNAME] # i: output file int nres # i: number of reseau marks pointer rx, ry # i: reseau coord structure bool cabs # i: are coords absolute? #-- pointer imin # i: input image pointer imout # i: output image pointer in, out, i_l, o_l pointer foc_coord, x_foc_immap(), immap() pointer imps2r(), imgs2r() bool foc_incheck() int i, j, doff, coff, xe, xs, ye, ys, npix, ires int impnlr(), imgnlr() int mx, my real rmx, rmy real f14, xres, yres long i_v[IM_MAXDIM] long o_v[IM_MAXDIM] begin f14 = 1.0/14.0 mx = 4 my = 4 rmx = mx rmy = my # open input and output imin = immap( input, READ_ONLY, 0) imout = immap( output, NEW_COPY, imin) # copy input to output call amovkl( long(1), i_v, IM_MAXDIM) call amovkl( long(1), o_v, IM_MAXDIM) npix = IM_LEN(imin, 1) while ( impnlr( imout, o_l, o_v) != EOF && imgnlr( imin , i_l, i_v) != EOF ) call amovr( Memr[i_l], Memr[o_l], npix) # close files call imunmap( imout) call salloc( foc_coord, SZ_FOC_COORD, TY_STRUCT) # open output again to fill reseau marks imout = x_foc_immap( output, foc_coord, READ_WRITE, NULL) # loop over all the reseau positions, process those not INDEF, # and not too close to edge for ( ires = 1; ires <= nres; ires=ires+1) { xres = Meml[rx-1+ires] yres = Meml[ry-1+ires] if (!cabs) { xres = xres + FOC_SAMPBEG(foc_coord) - 1 yres = yres + FOC_LINEBEG(foc_coord) - 1 } if (foc_incheck (xres, yres, rmx, rmx, rmy, rmy, foc_coord)) { xres = xres - FOC_SAMPBEG(foc_coord) + 1 yres = yres - FOC_LINEBEG(foc_coord) + 1 # try to fill the mark # see if we need to fill in the outer region # this is done if the gradient Changes by less than a factor of # 2 going from the inner 4*4 area to the 8*8 area around the mark xs = xres - mx xe = xres + mx ys = yres - my ye = yres + my in = imgs2r( imin, xs, xe, ys, ye ) out = imps2r( imout, xs, xe, ys, ye ) call amovr( Memr[in], Memr[out], (2*mx+1)*(2*my+1) ) for (i=mx-1; i<= mx+2; i=i+1) { doff = 2*mx - i if ( A_IN(in, i, my-3)-A_IN(in, i, my-2) < 2.0*(A_IN(in, i, my-2)-A_IN(in, i, my-1))) A_IN(out, i, my-2) = (6.0*A_IN(in, i, my-3) + A_IN(in, i, my+4) + doff*A_IN(in, mx-3, my-2)+ (7.0-doff)*A_IN(in, mx+4, my-2))*f14 if ( A_IN(in, i, my+4)-A_IN(in, i, my+3) < 2.0*(A_IN(in, i, my+3)-A_IN(in, i, my+2))) A_IN(out, i, my+3) = (6.0*A_IN(in, i, my+4) + A_IN(in, i, my-3) + doff*A_IN(in, mx-3, my+3) + (7.0-doff)*A_IN(in, mx+4, my+3))*f14 } # now down each side for ( i =my-1; i <= my+2; i=i+1) { doff = 2*my - i if ( A_IN(in, mx-3, i)-A_IN(in, mx-2, i) < 2.0*(A_IN(in, mx-2, i)-A_IN(in, mx-1, i))) A_IN(out, mx-2, i) = (6.0*A_IN(in, mx-3, i) + A_IN(in, mx+4, i) + doff*A_IN(in, mx-2, my-3)+ (7.0-doff)*A_IN(in, mx-2, my+4))*f14 if ( A_IN(in, mx+4, i)-A_IN(in, mx+3, i) < 2.0*(A_IN(in, mx+3, i)-A_IN(in, mx+2, i))) A_IN(out, mx+3, i) = (6.0*A_IN(in, mx+4, i) + A_IN(in, mx-3, i) + doff*A_IN(in, mx+3, my-3) + (7.0-doff)*A_IN(in, mx+3, my+4))*f14 } # now the four corners if ( A_IN(in, mx-3, my-3)-A_IN(in, mx-2, my-2) < 2.0*(A_IN(in, mx-2, my-2)-A_IN(in, mx-1, my-1))) A_IN(out, mx-2, my-2) =(6.0*A_IN(in, mx-2, my-3)+ A_IN(in, mx-2, my+4)+ 6.0*A_IN(in, mx-3, my-2)+ A_IN(in, mx+4, my-2))*f14 if ( A_IN(in, mx+4, my-3)-A_IN(in, mx+3, my-2)< 2.0*(A_IN(in, mx+3,my-2)-A_IN(in, mx+2,my-1))) A_IN(out, mx+3, my-2) =(6.0*A_IN(in, mx+3, my-3)+ A_IN(in, mx+3, my+4)+ A_IN(in, mx-3, my-2)+ 6.0*A_IN(in, mx+4, my-2))*f14 if ( A_IN(in, mx-3, my+4)-A_IN(in, mx-2, my+3)< 2.0*(A_IN(in, mx-2, my+3)-A_IN(in, mx-1, my+2))) A_IN(out, mx-2, my+3) =( A_IN(in, mx-2, my-3)+ 6.0*A_IN(in, mx-2, my+4)+ 6.0*A_IN(in, mx-3, my+3)+ A_IN(in, mx+4, my+3))*f14 if ( A_IN(in, mx+4, my+4)-A_IN(in, mx+3, my+3)< 2.0*(A_IN(in, mx+3, my+3)-A_IN(in, mx+2, my+2))) A_IN(out, mx+3, my+3) = ( A_IN(in, mx-2, my-3)+ 6.0*A_IN(in, mx-2, my+4)+ A_IN(in, mx-3, my+3)+ 6.0*A_IN(in, mx+4, my+3))*f14 # finally the insides do i = my-1, my+2 { do j = mx-1, mx+2 { doff = 2*my-i coff = 2*mx-j A_IN(out, j, i) =( doff*A_IN(in, j, my-3) + (7.0-doff)*A_IN(in, j, my+4) + coff*A_IN(in, mx-3, i) + (7.0-coff)*A_IN(in, mx+4, i))*f14 } } } } call imunmap( imin) call imunmap( imout) end