; $Id: pan_macrofunction.pro,v 1.8 2007/04/06 21:45:08 kneller Exp $
;###############################################################################
;
; NAME:
;  PAN_MACROFUNCTION
;
; PURPOSE:
;  User-defined macro-function for use in fitting data in PAN.
;
; CATEGORY:
;  DAVE, Data Analysis, PAN
;
; AUTHOR:
;   Robert M. Dimeo, Ph.D.
;   NIST Center for Neutron Research
;   100 Bureau Drive
;   Gaithersburg, MD 20899
;   Phone: (301) 975-8135
;   E-mail: robert.dimeo@nist.gov
;   http://www.ncnr.nist.gov/staff/dimeo
;
; LICENSE:
;  The software in this file is written by an employee of
;  National Institute of Standards and Technology
;  as part of the DAVE software project.
;
;  The DAVE software package is not subject to copyright protection
;  and is in the public domain. It should be considered as an
;  experimental neutron scattering data reduction, visualization, and
;  analysis system. As such, the authors assume no responsibility
;  whatsoever for its use, and make no guarantees, expressed or
;  implied, about its quality, reliability, or any other
;  characteristic. The use of certain trade names or commercial
;  products does not imply any endorsement of a particular product,
;  nor does it imply that the named product is necessarily the best
;  product for the stated purpose. We would appreciate acknowledgment
;  if the DAVE software is used of if the code in this file is
;  included in another product.
;
;###############################################################################
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
function pan_macrofunction,x,parms,Qgroup=Qgroup, $
                     parmnames = parmnames,  $
                     canDraw = canDraw,     $
                     eval = eval,      $
                     _Extra = extra
;help,/traceback
;if n_elements(Qgroup) ne 0  then print,'pan_macrofunction 1 Qgroup=',Qgroup
;help,x
release = 6.1
fit_fun = extra.fit_fun_filename
;if (!version).release lt release then $
   this_level = routine_names(/level) ;else $
;   this_level = scope_level()
main_level = 1


; First determine if the call is for the parameter names only...
if n_params() eq 0 then begin
   str = ''
   openr,lun,fit_fun,/get_lun
   readf,lun,str
   free_lun,lun,/force



   ;pan_do_the_macro RUNS THE MACRO VIA EXECUTE, CREATING THE parmnames VARIABLE AT THE MAIN LEVEL.
   ret = pan_do_the_macro(str[0])
;   if (!version).release lt release then begin
      value  = routine_names('parmnames', fetch = main_level)
      dummy  = routine_names('parmnames', value, store = this_level)
;   endif else begin
;      parmnames = scope_varfetch('parmnames', level = main_level)
;      print,'Parameter names: ',parmnames
;   endelse

   return,0
endif

;if n_elements(Qgroup) ne 0  then print,'pan_macrofunction 3 Qgroup=',Qgroup

; Send the x and parms values to the main level
;if (!version).release lt release then begin
   value  = routine_names('x', fetch = this_level) ; get x from this level
   dummy  = routine_names('x', value, store = main_level) ; and store it in the main level
   value = routine_names('parms',fetch = this_level)
   dummy = routine_names('parms',value,store = main_level)


;NOW DO THE SAME THING FOR Q VALUES, WHICH NEED TO BE PASSED INTO THIS ROUTINE.
    ;SET UP Q AS A SCALAR.
    ;THIS IS CALLED ONLY ONCE.  Qgroup MUST BE PULLED FROM THE CURVES ELSEWHERE.
    if n_elements(QGroup) ne 0 then begin;eq 1 then begin

        value  = routine_names('Qgroup', fetch = this_level) ; get qgroup from this level
        ;print,'value=',value
        dummy  = routine_names('Qgroup', value, store = main_level) ; and store it in the main level
    endif




;endif else begin
;   (scope_varfetch('x', /enter,level = main_level)) = x
;   (scope_varfetch('parms', /enter,level = main_level)) = parms
;endelse




; Read in the macro
counter = 0L
str = ''
openr,lun,fit_fun,/get_lun
while not(eof(lun)) do begin
   readf,lun,str
   if counter eq 0L then macro_text = str else $
     macro_text = [macro_text,str]
   counter = counter+1L
endwhile
free_lun,lun,/force




; If a resolution function is present, retrieve it from the $main$ level
;if (!version).release lt release then begin
   if n_elements(routine_names('resptr',fetch = main_level)) ne 0 then begin
      value  = routine_names('resptr', fetch = main_level)
      dummy  = routine_names('resptr', value, store = this_level)
   endif
;endif else begin
;   if n_elements(scope_varfetch('resptr',/enter,level = main_level)) ne 0 then $
;      resptr = scope_varfetch('resptr',level = main_level)
;endelse
; Now execute the macro
ret = pan_do_the_macro(macro_text,QGroup=QGroup)
eval = 1
if ret eq 0 then begin
   eval = 0
   return,ret
endif

;if (!version).release lt release then begin
   ; Retrieve ymodel, ydelta, and parmnames from the main level
   if n_elements(routine_names('ymodel', fetch = main_level)) ne 0 then begin
      value  = routine_names('ymodel', fetch = main_level)
      dummy  = routine_names('ymodel', value, store = this_level)
   endif
   if n_elements(routine_names('delta_params', fetch = main_level)) ne 0 then begin
      value  = routine_names('delta_params', fetch = main_level)
      dummy  = routine_names('delta_params', value, store = this_level)
   endif
   value  = routine_names('parmnames', fetch = main_level)
   dummy  = routine_names('parmnames', value, store = this_level)
;endif else begin
;   ; Retrieve ymodel, ydelta, and parmnames from the main level
;   ; and store in the current level
;   if n_elements(scope_varfetch('ymodel',/enter,level = main_level)) ne 0 then $
;      ymodel = scope_varfetch('ymodel',level = main_level)
;   if n_elements(scope_varfetch('delta_params',/enter,level = main_level)) ne 0 then $
;      delta_params = scope_varfetch('delta_params',level = main_level)
;   parmnames = scope_varfetch('parmnames', level = main_level)
;endelse

canDraw = 0

; If resolution function is present then perform the convolution here
if n_elements(resptr) ne 0 then begin
   if n_elements(ymodel) ne 0 then begin
;     yout = rmd_convol(x,resPtr,ymodel,pseudo_delta = delta_params)
      yout = pan_convolute(x,resPtr,ymodel,pseudo_delta = delta_params)
   endif else begin
;     yout = rmd_convol(x,resPtr,pseudo_delta = delta_params)
      yout = pan_convolute(x,resPtr,pseudo_delta = delta_params)
   endelse
endif else begin
   yout = 0
   if (n_elements(pseudo_delta) ne 0) and (n_elements(ymodel) eq 0) then begin
     yout = 0
   endif
   if (n_elements(ymodel) ne 0) then begin
     yout = ymodel
   endif
endelse
; Delete all the main level variables
;if (!version).release ge release then begin
;   varnames = scope_varname(level = main_level)
;   for jj = 0,n_elements(varnames)-1 do $
;      if (varnames[jj] ne 'jj') and (varnames[jj] ne 'r') and $
;         (n_elements((scope_varfetch(varnames[jj],/enter,level = main_level))) ne 0) then $
;         r = temporary((scope_varfetch(varnames[jj],/enter,level = main_level)))
;endif
return,yout
end;pan_macrofunction
