!------------------------------------------------------------------------
! @ p_header.ima  Image_Variable [Axis]
!
! 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"
! Revised S.Guilloteau 20-Jul-2017   Optional "mark" axis number
!------------------------------------------------------------------------
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
define integer g_axis
if pro%narg.eq.2 then
  let g_axis &2
else
  let g_axis 3
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 (.not.do_header) then
  greg1\set box xbox xbox+boxs ybox ybox+boxs
  return
endif
!
gtvl\create dir HEADER
gtvl\change dir HEADER
!
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 integer imajor iminor ipa
  if (&1%minor.gt.1.0) then
    let imajor nint(&1%major*180*3600|pi*10)
    let iminor nint(&1%minor*180*3600|pi*10)
    let ipa nint(&1%pa*180.0|pi)
    let text "\\iBeam:\\i "'0.1*imajor'" x "'0.1*iminor'" PA "'ipa'"^"
  else
    let imajor nint(&1%major*180*3600|pi*100)
    let iminor nint(&1%minor*180*3600|pi*100)
    let ipa nint(&1%pa*180.0|pi)
    let text "\\iBeam:\\i "'0.01*imajor'" x "'0.01*iminor'" PA "'ipa'"^"
  endif
  define real lwave jyperk
  let lwave 2.99792458e8|&1%restfre*1e-6
  let jyperk 2.0*1.38e3*pi*&1%major*&1%minor|4.|log(2.0)|lwave^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
if (spacing_rule%l.eq."USER").or.(spacing_rule%l.eq."LOG") 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.001*nint(jyperk*1000.)'" K "
    else
      let text '&1%unit'
    endif
  else
    let text '&1%unit'
  endif
!
  defin double range expo mant round_spacing
  sic precision double
  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
    sic precision single
    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
    sic precision single
    let text "\\iLevel step:\\i "'round_spacing'" m"'text'
  endif
  sigma = max(&1%noise,&1%rms)
  if (sigma.ne.0.and.true_spacing.ne.0) then
    let sigma true_spacing/sigma
    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
    sic precision single
    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'
!
! (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%unit'g_axis'.eq."RA") then
    let mymark "RA Offset"
  else if (&1%unit'g_axis'.eq."DEC") then
    let mymark "DEC Offset"
  else if (&1%f_axis.eq.'g_axis') then
    if (mark.ne."FREQUENCY") then
      let mymark "VELOCITY"
    endif
  else
    let mymark &1%unit'g_axis' /Format A
  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
gtvl\change dir <GREG
!
greg1\set box xbox xbox+boxs ybox ybox+boxs
! BOX N N N
!
