! @(#)areatable.prg	17.1.1.1 (ESO-DMD) 01/25/02 17:12:19
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure areatable.prg
! K. Banse      ESO-Garching	980914
! 
! construct a table containing columns :XSTART, :YSTART, :XEND, :YEND
!   defining areas of equal size covering the image
!   if image size is not a multiple of area sizes, the last areas are sized
!   to just fit the image
!   BUT, if those last areas consist of a single pixel, they are just dropped
! 
! use via:  @a areatable in_image xsize,ysize out_table
!
! with in_image - the input image
!      xsize,ysize the size of the areas in pixels
!      the name of the result table
! 
! the number of areas will be stored in descr. ARPIX of `out_table'
! 
! example: @a areatable galaxy 40,40 restable
! 
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! 
define/parameter p1 ? ima "Enter input image:"
define/parameter p2 4,4 no "Enter interval size in pixels for x,y:"
define/parameter p3 ? tab "Enter result table:"
! 
define/local myframe/c/1/100 {p1}
define/local inc/i/1/2 1,1
write/keyw inc/i/1/2 {p2},{p2}
define/local mytable/c/1/100 {p3}
! 
define/local kpix/i/1/2 1,1
kpix(1) = m$value({myframe},npix(1))
kpix(2) = m$value({myframe},npix(2))
define/local sta/d/1/2 0.,0.
sta(1) = m$value({myframe},start(1))
sta(2) = m$value({myframe},start(2))
define/local step/d/1/2 0.,0.
step(1) = m$value({myframe},step(1))
step(2) = m$value({myframe},step(2))
! 
define/local fpix/i/1/2 1,1		!frame pixels
define/local nox/i/1/1 1		!no. of areas (x,y)
define/local noy/i/1/1 1
nox = kpix(1)/inc(1)
noy = kpix(2)/inc(2)
define/local xa/r/1/1 0.		!corners of area (in world coords)
define/local ya/r/1/1 0.
define/local xe/r/1/1 0.
define/local ye/r/1/1 0.
define/local sin/r/1/2 0.,0.		!area size in wc
sin(1) = (inc(1)-1)*step(1)
sin(2) = (inc(2)-1)*step(2)
define/local end/r/1/2 0,0		!end coords of frame
end(1) = sta(1) + (kpix(1)-1)*step(1)
end(2) = sta(2) + (kpix(2)-1)*step(2)
! 
define/local loopy/i/1/1 1
define/local loopx/i/1/1 1
define/local nrow/i/1/1 1
define/local addon/i/1/2 0,0		!if areas don't cover completely
! 
inputi = (nox+1)*(noy+1)
create/table {mytable} 4 {inputi}	!create the table and the 4 columns
create/column {mytable} :xstart
create/column {mytable} :ystart
create/column {mytable} :xend
create/column {mytable} :yend
! 
fpix(2) = 1
ya = sta(2)
loopy = 1
! 
y_loop:
ye = ya+sin(2)
! 
yy_loop:
fpix(1) = 1
xa = sta(1)
! 
do loopx = 1 nox
   xe = xa+sin(1)
! 
   {mytable},:xstart,@{nrow} = xa 
   {mytable},:ystart,@{nrow} = ya 
   {mytable},:xend,@{nrow} = xe 
   {mytable},:yend,@{nrow} = ye 
   nrow = nrow+1
! 
   fpix(1) = fpix(1)+inc(1)
   xa = sta(1) + (fpix(1)-1) * step(1)
enddo
if xa .lt. end(1) then
   addon(1) = 1
   xe = end(1)
   {mytable},:xstart,@{nrow} = xa
   {mytable},:ystart,@{nrow} = ya
   {mytable},:xend,@{nrow} = xe
   {mytable},:yend,@{nrow} = ye
   nrow = nrow+1
endif
! 
fpix(2) = fpix(2)+inc(2)
ya = sta(2) + (fpix(2)-1) * step(2)
loopy = loopy+1
if loopy .le. noy then
   goto y_loop
else
   if addon(2) .eq. 0 then
      if ya .lt. end(2) then
         ye = end(2)
         addon(2) = 1
         goto yy_loop
      endif
   endif
endif
! 
nox = nox+addon(1)
noy = noy+addon(2)
set/format i1
write/out no. of sub-areas = {nox} x {noy} 
! 
inputi = m$ftset(mytable)			!test, if filetype there
if inputi .eq. 1 then					!filetype set already 
   write/descr {mytable} arpix/i/1/2 {nox},{noy}
else
   write/descr {mytable}.tbl arpix/i/1/2 {nox},{noy}
endif