!-----------------------------------------------------------------------------
begin procedure do_clean_all
   say "NEW DO_CLEAN_ALL"
   ! 
   ! do_clean_all.map 
   ! &1 = HOGBOM, CLARK, SDI, or MRC 
   ! 
   define integer n1 n2 first_saved last_saved
   define char ff*40
   let first_saved first
   let last_saved last
   let n1 max(1,first) 
   if last.eq.0 then 
      load dirty
      let n2 w%dim[3] 
   else 
      let n2 last 
   end if 
   say channels 'n1' to 'n2' 
   ! 
   def char method*20 
   let method &1 
   ! 
   if (do_plot.eq."NONE") then 
      symbol symbol_plot " " 
   else 
      symbol symbol_plot "/PLOT "'do_plot' 
   end if 
   ! 
   if ((flux[1].ne.0).or.(flux[2].ne.0)) then 
      symbol symbol_flux "/FLUX "'flux[1]'" "'flux[2]' 
   else 
      symbol symbol_flux " " 
   end if 
   ! 
   if ((method.eq."MRC").and.(ratio.ne.0)) then 
      symbol symbol_ratio "/RATIO "'ratio' 
   else 
      symbol symbol_ratio " " 
   end if 
   ! 
   for i n1 to n2 
      ! 
      show dirty 'i' 
      let ff 'name'-'i'.pol
      if file(ff) then
         support 'name'-'i'.pol 
      else
         support /cursor
         system "rm "'name'"-"'i'".pol"
         greg2\write polygon 'ff'
      end if
      support /plot 
      if (method.eq."HOGBOM") then 
         clean\hogbom 'i' 'symbol_flux' 
      else if (method.eq."CLARK") then 
         clean\clark 'i' 'symbol_plot' 'symbol_flux' 
      else if (method.eq."SDI") then 
         clean\sdi 'i' 'symbol_plot' 
      else if (method.eq."MRC") then 
         clean\mrc 'i' 'symbol_plot' 'symbol_flux' 'symbol_ratio' 
      end if 
      ! 
   next 
   let itype CLEAN
   let first 'first_saved'
   let last 'last_saved'
end procedure do_clean_all
!-----------------------------------------------------------------------------
begin procedure do_support_all
   define char ff*40 
   define integer n1 n2 first_saved last_saved
   define real a
   let a sec*support_size|2.
   pen 1 
   let first_saved first
   let last_saved last
   let n1 max(1,first) 
   if last.eq.0 then 
      load dirty
      let n2 w%dim[3] 
   else 
      let n2 last 
   end if 
   say using planes 'n1' to 'n2' 
   for i n1 to n2 
      if support_shape.eq."POLYGON" then
         support 'support_file'
      else if support_shape.eq."CURSOR" then
         if exist(clean) then 
            show clean 'i' 
         else 
            show dirty 'i' 
         end if 
         support /cursor
      else if support_shape.eq."SQUARE" then
         define real pp[5,2] 
         let pp[1] -a -a  a  a -a
         let pp[2] -a  a  a -a -a
         polygon pp /variable
         del /var pp 
      else if support_shape.eq."CIRCLE" then
         define real pp[33,2] 
         for k 1 to 33         
            let pp[k,1] a*cos(pi*k|16.)
            let pp[k,2] a*sin(pi*k|16.)
         next
         polygon pp /variable
         del /var pp 
      end if
      support /plot 
      if (sic$version.eq."HPUX").or.(sic$version.eq."Generic Unix") then
         system "rm "'name'"-"'i'".pol" 
      end if
      greg2\write polygon 'name'-'i'.pol 
      pen 0 
   next 
   let first 'first_saved'
   let last 'last_saved'
end procedure do_support_all
!-----------------------------------------------------------------------------
begin procedure x_whole_define
   define integer ratio plane lplane /global 
   define real flux[2] support_size /global 
   define character do_plot*12 itype*6 support_shape*7 support_file*40 /global 
   define integer nfield /global 
   define double bmin hppb /global 
   let gain 0.2 
   let bmin 0.25
!   let hppb 50
   let fres 0 
   let ares 1e-3 
   let niter 100 
!   if (mosaic) then 
!     let niter 500 
!   end if 
   let ratio 0 
   let first 'first' 
   let last 'last' 
   let do_plot residuals 
   let flux 0 0 
   let support_shape CURSOR
   let support_file [undefined]
   let support_size 25.
end procedure x_whole_define
!-----------------------------------------------------------------------------
begin procedure get_uv_map
   let uv_taper 'uv_taper[1]' 'uv_taper[2]' 'uv_taper[3]' /prompt "UV Taper" 
   let weight_mode 'weight_mode' /prompt "Weighting mode" /choice NATURAL UNIFORM 
   let map_size 'map_size[1]' 'map_size[2]' /prompt "Map size (in pixels)" 
   let map_cell 'map_cell[1]' 'map_cell[2]' /prompt "Pixel size (in arcsec)" 
   let uv_shift 'uv_shift' /prompt "Shift and rotate map on specified center ?" 
   let map_ra 'map_ra' /prompt "Right Ascension" 
   let map_dec 'map_dec' /prompt "Declination" 
   let map_angle 'map_angle' /prompt "Angle from North" 
   ! 
   let uv_cell 'uv_cell[1]' 'uv_cell[2]' /prompt "UV Cell size and min. weight" 
   let mcol 'mcol[1]' 'mcol[2]' /prompt "First and last channel" 
   let wcol 'wcol' /prompt "Weight channel" 
   ! 
   let convolution 'convolution' /prompt "Convolution function" -
   /index box sinc expo expo_sinc spheroidal 
end procedure get_uv_map
!-----------------------------------------------------------------------------
begin procedure get_clean_hogbom
   let gain 'gain' /prompt "Loop gain" 
   let niter 'niter' /prompt "Max. number of iterations" 
   let ares 'ares' /prompt "Max abs. residual" 
   let fres 'fres' /prompt "Frac. abs. residual" 
   let blc 'blc[1]' 'blc[2]' /prompt "Bottom Left corner" 
   let trc 'trc[1]' 'trc[2]' /prompt "Top Right corner" 
   let beam_patch 'beam_patch[1]' 'beam_patch[2]' /prompt "Beam Patch" 
   let major 'major' /prompt "Clean Beam major axis (sec)" 
   let minor 'minor' /prompt "Clean Beam minor axis (sec)" 
   let angle 'angle' /prompt "Clean Beam PA (deg E from N)" 
!   if (mosaic) then 
      let search_w 'search_w' /prompt "MOSAIC: Min. weight for search" 
      let restore_w 'restore_w' /prompt "MOSAIC: Min. weight for restore" 
!    end if 
    let flux 'flux[1]' 'flux[2]' /prompt "Flux scale for display" 
end procedure get_clean_hogbom
!-----------------------------------------------------------------------------
begin procedure get_clean_clark
   let gain 'gain' /prompt "Loop gain" 
   let niter 'niter' /prompt "Max. number of iterations" 
   let ares 'ares' /prompt "Max abs. residual" 
   let fres 'fres' /prompt "Frac. abs. residual" 
   let blc 'blc[1]' 'blc[2]' /prompt "Bottom Left corner" 
   let trc 'trc[1]' 'trc[2]' /prompt "Top Right corner" 
   let beam_patch 'beam_patch[1]' 'beam_patch[2]' /prompt "Beam Patch" 
   let major 'major' /prompt "Clean Beam major axis (sec)" 
   let minor 'minor' /prompt "Clean Beam minor axis (sec)" 
   let angle 'angle' /prompt "Clean Beam PA (deg E from N)" 
!   if (mosaic) then 
     let search_w 'search_w' /prompt "MOSAIC: Min. weight for search" 
     let restore_w 'restore_w' /prompt "MOSAIC: Min. weight for restore" 
!   end if 
   let flux 'flux[1]' 'flux[2]' /prompt "Flux scale for display" 
   let do_plot 'do_plot' /prompt "Display major cycle images?" -
   /choice residuals clean none 
end procedure get_clean_clark
!-----------------------------------------------------------------------------
begin procedure get_clean_mrc
   let gain 'gain' /prompt "Loop gain" 
   let niter 'niter' /prompt "Max. number of iterations" 
   let ratio 'ratio' /prompt "MRC smoothing factor" 
   let ares 'ares' /prompt "Max abs. residual" 
   let fres 'fres' /prompt "Frac. abs. residual" 
   let blc 'blc[1]' 'blc[2]' /prompt "Bottom Left corner" 
   let trc 'trc[1]' 'trc[2]' /prompt "Top Right corner" 
   let beam_patch 'beam_patch[1]' 'beam_patch[2]' /prompt "Beam Patch" 
   let major 'major' /prompt "Clean Beam major axis (sec)" 
   let minor 'minor' /prompt "Clean Beam minor axis (sec)" 
   let angle 'angle' /prompt "Clean Beam PA (deg E from N)" 
!   if (mosaic) then 
     let search_w 'search_w' /prompt "MOSAIC: Min. weight for search" 
     let restore_w 'restore_w' /prompt "MOSAIC: Min. weight for restore" 
!   end if 
   let flux 'flux[1]' 'flux[2]' /prompt "Flux scale for display" 
   let do_plot 'do_plot' /prompt "Display major cycle images?" - 
   /choice residuals clean none 
   ! 
end   procedure get_clean_mrc
!-----------------------------------------------------------------------------
begin procedure get_show
   ! 
   ! get_show: get show parameters for MAPPING 
   ! 
   sic\let size 'size' /prompt "Size of plotted area (sec)" 
   sic\let spacing 'spacing' /prompt "Contour step" 
   sic\let cross 'cross' /prompt "Center cross size (sec)" 
   sic\let mark 'mark' /prompt "Box marking type" -
      /choice velocity frequency channel none 
   sic\let beam_type 'beam_type' /prompt "Additional beam plotted" -
      /choice dirty clean none 
   sic\let extra 'extra' /prompt "Extra data plotted" /choice none coverage 
   ! 
   sic\let do_header 'do_header' /prompt "Draw header" 
   sic\let do_nice 'do_nice' /prompt "Plot clean beam ?" 
   sic\let do_bit 'do_bit' /prompt "Show bitmap images ?" 
   sic\let do_contour 'do_contour' /prompt "Draw contours ?" 
   sic\let do_grey 'do_grey' /prompt "Fill contours ?" 
   sic\let do_tree 'do_tree' /prompt "Structure plot ?" 
   ! 
end   procedure get_show
!-----------------------------------------------------------------------------
begin procedure do_read_all
   on error return
   @ count_fields
   if nfield.gt.0 then
      @ do_read DIRTY 'NAME'.'MAPFIL$EXTS2'
      @ do_read BEAM 'NAME'.'MAPFIL$EXTS3'
      @ do_read PRIMARY 'NAME'.'MAPFIL$EXTS4' 
      @ do_read CLEAN  'NAME'.'MAPFIL$EXTS5'
      say "I-DO_READ_ALL, Please hit MOSAIC"
   else
      @ do_read UV 'NAME'.'MAPFIL$EXTS1'
      @ do_read DIRTY 'NAME'.'MAPFIL$EXTS2'
      @ do_read BEAM 'NAME'.'MAPFIL$EXTS3'
      @ do_read CLEAN  'NAME'.'MAPFIL$EXTS5'
   end if
end   procedure do_read_all
!-----------------------------------------------------------------------------
begin procedure count_fields
   define character ff*40
   let nfield 0
   let ff 'NAME'-'nfield+1'.'MAPFIL$EXTS1'
   for /while file(ff)
      let nfield nfield+1
      let ff 'NAME'-'nfield+1'.'MAPFIL$EXTS1'
   next
   if (nfield.gt.0) then
      say "I-DO_READ_ALL, This is a "'nfield'" field mosaic.  "
   else 
      let ff 'NAME'.'MAPFIL$EXTS1'
      if file(ff) then
         say "I-DO_READ_ALL, Single-field UV data. "
      else
         say "W-DO_READ_ALL, no UV data. "
      end if
   end if
end   procedure count_fields
!-----------------------------------------------------------------------------
begin procedure do_mosaic
   define character chain*80 name_saved*40
   def double hmscen[2] hms[2] conv[2] s[2] hmsblc[2] hmstrc[2] np2[2]
   def integer h[2] m[2] 
   let uv_shift yes
!
! use center of gravity if no default map center.
!
   let conv 12|pi 180|pi
   let hmscen 0
   let hmstrc -1e10
   let hmsblc 1e10
   for i 1 to nfield
      define header hh 'name'-'i'.uvt read
      let hmscen hmscen[1]+hh%ra hmscen[2]+hh%dec
      let hmstrc[1] max(hmstrc[1],hh%ra)
      let hmstrc[2] max(hmstrc[2],hh%dec)
      let hmsblc[1] min(hmsblc[1],hh%ra)
      let hmsblc[2] min(hmsblc[2],hh%dec)
      delete /variable HH
   next
   let hmscen hmscen|nfield
   let hms abs(conv*hmscen) 
   let h int(hms) 
   let hms 60*(hms-h) 
   let m int(hms) 
   let hms 60*(hms-m) 
   let s 1e-4*nint(1e4*hms) 
   let chain 'h[1]':'m[1]':'s[1]' 
   if map_ra.eq." " then
      let map_ra 'chain'
   endif
   if map_dec.eq." " then
      if (hms[2].gt.0) then 
         let chain  +'h[2]':'m[2]':'s[2]'
      else 
         let chain  -'h[2]':'m[2]':'s[2]'
      end if 
      let map_dec 'chain'
   end if
   say "Map center will be at RA  "'map_ra'" Dec "'map_dec'
!
   let wcol 1
   let name_saved 'name'
   transpose 'name'-1.uvt 'name'-1.tuv 213
   define image tr 'name'-1.tuv read 
   define real uv[4] uvmax tmp_cell[2]
   compute uv[1] max tr[1]
   compute uv[2] min tr[1]
   compute uv[3] max tr[1]
   compute uv[4] min tr[1]
   let uv abs(uv)/299792458.D-6*tr%convert[2,2]
   compute uvmax max uv
   let tmp_cell 0.01*NINT(100.0|UVMAX|3.0|sec)
   del /var uv uvmax tr
   if map_cell[1]*map_cell[2].eq.0 then
      let map_cell 'tmp_cell[1]' 'tmp_cell[2]'
      say "Map cell is: " 'map_cell[1]' " by " 'map_cell[2]' " arc seconds "
   else if (tmp_cell[1].lt.map_cell[1]).or.(tmp_cell[2].lt.map_cell[2]) then
      say "W-DO_MOSAIC, map cell size is too large:"
      say "Map cell is: " 'map_cell[1]' " by " 'map_cell[2]' " arc seconds "
      say "Recommended: " 'tmp_cell[1]' " by " 'tmp_cell[2]' " arc seconds "
   end if
   if hppb.eq.0 then
      say "getting primary beam size ... "
      define header hh 'name'-1.uvt read
      let hppb 0.1*nint(440*(115000|hh%convert[2,1]))
      let hppb 'hppb'
      del /var hh
   end if
   say "Primary beam is " 'hppb' " arc seconds"
   def real bext 
   let bmin 'max(0.05,bmin)'
   let bext 2*hppb*sqrt(-log(bmin)/log(2)/4)
   let np2 (abs(hmstrc-hmsblc)|sec+bext)|map_cell
   let np2 max(5,int(log(np2)|log(2.)))+1
   let np2 2**np2
   if map_size[1]*map_size[2].eq.0 then
      let map_size 'np2[1]' 'np2[2]'
      say "Map size will be "'map_size[1]' 'map_size[2]' " pixels"
   else if (np2[1].gt.map_size[1]).or.(np2[2].gt.map_size[2]) then
      say "W-DO_MOSAIC, map size is too small:"
      say "Map size is: " 'map_size[1]' " by " 'map_size[2]' " pixels"
      say "Recommended: " 'np2[1]' " by " 'np2[2]' " pixels"
   end if
   pause
   for i 1 to nfield
      let name 'name_saved'-'i'
      go uv_map
   next   
   let name 'name_saved'
   run make_mosaic pr:graphic/make_mosaic.init /nowin 
   let restore_w bmin 
   let search_w bmin 
   read dirty 'name' 
   read beam 'name' 
   read primary 'name' 
! 
   say "compute clean beam parameters: "
   for i 1 to nfield
      fit 'i' 
   next 
end   procedure do_mosaic 
!-----------------------------------------------------------------------------
begin procedure plot_type
   @ p_plot 'itype'
end   procedure plot_type
!-----------------------------------------------------------------------------
begin procedure do_read
   on error return
   define character ff*40
   let ff &2
   if file(ff) then
      READ &1 &2
      if "&1?".eq."PRIMARY?" then
         say "I-DO_READ, Switching to MOSAIC mode"
      end if
      let itype &1
   else
      say "W-DO_READ, no &1 data ["'ff'"]"
      if ("&1?".eq."DIRTY?").and.(nfield.gt.1) then
         say "I-DO_READ, Please hit MOSAIC to build the mosaic"
      end if
   end if
end   procedure do_read
!-----------------------------------------------------------------------------
begin procedure do_write_all
   @ do_write UV 'NAME'.'MAPFIL$EXTS1'
   @ do_write DIRTY 'NAME'.'MAPFIL$EXTS2'
   @ do_write BEAM 'NAME'.'MAPFIL$EXTS3'
!!   @ do_write PRIMARY 'NAME'.'MAPFIL$EXTS4' 
   @ do_write CLEAN  'NAME'.'MAPFIL$EXTS5'
end   procedure do_write_all
!-----------------------------------------------------------------------------
begin procedure do_write
   on error return
   if exist(&1) then
      WRITE &1 &2
   end if
end   procedure do_write
!-----------------------------------------------------------------------------
! 
! x_whole.map
! Main Procedure
!-----------------------------------------------------------------------------
if (.not.exist(ratio)) then 
   @ x_whole_define
   let itype UV
end if 
! 
gui\panel "Mapping Control Panel" pr:map/x_whole.hlp 
sic\let name 'name' /prompt "Generic name " 
sic\let itype 'itype' /prompt "Image type to show" -
   /CHOICE UV DIRTY BEAM PRIMARY CLEAN
sic\let first 'first' /prompt "First channel" 
sic\let last 'last' /prompt "Last channel" 
! 
! ------ READ
gui\button "@ do_read_all" READ 
!
! ------ MOSAIC
gui\button "@ do_mosaic" MOSAIC "Mosaic from UV data" gildas_help:uv_map.hlp -
  "Mosaic parameters" 
let hppb 'hppb' /prompt "Half Power Primary Beam (sec)" 
let bmin 'bmin' /prompt "Truncation level" 
!
! ------ UV_MAP
gui\button "uv_map" UV_MAP "Mapping from UV data" gildas_help:uv_map.hlp -
  "UV_MAP parameters" 
@ get_uv_map
!
! ------ SUPPORT
gui\button "@ do_support_all" SUPPORT "Get support" gildas_help:uv_map.hlp -
  "parameters"
let support_shape 'support_shape' /prompt "Support shape ?" -
   /choice POLYGON SQUARE CIRCLE CURSOR
let support_size 'support_size' /prompt "Support size ("") ?"
let support_file 'support_file' /prompt "Support file ?" /FILE *.pol
! 
! ------ HOGBOM 
gui\button "@ do_clean_all HOGBOM" Hogbom "HOGBOM method" -
   gildas_run:uv_map.hlp "HOGBOM parameters" 
@ get_clean_hogbom 
! 
! ------ CLARK 
gui\button "@ do_clean_all CLARK" Clark "CLARK method" gildas_run:uv_map.hlp -
   "CLARK parameters" 
@ get_clean_clark 
! 
! ------ SDI 
gui\button "@ do_clean_all SDI" Sdi "SDI method" gildas_help:uv_map.hlp -
   "SDI parameters" 
@ get_clean_sdi 
! 
! ------ MRC 
gui\button "@ do_clean_all MRC" Mrc "MRC method" gildas_help:uv_map.hlp -
   "MRC parameters" 
@ get_clean_mrc
! 
! ------ SHOW
gui\button "@ plot_type" "SHOW" "Show image" gildas_help:clean.hlp -
   "SHOW parameters" 
@ get_show.map 
! ------ SHOW (top)
!
gui\button "@ plot_type" "SHOW" 
! 
! ------ WRITE
gui\button "@ do_write_all" WRITE 
!
on error return 
gui\go 
!