!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! GREG emulation of MVIEW.
!     Called by GO VIEW with argument VUE
!     Called by Mapping with argument W + some others
!
! Needed improvements:
!    1. Slice color problem.
!    2. compute min and max should correctly handle the blanking value.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
if (.not.exist(view_root)) then
   define character view_root*16 /global
   define integer view_iprint /global
   let view_iprint 0
   define integer upixel[2] old_ixy old_mxy ciplane miplane[2] /global
   define real velocities[2] xspectre[2] cspectre[2] mspectre[2] /global
   define double frequencies[2] /global
   let upixel 0
   define logical through_mask /global
   define logical first_time do_flux do_window do_extrema view_contour /global
   define logical ima_rcoord spe_rcoord kill unkill szoom vzoom /global
   define structure mm /global
   define real area_range[2] total_width center_velocity /global
   define real mm%min mm%max view_jyperk /global
   define real civelo /global
   define double cifreq frange[2] /global
   define real syscale[2] myscale[2] /global
   let through_mask no
   let first_time yes
   let view_contour no
   let kill no
   let unkill no
   let szoom no
   let vzoom no
   let ima_rcoord no
   let spe_rcoord no
   let old_ixy 0
   let old_mxy 0
   let ciplane 0
   !
   define logical view_side /global
   let view_side yes
endif
if (.not.exist(do_write)) then
   define logical do_write /global
   let do_write no
endif
if (.not.exist(boxes)) then
   define real boxes[4,4] /global
   define char cbox*8[5] /global
endif
let cbox "area" "mean" "channel" "spectrum" "outside"
if (.not.exist(gbox)) then
   define char gbox*10[17] /global
   !            1        2      3          4        5       6       7      8         9
   let gbox "flux" "window" "spectrum" "channel" "slice" "movie" "zoom" "unzoom" "extract" -
            "view-help" "view" "mask" "print" "value"  "view-write" "scale" "full"
   !            10        11     12      13      14         15        16      17
endif
if (exist(ulimit)) then
   delete /var ulimit
endif
define real ulimit[3] /global
let ulimit 0
!
let view_root &1
!
if (&1%angle.ne.0) then
   let ima_rcoord yes
else
   let ima_rcoord no
endif
!
if ((page_x.ne.30).or.(page_y.ne.21)) then
   greg1\set plot landscape
   say "go view: ensure a landscape plot page"
endif
!
if (.not.first_time) then
   if .not.exist(&1__first) then
     define integer &1__first &1__last /global
     define real &1__size[2] /global
     let &1__first -1
   endif
   if ((&1%dim[3].gt.1).and.((first.ne.last).or.(first.eq.0))) then
      let do_extrema 'has_changed'
      if ((&1__first.ne.first).or.(&1__last.ne.last)) then
        let do_extrema yes
      endif
      let do_flux yes
      let do_window yes
      @ view-help
      @ get_plane 'view_root'
      @ get_corner
      @ view 'view_root'
      if (do_loop) then
         @ loop
      endif
      let &1__first first
      let &1__last last
   else
      @ p_lmv_map.greg 'view_root' 0 &2 &3
   endif
   let &1__size size
   return
else
   @ window_tools
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! General purpose procedures
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure sub_box
  !
  define integer ibox
  let ibox &2
  !
  let inter 0
  let aspect_ratio yes
  let aspect abs(((itrc[1]-iblc[1]+1)*&1%convert[3,1])/((itrc[2]-iblc[2]+1)*&1%convert[3,2]))
  if (ibox.eq.1) then
     let position 0.17 0.72 0.075 0.49
  else if (ibox.eq.2) then
     let position 0.86 1.30 0.075 0.49; let aspect 1.0
  else if (ibox.eq.3) then
     let position 0.17 0.72 0.54 0.955
  else if (ibox.eq.4) then
     let position 0.86 1.30 0.54 0.955; let aspect 1.0
  endif
  @ window_xy 1 1 1
  !
  let boxes[ibox] 'box_xmin' 'box_xmax' 'box_ymin' 'box_ymax'
  !
end procedure sub_box
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure get_corner
  !
  @ p_corner.greg 'view_root' center size
  !
  sic output gag_scratch:poly.pol
    say 'rtrc[1]' 'rtrc[2]'
    say 'rtrc[1]' 'rblc[2]'
    say 'rblc[1]' 'rblc[2]'
    say 'rblc[1]' 'rtrc[2]'
  sic output
  if ("&1none".eq."plotnone") then
     gtvl\change directory <greg<channel
     greg2\polygon gag_scratch:poly /plot
     gtvl\change directory <greg<area
     greg2\polygon gag_scratch:poly /plot
     sic wait 1
  else
     greg2\polygon gag_scratch:poly
  endif
  !
end procedure get_corner
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure get_plane
  !
  ! Reset full image
  !
  define character dummy*32
  let dummy '&1%unit'"none"
  if (dummy.eq."none") then
     if (do_write) then
       say "go view: Please enter data cube unit"
       let &1%unit
     else
       say "go view: Warning, no data cube unit"
     endif
  endif
  delete /var dummy
  if (&1%ndim.ne.3) then
     say "go view error: input image is not a 3D cube"
     return base
  endif
  if ((&1%unit3.eq."frequency").or.(&1%unit3.eq."FREQUENCY")) then
     say "go view Warning: 3rd axis is Frequency"
     ! CHANGE THE AXIS TEMPORARILY
     if &1%rdonly then
       let &1 /status write
       let &1%convert[3,3] &1%velres
       let &1%convert[2,3] (&1%restfre-&1%convert[2,3])/&1%restfre*299792.458+&1%veloff
       let &1%unit3 "VELOCITY"
       let &1 /status read
     else
       let &1%convert[3,3] &1%velres
       let &1%convert[2,3] (&1%restfre-&1%convert[2,3])/&1%restfre*299792.458
       let &1%unit3 "VELOCITY"
     endif
  else if ((&1%unit3.ne."velocity").and.(&1%unit3.ne."VELOCITY")) then
     say "go view Warning: 3rd axis is not Velocity or Frequency"
     EXA &1%unit3
  endif
  if (&1%convert[3,3].eq.0.0) then
     say "go view error: velocity increment is equal to 0.0"
     return base
  endif
  !
  ! Following is not fully correct when range is outside the image boundaries
  ! which happen when loading two images with very different velocity ranges. ***
  !
  let miplane 1 &1%dim[3]
  if (range[1].ne.0.or.range[2].ne.0) then
     if (range[1].gt.range[2]) then
        define real dummy
        let dummy range[1]
        let range[1] range[2]
        let range[2] dummy
        delete /var dummy
     endif
     if (&1%convert[3,3].gt.0) then
        let miplane[1] (range[1]-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
        let miplane[2] (range[2]-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
     else
        let miplane[1] (range[2]-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
        let miplane[2] (range[1]-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
     endif
     let miplane[1] max(1,miplane[1])
     let miplane[2] min(&1%dim[3],miplane[2])
     !
     ! Protect against bad input ranges
     if miplane[1].gt.miplane[2] then
        say "W-VIEW,  Invalid input range " range[1] range[2]  /format a F13.2 F13.2 a
        let miplane 1 &1%dim[3]
        if (&1%convert[3,3].gt.0) then
           let range (miplane-&1%convert[1,3])*&1%convert[3,3]+&1%convert[2,3]
        else
           let range[2] (miplane[1]-&1%convert[1,3])*&1%convert[3,3]+&1%convert[2,3]
           let range[1] (miplane[2]-&1%convert[1,3])*&1%convert[3,3]+&1%convert[2,3]
        endif
     endif
  endif
  !
end procedure get_plane
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure side
  gtvl\gtv search <vside
  if (.not.gtv%exist) then
     gtvl\create direct <vside /plot_page 10 10 /geometry 256 256 /pos 100% 100%
     gtvl\change directory <vside
     greg1\set box 0 10 0 10
  else
     gtvl\change directory <vside
     gtvl\clear directory
  endif
end procedure
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure view
  !
  ! Does not anymore change window position on purpose to ease comparison
  ! of two sessions
  !
  gtvl\change directory <greg
  gtvl\clear directory
  !
  greg1\limits sblc[1] strc[1] sblc[2] strc[2] seconds
  !
  define real rlimit[3] rmin rmax ymin ymax
  define integer imin imax ixy mxy ix iy ibox
  let ixy &1%dim[3] ! Always use the full stuff
  if (ixy.ne.old_ixy) then
     delete /var velocities frequencies
     define real velocities[ixy] /global
     define double frequencies[ixy] /global
     let old_ixy ixy
  endif
  let mxy miplane[2]-miplane[1]+1
  if (mxy.ne.old_mxy) then
     delete /var xspectre cspectre mspectre
     define real xspectre[mxy] cspectre[mxy] mspectre[mxy] /global
     let old_mxy mxy
  endif
  define double vrange[2] dv vlimit[3] irange[2]
  !!! define double frange[2]
  !
  ! Definition of used velocity range
  !
  let velocities[ic] (ic-&1%convert[1,3])*&1%convert[3,3]+&1%convert[2,3]
  let frequencies -(velocities-&1%veloff)*&1%restfre/299792.458+&1%restfre
  let vrange[1] min(velocities['miplane[1]'],velocities['miplane[2]'])
  let vrange[2] max(velocities['miplane[1]'],velocities['miplane[2]'])
  let dv (vrange[2]-vrange[1])*0.02
  let vrange[1] vrange[1]-dv
  let vrange[2] vrange[2]+dv
  !
  ! Get the Frequency range
  if (&1%spec.ne.0) then
    if (&1%restfre.gt.0) then
      !  let frange (vrange-&1%convert[2,3])*&1%freqres/&1%convert[3,3]+&1%restfre
      !  Use more general formula (does not assume that restfre == reference pixel)
      let frange -(vrange-&1%veloff)*&1%restfre/299792.458+&1%restfre
    else
      let frange vrange
    endif
  else
    let frange vrange
  endif
  !
  ! And the spectrum
  let xspectre velocities['miplane[1]':'miplane[2]']
  !
  ! Definition of selected velocity channel
  !
  let vlimit ulimit
  if (ulimit[1].eq.0.and.ulimit[2].eq.0) then
     let vlimit[1] velocities['miplane[1]']
     let vlimit[2] velocities['miplane[2]']
  endif
  if (ulimit[3].eq.0) then
     let vlimit[3] (vlimit[1]+vlimit[2])/2
  endif
  let rlimit (vlimit-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
  let rlimit max(miplane[1],rlimit)
  let rlimit min(rlimit,miplane[2])
  sic\compute rmin min rlimit[1:2]
  sic\compute rmax max rlimit[1:2]
  let imin rmin
  let imax rmax
  let ciplane rlimit[3]
  let civelo  vlimit[3]
  if (&1%spec.ne.0) then
    ! let cifreq  (ciplane-&1%convert[1,3])*&1%freqres+&1%restfre
    ! Use more general formula (does not assume that restfre == reference pixel)
    let cifreq -(civelo-&1%veloff)*&1%restfre/299792.458+&1%restfre
    say "Channel " ciplane   civelo  cifreq /format A I6 F10.2 F14.3
  else
    say "Channel " ciplane   civelo  /format A I6 F10.2
  endif
  !
  ! Definition of selected pixel
  !
  if (upixel[1].le.0) then
     let ix (&1%dim[1]+1)/2
  else
     let ix min(&1%dim[1],upixel[1])
  endif
  if (upixel[2].le.0) then
     let iy (&1%dim[2]+1)/2
  else
     let iy min(&1%dim[2],upixel[2])
  endif
  !
  ! Kill or unkill selected pixel when asked
  !
  if (kill) then
     let &1[ix,iy,] &1%blank[1]
     let do_flux yes
     let do_window yes
     let do_extrema yes
     let kill no
  else if (unkill) then
     let &1[ix,iy,] b[ix,iy,]
     let do_flux yes
     let do_window yes
     let do_extrema yes
     let unkill no
  endif
  if (do_extrema) then
     !
     ! Fast code using compact actions
     sic\compute mm%min min &1['iblc[1]':'itrc[1]','iblc[2]':'itrc[2]','miplane[1]':'miplane[2]'] /blank &1%blank[1] &1%blank[2]
     sic\compute mm%max max &1['iblc[1]':'itrc[1]','iblc[2]':'itrc[2]','miplane[1]':'miplane[2]'] /blank &1%blank[1] &1%blank[2]
     greg2\rgdata &1['iblc[1]':'itrc[1]','iblc[2]':'itrc[2]','miplane[1]'] /var
  endif
  !
  ! Integrated image
  !
  if (do_window) then
     if exist(area_ima) then
        delete /var area_ima
     endif
     define real area_ima /like &1[1] /global
     let area_ima 0
     !
     ! Fast code using compiled action
     if  &1%blank[2].ge.0 then
       sic\compute area_ima sum &1[imin:imax] /blank &1%blank[1] &1%blank[2]
       if (&1%convert[3,3].ne.0.0) then
         let area_ima area_ima*abs(&1%convert[3,3]) /where area_ima.ne.&1%blank[1]
       endif
     else
       sic\compute area_ima sum &1[imin:imax]
       if (&1%convert[3,3].ne.0.0) then
         let area_ima area_ima*abs(&1%convert[3,3])
       endif
     endif
     let do_window no
  endif
  !
  ! Compute local extrema
  if (do_extrema) then
     if .not.exist(area_max) then
        define real area_max area_min /global
     endif
     sic\compute area_min min area_ima['iblc[1]':'itrc[1]','iblc[2]':'itrc[2]'] /blank &1%blank[1] &1%blank[2]
     sic\compute area_max max area_ima['iblc[1]':'itrc[1]','iblc[2]':'itrc[2]'] /blank &1%blank[1] &1%blank[2]
     if ((area_range[1].eq.0).and.(area_range[2].eq.0)) then
        let area_range[1] area_min
        let area_range[2] area_max
     endif
     let do_extrema no
  endif
  !
  ! Plot Box 1 (Integrated image)
  gtvl\change directory <greg
  let ibox 1
  gtvl\create directory 'cbox[ibox]'
  gtvl\change directory 'cbox[ibox]'
  @ sub_box 'view_root' 'ibox'
  define real bound[4]
  let bound (0.5-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1] -
            (&1%dim[1]+0.5-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1] -
            (0.5-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2] -
            (&1%dim[2]+0.5-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2]
  if (through_mask) then
     greg2\rgdata area_ima /var /subset iblc[1] iblc[2] itrc[1] itrc[2]
     greg1\limits /rg
     greg2\plot /scal lin area_min area_max
     greg2\levels 'area_range[1]' 'area_range[2]'
     greg2\rgmap quiet /abs 1.0
     greg1\limits sblc[1] strc[1] sblc[2] strc[2] seconds
     greg2\wedge right /levels
  else
!
! Do NOT contour the Integrated Area image
!    if (view_contour) then
!      greg2\rgdata area_ima /var /subset iblc[1] iblc[2] itrc[1] itrc[2]
!      greg1\limits /rg
!      greg2\levels 1 to 9
!      greg2\rgmap quiet /per 10
!      greg1\limits sblc[1] strc[1] sblc[2] strc[2] seconds
!    else
      greg2\plot area_ima /bound bound[1] bound[2] bound[3] bound[4] /scal lin area_min area_max
      greg2\wedge right
!    endif
  endif
  greg1\draw text 4 0 "Area ("'&1%unit'".km/s)" 5 90 /CHAR 6
  if (exist(poly%nxy)) then
     if (poly%nxy.gt.3) then
        greg2\polygon /plot
     endif
  endif
  if (ima_rcoord) then
     greg1\box /unit sec
     greg1\label "Relative coordinates (Arcsec)" /X
  else
     greg1\box /abs
     greg1\label "Absolute coordinates" /X
  endif
  !
  ! Selected velocity channel
  !
  gtvl\change directory <greg
  let ibox 3
  gtvl\create directory 'cbox[ibox]'
  gtvl\change directory 'cbox[ibox]'
  @ sub_box 'view_root' 'ibox'
  if (syscale[1].ne.0.and.syscale[2].ne.0) then
    let ymin syscale[1]
    let ymax syscale[2]
  else
    let ymin mm%min
    let ymax mm%max
  endif
  if (view_contour) then
    greg2\rgdata &1[ciplane] /var !!  area_ima /var /subset iblc[1] iblc[2] itrc[1] itrc[2]
    greg2\rgmap quiet /abs 1
  else
    greg2\plot &1[ciplane] /scal lin ymin ymax
    greg2\wedge right
  endif
  if (ima_rcoord) then
     greg1\box /unit sec
  else
     greg1\box /abs
  endif
  !
  ! Moved 30-Jan-2016
  define logical flux
  let flux no
  if (&1%major.ne.0) then
    define character u_unit*12
    let u_unit '&1%unit' /upper
    let flux u_unit.eq."JY/BEAM"
    exa u_unit
    exa &1%unit
    delete /var u_unit
    if (flux) then
      let view_jyperk &1%major*&1%minor/4./log(2.0)
      let view_jyperk 2.0*1.38e3*pi*view_jyperk|(2.99792458e8|&1%restfre*1e-6)^2
    endif
  endif
  !
  ! Begin SG 30 Jan-2016
  if (view_side) then
    @ side
    define character string*16
    define double rx ry
    define character*24 cx cy
    !
    if (exist(menu)) then
      gui\panel "View panel" no-help.txt
      sic\let name 'name' /prompt "File name (without extension)"
      say
      say "Channel  " ciplane  "  "         /format A12 I16   A12
      say "Velocity " civelo   " km/s"  /format A12 F16.3 A12
      if (&1%spec.ne.0) then
        say "Frequency  " cifreq " MHz" /format A12 F16.3 A12
      endif
      ! Pixel  (ix,iy)
      say "Pixel " "("'ix'","'iy'")"    /format A12 A16 A12
      ! Offset
      let rx (ix-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1]
      let ry (iy-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2]
      let cx rx/sec /format f0.2
      let cy ry/sec /format f0.2
      say "Offset "  "("'cx'","'cy'")" "arcsec" /format A12 A16 A12
      ! Intensity    ("'&1%unit'")"
      say "Value " &1[ix,iy,ciplane] " ("'&1%unit'")" /format A12 1PG16.3 A12
      if (flux) then
        say "Value " &1[ix,iy,ciplane]/view_jyperk " (K)" /format A12 1PG16.3 A12
      endif
      gui\go
    else
      ! Channel
      greg1\draw text 0 -1 "Channel "'ciplane' 6 0 /CHAR 7
      ! Velocity
      greg1\draw text 0 -2.5 "Velocity "'0.01*nint(100*civelo)'" km/s"  6 0 /CHAR 7
      ! Write the alternate Frequency axis
      if (&1%spec.ne.0) then
        let string cifreq /format F16.3
        greg1\draw text 0 -4 "Freq. "'string'" MHz"  6 0 /CHAR 7
      endif
      ! Pixel  (ix,iy)
      greg1\draw text 0 -5.5 "Pixel ("'ix'","'iy'")" 6 0 /char 7
      ! Offset
      let rx (ix-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1]
      let ry (iy-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2]
      let cx rx/sec /format f0.2
      let cy ry/sec /format f0.2
      greg1\draw text 0 -7 "Offset ("'cx'"`,"'cy'"`)" 6 0 /char 7
      ! Intensity    ("'&1%unit'")"
      let string &1[ix,iy,ciplane] /format 1pg11.3
      greg1\draw text 0 -8.5 "Value "'string'" ("'&1%unit'")" 6 0 /char 7
      if (flux) then
        let string &1[ix,iy,ciplane]/view_jyperk /format 1pg11.3
        greg1\draw text 0 -10 "Value "'string'" (K)" 6 0 /char 7
      endif
    endif
    ! Clean-up
    delet /var string cx cy rx ry
    gtvl\chang direc <greg
  else
    greg1\draw text 4 0 "Channel "'ciplane'" ("'&1%unit'")" 5 90 /CHAR 6
    !
    ! Write the alternate Frequency axis
    greg1\draw text 5.5 0 '0.01*nint(100*civelo)'" km/s"  6 90 /CHAR 3
    if (&1%spec.ne.0) then
      define character string*16
      let string cifreq /format F16.3
      greg1\draw text 5.5 0 'string'" MHz"  4 90 /CHAR 9
      delet /var string
    endif
  endif
  ! End SG 30-Jan-2016
  !
  ! Plot Box 2: Mean spectrum
  !
  gtvl\change directory <greg
  let ibox 2
  gtvl\create directory 'cbox[ibox]'
  gtvl\change directory 'cbox[ibox]'
  @ sub_box 'view_root' 'ibox'
  if (through_mask) then
    define integer local_mask /like area_ima
    let local_mask 1
    let local_mask 0 /where area_ima.ge.area_range[1].and.area_ima.le.area_range[2]
  endif
  define integer j
  if (do_flux) then
     if (through_mask) then
        ! Fast code using compiled action..
        SAY "Using SPECTRUM command -- With Mask"
        if (flux) then
          g\spectr mspectre &1 local_mask /corner 'iblc[1]' 'itrc[1]' 'iblc[2]' 'itrc[2]' -
            /plane miplane[1] miplane[2] /sum
        else
          g\spectr mspectre &1 local_mask /corner 'iblc[1]' 'itrc[1]' 'iblc[2]' 'itrc[2]' -
            /plane miplane[1] miplane[2] /mean
        endif
     else
        ! Fast code using compiled action
        SAY "Using SPECTRUM command -- no mask"
        if (flux) then
          g\spectr mspectre &1 /corner 'iblc[1]' 'itrc[1]' 'iblc[2]' 'itrc[2]' -
            /plane miplane[1] miplane[2] /sum
        else
          g\spectr mspectre &1 /corner 'iblc[1]' 'itrc[1]' 'iblc[2]' 'itrc[2]' -
            /plane miplane[1] miplane[2] /mean
        endif
     endif
     if (flux) then
        ! Convert to flux density
        let mspectre mspectre|pi|&1%major|&1%minor*4*log(2)
     endif
     let do_flux no
  endif
  !
  ! Velocity / Channel / Frequency axis
  if (spe_rcoord) then
     let irange  (vrange-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
     if (myscale[1].ne.0.and.myscale[2].ne.0) then
       greg1\limits irange[1] irange[2] myscale[1] myscale[2]
     else
       greg1\limits irange[1] irange[2] * * /var xspectre mspectre
     endif
     greg1\box p n
     greg1\label "Velocity (channel number)" /X
  else
     if (myscale[1].ne.0.and.myscale[2].ne.0) then
       greg1\limits vrange[1] vrange[2] myscale[1] myscale[2]
     else
       greg1\limits vrange[1] vrange[2]  * * /var xspectre mspectre
     endif
     greg1\box p n
     greg1\label "Velocity (km.s\\u-1\\d)" /X
  endif
  greg1\axis yr /label o
  greg1\limits vrange[1] vrange[2]  = =
  if (flux) then
     greg1\draw text 3 0 "Integrated Flux (Jy)" 5 90 /char 6
  else
     greg1\draw text 3 0 "Mean Spectrum ("'&1%unit'")" 5 90 /char 6
  endif
  !
  ! Shaded histogram in defined velocity range
  define integer kxy
  let kxy imax-imin+1
  define real vv[kxy] ss[kxy]
  let vv velocities[imin:imax]
  define integer jmin jmax
  let jmin imin-miplane[1]+1
  let jmax imax-miplane[1]+1
  let ss mspectre[jmin:jmax]
  greg1\histogram vv ss /fill 5 /base 0
  !
  ! Compute integrated flux
  define real tflux
  define charac cflux*12
  sic\compute tflux sum ss
  if (imax.gt.1) then
    let tflux tflux*abs(velocities[imax]-velocities['imax-1'])
  else
    let tflux tflux*abs(velocities[imin]-velocities['imin+1'])
  endif
  !
  ! To set the integrated area bandwidth
  let total_width velocities[imax]-velocities[imin]
  let center_velocity (velocities[imax]+velocities[imin])/2.0
  !
  let cflux tflux /format 1PG11.3
  if (flux) then
     greg1\draw text 0 -1 'cflux'" (Jy.km/s)" 5 0 /char 8
  else
     greg1\draw text 0 -1 'cflux'" ("'&1%unit'".km/s)" 5 0 /char 8
  endif
  !
  greg1\histogram xspectre mspectre
  delete /var vv ss
  !
  ! Plot 4
  ! Spectrum corresponding to selected pixel
  !
  gtvl\change directory <greg
  let ibox 4
  gtvl\create directory 'cbox[ibox]'
  gtvl\change directory 'cbox[ibox]'
  @ sub_box 'view_root' 'ibox'
  !
  let cspectre &1[ix,iy,'miplane[1]':'miplane[2]']
  !
  ! Velocity / Channel / Frequency axis
  if (syscale[1].ne.0.and.syscale[2].ne.0) then
    let ymin syscale[1]
    let ymax syscale[2]
  else
    define real margin
    let margin (mm%max-mm%min)*0.05  ! 5%
    let ymin mm%min-margin
    let ymax mm%max+margin
    del /variable margin
  endif
  if (spe_rcoord) then
     let irange  (vrange-&1%convert[2,3])/&1%convert[3,3]+&1%convert[1,3]
     greg1\limits irange[1] irange[2] ymin ymax
     greg1\axis xl
     greg1\axis xu
  else
     greg1\limits frange[1] frange[2] ymin ymax  !Frequency
     define real oldsize
     let oldsize character_size
     g\set char 'min(oldsize,0.45)'  ! At most 0.45 to avoid overlapping labels
     greg1\axis xl
     g\set char oldsize
     delete /var oldsize
     greg1\axis xu
  endif
  if (flux) then
    greg1\limits = = user_ymin|view_jyperk user_ymax|view_jyperk  !Frequency
    label "T\\dmb\\u (K)" /y 2
    greg1\axis yl /label o
  else
    greg1\axis yl /label n
  endif
  !
  greg1\limits vrange[1] vrange[2] ymin ymax
  greg1\axis yr /label o
  if (flux) then
     greg1\draw text 3 0 "Flux (Jy/beam)" 5 90 /char 6
  else
     greg1\draw text 3 0 "Spectrum ("'&1%unit'")" 5 90 /char 6
  endif
  !
  ! Write down the selected pixel coordinates
  greg1\draw text -1 -1 "("'ix'","'iy'")" 1 /char 9
  define double rx ry
  let rx (ix-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1]
  let ry (iy-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2]
  define character*24 cx cy
  let cx rx/sec /format f0.2
  let cy ry/sec /format f0.2
  greg1\draw text 1 -1 "("'cx'"`,"'cy'"`)" 3 /char 7
  !
  ! Vertical line to indicate selected velocity channel
  greg1\pencil 1
  greg1\draw relo vlimit[3] user_ymin /user
  greg1\draw line vlimit[3] user_ymax /user
  greg1\pencil 0
  greg1\histogram xspectre cspectre
  !
  ! Lines to indicate the selected pixel
  gtvl\change directory <greg<'cbox[4]'
  greg1\draw relo user_xmin user_ymin /user
  gtvl\change directory <greg<'cbox[3]'
  greg1\draw line (ix-&1%convert[1,1])*&1%convert[3,1]+&1%convert[2,1] -
            (iy-&1%convert[1,2])*&1%convert[3,2]+&1%convert[2,2] /user
  gtvl\change directory <greg<'cbox[4]'
  greg1\draw line user_xmin user_ymax /user
  gtvl\change directory <greg
  greg1\draw relo 0 0
  !
  let position 0.17 1.30 0.075 0.955
  let aspect_ratio no
  @ window_xy 1 1 1
  define character text*256
  let text "  \\iS:\\i "'&1%source'
  let text 'text'"  \\iL:\\i "'&1%line'
  let text 'text'"  "'1d-6*nint(&1%restfre*1000)'" GHz"
  define char vframe*20
  if (&1%vtype.eq.1) then
    let vframe "LSR"
  else if (&1%vtype.eq.2) then
    let vframe "Hel"
  else if (&1%vtype.eq.3) then
    let vframe "Obs"
  else if (&1%vtype.eq.4) then
    let vframe "Ear"
  else if (&1%vtype.eq.0) then
    let vframe "Unk"
  else
    let vframe "(not recognized)"
  endif
  let text 'text'" @ "'nint(&1%veloff*10)/10'" km/s "'vframe'
  if (&1%major.ne.0) then
    define double imajor iminor ipa
    if (&1%minor/sec.gt.1.0) then
      let imajor 0.1*nint(&1%major/sec*10)
      let iminor 0.1*nint(&1%minor/sec*10)
      let ipa nint(&1%pa*180.0/pi)
    else
      let imajor 0.01*nint(&1%major/sec*100)
      let iminor 0.01*nint(&1%minor/sec*100)
      let ipa nint(&1%pa*180.0/pi)
    endif
    if (&1%minor.eq.&1%major) then
      let text 'text'"  \\iB:\\i "'imajor'
    else
      let text 'text'"  \\iB:\\i "'imajor'" x "'iminor'" PA "'ipa'"^"
    endif
  endif
  greg1\draw text -1.2 1 'text' 5 /char 8
  greg1\draw text -5.5 0 'header_name_type' 5 90 /char 4
!!  greg1\draw text -5.5 0 'name'"."'type' 5 90 /char 4
  !
end procedure view
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure view-help
  say " "
  say "Authors: J.Pety & S.Guilloteau"
  say "Position-independent actions:"
  say "   Press E key: EXIT loop"
  say "   Press H key: HELP display"
  say "   Press M key: MOVIE"
  say "   Press P key: PRINT plot in ""ha"" subdirectory"
  say "   Press Q key: QUIT loop"
  say "   Press X key: EXTRACT on disk current zoomed region"
  say "Position-dependent actions:"
  say "   Cursor on images:"
  say "      Left  clic: Display spectrum at pointed position"
  say "      Right clic: Define a polygon"
  say "      Press C key: COORDINATES toggled from absolute to relative and back"
  say "      Press S key: SLICE definition (velocity-position)"
  say "      Press K key: KILL   pointed pixel"
  say "      Press U key: UNKILL pointed pixel"
  say "      Press Z key: ZOOM defined spatial region"
  say "      Press B key: BACK to full field of view"
  say "      Press V key: Display map coordinates at current position (the associated brightness value is wrong)"
  say "      Press W key: WRITE Integrated Area image"
  say "   Cursor on spectra:"
  say "      Left  clic in Selected   Spectrum: Display selected velocity channel"
  say "      Left  clic in Integrated Spectrum: Define velocity range"
  say "      Right clic in Selected   Spectrum: Define its intensity scale on Y axis"
  say "      Right clic in Integrated Spectrum: Define its intensity scale on Y axis"
  say "      Press C key: COORDINATES toggled from freq/velo to channels and back"
  say "      Press Z key: ZOOM defined velocity region"
  say "      Press B key: BACK to full velocity range"
  say "      Press F key: FULL intensity scale on current spectrum"
  say "      Press W key: WRITE Integrated (and current) Spectrum"
  say "   Cursor outside plots:"
  say "      Press B key: BACK to full velocity range AND full field of view"
  say "      Press F key: FULL intensity scales on all spectra"
  say "Known problems:"
  say "   1. Velocity range may be wrong when successively using go view on 2"
  say "      different cubes"
  say " "
end procedure view-help
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure loop
  !
  define integer ibox jbox jaction
  define logical loop
  let loop yes
  for /while loop
     gtvl\change directory <greg
     greg1\draw relo
     let ibox 0
     for i 1 to 4
        if ((x_pen.ge.boxes[1,i]).and.(x_pen.le.boxes[2,i])) then
           if ((y_pen.ge.boxes[3,i]).and.(y_pen.le.boxes[4,i])) then
              let ibox i
           endif
        endif
     next
     !
     ! First global behavior, then position-dependant behavior
     !
!     exa cursor_code
     if (cursor_code.eq."X") then
        let jaction 9
     else if (cursor_code.eq."H") then
        let jaction 10
     else if (cursor_code.eq."M") then
        let jaction 6
     else if (cursor_code.eq."P") then
        let jaction 13
     else if ((cursor_code.eq."Q").or.(cursor_code.eq."E")) then
        let loop no ! Exit the loop
     else if ((ibox.eq.1).or.(ibox.eq.3)) then
        ! 1: Area, 3: Channel
        if (cursor_code.eq."C") then
           let ima_rcoord .not.ima_rcoord  ! Swap
           let jaction 11
        else if (cursor_code.eq."Z") then
           let szoom yes
           let jaction 7
        else if (cursor_code.eq."B") then
           let szoom yes
           let jaction 8
        else if (cursor_code.eq."K") then
          if (do_write) then
            let kill yes
            let jaction 3
          else
            say "KILL only possible in DO_WRITE mode"
            let jaction 3
          endif
        else if (cursor_code.eq."U") then
          if (do_write) then
            let unkill yes
            let jaction 3
          else
            say "UNKILL only possible in DO_WRITE mode"
            let jaction 3
          endif
        else if (cursor_code.eq."S") then
           let jaction 5
        else if (cursor_code.eq."L") then
           if (through_mask) then
              let through_mask no
           else
              let through_mask yes
           endif
           let do_flux yes
           let jaction 11
        else if (cursor_code.eq."*") then
           if (through_mask) then
              let jaction 12
           else
              let jaction 1
           endif
        else if (cursor_code.eq."V") then
           let jaction 14
        else if (cursor_code.eq."W") then
           let jaction 15 ! Write some of the files...
        else ! Default behavior
           let jaction 3
        endif
     else if ((ibox.eq.2).or.(ibox.eq.4)) then
        ! 2: Mean, 4: Spectrum
        if (cursor_code.eq."C") then
           let spe_rcoord .not.spe_rcoord  ! Swap
           let jaction 11
        else if (cursor_code.eq."Z") then
           let vzoom yes
           let jaction 7
        else if (cursor_code.eq."B") then
           let vzoom yes
           let jaction 8
        else if (cursor_code.eq."W") then
           let jaction 15  ! Write some of the files...
        else if (cursor_code.eq."*") then
           let jaction 16
        else if (cursor_code.eq."F") then
           let jaction 17
        else ! Default behavior
           let jaction 'ibox'
        endif
     else if (ibox.eq.0) then
        ! 0: outside plotting area
        if (cursor_code.eq."B") then
           let vzoom yes
           let szoom yes
           let jaction 8
        else if (cursor_code.eq."F") then
           let jaction 17
        else ! Exit the loop
           let loop no
        endif
     else
        say "Should not be here: ibox = "'ibox'
     endif
     if (loop) then
        if (ibox.eq.0) then
           let jbox 5
        else
           let jbox ibox
        endif
        say "Box "'ibox'" "'cbox[jbox]'";  Action "'gbox[jaction]'
        ! Pass view_root as well
        @ 'gbox[jaction]' 'view_root' 'ibox' 'jaction'
     endif
  next
  !
end procedure loop
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Specific action procedures
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure value
  define integer test
  let test 0&2
  gtvl\change directory <greg<'cbox[test]'
  g\draw value * *
end procedure value
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure channel
  !
  define integer test
  let test 0&2
  if (test.eq.0) then
     gtvl\change directory <greg<spectrum
     say "Select current channel"
     greg1\draw relo
  else
     gtvl\change directory <greg<'cbox[test]'
     greg1\draw relo * *
  endif
  let ulimit[3] use_curs[1]
  @ view 'view_root'
  !
end procedure channel
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure flux
  !
  define integer test
  let test 0&2
  if (test.eq.0) then
     gtvl\change directory <greg<area
  else
     gtvl\change directory <greg<'cbox[test]'
     greg1\draw relo * *
  endif
  say "Define polygon"
  greg2\polygon
  let do_flux yes
  @ view 'view_root'
  !
end procedure flux
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure mask
  !
  define integer test
  let test 0&2
  gtvl\change directory <greg<area
  limits = = area_min area_max
  say "Select lower limit"
  greg1\draw relo
  let area_range[1] use_curs[2]
  say "Set upper limit"
  greg1\draw relo
  let area_range[2] use_curs[2]
  if (area_range[1].gt.area_range[2]) then
     define real dummy
     let dummy area_range[2]
     let area_range[2] area_range[1]
     let area_range[1] dummy
  endif
  let do_flux yes
  @ view 'view_root'
  !
end procedure mask
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure window
  !
  define integer test
  let test 0&2
  gtvl\change directory <greg<mean
  if (test.eq.0) then
     say "Select lower limit"
     greg1\draw relo
  else
     greg1\draw relo * *
  endif
  let ulimit[1] use_curs[1]
  say "Set upper limit"
  greg1\draw relo
  let ulimit[2] use_curs[1]
  let do_window yes
  let do_extrema yes
  @ view 'view_root'
  !
end procedure window
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure zoom
  !
  ! Either spatial or velocity zoom
  !
  define integer test
  let test 0&2
  define logical local_loop
  let local_loop yes
  if (vzoom) then
     gtvl\change directory <greg<'cbox[test]'
     for /while local_loop
        say "Select lower limit"
        greg1\draw relo
        let range[1] use_curs[1]
        say "Set upper limit"
        greg1\draw relo
        let range[2] use_curs[1]
        if (range[1].ne.range[2]) then
           let local_loop no
        else
           say "Window size must be > 0.0."
        endif
     next
     @ get_plane 'view_root'
     let do_flux yes
     let vzoom no
  else if (szoom) then
     @ get_szoom 'view_root' 'test'
  endif
  let do_extrema yes
  @ view 'view_root'
  !
end procedure zoom
!
begin procedure get_szoom
  define integer trc[2] blc[2] pix_size[2] pix_cent[2]
  gtvl\change directory <greg<'cbox[&2]'
  define logical local_loop
  let local_loop yes
  for /while local_loop
    say "Select top, right corner"
    greg1\draw relo
    let trc pix_curs
    say "Select bottom, left corner"
    greg1\draw relo
    let blc pix_curs
    if ((blc[1].ne.trc[1]).and.(blc[2].ne.trc[2])) then
       let local_loop no
    else
       say "Area of zoom rectangle must be > 0.0."
    endif
  next
  !
  let pix_size (trc-blc)
  let pix_cent (trc+blc)/2
  let upixel pix_cent
  !
  let center &1%convert[2,1:2]+(pix_cent-&1%convert[1,1:2])*&1%convert[3,1:2]
  let size   abs(pix_size*&1%convert[3,1:2])
  let size size/sec
  let center center/sec
  !
  @ get_corner "plot"
  let do_flux yes
  let szoom no
end procedure get_szoom
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure unzoom
  !
  ! 3 possibilities: velocity, spatial or both unzoom
  !
  if (vzoom) then
     let range 0
     @ get_plane 'view_root'
     let do_window yes
     let vzoom no
  endif
  if (szoom) then
     let size 0
     let center 0
     @ get_corner
     let szoom no
  endif
  let do_flux yes
  let do_extrema yes
  @ view 'view_root'
  !
end procedure unzoom
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure scale
  !
  ! Y intensity scale for selected spectrum and channel
  !
  define integer test
  let test 0&2
  define logical local_loop
  let local_loop yes
  define real my_yscale[2]
  gtvl\change directory <greg<'cbox[test]'
  for /while local_loop
    say "Set lower intensity value from Y axis"
    greg1\draw relo
    let my_yscale[1] use_curs[2]
    say "Set upper intensity value from Y axis"
    greg1\draw relo
    let my_yscale[2] use_curs[2]
    if (my_yscale[1].ne.my_yscale[2]) then
      let local_loop no
    else
      say "Intensity scale must have non null range"
    endif
  next
  if test.eq.2 then  ! 2: Mean spectrum
    let myscale my_yscale
  else  ! 4: Selected spectrum
    let syscale my_yscale
  endif
  @ get_plane 'view_root'
  let do_extrema no
  @ view 'view_root'
  !
end procedure scale
!
begin procedure full
  !
  ! Back to full Y scale(s)
  !
  define integer test
  let test 0&2
  !
  if test.eq.2 then  ! 2: Mean spectrum
    let myscale 0
  else if test.eq.4 then  ! 4: Selected spectrum
    let syscale 0
  else
    let syscale 0
    let myscale 0
  endif
  let do_extrema yes
  @ view 'view_root'
  !
end procedure full
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure spectrum
  !
  define integer test
  let test 0&2
  if (test.eq.0) then
     gtvl\change directory <greg<channel
     say "Select current spectrum"
     greg1\draw relo
  else
     gtvl\change directory <greg<'cbox[test]'
     greg1\draw relo * *
  endif
  let upixel pix_curs
  @ view 'view_root'
  !
end procedure spectrum
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure slice
  !
  say " "
  say "Position-velocity diagram"
  say " "
  if (.not.exist(slice)) then
     define real slice[2,2] /global
  endif
  define integer test
  let test 0&2
  if (test.eq.0) then
     gtvl\change directory <greg<channel
  else
     gtvl\change directory <greg<'cbox[test]'
  endif
  say "Select lower slice limit"
  greg1\draw relo
  let slice[1,1] 12*(&1%a0+use_curs[1]/cos(&1%d0))/pi
  let slice[2,1] 180*(&1%d0+use_curs[2])/pi
  say "Select upper slice limit"
  greg1\draw line
  let slice[1,2] 12*(&1%a0+use_curs[1]/cos(&1%d0))/pi
  let slice[2,2] 180*(&1%d0+use_curs[2])/pi
  vector\run slice gag_scratch:view-slice.init /nowindow
  gtv search <slice
  if (.not.gtv%exist) then
     create direct <slice /plot_page 20 20 /geometry 256 256
  endif
  gtvl\change dir <slice
  gtvl\clear dir
  gtvl\clear alpha
  vector\header 'name'.xy /extrema
  define ima b 'name'.xy read
  greg1\limits /rgdata b
  greg1\set box square
  greg2\plot b
  greg1\box n n n
  greg1\axis yl
  greg1\axis yr
  greg1\axis xl /unit sec
  greg1\axis xu /unit sec
  greg1\label "Offset (`)" /X
  greg1\draw text -3 0 "Velocity (km.s\\u-1\\d)" 5  90 /char 4
  gtvl\change dir <greg
  !
  ! Force reloading of the image afterward, in particular its projection
  ! system and angle
  let do_extrema yes
  !
end procedure slice
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure movie
  !
  define integer ilast jlast
  define real ttot
  let ttot 5.  ! Should be customizable by user
  define real rwait
  let rwait ttot/(abs(miplane[2]-miplane[1])+1)
  let rwait rwait-0.003  ! The netto code has about 3 msec penalty per plane (empirical value)
  let ilast miplane[1]
  let jlast ilast-miplane[1]+1
  for i miplane[1] to miplane[2]
     gtvl\change directory <greg<channel
     greg2\plot &1[i] /scal lin mm%min mm%max
     gtvl\change directory <greg<spectrum
     greg1\pencil /col 8
     greg1\draw relo velocities[ilast] user_ymin /user
     greg1\draw line velocities[ilast] cspectre[jlast] /user
     greg1\pencil /col 0
     let ilast i
     let jlast ilast-miplane[1]+1
     greg1\draw relo velocities[ilast] user_ymin /user
     greg1\draw line velocities[ilast] cspectre[jlast] /user
     if (rwait.ge.0.001) then
        sic wait rwait
     endif
  next
  greg1\pencil /col 8
  greg1\draw relo velocities[ilast] user_ymin /user
  greg1\draw line velocities[ilast] cspectre[jlast] /user
  greg1\pencil /col 0
  !
  ! Restore the defined channel
  !
  if (ciplane.ne.0) then
     gtvl\change directory <greg<channel
     sic wait rwait
     greg2\plot &1[ciplane] /scal lin mm%min mm%max
     if (ima_rcoord) then
        greg1\box /unit sec
     else
        greg1\box /abs
     endif
  endif
  gtvl\change directory <greg
  !
end procedure movie
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure extract
  !
  if (view_root.eq."W") then
    say "E-VIEW, Cannot extract from Mapping buffers"
    return
  endif
  !
  define logical doit
  let doit (iblc[1].eq.1).and.(iblc[2].eq.1).and.(miplane[1].eq.1)
  let doit doit.and.(itrc[1].eq.&1%dim[1]).and.(itrc[2].eq.&1%dim[2]).and.(miplane[2].eq.&1%dim[3])
  if (doit) then
     say "go view: extracted cube will be identical to originale one => abort"
  else
     vector\run extract gag_scratch:view-extract.init /nowindow
     say " "
     say "go view: sub-cube "'name'"-ext."'type'" successfully extracted"
     say " "
  endif
  !
end procedure extract
!
begin procedure view-write
  if pro%arg[2].eq."1" then !  Mean area
    say "Saving integrated area file in view-area.gdf"
    define image a view-area.gdf real /like area_ima
    let a% &1%
    let a area_ima
    if (&1%convert[3,3].ne.0.0) then
      let a%unit '&1%unit'".km/s"
      let a%freqres = a%freqres*total_width/a%velres
      let a%velres = total_width
      let a%convert[1,3] = 1.0d0
      let a%convert[2,3] = center_velocity
      let a%veloff = center_velocity
    endif
    delete /variable a
    v\header view-area.gdf /extrema
  else if (pro%arg[2].eq."2") then
    if (old_mxy.eq.0) return
    say "Saving integrated & current spectrum table in view-spectre.tab"
    define table a[old_mxy,3] view-spectre.tab real
    let a[1] xspectre
    let a[2] mspectre
    let a[3] cspectre
  endif
end procedure view-write
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure print
  !
  if .not.file(ha) then
     sic mkdir ha
  endif
  let view_iprint view_iprint+1
  ha "ha/view-"'view_iprint' /dev eps color
  say " "
  say "go view: EPS file available as ha/view-"'view_iprint'".eps"
  say " "
  !
end procedure print
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin data gag_scratch:view-slice.init
  !
  ! Parameter file for SLICE task
  !
  task\file "Input file name" INPUT_MAP$ 'name'.'type'
  task\file "Output file name" OUTPUT_MAP$ 'name'.xy
  task\character "Starting point" START$ 'slice[1,1]'" "'slice[2,1]'
  task\character "Ending point" END$ 'slice[1,2]'" "'slice[2,2]'
  task\go
  !
end data gag_scratch:view-slice.init
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin data gag_scratch:view-extract.init
  !
  ! Parameter file for EXTRACT task
  !
  task\file "Input file name"  Y_NAME$ 'name'"."'type'
  task\file "Output file name" X_NAME$ 'name'"-ext."'type'
  task\integer "Bottom left corner" BLC$[4] 'iblc[1]' 'iblc[2]' 'miplane[1]' 0
  task\integer "Top right corner"   TRC$[4] 'itrc[1]' 'itrc[2]' 'miplane[2]' 0
  task\integer "Position of one pixel in input image"   PIXEL_IN$[4]  'iblc[1]' 'iblc[2]' 'miplane[1]' 1
  task\integer "Position of this pixel in output image" PIXEL_OUT$[4] 1 1 1 1
  task\logical "Initialize output image" INITIALIZE$ YES
  SAY "If YES, Fill information Below"
  task\integer "Dimensions of output image" X_DIM$[4]  0 0 0 0
  task\logical "Initialize with input file's blanking value" BLANKOUT$ YES
  task\real "Initialization value [1 real]" INITVAL$ 0
  task\go
  !
end data gag_scratch:view-extract.init
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
let first_time no
define integer &1__first &1__last /global
define real &1__size[2] /global
if ((&1%dim[3].gt.1).and.((first.ne.last).or.(first.eq.0))) then
   let do_extrema yes
   let do_flux yes
   let do_window yes
   @ view-help
   @ get_plane 'view_root'
   @ get_corner
   @ view 'view_root'
   if (do_loop) then
      @ loop
   endif
   &1__first = first
   &1__last = last
else
   let beam_type " "
   let extra " "
   @ p_lmv_map.greg 'view_root' 0 &2 &3
   &1__first = -1
   &1__last = -1
endif
&1__size = size
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
