guile-gtk-general
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

canvas bpath and def


From: Greg Troxel
Subject: canvas bpath and def
Date: 08 Mar 2005 19:04:57 -0500
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3

In trying to diagnose and work around the leak I reported earlier, I
tried to not create new bpath and def objects.  So, I created a bpath
when I create a link between nodes, and then just reset and redefine
the gnome-canvas-path-def when the endpoints move.  But, it seems that
only the first line drawing sticks, and the subsequent updates don't
do anything.  Am I misunderstanding how defs and bpaths work, or is
this a a bug?

;; create a line object, with no path
(define (create-line color parent)
  (let*
      ((bpath (make <gnome-canvas-bpath>
                ;; parent must be first or this crashes!
                #:parent parent
                #:fill-color color
                #:width-pixels 20))
       (def (make <gnome-canvas-path-def>)))

    ;; This may result in excessive-size pixmaps.  Consider moving to
    ;; one coordinate and using relative coordinates.
    (move bpath 0 0)

    ;; save the def
    (set-object-property! bpath 'def def)

    bpath))

;; utility function that doesn't belong here
(define (draw-line bpath x1 y1 x2 y2 width)
  (let*
      ((def (object-property bpath 'def))
       (theta (atan (- y2 y1) (- x2 x1)))
       (right (+ theta 1.5707963267949))
       (incx (* width (cos right)))
       (incy (* width (sin right))))

    (format #t "draw-line bpath ~A def ~A x1 ~A y1 ~A x2 ~A y2 ~A w
    ~A\n"
            bpath def x1 y1 x2 y2 width)

    (reset def)
    (moveto def x1 y1)
    (lineto def x2 y2)
    (lineto def (+ x2 incx) (+ y2 incy))
    (lineto def (+ x1 incx) (+ y1 incy))
    (closepath def)

    (set-path-def bpath def)
    (gnome-canvas-item-lower-to-bottom bpath)
    (show bpath)

    (format #t "line drawn\n")
    ;; side-effect only - avoid return value
    #f))




(define-method (do-notify-create (l <link-map>))
  (if (or #f (not (line l)))
      (set! (line l)
            (create-line "black" (canvas-root (nodeset (endpoint1
  l))))))
  (draw-line (line l)
             (x (endpoint1 l)) (y (endpoint1 l))
             (x (endpoint2 l)) (y (endpoint2 l))
             (metric-to-width (link-to-metric l))))

-- 
        Greg Troxel <address@hidden>




reply via email to

[Prev in Thread] Current Thread [Next in Thread]