v4l2.lisp

   1 ;;;; Copyright 2009 Vitaly Mayatskikh <v.mayatskih@gmail.com>
   2 ;;;;
   3 ;;;; This file is a part of CL-Video4Linux2
   4 ;;;;
   5 ;;;; Performance counters are special hardware registers available on most modern
   6 ;;;; CPUs. These registers count the number of certain types of hw events: such
   7 ;;;; as instructions executed, cachemisses suffered, or branches mis-predicted -
   8 ;;;; without slowing down the kernel or applications. These registers can also
   9 ;;;; trigger interrupts when a threshold number of events have passed - and can
  10 ;;;; thus be used to profile the code that runs on that CPU.
  11 ;;;;
  12 ;;;; The Linux Performance Counter subsystem provides an abstraction of these
  13 ;;;; hardware capabilities. It provides per task and per CPU counters, counter
  14 ;;;; groups, and it provides event capabilities on top of those.  It
  15 ;;;; provides "virtual" 64-bit counters, regardless of the width of the
  16 ;;;; underlying hardware counters.
  17 ;;;;
  18 ;;;; CL-Perfcounters is free software: you can redistribute it and/or modify
  19 ;;;; it under the terms of the GNU General Public License as published by
  20 ;;;; the Free Software Foundation, either version 3 of the License, or
  21 ;;;; (at your option) any later version.
  22 ;;;;
  23 ;;;; CL-Perfcounters is distributed in the hope that it will be useful,
  24 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26 ;;;; GNU General Public License for more details.
  27 ;;;;
  28 ;;;; You should have received a copy of the GNU General Public License
  29 ;;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  30
  31 (in-package :cl-v4l2)
  32
  33 ;; hack uint32->int32
  34 (defun ioctl (fd req arg)
  35   (let ((req! (if (> req (ash 1 31))
  36                   (- (- (ash 1 32) req))
  37                   req)))
  38     (%sys-ioctl fd req! arg)))
  39
  40 (defun query-capabilities (fd)
  41   "Query for device capabilities."
  42   (with-foreign-object (caps 'v4l2-capability)
  43     (ioctl fd vidioc-querycap caps)
  44     caps))
  45
  46 (defun get-stream-params (fd type)
  47   "Get stream parameters."
  48   (with-foreign-object (parms 'v4l2-streamparm)
  49     (setf (foreign-slot-value parms 'v4l2-streamparm 'type)
  50           (foreign-enum-value 'v4l2-buf-type type))
  51     (ioctl fd vidioc-g-parm parms)
  52     parms))
  53
  54 (defun get-tuner-params (fd idx)
  55   "Get tuner parameters."
  56   (with-foreign-object (tuner 'v4l2-tuner)
  57     (setf (foreign-slot-value tuner 'v4l2-tuner 'index) idx)
  58     (ioctl fd vidioc-g-tuner tuner)
  59     tuner))
  60
  61 (defun get-input-params (fd idx)
  62   "Get input parameters."
  63   (with-foreign-object (vidin 'v4l2-input)
  64     (setf (foreign-slot-value vidin 'v4l2-input 'index) idx)
  65     (ioctl fd vidioc-enuminput vidin)
  66     vidin))
  67
  68 (defun get-input-standard (fd idx)
  69   "Get input standard."
  70   (with-foreign-object (std 'v4l2-standard)
  71     (setf (foreign-slot-value std 'v4l2-standard 'index) idx)
  72     (ioctl fd vidioc-enumstd std)
  73     std))
  74
  75 (defun get-format (fd idx)
  76   "Get pixel format."
  77   (with-foreign-object (fmt 'v4l2-fmtdesc)
  78     (setf (foreign-slot-value fmt 'v4l2-fmtdesc 'index) idx
  79           (foreign-slot-value fmt 'v4l2-fmtdesc 'type)
  80           (foreign-enum-value 'v4l2-buf-type :buf-type-video-capture))
  81     (ioctl fd vidioc-enum-fmt fmt)
  82     fmt))
  83
  84 (defun set-input (fd idx)
  85   "Set device input."
  86   (with-foreign-object (in :int)
  87     (setf (mem-ref in :int) idx)
  88     (ioctl fd vidioc-s-input in)))
  89
  90 (defun capability-driver (caps)
  91   (with-foreign-slots ((driver) caps v4l2-capability)
  92     (convert-from-foreign driver :string)))
  93
  94 (defun capability-card (caps)
  95   (with-foreign-slots ((card) caps v4l2-capability)
  96     (convert-from-foreign card :string)))
  97
  98 (defun capability-bus (caps)
  99   (with-foreign-slots ((bus-info) caps v4l2-capability)
 100     (convert-from-foreign bus-info :string)))
 101
 102 (defun capability-version (caps)
 103   (with-foreign-slots ((version) caps v4l2-capability)
 104     (let ((v (convert-from-foreign version :uint32)))
 105       (format nil "~D.~D.~D" (ldb (byte 8 16) v) (ldb (byte 8 8) v)
 106               (ldb (byte 0 8) v)))))
 107
 108 (defun %device-info (caps)
 109   (format nil "Driver: ~A~%Card: ~A~%Bus: ~A~%Version: ~A~%"
 110           (capability-driver caps)
 111           (capability-card caps)
 112           (capability-bus caps)
 113           (capability-version caps)))
 114
 115 (defun device-info (fd)
 116   "Get basic information about device."
 117   (let ((caps (query-capabilities fd)))
 118     (%device-info caps)))
 119
 120 (defun capable (caps cap)
 121   (with-foreign-slots ((capabilities) caps v4l2-capability)
 122     (not (zerop (logand (convert-from-foreign capabilities :uint32)
 123                         cap)))))