Update of /cvsroot/foo/foo/elkfoo/examples/scripts
In directory sc8-pr-cvs17:/tmp/cvs-serv31285
Modified Files:
fsdiary.foo
Log Message:
first bugfixes
Index: fsdiary.foo
===================================================================
RCS file: /cvsroot/foo/foo/elkfoo/examples/scripts/fsdiary.foo,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** fsdiary.foo 30 Sep 2007 12:31:38 -0000 1.1
--- fsdiary.foo 30 Sep 2007 13:10:20 -0000 1.2
***************
*** 45,51 ****
(curoutpos) ;; current outfile position
(outinc) ;; outputfile increment
! (normbpf)
! (startbpf)
! (endbpf)
(overalldur)
(c) ; context
--- 45,51 ----
(curoutpos) ;; current outfile position
(outinc) ;; outputfile increment
! (normenv~)
! (startenv~)
! (endenv~)
(overalldur)
(c) ; context
***************
*** 123,135 ****
;; period
(set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
;; duration
(if (cmdline:option-given? (foo:script-args) option-list "--duration")
! (set! duration (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--duration"))))
(set! duration period))
;; xfadelength
(if (cmdline:option-given? (foo:script-args) option-list "--xfadelength")
! (set! xfadelength (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--xfadelength"))))
(set! xfadelength 0))
--- 123,152 ----
;; period
(set! period (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--period"))))
+ (if (< period 0)
+ (begin
+ (display "negative period not allowed!")
+ (newline)
+ (exit)))
;; duration
(if (cmdline:option-given? (foo:script-args) option-list "--duration")
! (begin
! (set! duration (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--duration"))))
! (if (< duration 0)
! (begin
! (display "negative duration not allowed!")
! (newline)
! (exit))))
(set! duration period))
;; xfadelength
(if (cmdline:option-given? (foo:script-args) option-list "--xfadelength")
! (begin
! (set! xfadelength (string->number (car (cmdline:get-option-param (foo:script-args) option-list "--xfadelength"))))
! (if (< xfadelength 0)
! (begin
! (display "negative xfadelength not allowed!")
! (newline)
! (exit))))
(set! xfadelength 0))
***************
*** 171,190 ****
(set! c (context channels))
! ;; make bpfs
! (with-context c (lambda ()
! (set! normbpf (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))
! (set! startbpf (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))
! (set! endbpf (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1))))))
(letrec
;; write single slice per channels
! ((cat-slice (lambda (slice chan off bpf)
(if (> chan 0)
(begin
(if (>= (snd-channels slice) chan)
;; do the actual work per channel
! (output~ chan (time off (gate~ (mul~ (read-bpf~ bpf) (read-snd~ (snd-extract slice chan))) (snd-length slice)))))
! ;; (output~ chan (time off (gate~ (read-snd~ (snd-extract slice chan)) (snd-length slice))))
! (cat-slice slice (1- chan) off bpf)))))
;; write input file per slice
--- 188,212 ----
(set! c (context channels))
! ;; make envelope signals
! (if (= xfadelength 0)
! ;; make-bpf needs strictly ascending time values: FIXME!
! (with-context c (lambda ()
! (set! normenv~ (lambda () (~ 1)))
! (set! startenv~ (lambda () (~ 1)))
! (set! endenv~ (lambda () (~ 1)))))
! (with-context c (lambda ()
! (set! normenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list outinc 1) (list duration 0))))))
! (set! startenv~ (lambda () (read-bpf~ (make-bpf (list '(0 1) (list outinc 1) (list duration 0))))))
! (set! endenv~ (lambda () (read-bpf~ (make-bpf (list '(0 0) (list xfadelength 1) (list duration 1)))))))))
(letrec
;; write single slice per channels
! ((cat-slice (lambda (slice chan off env~)
(if (> chan 0)
(begin
(if (>= (snd-channels slice) chan)
;; do the actual work per channel
! (output~ chan (time off (gate~ (mul~ (env~) (read-snd~ (snd-extract slice chan))) (snd-length slice)))))
! (cat-slice slice (1- chan) off env~)))))
;; write input file per slice
***************
*** 196,211 ****
((= curoutpos 0)
(begin
! (cat-slice (snd-region snd curinpos duration) channels curoutpos startbpf)
(cat-slices file (+ curoutpos outinc) (+ curinpos period))))
;; last slice truncated
((>= (+ curinpos duration) (snd-length snd))
! (cat-slice (snd-region snd curinpos (- (snd-length snd) curinpos)) channels curoutpos endbpf))
;; last slice complete
((>= (+ curinpos period) (snd-length snd))
! (cat-slice (snd-region snd curinpos duration) channels curoutpos endbpf))
;; normal slice
(else
(begin
! (cat-slice (snd-region snd curinpos duration) channels curoutpos normbpf)
(cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))
--- 218,233 ----
((= curoutpos 0)
(begin
! (cat-slice (snd-region snd curinpos duration) channels curoutpos startenv~)
(cat-slices file (+ curoutpos outinc) (+ curinpos period))))
;; last slice truncated
((>= (+ curinpos duration) (snd-length snd))
! (cat-slice (snd-region snd curinpos (- (snd-length snd) curinpos)) channels curoutpos endenv~))
;; last slice complete
((>= (+ curinpos period) (snd-length snd))
! (cat-slice (snd-region snd curinpos duration) channels curoutpos endenv~))
;; normal slice
(else
(begin
! (cat-slice (snd-region snd curinpos duration) channels curoutpos normenv~)
(cat-slices file (+ curoutpos outinc) (+ curinpos period)))))))))
|
