Krautspace/rgb_led_matrix
Archived
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Organized lisp and arduino approaches into folders.

Browse source
This commit is contained in:
Uwe Lippmann 2015-01-18 19:43:50 +01:00
parent 60377434e4
commit 0845f3705a
4 changed files with 1 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

163
lisp/raspberry-ccl-control.lisp Normal file
View file

@ -0,0 +1,163 @@
;; /usr/share/arduino/hardware/tools/avrdude -C/usr/share/arduino/hardware/tools/avrdude.conf -v -v -v -v -patmega328p -carduino -P/dev/ttyUSB1 -b57600 -D -Uflash:w:/tmp/build438434850780539443.tmp/rgb_led_matrix.cpp.hex:i
(load "/home/pi/ccl/library/serial-streams.lisp")
(defparameter *a*
(ccl::make-serial-stream "/dev/ttyUSB0"
:format :binary
:baud-rate 115200
:parity nil
:char-bits 8
:stop-bits 1
:flow-control nil))
(let ((a (make-array (+ 1 (* 256 3)) :element-type '(unsigned-byte 8))))
(setf (aref a 0) 254)
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(setf (aref a (+ 1 (+ i (* 16 j)) (* 256 c)))
(if (= 0 (mod j 2)) 10 0)))))
(write-sequence a *a*)
nil)
(let* ((a1 (make-array (* 3 256) :element-type '(unsigned-byte 8)))
(a (make-array (list 16 16 3) :element-type '(unsigned-byte 8)
:displaced-to a1)))
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(let ((r (sqrt (+ (* i i) (* j j)))))
(setf (aref a j i c) ;; x
(if (or (= i j) (= (- 16 i) j)) 34 0))))))
(write-byte 254 *a*)
(write-sequence a1 *a*)
nil)
(let* ((a1 (make-array (* 3 256) :element-type '(unsigned-byte 8)))
(a (make-array (list 16 16 3) :element-type '(unsigned-byte 8)
:displaced-to a1)))
(loop for k below 100 do
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(let* ((ii (- i 7.5))
(jj (* .8 (- j 7.5)))
(r (sqrt (+ (* ii ii) (* jj jj)))))
(setf (aref a j i c)
(min 253 (max 0 (floor (+ -8 (* 12 (+ 1 (sin (+ (* .3 k) r)))))))))))))
(write-byte 254 *a*)
(write-sequence a1 *a*))
nil)
(let* ((a1 (make-array (* 3 256) :element-type '(unsigned-byte 8)))
(a (make-array (list 16 16 3) :element-type '(unsigned-byte 8)
:displaced-to a1)))
(loop for k below 100 do
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(let* ((ii (- i 7.5))
(jj (* .8 (- j 7.5)))
(r (sqrt (+ (* ii ii) (* jj jj)))))
(setf (aref a j i c)
(if (or (= i 0) (= i 15)
(= j 0) (= j 15))
255 0)))))))
(write-byte 254 *a*)
(write-sequence a1 *a*)
nil)
(defun read-pgm (filename)
(declare ((or pathname string) filename)
(values (or (simple-array (unsigned-byte 8) 2)
(simple-array (unsigned-byte 16) 2)) &optional))
(with-open-file (s filename)
(unless (equal (symbol-name (read s)) "P5")
(error "no PGM file"))
(let* ((w (read s))
(h (read s))
(grays (read s))
(pos (file-position s)))
(declare ((integer 0 65535) grays w h))
(let* ((type (if (<= grays 255)
'(unsigned-byte 8)
'(unsigned-byte 16)))
(data (make-array (list h w)
:element-type type))
(data-1d (make-array (* h w)
:element-type type
:displaced-to data)))
(with-open-file (s2 filename :element-type type)
(file-position s2 pos)
(read-sequence data-1d s2))
data))))
(defparameter *font-img* (read-pgm "font_arial.pgm"))
(defparameter *font*
(let ((a (make-array (list 16 16 16 16) :element-type '(unsigned-byte 8))))
(dotimes (ii 16)
(dotimes (jj 16)
(dotimes (i 16)
(dotimes (j 16)
(setf (aref a jj ii j i)
(aref *font-img* (+ j (* 16 jj)) (+ i (* 16 ii))))))))
a))
(let* ((a1 (make-array (* 3 256) :element-type '(unsigned-byte 8)))
(a (make-array (list 16 16 3) :element-type '(unsigned-byte 8)
:displaced-to a1)))
(loop for k below 100 do
(let ((ii (random 16)
)
(jj (random 16)))
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(setf (aref a j i c)
(floor (aref *font* jj ii (- 15 j) i) 10))))))
(write-byte 254 *a*)
(write-sequence a1 *a*)
(sleep .3))
nil)
(defparameter *arial-font-map*
" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ")
(char-code #\!)
(floor (char-code #\1) 16)
(defparameter *font-map*
(let ((a (make-array 256 :element-type '(unsigned-byte 8))))
(loop for c across *arial-font-map* and i from 16
do (setf (aref a (char-code c)) i))
a))
(loop for c across "!\"01@das ist ein test" collect
(let ((v (aref *font-map* (char-code c))))
(multiple-value-list (floor v 16))))
(let* ((a1 (make-array (* 3 256) :element-type '(unsigned-byte 8)))
(a (make-array (list 16 16 3) :element-type '(unsigned-byte 8)
:displaced-to a1)))
(loop for c across "12345" do
(let ((v (char-code c)))
(multiple-value-bind (jj ii) (floor v 16)
(dotimes (c 3)
(dotimes (j 16)
(dotimes (i 16)
(setf (aref a j i c)
(floor (aref *font* jj ii (- 15 j) i) 10)))))))
(progn
(write-byte 254 *a*)
(write-sequence a1 *a*)
(sleep 1)))
nil)