anchor.diff:     (constrict-mode :initform nil :accessor clim-fig-constrict-mode)
      (status :initform nil :accessor clim-fig-status))
     (:panes
  -   (canvas :canvas)
  +   (canvas (make-pane 'canvas-pane))
      (menu-bar (climi::make-menu-bar 'menubar-command-table :height 25))
      (line-width-slider :slider
   		      :label "Line Width"
  
positive.code:               first-point-x nil
                first-point-y nil)))))
  
  (in-package :clim-demo)
  
  (defun clim-fig ()
    (loop for port in climi::*all-ports*
        do (destroy-port port))
    (setq climi::*all-ports* nil)
   ;(run-frame-top-level (make-application-frame 'clim-fig))
    (setq frame (make-application-frame 'clim-fig))
    (setq fm (frame-manager frame))
    (setq port (climi::frame-manager-port fm))
    (setq pane (first (frame-panes frame)))
    (setq medium (sheet-medium pane))
    (setq graft (graft frame))
    (setq vbox (climi::frame-pane frame))
    (run-frame-top-level frame))
  
  (defun make-colored-button (color &key width height)
    (make-pane 'push-button-pane
  
negative.code:   (handle-event pane event))
  )
  
  (defun draw-figure (pane x y x1 y1 &key fastp)
    (with-slots (line-style current-color fill-mode constrict-mode)
        *application-frame*
      (let* ((radius-x (- x1 x))
             (radius-y (- y1 y))
             (line-style (if fastp (medium-line-style pane) line-style))
             (fill-mode (if fastp nil fill-mode)))
        (when constrict-mode
          (case (clim-fig-drawing-mode *application-frame*)
            ((:line :arrow)
             (if (> (abs radius-x) (abs radius-y))
                 (setf y1 y)
                 (setf x1 x)))
            ((:rectangle :ellipse)
             (let ((radius-max (max (abs radius-x) (abs radius-y))))
               (setf radius-x (* (signum-1 radius-x) radius-max)
                     radius-y (* (signum-1 radius-y) radius-max)
                     x1 (+ x radius-x)
                     y1 (+ y radius-y))))))
        (case (clim-fig-drawing-mode *application-frame*)
          (:line
           (draw-line* pane x y x1 y1
                       :ink current-color
                       :line-style line-style))
          (:arrow
           (with-new-output-record (pane)
             (draw-arrow* pane x y x1 y1
                          :ink current-color
                          :line-style line-style
                          :to-head t :head-width 20 :head-length 20)))
          (:rectangle
           (draw-rectangle* pane x y x1 y1 :filled fill-mode
                            :ink current-color
                            :line-style line-style))
          (:ellipse
           (draw-ellipse* pane x y radius-x 0 0 radius-y
                          :filled fill-mode
                          :ink current-color :line-style line-style))))))
  
  (defmethod handle-event ((pane canvas-pane) (event pointer-button-press-event))
    (when (= (pointer-event-button event) +pointer-left-button+)
      (handle-draw-object pane event))
    (when (= (pointer-event-button event) +pointer-right-button+)
      (with-slots (first-point-x first-point-y selected-object) pane
        (setq first-point-x (pointer-event-x event)
              first-point-y (pointer-event-y event))
        (setf selected-object (search-selected-object (stream-output-history pane)
                                                      first-point-x
                                                      first-point-y)))))
  
  