;+
; NAME:
;       spheretool_saveroutine
;
; PURPOSE:
;       Metaprogramming: Saves an IDL routine that implements
;       holographic video microscopy fits according to the current
;       settings of SPHERETOOL.
;
; CATEGORY:
;       Digital holography; microscopy
;
; CALLING SEQUENCE:
;       Internal rountine.  Not intended to be called independently.
;
; INPUTS:
;       a: DHM image of a sphere normalized by a background image.
;
; REFERENCE:
;      S. Lee, Y. Roichman, G. Yi, S. Kim, S. Yang, A. van Blaaderen,
;      P. van Oostrum and D. G. Grier,
;      Chararacterizing and tracking
;      single colloidal particles with video holographic microscopy,
;      Optics Express 15, 18275-18282 (2007)
;
; MODIFICATION HISTORY:
; 03/18/2009 DGG: Separated from SPHERETOOL.
; 03/20/2009 DGG: Included COMPILE_OPT
; 07/27/2009 DGG: Workaround for segfault in IDL 7.1 when
;    both DEFAULT_EXTENSION and FILTER are set.  Fixed bug in which
;    S is sent as a pointer but was interpreted as a structure.
; 
; LICENSE
;
;    This program is free software; you can redistribute it and/or
;    modify it under the terms of the GNU General Public License as
;    published by the Free Software Foundation; either version 2 of the
;    License, or (at your option) any later version.
;
;    This program is distributed in the hope that it will be useful,
;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;    General Public License for more details.
;
;    You should have received a copy of the GNU General Public License
;    along with this program; if not, write to the Free Software
;    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
;    02111-1307 USA
;
;    If the Internet and WWW are still functional when you are using
;    this, you shold be able to access the GPL here: 
;    http://www.gnu.org/copyleft/gpl.html
;-

; write out an IDL routine that implements the present settings
pro spheretool_saveroutine, s
compile_opt idl2, hidden

fn = DIALOG_PICKFILE(/WRITE, /OVERWRITE_PROMPT, $
                     DEFAULT_EXTENSION = 'pro', FILTER=['*.pro'], $
                     TITLE = "Save Procedure")
name = file_basename(fn, '.pro', /FOLD_CASE)
if strlen(fn) lt 1 then return
sz = size((*s).p.a,/DIMENSIONS)
rc = floor((*s).p.rc)
rad = min([(*s).p.rad, rc, sz-rc])
deinterlace = (*s).p.fixed[6]
openw, lun, fn, /get_lun
printf, lun, "pro " + name
printf, lun, ";;; routine generated automatically by SPHERETOOL.PRO"
printf, lun, ";;; " + systime()
printf, lun, ";;; Specify the background image"
printf, lun, "backgroundfile = XXX"
printf, lun, ";;; Specify the image files to be processed:"
printf, lun, "filespec = YYY"
printf, lun, ";;; Specify name of output data file"
printf, lun, 'filename = "'+name+'.gdf"'
printf, lun, ";;; nothing should need to be changed below this line"
printf, lun, "bg = double(read_image(backgroundfile)) > 1.d"
printf, lun, "sz = size(bg,/dimensions)"
printf, lun, "f = file_search(filespec, count=nfiles)"
printf, lun, ";;; Region of interest"
printf, lun, format='("rc = [", I4, ",", I4, "]")', rc
printf, lun, "rad =", rad
printf, lun, ";;; Flags"
printf, lun, "fixap =", (*s).p.fixed[0]
printf, lun, "fixzp =", (*s).p.fixed[1]
printf, lun, "fixnp =", (*s).p.fixed[2]
printf, lun, "fixnm =", (*s).p.fixed[3]
printf, lun, "fixalpha =", (*s).p.fixed[4]
printf, lun, ";;; Starting parameters for fits"
printf, lun, "zp =", (*s).p.zp
printf, lun, "ap =", (*s).p.ap
printf, lun, "np =", (*s).p.np
printf, lun, "alpha =", (*s).p.alpha
printf, lun, "nm =", (*s).p.nm
printf, lun, "lambda =", (*s).p.lambda
printf, lun, "mpp =", (*s).p.mpp
printf, lun, "p = dblarr(2,7,nfiles)"
printf, lun, "pin = double([0, 0, zp, ap, np, alpha, nm])"
printf, lun, "for n = 0, nfiles-1 do begin"
printf, lun, "   x0 = round(rc[0]-rad) > 0"
printf, lun, "   x1 = round(rc[0]+rad) < sz[0]-1"
printf, lun, "   y0 = round(rc[1]-rad) > 0"
printf, lun, "   y1 = round(rc[1]+rad) < sz[1]-1"
printf, lun, "   nx = x1 - x0 + 1"
printf, lun, "   ny = y1 - y0 + 1"
printf, lun, "   xp = rc[0] - x0 - nx/2."
printf, lun, "   yp = rc[1] - y0 - ny/2."
printf, lun, "   a = double((read_image(f[n]))[x0:x1,y0:y1])"
printf, lun, "   a /= bg[x0:x1,y0:y1]"         
printf, lun, "   pin[0:1] += [xp,yp]"
printf, lun, "   pout = fitspheredhm(a, pin, lambda=lambda, mpp=mpp, $"
if deinterlace then $
   printf, lun, "     deinterlace = y0, $"
printf, lun, "     fixap=fixap,fixzp=fixzp,fixnm=fixnm,fixalpha=fixalpha)"
printf, lun, "   pout[0,0:1] += [x0+nx/2., y0+ny/2]"
printf, lun, "   rc = pout[0,0:1]"
printf, lun, "   pin[2:*] = pout[0,2:*]"
printf, lun, "   p[*,*,n] = pout"
printf, lun, "   print, n, pout"
printf, lun, "   write_gdf, p, filename"
printf, lun, "endfor"
printf, lun, "end"
close, lun
free_lun, lun
end