From 24df75e86a93050a15a806dea45bd209cc3a37a2 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 6 Jun 2007 17:16:57 +0000 Subject: [PATCH] r11720: add dtmf capabilities --- cluck.lisp => clock.lisp | 14 +-- cluck.asd | 7 +- debian/changelog | 6 ++ debian/control | 2 +- dtmf.lisp | 193 +++++++++++++++++++++++++++++++++++++++ package.lisp | 51 +++++++++++ 6 files changed, 257 insertions(+), 16 deletions(-) rename cluck.lisp => clock.lisp (96%) create mode 100644 dtmf.lisp create mode 100644 package.lisp diff --git a/cluck.lisp b/clock.lisp similarity index 96% rename from cluck.lisp rename to clock.lisp index 1267bd1..4289a53 100644 --- a/cluck.lisp +++ b/clock.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: cluck.asd +;;;; Name: cluck.lisp ;;;; Purpose: Common Lisp uControler Clock Calculator ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: March 2007 @@ -36,18 +36,6 @@ ;;;; 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) diff --git a/cluck.asd b/cluck.asd index 6239bae..ef19678 100644 --- 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/debian/changelog b/debian/changelog index 4093edb..0b38754 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-cluck (0.1.2-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Tue, 5 Jun 2007 23:30:31 -0600 + cl-cluck (0.1.1-1) unstable; urgency=low * New upstream diff --git a/debian/control b/debian/control index 0cbf41e..671905a 100644 --- a/debian/control +++ b/debian/control @@ -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 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 index 0000000..001e435 --- /dev/null +++ b/package.lisp @@ -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)) -- 2.34.1