;;;;"metallic.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/metallic.html

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

(define (round-from-table table column)
  (define get  (dbinterp:memoize (table 'get column) 3))
  (define prev (dbinterp:memoize (table 'isam-prev) 3))
  (define next (table 'isam-next))
  (lambda (x)
    (let ((nxt (next x)))
      (if nxt (set! nxt (car nxt)))
      (let ((prv (prev (or nxt x))))
	(if prv (set! prv (car prv)))
	(cond ((not nxt) (get prv))
	      ((not prv) (get nxt))
	      (else
	       (if (> (/ (- x prv) (- nxt prv)) .5)
		   (get nxt)
		   (get prv))))))))

;;; 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)

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

(define Ag (interpolate-from-table (open-table nk 'Ag) 2))
(define Al (interpolate-from-table (open-table nk 'Al) 2))
(define Au (interpolate-from-table (open-table nk 'Au) 2))
;;;Glasses
(define COR7059 (interpolate-from-table (open-table nk 'COR7059) 2))
(define sio2 (interpolate-from-table (open-table nk 'sio2) 2))
(define ZnS (interpolate-from-table (open-table nk 'zns) 2))

(define MgF2 (interpolate-from-table (open-table nk 'MgF2) 2))
(define Cr (interpolate-from-table (open-table nk 'Cr) 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)

;;; Matches at 0.o and 45.o
(define (protected-al)
  (browse-optics-url "http://www.kruschwitz.com/HR%27s.htm")
  (plot-response
   (title "Protected Aluminum Mirror#Protected Metal" "protected-al")
   (output-format 'png 440 155)
   (font 13)
   (range .7 .95)
   (incident 0 'R)
   (wavelengths .3e-6 .9e-6)
   (stack-colors 'blue 'red 50)
   (optical-stack (layer     1.45      (/ 1.75 4) .6e-6)
		  (substrate AL))
   (optical-stack (layer     2         (/ 1.65 4) .6e-6)
		  (substrate AL))
   (optical-stack (substrate AL)))
  (plot-response
   (title "Protected Aluminum Mirror#Protected Metal" "protected-al45")
   (output-format 'png 440 155)
   (font 13)
   (range .7 .95)
   (incident 45 'R)
   (wavelengths .3e-6 .9e-6)
   (stack-colors 'blue 50)
   (optical-stack (layer     1.45      (/ 1.75 4) .6e-6)
		  (substrate AL))
   (optical-stack (substrate AL))))

;;; Matches for one, two, and three HL pairs.
(define (enhanced-al)
  ;;... by increasing the number of periods, the
  ;;reflectivity increases, but the high reflectivity region narrows.
  (define H 2.40)
  (define L 1.46)
  (browse-optics-url "http://www.kruschwitz.com/HR%27s.htm#Enhanced Metal")
  (plot-response
   (title "Enhanced Aluminum Mirror" "enhanced-al")
   (output-format 'png 435 155)
   (font 13)
   (range .6 1)
   (wavelengths .3e-6 .9e-6)
   (incident 0 'R)
   (stack-colors 50 'blue 'red 'apple)
   (optical-stack (substrate AL))
   (optical-stack
    (nominal  550e-9)
    (layer     H         1/4)
    (layer     L         1/4)
    (substrate AL))
   (optical-stack
    (nominal  550e-9)
    (layer     H         1/4)
    (layer     L         1/4)
    (layer     H         1/4)
    (layer     L         1/4)
    (substrate AL))
   (optical-stack
    (nominal  550e-9)
    (layer     H         1/4)
    (layer     L         1/4)
    (layer     H         1/4)
    (layer     L         1/4)
    (layer     H         1/4)
    (layer     L         1/4)
    (substrate AL))))

(define (al-mirror)
  (browse-optics-url "http://web.archive.org/web/20071011010822/http://www.mellesgriot.com/products/optics/oc_5_1.htm")
  (plot-response
   (title "Aluminum Mirror (/016)" "Al-mirror")
   (output-format 'png 390 200)
   (font 13)
   (range .75 1)
   (incident 0 'R)
   (wavelengths .4e-6 1.1e-6)
   (stack-colors 'red)
   (optical-stack (substrate Al))))

(define (zal-mirror)
  (define ral (round-from-table (open-table nk 'al) 2))
  (browse-optics-url "http://web.archive.org/web/20071011010822/http://www.mellesgriot.com/products/optics/oc_5_1.htm")
  (plot-response
   (title "Aluminum Mirror" "zAl-mirror")
   (output-format 'png 440 225)
   (font 13)
   (incident 0 'R)
   (wavelengths .75e-6 .925e-6)
   (IR ral 'n 'ec)
   ;;(IR al 'n 'k 'ec)
   (optical-stack (substrate ral))))

(define (Si2O3-Al)
  (define Si2O3 1.65)
  (define SrF2 1.4)
  (browse-optics-url "http://www.cvimellesgriot.com/Products/Protected-Aluminum-Flat-Mirrors.aspx")
  (plot-response
   (title "Si2O3 Protected Aluminum (/011)" "Si203-Al")
   (output-format 'png 395 205)
   (font 13)
   (range .7 1)
   (incident 0 'R)
   (incident 45 'R_s 'R_p)
   ;;(IR AL 'real 'imag)
   (wavelengths 400e-9 750e-9)
   (optical-stack
    (nominal 550e-9)
    (layer     Si2O3      1/2)		;Si2O3
    (substrate AL)
    )))

(define (bare-au)
  ;;(define au (round-from-table (open-table nk 'au) 2))
  (browse-optics-url "http://www.cvimellesgriot.com/Products/Bare-Gold-and-Protected-Gold-Flat-Mirrors.aspx")
  (plot-response
   (title "Bare Gold (/45)" "Au-mirror")
   (output-format 'png 390 200)
   (font 13)
   (range 0 1)
   (incident 0 'R)
   (wavelengths .4e-6 24e-6)
   ;;(IR Au 'n 'ec)
   (stack-colors 'red)
   (optical-stack (substrate Au))))

;;;; From US patent 4,337,990 issued May. 1976 to Fan et al.
;;; 359/360. Transparent heat-mirror
;;; Poor match.  TiO2 has bad UV kink
(define (hot-mirror-2)
  (let ((stk
	 (optical-stack
	  (layer TiO2 18e-9)
	  (layer Ag   18e-9)
	  (layer TiO2 18e-9)
	  ;;(layer (lambda (w) (if (< w 2e-6) (COR7059 w) (SiO2 w))) 1e-3)
	  (layer COR7059 1e-3)
	  )))
    (browse-optics-url "http://patft.uspto.gov/netacgi/nph-Parser?Sect1=PTO1&Sect2=HITOFF&d=PALL&p=1&u=/netahtml/srchnum.htm&r=1&f=G&l=50&s1=4,337,990.WKU.&OS=PN/4,337,990&RS=PN/4,337,990")
    (plot-response (title "Hot Mirror transmission, reflection @ 0\\353" "hot-2")
		   (color-swatch 0 'T)
		   (color-swatch 0 'R)
		   (output-format 'png 420 365)
		   (font 13)
		   (range 0 1)
		   (incident 0 'R 'T)
		   (samples 1200)
		   (logarithmic 0.3e-6 2e-6)
		   stk)
    (plot-response (title "Transmission, reflection @ 0\\353, 0.03.um Gaussian spread" "hot-2g")
		   (output-format 'png 420 365)
		   (font 13)
		   (range 0 1)
		   (incident 0 'R 'T)
		   (logarithmic 0.3e-6 2e-6)
		   (samples 1200)
		   (smooth 0.025)	; Smoothing is on logarithmic abscissa
		   (IR TiO2 'real 'ec)
		   stk)
    (plot-response (title "Hot Mirror transmission @ 0\\353, 40\\353 with 0.03um Gaussian" "hot-4g")
		   (output-format 'png 410 353)
		   (font 13)
		   (range 0 1)
		   (incident 0 'T)
		   (incident 40 'T)
		   (logarithmic 0.3e-6 2e-6)
		   (samples 1200)
		   (smooth 0.025)	; Smoothing is on logarithmic abscissa
		   stk)))

;;; United States Patent  	6,399,228
;;; Simpson 	June 4, 2002
;;; Multi-layer interference coatings
(define (r-d-a-d)
  (plot-response
   (title "reflector-dielectric-absorber-dielectric" "RDAD")
   (output-format 'png 410 250)
   (font 13 "88888" "88")
   (incident 0 'R)
   (range 0 1)
   (wavelengths 370e-9 800e-9)
   (color-swatch 0 'R)
   (optical-stack
    (layer	MgF2	320e-9)
    (layer	Cr	6e-9)
    (layer	MgF2	320e-9)
    (substrate	Ag)
    )))

(define (metal-bp)
  ;;(define AU 1.693+1.883i)
  (define BK7 1.5164)
  (define SiO2 1.4)
  (define TiO2 2.45)
  (browse-optics-url "http://www.sspectra.com/designs/mdbp.html")
  (plot-response
   (title "Metal-Dielectric Bandpass Filter" "metal-bp")
   (output-format 'png 560 215)
   (font 13)
   (incident 0 'T)
   ;;(IR AU 'real 'imag)
   (range 0 1)
   (wavelengths .7e-6 1e-6)
   (marker 8.70e-7)
   (optical-stack
    (nominal  870e-9)
    (layer     TIO2     101.94e-9)
    (layer     AU        24.97e-9)
    (layer     SIO2     127.87e-9)
    (layer     TIO2      94.24e-9)
    (layer     SIO2     302.57e-9)
    (layer     TIO2      94.24e-9)
    (layer     SIO2     121.94e-9)
    (layer     AU        23.33e-9)
    (substrate  BK7)
    )))

(define (dual-bp)
  ;;(define AU 1.693+1.883i)
  (define BK7 1.5164)
  (define SiO2 1.4)
  (define TiO2 2.4)
  (browse-optics-url "http://www.sspectra.com/designs/mdbp2.html")
  (plot-response
   (title "Metal-Dielectric Dual Bandpass Filter" "dual-bp")
   (output-format 'png 560 215)
   (font 13)
   (range 0 1)
   (incident  0 'T)			; 'A
   (wavelengths .7e-6 1e-6)
   (marker .770e-6 .920e-6)
   (optical-stack
    (nominal .920e-6)
    (layer  AU        10.76e-9)
    (layer  SIO2     102.01e-9)
    (layer  TIO2      95.25e-9)
    (layer  SIO2      10.49e-9)
    (layer  AU         4.16e-9)
    (layer  SIO2     270.66e-9)
    (layer  TIO2      93.69e-9)
    (layer  SIO2     152.40e-9)
    (layer  TIO2      39.24e-9)
    (layer  SIO2      49.67e-9)
    (layer  TIO2      96.33e-9)
    (layer  SIO2     115.39e-9)
    (layer  AU        16.58e-9)
    (substrate  BK7)
    )))

(define (ZnS-chart)
  (define wv (/ 5461e-10 (real-part (ZnS 5461e-10))))
  (write-color-table.png (string-append "ZnS-" "D65")
			 ZnS (/ wv 8) wv 8 1.55 30 'R CIE:SI-D65))

(define (ZnS-colors)
  (define wv 5461e-10)
  (apply plot-response
	 (title "ZnS" "ZnS")
	 (color-swatch 0 'R)
	 (color-swatch 45 'R)
	 (do ((th*8 8 (+ th*8 -1))
	      (stks '()
		    (cons (optical-stack (nominal wv)
					 (layer ZnS (/ th*8 8))
					 (substrate 1.55))
			  stks)))
	     ((zero? th*8) stks))))

(define (metallic)
  (protected-al)
  (enhanced-al)
  (al-mirror)
  (zal-mirror)
  (Si2O3-Al)
  (bare-au)
  (hot-mirror-2)
  (metal-bp)
  (dual-bp)
  (r-d-a-d)
  ;;(ZnS-chart)
  (ZnS-colors))

;;(metallic)