!------------------------------------------------------------------------
! @ P_HEADER.GREG  Image_Variable
!
! Procedure to plot header information for contour plots and others
! Variables defined in DEFINE.GRAPHIC
!
! Created R.Lucas 10-may-1990
! Revised S.Guilloteau 29-Jul-1990
! Converted to the Image Variable format later
! Revised S.Guilloteau 23-Jul-2008   Use an internal variable for "mark"
!------------------------------------------------------------------------
on error return
!
define character text*40 text2*30 text3*20 mymark*16
define logical landscape
define real sigma
define real k__line
if .not.exist(do_box) then
   define real boxs xbox ybox  /global
   define logical do_box  /global
   let do_box .true.
endif
!
let landscape page_x.gt.page_y
if (.not.do_box).and.(boxs.gt.0) then
  if (landscape) then
    greg1\set box xbox+boxs page_x ybox page_y-0.1
  else
    greg1\set box xbox xbox+boxs ybox+boxs page_y-0.1
  endif
else
  let xbox 6*character_size ! was 5
  let ybox 3*character_size
  if (landscape) then
    let boxs min(page_x-0.1-xbox-12*character_size,page_y-ybox-0.1) ! was 13
    if (boxs.lt.0) then
        message f header "Page to small - change page or decrease character size"
      quit all
    endif
    greg1\set box xbox+boxs page_x ybox page_y-0.1
  else
    let boxs min(page_x-xbox-0.1,page_y-13*character_size-0.1)
    if (boxs.lt.0) then
      message f header "Page to small - change page or decrease character size"
      quit all
    endif
    greg1\set box xbox xbox+boxs ybox+boxs page_y-0.1
  endif
endif
if (do_header) then
  define real y_step
  let y_step 0.8
  greg1\box n n n
  greg1\set expand 1.0
                                !
  !! let text 'name'.'type'
  !! greg1\draw text .5 -1 'text' 6 /box 7
  greg1\draw text .5 -y_step 'header_name_type' 6 /box 7
  greg1\set expand 0.8
                                !
  let text "\\iSource:\\i "'&1%source'
  greg1\draw text .5 -2*y_step 'text' 6 /box 7
                                !
  let text "\\iLine:\\i "'&1%line'
  greg1\draw text .5 -3*y_step 'text' 6 /box 7
                                !
  let text "\\iFrequency:\\i "'1d-6*nint(&1%restfre*1000)'" GHz"
  greg1\draw text .5 -4*y_step 'text' 6 /box 7
                                !
  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 "\\iVsys:\\i "'nint(&1%veloff*100)/100'" km/s "'vframe'
  greg1\draw text .5 -5*y_step 'text' 6 /box 7
                                !
  if (&1%major.ne.0) then
    define real rmajor rminor factor
    let rmajor &1%major/sec
    let rminor &1%minor/sec
    ! Ensure 3 significant digits
    if (rminor.gt.10.0) then
      let factor 10
    else if (rminor.gt.1.0) then
      let factor 100
    else if (rminor.gt.0.1) then
      let factor 1000
    else
      let factor 10000
    endif
    define integer imajor iminor ipa
    let imajor nint(rmajor*factor)
    let iminor nint(rminor*factor)
    let ipa nint(&1%pa*180.0/pi)
    let text "\\iBeam:\\i "'imajor/factor'" x "'iminor/factor'" PA "'ipa'"^"
    define real lambda jyperk
    let lambda 2.99792458e8|&1%restfre*1e-6
    let jyperk 2.0*1.38e3*pi*&1%major*&1%minor|4.|log(2.0)|lambda^2
  else
    let text "\\iBeam:\\i (no clean beam)"
  endif
  greg1\draw text .5 -6*y_step 'text' 6 /box 7
                                !
  define character sic_precis*8
  let sic_precis 'sic%precision'
                                !
  let space_type 'space_type' /upper
  if (spacing.lt.0).or.(space_type.eq."USER") then
    let text "\\iLevels :\\i ("'&1%unit'")"
    greg1\draw text .5 -7*y_step 'text' 6 /box 7
    sic precision single
    define integer j jmax
    if (.not.exist(greg%levels)) then
      message f header "LEVEL command should be used before running this procedure"
      return
    endif
    define double levels /like greg%levels
    let levels greg%levels
    let j 1
    let k__line 8*y_step
    let text " "
    greg1\set char character_size*0.8
    if (landscape) then
       let jmax 5
    else
       let jmax 10
    endif
    for i 1 to greg%nlevel
      if (levels[i].gt.&1%min.and.levels[i].lt.&1%max) then
        let text 'text'" "'levels[i]'
        if (j.eq.jmax) then
           greg1\draw text .5 -k__line text 6 /box 7
           let j 1
           let k__line k__line+0.70
           let text " "
        else
           let j j+1
        endif
      endif
    next
    if (j.ne.1) then
      greg1\draw text .5 -k__line text 6 /box 7
      let k__line k__line+y_step
    else
      let k__line k__line+0.30
    endif
    greg1\set char character_size*1.25
  else
    sic precis single
    let text2 " "
    if (&1%unit.eq."Jy".or.&1%unit.eq."Jy/beam") then
      if (&1%major.ne.0) then
        let jyperk = true_spacing|jyperk
        if (&1%unit.eq."Jy") then
          let text "Jy "
        else
          let text "Jy/beam"
        endif
        let text2 '0.01*nint(jyperk*100.)'" K "
      else
        let text '&1%unit'
      endif
    else
      let text '&1%unit'
    endif
!
    defin double range expo mant round_spacing
    if (true_spacing.gt.0.1) then
      let range = log10(true_spacing)
      let expo = int(range+20.)-21
      let mant = range-expo+1
      let round_spacing 0.1*nint(10^mant)*10^expo
      let text "\\iLevel step:\\i "'round_spacing'" "'text'
    else if (true_spacing.gt.0) then
      let range = log10(true_spacing*1e3)
      let expo = int(range+20.)-21
      let mant = range-expo+1
      let round_spacing 0.1*nint(10^mant)*10^expo
      let text "\\iLevel step:\\i "'round_spacing'" m"'text'
    endif
    if (&1%noise.ne.0.and.true_spacing.ne.0) then
      let sigma true_spacing/&1%noise
      let range = log10(sigma)
      let expo = int(range+20.)-21
      let mant = range-expo+1
      let round_spacing 0.1*nint(10^mant)*10^expo
      let text3 'round_spacing'
      if (text2.eq." ") then
        let text2 "            --  "'text3'" \gs"
      else
        let text2 "  "'text2'"   --  "'text3'" \gs"
      endif
    endif
    greg1\draw text .5 -7*y_step 'text' 6 /box 7
    greg1\draw text .5 -8*y_step 'text2' 6 /box 7
    let k__line 9*y_step
  endif
  sic precision 'sic_precis'
  !
  ! the exact spelling of the LET commands is no longer mandatory
  ! (MARK is in several widget menus which are unfortunately
  ! sometimes UPPER case
  ! and sometimes lower case).
  let mymark 'mark' /upper
  if (mymark.ne."CHANNEL".and.mymark.ne."NONE") then
    if (&1%unit3.eq."RA") then
      let mymark "RA Offset"
    else if (&1%unit3.eq."DEC") then
      let mymark "DEC Offset"
    else if (mark.ne."FREQUENCY") then
      let mymark "VELOCITY"
    endif
  endif
  let text "\\iBox marking:\\i "'mymark'
  greg1\draw text .5 -k__line 'text' 6 /box 7
  let text "\\iChannels:\\i ["'first'","'last'"]"
  greg1\draw text .5 -k__line-y_step text 6 /box 7
                                !
  sic\sic date
  if (landscape) then
    greg1\draw text 0.0 2.0 "'SYS_INFO'" 5 0 /box 2
    greg1\draw text 0.0 1.0 "'SYS_DATE'" 5 0 /box 2
  else
    greg1\draw text -1.0 0.0 "'SYS_INFO'" 5 90 /box 4
    greg1\draw text -2.0 0.0 "'SYS_DATE'" 5 90 /box 4
  endif
                                !
endif                         ! DO_HEADER
greg1\set box xbox xbox+boxs ybox ybox+boxs
! BOX N N N
!
