New Year's puzzle

[Paul Werkowski]

Run the frame as is. Grab the lower corner with mouse pointer. Move it 
around.

Then change either or both of the (1+  ...) forms to (1- ...) and see 
what happens.

  A free virtual beer to whomever solves it.


-------------- next part --------------
(defpackage :puz (:use :clim-lisp :clim)(:export #:tryit))
(in-package :puz)

(defclass example-pane (application-pane)())

#+McCLIM
(defmethod window-clear ((pane example-pane))
  (stream-close-text-output-record pane)
  (let ((output-history (stream-output-history pane)))
    (with-bounding-rectangle* (left top right bottom) output-history
      (when (sheet-viewable-p pane)
        (medium-clear-area (sheet-medium pane) left top right bottom)))
    (clear-output-record output-history))
  (window-erase-viewport pane))

#+McCLIM
(defmethod redisplay-frame-pane :around
  ((frame application-frame) (pane climi::pane-display-mixin) &key force-p)
  (declare (ignore force-p))
  (funcall (climi::pane-display-function pane) (pane-frame pane) pane))

(defmethod resize-sheet :after ((pane example-pane) w h)
  (declare (ignore w h))
  (window-clear pane)
  (redisplay-frame-pane (pane-frame pane) pane))

(define-application-frame test ()
  ()
  (:pane
   (make-pane
        'example-pane
        :width  300 :max-width  +fill+
        :height 300 :max-height +fill+
        :display-function
        #'(lambda(frame pane)
            (declare (ignore frame))
            (with-bounding-rectangle*
                (x1 y1 x2 y2) pane
              (let* ((w (- x2 x1))
                     (h (- y2 y1))
                     (x (/ w 2))
                     (y (/ h 2))
                     (r (* .1 (min w h))))
                (draw-ellipse* pane x y r 0 0 r  :ink +green+)
                (draw-line*    pane x y (1- w) y :ink +red+)  ;<< try 1+
                (draw-line*    pane x y x (1- h) :ink +blue+) ;<< try 1+
                ))))))

(defun tryit ()
  ;; grab edge or corner with mouse pointer and stretch or shrink.
  #+:CLX
  (pushnew :clx *default-server-path*)
  (run-frame-top-level
   (make-application-frame 'test)))