[mcclim-devel] incremental-redisplay issues

Cyrus Harmon ch-mcclim at bobobeach.com
Thu Dec 18 21:47:14 UTC 2008


I've been developing an application for generating and visualizing 2-d  
structures for molecules and have run into some issues with  
incremental-redisplay. There are two main problems that can be seen in  
the following screen shot:

http://www2.cyrusharmon.org/incr-redisp.png

1. I see visual "detritus" in the pane (is that the right term?) if I  
zoom in and out. It gets things mostly right, but there are some "left- 
over" lines that don't get erased. Some initial tests suggest this has  
to do with using incremental-redisplay in panes that have been  
transformed with with-scaling and friends. The workaround is to  
manually clear the screen, which I, hackily, do after various commands.

2. The order in which things are drawn is different upon redrawing. In  
the screenshot, you'll see that the lines for the bonds between the  
atoms are drawn on top of the colored circles representing the atoms.  
On the first drawing, they are drawn before the atoms and therefore  
are not overlapped by the atoms. Incremental-redisplay seems to be  
changing the order in which things are drawn.

For some code that illustrates these problems, I've made a standalone  
clim app that demonstrates the behavior and attached it below. If it  
gets munged by the mailing list, the code can also be found at:

http://www2.cyrusharmon.org/standalone.lisp

Any suggestions on how to either fix or better use McCLIM, would be  
greatly appreciated.

thanks,

Cyrus




;;; file: standalone.lisp
;;; Copyright (c) 2008 Cyrus Harmon (ch-lisp at bobobeach.com)
;;;

(asdf:oos 'asdf:load-op :mcclim)

(defpackage #:chemicl-draw-standalone
  (:use #:clim #:clim-lisp))

(in-package :chemicl-draw-standalone)

(defparameter *molecule-2d-pane-foreground-color* +white+)
(defparameter *molecule-2d-pane-background-color* +black+)

(defclass chemicl-2d-view (view) ())
(defparameter *chemicl-2d-view* (make-instance 'chemicl-2d-view))

(defclass chemicl-info-view (view) ())
(defparameter *chemicl-info-view* (make-instance 'chemicl-info-view))

(define-application-frame chemicl-draw ()
  ()
  (:pointer-documentation t)
  (:panes
   (app (make-clim-stream-pane
         :type 'application-pane
         :height 600 :width 500
         :incremental-redisplay t
         :display-function 'display-chemicl-2d
         :default-view *chemicl-2d-view*
         :background *molecule-2d-pane-background-color*
         :scroll-bars :both))
   (info :application
        :height 600 :width 300
        :display-function 'display-chemicl-info
        :default-view *chemicl-info-view*
        :background +white+)
   (int :interactor :height 160 :width 800))
  (:layouts
   (default (vertically ()
              (horizontally ()
                app info)
              int))))

(defun draw-bond (pane x1 y1 x2 y2 bond &key (inset 5))
  (draw-line* pane x1 y1 x2 y2 :ink +green+))

(defun bond-angle (x1 y1 x2 y2)
  (cond ((zerop (- y2 y1))
         (if (minusp (- x2 x1)) pi 0))
        ((zerop (- x2 x1))
         (if (minusp (- y2 y1))
             (/ (* 3 pi) 2)
             (/ pi 2)))
        (t (atan (/ (- y2 y1) (- x2 x1))))))

(defvar *default-scale* 25)
(defvar *scale* *default-scale*)

(defvar *default-rotation* 0)
(defvar *rotation* *default-rotation*)

(defun reset ()
  (setf *scale* *default-scale*)
  (setf *rotation* *default-rotation*))

(defparameter *atom-coords*
  '((6.169130606358857d0 . -1.6091702292618408d0)
    (5.5d0 . -0.8660254037844456d0)
    (3.0000000000000018d0 . -9.877623892429188d-16)
    (4.000000000000002d0 . -3.774758283725532d-15)
    (4.5d0 . -0.8660254037844436d0)
    (3.999999999999998d0 . -1.7320508075688812d0)
    (2.999999999999998d0 . -1.7320508075688794d0)
    (2.499999999999999d0 . -0.8660254037844402d0)
    (0.9999999999999981d0 . -1.732050807568877d0)
    (1.5000000000000004d0 . 0.8660254037844385d0)
    (1.4999999999999993d0 . -0.866025403784439d0)
    (1.0d0 . 0.0d0)
    (0.0d0 . 0.0d0)))

(defparameter *edge-coords*
  '(((5.5d0 . -0.8660254037844456d0)
     (6.169130606358857d0 . -1.6091702292618408d0))
    ((1.4999999999999993d0 . -0.866025403784439d0)
     (0.9999999999999981d0 . -1.732050807568877d0))
    ((4.5d0 . -0.8660254037844436d0) (5.5d0 . -0.8660254037844456d0))
    ((2.499999999999999d0 . -0.8660254037844402d0)
     (3.0000000000000018d0 . -9.877623892429188d-16))
    ((4.000000000000002d0 . -3.774758283725532d-15)
     (3.0000000000000018d0 . -9.877623892429188d-16))
    ((4.5d0 . -0.8660254037844436d0)
     (4.000000000000002d0 . -3.774758283725532d-15))
    ((3.999999999999998d0 . -1.7320508075688812d0)
     (4.5d0 . -0.8660254037844436d0))
    ((2.999999999999998d0 . -1.7320508075688794d0)
     (3.999999999999998d0 . -1.7320508075688812d0))
    ((2.499999999999999d0 . -0.8660254037844402d0)
     (2.999999999999998d0 . -1.7320508075688794d0))
    ((1.4999999999999993d0 . -0.866025403784439d0)
     (2.499999999999999d0 . -0.8660254037844402d0))
    ((1.0d0 . 0.0d0) (1.4999999999999993d0 . -0.866025403784439d0))
    ((1.0d0 . 0.0d0) (1.5000000000000004d0 . 0.8660254037844385d0))
    ((0.0d0 . 0.0d0) (1.0d0 . 0.0d0))))

(defun draw-molecule-2d (pane)
  (flet ((atom-color () +red+)
         (atom-size () .12))
    (let ((counter 0) (xmin 0) (xmax 0) (ymin 0) (ymax 0))
      (map nil
           (lambda (atom)
             (destructuring-bind (ax . ay)
                 atom
               (when (< ax xmin) (setf xmin ax))
               (when (> ax xmax) (setf xmax ax))
               (when (< ay ymin) (setf ymin ay))
               (when (> ay ymax) (setf ymax ay))))
           *atom-coords*)
      (with-scaling (pane *scale*)
        (with-rotation (pane *rotation*)
          (with-translation (pane (1+ (- xmin)) (+ 2 (- ymin)))
            (map nil
                 (lambda (edge)
                   (updating-output (pane :unique-id edge)
                     (destructuring-bind (a1 a2) edge
                       (let ((x1 (car a1)) (y1 (cdr a1)))
                         (let ((x2 (car a2)) (y2 (cdr a2)))
                           (let ((bond-angle (bond-angle x1 y1 x2 y2)))
                             (let ((xoffset (* .04 (cos (+ bond-angle  
(/ pi 2)))))
                                   (yoffset (* .04 (sin (+ bond-angle  
(/ pi 2))))))
                               (draw-line* pane
                                           (+ x1 xoffset)
                                           (+ y1 yoffset)
                                           (+ x2 xoffset)
                                           (+ y2 yoffset)
                                           :ink *molecule-2d-pane- 
foreground-color*
                                           :line-thickness 1))
                             (let ((xoffset (* .04 (cos (- bond-angle  
(/ pi 2)))))
                                   (yoffset (* .04 (sin (- bond-angle  
(/ pi 2))))))
                               (draw-line* pane
                                           (+ x1 xoffset)
                                           (+ y1 yoffset)
                                           (+ x2 xoffset)
                                           (+ y2 yoffset)
                                           :ink *molecule-2d-pane- 
foreground-color*
                                           :line-thickness 1))))))))
                 *edge-coords*)
            (map nil
                 (lambda (atom)
                   (destructuring-bind (x . y)
                       atom
                     (updating-output (pane :unique-id atom)
                       (draw-circle* pane x y (atom-size) :ink (atom- 
color))
                       (draw-circle* pane x y (* 1.2 (atom-size)) :ink  
(atom-color)
                                     :filled nil))
                     (incf counter)))
                 *atom-coords*)))))))

(defmethod display-chemicl-2d ((frame chemicl-draw) pane)
  (draw-molecule-2d pane))

(defmethod display-chemicl-info ((frame chemicl-draw) pane)
  (princ "test" pane)
  (terpri)
  (format pane "~&Mass: ~,5F~%" 1d0)
  (format pane "~&Exact Mass: ~,5F~%" 2d0)
  (format pane "~&Formula: ~,5F~%" 3d0))

(defun run (&key new-process)
  (flet ((run ()
           (let ((frame (make-application-frame 'chemicl-draw)))
             (run-frame-top-level frame))))
    (if new-process
        (clim-sys:make-process #'run :name "chemicl-draw")
        (run))))


(define-chemicl-draw-command (com-set-scale :name t)
    ((scale 'number :prompt " Scale? "))
  (when (plusp scale)
    (setf *scale* scale)))

(define-chemicl-draw-command (com-zoom-in :name t) ()
  (declare (optimize (debug 2)))
  (setf *scale* (* *scale* 2))
  (let* ((scroller (car (sheet-children
                         (find-pane-named *application-frame* 'app))))
         (pane (car (sheet-children
                     (caddr (sheet-children scroller))))))
    #+nil (window-clear pane)
    #+nil
    (with-bounding-rectangle* (x1 y1 x2 y2)
        (sheet-region pane)
      (draw-rectangle* (sheet-medium pane) x1 y1 x2 y2 :ink  
+background-ink+))))

(define-chemicl-draw-command (com-zoom-out :name t) ()
  (setf *scale* (/ *scale* 2))
  (let ((pane (car
               (sheet-children
                 (caddr
                  (sheet-children
                   (car
                    (sheet-children
                     (find-pane-named *application-frame* 'app)))))))))
    #+nil
    (window-clear pane)
    #+nil
    (with-bounding-rectangle* (x1 y1 x2 y2)
        (sheet-region pane)
      (draw-rectangle* (sheet-medium pane) x1 y1 x2 y2 :ink  
+background-ink+))))

(define-chemicl-draw-command (com-set-rotation :name t)
    ((rotation 'number :prompt " Rotation? "))
  (setf *rotation* rotation))

(define-chemicl-draw-command (com-reset :name t) ()
  (reset))

(define-chemicl-draw-command (com-clear :name t) ()
  (reset))

(define-chemicl-draw-command (com-redraw :name t) ())

(define-chemicl-draw-command (com-quit :name t) ()
  (frame-exit *application-frame*))







More information about the mcclim-devel mailing list