Further refine contracts on elements and pads

mwunsch · Sep 28, 2017 · 01ac788 · 01ac788
1 parent e4bc050
commit 01ac788
Show file tree

Hide file tree

Showing 2 changed files with 130 additions and 57 deletions.
diff --git a/gstreamer/element.rkt b/gstreamer/element.rkt
@@ -9,21 +9,23 @@
 (provide (contract-out [element-factory%
                         element-factory%/c]
                        [element%
-                        (subclass?/c gst-object%)]
+                        element%/c]
+                       [element-link-many
+                        (-> (is-a?/c element%)
+                            (is-a?/c element%)
+                            (is-a?/c element%) ... boolean?)]
                        [pad%
-                        (subclass?/c gst-object%)]
+                        pad%/c]
                        [ghost-pad%
-                        (subclass?/c pad%)]
-                       [element-factory%-find
-                        (-> string? (or/c false/c
-                                          (instanceof/c element-factory%/c)))]
-                       [element-factory%-make
-                        (->* (string?)
-                             ((or/c string? false/c))
-                             (or/c false/c
-                                   (is-a?/c element%)))]))
-
-(define gst-element-factory (gst 'ElementFactory))
+                        (and/c (subclass?/c pad%)
+                               (class/c
+                                [get-target
+                                 (->m (or/c (instanceof/c pad%/c)
+                                            false/c))]
+                                [set-target
+                                 (->m (is-a?/c pad%) boolean?)]))]
+                       [pad-direction
+                        gi-enum?]))
 
 (define element-factory%
   (class gst-object%
@@ -37,16 +39,6 @@
                      (values (string->symbol key)
                              (gobject-send pointer 'get_metadata key))))))
 
-(define (element-factory%-find name)
-  (let ([factory (gst-element-factory 'find name)])
-    (and factory
-         (new element-factory% [pointer factory]))))
-
-(define (element-factory%-make factory-name [name #f])
-  (let ([el (gst-element-factory 'make factory-name name)])
-    (and el
-         (new element% [pointer el]))))
-
 (define element-mixin
   (make-gobject-delegate get-compatible-pad
                          get-request-pad
@@ -68,7 +60,7 @@
         (and static-pad
              (new pad% [pointer static-pad]))))
     (define/override (get-factory)
-      (new element-factory+c% [pointer (super get-factory)]))
+      (new element-factory% [pointer (super get-factory)]))
     (define/public (get-num-src-pads)
       (gobject-get-field 'numsrcpads pointer))
     (define/public (get-num-sink-pads)
@@ -79,6 +71,12 @@
     (define/public (src?)
       (not (sink?)))))
 
+(define (element-link-many el1 el2 . els)
+  (and (send el1 link el2)
+       (if (pair? els)
+           (apply element-link-many el2 (car els) (cdr els))
+           #t)))
+
 (define pad-mixin
   (make-gobject-delegate get-direction
                          get-parent-element
@@ -96,20 +94,73 @@
 (define pad%
   (class (pad-mixin gst-object%)
     (super-new)
-    (inherit-field pointer)))
+    (inherit-field pointer)
+    (define/override (get-parent-element)
+      (new element% [pointer (super get-parent-element)]))))
+
+(define ghost-pad-mixin
+  (make-gobject-delegate set-target
+                         get-target))
 
 (define ghost-pad%
-  (class pad%
+  (class (ghost-pad-mixin pad%)
     (super-new)
-    (inherit-field pointer)))
+    (inherit-field pointer)
+    (define/override (get-target)
+      (let ([target (super get-target)])
+        (and target
+             (new pad% [pointer target]))))))
+
+(define pad-link-return
+  (gst 'PadLinkReturn))
+
+(define pad-direction
+  (gst 'PadDirection))
+
+(define pad%/c
+  (class/c
+   get-direction
+   [get-parent-element
+    (->m (is-a?/c element%))]
+   get-pad-template
+   [link
+    (->m (is-a?/c pad%) (gi-enum-value/c pad-link-return))]
+   [link-maybe-ghosting
+    (->m (is-a?/c pad%) boolean?)]
+   [unlink
+    (->m (is-a?/c pad%) boolean?)]
+   [linked?
+    (->m boolean?)]
+   [can-link?
+    (->m (is-a?/c pad%) boolean?)]
+   get-allowed-caps
+   get-current-caps
+   [get-peer
+    (->m (or/c (is-a?/c pad%) false/c))]
+   [active?
+    (->m boolean?)]))
+
+(define element%/c
+  (class/c
+   get-compatible-pad
+   get-request-pad
+   [get-static-pad
+    (->m string? (instanceof/c pad%/c))]
+   [link
+    (->m (is-a?/c element%) boolean?)]
+   [unlink
+    (->m (is-a?/c element%) void?)]
+   [link-pads
+    (->m (or/c string? false/c) (is-a?/c element%) (or/c string? false/c) boolean?)]
+   link-pads-filtered
+   link-filtered
+   [get-factory
+    (->m (is-a?/c element-factory%))]
+   set-state))
 
 (define element-factory%/c
   (class/c
    [create
-    (->*m () ((or/c string? false/c)) (is-a?/c element%))]
+    (->*m () ((or/c string? false/c)) (instanceof/c element%/c))]
    [get-metadata
     (->m (hash/c symbol? any/c))]))
-
-(define/contract element-factory+c%
-  element-factory%/c
-  element-factory%)
diff --git a/gstreamer/main.rkt b/gstreamer/main.rkt
@@ -1,57 +1,79 @@
 #lang racket/base
-
-(require ffi/unsafe
-         ffi/unsafe/introspection
+(require (except-in ffi/unsafe
+                    ->)
+         (except-in ffi/unsafe/introspection
+                    send get-field set-field! field-bound? is-a? is-a?/c)
          (only-in racket/list first last)
+         racket/class
+         racket/contract
          "gst.rkt"
-         "bus.rkt"
-         "caps.rkt"
          "element.rkt")
 
 (provide (all-from-out "gst.rkt"
-                       "bus.rkt"
-                       "caps.rkt"
                        "element.rkt")
-         pipeline%
-         pad%
-         bin%
-         event%
          bin-add-many
-         ghost-pad%
          seconds
          element-link-many
          _input-selector-sync-mode
          _video-test-src-pattern
          _audio-test-src-wave
-         gst-compose)
+         gst-compose
+         (contract-out [element-factory%-find
+                        (-> string? (or/c false/c
+                                          (is-a?/c element-factory%)))]
+                       [element-factory%-make
+                        (->* (string?)
+                             ((or/c string? false/c))
+                             (or/c false/c
+                                   (is-a?/c element%)))]
+                       [ghost-pad%-new
+                        (-> (or/c string? false/c) (is-a?/c pad%)
+                            (or/c (is-a?/c ghost-pad%)
+                                  false/c))]
+                       [ghost-pad%-new-no-target
+                        (-> (or/c string? false/c) (gi-enum-value/c pad-direction)
+                            (or/c (is-a?/c ghost-pad%)
+                                  false/c))]))
 
-(define pipeline% (gst 'Pipeline))
+(define gst-element-factory (gst 'ElementFactory))
+
+(define (element-factory%-find name)
+  (let ([factory (gst-element-factory 'find name)])
+    (and factory
+         (new element-factory% [pointer factory]))))
+
+(define (element-factory%-make factory-name [name #f])
+  (let ([el (gst-element-factory 'make factory-name name)])
+    (and el
+         (new element% [pointer el]))))
+
+(define gst-ghost-pad (gst 'GhostPad))
 
-(define pad% (gst 'Pad))
+(define (ghost-pad%-new name target)
+  (let ([ghost (gst-ghost-pad 'new name target)])
+    (and ghost
+         (new ghost-pad% [pointer ghost]))))
+
+(define (ghost-pad%-new-no-target name dir)
+  (let ([ghost (gst-ghost-pad 'new_no_target name dir)])
+    (and ghost
+         (new ghost-pad% [pointer ghost]))))
+
+(define pipeline% (gst 'Pipeline))
 
 (define bin% (gst 'Bin))
 
 (define event% (gst 'Event))
 
 (define second ((gst 'SECOND)))
 
-(define ghost-pad% (gst 'GhostPad))
-
 (define (seconds num)
   (* num second))
 
 (define (bin-add-many bin . elements)
   (for/and ([element elements])
     (send bin add element)))
 
-(define (element-link-many . elements)
-  (let link ([head (car elements)]
-             [tail (cdr elements)])
-    (if (pair? tail)
-        (and (send head link (car tail))
-             (link (car tail) (cdr tail)))
-        #t)))
-
 (define _input-selector-sync-mode (_enum '(active-segment clock)))
 
 (define (gst-compose name . elements)