|
From: Martin R. <ru...@us...> - 2004-08-07 21:26:19
|
Update of /cvsroot/foo/foo/elkfoo/scm/kernel In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26305 Added Files: Makefile.am elkfoo.scm Log Message: initial checkin: now belongs to elkfoo.la. install paths dependent on --xxxable-elk-integration option --- NEW FILE: elkfoo.scm --- ;;; -*-Scheme-*- ;;; ;;; The Scheme layer of the elkfoo extension. (require 'elkfoo.la) ;;; ;;; time-orig ;;; (unless (bound? '*time-orig*) (define *time-orig* seconds) (define seconds *time-orig*)) ;;; ;;; bpf ;;; (define bpf? foo:bpf?) (define make-bpf foo:make-bpf) (define bpf-offset foo:bpf-offset) (define bpf-length foo:bpf-length) (define bpf-reversed? foo:bpf-reversed?) (define bpf-type foo:bpf-type) (define bpf-context foo:bpf-context) (define bpf-pointer foo:bpf-pointer) ;; (define bpf-region foo:bpf-region) ;; (define bpf-reverse foo:bpf-reverse) ;;; ;;; context ;;; (define context? foo:context?) (define make-context foo:make-context) (define debug-context foo:debug-context) (define kill-context foo:kill-context) (define kill-all-contexts foo:kill-all-contexts) (define context-channels foo:context-channels) (define context-locked? foo:context-locked?) (define (current-context) (if (not foo:current-context) (error 'current-context "there is no current context") foo:current-context)) (define (with-context context thunk) (fluid-let ((foo:current-context context)) (thunk))) (define-macro (context channels . expressions) `(if (not (integer? ,channels)) (error 'context "wrong argument type ~s (expected integer)" (type ,channels)) (with-context (make-context ,channels) (lambda () ,@expressions (current-context))))) (define write-context foo:write-context) (define read-context foo:read-context) (define copy-context foo:copy-context) (define context-interval foo:context-interval) ;;; ;;; defaults ;;; (define foo-default-taps foo:default-taps) (define set-foo-default-taps! foo:set-default-taps!) (define foo-default-srate foo:default-srate) (define set-foo-default-srate! foo:set-default-srate!) (define foo-default-bsize foo:default-bsize) (define set-foo-default-bsize! foo:set-default-bsize!) (define foo-default-soundfile-format 'short) (define foo-default-soundfile-filetype 'aiff) (define foo-default-soundfile-extension ".aiff") (define foo-default-play-command "sndfile-play") (define foo-default-edit-command "snd") ;;; ;;; foofun ;;; (define shelfing-coefs foo:shelfing-coefs) ;;; ;;; module ;;; (define module? foo:module?) (define make-module foo:make-module) (define module-type foo:module-type) (define module-context foo:module-context) (define module-pointer foo:module-pointer) ;;; ;;; modules ;;; (define add~ foo:make-add) (define bln~ foo:make-bln) (define c2pf~ foo:make-c2pf) (define c2p2zf~ foo:make-c2p2zf) (define cbiquad~ foo:make-cbiquad) (define ~ foo:make-constant) (define diff~ foo:make-diff) (define dirac~ foo:make-dirac) (define div~ foo:make-div) (define expon~ foo:make-expon) (define fof~ foo:make-fof) (define fve~ foo:make-fve) (define gate~ foo:make-gate) (define integ~ foo:make-integ) (define line~ foo:make-line) (define lookup-snd~ foo:make-lookup-snd) (define mul~ foo:make-mul) (define neg~ foo:make-neg) (define noise~ foo:make-noise) (define sine~ foo:make-sine) (define osc~ foo:make-osc) (define output~ foo:make-output) (define play~ foo:make-play) (define read-bpf~ foo:make-read-bpf) (define read-snd~ foo:make-read-snd) (define sqrt~ foo:make-sqrt) (define reverb~ foo:make-reverb) (define reverb8~ foo:make-reverb8) (define revout~ foo:make-revout) (define sub~ foo:make-sub) (define transp-bpf~ foo:make-transp-bpf) (define transp-snd~ foo:make-transp-snd) (define v2pf~ foo:make-v2pf) (define (print~ s . commentary) (tell (foo:context-pointer (current-context)) 'invalidatePrint) (if (not (null? commentary)) (format #t "~a:~%" (car commentary))) (tell (foo:module-pointer (signal-module s)) 'print) s) ;;; ;;; math modules ;;; (define abs~ foo:make-abs) (define exp~ foo:make-exp) (define log~ foo:make-log) (define log10~ foo:make-log10) (define sqrt~ foo:make-sqrt) (define pow~ foo:make-pow) (define min~ foo:make-min) (define max~ foo:make-max) ;;; ;;; signal ;;; (define signal? foo:signal?) (define signal foo:signal) (define signal-length foo:signal-length) (define signal-ref foo:signal-ref) (define signal->list foo:signal->list) (define signal-terminal? foo:signal-terminal?) (define signal-mono? foo:signal-mono?) (define signal-constant? foo:signal-constant?) (define signal-constant-value foo:signal-constant-value) (define signal-module foo:signal-module) (define signal-make-terminal foo:signal-make-terminal) ;;; ;;; snd ;;; (define snd? foo:snd?) (define open-snd foo:open-snd) (define snd-name foo:snd-name) (define snd-format foo:snd-format) (define snd-channels foo:snd-channels) (define snd-channel foo:snd-channel) (define snd-srate foo:snd-srate) (define snd-offset foo:snd-offset) (define snd-length foo:snd-length) (define snd-reversed? foo:snd-reversed?) (define snd-type foo:snd-type) (define snd-context foo:snd-context) (define snd-pointer foo:snd-pointer) (define snd-segments foo:snd-segments) (define snd-region foo:snd-region) (define snd-reverse foo:snd-reverse) (define snd-extract foo:snd-extract) (define snd-minimum foo:snd-minimum) (define snd-maximum foo:snd-maximum) (define snd-absolute-maximum foo:snd-absolute-maximum) (define snd-filetype foo:snd-filetype) (define (snd-info s) (format #t "name : ~a~%" (snd-name s)) (format #t "format : ~a~%" (snd-format s)) (format #t "srate : ~a~%" (snd-srate s)) (format #t "filetype : ~a~%" (snd-filetype s)) (if (> (snd-channels s) 1) (format #t "channels : ~a~%" (snd-channels s)) (format #t "channel : ~a~%" (snd-channel s))) (if (not (= 0 (snd-offset s))) (format #t "offset : ~a~%" (snd-offset s))) (format #t "length : ~a~%" (snd-length s))) (define (number-of-open-soundfiles) (display "FIXME: this function is not yet implemented")) ;; (tell 'FileHandle 'descriptorCount)) ;;; ;;; soundfile ;;; (define soundfile-format foo:soundfile-format) (define soundfile-channels foo:soundfile-channels) (define soundfile-srate foo:soundfile-srate) (define soundfile-length foo:soundfile-length) (define soundfile-filetype foo:soundfile-filetype) (define soundfile-play foo:soundfile-play) (define (make-soundfile name format channels samplingrate . filetype) (set! name (tilde-expand name)) (if (null? filetype) (set! filetype foo-default-soundfile-filetype) (set! filetype (car filetype))) (foo:make-soundfile name format channels samplingrate filetype)) (define (create-soundfile name format channels samplingrate . filetype) (set! name (tilde-expand name)) (if (file-exists? name) (system (string-append "rm -rf " name))) (if (null? filetype) (set! filetype foo-default-soundfile-filetype) (set! filetype (car filetype))) (foo:make-soundfile name format channels samplingrate filetype)) ;;; ;;; system ;;; (define (foo:test-file-dir) (let ((dir (getenv "SFDIR"))) (if dir dir (string-append "/tmp/" (getenv "USER"))))) (define (foo:test-file-name) (string-append (foo:test-file-dir) "/foo" (number->string (getpid)) foo-default-soundfile-extension)) (define (foo:cleanup) (let ((test-file (foo:test-file-name))) (if (file-exists? test-file) (begin ;(format #t "removing ~a~%" test-file) (system (string-append "rm " test-file)))))) (define (quit) (foo:cleanup) (exit)) (define test-file-dir foo:test-file-dir) (define test-file-name foo:test-file-name) (define (foo:string-index aString aCharacter) (let ((len (string-length aString))) (define (loop n) (if (>= n len) #f (if (eq? (string-ref aString n) aCharacter) n (loop (1+ n))))) (loop 0))) (define (foo:string-rindex aString aCharacter) (let ((len (string-length aString))) (define (loop n) (if (< n 0) #f (if (eq? (string-ref aString n) aCharacter) n (loop (1- n))))) (loop (1- len)))) (define (foo:synthesize channels duration srate filename fileformat filetype thunk) (let ((c (make-context channels)) (d (substring filename 0 (foo:string-rindex filename #\/)))) (if (not (file-exists? d)) (system (string-append "mkdir -p " d))) (if (file-exists? filename) (system (string-append "rm " filename))) (make-soundfile filename fileformat channels srate filetype) (with-context c thunk) (let ((start 0) (finish 0) (done 0)) (define (pf filename n) (let ((s (number->string filename))) (substring s 0 (min (string-length s) n)))) (set! start (seconds)) (set! done (run-task (make-task 0 0 filename c 'punch srate) duration)) (set! finish (seconds)) (format #t "len: ~as, tim: ~as, rtf: ~a, sr: ~aHz~%fil: ~a, fmt: ~a, typ: ~a" (pf done 7) (pf (- finish start) 7) (pf (/ (- finish start) done) 7) (pf srate 7) filename fileformat filetype))) #v) (define-macro (syn c d . e) `(foo:synthesize ,c ,d (foo-default-srate) (foo:test-file-name) foo-default-soundfile-format foo-default-soundfile-filetype (lambda () ,@e))) (define-macro (synt c d s n f t . e) `(foo:synthesize ,c ,d ,s ,n ,f ,t (lambda () ,@e))) (define (play . name) (define (helper args) (if (null? args) '() (cons " " (cons (if (string? (car args)) (car args) (symbol->string (car args))) (helper (cdr args)))))) (system (apply string-append (cons (string-append foo-default-play-command " ") (if (null? name) (list (foo:test-file-name)) (helper name)))))) (define (save file) (system (string-append "cp " (foo:test-file-name) " " file))) (define (edit . name) (define (helper args) (if (null? args) "" (string-append " " (if (string? (car args)) (car args) (symbol->string (car args))) (helper (cdr args))))) (system (string-append foo-default-edit-command " " (if (null? name) (foo:test-file-name) (helper name)) " &"))) ;;(define (edit) ;; (system (string-append "open " (foo:test-file-name)))) ;;; ;;; task ;;; (define task? foo:task?) (define make-task foo:make-task) (define run-task foo:run-task) ;;; ;;; time ;;; (define (current-time) (foo:context-time (current-context))) (define (with-time offset thunk) (if (not (number? offset)) (error 'with-time "wrong argument type ~a (expected number)" (type offset))) (if (not (procedure? thunk)) (error 'with-time "wrong argument type ~a (expected procedure)" (type thunk))) (let ((context (current-context))) (dynamic-wind (lambda () (foo:context-push-time-frame context offset)) thunk (lambda () (foo:context-pop-time-frame context))))) (define-macro (time offset . expressions) `(with-time ,offset (lambda () ,@expressions))) ;;; ;;; testing ;;; (define (sweep) (syn 2 3 (output~ 1 (sine~ (expon~ 20 20000 3))) (output~ 2 (sine~ (expon~ 20000 20 3)))) (play)) ;;; ;;; misc ;;; (define about foo:about) (define version foo:version) (provide 'elkfoo) --- NEW FILE: Makefile.am --- # foo/elkfoo/scm/kernel/Makefile.am # 2004 rumori # $Id: Makefile.am,v 1.1 2004/08/07 21:26:11 rumori Exp $ NULL = pkgdata_DATA = $(ELKFOO_KERNEL_FILES) # depending on elk-integration pkgdatadir = @ELK_SCM_DIR@ ELKFOO_KERNEL_FILES = \ elkfoo.scm \ $(NULL) |