! @(#)swap4.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:12:31
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!  Midas procedure swap4.prg
!  to swap the 4 quadrants of an image diagonally
! 
!               A   B                    D   C
!  input image:   x    =>  output image:   x      ( A  B  =>  B  A  for 1-dim )
!               C   D                    B   A 
!
!  use via   @a swap4 inframe outframe [delete_flag] [swap_coords]
!
!  inframe   input image
!  outframe  output image  (input + output name may be the same...)
!  delete_flag  Y(es) or N(o), defaulted to YES
!  swap_coords  if given the pixels (as @x,@y) after which to swap
! 
!  KB	901108, 911119, 921013
!
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
define/param p1 ? IMA "Enter input frame: "
define/param p2 ? IMA "Enter output frame: "
define/param p3 Y ?   "Enter delete flag: "
define/param p4 + ?   "Enter swap coords: "
! 
define/local infr/c/1/60 {p1}
define/local outfr/c/1/60 {p2}
! 
define/local nl/i/1/1 {{infr},naxis}
define/local np/i/1/1 {{infr},npix(1)}	!no. of pixels in x-direction
define/local nn/i/1/2 0,0
define/local nhx/i/1/2 0,0
if p4(1:1) .ne. "+" then
   write/keyw nhx/i/1/1 {p4(2:)}		!skip @
else
   nhx(1) = np/2
endif
nhx(2) = nhx(1) + 1
nn(1) = np - nhx(1) + 1
! 
if nl .ne. 1 then
   define/local nq/i/1/1 {{infr},npix(2)}
   define/local nhy/i/1/2 0,0
   if p4(1:1) .ne. "+" then
      nhy(2) = m$index(p4,",")+2
      write/keyw nhy/i/1/1 {p4({nhy(2)}:)}		!skip @
   else
      nhy(1) = nq/2
   endif
   nhy(2) = nhy(1) + 1
   nn(2) = nq - nhy(1) + 1
endif
! 
! create result frame with same start and stepsize
if outfr .ne. infr copy/ii {infr} {outfr} 
! 
if nl .eq. 1 then
   extract/image swapswapc = {infr}[<:@{nhx(1)}]			!left
   extract/image swapswapd = {infr}[@{nhx(2)}:>]			!right
! 
   insert/image swapswapd {outfr} <
   insert/image swapswapc {outfr} @{nn(1)}
!
   if p3(1:1) .ne. "N" then
      delete/image swapswapc no
      delete/image swapswapd no
   endif
else
   extract/image swapswapc = {infr}[<,<:@{nhx(1)},@{nhy(1)}]	!lower left
   extract/image swapswapd = {infr}[@{nhx(2)},<:>,@{nhy(1)}]	!lower right
   extract/image swapswapa = {infr}[<,@{nhy(2)}:@{nhx(1)},>]	!upper left
   extract/image swapswapb = {infr}[@{nhx(2)},@{nhy(2)}:>,>]	!upper right
! 
   insert/image swapswapb {outfr} <,<
   insert/image swapswapa {outfr} @{nn(1)},<
   insert/image swapswapd {outfr} <,@{nn(2)}
   insert/image swapswapc {outfr} @{nn(1)},@{nn(2)}
!
   if p3(1:1) .ne. "N" then
      delete/image swapswapa no
      delete/image swapswapb no
      delete/image swapswapc no
      delete/image swapswapd no
   endif
endif