sic prec double 
on error return 
if (exist(xheader$name)) then 
  delete /var xheader$name 
endif 
sic\define character xheader$name*132 /global 
if ("XXXX&1".eq."XXXX") then 
  @ x_getfilename.graphic 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.graphic xheader$name " " ".gdf" 
    on error return 
    define header hds 'xheader$name' write 
  endif 
endif 
if (hds%extrema.lt.8) then 
  del /var hds 
  header 'xheader$name' /extrema 
  define header hds 'xheader$name' write 
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 character hds_d0*16 hds_a0*16 hds_ra*16 hds_dec*16 
define double h m s hms 
define double hds_1[3] hds_2[3] hds_3[3] hds_4[3] 
! 
gui\panel "GILDAS Image header editor" pr:graphic/header.hlp 
!----------------------------------------------------------------------- 
! 
say "Filename: "'xheader$name' 
delete /var xheader$name 
say "Image Dimensions: "'hds%dim[1]'" "'hds%dim[2]'" "'hds%dim[3]'" "'hds%dim[4]'" (fixed)" 
let hds_1 'hds%convert[1,1]' 'hds%convert[2,1]' 'hds%convert[3,1]' /prompt "Axis 1: Ref Val Inc" 
let hds_2 'hds%convert[1,2]' 'hds%convert[2,2]' 'hds%convert[3,2]' /prompt "Axis 2: Ref Val Inc" 
let hds_3 'hds%convert[1,3]' 'hds%convert[2,3]' 'hds%convert[3,3]' /prompt "Axis 3: Ref Val Inc" 
let hds_4 'hds%convert[1,4]' 'hds%convert[2,4]' 'hds%convert[3,4]' /prompt "Axis 4: Ref Val Inc" 
!----------------------------------------------------------------------- 
gui\button "GUI\WAIT" apply "Extrema section" pr:graphic/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" 
let hds%where 'hds%where[1,1]' 'hds%where[2,1]' 'hds%where[1,2]' 'hds%where[2,2]' 'hds%where[1,3]' 'hds%where[2,3]' 'hds%where[1,4]' 'hds%where[2,4]' /prompt "Min-Max pixels" 
!--------------------------------------------------------------------------- 
gui\button "GUI\WAIT" apply "Description section" pr:graphic/header.hlp "Description..." 
let hds%unit 'hds%unit' /prompt "Image Unit" /choice unknown kelvin "Jy" "Jy/Beam" * 
let hds%unit1 'hds%unit1' /prompt "Unit along 1st axis" /choice unknown ra dec lii bii freq lambda velocity * 
let hds%unit2 'hds%unit2' /prompt "Unit along 2nd axis" /choice unknown ra dec lii bii freq lambda velocity * 
let hds%unit3 'hds%unit3' /prompt "Unit along 3rd axis" /choice unknown ra dec lii bii freq lambda velocity * 
let hds%unit4 'hds%unit4' /prompt "Unit along 4th axis" /choice unknown ra dec lii bii freq lambda velocity * 
let hds%system 'hds%system' /prompt "Coordinate system" /choice equatorial galactic unknown 
!----------------------------------------------------------------------- 
! 
gui\button "GUI\WAIT" apply "Position section" pr:graphic/header.hlp "Position..." 
let hds%source 'hds%source' /prompt "Source name" 
let hms abs(12|pi*hds%ra) 
let h int(hms) 
let hms 60*(hms-h) 
let m int(hms) 
let hms 60*(hms-m) 
let s 1e-4*nint(1e4*hms) 
let hds_ra 'h':'m':'s' 
let hds_ra 'hds_ra' /prompt "Right Ascension" 
! 
let hms abs(180|pi*hds%dec) 
let h int(hms) 
let hms 60*(hms-h) 
let m int(hms) 
let hms 60*(hms-m) 
let s 1e-4*nint(1e4*hms) 
if (hds%dec.gt.0) then 
  let hds_dec 'h':'m':'s' 
else 
  let hds_dec -'h':'m':'s' 
endif 
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" pr:graphic/header.hlp "Projection..." 
let hds%ptype 'hds%ptype' /prompt "Projection Type" /index gnomonic orthographic azimuthal stereographic lambert aitoff radio none 
let hds%epoch 'hds%epoch' /prompt "Epoch of coordinates" /choice 2000.0 1950.0 * 
! 
let hms abs(180|pi*hds%d0) 
let h int(hms) 
let hms 60*(hms-h) 
let m int(hms) 
let hms 60*(hms-m) 
let s 1e-4*nint(1e4*hms) 
if (hds%d0.gt.0) then 
  let hds_d0 'h':'m':'s' 
else 
  let hds_d0 -'h':'m':'s' 
endif 
! 
let hms hds%a0 
let hms abs(12|pi*hms) 
let h int(hms) 
let hms 60*(hms-h) 
let m int(hms) 
let hms 60*(hms-m) 
let s 1e-4*nint(1e4*hms) 
let hds_a0 'h':'m':'s' 
! 
let hds_a0 'hds_a0' /prompt "R.A. of projection center" 
let hds_d0 'hds_d0' /prompt "Dec. of projection center" 
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 
let hds%angle 'hds%angle' /prompt "Projection angle" 
!----------------------------------------------------------------------- 
! 
gui\button "GUI\WAIT" apply "Frequency section" pr:graphic/header.hlp "Frequency..." 
let hds%line 'hds%line' /prompt "Line name" 
let hds%restfre 'hds%restfre' /prompt "Rest Frequency (MHz)" 
let hds%freqoff 'hds%freqoff' /prompt "Offset Frequency (MHz)" 
let hds%freqres 'hds%freqres' /prompt "Frequency Resolution (MHz)" 
let hds%f_axis 'hds%f_axis' /prompt "Frequency Axis" /choice 1 2 3 4 
let hds%veloff 'hds%veloff' /prompt "Velocity Offset" 
let hds%velres 'hds%velres' /prompt "Velocity Resolution" 
!----------------------------------------------------------------------- 
! 
gui\button "GUI\WAIT" apply "Beam section" pr:graphic/header.hlp "Beam..." 
let hds%major 'hds%major' /prompt "Minor axis of beam" 
let hds%minor 'hds%minor' /prompt "Minor axis of beam" 
let hds%pa 'hds%pa' /prompt "Position Angle of beam" 
! 
gui\button "GUI\WAIT" apply "Section Lengths" pr:graphic/header.hlp "Structure..." 
sic\say "Normally only a fool would want to change these values..." 
let hds%gene 'hds%gene' /prompt "General section length (116)" 
let hds%blan 'hds%blan' /prompt "Blanking section length (8)" 
let hds%extrema 'hds%extrema' /prompt "Extrema-section length (8)" 
let hds%desc 'hds%desc' /prompt "Description-section (72)" 
let hds%posi 'hds%posi' /prompt "Position-section length (48)" 
let hds%proj 'hds%proj' /prompt "Projection-section Length (36)" 
let hds%spec 'hds%spec' /prompt "Frequency-section length (48)" 
let hds%beam 'hds%beam' /prompt "Beam-section length" 
gui\go 
! Trick to wait and kill the panel after completion 
gui\wait 
gui\panel toto toto 
gui\go 
! 
let hds%convert[1] hds_1 
let hds%convert[2] hds_2 
let hds%convert[3] hds_3 
let hds%convert[4] hds_4 
! 
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 
let hds%ptype mod(hds%ptype,8) 
return