Changeset 22065 in project


Ignore:
Timestamp:
12/18/10 02:24:51 (9 years ago)
Author:
Moritz Heidkamp
Message:

pulseaudio: add proplist->alist convenience procedure

Location:
release/4/pulseaudio/trunk
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/pulseaudio/trunk/pulseaudio-lolevel.scm

    r22064 r22065  
    22
    33(make-mainloop mainloop-api run-mainloop iterate-mainloop
    4  make-proplist proplist-set! proplist-ref
     4
     5 make-proplist proplist-set! proplist-ref proplist->alist
     6
    57 make-context context-state-callback-set!
    68 context-state connect-context
     
    2729(include "syntax")
    2830(include "types")
     31(include "helpers")
    2932
    3033(define (keyword->property keyword)
     
    6568       (proplist-pointer proplist)
    6669       proplist)
    67    (keyword->property (string->keyword (symbol->string name)))))
     70   (keyword->property (symbol->keyword name))))
     71
     72(define (proplist->alist proplist)
     73  (let ((proplist (if (proplist? proplist)
     74                      (proplist-pointer proplist)
     75                      proplist)))
     76    (map (lambda (property)
     77           (cons (keyword->symbol (car property))
     78                 ((foreign-lambda c-string pa_proplist_gets proplist c-string)
     79                  proplist
     80                  (cadr property))))
     81         properties)))
    6882
    6983(define-callback/setter context-state
  • release/4/pulseaudio/trunk/pulseaudio.scm

    r22002 r22065  
    1 ;; this module is going to define some high-level API later
    21(module pulseaudio
    32
    4 ()
     3(connect)
     4(reexport (rename pulseaudio-lolevel (run-mainloop run)))
    55
    66(import chicken scheme)
    7 (use pulseaudio-lolevel)
     7(use pulseaudio-lolevel srfi-1 data-structures extras)
     8
     9(define context (make-parameter #f))
     10
     11(include "helpers")
     12
     13(define (keyword-args->alist kargs)
     14  (map (lambda (arg)
     15         (cons (keyword->symbol (car arg)) (cadr arg)))
     16       (chop kargs 2)))
     17
     18(define ((wrap-callback callback . defaults) c . args)
     19  (and callback
     20       (parameterize ((context c))
     21         (apply callback (append defaults args)))))
     22
     23(define facility-info-callbacks
     24  `((sink-input . ,context-sink-input-info)))
     25
     26(define (make-subscriptions-callback subscriptions)
     27  (and (not (null? subscriptions))
     28       (let ((subscriptions (map (lambda (s)
     29                                   (list (car s)
     30                                         (wrap-callback (cdr s))
     31                                         (alist-ref (car s) facility-info-callbacks)))
     32                                 subscriptions)))
     33         (lambda (ctx event index)
     34           (and-let* ((type (subscription-event-type event))
     35                      (facility (subscription-event-facility event))
     36                      (callback (alist-ref facility subscriptions))
     37                      (get-info (cadr callback))
     38                      (callback (car callback)))
     39
     40             (case type
     41               ((remove) (callback ctx type index #f))
     42               (else (get-info ctx index (cut callback <> type index <>)))))))))
     43
     44(define available-subscriptions
     45  '(sink-input))
     46
     47(define (subscription-callback? s)
     48  (memq (car s) available-subscriptions))
     49
     50(define (make-context-state-callback callbacks)
     51  (let* ((subscriptions (filter subscription-callback? callbacks))
     52         (subscriptions-cb (make-subscriptions-callback subscriptions))
     53         (context-state-cb (wrap-callback (alist-ref 'context-state callbacks)))
     54         (context-ready-cb (wrap-callback (alist-ref 'context-ready callbacks))))
     55    (lambda (ctx)
     56      (let ((state (context-state ctx)))
     57        (when context-state-cb
     58          (context-state-cb ctx state))
     59     
     60        (case state
     61          ((ready)
     62           (when context-ready-cb (context-ready-cb ctx))
     63           (when subscriptions-cb
     64             (context-subscribe-callback-set! ctx subscriptions-cb)
     65             (subscribe-context-events ctx (map car subscriptions)))))))))
     66
     67(define (connect name . handlers)
     68  (let* ((mainloop (make-mainloop))
     69         (ctx (make-context (mainloop-api mainloop)
     70                            name
     71                            (make-proplist application-name: name)))
     72         (handlers (keyword-args->alist handlers)))
     73   
     74    (context-state-callback-set! ctx (make-context-state-callback handlers))
     75
     76    (connect-context ctx)
     77    mainloop))
    878
    979)
Note: See TracChangeset for help on using the changeset viewer.