Changeset 22070 in project
- Timestamp:
- 12/18/10 20:28:37 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/pulseaudio/trunk/pulseaudio.scm
r22065 r22070 1 1 (module pulseaudio 2 2 3 (connect) 4 (reexport (rename pulseaudio-lolevel (run-mainloop run))) 3 (connect 4 facilities facility-properties facility-index facility-type) 5 6 (reexport (rename pulseaudio-lolevel 7 (run-mainloop run) 8 (iterate-mainloop iterate))) 5 9 6 10 (import chicken scheme) 7 11 (use pulseaudio-lolevel srfi-1 data-structures extras) 8 12 13 (include "helpers") 14 9 15 (define context (make-parameter #f)) 16 (define facilities (make-parameter '((sink-inputs)))) 10 17 11 (include "helpers") 18 (define-record facility 19 type index properties) 12 20 13 21 (define (keyword-args->alist kargs) … … 22 30 23 31 (define facility-info-callbacks 24 `((sink-input . ,context-sink-input-info))) 32 `((sink-input ,context-sink-input-info ,context-sink-input-info-list ,sink-input-info-index))) 33 34 (define facility-info-proplist 35 `((sink-input . ,sink-input-info-proplist))) 36 37 (define (facility-update! facility index info) 38 (let* ((get-proplist (alist-ref facility facility-info-proplist)) 39 (record (make-facility facility index (proplist->alist (get-proplist info))))) 40 (facilities 41 (alist-update! facility 42 (alist-update! index record (alist-ref facility (facilities))) 43 (facilities))) 44 record)) 45 46 (define (facility-ref facility index) 47 (alist-ref index (alist-ref facility (facilities)))) 48 49 (define (facility-delete! facility index) 50 (and-let* ((record (facility-ref facility index))) 51 (facilities (alist-update! facility 52 (alist-delete! index (alist-ref facility (facilities))) 53 (facilities))) 54 record)) 25 55 26 56 (define (make-subscriptions-callback subscriptions) 27 57 (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))) 58 (lambda (ctx event index) 59 (and-let* ((type (subscription-event-type event)) 60 (facility (subscription-event-facility event)) 61 (callback (alist-ref facility subscriptions))) 39 62 40 (case type 41 ((remove) (callback ctx type index #f)) 42 (else (get-info ctx index (cut callback <> type index <>))))))))) 63 ((car callback) ctx type index))))) 43 64 44 65 (define available-subscriptions … … 48 69 (memq (car s) available-subscriptions)) 49 70 71 (define (wrap-subscription-callback s) 72 (let* ((facility (car s)) 73 (callback (wrap-callback (cdr s))) 74 (get-info (car (alist-ref facility facility-info-callbacks))) 75 (make-info-callback (lambda (type facility index) 76 (lambda (ctx info) 77 (callback ctx type (facility-update! facility index info)))))) 78 79 (list facility 80 (lambda (ctx type index #!optional (get-info get-info)) 81 (case type 82 ((remove) (and-let* ((record (facility-delete! facility index))) 83 (callback ctx type record))) 84 (else (get-info ctx index (make-info-callback type facility index))))) 85 make-info-callback))) 86 87 (define (initialize-subscribed-facilities ctx subscriptions) 88 (for-each (lambda (subscription) 89 (let* ((facility (car subscription)) 90 (facility-info (alist-ref facility facility-info-callbacks)) 91 (get-info-list (cadr facility-info)) 92 (facility-info-index (caddr facility-info)) 93 (make-info-callback (caddr subscription))) 94 95 (get-info-list ctx (lambda (ctx info) 96 ((make-info-callback 'initialize 97 facility 98 (facility-info-index info)) 99 ctx info))))) 100 subscriptions)) 101 50 102 (define (make-context-state-callback callbacks) 51 (let* ((subscriptions ( filter subscription-callback? callbacks))103 (let* ((subscriptions (map wrap-subscription-callback (filter subscription-callback? callbacks))) 52 104 (subscriptions-cb (make-subscriptions-callback subscriptions)) 53 105 (context-state-cb (wrap-callback (alist-ref 'context-state callbacks))) 54 106 (context-ready-cb (wrap-callback (alist-ref 'context-ready callbacks)))) 107 55 108 (lambda (ctx) 56 109 (let ((state (context-state ctx))) … … 62 115 (when context-ready-cb (context-ready-cb ctx)) 63 116 (when subscriptions-cb 117 (initialize-subscribed-facilities ctx subscriptions) 64 118 (context-subscribe-callback-set! ctx subscriptions-cb) 65 119 (subscribe-context-events ctx (map car subscriptions))))))))) 66 120 67 (define (connect name . handlers)121 (define (connect name . args) 68 122 (let* ((mainloop (make-mainloop)) 123 (args (keyword-args->alist args)) 69 124 (ctx (make-context (mainloop-api mainloop) 70 125 name 71 (make-proplist application-name: name))) 72 (handlers (keyword-args->alist handlers))) 126 (apply make-proplist 127 (append (alist-ref 'properties args eq? '()) 128 (list application.name: name)))))) 73 129 74 (context-state-callback-set! ctx (make-context-state-callback handlers)) 75 130 (context-state-callback-set! ctx (make-context-state-callback args)) 76 131 (connect-context ctx) 77 132 mainloop))
Note: See TracChangeset
for help on using the changeset viewer.