begin procedure support-visualize
   @ support-write
   let type msk
   let first gosupport%first
   let last gosupport%last
   let do_header yes
   @ p_bit
   @ 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
   @ support-read
   let do_header no
   let type lmv-clean
end procedure support-visualize
!
begin procedure support-init
   if (.not.exist(supmask)) then
      if (.not.exist(clean)) read clean 'name'.lmv-clean
      message i support "Creating new support mask"
      define image supmask 'name'.msk real /like clean /global
   else
      message w support "Re-initializing loaded support mask"
   end if
   let supmask% clean%
   let supmask 0.0
end procedure support-init
!
begin procedure support-write
   if (exist(supmask)) then
      delete /var supmask
      if exist(myclean) then
         let myclean%support yes
      endif
   else
      message e support "There is no current support mask to write"
   endif
end procedure support-write
!
begin procedure support-read
   if (.not.exist(clean)) read clean 'name'.lmv-clean
   if (exist(supmask)) then
      message w support "Support mask already loaded in memory"
   else
      define image supmask 'name'.msk write /global
   endif 
end procedure support-read
!
begin procedure support-errorinput
   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
   say "    GO SUPPORT MODE"
   say "    "
   say "    Define the support inside which to search for CLEAN components."
   say "    "
   say "    The support can be defined through an interactive session:"
   say "    GO SUPPORT INTERACTIVE"
   say "    or:"
   say "    GO SUPPORT"
   say "    "
   say "    Or the support can be created through the command line:" 
   say "    GO SUPPORT INIT                           Initializes a blank mask"
   say "    GO SUPPORT READ                           Reads mask from disk"
   say "    GO SUPPORT WRITE                          Writes mask to disk"
   say "    GO SUPPORT ADD ELLIPSE|RECTANGLE|POLYGON  Adds figure to mask"
   say "    GO SUPPORT RM ELLIPSE|RECTANGLE|POLYGON   Removes figure from mask"
   say "    GO SUPPORT HELP|?                         Shows this help"
   say "    "
   say "    ************************************************************"
   say "    "
   say "    In case add|rm a rectangle|ellipse 5 more parameters are needed:"
   say "    GO SUPPORT ADD|RM ELLIPSE|RECTANGLE cx cy maj min pa"
   say "    "
   say "    cx, cy: offset from cube 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 north in degrees"
   say "    "
   say "    ************************************************************"
   say "    "
   say "    In case add|rm a polygon, this could be either a previously defined"
   say "    polygon:"
   say "    "
   say "    go support add|rm polygon mypoly.pol"
   say "    "
   say "    Or a new polygon to be done with the cursor:"
   say "    "
   say "    go support add|rm polygon"
   say "    "
   say "    ************************************************************"
   say "    "
   say "    To inspect a defined support type:"
   say "    GO SUPPORT VISUALIZE"
   say "    To overlay it over the clean image type:"
   say "    GO SUPPORT OVER"
   say "    "
end procedure support-help
!
begin procedure support-edit
   define char*256 nsave polname
   define integer fsave lsave
   define char*10 figure mode
   define logical exec invalid show
   !
   let mode &1
   let figure &2
   !
   if (pro%narg.eq.8) then
      let show &8
   else if (pro%narg.eq.3.and.figure.ne."polygon") then
      let show &3
   else if (pro%narg.eq.3.and.figure.eq."polygon") then
      if (gosupport%interactive) then
	 let show &3
      else
	 let show no
      endif
   else if (pro%narg.eq.4) then
      let show &4
   else
      let show yes
   endif
   let exec no
   if (.not.exist(supmask)) then
      message e support "There is no current support mask to edit"
      return
   endif
   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 nsave 'name'
   let fsave first
   let lsave last  
   let type lmv-clean
   if (show) then 
      if (first.ne.last.or.first.eq.0) then
         @ p_area.greg
         let first 0
         let last 0
      endif
      @ p_lmv.greg
   endif
   if (figure.eq."polygon") then
      if (pro%narg.ge.3.and..not.gosupport%interactive) then
	 sic find &3
	 if (dir%nfile.lt.1) then
	    message e support "Polygon file not found"
	    return
	 endif
	 poly &3
      else
	 poly
      endif
      let exec yes
   else
      @ p_poly.map 'figure' &3 &4 &5 &6 &7 'show'
      let exec yes
   endif
   let name 'nsave'
   let first fsave
   let last lsave
   if (exec) then
      @support-apply 'mode'
   end if
end procedure support-edit
!
begin procedure support-apply
   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
   for ip fplane to lplane
      rgdata supmask[,,ip] /var
      let rg[,] supmask[,,ip]
      mask in /blank 'val' 0.0
      let supmask[,,ip] rg[,]
   next ip
end procedure support-apply
!
begin procedure 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(nsave)) then
      define char*256 nsave nwork /global
   end if
   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
   let nsave 'name'
   if (fsave.eq.0) let fsave 1
   if (lsave.eq.0) let lsave supmask%dim[3]  
   let ip fsave
   @ button-tools.greg
   ! 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'
       ! return globals to previous state
       let name 'nsave'
       ! handle subroutine output
       if (aborted) return
       let prevp ip
       if (mvback) then
          let ip ip-step
          if (ip.lt.fsave) let ip fsave
       else if (stay) then
          continue
       else
          let ip ip+step
          if (ip.gt.lsave) let ip lsave
       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 nsave nwork stay
   @ button-delete
end procedure support-interactive
!
begin procedure support-interactive-action
   ! Initialization
   sic message greg -iw
   sic message sic -i
   define integer hfirst hlast sizex sizey
   define logical continue
   let continue yes
   let hfirst &1
   let hlast &1+&2-1
   if (hlast.gt.supmask%dim[3]) let hlast supmask%dim[3]
   ! Plotting image
   let type lmv-clean
   let first hfirst
   let last  hlast
   if (hfirst.ne.hlast) then
      @ p_area.greg
      let first 0
      let last 0
   end if
   for /while continue
      @ p_lmv.greg
      @ support-plot 'hfirst' 'hlast'
      g\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 continue no
      else if (buttons%clicked.eq.buttons%ids%prev) then
         message i support "Moving to previous group of planes"
         let mvback yes
         let continue no
      else if (buttons%clicked.eq.buttons%ids%prect) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig add rectangle
      else if (buttons%clicked.eq.buttons%ids%pelli) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig add ellipse
      else if (buttons%clicked.eq.buttons%ids%ppoly) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig add polygon
      else if (buttons%clicked.eq.buttons%ids%mrect) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig rm rectangle
      else if (buttons%clicked.eq.buttons%ids%melli) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig rm ellipse
      else if (buttons%clicked.eq.buttons%ids%mpoly) then
         @ p_lmv.greg
         @ support-plot 'hfirst' 'hlast'
         @ support-drawfig rm polygon
      else if (buttons%clicked.eq.buttons%ids%visu) then
         @ support-visualize
         let continue no
         let stay yes
      else if (buttons%clicked.eq.buttons%ids%excl) then
         for ip 'hfirst' to 'hlast'
               let supmask[,,ip] 0.0
         next ip
      else if (buttons%clicked.eq.buttons%ids%incl) then
         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
      endif
      for ip 'hfirst' to 'hlast'
         let worked[ip] yes
      next ip
   next
   sic message greg +iw
   sic message sic +i
end procedure support-interactive-action
!
begin procedure support-interface
   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
   @ button-init 'col' 'mainbot'          'bwidth' 'bheight' "next"  "Next"           'maincor'
   @ button-init 'col' 'mainbot-vspace'   'bwidth' 'bheight' "prev"  "Previous"       'maincor'
   @ 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
   define integer hfirst hlast
   define image supmasktmp supmasktmp.lm real /like supmask[,,1]
   let supmasktmp 0.0
   let supmasktmp% supmask%
   delete /var supmasktmp
   let hfirst &1
   let hlast &2
   image supmasktmp.lm
   for ip hfirst to hlast
      let rg rg+supmask[,,ip]
   next
   level  0.9
   rgmap /pen 7
   sic delete supmasktmp.lm
end procedure support-plot
!
begin procedure support-drawfig
  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
  pen /w 5
  if (mode.eq."add") then
     draw text 1 2 "Adding "'figure'":" /box 6
  else
     draw text 1 2 "Removing "'figure'":" /box 6
  endif
  if (figure.eq."polygon") then
     draw text 1 0 "1- Left click to" /box 6
     draw text 1 -0.5 "add corners" /box 6
     draw text 1 -1.5 "2- Right click to" /box 6
     draw text 1 -2.0 "finish" /box 6
     pen /def
     @ support-edit 'mode' polygon no
  else if (figure.eq."rectangle") then
     draw text 1 0 "1- Click on bottom" /box 6
     draw text 1 -0.5 "left corner" /box 6
     draw relo
     let click1 use_curs/sec
     draw text 1 -1.5 "2- Click on top" /box 6
     draw text 1 -2.0 "right corner" /box 6
     draw relo
     pen /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
     draw text 1  0.0 "1- Click to define " /box 6
     draw text 1 -0.5 "one of the edges of" /box 6
     draw text 1 -1.0 "the ellipse" /box 6
     draw relo
     let click1 use_curs/sec
     draw text 1 -2.0 "2- Click to define " /box 6
     draw text 1 -2.5 "the other edge of" /box 6
     draw text 1 -3.0 "the ellipse" /box 6
     draw relo 'click1[1]*sec' 'click1[2]*sec' /u
     pen /w 3
     draw line
     pen /w 5
     let click2 use_curs/sec
     draw text 1 -3.5 "3- Click to define " /box 6
     draw text 1 -4.0 "the semi-minor axis" /box 6
     draw text 1 -4.5 "of the ellipse" /box 6
     draw relo
     let click3 use_curs/sec
     pen /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
   ! Deleting integrated images produced during interactive section to save disk space
   sic delete 'name'-area*'type'
   if (gosupport%interactive) @ button-delete
end procedure support-cleanup
!
! Main program
!
define character*16 mode
define character*256 cmname
if (.not.exist(gosupport%first)) then
   define integer gosupport%first gosupport%last /global
   define logical gosupport%aborted gosupport%old /global
   define logical gosupport%interactive /global
endif
let gosupport%first first
let gosupport%last last
let gosupport%aborted no
let gosupport%old no
let gosupport%interactive no
if (pro%narg.eq.0) then
   let mode 'gosupport%kind'
else
   let mode &1
endif
if (mode.eq."?".or.mode.eq."help") then
   @ support-help
   return
end if
let cmname 'name'".lmv-clean"
if (.not.file(cmname).and..not.exist(clean)) then
   message e support "Clean image not found, impossible to proceed"
   return
end if
if (mode.eq."init") then
   @ support-init
else if (mode.eq."write") then
   @ support-write
   say "Type ''go support visualize'' to inspect it"
   let type msk
else if (mode.eq."read") then
   @ support-read
else if (mode.eq."polygon") then ! From widget polygon
   @ support-init
   @ support-edit add polygon
   @ support-write
   @ support-cleanup 
else if (mode.eq."rectangle") then
   @ support-init
   @ support-edit add rectangle 'gosupport%center[1]' 'gosupport%center[2]' 'gosupport%major' 'gosupport%minor' 'gosupport%pa'
   @ support-write
   @ support-cleanup 
else if (mode.eq."ellipse") then
   @ support-init
   @ support-edit add ellipse 'gosupport%center[1]' 'gosupport%center[2]' 'gosupport%major' 'gosupport%minor' 'gosupport%pa'
   @ support-write
   @ support-cleanup 
else if (mode.eq."visualize") then
   let type msk
   @ p_bit
   let type lmv-clean
else if (mode.eq."over") then
   let nimages 2
   let nreference 1
   let types[1] lmv-clean
   let types[2] msk
   let names 'name'
   @ p_over
else if (mode.eq."add".or.mode.eq."rm") then
   if (pro%narg.eq.7) then
      @ support-edit &1 &2 &3 &4 &5 &6 &7
   else if (pro%narg.eq.2) then
      @ support-edit &1 &2
   else if (pro%narg.eq.3) then
      @ support-edit &1 &2 &3      
   else
      message e support "Incorrect number of inputs."
      @ support-errorinput 'mode'
   end if
else if (mode.eq."interactive") then
   let cmname 'name'.msk
   let gosupport%interactive yes
   if (file(cmname)) then
      sic copy 'name'.msk 'name'.oldmsk
      @ support-read      
      let gosupport%old yes
   else
      @ support-init
   end if
   if (pro%narg.eq.2) then
      @ support-interactive &2
   else
      @ support-interactive 1
   end if
   if (.not.gosupport%aborted) @ support-write
   @ support-cleanup 'mode'
   if (gosupport%old) then
      if (gosupport%aborted) then
         delete /var supmask
         sic copy 'name'.oldmsk 'name'.msk
      endif
      sic delete 'name'.oldmsk
   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%first gosupport%last gosupport%aborted gosupport%old gosupport%interactive
