Commit 595a8d63 authored by IOhannes m zmölnig's avatar IOhannes m zmölnig

Imported Upstream version 16.7

parent 3eb3c4d0
Snd change log
28-Jul: Snd 16.7.
14-Jun: Snd 16.6.
30-May: snd-lint.scm, symbol takes any number of args.
6-May: Snd 16.5.
......
Snd 16.6.
Snd 16.7.
added snd-lint.scm (Snd extensions for lint)
changed compute-string and compute-uniform-circular-string to vibrating-string, etc.
s7's symbol function now takes any number of string args
these are all concatenated to form the new symbol name
s7's make-vector no longer takes an optional fourth argument.
checked: gtk 3.21.3|4, sbcl 1.3.7.
checked: gtk 3.21.2, sbcl 1.3.6, Fedora 24
Thanks!: Joe Python, Tito Latini.
\ No newline at end of file
Thanks!: Carlos Carrasco
This diff is collapsed.
......@@ -1436,13 +1436,13 @@
(defanimal (green-toad beg dur amp)
;; rocky 31 1
;; (an experiment with wave-train in place of pulsed env)
(let* ((wave-len 256)
(pulse (let ((v (make-float-vector wave-len))
(let ((pulse (let* ((wave-len 256)
(v (make-float-vector wave-len))
(pulse-ampf (make-env '(0.000 0.000 0.063 0.312 0.277 0.937 0.405 1.000 0.617 0.696 0.929 0.146 2.000 0.000) :length wave-len)))
(do ((i 0 (+ i 1)))
((= i wave-len))
(set! (v i) (env pulse-ampf)))
v)))
(do ((i 0 (+ i 1)))
((= i wave-len))
(set! (v i) (env pulse-ampf)))
v)))
(let ((start (seconds->samples beg))
(stop (seconds->samples (+ beg dur)))
(ampf (make-env (list 0 0 .2 .9 .3 .7 .4 1 (max .5 (- dur .01)) 1 (max .51 dur) 0) :duration dur :scaler amp))
......@@ -2506,9 +2506,6 @@
(frq-envs (make-vector 10 #f))
(gen1 (make-oscil))
(gen2 (make-oscil))
(peep 0)
(peep-dur 0)
(peep-start 0)
(durs (let ((v (make-vector 10 0.0)))
(do ((i 0 (+ i 1)))
((= i 10))
......@@ -2545,26 +2542,26 @@
:scaler (hz->radians (- (high-frqs i) (low-frqs i)))
:offset (hz->radians (low-frqs i))
:duration (durs i)))))
(set! peep-dur (seconds->samples (durs 0)))
(set! peep-start (+ start (seconds->samples (begs 0))))
(call-with-exit
(lambda (done)
(do ((i peep-start peep-start))
((>= i stop))
(let ((fe (frq-envs peep))
(ae (amp-envs peep))
(reset-stop (min stop (+ i peep-dur))))
(do ((k i (+ k 1)))
((= k reset-stop))
(let ((frq (+ (env fe) (rand-interp rnd))))
(outa k (* (env ae)
(oscil gen1 frq
(* .03 (oscil gen2 (* 2.0 frq)))))))))
(set! peep (+ peep 1))
(if (>= peep 10) (done))
(set! peep-start (+ start (seconds->samples (begs peep))))
(set! peep-dur (seconds->samples (durs peep)))))))))
(let ((peep 0)
(peep-dur (seconds->samples (durs 0)))
(peep-start (+ start (seconds->samples (begs 0)))))
(do ((i peep-start peep-start))
((>= i stop))
(let ((fe (frq-envs peep))
(ae (amp-envs peep))
(reset-stop (min stop (+ i peep-dur))))
(do ((k i (+ k 1)))
((= k reset-stop))
(let ((frq (+ (env fe) (rand-interp rnd))))
(outa k (* (env ae)
(oscil gen1 frq
(* .03 (oscil gen2 (* 2.0 frq)))))))))
(set! peep (+ peep 1))
(if (>= peep 10) (done))
(set! peep-start (+ start (seconds->samples (begs peep))))
(set! peep-dur (seconds->samples (durs peep))))))))))
;; (with-sound (:play #t) (fox-sparrow 0 3 .25))
......@@ -2931,10 +2928,10 @@
;; --------
(savannah-1 beg (* amp .21))
(savannah-1 (+ beg .35) (* amp .45))
(savannah-1 (+ beg .35 .28) (* amp .51))
(savannah-1 (+ beg .35 .28 .24) (* amp .64))
(savannah-1 (+ beg .35 .28 .24 .26) amp)
(savannah-1 (+ beg .35 .28 .24 .26 .17) amp)
(savannah-1 (+ beg .63) (* amp .51))
(savannah-1 (+ beg .87) (* amp .64))
(savannah-1 (+ beg 1.13) amp)
(savannah-1 (+ beg 1.3) amp)
(savannah-4 (+ .97 beg) (* amp .21))
......@@ -8925,31 +8922,31 @@
(polywave gen1 (+ (env frqf1)
(* (env vibf) (oscil vib))))))))))
(let ((main-ampf '(0.000 0.000 0.321 0.215 0.679 0.569 0.826 0.992 0.874 1.000 1.000 0.000))
(main-frqf '(0.000 0.228 0.795 0.210 0.816 0.235 0.827 0.199 0.846 0.217 0.882 0.181 1.000 0.206))
(other-ampf '(0.000 0.000 0.139 0.356 0.541 0.652 0.766 0.838 0.834 1.000 0.932 0.257 1.000 0.000)))
(black-throated-blue-warbler-1 beg1 .053 (* .2 amp1)
'(0.000 0.000 0.017 0.079 0.082 0.142 0.142 0.122 0.199 0.213 0.237 0.150 0.291 0.201
0.317 0.102 0.352 0.197 0.395 0.248 0.415 0.201 0.435 0.335 0.468 0.323 0.488 0.429
0.514 0.350 0.581 0.870 0.616 0.583 0.678 0.697 0.709 0.618 0.752 1.000 0.801 0.350
0.815 0.295 0.838 0.500 0.895 0.197 0.911 0.366 0.929 0.220 0.955 0.248 0.972 0.134
0.987 0.197 1.000 0.000)
22000
'(0.000 0.222 0.038 0.204 0.099 0.208 0.134 0.197 0.205 0.208 0.244 0.186 0.288 0.211
0.336 0.194 0.382 0.201 0.421 0.190 0.475 0.215 0.511 0.190 0.563 0.208 0.613 0.190
0.656 0.208 0.695 0.194 0.755 0.194 1.000 0.133)
10)
(black-throated-blue-warbler-1 (+ beg1 .156) .11 (* .4 amp1) main-ampf 20000 main-frqf 100)
(black-throated-blue-warbler-1 (+ beg1 .33) .135 (* .6 amp1) main-ampf 21000 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .33) .135 (* .6 amp1) main-ampf 22000 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .51) .175 amp1 other-ampf 22400.0 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .72) .152 amp1 other-ampf 23000.0 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .94) .23 (* .5 amp1)
'(0.000 0.000 0.022 0.300 0.067 0.788 0.191 0.919 0.331 0.958 0.581 1.000 0.805 0.946 0.929 0.773 1.000 0.000)
5400.0 '(0 1 1 1) 400)))
(black-throated-blue-warbler-1 beg1 .053 (* .2 amp1)
'(0.000 0.000 0.017 0.079 0.082 0.142 0.142 0.122 0.199 0.213 0.237 0.150 0.291 0.201
0.317 0.102 0.352 0.197 0.395 0.248 0.415 0.201 0.435 0.335 0.468 0.323 0.488 0.429
0.514 0.350 0.581 0.870 0.616 0.583 0.678 0.697 0.709 0.618 0.752 1.000 0.801 0.350
0.815 0.295 0.838 0.500 0.895 0.197 0.911 0.366 0.929 0.220 0.955 0.248 0.972 0.134
0.987 0.197 1.000 0.000)
22000
'(0.000 0.222 0.038 0.204 0.099 0.208 0.134 0.197 0.205 0.208 0.244 0.186 0.288 0.211
0.336 0.194 0.382 0.201 0.421 0.190 0.475 0.215 0.511 0.190 0.563 0.208 0.613 0.190
0.656 0.208 0.695 0.194 0.755 0.194 1.000 0.133)
10)
(let ((main-frqf '(0.000 0.228 0.795 0.210 0.816 0.235 0.827 0.199 0.846 0.217 0.882 0.181 1.000 0.206)))
(let ((main-ampf '(0.000 0.000 0.321 0.215 0.679 0.569 0.826 0.992 0.874 1.000 1.000 0.000)))
(black-throated-blue-warbler-1 (+ beg1 .156) .11 (* .4 amp1) main-ampf 20000 main-frqf 100)
(black-throated-blue-warbler-1 (+ beg1 .33) .135 (* .6 amp1) main-ampf 21000 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .33) .135 (* .6 amp1) main-ampf 22000 main-frqf 200))
(let ((other-ampf '(0.000 0.000 0.139 0.356 0.541 0.652 0.766 0.838 0.834 1.000 0.932 0.257 1.000 0.000)))
(black-throated-blue-warbler-1 (+ beg1 .51) .175 amp1 other-ampf 22400.0 main-frqf 200)
(black-throated-blue-warbler-1 (+ beg1 .72) .152 amp1 other-ampf 23000.0 main-frqf 200)))
(black-throated-blue-warbler-1 (+ beg1 .94) .23 (* .5 amp1)
'(0.000 0.000 0.022 0.300 0.067 0.788 0.191 0.919 0.331 0.958 0.581 1.000 0.805 0.946 0.929 0.773 1.000 0.000)
5400.0 '(0 1 1 1) 400))
;; (with-sound (:play #t) (black-throated-blue-warbler 0 .5))
......@@ -10689,7 +10686,7 @@
;;; ================ calling-all-animals ================
(define* (calling-all-frogs (beg 0.0) (spacing 0.0))
(plains-spadefoot (+ beg 0) 0.25) (set! beg (+ beg spacing))
(plains-spadefoot beg 0.25) (set! beg (+ beg spacing))
(barking-tree-frog (+ beg 1) 0.25) (set! beg (+ beg spacing))
(western-toad (+ beg 1.5) 2 0.25) (set! beg (+ beg spacing))
(southwestern-toad (+ beg 4) 2 0.25) (set! beg (+ beg spacing))
......@@ -10724,7 +10721,7 @@
(define* (calling-all-insects (beg 0.0) (spacing 0.0))
(mosquito (+ beg 0) 5 560 0.2) (set! beg (+ beg spacing))
(mosquito beg 5 560 0.2) (set! beg (+ beg spacing))
(mosquito (+ beg 1) 3 880 0.05) (set! beg (+ beg spacing))
(broad-winged-tree-cricket (+ beg 5.5) 2.0 0.2) (set! beg (+ beg spacing))
(long-spurred-meadow-katydid (+ beg 8) 0.5) (set! beg (+ beg spacing))
......@@ -10752,7 +10749,7 @@
(define* (calling-all-birds (beg 0.0) (spacing .25))
(ruffed-grouse (+ beg 0.0) 0.5) (set! beg (+ beg spacing))
(ruffed-grouse beg 0.5) (set! beg (+ beg spacing))
(eastern-wood-pewee-1 (+ beg 11.0) 0.25) (set! beg (+ beg spacing))
(eastern-wood-pewee-2 (+ beg 12.5) 0.25) (set! beg (+ beg spacing))
(field-sparrow (+ beg 14.0) 0.25) (set! beg (+ beg spacing))
......
......@@ -48,7 +48,7 @@
(if auto-saving
(begin
(for-each (lambda (snd)
(if (positive? (or (sound-property 'auto-save snd) 0))
(if (cond ((sound-property 'auto-save snd) => positive?) (else #f))
(let ((save-name (auto-save-temp-name snd)))
(status-report (string-append "auto-saving as " save-name "...") snd)
(in 3000 (lambda () (status-report "" snd)))
......
This diff is collapsed.
This diff is collapsed.
......@@ -127,17 +127,17 @@
(int_to_float32 (read-lint32)))
(define (float64_to_int32 flt)
(let* ((data (integer-decode-float flt))
(signif (car data))
(expon (cadr data))
(sign (caddr data)))
(if (= expon signif 0)
0
;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
;; this causes some round-off error
(logior (if (negative? sign) #x80000000 0)
(ash (+ expon 179) 23) ; 179 = (+ 52 127)
(logand (ash signif -29) #x7fffff)))))
(let ((data (integer-decode-float flt)))
(let ((signif (car data))
(expon (cadr data))
(sign (caddr data)))
(if (= expon signif 0)
0
;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
;; this causes some round-off error
(logior (if (negative? sign) #x80000000 0)
(ash (+ expon 179) 23) ; 179 = (+ 52 127)
(logand (ash signif -29) #x7fffff))))))
(define (write-bfloat32 flt)
(write-bint32 (float64_to_int32 flt)))
......@@ -164,15 +164,15 @@
(int_to_float64 (read-lint64)))
(define (float64_to_int64 flt)
(let* ((data (integer-decode-float flt))
(signif (car data))
(expon (cadr data))
(sign (caddr data)))
(if (= expon signif 0)
0
(logior (if (negative? sign) #x8000000000000000 0)
(ash (+ expon 1075) 52) ; 1075 = (+ 52 1023)
(logand signif #xfffffffffffff)))))
(let ((data (integer-decode-float flt)))
(let ((signif (car data))
(expon (cadr data))
(sign (caddr data)))
(if (= expon signif 0)
0
(logior (if (negative? sign) #x8000000000000000 0)
(ash (+ expon 1075) 52) ; 1075 = (+ 52 1023)
(logand signif #xfffffffffffff))))))
(define (write-bfloat64 flt)
(write-bint64 (float64_to_int64 flt)))
......@@ -186,8 +186,6 @@
(define (read-bfloat80->int)
(let ((exp 0)
(mant1 0)
(mant0 0)
(sign 0)
(buf (make-vector 10)))
(do ((i 0 (+ i 1)))
......@@ -196,14 +194,14 @@
(set! exp (logior (ash (buf 0) 8) (buf 1)))
(set! sign (if (not (= (logand exp #x8000) 0)) 1 0))
(set! exp (logand exp #x7FFF))
(set! mant1 (+ (ash (buf 2) 24) (ash (buf 3) 16) (ash (buf 4) 8) (buf 5)))
(set! mant0 (+ (ash (buf 6) 24) (ash (buf 7) 16) (ash (buf 8) 8) (buf 9)))
(if (= mant1 mant0 exp sign 0)
0
(round (* (if (= sign 1) -1 1)
(expt 2.0 (- exp 16383.0))
(+ (* (expt 2.0 -31.0) mant1)
(* (expt 2.0 -63.0) mant0)))))))
(let ((mant1 (+ (ash (buf 2) 24) (ash (buf 3) 16) (ash (buf 4) 8) (buf 5)))
(mant0 (+ (ash (buf 6) 24) (ash (buf 7) 16) (ash (buf 8) 8) (buf 9))))
(if (= mant1 mant0 exp sign 0)
0
(round (* (if (= sign 1) -1 1)
(expt 2.0 (- exp 16383.0))
(+ (* (expt 2.0 -31.0) mant1)
(* (expt 2.0 -63.0) mant0))))))))
(define (write-int->bfloat80 val)
(let ((exp 0)
......@@ -254,17 +252,17 @@
(with-output-to-file file
(lambda ()
(let* ((comlen (length comment))
(data-location (+ 24 (* 4 (floor (+ 1 (/ comlen 4))))))
(curloc 24))
(data-location (+ 24 (* 4 (floor (+ 1 (/ comlen 4)))))))
(write-chars ".snd")
(for-each write-bint32 (vector data-location data-size sample-type srate chns))
(if (> comlen 0)
(begin
(io-write-string comment)
(set! curloc (+ curloc comlen 1)))) ; io-write-string adds a trailing 0
(do ((i curloc (+ i 1)))
((>= i data-location))
(write-byte 0))))))
(let ((curloc 24))
(if (> comlen 0)
(begin
(io-write-string comment)
(set! curloc (+ curloc comlen 1)))) ; io-write-string adds a trailing 0
(do ((i curloc (+ i 1)))
((>= i data-location))
(write-byte 0)))))))
(define (read-aif-header file)
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -703,8 +703,8 @@
(let ((start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(os (make-oscil freq)))
(let* ((sr2 (make-src :srate speed :input (lambda (dir) (oscil os))))
(sr1 (make-src :srate speed :input (lambda (dir) (src sr2)))))
(let ((sr1 (let ((sr2 (make-src :srate speed :input (lambda (dir) (oscil os)))))
(make-src :srate speed :input (lambda (dir) (src sr2))))))
(do ((i start (+ i 1))) ((= i end))
(outa i (* amp (src sr1)))))))
......@@ -885,16 +885,17 @@
(let ((os (make-oscil freq))
(start (seconds->samples beg))
(end (seconds->samples (+ beg dur)))
(arr (make-float-vector 100))
(ctr 0)
(dir 1))
(arr (make-float-vector 100)))
(do ((i 0 (+ i 1)))
((= i 100))
(set! (arr i) (* amp (- (* i .01) 0.5))))
(array->file "testx.data" arr 100 22050 1)
(fill! arr 0.0)
(file->array "testx.data" 0 0 100 arr)
(do ((i start (+ i 1))) ((= i end))
(do ((ctr 0)
(dir 1)
(i start (+ i 1)))
((= i end))
(outa i (* (arr ctr) (oscil os)))
(set! ctr (+ ctr dir))
(if (>= ctr 99) (set! dir -1)
......@@ -1467,11 +1468,11 @@
(if (or (null? loop-data)
(<= (cadr loop-data) (car loop-data)))
(error 'no-loop-positions)
(let* ((loop-start (car loop-data))
(loop-length (- (+ (cadr loop-data) 1) loop-start))
(sound-section (float-vector-scale! (file->array sound 0 loop-start loop-length (make-float-vector loop-length)) amp))
(tbl (make-table-lookup :frequency (/ (* freq (srate sound)) loop-length)
:wave sound-section)))
(let ((tbl (let* ((loop-start (car loop-data))
(loop-length (- (+ (cadr loop-data) 1) loop-start))
(sound-section (float-vector-scale! (file->array sound 0 loop-start loop-length (make-float-vector loop-length)) amp)))
(make-table-lookup :frequency (/ (* freq (srate sound)) loop-length)
:wave sound-section))))
;; "freq" here is how fast we read (transpose) the sound -- 1.0 returns the original
(do ((i beg (+ i 1)))
((= i end))
......@@ -1578,14 +1579,14 @@
(float-vector 0.0 (hz->radians frequency) (* 1.0 n)))
(define (sndclmdoc-sum-of-odd-sines gen fm)
(let* ((a2 (* (gen 0) 0.5))
(n (gen 2))
(den (* n (sin a2)))
(result (if (< (abs den) 1.0e-9)
0.0
(/ (* (sin (* n a2))
(sin (* (+ 1 n) a2)))
den))))
(let ((result (let* ((a2 (* (gen 0) 0.5))
(n (gen 2))
(den (* n (sin a2))))
(if (< (abs den) 1.0e-9)
0.0
(/ (* (sin (* n a2))
(sin (* (+ 1 n) a2)))
den)))))
(set! (gen 0) (+ (gen 0) (gen 1) fm))
result))
......@@ -2018,9 +2019,9 @@
(lambda (gen input)
(let-set! gen 'input input)
(with-let gen
(let* ((modphase (* ratio phase))
(result (* (exp (* r2 (cos modphase)))
(sin (+ phase (* r1 (sin modphase)))))))
(let ((result (let ((modphase (* ratio phase)))
(* (exp (* r2 (cos modphase)))
(sin (+ phase (* r1 (sin modphase))))))))
(set! phase (+ phase input freq))
result)))))
......@@ -2029,9 +2030,9 @@
(lambda (gen input)
(let-set! gen 'input input)
(with-let gen
(let* ((modphase (* ratio phase))
(result (* (exp (- (* r1 (cos modphase)) r3))
(sin (+ phase (* r2 (sin modphase)))))))
(let ((result (let ((modphase (* ratio phase)))
(* (exp (- (* r1 (cos modphase)) r3))
(sin (+ phase (* r2 (sin modphase))))))))
(set! phase (+ phase input freq))
result)))))
......@@ -2128,11 +2129,11 @@
(sndclmdoc-tritri 0 1 1000.0 0.5 0.1 0.01) ; sci-fi laser gun
(sndclmdoc-tritri 1 1 4000.0 0.7 0.1 0.01)) ; a sparrow?
(with-sound (:srate 22050) (sndclmdoc-shift-pitch 0 3 "oboe.snd" 1108.0)) ; 1.7
(let* ((sound "oboe.snd") ; 1.8
(mx (maxamp sound))
(dur (mus-sound-duration sound)))
(with-sound (:scaled-to mx :srate 22050)
(sndclmdoc-repitch 0 dur sound 554 1000)))
(let ((sound "oboe.snd")) ; 1.8
(let ((mx (maxamp sound))
(dur (mus-sound-duration sound)))
(with-sound (:scaled-to mx :srate 22050)
(sndclmdoc-repitch 0 dur sound 554 1000))))
(with-sound () (sndclmdoc-fofins 0 1 270 .2 .001 730 .6 1090 .3 2440 .1)) ; "Ahh"
(with-sound () ; one of JC's favorite demos
(sndclmdoc-fofins 0 4 270 .2 0.005 730 .6 1090 .3 2440 .1 '(0 0 40 0 75 .2 100 1)
......
......@@ -5149,7 +5149,7 @@ static mus_float_t *list_to_partials(Xen harms, int *npartials, int *error_code)
for (i = 0, lst = Xen_copy_arg(harms); i < listlen; i += 2, lst = Xen_cddr(lst))
{
if ((!(Xen_is_number(Xen_car(lst)))) ||
if ((!(Xen_is_integer(Xen_car(lst)))) ||
(!(Xen_is_number(Xen_cadr(lst)))))
{
(*error_code) = NON_NUMBER_IN_LIST;
......@@ -12766,7 +12766,7 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_mus_file_name, g_mus_file_name_w, 1, 0, 0, H_mus_file_name, pl_sc);
Xen_define_typed_procedure(S_mus_reset, g_mus_reset_w, 1, 0, 0, H_mus_reset, pl_tc);
Xen_define_typed_procedure(S_mus_copy, g_mus_copy_w, 1, 0, 0, H_mus_copy, pl_cc);
Xen_define_procedure(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run);
Xen_define_typed_procedure(S_mus_run, g_mus_run_w, 1, 2, 0, H_mus_run, pl_dcr);
Xen_define_typed_procedure(S_mus_name, g_mus_name_w, 1, 0, 0, H_mus_name, pl_sc);
Xen_define_typed_dilambda(S_mus_phase, g_mus_phase_w, H_mus_phase, S_set S_mus_phase, g_mus_set_phase_w, 1, 0, 2, 0, pl_dc, pl_dcr);
......@@ -12786,7 +12786,7 @@ static void mus_xen_init(void)
Xen_define_typed_procedure(S_is_oscil_bank, g_is_oscil_bank_w, 1, 0, 0, H_is_oscil_bank, pl_bt);
Xen_define_typed_procedure(S_oscil_bank, g_oscil_bank_w, 1, 0, 0, H_oscil_bank, pl_dc);
Xen_define_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply);
Xen_define_typed_procedure(S_mus_apply, g_mus_apply_w, 0, 0, 1, H_mus_apply, pl_dcr);
Xen_define_typed_procedure(S_make_delay, g_make_delay_w, 0, 0, 1, H_make_delay,
s7_make_circular_signature(s7, 1, 2, s7_make_symbol(s7, S_is_delay), t));
......
This diff is collapsed.
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for snd 16.6.
# Generated by GNU Autoconf 2.69 for snd 16.7.
#
# Report bugs to <bil@ccrma.stanford.edu>.
#
......@@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz'
PACKAGE_VERSION='16.6'
PACKAGE_STRING='snd 16.6'
PACKAGE_VERSION='16.7'
PACKAGE_STRING='snd 16.7'
PACKAGE_BUGREPORT='bil@ccrma.stanford.edu'
PACKAGE_URL=''
......@@ -1310,7 +1310,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
\`configure' configures snd 16.6 to adapt to many kinds of systems.
\`configure' configures snd 16.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
......@@ -1380,7 +1380,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of snd 16.6:";;
short | recursive ) echo "Configuration of snd 16.7:";;
esac
cat <<\_ACEOF
......@@ -1496,7 +1496,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
snd configure 16.6
snd configure 16.7
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
......@@ -1957,7 +1957,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by snd $as_me 16.6, which was
It was created by snd $as_me 16.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
......@@ -3304,7 +3304,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
VERSION=16.6
VERSION=16.7
#--------------------------------------------------------------------------------
# configuration options
......@@ -6691,7 +6691,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by snd $as_me 16.6, which was
This file was extended by snd $as_me 16.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
......@@ -6753,7 +6753,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
snd config.status 16.6
snd config.status 16.7
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
......
......@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
AC_INIT(snd, 16.6, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz)
AC_INIT(snd, 16.7, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-16.tar.gz)
AC_CONFIG_SRCDIR(snd.c)
AC_CANONICAL_HOST # needed by case $host below
......@@ -24,7 +24,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
VERSION=16.6
VERSION=16.7
#--------------------------------------------------------------------------------
# configuration options
......
This diff is collapsed.
......@@ -64,52 +64,52 @@
(set! (foreground-color snd chn) red)
(draw-lines (channel-property 'rms-lines snd chn) snd chn time-graph cr)
(set! (foreground-color snd chn) old-color))
(let* ((xdata (pack-x-info axinf))
(ydata (pack-y-info axinf))
(start (max 0 (- left rms-size)))
(reader (make-sampler start snd chn))
(rms (make-moving-rms rms-size))
(x0 0)
(y0 0)
(line-ctr 2)
(lines (make-vector (* 2 (- (+ (axinf 12) 1) (axinf 10))) 0)))
(dynamic-wind
(lambda ()
(set! (foreground-color snd chn) red))
(lambda ()
(if (< start left) ; check previous samples to get first rms value
(do ((i start (+ 1 i)))
((= i left))
(moving-rms rms (reader))))
(let ((first-sample (next-sample reader)))
(set! x0 (grf-it (* left sr) xdata))
(set! y0 (grf-it first-sample ydata)))
(set! (lines 0) x0) ; first graph point
(set! (lines 1) y0)
(do ((i (+ left 1) (+ 1 i))) ; loop through all samples calling moving-rms
((= i right))
(let ((x1 (grf-it (* i sr) xdata))
(y (moving-rms rms (next-sample reader))))
(if (> x1 x0) ; very often many samples are represented by one pixel
(let ((y1 (grf-it y ydata)))
(set! (lines line-ctr) x1)
(set! (lines (+ 1 line-ctr)) y1)
(set! line-ctr (+ line-ctr 2))
(set! x0 x1)
(set! y0 y1))))) ; else should we do "max" here? or draw a vertical line from min to max?
(if (< line-ctr (length lines))
(do ((j line-ctr (+ j 2))) ; off-by-one in vector size calc -- need to pad so we don't get a bogus line to (0, 0)
((>= j (length lines)))
(set! (lines j) x0)
(set! (lines (+ j 1)) y0)))
(draw-lines lines snd chn time-graph cr)
(set! (channel-property 'rms-lines snd chn) lines) ; save current data for possible redisplay
(set! (channel-property 'rms-axis-info snd chn) axinf))
(lambda ()
(set! (foreground-color snd chn) old-color)))))
(let ((start (max 0 (- left rms-size))))
(let ((xdata (pack-x-info axinf))
(ydata (pack-y-info axinf))
(reader (make-sampler start snd chn))
(rms (make-moving-rms rms-size))
(x0 0)
(y0 0)
(line-ctr 2)
(lines (make-vector (* 2 (- (+ (axinf 12) 1) (axinf 10))) 0)))
(dynamic-wind
(lambda ()
(set! (foreground-color snd chn) red))