X-Git-Url: http://git.kpe.io/?p=cluck.git;a=blobdiff_plain;f=dtmf.lisp;h=957281ce4f911ce3a853fd14a2157a9ca640f944;hp=ef282ac554d614b449009c1644a210c2cf733e19;hb=HEAD;hpb=24df75e86a93050a15a806dea45bd209cc3a37a2

diff --git a/dtmf.lisp b/dtmf.lisp
index ef282ac..4a2402a 100644
--- a/dtmf.lisp
+++ b/dtmf.lisp
@@ -3,12 +3,10 @@
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; Name:          dtmf.lisp
-;;;; Purpose:       Common Lisp DTML tone generator
+;;;; Purpose:       Common Lisp DTMF (dual tone) wave generator
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  June 2007
 ;;;;
-;;;; $Id: cluck.lisp 11571 2007-03-09 14:53:51Z kevin $
-;;;;
 ;;;; Copyright (c) 2007 Kevin M. Rosenberg
 ;;;;
 ;;;; Redistribution and use in source and binary forms, with or without
@@ -38,7 +36,7 @@
 
 (in-package #:cluck)
 
-(defconstant* +dtmf-tones+
+(defconstant +dtmf-tones+
   '(
     ;; keypad
     (1 . (1209 . 697))
@@ -58,10 +56,10 @@
     (\# . (1477 . 941))
     (D . (1633 . 941))
 
-    ;; event
-    (busy . (480 . 620))
-    (dial-tone . (350 . 440))
-    (ringback . (440 . 480))
+    ;; events
+    (busy . (620 . 480))
+    (dial-tone . (440 . 350))
+    (ringback . (480 . 440))
     ))
 
 (defun dtmf-ratios ()
@@ -79,8 +77,7 @@
 ;; A(low) / A(high) between 0.7 and 0.9
 
 (defun dtmf-waveform (key duration sample-freq
-                      &key (min -1d0) (max 1d0)
-                      (element-type 'double-float)
+                      &key (min -1d0) (max 1d0) (element-type 'double-float)
                       &aux dtmf-record)
   "Returns the DTMF waveform of a key code for duration seconds
 at a sample frequency of sample-freq. Waveform normalized to -1 to 1 output."
@@ -143,17 +140,30 @@ at a sample frequency of sample-freq. Waveform normalized to -1 to 1 output."
         (format os "~F~A~F~%" time delimiter (aref wave i))
         (incf time period)))))
 
+
+;;; Functions optionally defined if supporting packages have already
+;;; been loaded
+;;;
+;;; Functions requiring CL-WAV-SYNTH, used for it WAV file writing
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (find-package '#:cl-wav-synth)
+    (pushnew :kmr-cl-wav-synth cl:*features*)))
+
+#+:kmr-cl-wav-synth
 (defun write-dtmf-wav (file key duration &key (sample-freq 8000)
                        (n-bits-per-sample 8)
                        &aux wave)
   (setq wave (dtmf-waveform key duration sample-freq
                             :min (ecase n-bits-per-sample
-                                       (8 -128)
-                                       (16 -32768))
+                                   (8 0)
+                                   (16 -32768))
                             :max (ecase n-bits-per-sample
-                                       (8 127)
-                                       (16 32767))
-                            :element-type (list 'signed-byte n-bits-per-sample)))
+                                   (8 255)
+                                   (16 32767))
+                            :element-type (ecase n-bits-per-sample
+                                            (8 '(unsigned-byte 8))
+                                            (16  '(signed-byte 16)))))
   (unless wave (return-from write-dtmf-wav nil))
 
   (let ((sample (make-instance 'cl-wav-synth:sample
@@ -167,7 +177,18 @@ at a sample frequency of sample-freq. Waveform normalized to -1 to 1 output."
     (cl-wav-synth:write-sample file sample)
     sample))
 
-#|
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (find :kmr-cl-wav-synth cl:*features*)
+    (setq cl:*features* (delete :kmr-cl-wav-synth cl:*features*))))
+
+
+;;; Functions requiring CGN, a plotting package
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (find-package '#:cgn)
+    (pushnew :kmr-cgn cl:*features*)))
+
+#+:kmr-cgn
 (defun plot-dtmf (key duration sample-freq &aux wave)
   (setq wave (dtmf-waveform key duration sample-freq))
   (unless wave (return-from plot-dtmf nil))
@@ -190,4 +211,7 @@ at a sample frequency of sample-freq. Waveform normalized to -1 to 1 output."
       (cgn:set-range 'y -1 1)
       (cgn:plot-points x y)
       )))
-|#
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (when (find :kmr-cgn cl:*features*)
+    (setq cl:*features* (delete :kmr-cgn cl:*features*))))