メディアファイルの再生

カレントディレクトリのtest.mp3を再生しながら、schemeコードでレベルメータを描画する。
Gstreamer winbuildsをインストールした環境かつCygwin環境下でないと動かない。原理的には32bitのLinuxでも動くはずで、その場合はgstreamer-plugins-ffmpegとgstreamer-plugins-good、gstreamer-plugins-uglyが必要。
amd64だとg_object_set(可変長引数を取る)が正常に動かない。
skymoshと違ってmoshはcallbackやCコードからのメッセージ送信をサポートしていないので、schemeコード側から能動的にバッファを受け取っている(appsink-pull-buffer)。
ポインタからbytevectorを作る方法やbytevectorをポインタにする方法がわからなかった。pointer-ref系も仕様が見つけられなかったので霊感で使っている。

(import (rnrs)
        (except (mosh) format) (mosh ffi)
        (srfi :48))

(define gobjectname "libgobject-2.0-0.dll")
(define gstbasename "libgstreamer-0.10.dll")
(define gstappname "libgstapp-0.10.dll")

(define filename "test.mp3")

(define libgobject (open-shared-library gobjectname))
(define libgstreamer (open-shared-library gstbasename))
(define libgstapp (open-shared-library gstappname))

;; FFI imports
(define gst-init (c-function libgstreamer void gst_init int int))
(define gst-pipeline-new (c-function libgstreamer void* gst_pipeline_new int))
(define gst-element-factory-make (c-function libgstreamer void* gst_element_factory_make char* int))
(define gobject-set%char (c-function libgobject void g_object_set void* char* char* int))
(define gobject-set%pointer (c-function libgobject void g_object_set void* char* void* int))
(define gtype-from-name (c-function libgobject void* g_type_from_name char*))
(define appsink-pull-buffer (c-function libgstapp void* gst_app_sink_pull_buffer void*))
(define gst-caps-from-string (c-function libgstreamer void* gst_structure_from_string char*))

(define gst-bin-add (c-function libgstreamer void gst_bin_add void* void*))
(define gst-element-link (c-function libgstreamer void gst_element_link void* void*))
(define gst-element-set-state (c-function libgstreamer void gst_element_set_state void* int))
(define gst-buffer-unref (c-function libgstreamer void gst_mini_object_unref void*))

(define (entry%uint st o)
  (pointer-ref-c-unsigned-int st o))

(define (entry%pointer st o)
  (pointer-ref-c-pointer st o))

(define (gst-buffer-data buf)
  (entry%pointer buf 4))

(define (gst-buffer-size buf)
  (entry%uint buf 5))

(gst-init 0 0)

(define (element name)
  (gst-element-factory-make name 0))

(define (gset! element slot value)
  (cond
    ((pointer? value) (gobject-set%pointer element slot value 0))
    (else (gobject-set%char element slot value 0))))

(define (addbin-all pipe . x)
  (define (addbin-itr x)
    (if (pair? x)
      (begin
        (gst-bin-add pipe (car x))
        (addbin-itr (cdr x)))))
  (addbin-itr x))

(define (nullpo? x) (= 0 (pointer->integer x)))

(define pipe (gst-pipeline-new 0))
(define src (element "filesrc"))
(define parse (element "mp3parse"))
(define dec (element "ffdec_mp3"))
(define sink (element "autoaudiosink"))
(define audioconvert (element "audioconvert"))
(define tee (element "tee"))
(define appsink (element "appsink"))
(define capsfilter (element "capsfilter"))
(define q1 (element "queue"))
(define q2 (element "queue"))
(define caps (gst-caps-from-string "audio/x-raw-int, endian=1234, signed=true, channels=(int)1, depth=16, width=32"))

(display caps)(display (nullpo? caps))(newline)

(gset! src "location" filename)

(addbin-all pipe src parse dec sink tee q1 q2 audioconvert capsfilter appsink )

(gst-element-link src parse)
(gst-element-link parse dec)
(gst-element-link dec tee)
(gst-element-link tee q1)
(gst-element-link q1 sink)
(gst-element-link tee q2)
(gst-element-link q2 appsink)
(gset! capsfilter "caps" appsink)

(gst-element-set-state pipe 4) ;;GST_STATE_PLAYING

(define (bar n)
  (define (bar-itr m)
    (display "#")
    (if (not (= n m)) (bar-itr (+ 1 m))))
  (bar-itr 0))

(define (printvol buf)
  (let ((count (/ (gst-buffer-size buf) 8))
        (ptr (gst-buffer-data buf)))
    (define (drawvol v)
      (let* ((rate (fl/ v 32768.0))
             (w (ceiling (* rate 40))))
        (format #t "~12,10F : " (inexact rate))(bar w)(newline)))
    (define (vol-itr v cur)
      (if (<= count cur)
        (drawvol v)
        (vol-itr
          (+ v (/ (inexact (abs (pointer-ref-c-int16 ptr cur))) count)) ;; WRONG?
          (+ 1 cur))))
    (vol-itr 0 0)))

(define (pr)
  (let ((buf (appsink-pull-buffer appsink)))
    (if (nullpo? buf) (begin (newline)(exit 0)))
    (printvol buf)
    (gst-buffer-unref buf))
  (pr))

(pr)