sic prec double
on error return
if (exist(xheader__name)) then
  delete /var xheader__name
endif
if (exist(hds_)) then
  delete /var hds_
endif
!
sic\define character xheader__name*132 /global
if ("XXXX&1".eq."XXXX") then
  @ x_getfilename.greg xheader__name " " ".gdf"
  on error return
  define header hds 'xheader__name' write
else
  if (file("&1")) then
    let xheader__name &1
    define header hds 'xheader__name' write
  else
    @ x_getfilename.greg xheader__name " " ".gdf"
    on error return
    define header hds 'xheader__name' write
  endif
endif
if (hds%extrema.le.0) then
  delete /var hds
  v\header 'xheader__name' /extrema  ! Recompute
  define header hds 'xheader__name' write  ! Reload
endif
! patch absence of some sections. Otherwise, changes in the header could be
! recorded but not visible via a "HEADER" command in GRAPHIC. I wonder if
! one could make something wrong by allowing sections to exist, even if empty..
if (hds%gene.le.0) then
  let hds%gene 116
endif
if (hds%blan.le.0) then
  let hds%blan 8
endif
if (hds%extrema.le.0) then
  let hds%extrema 8
endif
if (hds%desc.le.0) then
  let hds%desc 72
endif
if (hds%posi.le.0) then
  let hds%posi 48
endif
if (hds%proj.le.0) then
  let hds%proj 36
endif
if (hds%spec.le.0) then
  let hds%spec 48
endif
!
define structure hds_% /global
define character hds_%d0*16 hds_%a0*16 hds_%ra*16 hds_%dec*16 /global
define double hds_%z1[3] hds_%z2[3] hds_%z3[3] hds_%z4[3] hds_%z5[3] hds_%z6[3] hds_%z7[3] /global
!
define double h m s hms
!
gui\panel "GILDAS Image header editor" gag_pro:header.hlp
!-----------------------------------------------------------------------
!
say "Filename: "'xheader__name'
delete /var xheader__name
if (hds%ndim.eq.1) then
  say "Image has 1 dimension: "'hds%dim[1]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
else if (hds%ndim.eq.2)
  say "Image has 2 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
else if (hds%ndim.eq.3)
  say "Image has 3 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" x "'hds%dim[3]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
  let hds_%z3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc"
else if (hds%ndim.eq.4)
  say "Image has 4 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" x "'hds%dim[3]'" x "'hds%dim[4]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
  let hds_%z3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc"
  let hds_%z4 'hds%convert[1,4]' 'hds%convert[2,4]' 'hds%convert[3,4]' /prompt "Axis 4: Ref Val Inc"
else if (hds%ndim.eq.5)
  say "Image has 5 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" x "'hds%dim[3]'" x "'hds%dim[4]'" x "'hds%dim[5]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
  let hds_%z3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc"
  let hds_%z4 'hds%convert[1,4]' 'hds%convert[2,4]' 'hds%convert[3,4]' /prompt "Axis 4: Ref Val Inc"
  let hds_%z5 'hds%convert[1,5]' 'hds%convert[2,5]' 'hds%convert[3,5]' /prompt "Axis 5: Ref Val Inc"
else if (hds%ndim.eq.6)
  say "Image has 6 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" x "'hds%dim[3]'" x "'hds%dim[4]'" x "'hds%dim[5]'" x "'hds%dim[6]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
  let hds_%z3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc"
  let hds_%z4 'hds%convert[1,4]' 'hds%convert[2,4]' 'hds%convert[3,4]' /prompt "Axis 4: Ref Val Inc"
  let hds_%z5 'hds%convert[1,5]' 'hds%convert[2,5]' 'hds%convert[3,5]' /prompt "Axis 5: Ref Val Inc"
  let hds_%z6 'hds%convert[1,6]' 'hds%convert[2,6]' 'hds%convert[3,6]' /prompt "Axis 6: Ref Val Inc"
else if (hds%ndim.eq.7)
  say "Image has 7 dimensions: "'hds%dim[1]'" x "'hds%dim[2]'" x "'hds%dim[3]'" x "'hds%dim[4]'" x "'hds%dim[5]'" x "'hds%dim[6]'" x "'hds%dim[7]'" (fixed)"
  let hds_%z1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc"
  let hds_%z2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc"
  let hds_%z3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc"
  let hds_%z4 'hds%convert[1,4]' 'hds%convert[2,4]' 'hds%convert[3,4]' /prompt "Axis 4: Ref Val Inc"
  let hds_%z5 'hds%convert[1,5]' 'hds%convert[2,5]' 'hds%convert[3,5]' /prompt "Axis 5: Ref Val Inc"
  let hds_%z6 'hds%convert[1,6]' 'hds%convert[2,6]' 'hds%convert[3,6]' /prompt "Axis 6: Ref Val Inc"
  let hds_%z7 'hds%convert[1,7]' 'hds%convert[2,7]' 'hds%convert[3,7]' /prompt "Axis 7: Ref Val Inc"
endif
!-----------------------------------------------------------------------
gui\button "GUI\WAIT" APPLY "Extrema section" gag_pro:header.hlp "Extrema..."
let hds%blank 'hds%blank[1]' 'hds%blank[2]' /prompt "Blanking and tolerance"
!-----------------------------------------------------------------------
let hds%min 'hds%min' /prompt "Minimum value"
let hds%max 'hds%max' /prompt "Maximum value"
if (hds%ndim.eq.1) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' /prompt "Max pixel location"
else if (hds%ndim.eq.2) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' /prompt "Max pixel location"
else if (hds%ndim.eq.3) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' 'hds%minloc[3]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' 'hds%maxloc[3]' /prompt "Max pixel location"
else if (hds%ndim.eq.4) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' 'hds%minloc[3]' 'hds%minloc[4]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' 'hds%maxloc[3]' 'hds%maxloc[4]' /prompt "Max pixel location"
else if (hds%ndim.eq.5) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' 'hds%minloc[3]' 'hds%minloc[4]' 'hds%minloc[5]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' 'hds%maxloc[3]' 'hds%maxloc[4]' 'hds%maxloc[5]' /prompt "Max pixel location"
else if (hds%ndim.eq.6) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' 'hds%minloc[3]' 'hds%minloc[4]' 'hds%minloc[5]' 'hds%minloc[6]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' 'hds%maxloc[3]' 'hds%maxloc[4]' 'hds%maxloc[5]' 'hds%maxloc[6]' /prompt "Max pixel location"
else if (hds%ndim.eq.7) then
  let hds%minloc[1:hds%ndim] 'hds%minloc[1]' 'hds%minloc[2]' 'hds%minloc[3]' 'hds%minloc[4]' 'hds%minloc[5]' 'hds%minloc[6]' 'hds%minloc[7]' /prompt "Min pixel location"
  let hds%maxloc[1:hds%ndim] 'hds%maxloc[1]' 'hds%maxloc[2]' 'hds%maxloc[3]' 'hds%maxloc[4]' 'hds%maxloc[5]' 'hds%maxloc[6]' 'hds%maxloc[7]' /prompt "Max pixel location"
endif
!---------------------------------------------------------------------------
gui\button "GUI\WAIT" APPLY "Description section" gag_pro:header.hlp "Description..."
let hds%unit 'hds%unit' /prompt "Image Unit" /choice unknown kelvin "Jy" "Jy/Beam" *
if (hds%ndim.ge.1) then
  let hds%unit1 'hds%unit1' /prompt "Unit along 1st axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.2) then
  let hds%unit2 'hds%unit2' /prompt "Unit along 2nd axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.3) then
  let hds%unit3 'hds%unit3' /prompt "Unit along 3rd axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.4) then
  let hds%unit4 'hds%unit4' /prompt "Unit along 4th axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.5) then
  let hds%unit5 'hds%unit5' /prompt "Unit along 5th axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.6) then
  let hds%unit6 'hds%unit6' /prompt "Unit along 6th axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
if (hds%ndim.ge.7) then
  let hds%unit7 'hds%unit7' /prompt "Unit along 7th axis" /choice unknown ra dec lii bii frequency lambda velocity *
endif
let hds%system 'hds%system' /prompt "Coordinate system" /choice equatorial galactic icrs unknown
!-----------------------------------------------------------------------
!
gui\button "GUI\WAIT" APPLY "Position section" gag_pro:header.hlp "Position..."
let hds%source 'hds%source' /prompt "Source name"
!
@ sexagesimal 'hds%ra' 12d0 hds_%ra 3
@ sexagesimal 'hds%dec' 180d0 hds_%dec 2
!
let hds_%ra 'hds_%ra' /prompt "Right Ascension"
let hds_%dec 'hds_%dec' /prompt "Declination"
let hds%bii 'hds%bii' /prompt "Latitude"
let hds%lii 'hds%lii' /prompt "Longitude"
!-----------------------------------------------------------------------
!
gui\button "GUI\WAIT" APPLY "Projection section" gag_pro:header.hlp "Projection..."
let hds%ptype 'hds%ptype' /prompt "Projection Type" /index gnomonic orthogreg azimuthal stereogreg lambert aitoff radio none
let hds%equinox 'hds%equinox' /prompt "Equinox of coordinates" /choice 2000.0 1950.0 *
!
@ sexagesimal 'hds%d0' 180d0 hds_%d0 2
@ sexagesimal 'hds%a0' 12.d0 hds_%a0 3
!
let hds_%a0 'hds_%a0' /prompt "R.A. of projection center"
let hds_%d0 'hds_%d0' /prompt "Dec. of projection center"
if (hds%ndim.eq.1) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1
else if (hds%ndim.eq.2) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2
else if (hds%ndim.eq.3) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2 3
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2 3
else if (hds%ndim.eq.4) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2 3 4
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2 3 4
else if (hds%ndim.eq.5) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2 3 4 5
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2 3 4 5
else if (hds%ndim.eq.6) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2 3 4 5 6
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2 3 4 5 6
else if (hds%ndim.eq.7) then
  let hds%x_axis 'hds%x_axis' /prompt "Projected X Axis" /choice 1 2 3 4 5 6 7
  let hds%y_axis 'hds%y_axis' /prompt "Projected Y Axis" /choice 1 2 3 4 5 6 7
endif
let hds%angle 'hds%angle' /prompt "Projection angle"
!-----------------------------------------------------------------------
!
gui\button "GUI\WAIT" APPLY "Frequency section" gag_pro:header.hlp "Frequency..."
let hds%line 'hds%line' /prompt "Line name"
let hds%restfre 'hds%restfre' /prompt "Rest Frequency (MHz)"
let hds%imagfre 'hds%imagfre' /prompt "Image Frequency (MHz)"
let hds%freqres 'hds%freqres' /prompt "Frequency Resolution (MHz)"
if (hds%ndim.eq.1) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1
else if (hds%ndim.eq.2) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2
else if (hds%ndim.eq.3) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3
else if (hds%ndim.eq.4) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3 4
else if (hds%ndim.eq.5) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3 4 5
else if (hds%ndim.eq.6) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3 4 5 6
else if (hds%ndim.eq.7) then
  let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3 4 5 6 7
endif
let hds%veloff 'hds%veloff' /prompt "Velocity Offset"
let hds%velres 'hds%velres' /prompt "Velocity Resolution"
!-----------------------------------------------------------------------
!
gui\button "GUI\WAIT" APPLY "Beam section" gag_pro:header.hlp "Beam..."
let hds%major 'hds%major' /prompt "Major axis of beam"
let hds%minor 'hds%minor' /prompt "Minor axis of beam"
let hds%pa 'hds%pa' /prompt "Position Angle of beam"
!
gui\go
gui\wait
!
let hds%convert[1] hds_%z1
let hds%convert[2] hds_%z2
let hds%convert[3] hds_%z3
let hds%convert[4] hds_%z4
let hds%convert[5] hds_%z5
let hds%convert[6] hds_%z6
let hds%convert[7] hds_%z7
!
let hds%d0 'hds_%d0' /sexa
let hds%d0 hds%d0*pi|180.0
let hds%a0 'hds_%a0' /sexa
let hds%a0 hds%a0*pi|12.0
let hds%ra 'hds_%ra' /sexa
let hds%ra hds%ra*pi|12.0
let hds%dec 'hds_%dec' /sexa
let hds%dec hds%dec*pi|180.0
!somebody understands why this doesnot work?
! try again, it seems to work now
let hds%ptype mod(hds%ptype,8)
!let hds%ptype 'mod(hds%ptype,8)'
delete /var hds_
return
!
