pro mk_struct, infil, outfil
;
;
;
;Rules:
;	* The Structure definitions must use all caps STRUCTURE 
;	* A tab must preceed the STRUCTURE line which defines the structure name
;	* The last characters of the structure name must be "_REC"
;HISTORY:
;	Written Fall '91 by M.Morrison
;	15-Mar-93 (MDM) - Modified to make the keyword switch not include the
;			  version number of the structure name
;
print, 'Now processing ', infil
;
;----- Get a full list of the structures that are being defined
;
cmd = 'grep "	STRUCTURE" ' + infil + ' > mk_struct.dum'
spawn, cmd
openr, lun, 'mk_struct.dum', /get_lun
while not eof(lun) do begin
    lin = ' '
    readf, lun, lin
    p = strpos(lin, '/')
    temp = strmid(lin, p+1, 80)
    p = strpos(temp, '/')
    snam = strmid(temp, 0, p-4)
    if (n_elements(struct_names) eq 0) then struct_names = snam else struct_names = [struct_names, snam]
end
free_lun, lun
;
n = n_elements(struct_names) 
;
qdebug = 0 
break_file, infil, dsk_log, dir, filnam, ext
if (outfil eq '') then outfil = dsk_log + dir + filnam + '.pro'
;
get_lun, lun
openr, lun, infil
get_lun, lunout
openw, lunout, outfil
for i=0,n-1 do begin
    if (i eq 0) then str = 'pro ' + filnam + ', '  else str = '                     '
    keyword = struct_names(i)
    if (strpos(infil, 'old') eq -1) then begin		;it is not an old structure definision file
	temp = byte(strmid(keyword, 4, 4))
	if ((min(temp) ge 48) and (max(temp) le 70)) then keyword = strmid(keyword, 0, 4) + strmid(keyword, 9, 100)
    end
    str = str + keyword + ' = ' + struct_names(i)
    if (i ne n-1) then str = str + ',  $'
    printf, lunout, str
end
printf, lunout, '   '
printf, lunout, '   '
;
qin_struct = 0
qin_comment = 0
while not eof(lun) do begin
    ;lin = strarr(132,1)
    lin = '                                                                  ' & lin = lin + lin	;create 132 byte buffer
    readf, lun, lin
    ;;lin = lin(0)
    remtab, lin, lin
    linup = strupcase(lin)
    if (qdebug) then print, lin
    ;
    if (strmid(linup,0,2) eq 'C+') then qin_comment = 1
    if (qin_comment) then printf, lunout, ';' + strmid(lin, 1, 132)
    if (strmid(linup,0,2) eq 'C-') then begin
	qin_comment = 0
	printf, lunout, '   '
	printf, lunout, '   '
    end
    ;
    if (qin_struct) then begin
	p = strpos(linup, 'END STRUCTURE')
	if (p ne -1) then begin
	    printf, lunout, str_lastvar
	    printf, lunout, '   '
	    printf, lunout, '   '
	    printf, lunout, '   '
	    if (qdebug) then print, '--- End of Structure --- '
	    qin_struct = 0
	end else begin
	    if (str ne '') then printf, lunout, str
	end
    end
    ;
    if (qin_struct) then begin
	deparse, lin, vtyp, vnam, vstrlen, varrlen, vinit, comment, qdebug
	cre_idlstr, vtyp, vnam, vstrlen, varrlen, vinit, comment, str, str_lastvar
	if (qdebug) then print, str
    end
    ;
;;stop
    if (not qin_struct) then begin
	p = strpos(linup, '  STRUCTURE')
	if (p ne -1) then begin
	    if (qdebug) then print, '--- Start of Structure --- '
	    qin_struct = 1
	    p = strpos(linup, '/')
	    temp = strmid(lin, p+1, 80)
	    p = strpos(temp, '/')
	    struct_nam = strmid(temp, 0, p)
	    str_var_nam = strmid(temp, 0, p-4)	;drop off "_REC"
	    printf, lunout, str_var_nam, ' = { ', struct_nam, ',              $'
	    str = ''		;since write occurs next loop
	end
    end
end
;
printf, lunout, '  '
printf, lunout, '  '
printf, lunout, 'end'
;
free_lun, lun
free_lun, lunout
end
;------------------------------------------------------------------------------
pro deparse, lin, vtyp, vnam, vstrlen, varrlen, vinit, comment, qdebug
;
;
;
if (strupcase(strmid(lin,0,1)) eq 'C') then lin = ''	;drop commented lines
vtyp_str = strtrim(strupcase(strmid(lin, 8, 16)),2)
case vtyp_str of
    'BYTE':		vtyp = 1
    'INTEGER*2':	vtyp = 2
    'INTEGER*4':	vtyp = 3
    'REAL*4':		vtyp = 4
    '':			vtyp = -1	;no field defined, just comments
    else:				;should be CHARACTER type
endcase
;
;--------------------
;
vnam = strtrim(strmid(lin, 24, 16),2)
p = strpos(vnam, '/')			;trim off initialization value
if (p ne -1) then vnam = strmid(vnam, 0, p)
p = strpos(vnam, '(')
varrlen = 0					;scaler
if (p ne -1) then begin
    p2 = strpos(vnam, ')')
    p3 = strpos(vnam, ',')	;look for 2-D variable
    if (p3 eq -1) then begin	;1-D
	varrlen = fix(strmid(vnam, p+1, p2-p-1))
    end else begin
	varrlen = -1
	temp = strmid(vnam, p+1, p2-p-1)
	repeat begin
	    p3 = strpos(temp, ',')
	    if (p3 eq -1) then begin	;no more dimensions
		varrlen = [varrlen, fix(temp)]
	    end else begin
		temp2 = fix(strmid(temp, 0, p3))
		varrlen = [varrlen, temp2]
		temp = strmid(temp, p3+1, 80)
	    end
	end until (p3 eq -1)
	varrlen = varrlen(1:*)
    end
    vnam = strmid(vnam, 0, p)
end
;
vstrlen = 0
if (strmid(vtyp_str,0,9) eq 'CHARACTER') then begin
    vtyp = 1
    vnam = 'st$' + vnam
    vstrlen = fix(strtrim(strmid(vtyp_str, 10, 4),2))
    varrlen = vstrlen
end
;
;--------------------
;
p = strpos(lin, '!')
comment = ''
if (p ne -1) then comment = strmid(lin, p+1, 70)
;
;--------------------
;
vinit = '0'
p = strpos(lin, '/')
if ((p ne -1) and (p lt 40)) then begin		;dont want to grab '/' that are in comment area
    temp = strmid(lin, p+1, 100)
    p = strpos(temp, '/')
    vinit = strmid(temp, 0, p)
end
;--------------------
;
if (qdebug) then print, '     vtyp .......', vtyp
if (qdebug) then print, '     vnam .......', vnam
if (qdebug) then print, '     vstrlen ....', vstrlen
if (qdebug) then print, '     varrlen ....', varrlen
if (qdebug) then print, '     vinit ......', vinit
if (qdebug) then print, '     comment ....' + comment
;
end
;------------------------------------------------------------------------------
pro cre_idlstr, vtyp, vnam, vstrlen, varrlen, vinit, comment, str, str_lastvar
;
;
;
str = '      ' + vnam + ': '
n = n_elements(varrlen)
if (n eq 1) then begin
    str1 = '(' + strtrim(varrlen,2) + ')'
end else begin
    str1 = '('
    for i=0,n-1 do str1 = str1 + strtrim(varrlen(i),2) + ','
    str1 = strmid(str1, 0, strlen(str1)-1)
    str1 = str1 + ')'
end
if (vtyp eq 7) then str1 = '(' + strtrim(vstrlen,2) + ',' + strtrim(varrlen,2) + ')'
;
if (total(varrlen+intarr(2)) eq 0) then begin		;scaler
    case vtyp of
	1: str = str + "BYTE("   + vinit + "),  $"
	2: str = str + "FIX("    + vinit + "),  $"
	3: str = str + "LONG("   + vinit + "),  $"
	4: str = str + "FLOAT("  + vinit + "),  $"
	7: str = str + "' ',      $"
	else: str = ''				;just comment line
    endcase
end else begin
    if (vinit ne '0') then str1 = str1 + '+(' + vinit + ')'
    case vtyp of
	1: str = str + 'BYTARR' + str1 + ',  $'
	2: str = str + 'INTARR' + str1 + ',  $'
	3: str = str + 'LONARR' + str1 + ',  $'
	4: str = str + 'FLTARR' + str1 + ',  $'
	7: str = str + "STRARR' + str1 + ',  $'
	else: str = ''				;just comment line
    endcase
end
;
p = strpos(str, ')')
str_lastvar = strmid(str, 0, p+1) + ' }                                 '
str = str + '                                                  '
str         = strmid(str,         0, 45) + ';' + comment
str_lastvar = strmid(str_lastvar, 0, 45) + ';' + comment
;
end
;------------------------------------------------------------------------------
;
prefix = ['gen', 'hxt', 'wbs', 'sxt', 'bcs', 'obs', 'att', 'cba', 'evn', 'pnt', 'fem', $
					'sxt_old', 'bcs_old', 'gen_old', 'att_old']
;
in = ' '
read, 'Which structure to process (enter ALL to do all of them) ', in
;
if (strupcase(in) eq 'ALL') then begin
    for i=0,n_elements(prefix)-1 do mk_struct, prefix(i)+'_struct.inc', ''
end else begin
    mk_struct, in+'_struct.inc', ''
;
end
;
;mk_struct, 'gen_struct.inc', ''
;mk_struct, 'hxt_struct.inc', ''
;mk_struct, 'wbs_struct.inc', ''
;mk_struct, 'sxt_struct.inc', ''
;mk_struct, 'bcs_struct.inc', ''
;mk_struct, 'obs_struct.inc', ''
;
end