r11720: add dtmf capabilities
authorKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 6 Jun 2007 17:16:57 +0000 (17:16 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 6 Jun 2007 17:16:57 +0000 (17:16 +0000)
clock.lisp [new file with mode: 0644]
cluck.asd
cluck.lisp [deleted file]
debian/changelog
debian/control
dtmf.lisp [new file with mode: 0644]
package.lisp [new file with mode: 0644]

diff --git a/clock.lisp b/clock.lisp
new file mode 100644 (file)
index 0000000..4289a53
--- /dev/null
@@ -0,0 +1,145 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          cluck.lisp
+;;;; Purpose:       Common Lisp uControler Clock Calculator
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  March 2007
+;;;;
+;;;; $Id$
+;;;;
+;;;; Copyright (c) 2007 Kevin M. Rosenberg
+;;;;
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 1. Redistributions of source code must retain the above copyright
+;;;;    notice, this list of conditions and the following disclaimer.
+;;;; 2. Redistributions in binary form must reproduce the above copyright
+;;;;    notice, this list of conditions and the following disclaimer in the
+;;;;    documentation and/or other materials provided with the distribution.
+;;;; 3. Neither the name of the author nor the names of the contributors
+;;;;    may be used to endorse or promote products derived from this software
+;;;;    without specific prior written permission.
+;;;;
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+;;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+;;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;;; SUCH DAMAGE.
+;;;; *************************************************************************
+
+(in-package #:cluck)
+
+(defvar *f-cpu* 16000000)
+
+(defvar *8-bit-prescalars* '(1 8 64 256))
+(defvar *10-bit-prescalars* '(1 8 64 256 1024))
+
+(defvar *base-error-zero-baud-clk* (* 9 25 8192)
+"Base multiple for multi-megahertz clock frequencies to have
+0% error at common UART baud rates. Value of this base is 1.8432 million.
+Common multiples of this are 2 (3.6864Mhz), 4 (7.3728Mhz), 8 (14745600),
+and 10 (18.432MHz)")
+
+(defun show-timers (f-cpu prescalers width)
+  (let ((max-count (expt 2 width)))
+    (format t "~&Prescalar MaxRate     MinUS     MinRate        MaxMS~%")
+    (dolist (prescale prescalers)
+      (let ((base (/ f-cpu prescale)))
+        (format t "~4D ~12,1F ~9,3F ~10,4F ~13,3F~%"
+                prescale
+                (coerce base 'float)
+                (coerce (/ 1000000 base) 'float)
+                (coerce (/ base max-count) 'float)
+                (coerce (/ 1000 (/ base max-count)) 'float))))))
+
+(defun show-8-bit-timers (&optional (f-cpu *f-cpu*))
+  (show-timers f-cpu *10-bit-prescalars* 8))
+
+(defun show-16-bit-timers (&optional (f-cpu *f-cpu*))
+  (show-timers f-cpu *10-bit-prescalars* 16))
+
+(defun show-32-bit-timers (&optional (f-cpu *f-cpu*))
+  "Show max/min periods for 32-bit timers. For 16-bit PIC
+controllers, 32-bit timers use 8-bit prescalers"
+  (show-timers f-cpu *8-bit-prescalars* 32))
+
+(defun ms-timer-width (ms f-cpu prescalars width)
+  "Returns the prescalar and compare count for both 8 and 16 bit timers."
+  (labels ((nearest-count (prescale)
+             (let ((count (round (* ms (/ f-cpu 1000 prescale))))
+                   (max-count (expt 2 width)))
+               (cond
+                 ((< count 1)
+                   1)
+                 ((<= count max-count)
+                   count)
+                 ((> max-count)
+                   max-count))))
+           (clk-ms (prescale count)
+             (unless (zerop count)
+               (/ count (/ f-cpu 1000 prescale))))
+           (percent-error (actual desired)
+             (* 100 (- (/ actual desired) 1))))
+
+    (dolist (prescale prescalars)
+      (let* ((count (nearest-count prescale))
+             (clk-ms (clk-ms prescale count))
+             (err (percent-error clk-ms ms))
+             (fmt-err (if (> err 1000)
+                        "   >1000%"
+                        (format nil "~8,3F%" err))))
+        (format t "~2D  ~4D  ~5D ~10,4F ~A~%"
+                width prescale count clk-ms fmt-err)))))
+
+(defun ms-timer (ms &optional (f-cpu *f-cpu*))
+  "Returns the prescalar and compare count for both 8 and 16 bit timers."
+  (dolist (width '(8 16))
+    (ms-timer-width ms f-cpu *10-bit-prescalars* width)))
+
+(defparameter *baud-rates* '(300 600 1200 2400 4800 9600 14400 19200 28800
+                             38400 56000 57600 76800 115200 128000 250000
+                             256000 500000))
+
+(defun avr-uart-divisors (&optional (f-cpu *f-cpu*) (view-below-percent nil))
+  "Displays the divisor UBRR and error percent for various baud
+rates for F_CPU. UBBR is limited to 12 bits."
+  (dolist (baud *baud-rates*)
+    (let* ((ubrr (min 4096
+                      (max 0 (round (- (/ f-cpu 16 baud) 1)))))
+           (ubrr2 (min 4096
+                       (max 0 (round (- (/ f-cpu 8 baud) 1)))))
+           (actual-baud (/ f-cpu 16 (1+ ubrr)))
+           (actual-baud2 (/ f-cpu 8 (1+ ubrr2)))
+           (err (* 100 (- (/ actual-baud baud) 1)))
+           (err2 (* 100 (- (/ actual-baud2 baud) 1))))
+      (when (or (not view-below-percent)
+                (or (< (abs err) view-below-percent)
+                    (< (abs err2) view-below-percent)))
+        (format t "~6D ~4D ~5,1F% ~4D ~5,1F%~%"
+                baud ubrr err ubrr2 err2)))))
+
+(defun pic-uart-divisors (&optional (fcy *f-cpu*) (view-below-percent nil))
+  "Displays the divisor BRG and error percent for various baud
+rates for Fcy. BRG is limited to 16 bits."
+  (dolist (baud *baud-rates*)
+    (let* ((brg (min 65536
+                     (max 0 (round (- (/ fcy 16 baud) 1)))))
+           (actual-baud (/ fcy 16 (1+ brg)))
+           (err (* 100 (- (/ actual-baud baud) 1))))
+      (when (or (not view-below-percent)
+                (< (abs err) view-below-percent))
+        (format t "~6D ~4D ~5,1F%~%" baud brg err)))))
+
+(defun zero-error-uart-clocks ()
+  (dolist (mult '(1 2 4 6 8 10 12))
+    (format t "~&~8,4F MHz~%" (* mult  *base-error-zero-baud-clk* 1e-6))))
+
index 6239bae6b871627fc59b1108e2d494a753b68a54..ef19678041b47df55a3973e5661f50e47766d98e 100644 (file)
--- a/cluck.asd
+++ b/cluck.asd
@@ -20,5 +20,8 @@
   :licence "BSD"
   :description "Common Lisp uController Clock Calculator"
   :long-description "CLUCK provides functions to programming timers and selecting crystals for microcontrollers."
-  :components
-  ((:file "cluck")))
+  :depends-on (kmrcl)
+  :components ((:file "package")
+               (:file "clock" :depends-on ("package"))
+               (:file "dtmf" :depends-on ("package"))
+               ))
diff --git a/cluck.lisp b/cluck.lisp
deleted file mode 100644 (file)
index 1267bd1..0000000
+++ /dev/null
@@ -1,157 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          cluck.asd
-;;;; Purpose:       Common Lisp uControler Clock Calculator
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  March 2007
-;;;;
-;;;; $Id$
-;;;;
-;;;; Copyright (c) 2007 Kevin M. Rosenberg
-;;;;
-;;;; Redistribution and use in source and binary forms, with or without
-;;;; modification, are permitted provided that the following conditions
-;;;; are met:
-;;;; 1. Redistributions of source code must retain the above copyright
-;;;;    notice, this list of conditions and the following disclaimer.
-;;;; 2. Redistributions in binary form must reproduce the above copyright
-;;;;    notice, this list of conditions and the following disclaimer in the
-;;;;    documentation and/or other materials provided with the distribution.
-;;;; 3. Neither the name of the author nor the names of the contributors
-;;;;    may be used to endorse or promote products derived from this software
-;;;;    without specific prior written permission.
-;;;;
-;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
-;;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-;;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
-;;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-;;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-;;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-;;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-;;;; SUCH DAMAGE.
-;;;; *************************************************************************
-
-(defpackage #:cluck
-  (:use #:cl)
-  (:export
-   #:show-timers
-   #:show-8-bit-timers
-   #:show-16-bit-timers
-   #:show-32-bit-timers
-   #:ms-clocks
-   #:avr-uart-divisors
-   #:pic-uart-divisors
-   #:zero-error-uart-clocks))
-
-(in-package #:cluck)
-
-(defvar *f-cpu* 16000000)
-
-(defvar *8-bit-prescalars* '(1 8 64 256))
-(defvar *10-bit-prescalars* '(1 8 64 256 1024))
-
-(defvar *base-error-zero-baud-clk* (* 9 25 8192)
-"Base multiple for multi-megahertz clock frequencies to have
-0% error at common UART baud rates. Value of this base is 1.8432 million.
-Common multiples of this are 2 (3.6864Mhz), 4 (7.3728Mhz), 8 (14745600),
-and 10 (18.432MHz)")
-
-(defun show-timers (f-cpu prescalers width)
-  (let ((max-count (expt 2 width)))
-    (format t "~&Prescalar MaxRate     MinUS     MinRate        MaxMS~%")
-    (dolist (prescale prescalers)
-      (let ((base (/ f-cpu prescale)))
-        (format t "~4D ~12,1F ~9,3F ~10,4F ~13,3F~%"
-                prescale
-                (coerce base 'float)
-                (coerce (/ 1000000 base) 'float)
-                (coerce (/ base max-count) 'float)
-                (coerce (/ 1000 (/ base max-count)) 'float))))))
-
-(defun show-8-bit-timers (&optional (f-cpu *f-cpu*))
-  (show-timers f-cpu *10-bit-prescalars* 8))
-
-(defun show-16-bit-timers (&optional (f-cpu *f-cpu*))
-  (show-timers f-cpu *10-bit-prescalars* 16))
-
-(defun show-32-bit-timers (&optional (f-cpu *f-cpu*))
-  "Show max/min periods for 32-bit timers. For 16-bit PIC
-controllers, 32-bit timers use 8-bit prescalers"
-  (show-timers f-cpu *8-bit-prescalars* 32))
-
-(defun ms-timer-width (ms f-cpu prescalars width)
-  "Returns the prescalar and compare count for both 8 and 16 bit timers."
-  (labels ((nearest-count (prescale)
-             (let ((count (round (* ms (/ f-cpu 1000 prescale))))
-                   (max-count (expt 2 width)))
-               (cond
-                 ((< count 1)
-                   1)
-                 ((<= count max-count)
-                   count)
-                 ((> max-count)
-                   max-count))))
-           (clk-ms (prescale count)
-             (unless (zerop count)
-               (/ count (/ f-cpu 1000 prescale))))
-           (percent-error (actual desired)
-             (* 100 (- (/ actual desired) 1))))
-
-    (dolist (prescale prescalars)
-      (let* ((count (nearest-count prescale))
-             (clk-ms (clk-ms prescale count))
-             (err (percent-error clk-ms ms))
-             (fmt-err (if (> err 1000)
-                        "   >1000%"
-                        (format nil "~8,3F%" err))))
-        (format t "~2D  ~4D  ~5D ~10,4F ~A~%"
-                width prescale count clk-ms fmt-err)))))
-
-(defun ms-timer (ms &optional (f-cpu *f-cpu*))
-  "Returns the prescalar and compare count for both 8 and 16 bit timers."
-  (dolist (width '(8 16))
-    (ms-timer-width ms f-cpu *10-bit-prescalars* width)))
-
-(defparameter *baud-rates* '(300 600 1200 2400 4800 9600 14400 19200 28800
-                             38400 56000 57600 76800 115200 128000 250000
-                             256000 500000))
-
-(defun avr-uart-divisors (&optional (f-cpu *f-cpu*) (view-below-percent nil))
-  "Displays the divisor UBRR and error percent for various baud
-rates for F_CPU. UBBR is limited to 12 bits."
-  (dolist (baud *baud-rates*)
-    (let* ((ubrr (min 4096
-                      (max 0 (round (- (/ f-cpu 16 baud) 1)))))
-           (ubrr2 (min 4096
-                       (max 0 (round (- (/ f-cpu 8 baud) 1)))))
-           (actual-baud (/ f-cpu 16 (1+ ubrr)))
-           (actual-baud2 (/ f-cpu 8 (1+ ubrr2)))
-           (err (* 100 (- (/ actual-baud baud) 1)))
-           (err2 (* 100 (- (/ actual-baud2 baud) 1))))
-      (when (or (not view-below-percent)
-                (or (< (abs err) view-below-percent)
-                    (< (abs err2) view-below-percent)))
-        (format t "~6D ~4D ~5,1F% ~4D ~5,1F%~%"
-                baud ubrr err ubrr2 err2)))))
-
-(defun pic-uart-divisors (&optional (fcy *f-cpu*) (view-below-percent nil))
-  "Displays the divisor BRG and error percent for various baud
-rates for Fcy. BRG is limited to 16 bits."
-  (dolist (baud *baud-rates*)
-    (let* ((brg (min 65536
-                     (max 0 (round (- (/ fcy 16 baud) 1)))))
-           (actual-baud (/ fcy 16 (1+ brg)))
-           (err (* 100 (- (/ actual-baud baud) 1))))
-      (when (or (not view-below-percent)
-                (< (abs err) view-below-percent))
-        (format t "~6D ~4D ~5,1F%~%" baud brg err)))))
-
-(defun zero-error-uart-clocks ()
-  (dolist (mult '(1 2 4 6 8 10 12))
-    (format t "~&~8,4F MHz~%" (* mult  *base-error-zero-baud-clk* 1e-6))))
-
index 4093edba599e64332fd9428b5a6c9ac1c07e608b..0b38754e3cc0e4be4c028e93a1945030e4e498a6 100644 (file)
@@ -1,3 +1,9 @@
+cl-cluck (0.1.2-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Tue,  5 Jun 2007 23:30:31 -0600
+
 cl-cluck (0.1.1-1) unstable; urgency=low
 
   * New upstream 
index 0cbf41e0ea1ef2528123d256c323c4587e28fdbd..671905a84f2d29a3b88fd289e50e0ff3d27034ba 100644 (file)
@@ -7,7 +7,7 @@ Standards-Version: 3.7.2.2
 
 Package: cl-cluck
 Architecture: all
-Depends: common-lisp-controller (>= 3.37)
+Depends: common-lisp-controller (>= 3.37) kmrcl
 Description: Common Lisp Microcontroller Clock Calculator
  Cluck provides several functions to help select crystal frequencies,
  clock prescalers, and compare values to configuring timers on
diff --git a/dtmf.lisp b/dtmf.lisp
new file mode 100644 (file)
index 0000000..ef282ac
--- /dev/null
+++ b/dtmf.lisp
@@ -0,0 +1,193 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          dtmf.lisp
+;;;; Purpose:       Common Lisp DTML tone 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
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 1. Redistributions of source code must retain the above copyright
+;;;;    notice, this list of conditions and the following disclaimer.
+;;;; 2. Redistributions in binary form must reproduce the above copyright
+;;;;    notice, this list of conditions and the following disclaimer in the
+;;;;    documentation and/or other materials provided with the distribution.
+;;;; 3. Neither the name of the author nor the names of the contributors
+;;;;    may be used to endorse or promote products derived from this software
+;;;;    without specific prior written permission.
+;;;;
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+;;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+;;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;;; SUCH DAMAGE.
+;;;; *************************************************************************
+
+(in-package #:cluck)
+
+(defconstant* +dtmf-tones+
+  '(
+    ;; keypad
+    (1 . (1209 . 697))
+    (2 . (1336 . 697))
+    (3 . (1477 . 697))
+    (A . (1633 . 697))
+    (4 . (1209 . 770))
+    (5 . (1336 . 770))
+    (6 . (1477 . 770))
+    (B . (1633 . 770))
+    (7 . (1209 . 852))
+    (8 . (1336 . 852))
+    (9 . (1477 . 852))
+    (C . (1633 . 852))
+    (* . (1209 . 941))
+    (0 . (1336 . 941))
+    (\# . (1477 . 941))
+    (D . (1633 . 941))
+
+    ;; event
+    (busy . (480 . 620))
+    (dial-tone . (350 . 440))
+    (ringback . (440 . 480))
+    ))
+
+(defun dtmf-ratios ()
+  (let ((unsorted nil))
+    (dolist (record +dtmf-tones+)
+      (push (list (car record) (cddr record) (/ (cadr record) (cddr record)))
+            unsorted))
+    (sort unsorted (lambda (a b) (< (third a) (third b))))))
+
+(defun print-dtmf-ratios (&optional (stream *standard-output*))
+  (dolist (v (dtmf-ratios))
+    (format stream "~A ~D ~6,4F~%" (first v) (second v) (third v))))
+
+;; DTMF formula: f(t) = A(high)*sin(2*pi*f(high)*t) + A(low)*sin(2*pi*f(low)*t)
+;; 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)
+                      &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."
+  (setq dtmf-record (get-alist key +dtmf-tones+))
+  (unless dtmf-record (return-from dtmf-waveform nil))
+
+  (let* ((period (/ 1D0 sample-freq))
+         (samples (ceiling (* duration sample-freq)))
+         (wave (make-array (list samples) :element-type 'double-float))
+         (out-wave (make-array (list samples) :element-type element-type))
+         (time 0D0)
+         (amplitude-ratio 0.8D0)
+         (raw-min 0D0)
+         (raw-max 0D0)
+         (raw-range 0D0)
+         (range (coerce (- max min) 'double-float))
+         (f-high 0D0)
+         (f-low 0D0))
+    (declare (double-float raw-min raw-max raw-range range
+                           time amplitude-ratio f-high f-low))
+    (setq f-high (* 2 pi (car dtmf-record)))
+    (setq f-low (* 2 pi (cdr dtmf-record)))
+
+    (dotimes (i samples)
+      (declare (fixnum i))
+
+      (let ((a (+ (sin (* time f-high))
+                  (* amplitude-ratio (sin (* time f-low))))))
+        (cond
+          ((> a raw-max)
+           (setq raw-max a))
+          ((< a raw-min)
+           (setq raw-min a)))
+
+        (setf (aref wave i) a))
+      (incf time period))
+
+    (setq raw-range (- raw-max raw-min))
+    (dotimes (i samples)
+      (declare (fixnum i))
+      (let ((scaled (+ (* range (/ (- (aref wave i) raw-min) raw-range)) min)))
+        (when (subtypep element-type 'integer)
+          (setq scaled (round scaled)))
+        (setf (aref out-wave i) scaled)))
+    out-wave))
+
+
+(defun write-dtmf (file key duration sample-freq &key (delimiter #\tab)
+                   &aux wave)
+  (setq wave (dtmf-waveform key duration sample-freq))
+  (unless wave (return-from write-dtmf nil))
+
+  (with-open-file (os file :direction :output)
+    (let ((period (/ 1D0 sample-freq))
+          (time 0D0))
+      (declare (double-float time period))
+
+      (dotimes (i (length wave))
+        (declare (fixnum i))
+        (format os "~F~A~F~%" time delimiter (aref wave i))
+        (incf time period)))))
+
+(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))
+                            :max (ecase n-bits-per-sample
+                                       (8 127)
+                                       (16 32767))
+                            :element-type (list 'signed-byte n-bits-per-sample)))
+  (unless wave (return-from write-dtmf-wav nil))
+
+  (let ((sample (make-instance 'cl-wav-synth:sample
+                               :n-channels 1
+                               :n-bits-per-sample n-bits-per-sample
+                               :n-samples-per-sec sample-freq
+                               :data wave)))
+    (cl-wav-synth::set-sample-info sample)
+    (cl-wav-synth::set-total-byte-from-data sample)
+    (cl-wav-synth::set-last-sample sample)
+    (cl-wav-synth:write-sample file sample)
+    sample))
+
+#|
+(defun plot-dtmf (key duration sample-freq &aux wave)
+  (setq wave (dtmf-waveform key duration sample-freq))
+  (unless wave (return-from plot-dtmf nil))
+
+  (let ((period (/ 1D0 sample-freq))
+        (x (make-list (length wave)))
+        (y (make-list (length wave)))
+        (time 0D0))
+    (declare (double-float time period)
+             (list x y))
+
+    (dotimes (i (length wave))
+      (declare (fixnum i))
+      (setf (nth i x) time)
+      (setf (nth i y) (aref wave i))
+      (incf time period))
+
+    (cgn:with-gnuplot ('linux)
+      (cgn:set-range 'x 0 duration)
+      (cgn:set-range 'y -1 1)
+      (cgn:plot-points x y)
+      )))
+|#
diff --git a/package.lisp b/package.lisp
new file mode 100644 (file)
index 0000000..001e435
--- /dev/null
@@ -0,0 +1,51 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          package.lisp
+;;;; Purpose:       Package definition for CLUCK
+;;;; 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
+;;;; modification, are permitted provided that the following conditions
+;;;; are met:
+;;;; 1. Redistributions of source code must retain the above copyright
+;;;;    notice, this list of conditions and the following disclaimer.
+;;;; 2. Redistributions in binary form must reproduce the above copyright
+;;;;    notice, this list of conditions and the following disclaimer in the
+;;;;    documentation and/or other materials provided with the distribution.
+;;;; 3. Neither the name of the author nor the names of the contributors
+;;;;    may be used to endorse or promote products derived from this software
+;;;;    without specific prior written permission.
+;;;;
+;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+;;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+;;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+;;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;;; SUCH DAMAGE.
+;;;; *************************************************************************
+
+(in-package #:cl-user)
+
+(defpackage #:cluck
+  (:use #:cl #:kmrcl)
+  (:export
+   #:show-timers
+   #:show-8-bit-timers
+   #:show-16-bit-timers
+   #:show-32-bit-timers
+   #:ms-clocks
+   #:avr-uart-divisors
+   #:pic-uart-divisors
+   #:zero-error-uart-clocks))