!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! @ q-old-4view
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
if .not.exist(view%first_time) then
   if exist(view) then
      delete /var view
   endif
   define structure view /global
   define logical view%first_time /global
   !
   define structure view%comp /global
   define logical view%comp%spec view%comp%mean view%comp%area view%comp%extr /global
   !
   define integer view%iprint view%imap1 view%imap2 view%ispe1 view%ispe2 /global
   define integer view%i_xy view%i_vy view%i_xv view%i_sp view%i_ou view%i_pa /global
   !
   define character view%panels*8[5] view%name*512 /global
   define character view%coord*3[2] view%scoord*3[2] view%vcoord*3[3] /global
   !
   define double view%scale[2] view%arange[2] view%bounds[4,4] /global
   !
   let view%first_time yes
   let view%panels "xy" "vy" "xv" "spectrum" "outside"
   let view%i_xy 1
   let view%i_vy 2
   let view%i_xv 3
   let view%i_sp 4
   let view%i_ou 5
   let view%i_pa 5
   !
   let view%coord "abs" "rel"
   let view%scoord "abs" "pix"
   let view%vcoord "vel" "fre" "pix"
   let view%imap1 1
   let view%imap2 1
   let view%ispe1 1
   let view%ispe2 1
   let view%iprint 0
   !
   let view%comp%spec yes
   let view%comp%mean yes
   let view%comp%area yes
   let view%comp%extr yes
   !
   define logical view%slice_mode view%thres_mode /global
   let view%slice_mode no
   let view%thres_mode no
   !
endif
!
let view%name 'name'
let view%first_time yes
if (.not.view%first_time) then
   let view%comp%extr yes
   let view%comp%mean yes
   let view%comp%area yes
   @ 4view-load
   @ 4view-help
   @ 4view-view
   @ 4view-loop
   return
else
   ! VVV not sure what to put on the else
   !   @ window-tools.cube
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! General purpose procedures
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-load
  !
  go\oldload 'name' /syntax hgdf /in aaa1
  if exist(aaa1_velocities) then
     delete /var aaa1_velocities
  endif
  define double aaa1_velocities['aaa1%dim[3]'] /global
  let aaa1_velocities[i] (i-aaa1%convert[1,3])*aaa1%convert[3,3]+aaa1%convert[2,3]
  !
  ! Sanity checks
  define character dummy*32
  let dummy 'aaa1%unit'"none"
  if (dummy.eq."none") then
     message i 4view "Please input data cube unit"
     let aaa1%unit
  endif
  delete /var dummy
  if (aaa1%ndim.ne.3) then
     message w 4view "Input image is not a 3D cube => Default to GO NICE"
     @ p-old-nice.cube
     return
  endif
  if (aaa1%f_axis.ne.3) then
     message e 4view "3rd axis is not velocity"
     return base
  endif
  if (aaa1%convert[3,3].eq.0.0) then
     message e 4view "Velocity increment is equal to 0.0"
     return base
  endif
  !
  if ((page_x.ne.30).or.(page_y.ne.21)) then
     greg1\set plot landscape
     message w 4view "Ensure a landscape plot page"
  endif
  !
end procedure 4view-load
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-panel
  !
  gtvl\change directory <greg
  gtvl\create directory 'view%panels[&1]'
  gtvl\change directory 'view%panels[&1]'
  define real myaspect
  !
  let myaspect abs((true%prange%s[2,1]-true%prange%s[1,1])/(true%prange%s[2,2]-true%prange%s[1,2]))
  set\panel 1 /def /inter 0 /fixed trc /aspect 'myaspect'
  !
  if (&1.eq.view%i_xv) then
     if (myaspect.gt.1.0) then
        let myaspect 1.0
     endif
     set\panel /aspect 'myaspect' /position 0.20 0.635 0.56 0.995
  else if (&1.eq.view%i_sp) then
     set\panel /position 0.86 1.295 0.56 0.995 /aspect 1
  else if (&1.eq.view%i_xy) then
     set\panel /position 0.20 0.635 0.075 0.51
  else if (&1.eq.view%i_vy) then
     if (myaspect.lt.1.0) then
        let myaspect 1.0
     endif
     set\panel /aspect 'myaspect' /position 0.86 1.295 0.075 0.51
  endif
  !
  set\panel 1 /nxy 1
  !
  ! Panel boundaries must be updated as the image aspect may have changed
  let view%bounds[&1] 'box_xmin' 'box_xmax' 'box_ymin' 'box_ymax'
  !
end procedure 4view-panel
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-view
  !
  ! Does not anymore change window position on purpose to ease comparison
  ! of two sessions
  gtvl\change directory <greg
  gtvl\clear
  !
  ! 1. Analyze input parameters
  !
  define double loc_range[2]
  !
  ! Working subcube
  @ l-old-prange.cube aaa1 center size
  @ l-old-vrange.cube aaa1 range true%vrange
  @ l-old-corner.cube aaa1
  ! Velocity window
  let loc_range min(true%vrange%v[1],true%vrange%v[2]) max(true%vrange%v[1],true%vrange%v[2])
  if ((do%win[1].ne.0).or.(do%win[2].ne.0)) then
     for iedge 1 to 2
        let do%win[iedge] min(max(do%win[iedge],loc_range[1]),loc_range[2])
     next
  else
     let do%win range
  endif
  @ l-old-vrange.cube aaa1 do%win true%win
  @ l-old-layout.cube aaa1 "1d" true%win%p[1] true%win%p[2] 1
  !
  ! Selected channel
  if ((do%chan.lt.loc_range[1]).or.(loc_range[2].lt.do%chan)) then
     let do%chan 0.5*(loc_range[1]+loc_range[2])
  endif
  @ l-old-channel.cube aaa1 do%chan V
  ! Selected position
  for iaxis 1 to 2
     let loc_range min(true%prange%s[1,iaxis],true%prange%s[2,iaxis]) max(true%prange%s[1,iaxis],true%prange%s[2,iaxis])
     if ((do%pos[iaxis].lt.loc_range[1]).or.(loc_range[2].lt.do%pos[iaxis])) then
        let do%pos[iaxis] 0.5*(loc_range[1]+loc_range[2])
     endif
  next iaxis
  @ l-old-position.cube aaa1 do%pos true%pos
  !
  ! 2. Compute when needed
  !
  ! area%map and area%mask
  if (view%comp%area) then
     @ c-old-area.cube "inter"
     let view%comp%area no
  endif
  ! Subcube and area%map extrema
  if (view%comp%extr) then
     sic\compute view%scale[1] min aaa1['true%blc[1]':'true%trc[1]','true%blc[2]':'true%trc[2]','true%blc[3]':'true%trc[3]']
     sic\compute view%scale[2] max aaa1['true%blc[1]':'true%trc[1]','true%blc[2]':'true%trc[2]','true%blc[3]':'true%trc[3]']
     sic\compute area%map%min min area%map['true%blc[1]':'true%trc[1]','true%blc[2]':'true%trc[2]']
     sic\compute area%map%max max area%map['true%blc[1]':'true%trc[1]','true%blc[2]':'true%trc[2]']
     let view%comp%extr no
  endif
  ! Mean spectrum
  if (view%comp%mean) then
     if (view%thres_mode) then
        ! Threshold mode => Remove polygon and define threshold mask first
        ! Remove polygon (there is no easy way...)
        if exist(poly%nxy) then
           define double xygons[1,2]
           greg2\polygon xygons /var
        endif
        ! Define mask
        if exist(mask) then
           delete /var mask
        endif
        define integer mask /like aaa1[1] /global
        if exist(area%mask) then
           ! Recover area mask
           let mask area%mask
        else
           ! Everybody is good by default
           let mask 0
        endif
        ! Mark as additional bad pixels the ones outside the view%arange
        let mask 1 /where (area%map.lt.view%arange[1].or.view%arange[2].lt.area%map)
        ! Compute using only mask
        @ c-old-mean-spectrum.cube mask "inter"
     else
        ! Restore polygon
        if exist(view%poly%xy) then
           greg2\polygon view%poly%xy /var
        endif
        ! Compute using area%mask and polygon
        @ c-old-mean-spectrum.cube area%mask "inter"
     endif
     let view%comp%mean no
  endif
  ! Single spectrum
  if (view%comp%spec) then
     @ c-old-get-spectrum.cube "inter"
     let view%comp%spec no
  endif
  !
  ! 3. Plot
  !
  ! 3.1 Integrated area
  !
  @ 4view-panel 'view%i_xy'
  ! Image
  greg1\limits true%prange%r[1,1] true%prange%r[2,1] true%prange%r[1,2] true%prange%r[2,2]
  greg2\rgdata area%map /var /subset 'true%blc[1]' 'true%blc[2]' 'true%trc[1]' 'true%trc[2]'
  greg2\plot area%map /scal lin area%map%min area%map%max
  ! Contours + Wedge
  if (view%thres_mode) then
     ! Contours
     greg2\levels 'view%arange[1]' 'view%arange[2]'
     greg2\rgmap quiet /abs 1.0
     ! Wedge
     greg2\wedge right /levels
  else
     ! Polygon if possible
     if (exist(poly%nxy)) then
        if (poly%nxy.ge.3) then
           greg2\polygon /plot
        endif
     endif
     ! Wedge
     greg2\wedge right
  endif
  ! Box + legend
  greg1\draw text 4 0 "Area ("'aaa1%unit'".km/s)" 5 90 /char 6
  let do%lab%yp "*" "*"
  let do%leg%xt "*"
  let do%leg%yt "*"
  let do%leg%yp 0
  let do%coord  'view%coord[view%imap1]'
  let do%scoord 'view%scoord[view%imap2]'
  if (do%scoord.eq."pix") then
     greg1\limits true%prange%p[1,1] true%prange%p[2,1] true%prange%p[1,2] true%prange%p[2,2]
  endif
  @ l-old-box-setup.cube area%map image
  @ l-old-box.cube label
  if (do%scoord.eq."pix") then
     greg1\limits true%prange%r[1,1] true%prange%r[2,1] true%prange%r[1,2] true%prange%r[2,2]
  endif
  !
  !
  @ 4view-panel 'view%i_xv'
  if exist(xv) then
     delete /var xv
  endif
  define image xv "*" real /like aaa1[,1,] /global
  let xv% aaa1%
  let xv%convert[1] aaa1%convert[1]
  let xv%convert[2] aaa1%convert[3]
  let xv%convert[3] 0 0 0
  let xv%x_axis 1
  let xv%y_axis 0
  let xv%f_axis 2
  let xv%unit1 'aaa1%unit1'
  let xv%unit2 'aaa1%unit3'
  let xv%unit3 "UNKNOWN"
  let xv aaa1[,'true%pos%p[2]',]
  greg1\limits true%prange%r[1,1] true%prange%r[2,1] true%vrange%v[1] true%vrange%v[2]
  greg2\rgdata xv /var /subset 'true%blc[1]' 'true%blc[3]' 'true%trc[1]' 'true%trc[3]'
  greg2\plot xv /scal lin view%scale[1] view%scale[2]
  let do%leg%xt " "
  @ l-old-box-setup.cube xv image
  @ l-old-box.cube label
  greg2\wedge
  !
  !
  !
  @ 4view-panel 'view%i_vy'
  if exist(vy) then
     delete /var vy
  endif
  define image vy['aaa1%dim[3]','aaa1%dim[2]'] "*" real /global
  define real yv /like aaa1[1,,]
  let yv aaa1['true%pos%p[1]',,]
  vector\transpose yv vy 21
  let vy% aaa1%
  let vy%convert[1] aaa1%convert[3]
  let vy%convert[2] aaa1%convert[2]
  let vy%convert[3] 0 0 0
  let vy%x_axis 0
  let vy%y_axis 2
  let vy%f_axis 1
  let vy%unit1 'aaa1%unit3'
  let vy%unit2 'aaa1%unit2'
  let vy%unit3 "UNKNOWN"
  greg1\limits true%vrange%v[1] true%vrange%v[2] true%prange%r[1,2] true%prange%r[2,2]
  greg2\rgdata vy /var /subset 'true%blc[3]' 'true%blc[2]' 'true%trc[3]' 'true%trc[2]'
  greg2\plot vy /scal lin view%scale[1] view%scale[2]
  let do%leg%xt "*"
  let do%leg%yt " "
  @ l-old-box-setup.cube vy image
  @ l-old-box.cube label
  greg2\wedge
  !
  ! 3.3 Mean spectrum
  !
  @ 4view-panel 'view%i_sp'
  ! Setup layout
  let do%fill yes
  let do%coord  'view%coord[view%ispe1]'
  let do%vcoord 'view%vcoord[view%ispe2]'
  let do%lab%yp "n" "o"
  let do%leg%xt "*"
  let do%leg%yt "*"
  let do%leg%yp 19
  let mark "none"
  let scale 0
  if .not.exist(mean_spectrum%wmin) then
     define integer mean_spectrum%wmin mean_spectrum%wmax /global
  endif
  if (true%step[1].gt.0) then
     let mean_spectrum%wmin true%first[1]-true%blc[3]+1
     let mean_spectrum%wmax  true%last[1]-true%blc[3]+1
  else
     let mean_spectrum%wmin  true%last[1]-true%blc[3]+1
     let mean_spectrum%wmax true%first[1]-true%blc[3]+1
  endif
  ! Plot
  @ l-old-plot-spectrum.cube mean_spectrum
  !
  ! 3.4 Spectrum corresponding to selected pixel
  !
!!$  @ 4view-panel 'view%i_sp'
!!$  ! Setup layout
!!$  let do%fill no
!!$  let do%leg%xt " "
!!$  let do%leg%yt "*"
!!$  let mark "*"
!!$  let scale view%scale
!!$  ! Plot
!!$  @ l-old-plot-spectrum.cube single_spectrum
!!$  ! Draw lines to indicate the selected pixel
!!$  gtvl\change directory <greg<'view%panels[view%i_spec]'
!!$  greg1\draw relo user_xmin user_ymin /user
!!$  gtvl\change directory <greg<'view%panels[view%i_chan]'
!!$  greg1\draw line 'true%pos%r[1]' 'true%pos%r[2]' /user
!!$  gtvl\change directory <greg<'view%panels[view%i_spec]'
!!$  greg1\draw line user_xmin user_ymax /user
!!$  ! Draw a vertical line to indicate selected velocity channel
!!$  gtvl\change directory <greg<'view%panels[view%i_spec]'
!!$  greg1\pencil 1
!!$  greg1\draw relo true%chan%v true%scale[1] /user
!!$  greg1\draw line true%chan%v true%scale[2] /user
!!$  greg1\pencil 0
  !
  ! Reset
  gtvl\change directory <greg
  greg1\draw relo 0 0
  !
end procedure 4view-view
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-help
  say " "
  say "   Press ? key: Display help"
  say "   Press E key: Exit loop"
  say "   Press H key: Hardcopy in ha subdirectory"
  say "   Press M key: Movie"
  say "   Press X key: Extract on disk current zoomed region"
  say "Position-dependent actions:"
  say "   Cursor on images:"
  say "      Left  click: Display spectrum at pointed position"
  say "      Right click: 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 "   Cursor on spectra:"
  say "      Left click in Selected   Spectrum: Display selected velocity channel"
  say "      Left click in Integrated Spectrum: Define velocity range"
  say "      Press C key: COORDINATES toggled from absolute to relative and back"
  say "      Press Z key: ZOOM defined velocity region"
  say "      Press B key: BACK to full velocity range"
  say "   Cursor outside plots:"
  say "      Press B key: BACK to full velocity range AND full field of view"
  say "Know problems:"
  say "   1. Making position-velocity diagram produces strange color problems."
  say "      Just exit greg and come back."
  say "   2. Velocity range may be wrong when successively using go view on 2"
  say "      different cubes"
  say " "
end procedure 4view-help
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-loop
  !
  define logical loop
  let loop yes
  for /while loop
     gtvl\change directory <greg
     greg1\draw relo
     let view%i_pa view%i_ou
     for ipanel 1 to 4
        if ((x_pen.ge.view%bounds[1,ipanel]).and.(x_pen.le.view%bounds[2,ipanel])) then
           if ((y_pen.ge.view%bounds[3,ipanel]).and.(y_pen.le.view%bounds[4,ipanel])) then
              let view%i_pa ipanel
           endif
        endif
     next ipanel
     !
     ! First global behavior, then position-dependant behavior
     !
!     exa cursor_code
     if (cursor_code.eq."X") then
        @ 4view-extract
     else if (cursor_code.eq."?") then
        @ 4view-help
     else if (cursor_code.eq."M") then
        @ 4view-movie
     else if (cursor_code.eq."H") then
        @ 4view-hard
     else if (cursor_code.eq."E") then
        let loop no ! Exit the loop
     else if (view%i_pa.eq.view%i_xy) then
        if (cursor_code.eq."C") then
           let view%imap1 mod(view%imap1,2)+1
           @ 4view-view
        else if (cursor_code.eq."D") then
           let view%imap2 mod(view%imap2,2)+1
           @ 4view-view
        else if (cursor_code.eq."Z") then
           @ 4view-zoom position
        else if (cursor_code.eq."B") then
           @ 4view-unzoom position
        else if (cursor_code.eq."K") then
           let view%kill yes
           @ 4view-spectrum
        else if (cursor_code.eq."U") then
           let view%unkill yes
           @ 4view-spectrum
        else if (cursor_code.eq."S") then
           if (view%slice_mode) then
              let view%slice_mode no
           else
              let view%slice_mode yes
           endif
           @ 4view-view
        else if (cursor_code.eq."L") then
           if (view%thres_mode) then
              let view%thres_mode no
           else
              let view%thres_mode yes
           endif
           let view%comp%mean yes
           @ 4view-view
        else if (cursor_code.eq."*") then ! Right click
           if (view%slice_mode) then
              @ 4view-slice "*"
           else if (view%thres_mode) then
              @ 4view-mean "thre"
           else
              @ 4view-mean "poly"
           endif
        else if (cursor_code.eq."R") then ! Left click
           if (view%slice_mode) then
              @ 4view-slice "R"
           else
              @ 4view-spectrum
           endif
!!$           @ 4view-rotate
        else if (cursor_code.eq."&") then ! Middle click
           if (view%slice_mode) then
              @ 4view-slice "&"
           endif
        endif
     else if (view%i_pa.eq.view%i_sp) then
        if (cursor_code.eq."C") then
           let view%ispe1 mod(view%ispe1,2)+1
           @ 4view-view
        else if (cursor_code.eq."D") then
           let view%ispe2 mod(view%ispe2,3)+1
           @ 4view-view
        else if (cursor_code.eq."Z") then
           @ 4view-zoom velocity
        else if (cursor_code.eq."B") then
           @ 4view-unzoom velocity
        else if (cursor_code.eq."N") then
           @ 4view-movie n
        else if (cursor_code.eq."P") then
           @ 4view-movie p
        else if (cursor_code.eq."R") then
           if (view%i_pa.eq.view%i_xy) then
              @ 4view-area
           else
              @ 4view-channel
           endif
        endif
     else if ((view%i_pa.eq.view%i_xv).or.(view%i_pa.eq.view%i_vy)) then
        if (cursor_code.eq."R") then ! Left click
           @ 4view-pv
        endif
     else if (view%i_pa.eq.view%i_ou) then
        if (cursor_code.eq."B") then
           @ 4view-unzoom both
        else if (cursor_code.eq."C") then
           let view%ispe1 mod(view%ispe1,2)+1
           let view%imap1 mod(view%imap1,2)+1
           @ 4view-view
        endif
     else
        message w 4view "Should not be here: view%i_pa = "'view%i_pa'
     endif
  next
  !
end procedure 4view-loop
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! Specific action procedures
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-channel
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  let do%chan use_curs[1]
  @ 4view-view
  !
end procedure 4view-channel
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-mean
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  if ("&1".eq."poly") then
     say "Define polygon"
     on error return
     greg2\polygon
     ! Save defined polygon
     if exist(view%poly%xy) then
        delete /var view%poly%xy
     endif
     define double view%poly%xy[poly%nxy,2] /global
     let view%poly%xy[1] poly%x
     let view%poly%xy[2] poly%y
  else if ("&1".eq."thre") then
     if (user_ymin.ne.user_ymax) then
        let view%arange[1] use_curs[2]
        say "Set upper limit"
        greg1\draw relo
        let view%arange[2] use_curs[2]
        let view%arange area%map%min+(area%map%max-area%map%min)*(view%arange-user_ymin)/(user_ymax-user_ymin)
        if (view%arange[1].gt.view%arange[2]) then
           define real dummy
           let dummy view%arange[2]
           let view%arange[2] view%arange[1]
           let view%arange[1] dummy
        endif
     else
        let view%arange area%map%min
     endif
  else
     return
  endif
  let view%comp%mean yes
  @ 4view-view
  !
end procedure 4view-mean
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-area
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  let do%win[1] use_curs[1]
  say "Set upper limit"
  greg1\draw relo
  let do%win[2] use_curs[1]
  let view%comp%extr yes
  let view%comp%area yes
  if (view%thres_mode) then
     let view%comp%spec yes
  endif
  @ 4view-view
  !
end procedure 4view-area
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-rotate
  !
  define double x y rho
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  let x use_curs[1]
  let y use_curs[2]
  greg1\draw relo 0 0 /user
  greg1\draw line x y /user
  let rho sqrt(x^2+y^2)
  if (rho.ne.0) then
     let angle atan2(x/rho,y/rho)*180/pi
  endif
  let name 'view%name'
  let angle aaa1%angle*180/pi-angle
exa angle
!  @ c-old-rot.cube
  let view%comp%area yes
  let view%comp%extr yes
  @ 4view-load
  @ 4view-view
  !
end procedure 4view-rotate
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-pv
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  if (view%i_pa.eq.view%i_xv) then
     let do%pos[1] use_curs[1]/sec
     let do%chan   use_curs[2]
  else if (view%i_pa.eq.view%i_vy) then
     let do%pos[2] use_curs[2]/sec
     let do%chan   use_curs[1]
  endif
  @ 4view-view
  !
end procedure 4view-pv
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-zoom
  !
  ! Either position or velocity zoom
  !
  define character kind*8
  let kind "&1" /lower
  !
  if (kind.eq."velocity") then
     ! Define zoom range
     gtvl\change directory <greg<'view%panels[view%i_pa]'
     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]
  else if (kind.eq."position") then
     ! Define zoom area
     gtvl\change directory <greg<'view%panels[view%i_pa]'
     define double blc[2] trc[2]
     say "Select top, right corner"
     greg1\draw relo
     let trc use_curs
     say "Select bottom, left corner"
     greg1\draw relo
     let blc use_curs
     let size   (trc-old-blc)/sec
     let center (trc+blc)/(2*sec)
     ! Visualize zoom area
     ! 1. Define space ranges associated to center and size
     @ l-old-prange.cube aaa1 center size
     ! 2. Define associated polygon
     define real xygons[4,2]
     let xygons[1,1:2] 'true%prange%r[2,1]' 'true%prange%r[2,2]'
     let xygons[2,1:2] 'true%prange%r[2,1]' 'true%prange%r[1,2]'
     let xygons[3,1:2] 'true%prange%r[1,1]' 'true%prange%r[1,2]'
     let xygons[4,1:2] 'true%prange%r[1,1]' 'true%prange%r[2,2]'
     ! 3. Load and plot
     gtvl\change directory <greg<xy
     greg2\polygon xygons /plot /var
     delete /var xygons
     sic wait 1
     ! Remove polygon
     if exist(view%poly%xy) then
        delete /var view%poly%xy
     endif
     define double view%poly%xy[1,2] /global
  endif
  let view%comp%spec yes
  let view%comp%mean yes
  let view%comp%extr yes
  @ 4view-view
  !
end procedure 4view-zoom
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-unzoom
  !
  ! 3 possibilities: unzoom velocity, position or both
  !
  define character kind*8
  let kind "&1" /lower
  !
  if ((kind.eq."velocity").or.(kind.eq."both")) then
     let range 0
     let view%comp%area yes
  endif
  if ((kind.eq."position").or.(kind.eq."both")) then
     let size 0
     let center 0
  endif
  let view%comp%spec yes
  let view%comp%mean yes
  let view%comp%extr yes
  @ 4view-view
  !
end procedure 4view-unzoom
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-spectrum
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  let do%pos use_curs/sec
  let view%comp%spec yes
  @ 4view-view
  !
end procedure 4view-spectrum
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-slice
  !
  gtvl\change directory <greg<'view%panels[view%i_pa]'
  greg1\draw relo * *
  if ("&1".eq."R") then ! Left click
     let do%slice[1] use_curs/sec
     greg1\draw relo do%slice[1,1] do%slice[2,1] /user sec
     greg1\draw line do%slice[1,2] do%slice[2,2] /user sec
  else if ("&1".eq."*") then ! Right click
     let do%slice[2] use_curs/sec
     greg1\draw relo do%slice[1,1] do%slice[2,1] /user sec
     greg1\draw line do%slice[1,2] do%slice[2,2] /user sec
  else ! Middle click
     let do%slice[1] use_curs/sec
     greg1\draw relo do%slice[1,1] do%slice[2,1] /user sec
     greg1\draw line
     let do%slice[2] use_curs/sec
  endif
  !
  gtvl\gtv search <slice
  if (.not.gtv%exist) then
     gtvl\create dir <slice /size 20 20 /pixel 380 380
  endif
  gtvl\change dir <slice
  gtvl\clear dir
  gtvl\clear alpha
  !
  let do%lab%yp "*" "*"
  let do%leg%yp -3
  let do%leg%xt "*"
  let do%leg%yt "*"
  !
  let scale view%scale
  @ c-old-slice.cube "inter"
  define double slice[2,2]
  let slice 0.01*nint(100*true%slice%s)
  greg1\draw text 0 1 "Slice from ("'slice[1,1]'"`,"'slice[2,1]'"`) to ("'slice[1,2]'"`,"'slice[2,2]'"`)" 5 0 /CHAR 8
  !
  gtvl\change dir <greg
  !
end procedure 4view-slice
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-movie
  !
  define character action*1
  let action "&1" /lower
  if (action.eq."n") then
     let true%chan%p true%chan%p+1
  else if (action.eq."p") then
     let true%chan%p true%chan%p-1
  endif
  if (true%chan%p.gt.true%trc[3]) then
     let true%chan%p true%blc[3]
  else if (true%chan%p.lt.true%blc[3]) then
     let true%chan%p true%trc[3]
  endif
  !
  gtvl\change directory <greg<spectrum
  gtvl\clear segment
  !
  gtvl\change directory <greg<xy
  gtvl\clear dir
  greg1\limits true%prange%r[1,1] true%prange%r[2,1] true%prange%r[1,2] true%prange%r[2,2]
  greg2\plot aaa1[true%chan%p] /scal lin view%scale[1] view%scale[2]
  greg2\wedge right
  greg1\draw text 4 0 "Channel "'true%chan%p'" ("'aaa1%unit'")" 5 90 /char 6
  let do%leg%xt " "
  let do%leg%yt " "
  let do%lab%yp "*" "*"
  @ l-old-box-setup.cube aaa1 image
  @ l-old-box.cube label
  !
  gtvl\change directory <greg<spectrum
  greg1\pencil 1
  greg1\draw relo aaa1_velocities[true%chan%p] true%scale[1] /user
  greg1\draw line aaa1_velocities[true%chan%p] true%scale[2] /user
  greg1\pencil 0
  !
  gtvl\change directory <greg
  !
end procedure 4view-movie
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-extract
  !
  @ c-old-extract.cube aaa1
  !
end procedure 4view-extract
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
begin procedure 4view-hard
  !
  if .not.file(ha) then
     sic mkdir ha
  endif
  let view%iprint view%iprint+1
  gtvl\hardcopy "ha/4view-"'view%iprint' /dev eps color
  say " "
  say "go view: EPS file available as ha/4view-"'view%iprint'".eps"
  say " "
  !
end procedure 4view-hard
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
let view%first_time no
let view%comp%extr yes
let view%comp%mean yes
let view%comp%area yes
@ 4view-load
@ 4view-help
@ 4view-view
if (do%loop) then
   @ 4view-loop
endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
