examples/tictactoe.scm

examples/tictactoe.scm

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 630 bytes --]

I tried to run examples/tictactoe.scm and noticed gtk-class-new and
gtk-signal-new-generic seem to have bit-rotted slightly.

        * guile-gtk.c (gtk_class_new): Use gtk_type_query rather than
        gtk_type_get_info.
        (gtk_signal_new_generic): Use sgtk_callback_marshal for marshalling.

Not sure if this is actually right, but it takes it from not working
to seeming to work. :)

I see the gtk changelog says gtk_type_get_info got reverted.  I guess
gtk_type_query is the way to go, for gtk 1.2 at least.  Unless anyone
knows better I'd think it could be used unconditionally, no need for
an autoconf check by now.


[-- Attachment #2: guile-gtk.c.tictactoe.diff --]
[-- Type: text/plain, Size: 1174 bytes --]

--- guile-gtk.c.~1.15.~	2003-05-24 10:02:45.000000000 +1000
+++ guile-gtk.c	2003-05-25 12:15:41.000000000 +1000
@@ -2565,19 +2565,21 @@
 gtk_class_new (GtkType parent_type, gchar *name)
 {
   GtkTypeInfo info = { 0 };
-  GtkTypeInfo parent_info;
+  GtkTypeQuery *parent_query;
 
-  if (!gtk_type_get_info (parent_type, &parent_info))
+  parent_query = gtk_type_query (parent_type);
+  if (parent_query == NULL)
     return GTK_TYPE_INVALID;
 
   info.type_name = name;
-  info.object_size = parent_info.object_size;
-  info.class_size = parent_info.class_size;
+  info.object_size = parent_query->object_size;
+  info.class_size = parent_query->class_size;
   info.class_init_func = NULL;
   info.object_init_func = NULL;
 #if GTK_MAJOR_VERSION > 1 || GTK_MINOR_VERSION > 0
   info.base_class_init_func = NULL;
 #endif
+  g_free (parent_query);
 
   return gtk_type_unique (parent_type, &info);
 }
@@ -2596,7 +2598,7 @@
     return 0;
 
   signal_id = gtk_signal_newv (name, signal_flags, type,
-			       0, NULL,
+			       0, sgtk_callback_marshal,
 			       return_type, nparams, params);
   if (signal_id > 0)
     gtk_object_class_add_signals (gtk_type_class (type),

Re: examples/tictactoe.scm

[Kevin Ryde]

I wrote:
>
>         * guile-gtk.c (gtk_class_new): Use gtk_type_query rather than
>         gtk_type_get_info.
>         (gtk_signal_new_generic): Use sgtk_callback_marshal for marshalling.

In absense of violent objections, I made this change.

Re: examples/tictactoe.scm

[Marius Vollmer]

The tictactoe example didn't ever work.  I had a locally patched
version of Gtk+ that had the necessary additions to the Gtk+ object
model, but I couldn't convince the Gtk+ guys to include the patch.
Thus, tictactoe will never work right with a stock Gtk+ 1.2.  Don't
know about Gtk+ 2.0, though.

-- 
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3  331E FAF8 226A D5D4 E405

Re: examples/tictactoe.scm

[Kevin Ryde]

Marius Vollmer <mvo@zagadka.de> writes:
>
> The tictactoe example didn't ever work.  I had a locally patched
> version of Gtk+ that had the necessary additions to the Gtk+ object
> model, but I couldn't convince the Gtk+ guys to include the patch.

gtk_type_query which got added subsequently seems to give the
necessary info.

> Thus, tictactoe will never work right with a stock Gtk+ 1.2.

It's working now :-), enough to start up and seem to go at least.

Re: examples/tictactoe.scm

[Marius Vollmer]

Kevin Ryde <user42@zip.com.au> writes:

> > Thus, tictactoe will never work right with a stock Gtk+ 1.2.
> 
> It's working now :-), enough to start up and seem to go at least.

Ohh!  I need to take a closer look then.  I know I was pretty obsessed
with correctness back then...

-- 
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3  331E FAF8 226A D5D4 E405

Re: examples/tictactoe.scm

[Andy Wingo]

[-- Attachment #1: Type: text/plain, Size: 813 bytes --]

On Sun, 15 Jun 2003, Marius Vollmer wrote:

> The tictactoe example didn't ever work.  I had a locally patched
> version of Gtk+ that had the necessary additions to the Gtk+ object
> model, but I couldn't convince the Gtk+ guys to include the patch.
> Thus, tictactoe will never work right with a stock Gtk+ 1.2.  Don't
> know about Gtk+ 2.0, though.

Just for the record, I've attached the current version of
tic-tac-toe.scm for guile-gobject. The version in the latest release
also works, but it's not as nice.

Speaking of which: Can I have cvs access to guile-gtk so I can put in
guile-gobject? My savannah username is "wingo".

I've also attached a copy of a sine source element for GStreamer, just
to show off the gstreamer bindings (in GStreamer cvs), that also depend
on guile-gobject.

Regards,

wingo.


[-- Attachment #2: sinesrc.scm --]
[-- Type: text/plain, Size: 6158 bytes --]

;;; Commentary:
;;
;; A reimplementation of GStreamer's sine src in scheme. It's slow slow
;; slow -- my PIII/600 laptop can't do it in realtime. This is really
;; just a proof of concept.
;;
;;; Code:

(define-module (examples gstreamer sinesrc)
  :use-module (gnome gstreamer)
  :use-module (gnome gobject primitives)
  :export (<scm-sinesrc>))

(read-set! keywords 'prefix) ;; :keywords rather than #:keywords

(define-gobject-class <scm-sinesrc> <gst-element> "scm-sinesrc")

(let-params <scm-sinesrc>
            ((sample-rate (<gparam-int>
                           :nick "Sample rate" :blurb "Sample rate"
                           :minimum 4000 :maximum 48000 :default-value 44100
                           :flags '(read write construct)))
             (table-size (<gparam-int>
                          :nick "Table size" :blurb "Size of wavetable"
                          :minimum 1 :maximum gruntime:int-max :default-value 1024
                          :flags '(read write construct)))
             (buffer-size (<gparam-int>
                           :nick "Buffer size" :blurb "Buffer size (frames)"
                           :minimum 1 :maximum gruntime:int-max :default-value 1024
                           :flags '(read write construct)))
             (frequency (<gparam-float>
                         :nick "Frequency" :blurb "Frequency of sine source"
                         :minimum 0.0 :maximum 20000.0 :default-value 440.0
                         :flags '(read write construct)))
             (volume (<gparam-float>
                      :nick "Volume" :blurb "Volume of sine source"
                      :minimum 0.0 :maximum 1.0 :default-value 0.8
                      :flags '(read write construct)))
             (src-pad #f)
             (timestamp #f)
             (wavetable #f)
             (new-caps? #f)
             (table-pos #f))

  ;; the defines need to come before the define-methods

  (define uv-set! uniform-vector-set!)
  (define uv-ref uniform-vector-ref)

  (define (populate-sinetable src)
    (let* ((tsize (table-size src))
           (t (make-uniform-vector tsize 1.0))
           (pi2scaled (/ (* 3.141592653589 2 ) tsize)))
      (let loop ((i 0))
        (uv-set! t i (sin (* i pi2scaled)))
        (if (eq? (1+ i) tsize)
            #t
            (loop (1+ i))))
      (set! (wavetable src) t)))
  
  (define (get-func pad)
    (let* ((this (get-parent pad))
           (data-len (buffer-size this))
           (data (make-uniform-vector data-len 's)) ;; a vector of shorts
           (buffer (gst-buffer-new))
           (table-size (table-size this))
           (wavetable (wavetable this))
           (volume (volume this))
           (table-step (* table-size (/ (frequency this) (sample-rate this)))))
;;      (set-timestamp buffer (timestamp this))
      (gst-buffer-set-data buffer data)
      
;;      (set! (timestamp this) (+ (timestamp this) (* data-len gst:second)))
      
      (let ((lookup 0) (lookup-next 0) (f 0.0))
        (do ((i 0 (1+ i))
             (pos (table-pos this) (+ pos table-step)))
            ((eq? i data-len) (set! (table-pos this) pos))
          (set! lookup (modulo (inexact->exact (floor pos)) table-size))
          (set! lookup-next (modulo (1+ lookup) table-size))
          (set! f (- pos (floor pos)))
          
          ;; linear interpolation
          (uv-set! data i (inexact->exact
                           (* (+ (* f (uv-ref wavetable lookup-next))
                                 (* (- 1 f) (uv-ref wavetable lookup)))
                              (* volume 32767))))))
      
      (if (new-caps? this)
          (let ((caps (gst-caps-new
                       "sinesrc-src" "audio/raw"
                       (gst-props-new
                        '("format" string-type "int")
                        '("channels" int-type 1)
                        `("rate" int-type ,(sample-rate this))
                        '("law" int-type 0)
                        `("endianness" int-type ,gruntime:byte-order)
                        '("signed" boolean-type #t)
                        '("depth" int-type 16)
                        '("width" int-type 16)))))
            (try-set-caps (src-pad this) caps)
            (set! (new-caps? this) #f)))
      
      buffer))
  
  (define-method (gobject:set-property (obj <scm-sinesrc>) (name <symbol>) value)
    (case name
      ((sample-rate)
       (set! (sample-rate obj) value)
       (set! (new-caps? obj) #t))
      ((table-size)
       (set! (table-size obj) value)
       (populate-sinetable obj))
      ((buffer-size)
       (set! (buffer-size obj) value))
      ((frequency)
       (set! (frequency obj) value))
      ((volume)
       (set! (volume obj) value))
      (else
       (error "Unknown property: " name))))

  (define-method (gobject:get-property (obj <scm-sinesrc>) (name <symbol>))
    (case name
      ((sample-rate) (sample-rate obj))
      ((table-size) (table-size obj))
      ((buffer-size) (buffer-size obj))
      ((frequency) (frequency obj))
      ((volume) (volume obj))
      (else (error "Unknown property: " name))))

  (define-method (gobject:instance-init (class <gst-element>) (obj <scm-sinesrc>))
    (let* ((templates (get-pad-templates <scm-sinesrc>))
           (src-template (get-pad-template templates "src"))
           (src (gst-pad-new-from-template src-template "src")))
      (set! (src-pad obj) src)
      (add-pad obj src)
      (set-get-function src get-func)
      
      ;; no dparams (yet), sorry...
      ;; wavetable will be populated on construction automagically

      (set! (table-pos obj) 0.0)
      (set! (timestamp obj) 0)))

  (add-pad-template
   <scm-sinesrc>
   (gst-pad-template-new
    "src" 'src 'always
    (gst-caps-new
     "sinesrc-src" "audio/raw"
     (gst-props-new
      '("format" string-type "int")
      '("channels" int-type 1)
      '("rate" int-range-type 8000 48000)
      '("law" int-type 0)
      `("endianness" int-type ,gruntime:byte-order)
      '("signed" boolean-type #t)
      '("depth" int-type 16)
      '("width" int-type 16)))))
  
  (register-new-element <scm-sinesrc> "scm-sinesrc"))

[-- Attachment #3: tic-tac-toe.scm --]
[-- Type: text/plain, Size: 4700 bytes --]

(read-set! keywords 'prefix)
(use-modules (gnome gtk) (gnome gobject primitives))

(define-gobject-class <tic-tac-toe> <gtk-vbox> "tic-tac-toe"
  ;; signals follow
  (tic-tac-toe #f))

;; there are many ways to define the class functionality; the let-params
;; way is (imho) the most flexible, so we use it here as an example. as
;; a way to demonstrate how to set object properties with equivalents on
;; the gobject side of things, we add a property to change the board
;; size.
;;
;; see examples/gobject/my-object.scm for more info on let-params.
(let-params <tic-tac-toe>
            ((board-size (<gparam-int> ; a gobject property and a
				       ; procedure-with-setter of the
				       ; same name
                          :minimum 2 :maximum 100 :default-value 3
                          :flags '(read write construct)))
             (table #f) ; a procedure-with-setter only -- with some
			; voodoo so that it sets to the gtype-instance,
			; not the gobject wrapper
             (buttons #f)
             (winning-combinations #f))
  (define (ttt-clear ttt)
    (let ((buttons (buttons ttt)))
      (do ((p 0 (1+ p)))
          ((>= p (vector-length buttons)))
        (set (vector-ref buttons p) 'active #f))))

  (define (ttt-toggle ttt)
    (let ((buttons (buttons ttt)))
      (let loop ((wins (winning-combinations ttt)))
        (cond ((not (null? wins))
               (cond ((and-map (lambda (wp) 
                                 (get (vector-ref buttons wp) 'active))
                               (car wins))
                      (emit ttt 'tic-tac-toe)
                      (ttt-clear ttt))
                     (else
                      (loop (cdr wins)))))))))

  (define (make-sequence len init step)
    (let loop ((i len) (val init))
      (if (eq? i 0)
          '()
          (cons val (loop (1- i) (+ val step))))))

  (define-method (gobject:set-property (ttt <tic-tac-toe>) (name <symbol>) value)
    (case name
      ((board-size)
       (if (table ttt) (destroy (table ttt)))
       (let ((t (gtk-table-new value value #f))
             (bvect (make-vector (* value value))))
         (do ((p 0 (1+ p)))
             ((>= p (vector-length bvect)))
           (let ((b (make <gtk-toggle-button>))
                 (i (quotient p value))
                 (j (remainder p value)))
             (vector-set! bvect p b)
             (attach-defaults t b i (1+ i) j (1+ j))
             (connect b 'toggled (lambda (unused-arg) (ttt-toggle ttt)))))
         (set! (winning-combinations ttt)
               (map (lambda (pair) (make-sequence value (car pair) (cadr pair)))
                    (cons*
                     ;; the diagonals
                     (list 0 (1+ value)) 
                     (list (1- value) (1- value))
                     (append
                      ;; the horizontals
                      (let loop ((i 0))
                        (if (eq? i value)
                            '()
                            (cons (list i value) (loop (1+ i)))))
                      ;; the verticals
                      (let loop ((i 0))
                        (if (eq? i (* value value))
                            '()
                            (cons (list i 1) (loop (+ i value)))))))))
         (set! (table ttt) t)
         (set! (buttons ttt) bvect)
         (pack-start-defaults ttt t)
         (show-all t))
       (set! (board-size ttt) value))
      (else (next-method))))

  (define-method (gobject:get-property (ttt <tic-tac-toe>) (name <symbol>))
    (case name
      ((board-size) (board-size ttt))
      (else (next-method))))

  (define-method (gobject:instance-init (class <gtk-vbox>) (ttt <tic-tac-toe>))
    (next-method)
    ;; setting the 'board-size property on ttt, which is done on
    ;; construction (due to the 'construct flag in the param's flags),
    ;; takes care of setting up widget internals. we don't actually do
    ;; anything here -- which is nice, that means the object has a
    ;; robust interface.
    ))

(let* ((w (make <gtk-window> :type 'toplevel :title "Tic tac toe"))
       (vbox (make <gtk-vbox>))
       (ttt (make <tic-tac-toe>))
       (adj (gtk-adjustment-new 3 2 100 1 1 1)) ;; not a gobject yet, argh
       (spin (make <gtk-spin-button>)))
  (set spin 'adjustment adj)
  (connect adj 'value-changed
           (lambda (a) (set ttt 'board-size (inexact->exact (get-value a)))))
  (set-default-size w 250 250)
  (add w vbox)
  (pack-start-defaults vbox ttt)
  (pack-start vbox spin #f #f 0)
  (show-all w)
  (g-timeout-add 100 (lambda () #t))
  (connect ttt 'tic-tac-toe (lambda (ttt) (display "Yay!\n")))
  (connect w 'delete-event (lambda (ttt e) (gtk-main-quit) #f)))

(gtk-main)

Re: examples/tictactoe.scm

[Marius Vollmer]

Andy Wingo <wingo@pobox.com> writes:

> Speaking of which: Can I have cvs access to guile-gtk so I can put in
> guile-gobject? My savannah username is "wingo".

Yep.  I have added you.

-- 
GPG: D5D4E405 - 2F9B BCCC 8527 692A 04E3  331E FAF8 226A D5D4 E405

Re: examples/tictactoe.scm

[Andreas Rottmann]

[CC'd Rob Browining, since he's the g-wrap author/maintainer]

Marius Vollmer <mvo@zagadka.de> writes:

> Andy Wingo <wingo@pobox.com> writes:
>
>> Speaking of which: Can I have cvs access to guile-gtk so I can put in
>> guile-gobject? My savannah username is "wingo".
>
> Yep.  I have added you.
>
So now we get guile-gobject into CVS. Cool! 

Since the guile-gobject hackers needed to patch up g-wrap and will
likely need to do so in future, it would be really great to get g-wrap
into CVS, too. There is a savannah g-wrap project, but nothing in
CVS. So Rob, could you please check it in?

Thanks, Andy

PS: Rob: Yes, I know I've bugged you about this before. Sorry for
being so annoying.
-- 
Andreas Rottmann         | Rotty@ICQ      | 118634484@ICQ | a.rottmann@gmx.at
http://www.8ung.at/rotty | GnuPG Key: http://www.8ung.at/rotty/gpg.asc
Fingerprint              | DFB4 4EB4 78A4 5EEE 6219  F228 F92F CFC5 01FD 5B62

It's GNU/Linux dammit!

Re: examples/tictactoe.scm

[Kevin Ryde]

I wrote:
>
> Not sure if this is actually right, but it takes it from not working
> to seeming to work. :)

Actually, I see sgtk_callback_marshal is not right at all for
gtk_signal_new_generic.  Close enough when there's no signal
parameters and no return type.  Have to come back to this.

Re: examples/tictactoe.scm

[Kevin Ryde]

I wrote:
>
> Have to come back to this.

I got myself a bit confused.  I set to gtk_marshal_NONE__NONE with a
comment about this not actually being right for C callbacks, which is
ok since there won't be any for a brand new signal.