home *** CD-ROM | disk | FTP | other *** search
/ vis-ftp.cs.umass.edu / vis-ftp.cs.umass.edu.tar / vis-ftp.cs.umass.edu / pub / Software / ASCENDER / ascender.tar.Z / ascender.tar / Epipolar / rcde-display.lisp < prev    next >
Lisp/Scheme  |  1996-03-05  |  6KB  |  146 lines
  1. ;;; RCDE-DISPLAY.LISP
  2. ;;;
  3. ;;; Interface to RCDE graphics routines
  4. ;;;
  5. ;;; Author: Robert T. Collins
  6. ;;; Date: Mar 4, 1995
  7. ;;;
  8. ;-----------------------------------------------------------------
  9. ; (c) Copyright 1995 by The University of Massachusetts
  10. ;------------------------------------------------------------------
  11.  
  12. (in-package 'cme)
  13.  
  14. (defvar *%%tmpvec* (cme::make-coordinate-vector 3))
  15.  
  16. (defmacro inline-transform (transform position &optional to-vector)
  17.   `(let ((transform ,transform)
  18.          (position ,position)
  19.          (to-vector ,to-vector) )
  20.      (unless to-vector (setf to-vector *%%tmpvec*))
  21.      (unless (vectorp position)
  22.        (setq position (cme::position-to-vector position to-vector )))
  23.      (if (null transform)
  24.          position
  25.          (cme::transform-vector transform position to-vector))))
  26.  
  27. (defmacro with-display-context ((var pane color thickness) &body body)
  28.   `(with-window-drawing-context (%dc% ,pane)
  29.      (ic::with-drawing-context-line-width (%dc% ,thickness)
  30.         (with-drawing-context-color (%dc% ,color)
  31.       (let ((,var %dc%))
  32.         ,@body)))))
  33.  
  34.  
  35. ;;;;****************************************************************
  36. ;;;;  DISPLAYING LINE TOKENSETS
  37.  
  38. (defun display-line-tokenset (view tks &key (color "YELLOW") (thickness 1))
  39.   "Display an ISR2 line tokenset (endpts are stored in 2D-world coords)."
  40.   (let ((transform (2d-to-window-transform view)))
  41.     (with-display-context (dc (view-window view) color thickness)
  42.        (isr2::for-every-token (tok tks (x1 y1 x2 y2))
  43.      (bind-vector-elements 
  44.        (u1 v1)(inline-transform transform
  45.                    (list (isr2::value x1) (isr2::value y1)))
  46.        (bind-vector-elements
  47.         (u2 v2)(inline-transform transform
  48.              (list (isr2::value x2) (isr2::value y2)))
  49.         (dc-draw-line dc u1 v1 u2 v2)))))))
  50.  
  51.  
  52. (defun display-line (view x1 y1 x2 y2 &key (color "YELLOW") (thickness 1)
  53.               (transform (2d-to-window-transform view)))
  54.   "Display a line segment (specified in 2D-world coords)."
  55.   (with-display-context (dc (view-window view) color thickness)
  56.      (bind-vector-elements 
  57.       (u1 v1)(inline-transform transform (list x1 y1))
  58.       (bind-vector-elements
  59.        (u2 v2)(inline-transform transform (list x2 y2))
  60.        (dc-draw-line dc u1 v1 u2 v2)))))
  61.  
  62.  
  63. ;;;;****************************************************************
  64. ;;;;  ZOOMING DISPLAY WITH RESPECT TO A BOUNDING BOX
  65.  
  66.  
  67. (defun zoom-in-around-pixel (view pixelx pixely)
  68.   "Zoom in using pixelx, pixely as zoom center point."
  69.   (cme::bind-vector-elements (xcenter ycenter)
  70.        (cme::inline-transform 
  71.       (cme::inverse-transform (cme::image-to-2d-transform view))
  72.       (list pixelx pixely))
  73.     (ic::zoom-in view :x xcenter :y ycenter)))
  74.  
  75. (defun zoom-out-around-pixel (view pixelx pixely)
  76.   "Zoom out using pixelx, pixely as zoom center point."
  77.   (cme::bind-vector-elements (xcenter ycenter)
  78.        (cme::inline-transform 
  79.       (cme::inverse-transform (cme::image-to-2d-transform view))
  80.       (list pixelx pixely))
  81.     (ic::zoom-out view :x xcenter :y ycenter)))
  82.  
  83.  
  84. (defun center-around-pixel (view pixelx pixely)
  85.   "Center the view at pixelx, pixely."
  86.   (cme::bind-vector-elements (xcenter ycenter)
  87.        (cme::inline-transform 
  88.       (cme::inverse-transform (cme::image-to-2d-transform view))
  89.       (list pixelx pixely))
  90.      (ic::set-image-position-at-window-center
  91.         view  xcenter ycenter (cme::view-window view))))
  92.  
  93. (defun zoom-to-bounding-box (view minx miny maxx maxy &optional (pixel-border 0))
  94.   "Focus in on a particular bounding box (given in 2D-world coords)."
  95.   (setf minx (- minx pixel-border) miny (- miny pixel-border)
  96.     maxx (+ maxx pixel-border) maxy (+ maxy pixel-border))
  97.   (let* ((dx (- maxx minx))
  98.      (dy (- maxy miny))
  99.      (cx (+ minx (/ dx 2)))
  100.      (cy (+ miny (/ dy 2))))
  101.     (let* ((zoomfac (truncate (log (cme::view-zoom-factor view) 2)))
  102.        (pane (cme::view-window view))
  103.        (paneheight (ic::inside-height pane))
  104.        (panewidth (ic::inside-width pane))
  105.        (newzoom (min (floor (log (/ panewidth dx) 2))
  106.              (floor (log (/ paneheight dy) 2)))))
  107.       (cond
  108.        ((= zoomfac newzoom)       ;;just recenter
  109.     (center-around-pixel view cx cy))
  110.        ((< zoomfac newzoom)       ;;zoom in
  111.     (dotimes (i (- newzoom zoomfac))
  112.        (zoom-in-around-pixel view cx cy)))
  113.        (t                         ;;zoom out
  114.     (dotimes (i (- zoomfac newzoom))
  115.        (zoom-out-around-pixel view cx cy))))
  116.       (ic::refresh (cme::view-window view)))))
  117.  
  118.  
  119. #|
  120.  
  121.  
  122. (defun foo (view)
  123.   (let* ((w2i (cme::inverse-transform (cme::image-to-window-transform view)))
  124.      (w2s (cme::inverse-transform (cme::2d-to-window-transform view)))
  125.      (zoomfac (cme::view-zoom-factor view))
  126.      (pane (cme::view-window view))
  127.      (winlowleft (list 0 (ic::inside-height pane)))
  128.      (winupright (list (ic::inside-width pane) 0))
  129.      (iboxll (la::listarray (cme::inline-transform w2i winlowleft)))
  130.      (iboxur (la::listarray (cme::inline-transform w2i winupright)))
  131.      (sboxll (la::listarray (cme::inline-transform w2s winlowleft)))
  132.      (sboxur (la::listarray (cme::inline-transform w2s winupright))))
  133.     (format t "zoom factor: ~d~%" zoomfac)
  134.     (format t "pane width: ~d   height: ~d~%"
  135.         (ic::inside-width pane) (ic::inside-height pane))
  136.     (format t "image window (~,2f ~,2f) to (~,2f ~,2f)~%"
  137.         (elt iboxll 0) (elt iboxll 1) (elt iboxur 0) (elt iboxur 1))
  138.     (format t "sensor window (~,2f ~,2f) to (~,2f ~,2f)~%"
  139.         (elt sboxll 0) (elt sboxll 1) (elt sboxur 0) (elt sboxur 1))
  140.     (format t "  width: ~,2f   height: ~,2f~%"
  141.         (- (elt sboxur 0) (elt sboxll 0))
  142.         (- (elt sboxur 1) (elt sboxll 1)))))
  143.  
  144.  
  145. |#
  146.