1 files changed, 229 insertions, 0 deletions
diff --git a/subprojects/gstreamer/tests/misc/network-clock-utils.scm b/subprojects/gstreamer/tests/misc/network-clock-utils.scm
new file mode 100644
index 0000000000..1a71e3231c
--- /dev/null
+++ b/subprojects/gstreamer/tests/misc/network-clock-utils.scm
@@ -0,0 +1,229 @@
+;; GStreamer
+;; Copyright (C) 2005 Andy Wingo <wingo at pobox.com>
+
+;; This program is free software; you can redistribute it and/or    
+;; modify it under the terms of the GNU General Public License as   
+;; published by the Free Software Foundation; either version 2 of   
+;; the License, or (at your option) any later version.              
+;;                                                                  
+;; This program is distributed in the hope that it will be useful,  
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of   
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    
+;; GNU General Public License for more details.                     
+;;                                                                  
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, contact:
+;;
+;; Free Software Foundation           Voice:  +1-617-542-5942
+;; 51 Franklin St, Fifth Floor        Fax:    +1-617-542-2652
+;; Boston, MA  02110-1301,  USA       gnu@gnu.org
+
+
+;;; Commentary:
+;;
+;; Utilities for the network clock simulator.
+;;
+;;; Code:
+
+
+;; Init the rng.
+
+(use-modules ((srfi srfi-1) (fold unfold)))
+
+(define (read-bytes-from-file-as-integer f n)
+  (with-input-from-file f
+    (lambda ()
+      (fold (lambda (x seed) (+ x (ash seed 8)))
+            0
+            (unfold zero? (lambda (n) (char->integer (read-char))) 1- n)))))
+
+(set! *random-state* (seed->random-state
+                      (read-bytes-from-file-as-integer "/dev/random" 4)))
+
+;; General utilities.
+
+(define (iround x)
+  (if (inexact? x)
+      (inexact->exact (round x))
+      x))
+
+(define (filter proc l)
+  (cond
+   ((null? l) '())
+   ((proc (car l)) (cons (car l) (filter proc (cdr l))))
+   (else (filter proc (cdr l)))))
+
+(define (sum l)
+  (apply + l))
+
+(define (avg . nums)
+  (/ (sum nums) (length nums)))
+
+(define (sq x)
+  (* x x))
+
+(define (debug str . args)
+  (if *debug*
+      (apply format (current-error-port) str args)))
+
+(define (print-event kind x y)
+  (format #t "~a ~a ~a\n" kind x y))
+
+;; Linear least squares.
+;;
+;; See http://mathworld.wolfram.com/LeastSquaresFitting.html
+;; returns (values slope intercept r-squared)
+
+(define (least-squares x y)
+  (let ((n (length x)))
+    (let ((xbar (apply avg x))
+          (ybar (apply avg y)))
+      (let ((sxx (- (sum (map sq x)) (* n (sq xbar))))
+            (syy (- (sum (map sq y)) (* n (sq ybar))))
+            (sxy (- (sum (map * x y)) (* n xbar ybar))))
+        (let ((slope (/ sxy sxx)))
+          (values
+           slope
+           (- ybar (* slope xbar))
+           (/ (sq sxy) (* sxx syy))))))))
+
+;; Streams: lists with lazy cdrs.
+
+(define-macro (stream-cons kar kdr)
+  `(cons ,kar (delay ,kdr)))
+
+(define (stream-cdr stream)
+  (force (cdr stream)))
+
+(define (stream-car stream)
+  (car stream))
+
+(define (stream-null? stream)
+  (null? stream))
+
+(define (stream-ref stream n)
+  (if (zero? n)
+      (stream-car stream)
+      (stream-ref (stream-cdr stream) (1- n))))
+
+(define (stream->list stream n)
+  (let lp ((in stream) (out '()) (n n))
+    (if (zero? n)
+        (reverse! out)
+        (lp (stream-cdr in) (cons (stream-car in) out) (1- n)))))
+
+(define (stream-skip stream n)
+  (if (zero? n)
+      stream
+      (stream-skip (stream-cdr stream) (1- n))))
+
+(define (stream-sample stream n)
+  (stream-cons (stream-car stream)
+               (stream-sample (stream-skip stream n) n)))
+
+(define (stream-map proc . streams)
+  (stream-cons (apply proc (map stream-car streams))
+               (apply stream-map proc (map stream-cdr streams))))
+
+(define (arithmetic-series start step)
+  (stream-cons start (arithmetic-series (+ start step) step)))
+
+(define (scale-stream stream factor)
+  (stream-map (lambda (t) (* t factor)) stream))
+
+(define (stream-while pred proc . streams)
+  (if (apply pred (map stream-car streams))
+      (begin
+        (apply proc (map stream-car streams))
+        (apply stream-while pred proc (map stream-cdr streams)))))
+
+(define (stream-of val)
+  (stream-cons val (stream-of val)))
+
+(define (periodic-stream val period)
+  (let ((period (iround (max 1 (* *sample-frequency* period)))))
+    (let lp ((n 0))
+      (if (zero? n)
+          (stream-cons val (lp period))
+          (stream-cons #f (lp (1- n)))))))
+
+
+;; Queues with a maximum length.
+
+(define (make-q l)
+  (cons l (last-pair l)))
+
+(define (q-head q)
+  (car q))
+
+(define (q-tail q)
+  (car q))
+
+(define (q-push q val)
+  (let ((tail (cons val '())))
+    (if (null? (q-tail q))
+        (make-q tail)
+        (let ((l (append! (q-head q) tail)))
+          (if (> (length (q-head q)) *window-size*)
+              (make-q (cdr (q-head q)))
+              q)))))
+
+
+;; Parameters, settable via command line arguments.
+
+(define %parameters '())
+(define-macro (define-parameter name val)
+  (let ((str (symbol->string name)))
+    (or (and (eqv? (string-ref str 0) #\*)
+             (eqv? (string-ref str (1- (string-length str))) #\*))
+        (error "Invalid parameter name" name))
+    (let ((param (string->symbol
+                  (substring str 1 (1- (string-length str)))))
+          (val-sym (gensym)))
+      `(begin
+         (define ,name #f)
+         (let ((,val-sym ,val))
+           (set! ,name ,val-sym)
+           (set! %parameters (cons (cons ',param ,val-sym)
+                                   %parameters)))))))
+(define (set-parameter! name val)
+  (define (symbol-append . args)
+    (string->symbol (apply string-append (map symbol->string args))))
+  (or (assq name %parameters)
+      (error "Unknown parameter" name))
+  (module-set! (current-module) (symbol-append '* name '*) val))
+
+(define (parse-parameter-arguments args)
+  (define (usage)
+    (format #t "Usage: ~a ARG1...\n\n" "network-clock.scm")
+    (for-each
+     (lambda (pair)
+       (format #t "\t--~a=VAL \t(default: ~a)\n" (car pair) (cdr pair)))
+     %parameters))
+  (define (unknown-arg arg)
+    (with-output-to-port (current-error-port)
+      (lambda ()
+        (format #t "\nUnknown argument: ~a\n\n" arg)
+        (usage)
+        (quit))))
+  (define (parse-arguments args)
+    (let lp ((in args) (out '()))
+      (cond
+       ((null? in)
+        (reverse! out))
+       ((not (string=? (substring (car in) 0 2) "--"))
+        (unknown-arg (car in)))
+       (else
+        (let ((divider (or (string-index (car in) #\=)
+                           (unknown-arg (car in)))))
+          (or (> divider 2) (unknown-arg (car in)))
+          (let ((param (string->symbol (substring (car in) 2 divider)))
+                (val (with-input-from-string (substring (car in) (1+ divider))
+                       read)))
+            (lp (cdr in) (acons param val out))))))))
+  (for-each
+   (lambda (pair)
+     (or (false-if-exception
+          (set-parameter! (car pair) (cdr pair)))
+         (unknown-arg (format #f "--~a=~a" (car pair) (cdr pair)))))
+   (parse-arguments args)))