!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure mosaic-poly
  !--------------------------------------------------------------------------
  ! &1: rectangle or ellipse
  ! &2: xcenter [arcsec]
  ! &3: ycenter [arcsec]
  ! &4: major   [arcsec]
  ! &5: minor   [arcsec]
  ! &6: pa      [degree]
  !
  ! Define and draw a rectangle or an ellipse
  !---------------------------------------------------------------------------
  !
  ! Go to radian from input units
  define double center[2] major minor pa
  let center '&2*sec' '&3*sec'
  let major '(&4/2.0)*sec'
  let minor '(&5/2.0)*sec'
  let pa    'pi*(90-&6)/180.0'
  !
  ! Define number of gons
  define integer ngons
  if ("&1".eq."ellipse") then
     let ngons 100
  else if ("&1".eq."rectangle") then
     let ngons 4
  else
     message e poly "Unknown polygon type: &1"
     return base
  endif
  !
  define real xygons[ngons,2] cospa sinpa rx ry cangle
  let cospa cos(pa)
  let sinpa sin(pa)
  !
  if ("&1".eq."ellipse") then
     let cangle (2*pi)/ngons
     for igon 1 to ngons
     let rx major*cos(igon*cangle)
     let ry minor*sin(igon*cangle)
     let xygons[igon,1] center[1]+rx*cospa-ry*sinpa
     let xygons[igon,2] center[2]+rx*sinpa+ry*cospa
     next
  else
     let xygons[1,1:2] 'center[1]+major*cospa+minor*sinpa' 'center[2]+major*sinpa-minor*cospa'
     let xygons[2,1:2] 'center[1]+major*cospa-minor*sinpa' 'center[2]+major*sinpa+minor*cospa'
     let xygons[3,1:2] 'center[1]-major*cospa-minor*sinpa' 'center[2]-major*sinpa+minor*cospa'
     let xygons[4,1:2] 'center[1]-major*cospa+minor*sinpa' 'center[2]-major*sinpa-minor*cospa'
  endif
  !
  polygon xygons /var /plot
end procedure mosaic-poly
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure mosaic-define
  tickspace 0 0 0 0
  if .not.exist(mos) then
     define structure mos /global
     define double mos%freq mos%diam mos%primbeam /global
     define character*32 mos%ra mos%dec /global
     define logical mos%readoffsets /global
     define character mos%filename*256 /global
     define double mos%orien mos%size[2] mos%center[2] /global
     define logical mos%closest mos%list /global
     define integer mos%nfield mos%pen /global
     let mos%diam 15
     let mos%freq 115.271 ! [GHz]
     let mos%ra   "05:40:54.270"
     let mos%dec "-02:28:00.000"
     let mos%readoffsets no
     let mos%filename ""
     let mos%orien 0.0
     let mos%size 180
     let mos%closest yes
     let mos%nfield 0
     let mos%pen 1
     let mos%list no
  endif
end procedure mosaic-define
!
begin procedure mosaic-pattern-compute
  ! 
  ! Computes offsets for a mosaic
  ! - exact mosaic pattern
  ! - there is always a field in (0,0) 
  !        => odd number of fields in each direction 
  !
  define integer nra ndec kfield
  define double size_ra size_dec first_ra first_dec delta_ra delta_dec
  define double ra_off dec_off
  define logical even jeven
  !
  ! Deletes the offset arrays and redefines them later as global variables 
  ! with the right dimension
  if (exist(mos%xoff)) then
     delete /var mos%xoff
  endif
  if (exist(mos%yoff)) then
     delete /var mos%yoff
  endif
  let size_ra  mos%size[1]
  let size_dec mos%size[2]
  ! Computes pixel size to obtain an mosaic pattern
  let delta_ra  0.5*mos%primbeam
  let delta_dec 0.25*sqrt(3.0)*mos%primbeam
  ! `nra' and `ndec' are the number of beams the mosaic will have in ra 
  ! and dec. These must at least be 1
  let nra  max(1,int(size_ra/(2.0*delta_ra)))
  let ndec max(1,int(size_dec/(2.0*delta_dec)))
  ! `first_ra' and `first_dec' are the coordiantes of the first 
  ! pointing position
  let first_ra    (nra-1)*delta_ra
  let first_dec -(ndec-1)*delta_dec
  ! Finds position of fields in ra and dec
  define double xoff['2*nra-1'] yoff['2*ndec-1']
  for i 0 to 2*nra-2
     let xoff['i+1'] first_ra-delta_ra*i
  next
  for j 0 to 2*ndec-2
     let yoff['j+1'] first_dec+delta_dec*j
  next
  ! Here is the hard part
  !  - Tries to make a good use of the fact that an mosaic pattern 
  !    is asymetric in ra and dec;
  ! That probably can be done in a more elegant way but that is working!
  let kfield 1
  let even (2*int(ndec/2).eq.ndec)
  if (even) then 
     let mos%nfield (2*nra-2)*ndec+(2*nra-1)*(ndec-1)
  else
     let mos%nfield (2*nra-2)*(ndec-1)+(2*nra-1)*ndec
  endif
  define double mos%xoff[mos%nfield] mos%yoff[mos%nfield] /global
  define integer ifieldmax
  let ra_off 0.5*delta_ra
  for jfield 1 to 2*ndec-1
     let jeven (2*int(jfield/2).eq.jfield)
     if ((even.and.jeven).or.((.not.even).and.(.not.jeven))) then
        for ifield 1 to 2*nra-1
           let mos%xoff[kfield] xoff[ifield]
           let mos%yoff[kfield] yoff[jfield]
           let kfield kfield+1
        next ifield
     else
        let ifieldmax 2*nra-2
        for ifield 1 to ifieldmax
           let mos%xoff[kfield] xoff['ifieldmax-ifield+1']-ra_off
           let mos%yoff[kfield] yoff[jfield]
           let kfield kfield+1
        next ifield
     endif
  next jfield
  ! When asked, selects only the fields which are in a circular region 
  ! (i.e. the closest neighbours of the central field)
  if (mos%closest) then
     define double new_xoff[mos%nfield] new_yoff[mos%nfield]
     define double circular_limit
     ! The 1.01 factor comes from rounding problems
     let circular_limit (1.01*(nra-1)*delta_ra)^2
     let kfield 1
     for ifield 1 to mos%nfield
        say 'circular_limit' 'mos%xoff[ifield]^2+mos%yoff[ifield]^2'
        if ((mos%xoff[ifield]^2+mos%yoff[ifield]^2).le.circular_limit) then
           let new_xoff[kfield] mos%xoff[ifield]
           let new_yoff[kfield] mos%yoff[ifield]
           let kfield kfield+1
        endif
     next ifield
     delete /var mos%xoff mos%yoff
     let mos%nfield kfield-1
     define double mos%xoff[mos%nfield] mos%yoff[mos%nfield] /global
     let mos%xoff new_xoff[1:mos%nfield]
     let mos%yoff new_yoff[1:mos%nfield]
     delete /var new_xoff new_yoff
  endif
  ! Rotate the coordinates
  define double new_xoff[mos%nfield] new_yoff[mos%nfield]
  define double pha cospha sinpha
  let pha mos%orien*pi/180
  let cospha cos(pha)
  let sinpha sin(pha)
  let new_xoff mos%xoff*cospha-mos%yoff*sinpha
  let new_yoff mos%xoff*sinpha+mos%yoff*cospha
  let mos%xoff new_xoff
  let mos%yoff new_yoff
  delete /var new_xoff new_yoff
  ! Offset the coordinates
  let mos%xoff mos%xoff+mos%center[1]
  let mos%yoff mos%yoff+mos%center[2]
end procedure mosaic-pattern-compute
!
begin procedure mosaic-pattern-read
  if .not.file(mos%filename) then
     message e mosaic "Unknown file: "'mos%filename'
     return base
  endif
  !
  compute mos%nfield lines 'mos%filename' /blank
  if (exist(mos%xoff)) then
     delete /var mos%xoff
  endif
  if (exist(mos%yoff)) then
     delete /var mos%yoff
  endif
  define double mos%xoff[mos%nfield] mos%yoff[mos%nfield] /global
  accept mos%xoff mos%yoff /column 'mos%filename'
  !
  compute mos%center[1] mean mos%xoff
  compute mos%center[2] mean mos%yoff
  define double min[2] max[2]
  compute min[1] min mos%xoff
  compute max[1] max mos%xoff
  compute min[2] min mos%yoff
  compute max[2] max mos%yoff
  let mos%size max-min+mos%primbeam
end procedure mosaic-pattern-read
!
begin procedure mosaic-pattern-define
  define double lambda
  let lambda 299792458/(mos%freq*1e9)
  let mos%primbeam 1.2*lambda/mos%diam/sec ! *** JP unclear whether the 1.2 should be there
  !
  if (mos%readoffsets) then
     @ mosaic-pattern-read 
  else
     @ mosaic-pattern-compute     
  endif
end procedure mosaic-pattern-define
!
begin procedure mosaic-pattern-plot
  ! Set projection
  clear
  g\set system EQUATORIAL 2000
  projection 'mos%ra' 'mos%dec' /type azimuthal
  define double cos sin xrange yrange xmin xmax ymin ymax
  let cos abs(cos(mos%orien*pi/180))
  let sin abs(sin(mos%orien*pi/180))
  let xrange 0.6*(mos%size[1]*cos+mos%size[2]*sin)
  let yrange 0.6*(mos%size[1]*sin+mos%size[2]*cos)
  let xmin mos%center[1]-xrange
  let xmax mos%center[1]+xrange
  let ymin mos%center[2]-yrange
  let ymax mos%center[2]+yrange
  limits xmax xmin ymin ymax sec
  g\set box match
  box /unit sec !/abs
  ! Plot fields
  g\set marker 4 1 0.4 45
  if (mos%nfield.gt.1) then
     pen 3
     greg\draw relo 'mos%xoff[1]' 'mos%yoff[1]' /user sec
     for ifield 2 to mos%nfield
        greg\draw arrow 'mos%xoff[ifield]' 'mos%yoff[ifield]' /user sec
     next ifield
  endif
  pen 'mos%pen'
  for ifield 1 to mos%nfield
     ellipse 'mos%primbeam/2' /user 'mos%xoff[ifield]' 'mos%yoff[ifield]' sec 
  next ! ifield
  if (.not.mos%readoffsets) then
     ! Plot box that defines the mosaic size
     @ mosaic-poly rectangle 'mos%center[1]' 'mos%center[2]' 'mos%size[1]' 'mos%size[2]' '90-mos%orien'
  endif
  pen 0
end procedure mosaic-pattern-plot
!
begin procedure mosaic-pattern-list
  if (.not.mos%list) return
  say "BEGIN DATA offsets"
  for ifield 1 to mos%nfield
     say mos%xoff[ifield] mos%yoff[ifield] /format f12.2 f12.2
  next ifield
  say "END DATA offsets"
end procedure mosaic-pattern-list
!
begin procedure mosaic-usage
  message e mosaic "Usage: @ mosaic.greg [/diameter diam] [/frequency freq] [/projection  RA Dec] [/offsets filename] [/size sx [sy]] [/center cx [cy]] [/orientation angle] [/closest] [/list]"
  return base
end procedure mosaic-usage
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
@ mosaic-define
!
! Parse arguments
! @ mosaic.astro -
!      /diameter    diam -
!      /frequency   freq -
!      /projection  RA Dec
!      /offsets     filename -
!      /size        sx [sy] -
!      /center      cx [cy] -
!      /orientation angle -
!      /closest
!      /list 
on error "@ mosaic-usage"
parse -
   /diameter    1 1 -
   /frequency   1 1 -
   /projection  2 2 -
   /offsets     1 1 -
   /size        1 2 -
   /center      1 2 -
   /orientation 1 1 -
   /closest -
   /list
! Generic parameters
let mos%list pro%parse%list%narg.eq.0
if (pro%parse%diameter%narg.lt.1) then
   ! Using either default or last value
else
   let mos%diam 'pro%parse%diameter%arg[1]'
endif
if (pro%parse%frequency%narg.lt.1) then
   ! Using either default or last value
else
   let mos%freq 'pro%parse%frequency%arg[1]'
endif
if (pro%parse%projection%narg.lt.1) then
   ! Using either default or last value
else
   let mos%ra  'pro%parse%projection%arg[1]'
   let mos%dec 'pro%parse%projection%arg[1]'
endif
! Offset related parameters
if (pro%parse%offsets%narg.eq.1) then
   ! The user provides a file of offset => we will just plot it
   let mos%readoffsets yes
   let mos%filename 'pro%parse%offsets%arg[1]'
else
   ! Alternatively we parse the parameters to define the offset list and to
   ! plot it
   let mos%readoffsets no
   if (pro%parse%size%narg.lt.1) then
      ! Using either default or last value
   else
      if (pro%parse%size%narg.eq.1) then
         let mos%size[1] 'pro%parse%size%arg[1]'
         let mos%size[2] 'pro%parse%size%arg[1]'
      else
         let mos%size[1] 'pro%parse%size%arg[1]'
         let mos%size[2] 'pro%parse%size%arg[2]'
      endif
   endif
   if (pro%parse%center%narg.lt.1) then
      ! Using either default or last value
   else
      if (pro%parse%center%narg.eq.1) then
         let mos%center[1] 'pro%parse%center%arg[1]'
         let mos%center[2] 'pro%parse%center%arg[1]'
      else
         let mos%center[1] 'pro%parse%center%arg[1]'
         let mos%center[2] 'pro%parse%center%arg[2]'
      endif
   endif
   if (pro%parse%orientation%narg.lt.1) then
      ! Using either default or last value
   else
      let mos%orien 'pro%parse%orientation%arg[1]'
   endif
   let mos%closest (pro%parse%closest%narg.eq.0)
endif
!
on error "return base"
!
@ mosaic-pattern-define
@ mosaic-pattern-plot
@ mosaic-pattern-list
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
