用Lisp获取摄像头图像，保存成BMP图片
用Lisp已经有一段时间了，玩点啥呢？忽然看到笔记本有个摄像头，何不抓出个图看看。
22 Nov 2013
设备驱动
我用Fedora Linux系统，一直以为摄像头的驱动没有，鼓捣了一番，发现，驱动好好的，不用像Windows那样要手动按驱动。
1 [root@linklook _posts]# lsusb
2 Bus 001 Device 003: ID 058f:a014 Alcor Micro Corp. Asus Integrated Webcam
3 ......(others)
4 [root@linklook _posts]# lsusb -d 058f:a014 -v
5 Bus 001 Device 003: ID 058f:a014 Alcor Micro Corp. Asus Integrated Webcam
6 Device Descriptor:
7 bLength 18
8 bDescriptorType 1
9 bcdUSB 2.00
10 bDeviceClass 239 Miscellaneous Device
11 bDeviceSubClass 2 ?
12 bDeviceProtocol 1 Interface Association
13 bMaxPacketSize0 64
14 idVendor 0x058f Alcor Micro Corp.
15 idProduct 0xa014 Asus Integrated Webcam
16 bcdDevice 0.03
17 iManufacturer 3 04G6200086K1AN236001YWJ
18 iProduct 1 ASUS USB2.0 WebCam
19 iSerial 0
20 bNumConfigurations 1
21 ......(others)
原来内置的摄像头也是WebCam设备，既然驱动已经有了，那就好办了，可以直接使用设备了。Linux关于WebCam的设备的驱动是uvcvideo模块，Linux的设备都是文件，在/dev/目录下：
1 [root@linklook _posts]# lsmod | grep uvc
2 uvcvideo 81006 0
3 videobuf2_vmalloc 13163 1 uvcvideo
4 videobuf2_core 38816 1 uvcvideo
5 videodev 121874 2 uvcvideo,videobuf2_core
6 media 20444 2 uvcvideo,videodev
7
8 [root@linklook _posts]# ls -l /dev/video*
9 crw-rw----+ 1 root video 81, 0 Nov 22 07:42 /dev/video0
说明模块已经加载，设备文件已经识别。先用成熟的工具试一下，看摄像头是否工作。Linux下关于WebCam的软件有xawtv, video4linux, cheese, kopete(KDE), mplayer, guvcviewer等，我用Gnome，就用现成的cheese试试把。
1 [weida@linklook _posts]$ cheese
2 [weida@linklook _posts]$ mplayer tv:// -tv driver=v4l2:width=640:height=480:device=/dev/video0 -fps 15 -vf screenshot
出图像了，说明设备和驱动都没有问题，下面开始写程序。
V4L2程序接口
关于Linux的视频输入有一套接口(或框架)，叫v4l2(video for linux), 包含一系列的API: Video Capture Interface, Video Output, Video Overlay, Video Output Overlay, Codec等。先把依赖的包装上：
1 [root@linklook _posts]# rpm -qa | grep v4l
2 gtk-v4l-0.4-3.fc18.x86_64
3 libv4l-0.8.8-3.fc18.x86_64
4 v4l-utils-0.8.8-3.fc18.x86_64
5 v4l-utils-devel-tools-0.8.8-3.fc18.x86_64
6 libv4l-0.8.8-3.fc18.i686
API比较多，目前没有深入研究，直接拿个例子来分析，通过分析C代码，发现流程是这样的：
1. open设备
2. 查看capability
3. set 制式，帧格式
4. 申请帧缓冲
5. mmap共享内存映射，VIDIOC_QBUF入队列
6. 开始采集，VIDIOC_STREAMON
7. Loop, VIDIOC_DQBUF出队列，处理该帧，再放入队列
8. 停止采集，VIDIOC_STREAMOFF
9. 关设备
下面该Lisp登场了.
CL-V4L2库
Common Lisp关于v4l接口有一个库，叫cl-v4l2，是基于cffi的封装，直接用quicklisp安装，同时安装的还有cl-gtk2-gtk, bordeaux-threads, cffi.
1 CL-USER> (ql:quickload "cl-v4l2")
2 CL-USER> (ql:quickload "cl-gtk2-gtk")
3 CL-USER> (ql:quickload "bordeaux-threads")
4 CL-USER> (ql:quickload "cffi")
cl-v4l2有个自带的例子example.lisp，虽然有问题，但仍可以使用，例子用到了cl-gtk2-gtk, cl-gtk2-gtkglext, bordeaux-thread. 用两个线程，一个线程用于采集，一个线程用于显示，显示用gtk库搭建的窗口，用glext库填充了内容。example.lisp的文件需要改一改：
需要将gtk-glext库的位置引用进来，且要把cl-gtk2改为cl-gtk2-gtk.
1 ;; $ LD_PRELOAD=/usr/lib64/libv4l/v4l2convert.so sbcl --load example.lisp
2 (push "~/quicklisp/dists/quicklisp/software/cl-gtk2-20120909-git/gtk-glext/" asdf:*central-registry*)
3 (asdf:oos 'asdf:load-op :cl-v4l2)
4 ;;(asdf:oos 'asdf:load-op :cl-gtk2)
5 (asdf:oos 'asdf:load-op :cl-gtk2-gtk)
6 (asdf:oos 'asdf:load-op :cl-gtk2-gtkglext)
7 (asdf:oos 'asdf:load-op :bordeaux-threads)
运行一下，但不一定成功，即使成功，图像也不对。
想了一下，何不把显示相关的内容裁掉，只留采集慢慢研究。
YUV和BMP
设备采集下来的图像流一般是yuv形式的，我的设备是yuv(4:2:2), 而且是YUYV, 如果要保存成图片，一般要转换为RGB形式，转换公式网上都有。
1 (defun yuv2rgb (y u v)
2 (mapcar #'(lambda (x) (ldb (byte 8 0) (round x)))
3 (list (+ y (* 1.13983 (- v 128)))
4 (- y (* 0.39465 (- u 128)) (* 0.58060 (- v 128)))
5 (+ y (* 2.03211 (- u 128))))))
采集下来的一帧按照YUYV是这样排列的：(y0,u,y1,v)(y2,u,y3,v)(...), 每2个y共用一个uv, 每个y代表一个像素(2个像素用4个字节表示), 如果图像的宽是352, 高是288, 那么一帧的大小是352*288*2=202752字节. 如果转换为RGBA, 一个像素用4个字节表示，所以转换后的缓冲区为202752*2=405504.
1 (defvar *camera-data* NIL)
2 (setq *camera-data* (make-array (* 4 *got-height* *got-width*)
3 :element-type '(unsigned-byte 8)
4 :initial-element #xff))
BMP是最简单的图像格式，包括：bmp文件头(14Bytes), 位图信息头(50Bytes), 调色板(由于用32位真色彩，所以不用调色板)和数据。
define-binary-type和define-binary-class是两个宏, 目的是方便的创建像C语言struct一样的类型或类, 类中的slot能设定占几个字节, 这样就能够方便的写入文件或从文件中读取. 有关内容在《实用Common Lisp编程》的第24章。
1 (define-binary-type unsigned-integer (bytes bits-per-byte)
2 (:reader (in)
3 (loop with value = 0
4 ;; for low-bit downfrom (* bits-per-byte (1- bytes)) to 0 by bits-per-byte
5 for low-bit from 0 upto (* bits-per-byte (1- bytes)) by bits-per-byte
6 do (setf (ldb (byte bits-per-byte low-bit) value) (read-byte in))
7 finally (return value)))
8 (:writer (out value)
9 ;; (loop for low-bit downfrom (* bits-per-byte (1- bytes)) to 0 by bits-per-byte
10 (loop for low-bit from 0 upto (* bits-per-byte (1- bytes)) by bits-per-byte
11 do (write-byte (ldb (byte bits-per-byte low-bit) value) out))))
12
13 (define-binary-type u1 () (unsigned-integer :bytes 1 :bits-per-byte 8))
14 (define-binary-type u2 () (unsigned-integer :bytes 2 :bits-per-byte 8))
15 (define-binary-type u3 () (unsigned-integer :bytes 3 :bits-per-byte 8))
16 (define-binary-type u4 () (unsigned-integer :bytes 4 :bits-per-byte 8))
17
18 (define-binary-class bmp-file-header ()
19 ((bf-type u2)
20 (bf-size u4)
21 (bf-reserved-1 u2)
22 (bf-reserved-2 u2)
23 (bf-offbits u4)))
24
25 (define-binary-class bmp-info-header ()
26 ((info-size u4)
27 (info-width u4)
28 (info-height u4)
29 (info-planes u2)
30 (info-bits u2)
31 (info-compression u4)
32 (info-image-size u4)
33 (info-x-resolution u4)
34 (info-y-resolution u4)
35 (info-n-colors u4)
36 (info-important-colors u4)))
37
38 (defun init-bmp-file-header (bf-obj data-size)
39 (with-slots (bf-type bf-size bf-reserved-1 bf-reserved-2 bf-offbits) bf-obj
40 (setf bf-type #x4d42
41 bf-size (+ 54 data-size)
42 bf-reserved-1 0
43 bf-reserved-2 0
44 bf-offbits 54))
45 bf-obj)
46
47 (defun init-bmp-info-header-32 (info width height data-size)
48 (with-slots (info-size info-width info-height info-planes info-bits
49 info-compression info-image-size
50 info-x-resolution info-y-resolution
51 info-n-colors info-important-colors) info
52 (setf info-size 40
53 info-width width
54 info-height height
55 info-planes 1
56 info-bits 32
57 info-compression 0
58 info-image-size data-size
59 info-x-resolution 11811
60 info-y-resolution 11811
61 info-n-colors 0
62 info-important-colors 0))
63 info)
所以把采集下来的一帧保存为bmp文件是很容易的：创建一个文件，写入bmp文件头和位图信息头，再把YUYV转换为RGBA，依次写入文件。
1 (with-open-file (out file-name
2 :direction :output
3 :element-type '(unsigned-byte 8)
4 :if-does-not-exist :create
5 :if-exists :supersede)
6 (let ((bf (init-bmp-file-header (make-instance 'bmp-file-header) (length *camera-data*)))
7 (info (init-bmp-info-header-32
8 (make-instance 'bmp-info-header)
9 *got-width* *got-height* (length *camera-data*))))
10 (write-object bf out)
11 (write-object info out)
12 (write-sequence *camera-data* out)))
需要注意一点是：bmp的图像是反转的，因此写入像素时，要从后往前写.
1 ;;buffers is the frame buffer list.
2 ;;frame is the index of buffers. means this frame is ready.
3 (multiple-value-bind (buffer address length)
4 (values-list (nth frame buffers))
5 (declare (ignore buffer))
6 ;;address is the beginning of frame buffer.
7 ;;length is the frame buffer length.
8 (let ((pixels (floor (/ length 4))))
9 (loop for i fixnum from 0 below pixels do
10 (let* ((y0 (cffi:mem-aref address :uchar (+ (* 4 i) 0)))
11 (u (cffi:mem-aref address :uchar (+ (* 4 i) 1)))
12 (y1 (cffi:mem-aref address :uchar (+ (* 4 i) 2)))
13 (v (cffi:mem-aref address :uchar (+ (* 4 i) 3)))
14 (pix-1 (yuv2rgb y0 u v))
15 (pix-2 (yuv2rgb y1 u v)))
16
17 (setf (aref *camera-data* (+ (* 8 (- pixels i 1)) 0)) (third pix-2)
18 (aref *camera-data* (+ (* 8 (- pixels i 1)) 1)) (second pix-2)
19 (aref *camera-data* (+ (* 8 (- pixels i 1)) 2)) (first pix-2)
20 (aref *camera-data* (+ (* 8 (- pixels i 1)) 3)) #xff
21 (aref *camera-data* (+ (* 8 (- pixels i 1)) 4)) (third pix-1)
22 (aref *camera-data* (+ (* 8 (- pixels i 1)) 5)) (second pix-1)
23 (aref *camera-data* (+ (* 8 (- pixels i 1)) 7)) #xff
24 (aref *camera-data* (+ (* 8 (- pixels i 1)) 6)) (first pix-1))))))
虽然不太美观，但是能工作了.
下一步准备把采集到的图像传到电视上.