cl-cluck-0.1.3/0000755000175000017500000000000011235266250012224 5ustar kevinkevincl-cluck-0.1.3/clock.lisp0000644000175000017500000001434710667175406014233 0ustar kevinkevin;;;; -*- 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))) (defconstant* +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)))) cl-cluck-0.1.3/cluck.asd0000644000175000017500000000164710667175406014040 0ustar kevinkevin;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: cluck.asd ;;;; Purpose: ASDF definition file for CLUCK ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: March 2007 ;;;; ;;;; $Id$ ;;;; ;;;; ************************************************************************* (defpackage #:cluck-system (:use #:asdf #:cl)) (in-package #:cluck-system) (defsystem cluck :name "cluck" :maintainer "Kevin M. Rosenberg" :licence "BSD" :description "Common Lisp uController Clock Calculator" :long-description "CLUCK provides functions to programming timers and selecting crystals for microcontrollers." :depends-on (kmrcl) :components ((:file "package") (:file "clock" :depends-on ("package")) (:file "dtmf" :depends-on ("package")) )) cl-cluck-0.1.3/cluck.txt0000644000175000017500000000122010667175406014073 0ustar kevinkevinCluck is a Common Lisp library to help automate clock and divisor selections for microcontrollers. Functions include: 1. show-timers Shows range of frequency and periods for 8 and 16-bit timers for a given clock frequency 2. ms-timer Shows prescaler, compare values, and percent errors for 8 and 16 times to acheive desired millisecond compare interrupts. 3. avr-uart-divisors / pic-uart-divisors Shows optimal divisors and percent error for common baud for serial communications 4. zero-error-uart-clocks Display common crystal frequencies that have zero uart timin errors for common serial communication rates cl-cluck-0.1.3/dtmf.lisp0000644000175000017500000001755410667175406014075 0ustar kevinkevin;;;; -*- 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)) ;; events (busy . (620 . 480)) (dial-tone . (440 . 350)) (ringback . (480 . 440)) )) (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))))) ;;; 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 0) (16 -32768)) :max (ecase 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 :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)) (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)) (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) ))) (eval-when (:compile-toplevel :load-toplevel :execute) (when (find :kmr-cgn cl:*features*) (setq cl:*features* (delete :kmr-cgn cl:*features*)))) cl-cluck-0.1.3/package.lisp0000644000175000017500000000437210667175406014530 0ustar kevinkevin;;;; -*- 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))