[foo-cvs] foo/elkfoo/scm/kernel Makefile.am,NONE,1.1 elkfoo.scm,NONE,1.1

[Martin R. <ru...@us...>]

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)