From af000e133ae3649d9faf264b15b2b2a0f2e132bb Mon Sep 17 00:00:00 2001
From: mk <martin@chuck.(none)>
Date: Sun, 29 Aug 2010 23:14:17 +0100
Subject: [PATCH] fov isn't a good way of zooming. it leads to ugly artifacts
 for strong magnification. presumably z-buffer

---
 frontend/draw-model.lisp |  2 +-
 gui/gui.lisp             | 66 +++++++++++++++++++++++++++---------------------
 gui/packages.lisp        |  2 +-
 run.lisp                 | 13 +++++++---
 4 files changed, 48 insertions(+), 35 deletions(-)

diff --git a/frontend/draw-model.lisp b/frontend/draw-model.lisp
index 94c9b46..bba3d9c 100644
--- a/frontend/draw-model.lisp
+++ b/frontend/draw-model.lisp
@@ -104,7 +104,7 @@
 			  (car scale))))
 	       (gl:scale s s s))
 	     (draw-axes)
-	     (translate-v (v* ez (- nf)))
+	     #+nil (translate-v (v* ez (- nf)))
 	     (gl:with-pushed-matrix
 	       (translate-v (v* ez (- nf z-mm)))
 	       (draw-hidden-spheres model)))
diff --git a/gui/gui.lisp b/gui/gui.lisp
index 57fb290..3f22a78 100644
--- a/gui/gui.lisp
+++ b/gui/gui.lisp
@@ -13,17 +13,8 @@
 			      (color 0 0 1) (vertex 0 0 0) (vertex 0 0 1)))
 	      :type function)))
 
-(let ((view-center (list (v))))
-  (defun set-view-center (vec-list)
-    "This function can be called from outside an OpenGL context. The
-supplied list will be used to set the viewpoint with glLookAt. It is
-consumed from the front."
-    (declare (cons vec-list))
-    (assert (equal (type-of (car vec-list))
-		   (type-of (v))))
-    (setf view-center vec-list))
-  
-    (defmethod set-view ((w fenster) &optional (2d nil) (view-center (v)))
+(defmethod set-view ((w fenster) &key (2d nil) (view-center (v))
+		     (fov 30d0))
       (load-identity)
       (viewport 0 0 (width w) (height w))
       (matrix-mode :projection)
@@ -33,36 +24,53 @@ consumed from the front."
 	(let ((x (vec-x view-center))
 	      (y (vec-y view-center))
 	      (z (vec-z view-center)))
-	  (glu:perspective 30 (/ (width w) (height w)) .01 100)
+	  (glu:perspective fov (/ (width w) (height w)) .01 100)
 	  (glu:look-at 20 30 10
 		       x y z
 		       0 0 1)))
       (matrix-mode :modelview)
       (load-identity))
+
+(let ((field-of-view (list 30d0))
+      (view-center (list (v))))
+  (defun update-view (&key (center-list view-center)
+		      (fov-list field-of-view))
+    "This function can be called from outside an OpenGL context. The
+supplied lists will be used to set the viewpoint with glLookAt. It is
+consumed from the front."
+    (declare (cons center-list fov-list))
+    (assert (equal (type-of (car center-list))
+		   (type-of (v))))
+    (assert (numberp (car fov-list)))
+    (setf view-center center-list
+	  field-of-view fov-list))
+
+  (defmethod ensure-uptodate-view ((w fenster))
+    (labels ((pop-until-last (l)
+	       (if (cdr l)
+		   (pop l)
+		   (car l))))
+      (set-view w :view-center (pop-until-last view-center)
+		:fov (pop-until-last field-of-view))))
+  
+  (defmethod display ((w fenster))
+    (ensure-uptodate-view w)
+    (clear :color-buffer-bit :depth-buffer-bit)
+    (load-identity)
     
-    (defmethod ensure-uptodate-view-center ((w fenster))
-      (if (cdr view-center)
-	  (set-vew w nil (pop view-center))
-	  (set-view w nil (car view-center))))
-    (defmethod display ((w fenster))
-      (ensure-uptodate-view-center w)
-      (clear :color-buffer-bit :depth-buffer-bit)
-      (load-identity)
-      
-      (funcall (draw-func w))
-      
-      (swap-buffers)
-      (sleep (/ 20))
-      (post-redisplay)))
+    (funcall (draw-func w))
+    
+    (swap-buffers)
+    (sleep (/ 20))
+    (post-redisplay)))
 
 (defmethod reshape ((w fenster) x y)
   (setf (width w) x
 	(height w) y)
-  (set-view w))
+  (ensure-uptodate-view w))
 
 (defmethod display-window :before ((w fenster))
-  (set-view w))
-
+  (ensure-uptodate-view w))
 
 (defmethod passive-motion ((w fenster) x y)
   (setf (aref (cursor-position w) 0) x
diff --git a/gui/packages.lisp b/gui/packages.lisp
index bb54e22..992602f 100644
--- a/gui/packages.lisp
+++ b/gui/packages.lisp
@@ -14,4 +14,4 @@
 	   #:draw-axes
 	   #:draw-xz
 	   #:draw-wire-box
-	   #:set-view-center))
+	   #:update-view))
diff --git a/run.lisp b/run.lisp
index 53eb1bf..3b6e597 100644
--- a/run.lisp
+++ b/run.lisp
@@ -61,13 +61,18 @@
 (update-scale 1 40)
 
 
+
 #+nil 
 (let* ((obj (lens:make-objective))
        (n (lens::immersion-index obj))
-       (f (lens::focal-length obj)))
-  (gui:set-view-center (list 
-			(v+ (first (centers-mm *model*))
-			    (make-vec 0d0 0d0 (* n f))))))
+       (f (lens::focal-length obj))
+       (nucleus-position (elt (centers-mm *model*) 6))
+       (center (make-vec (vec-x nucleus-position)
+			 (vec-y nucleus-position))))
+  (defparameter *look* nucleus-position)
+  (gui:update-view :fov-list (list 40d0)
+		   :center-list (list (v- (make-vec 0d0 0d0 (* n f))
+					  center))))
 
 #+nil
 (with-gui
-- 
2.11.4.GIT