Next Prev Up Top Contents Index

12.4.4 Using the third value from accept in accepting-values

As a second example, consider a dialog that accepts four real numbers that delimit a rectangular region in the plane, but we wish to enforce a constraint that the region be a square. We allow the user to input any of Xmin , Xmax , Ymin , or Ymax , but enforce the constraint that:

     Xmax - Xmin = Ymax - Ymin

We want to avoid changing the value that a user inputs, so we decide (in cases where the constraint has to be enforced) to change the X value if the user inputs a Y value, and to change the Y value if the user inputs an X value. When changing values, we preserve the center of the interval. We use the third returned value from accept to control the constraint enforcement.

(defun accepting-square
  (&key (xmin -1.0) (xmax 1.0)
        (ymin -1.0) (ymax 1.0)
        (stream *query-io*))
  (let (xmin-changed xmax-changed ymin-changed ymax-changed ptype)
     (stream :resynchronize-every-pass t)
     (fresh-line stream)
         (xmin ptype xmin-changed)
         (clim:accept 'clim:real :default xmin
          :prompt "Xmin" :stream stream))
     (fresh-line stream)
         (xmax ptype xmax-changed)
         (clim:accept 'clim:real :default xmax
          :prompt "Xmax" :stream stream))
     (fresh-line stream)
         (ymin ptype ymin-changed)
         (clim:accept 'clim:real :default ymin
          :prompt "Ymin" :stream stream))
     (fresh-line stream)
         (ymax ptype ymax-changed)
         (clim:accept 'clim:real :default ymax
          :prompt "Ymax"  :stream stream))
     (cond ((or xmin-changed xmax-changed)
            (let ((y-center (/ (+ ymax ymin) 2.0))
                  (x-half-width (/ (- xmax xmin) 2.0)))
              (setq ymin (- y-center x-half-width)
                    ymax (+ y-center x-half-width)))
            (setq xmin-changed nil
                  xmax-changed nil))
           ((or ymin-changed ymax-changed)
            (let ((x-center (/ (+ xmax xmin) 2.0))
                  (y-half-width (/ (- ymax ymin) 2.0)))
              (setq xmin (- x-center y-half-width)
                    xmax (+ x-center y-half-width)))
            (setq ymin-changed nil
                  ymax-changed nil)))))
  (values xmin xmax ymin ymax))

Common Lisp Interface Manager 2.0 User Guide - 14 Dec 2001

Next Prev Up Top Contents Index