uim-vorbis.scm

;; uimでvorbisを再生する。まったくもって無意味
(module-load "ffi")
(module-load "lolevel")

(define libc
  (dlopen "libc.so" (assq-cdr '$RTLD_LAZY (dlopen-mode))))

(define (fopen path mode)
  (ffi-function libc 'pointer "fopen" `((string . ,path)
                                        (string . ,mode))))
(define (fclose stream)
  (ffi-function libc 'int "fclose" `((pointer . ,stream))))

(define libm
  (dlopen "libm.so" (assq-cdr '$RTLD_GLOBAL (dlopen-mode))))
(define libpthread
  (dlopen "libpthread.so" (assq-cdr '$RTLD_GLOBAL (dlopen-mode))))
(define libogg
  (dlopen "libogg.so" (assq-cdr '$RTLD_GLOBAL (dlopen-mode))))
(define libvorbis
  (dlopen "libvorbis.so" (assq-cdr '$RTLD_GLOBAL (dlopen-mode))))
(define libvorbisfile ;; cannot lazy
  (dlopen "libvorbisfile.so" (assq-cdr '$RTLD_GLOBAL (dlopen-mode))))

(define (ov-open stream vf initial ibytes)
  (ffi-function libvorbisfile 'int "ov_open" `((pointer . ,stream)
                                               (pointer . ,vf)
                                               (string  . ,initial)
                                               (long    . ,ibytes))))
(define (ov-comment vf link)
  (ffi-function libvorbisfile 'pointer "ov_comment" `((pointer . ,vf)
                                                      (int . ,link))))
(define (ov-info vf link)
  (ffi-function libvorbisfile 'pointer "ov_info" `((pointer . ,vf)
                                                   (int . ,link))))
(define (ov-pcm-total vf i)
  (ffi-function libvorbisfile 'long "ov_pcm_total" `((pointer . ,vf)
                                                     (int . ,i))))

(define (ov-read vf buf len big? word sign? stream)
  (ffi-function libvorbisfile
                'long "ov_read" `((pointer . ,vf)
                                  (pointer . ,buf)
                                  (int . ,len)
                                  (int . ,big?)
                                  (int . ,word)
                                  (int . ,sign?)
                                  (pointer . ,stream))))

(define libao
  (dlopen "libao.so" (assq-cdr '$RTLD_LAZY (dlopen-mode))))

(define (ao-initialize)
  (ffi-function libao 'void "ao_initialize" '()))
(define (ao-shutdown)
  (ffi-function libao 'void "ao_shutdown" '()))
(define (ao-default-driver-id)
  (ffi-function libao 'int "ao_default_driver_id" '()))
(define (ao-open-live driver-id format option)
  (ffi-function libao 'pointer "ao_open_live" `((int . ,driver-id)
                                                (pointer . ,format)
                                                (pointer . ,option))))
(define (ao-close device)
  (ffi-function libao 'int "ao_close" `((pointer . ,device))))
(define (ao-play device buf len)
  (ffi-function libao 'int "ao_play" `((pointer . ,device)
                                       (pointer . ,buf)
                                       (int . ,len))))

(define AO_FMT_NATIVE 4)

(define (vorbis-play filename)
  (let* ((ao-sample-format
          (let ((heap (allocate 16)))
            (memory-fill! heap 0 16)
            heap))
         (fp (fopen filename "r"))
         (vf (allocate 1024)))
    (ov-open fp vf '() 0)
    (let* ((vi (ov-info vf -1))
           (chan (pointer-s32-ref (pointer-offset vi 4)))
           (rate (pointer-s64-ref (pointer-offset vi 8))))
      (ao-initialize)
      (pointer-s32-set! (pointer-offset ao-sample-format 0) 16)   ;; bits
      (pointer-s32-set! (pointer-offset ao-sample-format 4) rate) ;; rate
      (pointer-s32-set! (pointer-offset ao-sample-format 8) chan) ;; channels
      (pointer-s32-set! (pointer-offset ao-sample-format 12) AO_FMT_NATIVE) ;; byte order

      (display (format "Rate: ~a Channels: ~a Length: ~a\n" rate chan (ov-pcm-total vf -1)))

      (let* ((driver (ao-default-driver-id))
             (device (ao-open-live driver ao-sample-format '()))
             (pcmout (allocate 4096))
             (current_section (allocate 4)))
        (let loop ()
          (let ((ret (ov-read vf pcmout 4096 0 2 1 current_section)))
            (cond ((= ret 0)
                   #t)
                  ((< ret 0)
                   (printf "unknown error"))
                  (else
                   (ao-play device pcmout ret)
                   (loop)))
            (fclose fp)
            (ao-close device)
            (ao-shutdown)))))))

(vorbis-play "foobar.ogg")

(for-each dlclose (list libc libvorbisfile libao))