;;;;"granular.scm" FreeSnell optics validation suite	-*-scheme-*-
;;; Copyright (C) 2003, 2004, 2005, 2009 Aubrey Jaffer

;;; 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 3 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, USA.

;;; http://people.csail.mit.edu/jaffer/FreeSnell/granular.html

(require 'FreeSnell)
(require 'databases)
(require 'database-interpolate)

;;; Reducing the size of plots to closer match the web plots.
;;;(define graph:dimensions '(512 256))
;;;(define graph:font-size 13)
;;; Output png files for validation webpage.
;;;(define *output-format* 'png)

(defvar nk (open-database (or (getenv "NK_DATABASE_PATH") "nk.rwb") 'rwb-isam))
;;(defvar nk (open-database "/home/jaffer/cool/nk-sopra.rwb" 'rwb-isam))
(defvar mgo (interpolate-from-table (open-table nk 'mgo) 2))

(defvar au (interpolate-from-table (open-table nk 'au) 2))
(defvar cu (interpolate-from-table (open-table nk 'cu) 2))
(defvar ag (interpolate-from-table (open-table nk 'ag) 2))
;; The GranFilm "Dielectrics" directory has a different version of
;; al.nk.
(defvar granfilm.nk
  (if (file-exists? "granfilm.rwb")
      (open-database "granfilm.rwb" 'rwb-isam)
      nk))
(defvar al (interpolate-from-table (open-table granfilm.nk 'al) 2))

(defvar Co (interpolate-from-table (open-table nk 'Co) 2))
(defvar Pd (interpolate-from-table (open-table nk 'Pd) 2))
(defvar Pt (interpolate-from-table (open-table nk 'Pt) 2))
(defvar Ti (interpolate-from-table (open-table nk 'Ti) 2))

;;;Glasses
(defvar BK7 (interpolate-from-table (open-table nk 'BK7) 2))

;;;; Handy for comparing FreeSnell graphs to optics on the web
(define optics:tmp "/tmp/optics.url")
(define (browse-optics-url url)
  (define current-url (and (file-exists? optics:tmp)
			   (call-with-input-file optics:tmp read)))
  (cond ((equal? url current-url))
	(else (call-with-output-file optics:tmp
		(lambda (oport) (write url oport)))
	      (browse-url url))))
(define (browse-optics-url url) url)

(define (view-image name) (system (string-append "xv \"" name "\"")))
(define (view-image name) name)

(define (gold-ruby-glass)
  (define (grg02 w) (granular-IR (au w) 2e-6 1.5))
  (define (grg08 w) (granular-IR (au w) 08e-6 1.5))
  (define (grg14 w) (granular-IR (au w) 14e-6 1.5))
  (plot-response
   (title "gold-ruby-glass" "gold-ruby-glass")
   (output-format 'png 350 250)
   (font 14 "+12.0" "+12.0 kk")
   (range 0 1)
   (wavelengths 380e-9 780e-9)
   (incident 0 'T)
   (IR grg02 'ec)
   (IR grg08 'ec)
   (IR grg14 'ec)
   (color-swatch 0 'T)
   (optical-stack (layer* grg02 4e-3))
   (optical-stack (layer* grg08 4e-3))
   (optical-stack (layer* grg14 4e-3))))

(define (polymer-ag)
  (define (metal w) (granular-IR (ag w) 1/6 1.5))
  (define (metal/2 w) (granular-IR (ag w) 1/12 1.5))
  (define thk 154e-9)
  (define trns 0.15)
  (browse-optics-url "http://web.mit.edu/cmse/www/IRG-II-2.nug02.html")
  (plot-response
   (title "Polymer-Ag" "poly-Ag")
   (output-format 'png 535 250)
   (font 13 "+0.80" "0")
   (IR metal 'real 'ec)
   (IR metal/2 'real 'ec)
   (color-swatch 0 'R)
   (color-swatch 35 'R)
   (incident 35 'R)
   (wavelengths 300e-9 1500e-9)
   (range 0 1)
   (stack-colors 'burgundy)
   (optical-stack (nominal 1.03e-6)
		  (repeat 4
			  (layer metal/2  (* trns thk))
			  (layer metal (* (- 1 (* 2 trns)) thk))
			  (layer metal/2  (* 2 trns thk))
			  (layer 1.5   (* (- 1 (* 2 trns)) thk))
			  (layer metal/2  (* trns thk))
			  )
		  (layer metal/2  (* trns thk))
		  (layer metal (* (- 1 (* 2 trns)) thk))
		  (layer metal/2  (* 2 trns thk))
		  (substrate BK7)))
  (view-image "poly-Ag.png"))

(define (AgMgO)
  (define (metal w) (granular-IR (Ag w) 0.67 1))
  (browse-optics-url "http://www.phys.ntnu.no/~ingves/Software/GranularFilm/")
  (plot-response
   (title "3.0.nm Ag deposit on an MgO substrate" "AgMgO-3.0")
   (output-format 'png 400 333)
   (font 16 "+12.0" "0")
   (range -4 14)
   (eVs 1 4.5)
   ;;(IR MgO 'real 'R0)
   (incident 45 '(/ (- R_p .023) .023))
   (stack-colors 'lusty)
   (optical-stack (layer metal 3e-9)
		  (substrate MgO)))
  (view-image "AgMgO-3.0.png")
  (plot-response
   (color-swatch 30 'R)
   (title "3.nm Ag deposit on an MgO substrate (fudged)" "AgMgO-3")
   (output-format 'png 400 333)
   (font 16 "+12.0" "0")
   (range -1 3.5)
   (eVs 1 4.5)
   (incident 45 '(/ (- R_p .023) .078))
   (stack-colors 'lusty)
   (optical-stack (layer metal 3e-9)
		  (substrate MgO)))
  (view-image "AgMgO-3.png")
  )

(define (AgMgO-p)
  (define gwidth 440)
  (define gheight 285)
  (define fsize 16)
  ;;(define MgO 1.746)
  (define (metal w) (granular-IR (Ag w) 0.67 1))
  (browse-optics-url "http://www.phys.ntnu.no/~ingves/Software/GranularFilm/")
  (plot-response
   (title "3.nm Ag deposit on an MgO substrate; p-polarization" "AgMgO-p")
   (output-format 'png gwidth gheight)
   (font fsize)
   (range 0 1)
   (eVs 1.5 5)
   (incident 45 'R_p 'A_p 'T_p)
   ;;(IR Ag 'real 'imag 'ec)
   (optical-stack (layer metal 3e-9)
		  (layer MgO 1e-9)
		  ;;(substrate MgO)
		  ))
  (view-image "AgMgO-p.png")
  (plot-response
   (title "3.nm Ag deposit on an MgO substrate; s-polarization" "AgMgO-s")
   (output-format 'png gwidth gheight)
   (font fsize)
   (range 0 1)
   (eVs 1.5 5)
   (incident 45 'R_s 'A_s 'T_s)
   (optical-stack (layer metal 3e-9)
		  (substrate MgO)
		  ))
  (view-image "AgMgO-s.png"))

(define (AgMgO-ang)
  (define gwidth 335)
  (define gheight 320)
  (define fsize 16)
  (define (metal w) (granular-IR (Ag w) 0.67 1))
  (browse-optics-url "http://www.phys.ntnu.no/~ingves/Software/GranularFilm/")
  (view-image "MgO-ang.png")
  (plot-response
   (title "3.nm Ag deposit on an MgO substrate" "AgMgO-ang")
   (output-format 'png gwidth gheight)
   (font fsize "+12.0" "0")
   (range 0 1)
   (angles 0 90)
   ;;(marker 78)
   (wavelength (eV<->L 2.5) 'R_p 'R_s)
   (stack-colors 0 40)
   (optical-stack (layer metal 3e-9) (substrate MgO))
   (optical-stack (substrate MgO)))
  (view-image "AgMgO-ang.png"))

(define (nobles)
  (define (gAg w) (granular-IR (Ag w) 0.67 1))
  (define (gCu w) (granular-IR (Cu w) 0.67 1))
  (define (gAu w) (granular-IR (Au w) 0.67 1))
  (define (gAl w) (granular-IR (Al w) 0.67 1))
  (browse-optics-url "http://www.phys.ntnu.no/~ingves/Software/GranularFilm/")
  (plot-response
   (title "3.nm noble metal deposit on an MgO substrate" "nobles")
   (output-format 'png 270 270)
   (font 12 "+12.0" "")
   (range -1 12.5)
   (eVs 1.5 5)
   (incident 45 '(/ (- R_p .023) .023))
   (optical-stack (layer gAg 3e-9)
		  (substrate MgO))
   (optical-stack (layer gAu 3e-9)
		  (substrate MgO))
   (optical-stack (layer gCu 3e-9)
		  (substrate MgO))
   (optical-stack (layer gAl 3e-9)
		  (substrate MgO)))
  (view-image "nobles.png"))

(define (transitions)
  (define (gCo w) (granular-IR (Co w) 0.67 1))
  (define (gPd w) (granular-IR (Pd w) 0.67 1))
  (define (gPt w) (granular-IR (Pt w) 0.67 1))
  (define (gTi w) (granular-IR (Ti w) 0.67 1))
  (browse-optics-url "http://www.phys.ntnu.no/~ingves/Software/GranularFilm/")
  (plot-response
   (title "3.nm transition metal deposit on an MgO substrate" "transitions")
   (output-format 'png 270 270)
   (font 12 "+12.0" "")
   (range .05 1.35)
   (eVs 1.5 5)
   (incident 45 '(/ (- R_p .023) .023))
   (stack-colors 'cobalt 'apple 'lusty 'oldbrick)
   (optical-stack (layer gCo 3e-9)
		  (substrate MgO))
   (optical-stack (layer gPt 3e-9)
		  (substrate MgO))
   (optical-stack (layer gPd 3e-9)
		  (substrate MgO))
   (optical-stack (layer gTi 3e-9)
		  (substrate MgO)))
  (view-image "transitions.png"))

(define (charts str illu)
  ;;(define BK7 1.5164)
  (write-color-table.png (string-append "Ag-" str) Ag 1e-9 100e-9 20 1.5 0 'B illu)
  (write-color-table.png (string-append "Au-" str) Au 1e-9 100e-9 20 1.5 0 'B illu)
  ;;(write-color-table.png (string-append "Ag-tr-" str) Ag 1e-9 100e-9 20 BK7 30 'T illu)
  ;;(write-color-table.png (string-append "Au-tr-" str) Au 1e-9 100e-9 20 BK7 30 'T illu)
  )

(define (make-charts)
  (charts "D65" CIE:SI-D65)
  ;;(charts "A" CIE:SI-A)
  )

(define (granular)
  (gold-ruby-glass)
  (polymer-ag)
  (AgMgO)
  (AgMgO-p)
  (AgMgO-ang)
  (nobles)
  (transitions)
  (make-charts))

;;(granular)