[-- 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)