;;; -*- Mode: Lisp; Syntax: Common-lisp; Package: MU; Base: 10.; -*-

;;; Copyright (c) 1988, Massachusetts Institute of Technology
;;; Authors: Mike Drumheller, Walter E. Gillett

(in-package :mu)

;;; Contains user interface functions for parallel stereo code.  Master routine:
;;; *stereo.  The guts of the stereo algorithm are in the file "stereo".

(proclaim '(special *x-warp-array* *y-warp-array* *left-256* *right-256*))
(proclaim '(*defun warp-with-router!!))

;(*proclaim '(*defun
;	     diffusion-interpolation!!
;	     thin-plate-interpolation!!
;	     contour-map!!
;	     fill-borders!!
;	     remove-isolated-pixels!! 
;	     clear-if-high-variance-or-if-very-different-from-mean!!
;	     *stereo-on-edge-images winning-scores!!))

(*defunc *STEREOMATCHING (left-edges-source!! right-edges-source!!
			   disp-map-dest!! disp-locations-dest!!
			   &optional user-match-scores-dest!! user-close-winners-dest!!
			   &key match-gradients? pause)
  (declare (special *save-scores?*))
  (ignore pause)				  ;not currently used
  (format t "~%Stereomatching...")
;  (tv:noting-progress ("Stereomatching")
    (unwind-protect				;be sure to free heap memory
	(progn
	  (*stereo-on-edge-images
	    :l-features!! left-edges-source!!
	    :r-features!! right-edges-source!!
	    :angles *angles*
	    :iters *iters* 
	    :support-region-width *support-region-width*
	    :i-d *id*
	    :f-d *fd*
	    :ivd *ivd*
	    :fvd *fvd*
	    :support-region-height *support-region-width*
	    :weak-compat? *weak-compat?*
	    :match-gradients? match-gradients?
	    :margin *margin*
	    :clear-accums-where-no-match? *clear-accums-where-no-match?*
	    :user-close-winners-dest!! user-close-winners-dest!!)
	  (*set disp-map-dest!! (make-disp-map!! *pm* *id*))
	  (*set disp-locations-dest!! (make-boolean-of-found-disparities!! *pm*))
	  ;; don't include results near the boundary, where the scores become unreliable
	  (*when (not!! (context-rectangle!! *top-edges-clip* *left-edges-clip*
					     *right-edges-clip* *bottom-edges-clip*))
	    (*set disp-map-dest!! (!! 0)
		  disp-locations-dest!! nil!!))
	  (cond (user-match-scores-dest!!
		 (format t "~%Filling USER-MATCH-SCORES!! ")
		 (*set user-match-scores-dest!! (winning-scores!! 0 *ac* *id* *fd*))
		 (if *user-matching-scores-sparse?*
		     (*when (not!! disp-locations-dest!!)
		       (*set user-match-scores-dest!! (!! 0))
		       (format t "(clearing scores where there is no match)..."))
		     (format t "(providing scores at all locations, regardless of matching)...")))))
      ;; Free all allocate!! pvars if they have been allocated.
      (if (not (and (boundp '*save-scores?*) *save-scores?*))	;hack to keep scores around if desired
	  (loop for pvar in *ac* do (*deallocate pvar)))
      (loop for pvar in *sp* do (*deallocate pvar))
      (loop for pvar in *pm* do (*deallocate pvar))
      )
    );)

(*defunc *APPLY-DISPARITY-MAP-CLEANUP-HEURISTICS
	(disp-map-source!! disp-map-dest!! disp-locations-source!! disp-locations-dest!!)
  (format t "~%Removing bad pixels from disparity map...")
;  (tv:noting-progress ("Removing bad pixels from disparity map")
    ;; initialize destinations from sources
    (*set disp-map-dest!! disp-map-source!!
	  disp-locations-dest!! disp-locations-source!!)
    ;; remove deviants
    (*clear-if-high-variance-or-if-very-different-from-mean
      disp-map-dest!!
      disp-locations-dest!!
      *max-allowed-difference-from-mean*
      *max-allowed-variance*
      *cleanup-statistics-width*)
    ;; get rid of isolated matches
    (remove-isolated-booleans!! disp-locations-dest!!)
    );)

;;; interpolate sparse depth values to provide a continuous disparity field
(*defunc *INTERPOLATION (interpolated-disp-map-dest!! disp-map-source!!
						     &key pause
						     (display *display?*)
						     use-color
						     boolean-of-fixed-values!!)
  (format t "~%Interpolating...")
;  (tv:noting-progress ("Interpolating")
    (*set interpolated-disp-map-dest!!
	  ;; for now, use the boolean-of-fixed-values!! only for rubber sheet interpolation
	  (ecase interpolation-method
	    (rubber-sheet
	      (diffusion-interpolation!! 
		disp-map-source!!
		constrained-diff-iters
		free-diff-iters shift-before-diff shift-after-diff boolean-of-fixed-values!!))
	    (thin-plate
	      (thin-plate-interpolation!!
		disp-map-source!!
		pre-thin-plate-diff-iters
		constrained-tp-iters
		free-diff-iters-after-tp shift-before-tp shift-after-tp))))
    (cond (display (*show-depth interpolated-disp-map-dest!! t!!
				*stereo-x0-offset* *stereo-y-offset* use-color pause))));)

(*defunc *CONTOUR-MAPPING (contour-map-dest!! interpolated-disp-map-source!!
					      &optional use-color stop-and-show?)
  (format t "~%Making contour map...")
;  (tv:noting-progress ("Making contour map")
    (*set contour-map-dest!!
	  (contour-map!!
	    (fill-borders!!
	      interpolated-disp-map-source!!
	      0
	      (abs *id*)
	      (abs *fd*)
	      contour-map-top-border
	      contour-map-bottom-border)
	    0
	    (* (expt 2 (+ shift-before-diff shift-after-diff)) (1+ (- *fd* *id*)))
	    contour-lines))
    (cond (*display?*
	   (if use-color
	       (*show-pvar (if!! contour-map-dest!!
				 interpolated-disp-map-source!!
				 (!! (1- (*min interpolated-disp-map-source!!))))
			   :x *stereo-x1-offset* :y *stereo-y-offset*)
	       (*show-pvar (if!! contour-map-dest!! (!! 1) (!! 0))
			   :x *stereo-x1-offset* :y *stereo-y-offset*))
	   (if stop-and-show? (pause)))));)

(*defunc CLEAN-UP-AND-DISPLAY-DEPTH-DATA
	 (disparity-map!! disp-locations!! display? pause?)
  "If requested, apply cleanup heuristics to the depth data.  Display depths from both left
and right views, as well as cleanup results (if requested)."
;  (if display? (grey::clear))
;;; ************************************************** CONVERT
;  (if display? (send spe:*color-window* :clear-window))
  ;; the cleanup heuristics aren't useful for grey-level matching
  (cond ((and *apply-cleanup-heuristics?* (not *match-grey?*))
	 ;; Display the original depth data on the left and the cleaned-up depth data on the right.
	 (if (and display? *show-cleanup-heuristics?*)
	     (*show-depth disparity-map!! disp-locations!! *stereo-x0-offset* *stereo-y-offset* use-color nil))
	 (*apply-disparity-map-cleanup-heuristics disparity-map!! disparity-map!! disp-locations!! disp-locations!!)
	 (cond ((and display? *show-cleanup-heuristics?*)
		(*show-depth disparity-map!! disp-locations!! *stereo-x1-offset* *stereo-y-offset* use-color nil)
		(if pause? (pause))))))		;wait for user if necessary
  (if display? (*show-depths-from-both-views disparity-map!! disp-locations!! pause?)))

;;; Interpolate sparse disparity values, find isodisparity contours, then display contours.
(*defunc INTERPOLATE-AND-DRAW
	 (disparity-map!! disp-locations!! user-interpolated-disparity-map!!
			  user-contour-map!! pause pia use-frame-grabber
			  full-left-view-to-show)
  (*let ((interpolated-disparity-map!! (!! 0))
	 (contour-map!! (!! nil)))
    (declare (type (signed-pvar (+ shift-before-diff shift-after-diff 8))
		   interpolated-disparity-map!!)
	     (type boolean-pvar contour-map!!))
    (*interpolation interpolated-disparity-map!! disparity-map!! :pause nil
		    :use-color use-color :boolean-of-fixed-values!! disp-locations!!)
    (cond (user-interpolated-disparity-map!!
	   (format t "~%Filling USER-INTERPOLATED-DISPARITY-MAP!!")
	   (*set user-interpolated-disparity-map!! interpolated-disparity-map!!)))
    (*contour-mapping contour-map!! interpolated-disparity-map!! use-color pause)
    (cond (user-contour-map!!
	   (format t "~%Filling USER-CONTOUR-MAP!!")
	   (*set user-contour-map!! contour-map!!)))
    ;; If requested, show depth data superimposed on the left view.  There are two options:
    ;; superimpose depths on the downsampled left view and superimpose depths on the
    ;; original, full-size left view.  The options are requested by setting the parameters
    ;; *show-left-view-with-stereo-data* and *show-full-left-view-with-stereo-data*,
    ;; respectively.  Furthermore, the user can choose to superimpose either the sparse
    ;; depth data or isodisparity contours by setting *superimpose-depth-data* to t or nil,
    ;; respectively.
    (cond (*display?*
	   (cond (*show-left-view-with-stereo-data*
;		  (grey::straight-map)		;restore standard color map
		  (spe:linear-map)
		  (if *superimpose-depth-data*
		      (*show-left-view-with-stereo-data
			(if pia (first pia) *left-256*) disparity-map!!
			disp-locations!! pause)
		      (*show-left-view-with-stereo-data
			(if pia (first pia) *left-256*) interpolated-disparity-map!!
			contour-map!! pause))))
	   ;; We can show the full left view if it can be recaptured from the frame grabber
	   ;; or if it has been provided by the user.
	   (cond ((and *show-full-left-view-with-stereo-data*
		       (or use-frame-grabber full-left-view-to-show))
		  (if *superimpose-depth-data*
		      (*show-full-left-view-with-stereo-data
			(if full-left-view-to-show full-left-view-to-show *left-array*)
			disparity-map!! disp-locations!! pause t)
		      (*show-full-left-view-with-stereo-data
			(if full-left-view-to-show full-left-view-to-show *left-array*)
			interpolated-disparity-map!! contour-map!! pause nil)
		      )))))))

;;; Here is the top-level routine for running my stereo program.
;;;
;;; IT RETURNS NOTHING.  If *DISPLAY?* is nil, then it displays nothing, and you might as
;;; well not run it.
;;; 
;;; If PAIR-OF-ARRAYS-TO-USE-INSTEAD-OF-FRAME-GRABBER is a list of two 8bit arrays, like
;;; (<your-favorite-left-image> <your-favorite-right-image>), then it will use these
;;; instead of grabbing new frames.  It will assume that your pair-of-arrays require no
;;; registration.  (The argument must normally be NIL.) Same goes for PAIR-OF-EDGE-ARRAYS.
;;; You can bypass frame-grabbing or any grey-level processing by supplying your own edges
;;; to the algorithm.  As above, it assumes they're registered.
;;;
;;; If USER-LEFT-IMAGE!! is a (preferably 8bit field-type) pvar, then it will be *set to
;;; whatever left image is being used. If USER-LEFT-EDGES!! is a (preferably
;;; boolean-type) pvar, then it will be *set to T wherever the zero-crossings or
;;; canny-edges of the left image were non-zero. If USER-DISPARITY-LOCATIONS!! is a
;;; (preferably boolean-type) pvar, then it will be *set to T at each pixel in the left
;;; image where a disparity was found.  Note that this is a subset of the pixels in
;;; USER-LEFT-EDGES!!. If USER-DISPARITY-MAP!! is a (preferably 8bit signed-type)
;;; pvar, then it will be *set to the disparity map. If USER-MATCH-SCORES!! is a
;;; (preferably 16bit field-type) pvar, then it will be *set to the scores of the winning
;;; disparities.  These are defined only where the left-zero-crossings are non-zero
;;;
;;; Useful examples:
;;; (*proclaim '(type (field-pvar 8) lip))  <=== Use this for :USER-LEFT-IMAGE!!.
;;; (*defvar LIP (!! 0))     
;;; (*proclaim '(type boolean-pvar lep))    <=== Use this for :USER-LEFT-EDGES!!.
;;; (*defvar LEP (!! nil))
;;; (*proclaim '(type (field-pvar 16) msp)) <=== Use this for :USER-MATCH-SCORES!!.
;;; (*defvar MSP (!! 0))
;;; (*proclaim '(type (signed-pvar 8) dmp)) <=== Use this for :USER-DISPARITY-MAP!!.
;;; (*defvar DMP (!! 0))
;;; (*proclaim '(type boolean-pvar dlp))    <=== Use this for :USER-DISPARITY-LOCATIONS!!.
;;; (*defvar DLP (!! nil))
;;;
;;;             ************  CRUCIAL  POINT  ABOUT  THE  DISPARITY  MAP  *************
;;;
;;; You must be very careful about interpreting the values in the DISPARITY MAP PVAR (i.e.,
;;; the values that will appear in YOUR 8-bit FIELD-TYPE PVAR THAT YOU SUPPLY TO THE
;;; KEYWORD ARGUMENT ":USER-DISPARITY-MAP!!."  Specifically, these values are
;;; UNINTERPRETABLE unless they are used IN CONJUNCTION with the values stuffed into
;;; ":USER-DISPARITY-LOCATIONS!!." Explanation:  Strictly speaking, the disparity map
;;; should contain two different types of values:  NIL wherever NO DISPARITY WAS FOUND, and
;;; NUMBERS indicating disparity wherever a disparity WAS FOUND.  However, I somehow opted
;;; to make disparity maps be 8-bit SIGNED-PVARs (probably in order to make display
;;; routines easy and i/o fast, and to take up LESS SPACE; I can't remember, it's all a
;;; blur now...), which are ZERO wherever NO DISPARITY was found.  Unfortunately, they are
;;; also zero wherever the disparity was calculated to be zero.  Therefore, you should
;;; interpret every pixel in YOUR USER-DISPARITY-MAP!! to be NIL unless the
;;; corresponding pixel in YOUR USER-DISPARITY-LOCATIONS!! is T.  Dig?

;;; The function *stereo just checks to make sure that the CM has been cold-booted to the
;;; right dimensions, then passes control to *stereo-internal.  The point is that *stereo
;;; may want to do a *cold-boot.  Since *cold-boot is not allowed within a *defunc, *stereo
;;; is an ordinary defmacro and *stereo-internal is a *defunc.  Boring but useful.

(defmacro *STEREO (&rest rest)
  #+lispm
  (declare
    (arglist &key 
	     pause
	     (save-warped-right-view t)
	     full-left-view-to-show
	     (wait-for-user-to-hit-space-bar t)
	     (interpolate-and-draw? *interpolate-and-draw?*)
	     ;; reuse the downsampled, warped images in *left-256* and *right-256*.
	     use-canned-data
	     ;; reuse the frames in *left-array* and *right-array*, rather
	     ;; than grabbing new ones.  (Use grab-stereo-pair-twiddle to grab.)
	     already-grabbed
	     menu				;use (change-stereomatching-parameters)
	     pair-of-image-arrays		;pair of downsampled, warped images
	     pair-of-edge-arrays
	     pair-of-edge-arrays-to-fill-in
	     pair-of-image-arrays-to-fill-in
	     depth-and-loc-arrays-to-fill-in
	     user-left-image!!
	     user-left-edges!!
	     user-disparity-locations!!
	     user-disparity-map!!
	     user-match-scores!!
	     user-interpolated-disparity-map!!
	     user-contour-map!!
	     user-close-winners!!
	     ))
  `(block stereo
     (cond ((not (cm:attached))
	    (format t "~%No CM is attached.  Do a (cm:attach) and try again.")
	    (return-from stereo))		;exit
	   ((*lx:*lisp-runnable-p)
	    (if (not (and (= 256. (dimension-size 0))
			  (= 256. (dimension-size 1))))
		(if (y-or-n-p "The CM grid must have dimensions 256x256 (currently ~ax~a).  May I *cold-boot to fix the grid dimensions? " (dimension-size 0) (dimension-size 1))
		    (boot-256)
		    (return-from stereo))))	;user doesn't want to cold boot
	   (t (if (y-or-n-p "The CM needs to be cold booted.  May I *cold-boot to set up a 256x256 grid? ")
		  (boot-256)
		  (return-from stereo))))	;user doesn't want to cold boot
     (*stereo-internal ,@rest)))

;;; To deal with the change from column-major arrays to row-major arrays
;;; in Rel 7, all arrays are transposed after loading them into the CM.
(*defunc *STEREO-INTERNAL
	 (&key 
	   pause
	   (save-warped-right-view t)
	   full-left-view-to-show
	   (wait-for-user-to-hit-space-bar t)
	   (interpolate-and-draw? *interpolate-and-draw?*)
	   ;; reuse the downsampled, warped images in *left-256* and *right-256*.
	   use-canned-data
	   ;; reuse the frames in *left-array* and *right-array*, rather
	   ;; than grabbing new ones.  (Use grab-stereo-pair-twiddle to grab.)
	   already-grabbed
	   menu					;use (change-stereomatching-parameters)
	   pair-of-image-arrays			;pair of downsampled, warped images
	   pair-of-edge-arrays
	   pair-of-edge-arrays-to-fill-in
	   pair-of-image-arrays-to-fill-in
	   depth-and-loc-arrays-to-fill-in
	   user-left-image!!
	   user-left-edges!!
	   user-disparity-locations!!
	   user-disparity-map!!
	   user-match-scores!!
	   user-interpolated-disparity-map!!
	   user-contour-map!!
	   user-close-winners!!
	   )

;;; ************************************************** CONVERT
  menu
;  (when menu (change-stereomatching-parameters))
  (format t "~%Examining the horizontal disparity range <~D, ~D>, vertical range <~D, ~D>." *id* *fd* *ivd* *fvd*)
  (format t "  Support region width = ~D." *support-region-width*)
  ;; if we are using the display, then we must have a color window
  (when *display?* 
    (require-color-window))
  (if use-canned-data (setq pair-of-image-arrays (list *left-256* *right-256*)
			    full-left-view-to-show *left-array*))
  ;; If we are not displaying anything, there is no point in pausing.
  (if (not *display?*) (setq pause nil))
  (let* ((pia pair-of-image-arrays)
	 (pea pair-of-edge-arrays)
	 (use-frame-grabber (not (or pia pea))))
    ;; By allocating the image pvars on the heap rather than the stack, we can delete them freely
    ;; when storage becomes critical.
    (setq *left-image* (allocate!! (if pia (fastio:write-raster-to-cm-grid!! (first pia)) (!! 0))
				   '*left-image* `(field-pvar ,cmv::*pixel-bits*)
				   )
	  *right-image* (allocate!! (if pia (fastio:write-raster-to-cm-grid!! (second pia)) (!! 0))
				    '*right-image* `(field-pvar ,cmv::*pixel-bits*)
				    ))
    (*let ((left-edge!! (if pea (fastio:write-raster-to-cm-grid!! (first pea)) (!! 0)))
	   (right-edge!! (if pea (fastio::write-raster-to-cm-grid!! (second pea)) (!! 0))))
      ;; When we are using gradient matching, edge pvars only need a single bit.
      ;; Otherwise edges are signed, 1 or -1 depending on polarity.
      (declare (type (signed-pvar 2) left-edge!! right-edge!!))
      (if *display?* (display-preparation))
      (cond (use-frame-grabber
	     (*grab-and-register-stereo-images
	       *left-image* *right-image*
	       :stop-and-show? pause
	       :save-warped-right-view save-warped-right-view
	       :already-grabbed already-grabbed
	       :wait-for-user-to-hit-space-bar
	       wait-for-user-to-hit-space-bar)))
      (cond ((and pia *display?*)
	     (spe:show-color spe:*color-window* (first pia) :to-x *stereo-x0-offset* :to-y *stereo-y-offset*)
	     (spe:show-color spe:*color-window* (second pia) :to-x *stereo-x1-offset* :to-y *stereo-y-offset*)
	     (if pause (pause))))
      (when (numberp *vertical-smearing*)
	(format t "~%Vertical smearing: sigma=~D" *vertical-smearing*)
;	(let ((temp (!! 0)))
;	  (declare (type (field-pvar (pvar-length *left-image*)) temp))
	  (*set *left-image* (max!! (!! 0) (floor!! (1d-g-conv!! *left-image* *vertical-smearing* nil))))
	  (*set *right-image* (max!! (!! 0) (floor!! (1d-g-conv!! *right-image* *vertical-smearing* nil)))))
;      )
      (when pair-of-image-arrays-to-fill-in
	(format t "~%Filling PAIR-OF-IMAGE-ARRAYS-TO-FILL-IN")
	(when (first pair-of-image-arrays-to-fill-in)
	  (fastio:*read-raster-from-cm-grid (first pair-of-image-arrays-to-fill-in) *left-image*))
	(when (second pair-of-image-arrays-to-fill-in)
	  (fastio:*read-raster-from-cm-grid (second pair-of-image-arrays-to-fill-in) *right-image*))
	(setq pia pair-of-image-arrays-to-fill-in)
	(when *display?*
	  (when (first pair-of-image-arrays-to-fill-in)
	    (spe:show-color spe:*color-window* (first pair-of-image-arrays-to-fill-in)
			    :to-x *stereo-x0-offset* :to-y *stereo-y-offset*))
	  (when (second pair-of-image-arrays-to-fill-in)
	    (spe:show-color spe:*color-window* (second pair-of-image-arrays-to-fill-in)
			    :to-x *stereo-x1-offset* :to-y *stereo-y-offset*))
	  (if pause (pause))))
      (cond (user-left-image!!
	     (format t "~%Filling USER-LEFT-IMAGE!!")
	     (*set user-left-image!! *left-image*)))
      (cond (*match-grey?*)			;grey level matching doesn't use edges
	    (pea (spe:show-color spe:*color-window* (first pea) :to-x *stereo-x0-offset* :to-y *stereo-y-offset*)
		 (spe:show-color spe:*color-window* (first pea) :to-x *stereo-x1-offset* :to-y *stereo-y-offset*))
	    (t (*edge-finding left-edge!! right-edge!! *left-image* *right-image*
			      *canny-edges?* *match-gradients?* pause)))
      (cmv::with-temp-pvars
	(cond (pair-of-edge-arrays-to-fill-in
	       (format t "~%Filling in user edge arrays")
	       (when (first pair-of-edge-arrays-to-fill-in)
		 (fastio:*read-raster-from-cm-grid (first pair-of-edge-arrays-to-fill-in)
						(not!! (zerop!! left-edge!!))))
	       (when (second pair-of-edge-arrays-to-fill-in)
		 (fastio:*read-raster-from-cm-grid (second pair-of-edge-arrays-to-fill-in)
						(not!! (zerop!! right-edge!!)))))))
      (cond (user-left-edges!!
	     (format t "~%Filling USER-LEFT-EDGES!!")
	     (*set user-left-edges!! (nzerop!! left-edge!!))))
      (*let ((disparity-map!! (!! 0))
	     (disp-locations!! (!! nil)))
	(declare (type (signed-pvar 8) disparity-map!!)
		 (type boolean-pvar disp-locations!!))
	(*stereomatching left-edge!! right-edge!! disparity-map!!
			 disp-locations!! user-match-scores!! user-close-winners!!
			 ;; match gradients if this was requested and we can compute the gradients
			 :match-gradients? (and *match-gradients?* (not pea)) :pause nil)
	(clean-up-and-display-depth-data disparity-map!! disp-locations!! *display?* pause)
	(cond (user-disparity-locations!!
	       (format t "~%Filling USER-DISPARITY-LOCATIONS!!")
	       (*set user-disparity-locations!! disp-locations!!)))
	(cond (user-disparity-map!!
	       (format t "~%Filling USER-DISPARITY-MAP!!")
	       (*set user-disparity-map!! disparity-map!!)))
	(cond (depth-and-loc-arrays-to-fill-in
	       (format t "~%Filling DEPTH-AND-LOC-ARRAYS-TO-FILL-IN")
	       (fastio:*read-raster-from-cm-grid
		 (first depth-and-loc-arrays-to-fill-in)
		 (-!! disparity-map!! (!! (if *returned-disparity-offset*
					      (- *returned-disparity-offset*)
					      (*min disparity-map!!)))))
	       (fastio:*read-raster-from-cm-grid (second depth-and-loc-arrays-to-fill-in)
					       disp-locations!!)))
	;; If requested, interpolate sparse disparity values, find isodisparity contours,
	;; then display the contours.
	(if interpolate-and-draw?
	    (interpolate-and-draw disparity-map!! disp-locations!!
				  user-interpolated-disparity-map!!
				  user-contour-map!! pause pia
				  use-frame-grabber full-left-view-to-show))))))

(defun WARP-ARRAY (8b-array)
  (*let* ((pvar!! (fastio:write-raster-to-cm-grid!! 8b-array))
	  (warped!! (warp-with-router!! pvar!! *x-warp-array* *y-warp-array*)))
    (declare (type (field-pvar 8) warped!!))
    (fastio:*read-raster-from-cm-grid 8b-array warped!!)))

(defun GRAB-AND-REGISTER ()
  (grab-stereo-pair-twiddle)
  (move-frames 256)
  (warp-array *right-256*))

;;; suppress only along left eye line of sight and don't throw away any scores
(defun LEFT-EYE-ONLY ()
  (setq *entire-forbidden-zone?* nil
	*angles* '(0)
	*discard-bad-scores?* nil
	*kill-non-unique-matches?* nil))

;;; suppress entire forbidden zone, non-unique matches
(defun SUPPRESS ()
  (setq *entire-forbidden-zone?* t
	*angles* '(0 90)
	*discard-bad-scores?* t
	*kill-non-unique-matches?* t))