!
! Forked from Revision 1.27 of p_support.map
!
! If SUPMASK exist, it means we just do it again
if (exist(supmask)) then
  !
  ! One may need to re-initialize if CLEAN and SUPMASK do not match
  @ support-main &1 &2 &3 &4 &5 &6 &7 &8 &9
  return
endif
!
! First definitions
if .not.exist(gosupport) then
  define structure gosupport /global
  define character gosupport%kind*16 /global
  define double gosupport%center[2] gosupport%major gosupport%minor gosupport%pa /global
  let gosupport%kind "interactive"
endif
!
! First time, Create all procedures only once
begin procedure support-visualize
  SAY "SUPPORT Visualize"
  ! Show the MASK
  ! - Adapted 13-Dec-2018
  @ support-save           ! Transfer the SUPMASK variable to MASK buffer
  let do_header yes
  clean\show mask 'gosupport%first' 'gosupport%last'
  !
  ! Re-display the buttons...
  @ button-reset
  @ button-init 9.8 5.0 3.0 0.5 "back"  "Back" 3
  @ button-init 9.8 4.2 3.0 0.5 "exit"  "Exit" 1
  for /while yes
    @ button-click
    if (buttons%clicked.eq.0.0.or.buttons%clicked.eq.buttons%ids%exit) then
      let aborted yes
      break
    else if (buttons%clicked.eq.buttons%ids%back) then
      break
    endif
  next
  let do_header no
end procedure support-visualize
!
begin procedure support-check
  if .not.exist(supmask) then
    message e MASK "Mask not initialized, use MASK INIT [2D] first"
    return base
  endif
  !
  if .not.exist(clean) then
    message w MASK "No CLEAN image"
  else
    if (any(supmask%dim[1:2].ne.clean%dim[1:2])) then
      ! Check matching sizes
      message e MASK "Mask and Clean sizes do not match"
      return base
    else if (supmask%dim[3].ne.1) then
      ! Check matching velocity range
      if (supmask%dim[3].ne.clean%dim[3]) then
        message w "Mask and Clean planes mismatch, proceed at own risk"
      endif
    endif
  endif
  !
end procedure support-check
!
begin procedure support-init
  SAY "SUPPORT init &1"
  ! Initialize the SUPMASK variable
  ! - Adapted 11-Dec-2018
  !
  !**! Must be changed for handling 2-D // 3-D case !**!
  if .not.exist(clean) then
    message w support "No CLEAN image"
    return
  endif
  if (exist(supmask)) then
    message w support "Re-initializing support mask"
    delete /var supmask
  else
    message i support "Creating new support mask"
  end if
  if ("-&1".eq."-2D").and.(clean%dim[3].gt.1) then
    define image supmask['clean%dim[1]','clean%dim[2]',1] * real /global
  else
    define image supmask * real /like clean /global
  endif
  !
  let supmask% clean%
  let supmask 0.0
end procedure support-init
!
begin procedure support-save
  SAY "SUPPORT save"
  ! Write the SUPMASK variable : transfer it to the MASK buffer
  ! - Adapted 13-Dec-2018
  if (exist(supmask)) then
    clean\write supmask gag_scratch:tmp.msk
    clean\read mask gag_scratch:tmp.msk
    message i support "Support transferred to Mask"
  else
    message e support "There is no current support mask to write"
  endif
end procedure support-save
!
begin procedure support-read
  ! MASK READ File.msk
  SAY "SUPPORT Read &1"
  ! Initialize the SUPMASK variable - Adapted 11-Dec-2018
  ! to be finalized for existing Support
  if .not.exist(clean) then
    message e support "No CLEAN image"
    return error
  endif
  !
  ! Check Mask / Clean mismatch ?
  if (exist(supmask)) then
    message w support "Support mask already loaded in memory - re-initialize first"
  else
    define character file*256
    let file &1
    clean\read mask 'file'
    define image supmask * real /like mask /global
    let supmask% mask%
    let supmask mask
  endif
end procedure support-read
!
begin procedure support-errorinput
  ! Same as .map version
  define char*10 mode
  let mode &1
  message e support "Wrong usage of mode: "'mode'
  message i support "Correct usage:"
  message i support "go support "'mode'" rectangle|ellipse cx cy major minor pa"
  message i support "go support "'mode'" polygon"
end procedure support-errorinput
!
begin procedure support-help
  ! Same as .map version, except English typos
  say "    MASK"
  say "    "
  say "    Define a mask for further use (Masking, Cleaning, etc...)"
  say "    "
  say "    The mask can be defined through an interactive session:"
  say "    MASK"
  say "    "
  say "    Or created through the command line:"
  say "    MASK INIT                           Initializes a mask"
  say "    MASK READ                           Reads mask from disk"
  say "    MASK WRITE                          Writes mask to disk"
  say "    MASK ADD ELLIPSE|RECTANGLE|POLYGON  Adds figure to mask"
  say "    MASK RM ELLIPSE|RECTANGLE|POLYGON   Removes figure from mask"
  say "    MASK [HELP|?]                       Shows this help"
  say "    "
  say "    In case add|rm a rectangle|ellipse 5 more parameters are needed:"
  say "    MASK ADD|RM ELLIPSE|RECTANGLE cx cy maj min pa"
  say "    "
  say "    cx, cy: offset of figure center in arcseconds"
  say "    maj:    long  side|major axis of rectangle|ellipse in arcseconds"
  say "    min:    short side|minor axis of the rectangle|ellipse in arcseconds"
  say "    pa:     angle between the long side|major axis and the north in degrees"
  say "    "
  say "    To inspect a defined support type:"
  say "    MASK VISUALIZE"
  say "    To overlay it over the clean image type:"
  say "    MASK OVER"
  say "    "
end procedure support-help
!
begin procedure support-edit
  SAY "SUPPORT Edit"
  !
  ! @ support-edit MODE FIGURE [params ...] PLOT
  !     MODE    ADD or RM   Add or remove in current Mask
  !     FIGURE  Type of figure to be added or removed
  !     Params  Figure parameters (figure dependent)
  !     PLOT    YES or NO: plot the result (default is YES)
  !
  ! - Adapted 11-Dec-2018
  ! - Updated 25-Jan-2019 to avoid calling MOMENTS
  if (.not.exist(supmask)) then
    message e support "There is no current support mask to edit"
    return
  endif
  !
  define integer fsave lsave
  define char*10 figure mode
  define logical do_exec invalid show
  let figure &2
  let invalid (figure.ne."polygon".and.figure.ne."rectangle").and.figure.ne."ellipse"
  if (invalid) then
    message e support "Unknow figure: "'figure'
    @ support-errorinput 'mode'
    return
  endif
  let mode &1
  if (pro%narg.eq.8) then
    let show &8
  else if (pro%narg.eq.3) then
    let show &3
  else
    let show yes
  endif
  let do_exec no
  !
  ! Show the Integrated area or Single plane
  if (show) then
    if (clean%dim[3].eq.1) then
      clean\show clean
    else
      !! moments !! This is not good, it becomes re-entrant code
      define integer jf jl
      let jf max(1,first)
      let jf min(jf,clean%dim[3])
      if (last.le.0) then
        let jl max(jf,clean%dim[3]-last)
      else
        let jl min(last,clean%dim[3])
      endif
      define image m_mean * real /like clean[1] /global
      let m_mean% clean%
      compute m_mean sum clean[jf:jl]
      compute m_mean%min min m_mean
      compute m_mean%max max m_mean
      clean\show m_mean
      delete /var m_mean
    endif
  endif
  !
  if (figure.eq."polygon") then
    greg2\polygon
    let do_exec yes
  else
    @ p_poly 'figure' &3 &4 &5 &6 &7 'show'
    let do_exec yes
  endif
  let first fsave
  let last lsave
  if (do_exec) then
    @ support-apply 'mode'
  end if
end procedure support-edit
!
begin procedure support-apply
  SAY "SUPPORT Apply"
  ! @ support-apply add|rm
  !
  ! Add or remove current polygon in current Mask
  !
  ! Identical, except optimization, to .map version 11-Dec-2018
  define integer fplane lplane
  define real val
  define char*10 mode
  !
  let fplane first
  let lplane last
  let mode &1
  if (fplane.eq.0) let fplane 1
  if (lplane.eq.0) let lplane supmask%dim[3]
  if (mode.eq."add") then
    let val 1.0
  else
    let val 0.0
  end if
  if supmask%ndim.eq.3 then
    for ip fplane to lplane
      greg2\rgdata supmask[,,ip] /var        ! This makes a Copy,
      !! .map! let rg[,] supmask[,,ip] ! So no need to it again
      greg2\mask in /blank val 0.0     ! No need to format
      let supmask[,,ip] rg[,]
    next ip
  else
    greg2\rgdata supmask /var        ! This makes a Copy,
    !! .map! let rg[,] supmask[,,ip] ! So no need to it again
    greg2\mask in /blank val 0.0     ! No need to format
    let supmask rg
  endif
end procedure support-apply
!
begin procedure support-interactive
  SAY "SUPPORT Interactive"
  ! Initialization
  let do_header no
  let do_contour no
  define integer step fsave lsave ip prevp nplanes
  let nplanes supmask%dim[3]
  define logical carry port waszero
  if (.not.exist(aborted)) then
    define logical aborted mvback stay worked[nplanes] /global
  end if
  if (gosupport%old) then
    let worked yes
  else
    let worked no
  endif
  let aborted no
  let carry yes
  let step &1
  let fsave gosupport%first
  let lsave gosupport%last
  if (fsave.eq.0) let fsave 1
  if (lsave.eq.0) let lsave supmask%dim[3]
  let ip fsave
  !
  @ button-tools
  ! Main loop over planes
  for /while ip.le.lsave ! fsave to lsave by step
    let mvback no
    let stay no
    @ support-interactive-action 'ip' 'step'
    ! handle subroutine output
    if (aborted) return
    let prevp ip
    if (mvback) then
      let ip ip-step
      if (ip.lt.fsave) then
        message w support "First channel reached"
        let ip fsave
      endif
    else if (stay) then
      continue
    else
      let ip ip+step
      if (ip.gt.lsave) then
        message w support "Last channel reached"
        let ip lsave
      endif
    endif
    let port carry.and.ip.ne.prevp.and..not.worked[ip]
    if (port) then
      let supmask[,,ip] supmask[,,prevp]
    endif
  next
  let do_header yes
  let do_contour yes
  delete /var mvback aborted stay
  @ button-delete
end procedure support-interactive
!
begin procedure support-interactive-action
  SAY "SUPPORT Action"
  ! Dispatch the action according to which button was clicked
  !
  ! Initialization
  sic message greg -iw
  sic message sic -i
  define integer hfirst hlast sizex sizey
  define logical goon
  !
  let gosupport%plane &1  ! Remember current plane
  !
  let goon yes
  let hfirst &1
  let hlast &1+&2-1
  if (hlast.gt.supmask%dim[3]) let hlast supmask%dim[3]
  !
  ! Plotting image
  if exist(l_area) delete /var l_area
  define image l_area * real /like clean[1] /global
  let l_area% clean%
  if (supmask%dim[3].eq.1) then
    compute l_area mean clean[1:'clean%dim[3]']
  else
    compute l_area mean clean[hfirst:hlast]
  endif
  compute l_area%min min l_area
  compute l_area%max max l_area
  !
  for /while goon
    clean\show l_area !!@ p_lmv.greg
    @ support-plot 'hfirst' 'hlast'
    greg1\draw text 0 -1 'hfirst'" "'hlast' /box 8
    @ support-interface
    @ button-click
    if (buttons%clicked.eq.0.0.or.buttons%clicked.eq.buttons%ids%exit) then
      let aborted yes
      return
    else if (buttons%clicked.eq.buttons%ids%abort) then
      message w support "Abort requested by user"
      let gosupport%aborted yes
      let aborted yes
      return
!    else if (buttons%clicked.eq.buttons%ids%next) then
!      message i support "Moving to next group of planes"
!      let goon no
!    else if (buttons%clicked.eq.buttons%ids%prev) then
!      message i support "Moving to previous group of planes"
!      let mvback yes
!      let goon no
    else if (buttons%clicked.eq.buttons%ids%prect) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig add rectangle
    else if (buttons%clicked.eq.buttons%ids%pelli) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig add ellipse
    else if (buttons%clicked.eq.buttons%ids%ppoly) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig add polygon
    else if (buttons%clicked.eq.buttons%ids%mrect) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig rm rectangle
    else if (buttons%clicked.eq.buttons%ids%melli) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig rm ellipse
    else if (buttons%clicked.eq.buttons%ids%mpoly) then
      clean\show l_area !! @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      @ support-drawfig rm polygon
    else if (buttons%clicked.eq.buttons%ids%visu) then
      @ support-visualize
      let goon no
      let stay yes
    else if (buttons%clicked.eq.buttons%ids%excl) then
      let supmask[,,hfirst:hlast] 0.0   ! Simpler replacement
    else if (buttons%clicked.eq.buttons%ids%incl) then
      ! What is that supposed to do ??
      let sizex supmask%dim[1]
      let sizey supmask%dim[2]
      for ip 'hfirst' to 'hlast'
        let supmask[,,ip] 1.0
        let supmask[1,,ip] 0.0
        let supmask[sizex,,ip] 0.0
        let supmask[,sizey,ip] 0.0
        let supmask[,1,ip] 0.0
      next ip
      PAUSE
    else
      if (exist(buttons%ids%next)) then
        if (buttons%clicked.eq.buttons%ids%next) then
          message i support "Moving to next group of planes"
          let goon no
        endif
      endif
      if (exist(buttons%ids%prev)) then
        if (buttons%clicked.eq.buttons%ids%prev) then
          message i support "Moving to previous group of planes"
          let mvback yes
          let goon no
        endif
      endif
    endif
    let worked[hfirst:hlast] yes      ! Simpler replacement
  next
  sic message greg +iw
  sic message sic +i
end procedure support-interactive-action
!
begin procedure support-interface
  SAY "SUPPORT Interface"
  ! Create the interface to control the User actions
  ! as pseudo-buttons (areas in which the user can click in the plot)
  !
  ! as in .map version
  define real bwidth bheight vspace col addpos mainbot maintop rmpos
  define integer addcor rmcor maincor
  let addcor 3
  let rmcor 1
  let maincor 0
  let bwidth 3.0
  let bheight 0.5
  let vspace 0.8
  let col 9.8
  let mainbot 1.25
  let addpos 7.25
  let rmpos 4.25
  let maintop 10.25
  @ button-reset
  ! Previous and Next buttons
  if (gosupport%plane.lt.min(supmask%dim[3],gosupport%last)) then
    @ button-init 'col' 'mainbot'          'bwidth' 'bheight' "next"  "Next"           'maincor'
  endif
  if (gosupport%plane.gt.max(1,gosupport%first)) then
    @ button-init 'col' 'mainbot-vspace'   'bwidth' 'bheight' "prev"  "Previous"       'maincor'
  endif
  @ button-init 'col' 'mainbot-2*vspace' 'bwidth' 'bheight' "exit"  "Save_and_Exit"  'maincor'
  @ button-init 'col' 'mainbot-3*vspace' 'bwidth' 'bheight' "abort" "Exit_w/o_save"  'maincor'
  ! Main interface buttons
  @ button-init 'col' 'maintop'          'bwidth' 'bheight' "incl"  "Include_plane"  'maincor'
  @ button-init 'col' 'maintop-vspace'   'bwidth' 'bheight' "excl"  "Exclude_plane"  'maincor'
  @ button-init 'col' 'maintop-2*vspace' 'bwidth' 'bheight' "visu"  "Visualize_mask" 'maincor'
  ! Add buttons
  @ button-init 'col' 'addpos'           'bwidth' 'bheight' "prect" "+_Rectangle"    'addcor'
  @ button-init 'col' 'addpos-vspace'    'bwidth' 'bheight' "pelli" "+_Ellipse"      'addcor'
  @ button-init 'col' 'addpos-2*vspace'  'bwidth' 'bheight' "ppoly" "+_Polygon"      'addcor'
  ! Remove buttons
  @ button-init 'col' 'rmpos'            'bwidth' 'bheight' "mrect" "-_Rectangle"    'rmcor'
  @ button-init 'col' 'rmpos-vspace'     'bwidth' 'bheight' "melli" "-_Ellipse"      'rmcor'
  @ button-init 'col' 'rmpos-2*vspace'   'bwidth' 'bheight' "mpoly" "-_Polygon"      'rmcor'
end procedure support-interface
!
begin procedure support-plot
  SAY "SUPPORT Plot"
  !
  ! Plot the current Mask - optimized for IMAGER
  define integer hfirst hlast
  define image supmasktmp * real /like supmask[,,1]
  let supmasktmp% supmask%
  let hfirst &1
  let hlast &2
  !
  compute supmasktmp sum supmask[hfirst:hlast]
  greg2\rgdata supmasktmp /var
  greg2\levels  0.9
  greg2\rgmap /pen 7
end procedure support-plot
!
begin procedure support-drawfig
  SAY "SUPPORT drawfig"
  ! Draw the current figure    ! As in .map version
  define real click1[2] click2[2] click3[2] cx cy dx dy delx dely
  define double pa
  define char*20 figure mode
  let mode &1
  let figure &2
  greg1\pencil /w 5
  if (mode.eq."add") then
    greg1\draw text 1 2 "Adding "'figure'":" /box 6
  else
    greg1\draw text 1 2 "Removing "'figure'":" /box 6
  endif
  if (figure.eq."polygon") then
    greg1\draw text 1 0 "1- Left click to" /box 6
    greg1\draw text 1 -0.5 "add corners" /box 6
    greg1\draw text 1 -1.5 "2- Right click to" /box 6
    greg1\draw text 1 -2.0 "finish" /box 6
    greg1\pencil /def
    @ support-edit 'mode' polygon no
  else if (figure.eq."rectangle") then
    greg1\draw text 1 0 "1- Click on bottom" /box 6
    greg1\draw text 1 -0.5 "left corner" /box 6
    greg1\draw relo
    let click1 use_curs/sec
    greg1\draw text 1 -1.5 "2- Click on top" /box 6
    greg1\draw text 1 -2.0 "right corner" /box 6
    greg1\draw relo
    greg1\pencil /def
    let click2 use_curs/sec
    let cx (click1[1]+click2[1])/2
    let cy (click1[2]+click2[2])/2
    let dy abs(click2[1]-click1[1])
    let dx abs(click2[2]-click1[2])
    @ support-edit 'mode' 'figure' 'cx' 'cy' 'dx' 'dy' 0.0 no
  else
    greg1\draw text 1  0.0 "1- Click to define " /box 6
    greg1\draw text 1 -0.5 "one of the edges of" /box 6
    greg1\draw text 1 -1.0 "the ellipse" /box 6
    greg1\draw relo
    let click1 use_curs/sec
    greg1\draw text 1 -2.0 "2- Click to define " /box 6
    greg1\draw text 1 -2.5 "the other edge of" /box 6
    greg1\draw text 1 -3.0 "the ellipse" /box 6
    greg1\draw relo 'click1[1]*sec' 'click1[2]*sec' /u
    greg1\pencil /w 3
    greg1\draw line
    greg1\pencil /w 5
    let click2 use_curs/sec
    greg1\draw text 1 -3.5 "3- Click to define " /box 6
    greg1\draw text 1 -4.0 "the semi-minor axis" /box 6
    greg1\draw text 1 -4.5 "of the ellipse" /box 6
    greg1\draw relo
    let click3 use_curs/sec
    greg1\pencil /def
    let cx (click1[1]+click2[1])/2 ! centers
    let cy (click1[2]+click2[2])/2
    let delx click2[1]-click1[1]
    let dely click2[2]-click1[2]
    ! major axis => distance between cl1 and cl2
    let dx sqrt(delx**2+dely**2)
    ! minor axis => twice distance between cl3 and the line between cl1 and cl2
    let dy dely*click3[1]-delx*click3[2]+click2[1]*click1[2]-click2[2]*click1[1]
    let dy 2*abs(dy)/dx
    if (dely.gt.0) then
      let pa delx/dx
    else
      let pa -(delx)/dx
    endif
    ! pa from deltax/major axis
    let pa asin(pa)*180/pi
    @ support-edit 'mode' 'figure' 'cx' 'cy' 'dx' 'dy' 'pa' no
  end if
end procedure support-drawfig
!
begin procedure support-cleanup
  SAY "SUPPORT Cleanup"
  ! Nothing special in IMAGER, who works with Buffers
  ! Deleting integrated images produced during interactive section to save disk space
  !.map! sic delete 'name'-area*'type'
  @ button-delete
end procedure support-cleanup
!
! Main program
begin procedure support-main
  !
  ! Adapted 11-Dec-2018
  define character*16 mode
  define character*256 cmname
  if (.not.exist(gosupport%first)) then
    define integer gosupport%plane gosupport%first gosupport%last /global
    define logical gosupport%aborted gosupport%old /global
  endif
  let gosupport%plane first
  let gosupport%first first
  let gosupport%last last
  let gosupport%aborted no
  let gosupport%old no
  if (pro%narg.eq.0) then
    let mode 'gosupport%kind'
  else
    let mode &1 /lower
  endif
  if (mode.eq."?".or.mode.eq."help") then
    @ support-help
    return
  end if
  !
  ! That may be changed to the currently Displayed image
  if .not.exist(clean) then
    message e support "No Clean image, impossible to proceed"
    return
  end if
  !
  define logical old_wedge
  let old_wedge do_wedge
  let do_wedge no
  !
  if (mode.eq."init") then
    @ support-init &2
  else if (mode.eq."write") then
    @ support-save
    say "Type MASK VISUALIZE to inspect it"
  else if (mode.eq."read") then
    @ support-read
  else if (mode.eq."polygon") then ! From widget polygon
    @ support-check
    @ support-edit add polygon
    @ support-save
    @ support-cleanup
  else if (mode.eq."rectangle") then
    @ support-check
    @ support-edit add rectangle 'gosupport%center[1]' 'gosupport%center[2]' 'gosupport%major' 'gosupport%minor' 'gosupport%pa'
    @ support-save
    @ support-cleanup
  else if (mode.eq."ellipse") then
    @ support-check
    @ support-edit add ellipse 'gosupport%center[1]' 'gosupport%center[2]' 'gosupport%major' 'gosupport%minor' 'gosupport%pa'
    @ support-save
    @ support-cleanup
  else if (mode.eq."visualize") then
    clean\show supmask 'first' 'last'
  else if (mode.eq."over") then
    ! Not sure it works...
    let nimages 2
    let nreference 1
    let names[1] CLEAN
    let names[2] SUPMASK
    let types "%"
    @ p_over
  else if (mode.eq."add".or.mode.eq."rm") then
    if (pro%narg.eq.7) then
      @ support-check
      @ support-edit &1 &2 &3 &4 &5 &6 &7
      @ support-save
    else if (pro%narg.eq.2) then
      @ support-check
      @ support-edit &1 &2
      @ support-save
    else
      message e MASK "Incorrect number of inputs."
      @ support-errorinput 'mode'
    end if
  else if (mode.eq."interactive") then
    if (pro%narg.eq.2) then
      @ support-interactive &2
    else
      @ support-interactive 1
    end if
    ! At end, save if not aborted
    if (.not.gosupport%aborted) @ support-save
    @ support-cleanup
    ! the logic is bizarre
    if (gosupport%old) then
      if (gosupport%aborted) delete /var supmask
    end if
  else if (mode.eq."?".or.mode.eq."help") then
    @ support-help
  else
    message e support "Unrecognized mode, nothing done"
  endif
  let first gosupport%first
  let last gosupport%last
  let do_header yes
  let do_contour yes
  delete /var gosupport%plane gosupport%first gosupport%last gosupport%aborted gosupport%old
  let do_wedge old_wedge
end procedure support-main
!
! First pass: initialize and loop
@ support-main &1 &2 &3 &4 &5 &6 &7 &8 &9
