;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MAKECALFILE_GENERIC.PRO
;;   Creates calibration FITS header and data in a struct
;;   Routines (see comments at routine declaration for details):
;;     makeCalFile_Generic    - Main routine, build header, writes file
;;     makeCalFile_Comments   - Support routine, add comments to FITS hdr
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; makeCalFile_Comments 
;; - Support routine
;; - Mungs comments for characters and length
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
pro makeCalFile_addComments, cmts, newCmtsArg, stars=stars

  ;; Ensure comments are type string

  if size(newCmtsArg,/type) ne size('',/type) then return

  ;; Make local copy, loop through comments

  if n_elements(stars) ne 1L then begin
    newCmts = [ newCmtsArg[*] ]
  endif else begin
    newCmts = [ newCmtsArg[*] , stars[0]]
  endelse

  nNewCmts = n_elements(newCmts)

  ;; Replace non-7-bit, non-control characters with spaces

  for iNewCmt=0L,nNewCmts-1L do begin
    if newCmts[iNewCmt] eq '' then continue    ;; ignore empty comments

    bMbr = byte(newCmts[iNewCmt])
    iw = where(bMbr lt 32b or bMbr gt 127b,iwCt)
    if iwCt eq 0L then continue
    bMbr[iw] = 32b
    newCmts[iNewCmt] = string(bMbr)
  endfor

  newCmts = strtrim(newCmts, 0)      ;; Trim spaces from right

  ;; Break new comments at 72 columns

  maxLen = max(strlen(newCmts))
  if maxLen gt 72L then begin
    nCols = (maxLen / 72L) + 1L
    xposCmts = strarr(nCols,nNewCmts)
    for iCol=0,nCols-1 do xposCmts[iCol,*] = strmid(newCmts,iCol*72L,72L)
    iwArr = make_array( nCols,nNewCmts,val=0b)
    iwArr[*,0]=1b
    iwArr[where(xposCmts ne '')]=1b
    newCmts = xposCmts[where( iwArr eq 1b)]
  endif

  if n_elements(cmts) lt 1L then cmts = [stars]   ;; Initialize output comments
  cmts = [cmts, newCmts]                          ;; Append new comments

  return
end

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; makeCalFile_Generic
;; - Main routine
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function makeCalFile_Generic  $
, calKwd                      $ ;;; {DICalKeywords ,...} from DICalKeywords()
, calData                     $ ;;; image or other binary data
, existingHdr=existingHdr     $ ;;; Start with existing header, if ,/UPDATE
, update=updateArg            $ ;;; Start with existingHdr, if present
, extraKeywords=extraKeywords $ ;;; {kwd1:{v:value,c:'comment'},kwd2:...}
, extraFnOrigs=extraFnOrigs   $ ;;; STR[] FNORIGs beyond calKwd.fnorig
, cmtStructArg=cmtStructArg   $ ;;; { cmnt1:['xyz',...],cmnt2:['abc',...]... }
, noModeLoop=noModeLoop       $ ;;; ,/noModeLoop => do not loop over all modes
, asciiFiles=asciiFiles       $ ;;; STR[] ASCII filenames to put in PDU hdr
, nameSuffix=nameSuffix       $ ;;; Filename suffix (temperature, filter, &c)
, noSetName=noSetName         $ ;;; Don't set .dicalnam from other members
, extFiles=extFiles           $ ;;; filenames of Binary files to put in EDUs
, doWrite=doWrite             $ ;;; ,/write => write FITS file(s)
, debug=debugArg

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Creates calibration FITS header and data in a struct:
;; { success: 1b, status: '...', reason: '' $
;; , nHdr:nHdr, hdr:hdr, imgData:calData }
;; 
;; - N.B. If the input mode (CalKeywords.DICALMOD) is less than 1, then
;;        return.hdr will be an array of several FITS headers for multiple modes
;; - Optionally write FITS file
;;
;; Revision
;; 2010-09 BTCarcich  Original version
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

debug = keyword_set(debugArg)
if debug then help,cmtStructArg,/st
if debug then help

rtn = { success: 0b, status: 'FAILED', reason: 'UNKNOWN' }

inst = calKwd.dicalins
mode = calKwd.DICALMOD

maxmode = (inst EQ 'HRIIR')?7L:9L

if mode lt 1L and not keyword_set(noModeLoop) then begin
  calKwdArr = replicate(calKwd,maxmode)
  calKwdArr.DICALMOD = lindgen(maxmode)+1L
  nHdr=0L
  for iMode=0L,maxmode-1 do begin

    lclCalKwd = calKwdArr[iMode]

    iRtn = makeCalFile_generic( lclCalKwd, calData  $
           , existingHdr=existingHdr     $
           , update=updateArg            $
           , extraKeywords=extraKeywords $
           , extraFnOrigs=extraFnOrigs   $
           , cmtStructArg=cmtStructArg   $
           , asciiFiles=asciiFiles       $
           , nameSuffix=nameSuffix       $
           , extFiles=extFiles           $
           , doWrite=doWrite             $
           , debug=debugArg              $
           )
    if iRtn.success ne 1b then begin
      iRtn.reason = 'Failed in MODE loop at MODE=' $
                    + strtrim(calKwdArr[iMode].DICALMOD,2) $
                    + '{' + iRtn.reason + '}'
      return, iRtn
    endif

    calKwdArr[iMode] = iRtn.calKwd
    if iMode eq 1L then begin
      hdrArr = iRtn.hdr
    endif else begin
      hdrArr = [[hdrArr],[iRtn.hdr]]
    endelse
    nHdr = nHdr + 1L
  endfor
  rtn.success = 1b
  rtn.status = 'OK'
  rtn.reason = 'SUCCESS IN LOOP OVER ' + strtrim(nHdr,2) + ' MODES'
  return, create_struct( rtn, 'nHdr', nHdr, 'hdr', hdrArr, 'imgData', calData $
                       , 'calKwdArr', calKwdArr $
                       )
endif

structType = size({b:0b},/type)

typCmt = size(cmtStructArg,/type) 
if typCmt eq structtype then begin
  cmtStruct = cmtStructArg
endif else if typCmt eq size('',/type) then begin
  cmtStruct = {cmt:[cmtStruct[*]]}
endif else begin
  cmtStruct = {cmt:0b}
endelse

tnsCmt = tag_names(cmtStruct)
nTnsCmtM1 = n_elements(tnsCmt)-1L

stars='***********************************************************************'
ptr_free,ptr_new(cmts,/no_copy)

;;; Add comments

for i=0L,nTnsCmtM1 do begin
  makecalfile_addComments, cmts, (cmtStruct.(i))[*], stars=stars
endfor

;;; Add ASCII files

for iFile=0L,n_elements(asciiFiles)-1L do begin
  fn=asciiFiles[iFile]
  iTmp=query_ascii(fn,infoTmp)
  if iTmp ne 1L then begin
    message,/info,'Comment file ' + fn + ' skipped; file is not ASCII'
    continue
  endif
  if infoTmp.lines lt 1L then begin
    message,/info,'Comment file ' + fn + ' skipped; file is empty'
    continue
  endif
  fCmts = strarr(infoTmp.lines+1L)
  fCmts[0] = 'Comments from file  ' + fn + ':'
  openr,lun,fn,/get_lun
  s=''
  for i=1L,infoTmp.lines do begin
    readf,lun,s
    fCmts[i] = s
  endfor
  free_lun,lun
  makecalfile_addComments, cmts, fCmts, stars=stars
endfor

mkhdr,fithdr, calData, /extend      ;; Create header

if n_elements(cmts) gt 0L then begin
  if debug then help,/st,cmtStruct,tnsCmt,nTnsCmtM1,cmts
  sxaddhist, cmts, fithdr, /comment   ;; Add comments to header
endif

sxaddpar, fithdr, 'BSCALE', 1.0     ;; Add scaling to header
sxaddpar, fithdr, 'BZERO', 0.0

DICalKeywords_FitAddPar, fithdr, calKwd $       ;; Add DICAL keworrds to header
   , noSetName=noSetName, nameSuffix=nameSuffix

;; Add any extra original filenames to header

for iFnOrig=0L,n_elements(extraFnOrigs)-1L do begin
  sxaddpar, fithdr, 'FNORIG'+strtrim(iFnOrig+1L,2), extraFnOrigs[iFnOrig], ' Additional original filename'
endfor

if size(extraKeywords,/type) eq structType then begin
  tnsKwds = tag_names(extraKeywords)
  for iKwd=0L,n_elements(tnsKwds)-1L do begin
    kwd = tnsKwds[iKwd]
    if strlen(kwd) gt 8L then continue           ;;; Skip long keywords
    if strmid(kwd,0,5) eq 'SKIP_' then continue  ;;; Skip keywords that start with SKIP_
    str = extraKeywords.(iKwd)
    if size(str,/type) ne structType then continue  ;;; Skip non-structs
    sxaddpar, fithdr, kwd, str.v, str.c             ;;; Keyword, Value, Comment
  endfor
endif

if n_elements(existingHdr) gt 0L and keyword_set(updateArg) then begin
  iEnd = (where( strmid(fithdr,0,9) eq 'END      ' ))[0]
  iToEnd = lindgen(iEnd)

  f9s = strmid( fithdr, 0, 9 )
  iwF9s = where( strmid(f9s, 0, 8) ne 'COMMENT ', ct)

  if ct gt 0L then begin

    iwExisting = lindgen( n_elements(existingHdr) )

    existing9 = strmid( existingHdr, 0, 9)

    for i=0L,n_elements(iwF9s)-1L do begin
      if iwF9s[i] lt 0L then continue
      iwDrop = where( f9s[iwF9s[i]] eq existing9, ct)
      if ct lt 1L then continue
      iwExisting[iwDrop] = -1L
    endfor

    iw = where(iwExisting gt -1L, ct)
    if ct gt 0L then begin
      fithdr = [ fithdr[iToEnd], existingHdr[iwExisting[iw]], fithdr[iEnd:*] ]
    endif
  endif
    
  oldorig = sxpar( existingHdr, 'FNORIG', comment=cmtOldorig, count=ct)
  if ct eq 1 then sxaddpar, fithdr, 'OLDORIG', oldorig, cmtOldorig, after='FNSTRTSP'
endif

if keyword_set(doWrite) then begin
  writefits, calKwd.dicalnam, calData, fithdr
endif

rtn.success = 1b
rtn.status = 'OK'
rtn.reason = 'SUCCESS'

return, create_struct( rtn, 'nHdr', 1, 'hdr', fithdr, 'imgData', calData $
                       , 'calKwd', calKwd $
                       )

end