using/wrapping container?

[Jan Nieuwenhuizen]

Hi,

I'm having some trouble using/wrapping gnome-canvas-path-def

   
http://developer.gnome.org/doc/API/2.0/libgnomecanvas/libgnomecanvas-gnome-canvas-path-def.html

I'd like to add a bezier to the canvas.scm example, but I cannot do any of


    (let ((curve (make <gnome-canvas-path-def>))
           (xcurve (gnome-canvas-path-def-new)))

       (moveto curve 0.0 0.0)
       (set curve 'fill-color "black")
       
       (moveto xcurve 0.0 0.0)
       (set xcurve 'fill-color "black")
       
Hints greatly appreciated.

Jan.


#! /usr/bin/guile -s
!#
;; guile-gnome
;; Copyright (C) 2004 Free Software Foundation, Inc.

;; This program is free software; you can redistribute it and/or    
;; modify it under the terms of the GNU General Public License as   
;; published by the Free Software Foundation; either version 2 of   
;; the License, or (at your option) any later version.              
;;                                                                  
;; This program is distributed in the hope that it will be useful,  
;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
;; GNU General Public License for more details.                     
;;                                                                  
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation           Voice:  +1-617-542-5942
;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
;; Boston, MA  02111-1307,  USA       address@hidden

(use-modules (gnome gtk)
             (gnome gtk gdk-event)
             (gnome canvas))

(debug-enable 'backtrace)

(define (stderr string . rest)
  (apply format (current-error-port) string rest)
  (force-output (current-error-port)))

(define canvas-width 300)
(define canvas-height canvas-width)
(define output-scale 1.8)

;; Hmm.
;;(define-class <gnome-canvas-path-def> (<gnome-canvas-shape>))
;;;(define-method (moveto (this <gnome-canvas-path-def>) x y)
;;  (gnome-canvas-path-def-moveto this x y))
  
  

(define (main)

  (define (item-event item event . data)
    (case (gdk-event:type event)
      ((enter-notify) (set item 'fill-color "white"))
      ((leave-notify) (set item 'fill-color "black"))
      ((2button-press) (set item 'fill-color "red")))
    #t)
    
  (define (key-press-event item event . data)
    (let ((keyval (gdk-event-key:keyval event))
          (mods (gdk-event-key:modifiers event)))
      (if (and (or (eq? keyval gdk:q)
                   (eq? keyval gdk:w))
               (equal? mods '(control-mask modifier-mask)))
          (gtk-main-quit))
      #f))
    
  (let* ((window (make <gtk-window> #:type 'toplevel))
         (button (make <gtk-button> #:label "Exit"))
         (canvas (make <gnome-canvas>))
         (vbox (make <gtk-vbox>))
         (canvas-root (root canvas)))

    (add window vbox)
    (add vbox canvas)

    (let* ((line (make <gnome-canvas-rect> #:parent canvas-root
                       #:x1 0.0 #:y1 0.0 #:x2 100.0 #:y2 9.0
                       #:fill-color "black"))
           (text (make <gnome-canvas-text> #:parent canvas-root
                       #:font "new century schoolbook, i bold 20"
                       #:text "Guile GNOME"
                       #:x 0.0 #:y 0.0
                       #:size-points 18
                       #:size-set #t
                       #:fill-color "black"
                       #:anchor 'west))
           (line-2 (make <gnome-canvas-rect> #:parent canvas-root
                         #:x1 0.0 #:y1 30.0 #:x2 100.0 #:y2 39.0
                         #:fill-color "black"))
           ;;(curve (make <gnome-canvas-path-def>)))
           (curve (gnome-canvas-path-def-new)))

      ;; UGH
      ;;(moveto curve 0.0 0.0)
      (gnome-canvas-path-def-moveto curve 0.0 0.0)
      (gnome-canvas-path-def-curveto curve 10.0 10.0 20.0 10.0 30.0 0.0)
      (gnome-canvas-path-def-lineto curve 0.0 0.0)
      (gnome-canvas-path-def-closepath curve)
      ;; how to set property?
      ;;(set curve 'fill-color "black")
      ;;(set  (gnome-canvas-path-def-bpath curve) 'fill-color "black")
      ;;(gtk-object-set (gnome-canvas-path-def-bpath curve) 'fill-color "black")
      ;;(gobject-set (gnome-canvas-path-def-bpath curve) 'fill-color "black")
      ;;(g-object-set (gnome-canvas-path-def-bpath curve) 'fill-color "black")
      ;;(g-object-set (gnome-canvas-path-def-bpath curve) 'fill-color "black")
      ;;(gobject-set-property curve 'fill-color "black")
      ;;(gtk-object-set curve 'fill-color "black")
      (move text -40 55)
      (connect text 'event item-event)
    
      (for-each (lambda (item)
                  (move item -40 20)
                  (affine-relative item output-scale 0 0 output-scale 0 0))
       (list line line-2)))

    (add vbox button)
    (connect button 'clicked
             (lambda (b) (gtk-main-quit)))

    (connect window 'key-press-event key-press-event)
    
    ;; (set-size-request button canvas-width 20) ?
    (set-child-packing vbox button #f #f 0 'end)
    (set-size-request canvas canvas-width canvas-height)
    
    (show-all window)
    (gtk-main)))

(main)



-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond - The music typesetter
http://www.xs4all.nl/~jantien       | http://www.lilypond.org