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) 

    (clim:accepting-values

     (stream :resynchronize-every-pass t) 

     (fresh-line stream) 

     (multiple-value-setq

         (xmin ptype xmin-changed) 

         (clim:accept 'clim:real :default xmin

          :prompt "Xmin" :stream stream)) 

     (fresh-line stream) 

     (multiple-value-setq

         (xmax ptype xmax-changed) 

         (clim:accept 'clim:real :default xmax

          :prompt "Xmax" :stream stream)) 

     (fresh-line stream) 

     (multiple-value-setq

         (ymin ptype ymin-changed) 

         (clim:accept 'clim:real :default ymin

          :prompt "Ymin" :stream stream))

     (fresh-line stream) 

     (multiple-value-setq

         (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))