Changeset 22070 in project

Timestamp:

12/18/10 20:28:37 (10 years ago)

Author:

Moritz Heidkamp

Message:

pulseaudio: foundation for higher level API

File:

• release/4/pulseaudio/trunk/pulseaudio.scm (modified) (4 diffs)

release/4/pulseaudio/trunk/pulseaudio.scm

@@ -1 +1 @@
 (module pulseaudio
 
-(connect)
-(reexport (rename pulseaudio-lolevel (run-mainloop run)))
+(connect 
+ facilities facility-properties facility-index facility-type)
+
+(reexport (rename pulseaudio-lolevel 
+                  (run-mainloop run)
+                  (iterate-mainloop iterate)))
 
 (import chicken scheme)
 (use pulseaudio-lolevel srfi-1 data-structures extras)
 
+(include "helpers")
+
 (define context (make-parameter #f))
+(define facilities (make-parameter '((sink-inputs))))
 
-(include "helpers")
+(define-record facility
+  type index properties)
 
 (define (keyword-args->alist kargs)
@@ -22 +30 @@
 
 (define facility-info-callbacks
-  `((sink-input . ,context-sink-input-info)))
+  `((sink-input ,context-sink-input-info ,context-sink-input-info-list ,sink-input-info-index)))
+
+(define facility-info-proplist
+  `((sink-input . ,sink-input-info-proplist)))
+
+(define (facility-update! facility index info)
+  (let* ((get-proplist (alist-ref facility facility-info-proplist))
+         (record (make-facility facility index (proplist->alist (get-proplist info)))))
+    (facilities 
+     (alist-update! facility 
+                    (alist-update! index record (alist-ref facility (facilities)))
+                    (facilities)))
+    record))
+
+(define (facility-ref facility index)
+  (alist-ref index (alist-ref facility (facilities))))
+
+(define (facility-delete! facility index)
+  (and-let* ((record (facility-ref facility index)))
+    (facilities (alist-update! facility
+                               (alist-delete! index (alist-ref facility (facilities)))
+                               (facilities)))
+    record))
 
 (define (make-subscriptions-callback subscriptions)
   (and (not (null? subscriptions))
-       (let ((subscriptions (map (lambda (s) 
-                                   (list (car s)
-                                         (wrap-callback (cdr s))
-                                         (alist-ref (car s) facility-info-callbacks)))
-                                 subscriptions)))
-         (lambda (ctx event index)
-           (and-let* ((type (subscription-event-type event))
-                      (facility (subscription-event-facility event))
-                      (callback (alist-ref facility subscriptions))
-                      (get-info (cadr callback))
-                      (callback (car callback)))
+       (lambda (ctx event index)
+         (and-let* ((type (subscription-event-type event))
+                    (facility (subscription-event-facility event))
+                    (callback (alist-ref facility subscriptions)))
 
-             (case type
-               ((remove) (callback ctx type index #f))
-               (else (get-info ctx index (cut callback <> type index <>)))))))))
+           ((car callback) ctx type index)))))
 
 (define available-subscriptions 
@@ -48 +69 @@
   (memq (car s) available-subscriptions))
 
+(define (wrap-subscription-callback s)
+  (let* ((facility (car s))
+         (callback (wrap-callback (cdr s)))
+         (get-info (car (alist-ref facility facility-info-callbacks)))
+         (make-info-callback (lambda (type facility index)
+                               (lambda (ctx info)
+                                 (callback ctx type (facility-update! facility index info))))))
+
+    (list facility
+          (lambda (ctx type index #!optional (get-info get-info))
+            (case type
+              ((remove) (and-let* ((record (facility-delete! facility index)))
+                          (callback ctx type record)))
+              (else (get-info ctx index (make-info-callback type facility index)))))
+          make-info-callback)))
+
+(define (initialize-subscribed-facilities ctx subscriptions)
+  (for-each (lambda (subscription)
+              (let* ((facility (car subscription))
+                     (facility-info (alist-ref facility facility-info-callbacks))
+                     (get-info-list (cadr facility-info))
+                     (facility-info-index (caddr facility-info))
+                     (make-info-callback (caddr subscription)))
+                
+                (get-info-list ctx (lambda (ctx info)
+                                     ((make-info-callback 'initialize 
+                                                          facility
+                                                          (facility-info-index info))
+                                      ctx info)))))
+            subscriptions))
+
 (define (make-context-state-callback callbacks)
-  (let* ((subscriptions (filter subscription-callback? callbacks))
+  (let* ((subscriptions (map wrap-subscription-callback (filter subscription-callback? callbacks)))
          (subscriptions-cb (make-subscriptions-callback subscriptions))
          (context-state-cb (wrap-callback (alist-ref 'context-state callbacks)))
          (context-ready-cb (wrap-callback (alist-ref 'context-ready callbacks))))
+
     (lambda (ctx)
       (let ((state (context-state ctx)))
@@ -62 +115 @@
            (when context-ready-cb (context-ready-cb ctx))
            (when subscriptions-cb
+             (initialize-subscribed-facilities ctx subscriptions)
              (context-subscribe-callback-set! ctx subscriptions-cb)
              (subscribe-context-events ctx (map car subscriptions)))))))))
 
-(define (connect name . handlers)
+(define (connect name . args)
   (let* ((mainloop (make-mainloop))
+         (args (keyword-args->alist args))
          (ctx (make-context (mainloop-api mainloop) 
                             name
-                            (make-proplist application-name: name)))
-         (handlers (keyword-args->alist handlers)))
+                            (apply make-proplist
+                                   (append (alist-ref 'properties args eq? '())
+                                           (list application.name: name))))))
     
-    (context-state-callback-set! ctx (make-context-state-callback handlers))
-
+    (context-state-callback-set! ctx (make-context-state-callback args))
     (connect-context ctx)
     mainloop))