Lots of changes

2022-10-12 15:56:48 +02:00
parent a61f15df44
commit cb2dad39ec
9 changed files with 227 additions and 43 deletions
--- a/lib/Petzval/Examples.hs
+++ b/lib/Petzval/Examples.hs
@@ -0,0 +1,69 @@
+module Petzval.Examples where
+
+import Control.Lens
+import Data.Either
+import Petzval.Optics
+import Petzval.Optics.RTM
+import Petzval.System
+import Petzval.Trace
+import Petzval.Calculations
+import Linear
+import Numeric.AD.Mode (Scalar, Mode)
+
+import qualified Debug.Trace 
+
+bk7 = SellemeierMat [ (1.03961212,  6.00069867e-3 )
+                    , (0.231792344, 2.00179144e-2 )
+                    , (1.01046945,  103.560653 )]
+n_sk16 = SellemeierMat [ (1.343177740, 0.007046873)
+                       , (0.241144399, 0.0229005000)
+                       , (0.994317969, 92.75085260)]
+
+n_ssk8 = SellemeierMat [ (1.44857867, 1.17965926e-01)
+                       , (1.06937528, 8.69310149E-03)
+                       , (4.21566593E-02, 1.11300666E+02) ]
+
+system1 :: Num a => [Element SellemeierMat a]
+system1 =
+  [ Stop{_thickness = 0, _outsideRadius=5}
+  , Surface{_material = bk7, _thickness = 10, _roc = 100, _outsideRadius=10}
+  , Surface{_material = air, _thickness = 95, _roc = -100, _outsideRadius=10}
+  ]
+
+system2 :: Fractional a => [Element ConstMat a]
+system2 =
+  [
+    Surface{_material = s_sk16, _outsideRadius=11.5, _roc=42.98790, _thickness = 4}
+  , Surface{_material = air, _outsideRadius = 11.5, _roc = -248.07740, _thickness = 10.51018}
+  , Surface{_material = s_f4, _outsideRadius = 9.852, _roc = -38.21035, _thickness = 2.5}
+  , Surface{_material = air, _outsideRadius = 8.885, _roc = 43.95894, _thickness = 0}
+  , Stop{_outsideRadius = 8.6762522794, _thickness = 9.86946}
+  , Surface{_material=s_sk16, _outsideRadius = 11, _roc=656.66349, _thickness = 4.5}
+  , Surface{_material = air, _outsideRadius = 11, _roc = -33.50754, _thickness = 86.48643}
+  ]
+  where s_sk16 = ConstMat 1.620408
+        s_f4 = ConstMat 1.616589
+
+trace1 :: Show a => String -> a -> a
+trace1 msg = (msg++) . show >>= Debug.Trace.trace
+trace1 _ = id
+merit :: (Material mat, RealFloat a, Scalar a ~ Double, Epsilon a, Mode a, Show a) => [Element mat a] -> a
+-- merit :: (Material mat) => [Element mat Double] -> Double
+merit system = result 
+  where baked = bake 0.587618 system
+        ep = trace1 "EP: " $ entrancePupil baked
+        result = sum
+          . map (^2)
+          . map (\ angle -> rmsSize
+                  . toListOf (each._pos._xy)
+                  -- . (\x -> x :: [Ray a])
+                  . rights
+                  . map fst
+                  . map (trace1 "Trace: " . raytrace baked . trace1 "Ray: " . createRay Nothing ep angle . trace1 "Pupil: ")
+                  $ spiralPattern 10)
+          $ [0, 7.07, 15]
+
+cast1 system = result
+  where baked = bake 0.587618 system
+        ep = trace1 "EP: " $ entrancePupil baked
+        result = raytrace baked . trace1 "Ray: " . createRay Nothing ep 15 . trace1 "Pupil: "