File: fft-menu.scm

package info (click to toggle)
snd 26.1-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 44,044 kB
  • sloc: ansic: 291,996; lisp: 260,569; ruby: 71,134; sh: 3,293; fortran: 2,342; csh: 1,067; cpp: 294; makefile: 294; python: 87; xml: 27; javascript: 1
file content (132 lines) | stat: -rw-r--r-- 4,837 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(when (and (provided? 'xm)
	   (not (provided? 'snd-effects-utils.scm)))
  (load "effects-utils.scm"))

(define *e* *motif*)
(define update-label (*e* 'update-label))
(define change-label (*e* 'change-label))
(define make-effect-dialog (*e* 'make-effect-dialog))
(define add-sliders (*e* 'add-sliders))
(define activate-dialog (*e* 'activate-dialog))
(define select-file (*e* 'select-file))

(require snd-examp.scm)

(provide 'snd-fft-menu.scm)


(define fft-list ()) ; menu labels are updated to show current default settings

(define fft-menu (add-to-main-menu "FFT Edits" 
				   (lambda ()
				     (for-each (lambda (fft) (fft)) fft-list))))

;;; ------ FFT edit
;;;

(define fft-edit-low-frequency 100)
(define fft-edit-high-frequency 1000)
(define fft-edit-label "FFT notch filter")
(define fft-edit-dialog #f)
(define fft-edit-menu-label #f)

(define (cp-fft-edit)
  (fft-edit fft-edit-low-frequency fft-edit-high-frequency))

(if (not (or (provided? 'xg) 
	     (provided? 'xm)))
    (set! fft-edit-menu-label (add-to-menu fft-menu fft-edit-label cp-fft-edit))
    (begin
      (define (post-fft-edit-dialog)
        (unless fft-edit-dialog
	  ;; if fft-edit-dialog doesn't exist, create it
	  (let ((initial-fft-edit-low-frequency 100)
		(initial-fft-edit-high-frequency 1000)
		(sliders ()))
	    
	    (set! fft-edit-dialog
		  (make-effect-dialog fft-edit-label
				      (values (lambda (w context info) 
						(cp-fft-edit))
					      (lambda (w context info)
						(help-dialog "FFT notch filter"
								 "A simple example of FFT-based editing. It takes an FFT of the entire sound,\
 removes all energy below the low frequency and above the high frequency, then computes the inverse FFT."))
					      (lambda (w c i)
						(set! fft-edit-low-frequency initial-fft-edit-low-frequency)
						(set! fft-edit-high-frequency
						      initial-fft-edit-high-frequency)
						((*motif* 'XtSetValues) (car sliders) (list (*motif* 'XmNvalue) (floor fft-edit-low-frequency)))
						((*motif* 'XtSetValues) (cadr sliders) (list (*motif* 'XmNvalue) (floor fft-edit-high-frequency)))))))
	    (set! sliders
		  (add-sliders 
		   fft-edit-dialog
		   
		   (list (let ((low-func (lambda (w context info) (set! fft-edit-low-frequency ((*motif* '.value) info)))))
			   (list "low frequency" 20 initial-fft-edit-low-frequency 22050 low-func 1))
			 (let ((high-func (lambda (w context info) (set! fft-edit-high-frequency ((*motif* '.value) info)))))
			   (list "high frequency" 20 initial-fft-edit-high-frequency 22050 high-func 1)))))))
        (activate-dialog fft-edit-dialog))
      (set! fft-edit-menu-label (add-to-menu fft-menu "FFT notch filter" post-fft-edit-dialog))))

(set! fft-list (cons (lambda ()
		       (let ((new-label (format #f "FFT notch filter (~D ~D)" fft-edit-low-frequency fft-edit-high-frequency)))
			 (if fft-edit-menu-label (change-label fft-edit-menu-label new-label))
			 (set! fft-edit-label new-label)))
		     fft-list))



;;; ------ FFT squelch
;;;

(define fft-squelch-amount 0.0)
(define fft-squelch-label "FFT squelch")
(define fft-squelch-dialog #f)
(define fft-squelch-menu-label #f)

(define (cp-fft-squelch)
  (fft-squelch fft-squelch-amount))

(if (not (or (provided? 'xg) 
	     (provided? 'xm)))
    (set! fft-squelch-menu-label (add-to-menu fft-menu fft-squelch-label cp-fft-squelch))
    (begin
      
      (define (post-fft-squelch-dialog)
        (unless fft-squelch-dialog
	  ;; if fft-squelch-dialog doesn't exist, create it
	  (let ((initial-fft-squelch-amount 0.0)
		(sliders ()))
	    
	    (set! fft-squelch-dialog
		  (make-effect-dialog fft-squelch-label
				      (values (lambda (w context info)
						(cp-fft-squelch))
					      (lambda (w context info)
						(help-dialog "FFT squelch"
							     "Removes all energy below the squelch amount. This is sometimes useful for noise-reduction."))
					      (lambda (w c i)
						(set! fft-squelch-amount initial-fft-squelch-amount)
						((*motif* 'XtSetValues) (list-ref sliders 0)
						 (list (*motif* 'XmNvalue) (round (* fft-squelch-amount 100))))))))
	    (set! sliders
		  (add-sliders 
		   fft-squelch-dialog
		   (let ((squelch-func (lambda (w context info)
					 (set! fft-squelch-amount (/ ((*motif* '.value) info) 100)))))
		     (list (list "squelch amount" 0.0 initial-fft-squelch-amount 1.0 squelch-func 100)))))))
	
        (activate-dialog fft-squelch-dialog))
      (set! fft-squelch-menu-label (add-to-menu fft-menu "FFT squelch" post-fft-squelch-dialog))))


(set! fft-list (cons (lambda ()
		       (let ((new-label (format #f "FFT squelch (~1,2F)" fft-squelch-amount)))
			 (if fft-squelch-menu-label (change-label fft-squelch-menu-label new-label))
			 (set! fft-squelch-label new-label)))
		     fft-list))

(add-to-menu fft-menu #f #f)

(add-to-menu fft-menu "Squelch vowels" squelch-vowels)