├── .gitignore ├── LICENSE ├── Makefile ├── Makefile.common ├── Makefile.darwin ├── Makefile.linux ├── README.md ├── TODO.org ├── build └── Makefile ├── cl-opencv-test.asd ├── cl-opencv.asd ├── cl-opencv.lisp ├── core.lisp ├── frdiff.sh ├── glue ├── Makefile ├── cl-opencv-glue.c └── cl-opencv-glue.h ├── highgui.lisp ├── imgproc.lisp ├── package.lisp ├── select_platform.sh ├── test.sh └── test ├── package.lisp └── test.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.fasl 3 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; Copyright (c) 2012 J. Bromley All Rights Reserved 3 | ;;;; Copyright (c) 2012 Ryan Davis All Rights Reserved 4 | ;;;; 5 | ;;;; Redistribution and use in source and binary forms, with or without 6 | ;;;; modification, are permitted provided that the following conditions 7 | ;;;; are met: 8 | ;;;; 9 | ;;;; * Redistributions of source code must retain the above copyright 10 | ;;;; notice, this list of conditions and the following disclaimer. 11 | ;;;; 12 | ;;;; * Redistributions in binary form must reproduce the above 13 | ;;;; copyright notice, this list of conditions and the following 14 | ;;;; disclaimer in the documentation and/or other materials 15 | ;;;; provided with the distribution. 16 | ;;;; 17 | ;;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED 18 | ;;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | ;;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ;;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY 21 | ;;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | ;;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE 23 | ;;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24 | ;;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25 | ;;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 26 | ;;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | ;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | ;;;; 29 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for cl-opencv glue code 2 | 3 | DESTDIR=/usr 4 | 5 | all: Makefile.opts 6 | ${MAKE} -C glue 7 | 8 | clean: Makefile.opts 9 | ${MAKE} -C glue clean 10 | ${MAKE} -C build clean 11 | $(RM) Makefile.opts 12 | 13 | Makefile.opts: 14 | (sh select_platform.sh) 15 | 16 | install_glue: 17 | ${MAKE} -C build install_glue DESTDIR=$(DESTDIR) 18 | 19 | install: install_glue 20 | -------------------------------------------------------------------------------- /Makefile.common: -------------------------------------------------------------------------------- 1 | # Common Makefile options 2 | 3 | LIB_NAME=cl-opencv-glue 4 | 5 | SHLIB_NAME=lib$(LIB_NAME) 6 | OBJ_SUFFIX=o 7 | 8 | STUBS=$(LIB_NAME).$(OBJ_SUFFIX) $(SHLIB_NAME).$(SHLIB_SUFFIX) 9 | 10 | -------------------------------------------------------------------------------- /Makefile.darwin: -------------------------------------------------------------------------------- 1 | #### Makefile for Darwin/PPC systems 2 | 3 | CC=gcc 4 | SHFLAGS=-dynamiclib 5 | CFLAGS+=$(SHFLAGS) -g -Wall 6 | LDFLAGS+=$(SHFLAGS) 7 | SHLIB_SUFFIX=dylib 8 | OPENCV_CONFIG=pkg-config opencv 9 | 10 | OPENCV_CFLAGS=$(CFLAGS) $(shell $(OPENCV_CONFIG) --cflags) 11 | OPENCV_LDFLAGS=$(LDFLAGS) $(shell $(OPENCV_CONFIG) --libs) 12 | 13 | OPENCV_GLUE_CFLAGS=$(OPENCV_CFLAGS) 14 | OPENCV_GLUE_LDFLAGS=$(OPENCV_LDFLAGS) 15 | -------------------------------------------------------------------------------- /Makefile.linux: -------------------------------------------------------------------------------- 1 | #### -*- Mode: Makefile -*- 2 | 3 | CC=gcc 4 | SHFLAGS=-shared -fPIC 5 | CFLAGS+=$(SHFLAGS) -g -Wall 6 | LDFLAGS+=$(SHFLAGS) -L/usr/X11R6/lib/ 7 | SHLIB_SUFFIX=so 8 | OPENCV_CONFIG=pkg-config opencv 9 | 10 | OPENCV_CFLAGS=$(CFLAGS) $(shell $(OPENCV_CONFIG) --cflags) 11 | OPENCV_LDFLAGS=$(LDFLAGS) $(shell $(OPENCV_CONFIG) --libs) 12 | 13 | OPENCV_GLUE_CFLAGS=$(OPENCV_CFLAGS) 14 | OPENCV_GLUE_LDFLAGS=$(OPENCV_LDFLAGS) 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # README: cl-opencv # 2 | 3 | 4 | ## Introduction ## 5 | 6 | These are OpenCV bindings for SBCL. They do not promise to be 7 | complete, though eventually I hope to have fairly complete coverage of 8 | OpenCV functionality. This package depends on the [cffi 9 | package](http://common-lisp.net/project/cffi/) and 10 | [libffi](http://sourceware.org/libffi/). I use 11 | [Quicklisp](http://www.quicklisp.org/) to set up my Lisp environment. 12 | 13 | 14 | ## Compatibility ## 15 | 16 | This package is known to work in the following configurations. 17 | 18 | - Mac OS 10.6, sbcl 1.0.45 (MacPorts), OpenCV 2.2 (MacPorts) 19 | - Ubuntu 10.10 (64-bit), sbcl 1.0.40, OpenCV 2.1 20 | 21 | If you have gotten cl-opencv to run with some other combination of OS 22 | and software versions, please let me know. 23 | 24 | 25 | ## Installation ## 26 | 27 | ### Mac OS X ### 28 | 29 | 1. Install OpenCV from MacPorts: `port install opencv` 30 | 2. Install libffi from MacPorts: `port install libffi` 31 | 3. In your lisp environment, make sure that cffi is available. In 32 | Quicklisp you would just do `(ql:quickload "cffi")`. 33 | 4. Run `make` and `sudo make install` in the top-level directory to 34 | build and install the glue code library. 35 | 36 | ### Ubuntu ### 37 | 38 | 1. Install OpenCV from the repos: `sudo apt-get install libhighgui-dev`. 39 | 2. Install libffi from the repos: `sudo apt-get install libffi` 40 | 3. In your lisp environment, make sure that cffi is available. In 41 | Quicklisp you would just do `(ql:quickload "cffi")`. 42 | 4. Run `make` and `sudo make install` in the top-level directory to 43 | build and install the glue code library. 44 | 45 | 46 | ## Troubleshooting ## 47 | 48 | ### Ubuntu ### 49 | 50 | If CFFI has problems loading the library, be sure that: 51 | 52 | - your lisp and your OpenCV library are both 32 bit or both 64 bit; and 53 | - if you installed OpenCV to a non-standard location, you might try 54 | adding that path to `cffi:*foreign-library-directories*`. 55 | 56 | Different camera support different resolutions and framerates. The 57 | tests assume a camera capable of about 30 fps at 640x480. Adjust the 58 | values at the top of test.lisp to match your camera. A program like 59 | VLC can help you determine those. 60 | -------------------------------------------------------------------------------- /TODO.org: -------------------------------------------------------------------------------- 1 | #+TITLE: cl-opencv TODO List 2 | #+AUTHOR: J. Bromley 3 | #+TODO: TODO IN_PROGRESS | DONE CANCELED 4 | 5 | * TODO Replace glue code and struct packing using fsbv 6 | I have resorted to some hackery to deal with structs passed by value 7 | including packing structures into int64s and writing special-case glue 8 | code. It turns out there is a library fsbv that should allow me to 9 | handle these cases without such hackery. 10 | * TODO Wrap highgui functions for reading and writing images. [0%] 11 | - [ ] cvCreateVideoWriter 12 | - [ ] cvReleaseVideoWriter 13 | - [ ] cvWriteFrame 14 | - [ ] CV_FOURCC 15 | * TODO Add miscellaneous image transformations [1]. [11%] 16 | - [X] cvAdaptiveThreshold 17 | - [ ] cvCvtColor 18 | - [ ] cvDistTransform (?) 19 | - [ ] CvConnectedComp 20 | - [ ] cvFloodFill 21 | - [ ] cvInpaint 22 | - [ ] cvIntegral 23 | - [ ] cvPyrMeanShiftFiltering 24 | - [ ] cvPyrSegmentation 25 | * TODO Make get capture property return proper type. 26 | Currently all properties are returned as doubles, which forces me to 27 | truncate them when I actually am expecting an integer. Fix this so 28 | each property gets returned as the proper type. 29 | * TODO Wrap cvCreateImageHeader. 30 | * TODO Implement IplImage as a C struct accessible from Lisp. 31 | This will allow me to directly access pixel data and other `IplImage` 32 | information through `IplImage` pointers. This would be particularly 33 | useful in conjunction with cvCreateImageHeader for creating a header 34 | and then pointing the data somewhere inside an existing image. 35 | * TODO Create with-images macro to automatically release images when done. 36 | * TODO Create with-window macro to automatically destroy windows when done. 37 | * TODO Figure out how to do callbacks for foreign functions in Lisp. 38 | * TODO Figure out how to better deal with passing structs by value. 39 | * TODO Do better error handling of foreign function exceptions. 40 | * TODO Wrap more of the user interface functionality. [0%] 41 | - [ ] cvCreateTrackbar 42 | - [ ] cvGetTrackbarPos 43 | - [ ] cvGetWindowHandle (?) 44 | - [ ] cvGetWindowName (?) 45 | - [ ] cvInitSystem 46 | - [ ] cvSetMouseCallback 47 | - [ ] cvSetTrackbarPos 48 | * IN_PROGRESS Add some simple image filters [1]. [55%] 49 | - [X] cvDilate 50 | - [X] cvErode 51 | - [ ] cvFilter2D 52 | - [X] cvLaplace 53 | - [ ] cvMorphologyEx 54 | - [X] cvPyrDown 55 | - [X] cvReleaseStructuringElement 56 | - [ ] cvSmooth 57 | - [ ] cvSobel 58 | * TODO Handle custom values for create-structuring-element-ex. 59 | The create-structuring-element-ex allows users to create their own 60 | convolution kernel. In the C interface the values of the kernel 61 | components are passed as an array (pointer to int). I need to add Lisp 62 | code to handle the list of kernel values and turn these into a native array. 63 | 64 | [1] See 65 | http://opencv.willowgarage.com/documentation/c/imgproc__image_processing.html 66 | for a complete list of image processing functions. 67 | -------------------------------------------------------------------------------- /build/Makefile: -------------------------------------------------------------------------------- 1 | # cl-opencv-glue 2 | 3 | include ../Makefile.opts 4 | include ../Makefile.common 5 | 6 | USR_OPENCV_LIBDIR=$(DESTDIR)/local/lib/ 7 | OPENCV_LIBDIR=$(DESTDIR)/lib/ 8 | 9 | 10 | all: 11 | 12 | clean: 13 | $(RM) $(STUBS) 14 | 15 | install_glue: 16 | install -m 0644 $(SHLIB_NAME).$(SHLIB_SUFFIX) $(USR_OPENCV_LIBDIR) 17 | 18 | ifeq ($(wildcard $(OPENCV_LIBDIR)$(SHLIB_NAME).$(SHLIB_SUFFIX)),) 19 | @echo "Creating a soft link from $(SHLIB_NAME).$(SHLIB_SUFFIX) in $(USR_OPENCV_LIBDIR) to $(OPENCV_LIBDIR)" 20 | ln -s $(USR_OPENCV_LIBDIR)$(SHLIB_NAME).$(SHLIB_SUFFIX) $(OPENCV_LIBDIR)$(SHLIB_NAME).$(SHLIB_SUFFIX) 21 | else 22 | @echo "Link exists from $(SHLIB_NAME).$(SHLIB_SUFFIX) in $(USR_OPENCV_LIBDIR) to $(OPENCV_LIBDIR)" 23 | endif 24 | -------------------------------------------------------------------------------- /cl-opencv-test.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp; indent-tabs: nil -*- 2 | 3 | (asdf:defsystem #:cl-opencv-test 4 | :description "Test programs for cl-opencv." 5 | :author "J. Bromley " 6 | :version "0.1" 7 | :depends-on (#:cl-opencv) 8 | :components 9 | ((:module "test" 10 | :components 11 | ((:file "package") 12 | (:file "test" :depends-on ("package")))))) 13 | -------------------------------------------------------------------------------- /cl-opencv.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp; indent-tabs: nil -*- 2 | 3 | (asdf:defsystem #:cl-opencv 4 | :name "cl-opencv" 5 | :author "J. Bromley " 6 | :version "0.1" 7 | :description "OpenCV bindings for SBCL" 8 | :depends-on (:cffi) 9 | :serial t 10 | :components ((:file "package") 11 | (:file "cl-opencv" :depends-on ("package")) 12 | (:file "core" :depends-on ("package" "cl-opencv")) 13 | (:file "imgproc" :depends-on ("package" "cl-opencv" "core")) 14 | (:file "highgui" :depends-on ("package" "cl-opencv" "core")))) 15 | -------------------------------------------------------------------------------- /cl-opencv.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- mode: lisp; indent-tabs: nil -*- 2 | ;;;; cl-opencv.lisp 3 | ;;;; OpenCV bindings for SBCL 4 | ;;;; Library loading and common code 5 | (in-package :cl-opencv) 6 | 7 | ;;; Foreign library setup 8 | (when (member :darwin cl:*features*) 9 | (pushnew #p"/opt/local/lib/" cffi:*foreign-library-directories*)) 10 | 11 | (cffi:define-foreign-library highgui 12 | (:darwin (:or "libopencv_highgui.2.2.0.dylib" "libopencv_highgui.dylib")) 13 | (:unix (:or "libhighgui.so.2.1.0" "libhighgui.so" 14 | "libopencv_highgui.so.2.3" 15 | "libopencv_highgui.so.2.3.1")) 16 | (t (:default "libhighgui"))) 17 | (cffi:use-foreign-library highgui) 18 | 19 | (cffi:define-foreign-library cl-opencv-glue 20 | (:darwin "libcl-opencv-glue.dylib") 21 | (:unix "libcl-opencv-glue.so") 22 | (t (:default "libcl-opencv-glue"))) 23 | (cffi:use-foreign-library cl-opencv-glue) 24 | 25 | ;;; General macros and functions 26 | (defmacro defanonenum (&body enums) 27 | "Converts anonymous enums to Lisp constants." 28 | `(cl:progn ,@(cl:loop for value in enums 29 | for index = 0 then (cl:1+ index) 30 | when (cl:listp value) 31 | do (cl:setf index (cl:second value) 32 | value (cl:first value)) 33 | collect `(cl:defconstant ,value ,index)))) 34 | -------------------------------------------------------------------------------- /core.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- mode: lisp; indent-tabs: nil -*- 2 | ;;;; core.lisp 3 | ;;;; OpenCV bindings for SBCL 4 | ;;;; Core functionality 5 | (in-package :cl-opencv) 6 | 7 | 8 | ;;; Basic Structures 9 | 10 | ;; We do some heinous kludging here for now. CFFI cannot pass structs 11 | ;; by value, which is almost always how OpenCV uses CvSize and 12 | ;; CvPoint. We get around this by treating the these structs as a 13 | ;; 64-bit integer, which CFFI can handle (at least on some 14 | ;; platforms). The correct answer is to write some glue C code to 15 | ;; translate structs passed by value to pointers. 16 | 17 | (defmacro make-structure-serializers (struct slot1 slot2) 18 | "Create a serialization and deserialization functionf for the 19 | structure STRUCT with integer slots SLOT1 and SLOT2. These functions 20 | will pack and unpack the structure into an INT64." 21 | (let ((pack-fn (intern (concatenate 'string (string struct) 22 | (string '->int64)))) 23 | (slot1-fn (intern (concatenate 'string (string struct) "-" 24 | (string slot1)))) 25 | (slot2-fn (intern (concatenate 'string (string struct) "-" 26 | (string slot2)))) 27 | (unpack-fn (intern (concatenate 'string (string 'int64->) 28 | (string struct)))) 29 | (make-fn (intern (concatenate 'string (string 'make-) 30 | (string struct))))) 31 | `(progn 32 | (defun ,pack-fn (s) 33 | (+ (,slot1-fn s) (ash (,slot2-fn s) 32))) 34 | (defun ,unpack-fn (n) 35 | (,make-fn ,slot1 (logand n #x00000000ffffffff) 36 | ,slot2 (ash n -32)))))) 37 | 38 | ;; CvPoint 39 | (defstruct cv-point (x 0) (y 0)) 40 | (make-structure-serializers :cv-point :x :y) 41 | 42 | ;; CvSize 43 | (defstruct size (width 0) (height 0)) 44 | (make-structure-serializers :size :width :height) 45 | 46 | ;; CvRect 47 | ;; More kludging Lisp structs to 64-bit integers which are really C structs. 48 | (defstruct cv-rect (x 0) (y 0) (width 0) (height 0)) 49 | 50 | (defun cv-rect->int64s (r) 51 | "Convert a cv-rect struct R into two 64-bit integers." 52 | (let ((i1 (+ (cv-rect-x r) (ash (cv-rect-y r) 32))) 53 | (i2 (+ (cv-rect-width r) (ash (cv-rect-height r) 32)))) 54 | (list i1 i2))) 55 | 56 | ;; CvScalar 57 | ;; In OpenCV a scalar is a struct whose single member is an array of 58 | ;; four double values. We just use a list with values coerced to 59 | ;; double. We provide a helper function to create a Lisp version of a 60 | ;; scalar. The helper ensures that there are only four values in the 61 | ;; scalar. 62 | (defun make-cv-scalar (&rest args) 63 | (mapcar #'(lambda (v) (coerce v 'double-float)) 64 | (cond ((> (length args) 4) (subseq args 0 4)) 65 | ((< (length args) 4) 66 | (do ((new-args (reverse args))) 67 | ((= (length new-args) 4) (reverse new-args)) 68 | (push 0 new-args))) 69 | (t args)))) 70 | 71 | ;; CvMat 72 | (cffi:defctype cv-matrix :pointer) 73 | 74 | ;; IplImage 75 | (defanonenum 76 | (+ipl-depth-1u+ 1) 77 | (+ipl-depth-8u+ 8) 78 | (+ipl-depth-16u+ 16) 79 | (+ipl-depth-32f+ 32) 80 | (+ipl-depth-64f+ 64) 81 | (+ipl-depth-sign+ -2147483648) ; IPL_DEPTH_SIGN is #x80000000 82 | (+ipl-depth-8s+ -2147483640) ; IPL_DEPTH_SIGN | 8 83 | (+ipl-depth-16s+ -2147483632) ; IPL_DEPTH_SIGN | 16 84 | (+ipl-depth-32s+ -2147483616)) ; IPL_DEPTH_SIGN | 32 85 | 86 | (cffi:defctype ipl-image :pointer) 87 | 88 | ;; CvArr 89 | (cffi:defctype cv-array :pointer) 90 | 91 | 92 | 93 | 94 | ;;; Operations on Arrays 95 | 96 | ;; void cvAbsDiff(const CvArr* src1, const CvArr* src2, CvArr* dst) 97 | (cffi:defcfun ("cvAbsDiff" abs-diff) :void 98 | "Calculate the absolute difference between elements in SRC1 and SRC2 99 | and store them in DEST." 100 | (src1 cv-array) 101 | (src2 cv-array) 102 | (dest cv-array)) 103 | 104 | ;; void cvAbsDiffS(const CvArr* src, CvArr* dst, CvScalar value) 105 | (cffi:defcfun ("cvAbsDiffS_glue" %abs-diff-scalar-glue) :void 106 | (src cv-array) 107 | (dest cv-array) 108 | (s1 :double) 109 | (s2 :double) 110 | (s3 :double) 111 | (s4 :double)) 112 | 113 | (defun abs-diff-scalar (src dest scalar) 114 | "Calculate the absolute difference between elements of SRC and a fixed vector of values SCALAR. Store the result in DEST." 115 | (apply #'%abs-diff-scalar-glue src dest scalar)) 116 | 117 | ;; void cvAddWeighted(const CvArr* src1, double alpha, const CvArr* src2, 118 | ;; double beta, double gamma, CvArr* dst) 119 | (cffi:defcfun ("cvAddWeighted" add-weighted) :void 120 | (src1 cv-array) 121 | (alpha :double) 122 | (src2 cv-array) 123 | (beta :double) 124 | (dest cv-array) 125 | (gamma :double)) 126 | 127 | ;; void cvCopy(const CvArr* src, CvArr* dst, const CvArr* mask=NULL) 128 | (cffi:defcfun ("cvCopy" %copy) :void 129 | (src cv-array) 130 | (dest cv-array) 131 | (mask cv-array)) 132 | 133 | (defun copy (src dest &optional (mask (null-pointer))) 134 | "Copy an image from SRC to DEST using MASK to determine which pixels 135 | are copied." 136 | (%copy src dest mask)) 137 | 138 | ;; IplImage* cvCreateImage(CvSize size, int depth, int channels) 139 | (cffi:defcfun ("cvCreateImage" %create-image) ipl-image 140 | (size :int64) 141 | (depth :int) 142 | (channels :int)) 143 | 144 | (defun create-image (size depth channels) 145 | "Create an image with dimensions given by SIZE, DEPTH bits per 146 | channel, and CHANNELS number of channels." 147 | (let ((nsize (size->int64 size))) 148 | (%create-image nsize depth channels))) 149 | 150 | ;; CvSize cvGetSize(const CvArr* arr) 151 | (cffi:defcfun ("cvGetSize" %get-size) :int64 152 | (arr cv-array)) 153 | 154 | (defun get-size (arr) 155 | "Get the dimensions of the OpenCV array ARR. Return a size struct with the 156 | dimensions." 157 | (let ((nsize (%get-size arr))) 158 | (int64->size nsize))) 159 | 160 | ;; void cvReleaseImage(IplImage** image) 161 | (cffi:defcfun ("cvReleaseImage" %release-image) :void 162 | (image-ptr :pointer)) 163 | 164 | (defun release-image (image) 165 | "Release the resources use by the image held in IMAGE." 166 | (with-foreign-object (image-ptr :pointer) 167 | (setf (mem-ref image-ptr :pointer) image) 168 | (%release-image image-ptr))) 169 | 170 | ;; void cvResetImageROI(IplImage* image) 171 | (cffi:defcfun ("cvResetImageROI" reset-image-roi) :void 172 | "Reset the ROI for IMAGE." 173 | (image ipl-image)) 174 | 175 | ;; void cvSetImageROI(IplImage* image, CvRect rect) 176 | ;; Note: the two int64 parameters actually represent a CvRect structure. 177 | (cffi:defcfun ("cvSetImageROI" %set-image-roi) :void 178 | (image ipl-image) 179 | (rect-i1 :int64) 180 | (rect-i2 :int64)) 181 | 182 | (defun set-image-roi (image rect) 183 | "Set the ROI of IMAGE to the rectangle RECT." 184 | (let ((irect (cv-rect->int64s rect))) 185 | (%set-image-roi image (first irect) (second irect)))) 186 | 187 | ;; void cvSub(const CvArr* src1, const CvArr* src2, CvArr* dst, 188 | ;; const CvArr* mask=NULL) 189 | (cffi:defcfun ("cvSub" %subtract) :void 190 | (src1 cv-array) 191 | (src2 cv-array) 192 | (dest cv-array) 193 | (mask cv-array)) 194 | 195 | (defun subtract (src1 src2 dest &optional (mask (null-pointer))) 196 | "Subtract elements of SRC2 from SRC1 for the set bits in MASK and 197 | store the result in DEST. This operation is saturating for types with 198 | limited range." 199 | (%subtract src1 src2 dest mask)) 200 | 201 | ;; void cvSubS(const CvArr* src, CvScalar value, CvArr* dst, 202 | ;; const CvArr* mask=NULL) 203 | (cffi:defcfun ("cvSubS_glue" %subtract-scalar-glue) :void 204 | (src cv-array) 205 | (s1 :double) 206 | (s2 :double) 207 | (s3 :double) 208 | (s4 :double) 209 | (dest cv-array) 210 | (mask cv-array)) 211 | 212 | (defun subtract-scalar (src scalar dest &optional (mask (null-pointer))) 213 | "Subtract corresponding elements of SCALAR from each pixel in SRC 214 | and store the result in DEST. Only subtract where pixels in MASK are 215 | non-zero." 216 | (%subtract-scalar-glue src (first scalar) (second scalar) (third scalar) 217 | (fourth scalar) dest mask)) 218 | 219 | ;; void cvSubRS(const CvArr* src, CvScalar value, CvArr* dst, 220 | ;; const CvArr* mask=NULL) 221 | (cffi:defcfun ("cvSubRS_glue" %subtract-r-scalar-glue) :void 222 | (src cv-array) 223 | (s1 :double) 224 | (s2 :double) 225 | (s3 :double) 226 | (s4 :double) 227 | (dest cv-array) 228 | (mask cv-array)) 229 | 230 | (defun subtract-r-scalar (src scalar dest &optional (mask (null-pointer))) 231 | "Subtract corresponding elements of SRC pixels from each element of 232 | SCALAR and store the result in DEST. Only subtract where pixels in 233 | MASK are non-zero." 234 | (%subtract-r-scalar-glue src (first scalar) (second scalar) (third scalar) 235 | (fourth scalar) dest mask)) 236 | 237 | -------------------------------------------------------------------------------- /frdiff.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | sbcl --noinform --eval "(asdf:operate 'asdf:load-op :cl-opencv-test)" \ 3 | --eval "(cl-opencv-test:camera-frame-diff)" \ 4 | --eval "(sb-ext:quit)" 5 | exit 0 6 | -------------------------------------------------------------------------------- /glue/Makefile: -------------------------------------------------------------------------------- 1 | # cl-opencv glue library 2 | 3 | include ../Makefile.opts 4 | include ../Makefile.common 5 | 6 | all: $(SHLIB_NAME).$(SHLIB_SUFFIX) 7 | cp $(SHLIB_NAME).$(SHLIB_SUFFIX) ../bin/ 8 | mv $(SHLIB_NAME).$(SHLIB_SUFFIX) ../build/ 9 | 10 | $(LIB_NAME).$(OBJ_SUFFIX): $(LIB_NAME).c 11 | $(CC) $(CPPFLAGS) $(OPENCV_GLUE_CFLAGS) -c -o $@ $< 12 | 13 | $(SHLIB_NAME).$(SHLIB_SUFFIX): $(LIB_NAME).$(OBJ_SUFFIX) 14 | $(CC) $(OPENCV_GLUE_LDFLAGS) -o $@ $< 15 | 16 | clean: 17 | rm -f $(STUBS) 18 | -------------------------------------------------------------------------------- /glue/cl-opencv-glue.c: -------------------------------------------------------------------------------- 1 | /* cl-opencv-glue.c */ 2 | #include "cl-opencv-glue.h" 3 | 4 | void cvAbsDiffS_glue(const CvArr *src, CvArr *dest, CV_SCALAR_DECL(value)) 5 | { 6 | cvAbsDiffS(src, dest, CV_SCALAR(value)); 7 | } 8 | 9 | void cvSubS_glue(const CvArr *src, CV_SCALAR_DECL(value), CvArr *dest, 10 | const CvArr *mask) 11 | { 12 | cvSubS(src, CV_SCALAR(value), dest, mask); 13 | } 14 | 15 | void cvSubRS_glue(const CvArr* src, CV_SCALAR_DECL(value), CvArr* dest, 16 | const CvArr* mask) 17 | { 18 | cvSubRS(src, CV_SCALAR(value), dest, mask); 19 | } 20 | 21 | void cvCopyMakeBorder_glue(const CvArr* src, CvArr* dst, CvPoint offset, 22 | int bordertype, CV_SCALAR_DECL(value)) 23 | { 24 | cvCopyMakeBorder(src, dst, offset, bordertype, CV_SCALAR(value)); 25 | } 26 | 27 | -------------------------------------------------------------------------------- /glue/cl-opencv-glue.h: -------------------------------------------------------------------------------- 1 | /* cl-opencv-glue.h 2 | * OpenCV glue functions. Most of these handle the cases were a struct is 3 | * either passed or returned by value. 4 | */ 5 | 6 | #include "cxcore.h" 7 | #include "cv.h" 8 | 9 | #define CV_SCALAR_DECL(x) double x##1, double x##2, double x##3, double x##4 10 | #define CV_SCALAR(x) cvScalar(x##1, x##2, x##3, x##4) 11 | 12 | /* void cvAbsDiffS(const CvArr* src, CvArr* dst, CvScalar value) */ 13 | void cvAbsDiffS_glue(const CvArr *src, CvArr *dest, CV_SCALAR_DECL(value)); 14 | 15 | /* void cvSubS(const CvArr* src, CvScalar value, CvArr* dst, 16 | const CvArr* mask=NULL) */ 17 | void cvSubS_glue(const CvArr *src, CV_SCALAR_DECL(value), CvArr *dest, 18 | const CvArr *mask); 19 | 20 | /* void cvSubRS(const CvArr* src, CvScalar value, CvArr* dst, 21 | const CvArr* mask=NULL) */ 22 | void cvSubRS_glue(const CvArr* src, CV_SCALAR_DECL(value), CvArr* dest, 23 | const CvArr* mask); 24 | 25 | /* void cvCopyMakeBorder(const CvArr* src, CvArr* dst, CvPoint offset, 26 | int bordertype, CvScalar value=cvScalarAll(0)) */ 27 | void cvCopyMakeBorder_glue(const CvArr* src, CvArr* dst, CvPoint offset, 28 | int bordertype, CV_SCALAR_DECL(value)); 29 | -------------------------------------------------------------------------------- /highgui.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- mode: lisp; indent-tabs: nil -*- 2 | ;;;; highgui.lisp 3 | ;;;; OpenCV bindings for SBCL 4 | ;;;; High-level GUI and Media I/O 5 | (in-package :cl-opencv) 6 | 7 | 8 | ;;; Types and structures 9 | 10 | ;; CvCapture 11 | (cffi:defctype cv-capture :pointer) 12 | 13 | ;; CvVideoWriter 14 | (cffi:defctype cv-video-writer :pointer) 15 | 16 | 17 | 18 | ;;; User Interface 19 | 20 | ;; Operation flags for cvConvertImage 21 | (defanonenum 22 | (+cvtimg-flip+ 1) 23 | (+cvtimg-swap-rb+ 2)) 24 | 25 | ;; cvConvertImage(const CvArr *src, CvArr *dst, int flags) 26 | (cffi:defcfun ("cvConvertImage" %convert-image) :void 27 | (src ipl-image) 28 | (dest ipl-image) 29 | (flags :int)) 30 | 31 | (defun convert-image (src dest &optional (flags 0)) 32 | "Converts SRC to DEST with an optional vertical flip and/or red/blue channel 33 | switch as determined by FLAGS." 34 | (%convert-image src dest flags)) 35 | 36 | ;; TODO int cvCreateTrackbar(const char* trackbarName, 37 | ;; const char* windowName, int* value, int count, 38 | ;; CvTrackbarCallback onChange) 39 | 40 | ;; void cvDestroyAllWindows(void) 41 | (cffi:defcfun ("cvDestroyAllWindows" destroy-all-windows) :void 42 | "Destroy all named windows and free their resources.") 43 | 44 | ;; void cvDestroyWindow(const char* name) 45 | (cffi:defcfun ("cvDestroyWindow" destroy-window) :void 46 | "Destroy the named window with name NAME and free its resources." 47 | (name :string)) 48 | 49 | ;; TODO int cvGetTrackbarPos(const char* trackbarName, const char* windowName) 50 | 51 | ;; TODO int cvInitSystem(int argc, char** argv) 52 | 53 | ;; void cvMoveWindow(const char* name, int x, int y) 54 | (cffi:defcfun ("cvMoveWindow" move-window) :void 55 | "Sets the position of the window NAME to X, Y." 56 | (name :string) 57 | (x :int) 58 | (y :int)) 59 | 60 | ;; int cvNamedWindow(const char* name, int flags) 61 | 62 | ;; Window constants for cvNamedWindow. 63 | (defanonenum 64 | +window-normal+ 65 | +window-autosize+) 66 | 67 | (cffi:defcfun ("cvNamedWindow" %named-window) :int 68 | "Internal helper function for NAMED-WINDOW." 69 | (name :string) 70 | (flags :int)) 71 | 72 | (defun named-window (name &optional (flags +window-autosize+)) 73 | "Create a window named NAME size according to 74 | FLAGS. +WINDOW-AUTOSIZE+ sizes the window according to its 75 | contents. Note that current OpenCV only supports +WINDOW-AUTOSIZE+." 76 | (%named-window name flags)) 77 | 78 | ;; void cvResizeWindow(const char* name, int width, int height)¶ 79 | (cffi:defcfun ("cvResizeWindow" resize-window) :void 80 | "Resize the window with name NAME to WIDTH by HEIGHT." 81 | (name :string) 82 | (width :int) 83 | (height :int)) 84 | 85 | ;; TODO void cvSetMouseCallback(const char* windowName, 86 | ;; CvMouseCallback onMouse, void* param=NULL) 87 | 88 | ;; TODO void cvSetTrackbarPos(const char* trackbarName, 89 | ;; const char* windowName, int pos) 90 | 91 | ;; void cvShowImage(const char* name, const CvArr* image) 92 | (cffi:defcfun ("cvShowImage" show-image) :void 93 | "Show the picture IMAGE in the named window NAME." 94 | (name :string) 95 | (image ipl-image)) 96 | 97 | ;; int cvWaitKey(int delay=0) 98 | (cffi:defcfun ("cvWaitKey" %wait-key) :int 99 | (delay :int)) 100 | 101 | (defun wait-key (&optional (delay 0)) 102 | "Wait up to DELAY milliseconds for a key press. Return the key press 103 | if any. If DELAY is zero, this function doesn't return until a key is 104 | pressed." 105 | (%wait-key delay)) 106 | 107 | 108 | 109 | 110 | ;;; Reading and Writing Images and Video 111 | 112 | ;; Color mode constants for cvLoadImage. 113 | (defanonenum 114 | (+load-image-unchanged+ -1) 115 | +load-image-grayscale+ 116 | +load-image-color+ 117 | +load-image-anydepth+ 118 | (+load-image-anycolor+ 4)) 119 | 120 | (cffi:defcfun ("cvLoadImage" %load-image) ipl-image 121 | (filename :string) 122 | (is-color :int)) 123 | 124 | ;; IplImage* cvLoadImage(const char* filename, int iscolor=CV_LOAD_IMAGE_COLOR) 125 | (defun load-image (filename &optional (is-color +load-image-color+)) 126 | "Load the image at path FILENAME using color options IS-COLOR." 127 | (%load-image filename is-color)) 128 | 129 | (cffi:defcfun ("cvLoadImageM" %load-image-m) cv-matrix 130 | (filename :string) 131 | (is-color :int)) 132 | 133 | ;; CvMat* cvLoadImageM(const char* filename, int iscolor=CV_LOAD_IMAGE_COLOR) 134 | (defun load-image-m (filename &optional (is-color +load-image-color+)) 135 | "Load the image from FILENAME as a CvMat using IS-COLOR color options." 136 | (%load-image-m filename is-color)) 137 | 138 | ;; int cvSaveImage(const char* filename, const CvArr* image) 139 | (cffi:defcfun ("cvSaveImage" save-image) :int 140 | "Save the image in IMAGE into the file FILENAME." 141 | (filename :string) 142 | (image ipl-image)) 143 | 144 | ;; CvCapture* cvCreateCameraCapture(int index) 145 | (cffi:defcfun ("cvCreateCameraCapture" create-camera-capture) cv-capture 146 | "Capture a video stream from the camera with index INDEX." 147 | (index :int)) 148 | 149 | ;; CvCapture* cvCreateFileCapture(const char* filename) 150 | (cffi:defcfun ("cvCreateFileCapture" create-file-capture) cv-capture 151 | "Initializes capturing a video from the file FILENAME." 152 | (filename :string)) 153 | 154 | ;; Constants for cvSetCaptureProperty and cvGetCaptureProperty. 155 | (defanonenum 156 | +cap-prop-pos-msec+ ; video position in milliseconds or capture timestamp 157 | +cap-prop-pos-frames+ ; 0-based index of frame to be decoded/captures next 158 | +cap-prop-pos-avi-ratio+ ; relative position of video file (0 to 1). 159 | +cap-prop-frame-width+ ; width of frames in the video stream 160 | +cap-prop-frame-height+ ; height of frames in the video stream 161 | +cap-prop-fps+ ; frame rate 162 | +cap-prop-fourcc+ ; 4-character code of the codec 163 | +cap-prop-frame-count+ ; number of frames in video file 164 | +cap-prop-format+ ; format of Mat objects returned by retrieve 165 | +cap-prop-mode+ ; backend-specific value indicating capture mode 166 | +cap-prop-brightness+ ; brightness of the image (only cameras) 167 | +cap-prop-contrast+ ; contrast of the image (only cameras) 168 | +cap-prop-saturation+ ; saturation of the image (only cameras) 169 | +cap-prop-hue+ ; hue of the image (only cameras) 170 | +cap-prop-gain+ ; gain of the image (only cameras) 171 | +cap-prop-exposure+ ; exposure of the image (only cameras) 172 | +cap-prop-convert-rgb+ ; indicates whether images should be converted to RGB 173 | +cap-prop-white-balance+ ; currently unsupported 174 | +cap-prop-rectification+); ? (only supported by DC1394 v 2.x backend) 175 | 176 | ;; double cvGetCaptureProperty(CvCapture* capture, int property_id) 177 | (cffi:defcfun ("cvGetCaptureProperty" get-capture-property) :double 178 | "Retrieves that value of property PROPERTY-ID from the capture 179 | stream CAPTURE." 180 | (capture cv-capture) 181 | (property-id :int)) 182 | 183 | ;; int cvGrabFrame(CvCapture* capture) 184 | (cffi:defcfun ("cvGrabFrame" grab-frame) :int 185 | "Grabs a frame from the video capture stream CAPTURE. The image is 186 | stored internally. Use RETRIEVE-FRAME to retrieve the grabbed frame." 187 | (capture cv-capture)) 188 | 189 | ;; IplImage* cvQueryFrame(CvCapture* capture) 190 | (cffi:defcfun ("cvQueryFrame" query-frame) ipl-image 191 | "Grab a frame from a video capture stream CAPTURE, decompress it and 192 | return it." 193 | (capture cv-capture)) 194 | 195 | (cffi:defcfun ("cvReleaseCapture" %release-capture) :void 196 | (capture-ptr :pointer)) 197 | 198 | ;; void cvReleaseCapture(CvCapture** capture) 199 | (defun release-capture (capture) 200 | "Release the resources use by the capture stream CAPTURE." 201 | (cffi:with-foreign-object (capture-ptr :pointer) 202 | (setf (cffi:mem-ref capture-ptr :pointer) capture) 203 | (%release-capture capture-ptr))) 204 | 205 | (defmacro with-capture ((capture-var capture) &body body) 206 | "ensures RELEASE-CAPTURE gets called on captures." 207 | `(let ((,capture-var ,capture)) 208 | (unwind-protect 209 | (progn ,@body) 210 | (release-capture ,capture-var)))) 211 | 212 | ;; IplImage* cvRetrieveFrame(CvCapture* capture) 213 | (cffi:defcfun ("cvRetrieveFrame" retrieve-frame) ipl-image 214 | "Returns a pointer to the last image grabbed from CAPTURE-SRC with 215 | GRAB-FRAME." 216 | (capture cv-capture)) 217 | 218 | (cffi:defcfun ("cvSetCaptureProperty" %set-capture-property) :int 219 | (capture cv-capture) 220 | (property-id :int) 221 | (value :double)) 222 | 223 | ;; int cvSetCaptureProperty(CvCapture* capture, int property_id, double value) 224 | (defun set-capture-property (capture property-id value) 225 | "Sets the value of the property PROPERTY-ID of the capture source 226 | CAPTURE to the value VALUE." 227 | (%set-capture-property capture property-id (coerce value 'double-float))) 228 | 229 | ;; TODO CV_FOURCC 230 | 231 | 232 | ;; TODO CvVideoWriter* cvCreateVideoWriter(const char* filename, int fourcc, 233 | ;; double fps, CvSize frame_size, 234 | ;; int is_color=1) 235 | 236 | ;; TODO void cvReleaseVideoWriter(CvVideoWriter** writer) 237 | 238 | ;; TODO int cvWriteFrame(CvVideoWriter* writer, const IplImage* image) 239 | 240 | -------------------------------------------------------------------------------- /imgproc.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- mode: lisp; indent-tabs: nil -*- 2 | ;;;; imgproc.lisp 3 | ;;;; OpenCV bindings for SBCL 4 | ;;;; Image processing 5 | (in-package :cl-opencv) 6 | 7 | 8 | ;;; Histograms 9 | 10 | 11 | 12 | ;;; Image Filtering 13 | 14 | (cffi:defctype ipl-conv-kernel :pointer) 15 | 16 | ;; TODO test cvCopyMakeBorder 17 | ;; void cvCopyMakeBorder(const CvArr* src, CvArr* dst, CvPoint offset, 18 | ;; int bordertype, CvScalar value = cvScalarAll(0)) 19 | (defanonenum 20 | +ipl-border-constant+ 21 | +ipl-border-replicate+) 22 | 23 | (cffi:defcfun ("cvCopyMakeBorder_glue" %copy-make-border) :void 24 | (src cv-array) 25 | (dest cv-array) 26 | (offset :int64) 27 | (border-type :int) 28 | (s1 :double) 29 | (s2 :double) 30 | (s3 :double) 31 | (s4 :double)) 32 | 33 | (defun copy-make-border (src dest offset border-type 34 | &optional (value (make-cv-scalar))) 35 | (apply #'%copy-make-border src dest offset border-type value)) 36 | 37 | ;; IplConvKernel* 38 | ;; cvCreateStructuringElementEx(int cols, int rows, int anchorX, int anchorY, 39 | ;; int shape, int* values=NULL) 40 | (defanonenum 41 | +cv-shape-rect+ 42 | +cv-shape-cross+ 43 | +cv-shape-ellipse+ 44 | (+cv-shape-custom+ 100)) 45 | 46 | (cffi:defcfun ("cvCreateStructuringElementEx" %create-structuring-element-ex) :void 47 | (cols :int) 48 | (rows :int) 49 | (anchor-x :int) 50 | (anchor-y :int) 51 | (shape :int) 52 | (values :pointer)) 53 | 54 | ;; TODO handle array of values in create-structuring-element-ex 55 | (defun create-structuring-element-ex (cols rows anchor-x anchor-y shape 56 | &optional (values (null-pointer))) 57 | "Creates and fills an IplConvKernel structure. The structure will be 58 | of dimensions COLSxROWS with the anchor at (ANCHOR-X, ANCHOR-Y) with 59 | SHAPE filled with VALUES." 60 | (%create-structuring-element-ex cols rows anchor-x anchor-y shape values)) 61 | 62 | ;; void cvDilate(const CvArr* src, CvArr* dst, IplConvKernel* element = NULL, 63 | ;; int iterations = 1) 64 | (cffi:defcfun ("cvDilate" %dilate) :void 65 | (src cv-array) 66 | (dest cv-array) 67 | (element ipl-conv-kernel) 68 | (iterations :int)) 69 | 70 | (defun dilate (src dest &optional (element (null-pointer)) (iterations 1)) 71 | (%dilate src dest element iterations)) 72 | 73 | ;; void cvErode(const CvArr* src, CvArr* dst, IplConvKernel* element=NULL, 74 | ;; int iterations=1) 75 | 76 | (cffi:defcfun ("cvErode" %erode) :void 77 | (src cv-array) 78 | (dest cv-array) 79 | (element ipl-conv-kernel) 80 | (iterations :int)) 81 | 82 | (defun erode (src dest &optional (element (null-pointer)) (iterations 1)) 83 | (%erode src dest element iterations)) 84 | 85 | ;; void cvLaplace(const CvArr* src, CvArr* dst, int apertureSize=3) 86 | 87 | (cffi:defcfun ("cvLaplace" %laplace) :void 88 | (src cv-array) 89 | (dest cv-array) 90 | (aperture-size :int)) 91 | 92 | (defun laplace (src dest &optional (aperture-size 3)) 93 | (%laplace src dest aperture-size)) 94 | 95 | ;; void cvPyrDown(const CvArr* src, CvArr* dst, int filter=CV_GAUSSIAN_5x5) 96 | (defanonenum 97 | (+gaussian-5x5+ 7)) 98 | 99 | (cffi:defcfun ("cvPyrDown" %pyr-down) :void 100 | (src cv-array) 101 | (dest cv-array) 102 | (filter :int)) 103 | 104 | (defun pyr-down (src dest &optional (filter +gaussian-5x5+)) 105 | "Perform downsampling step of the Gaussian pyramid decomposition on 106 | the image SRC and store it in DEST. Use the Gaussian filter type 107 | FILTER for the convolution." 108 | (%pyr-down src dest filter)) 109 | 110 | ;; void cvReleaseStructuringElement(IplConvKernel** element) 111 | 112 | (cffi:defcfun ("cvReleaseStructuringElement" %release-structuring-element) :void 113 | (element-ptr :pointer)) 114 | 115 | (defun release-structuring-element (element) 116 | (cffi:with-foreign-object (element-ptr :pointer) 117 | (setf (cffi:mem-ref element-ptr :pointer) element) 118 | (%release-structuring-element element-ptr))) 119 | 120 | 121 | 122 | 123 | ;;; Geometric Image Transformations 124 | 125 | 126 | 2 127 | ;;; Miscellaneous Image Transformations 128 | 129 | ;; void cvAdaptiveThreshold(const CvArr* src, CvArr* dst, double maxValue, 130 | ;; int adaptive_method=CV_ADAPTIVE_THRESH_MEAN_C, 131 | ;; int thresholdType=CV_THRESH_BINARY, int blockSize=3, 132 | ;; double param1=5) 133 | 134 | ;; Enumeration of threshold types for cvThreshold, cvAdaptiveThreshold 135 | (defanonenum 136 | +thresh-binary+ 137 | +thresh-binary-inv+ 138 | +thresh-trunc+ 139 | +thresh-tozero+ 140 | +thresh-tozero-inv+) 141 | 142 | ;; Adaptive threshold types 143 | (defanonenum 144 | +adaptive-thresh-mean-c+ 145 | +adaptive-thresh-gaussian-c+) 146 | 147 | (cffi:defcfun ("cvAdaptiveThreshold" %adaptive-threshold) :void 148 | (src cv-array) ; source image 149 | (dest cv-array) ; destination image 150 | (max-value :double) ; maximum value: binary and inverse binary 151 | (adaptive-method :int) ; adaptive thresholding algorithm 152 | (threshold-type :int) ; binary or inverse binary thresholding 153 | (block-size :int) ; pixel neighborhood size for thresholding 154 | (param-1 :double)) ; method-dependent parameter 155 | 156 | (defun adaptive-threshold (src dest max-value &optional 157 | (adaptive-method +adaptive-thresh-mean-c+) 158 | (threshold-type +thresh-binary+) (block-size 3) 159 | (param-1 5)) 160 | (%adaptive-threshold src dest (coerce max-value 'double-float) adaptive-method 161 | threshold-type block-size 162 | (coerce param-1 'double-float))) 163 | 164 | ;; double cvThreshold(const CvArr* src, CvArr* dst, double threshold, 165 | ;; double maxValue, int thresholdType) 166 | 167 | (cffi:defcfun ("cvThreshold" %threshold) :double 168 | (src cv-array) 169 | (dest cv-array) 170 | (threshold :double) 171 | (max-value :double) 172 | (threshold-type :int)) 173 | 174 | (defun threshold (src dest threshold max-value threshold-type) 175 | "Applies a fixed-level threshold to array elements. SRC is the 176 | source array and DEST is the target array. THRESHOLD is the threshold 177 | value and MAX-VALUE is the 'on' value for binary 178 | thresholding. THRESHOLD-TYPE is the type of thresholding to be done." 179 | (%threshold src dest (coerce threshold 'double-float) 180 | (coerce max-value 'double-float) threshold-type)) 181 | 182 | 183 | 184 | ;;; Structural Analysis and Shape Descriptors 185 | 186 | 187 | 188 | ;;; Planar Subdivisions 189 | 190 | 191 | 192 | ;;; Motion Analysis and Object Tracking 193 | 194 | 195 | 196 | ;;; Feature Detection 197 | 198 | 199 | 200 | ;;; Object Detection 201 | 202 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp; indent-tabs: nil -*- 2 | 3 | (defpackage :cl-opencv 4 | (:use #:cl) 5 | (:export 6 | ;; core - basic structures 7 | #:cv-point 8 | #:make-cv-point 9 | #:cv-point-p 10 | #:copy-cv-point 11 | #:cv-point-x 12 | #:cv-point-y 13 | 14 | #:size 15 | #:make-size 16 | #:size-p 17 | #:copy-size 18 | #:size-width 19 | #:size-height 20 | 21 | #:cv-rect 22 | #:make-cv-rect 23 | #:cv-rect-p 24 | #:copy-cv-rect 25 | #:cv-rect-x 26 | #:cv-rect-y 27 | #:cv-rect-width 28 | #:cv-rect-height 29 | 30 | #:make-cv-scalar 31 | #:cv-matrix 32 | 33 | #:ipl-image 34 | #:+ipl-depth-1u+ 35 | #:+ipl-depth-8u+ 36 | #:+ipl-depth-16u+ 37 | #:+ipl-depth-32f+ 38 | #:+ipl-depth-64f+ 39 | #:+ipl-depth-8s+ 40 | #:+ipl-depth-16s+ 41 | #:+ipl-depth-32s+ 42 | 43 | #:cv-array 44 | 45 | ;; core - operations on arrays 46 | #:abs-diff 47 | #:abs-diff-scalar 48 | #:add-weighted 49 | #:copy 50 | #:create-image 51 | #:get-size 52 | #:release-image 53 | #:reset-image-roi 54 | #:set-image-roi 55 | #:subtract 56 | #:subtract-scalar 57 | #:sub-r-scalar 58 | 59 | ;; imgproc - image processing - miscellaneous image transformations 60 | #:+adaptive-thresh-mean-c+ 61 | #:+adaptive-thresh-gaussian-c+ 62 | #:adaptive-threshold 63 | #:+thresh-binary+ 64 | #:+thresh-binary-inv+ 65 | #:+thresh-trunc+ 66 | #:+thresh-tozero+ 67 | #:+thresh-tozero-inv+ 68 | #:threshold 69 | 70 | ;; imgproc - image processing - image filtering 71 | #:ipl-conv-kernel 72 | #:+ipl-border-constant+ 73 | #:+ipl-border-replicate+ 74 | #:copy-make-border 75 | #:+cv-shape-rect+ 76 | #:+cv-shape-cross+ 77 | #:+cv-shape-ellipse+ 78 | #:+cv-shape-custom+ 79 | #:create-structuring-element-ex 80 | #:dilate 81 | #:erode 82 | ; #:filter-2d 83 | #:laplace 84 | #:+gaussian-5x5+ 85 | #:pyr-down 86 | #:release-structuring-element 87 | 88 | ;; highgui - user interface 89 | #:cv-capture 90 | #:cv-video-writer 91 | 92 | #:+cvtimg-flip+ 93 | #:+cvtimage-swap-rb+ 94 | #:convert-image 95 | ; #:create-trackbar 96 | #:destroy-all-windows 97 | #:destroy-window 98 | ; #:get-trackbar-pos 99 | ; #:init-system 100 | #:move-window 101 | #:+window-normal+ 102 | #:+window-autosize+ 103 | #:named-window 104 | #:resize-window 105 | ; #:set-mouse-callback 106 | ; #:set-trackbar-pos 107 | #:show-image 108 | #:wait-key 109 | 110 | ;; highgui - reading and writing images and video 111 | #:+load-image-unchanged+ 112 | #:+load-image-grayscale+ 113 | #:+load-image-color+ 114 | #:+load-image-anydepth+ 115 | #:+load-image-anycolor+ 116 | #:load-image 117 | #:load-image-m 118 | #:save-image 119 | #:create-camera-capture 120 | #:create-file-capture 121 | #:with-capture 122 | #:+cap-prop-pos-msec+ 123 | #:+cap-prop-pos-frames+ 124 | #:+cap-prop-pos-avi-ratio+ 125 | #:+cap-prop-frame-width+ 126 | #:+cap-prop-frame-height+ 127 | #:+cap-prop-fps+ 128 | #:+cap-prop-fourcc+ 129 | #:+cap-prop-frame-count+ 130 | #:+cap-prop-format+ 131 | #:+cap-prop-mode+ 132 | #:+cap-prop-brightness+ 133 | #:+cap-prop-contrast+ 134 | #:+cap-prop-saturation+ 135 | #:+cap-prop-hue+ 136 | #:+cap-prop-gain+ 137 | #:+cap-prop-exposure+ 138 | #:+cap-prop-convert-rgb+ 139 | #:+cap-prop-white-balance+ 140 | #:+cap-prop-rectification+ 141 | #:get-capture-property 142 | #:grab-frame 143 | #:query-frame 144 | #:release-capture 145 | #:retrieve-frame 146 | #:set-capture-property 147 | ; #:fourcc 148 | ; #:create-video-writer 149 | ; #:release-video-writer 150 | ; #:write-frame 151 | 152 | )) -------------------------------------------------------------------------------- /select_platform.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | SYS="" 4 | case `uname` in 5 | Linux) SYS=linux ;; 6 | # FreeBSD) SYS=fbsd ;; 7 | # *CYGWIN*) SYS=cygwin ;; 8 | # *MINGW*) SYS=mingw ;; 9 | Darwin) SYS=darwin ;; 10 | esac 11 | 12 | if [ -z "$SYS" ]; then 13 | echo "System not found" 14 | exit 1; 15 | fi 16 | 17 | ln -sf Makefile.$SYS Makefile.opts 18 | -------------------------------------------------------------------------------- /test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | sbcl --noinform --eval "(asdf:operate 'asdf:load-op :cl-opencv-test)" \ 3 | --eval "(cl-opencv-test:show-camera-threshold)" --eval "(sb-ext:quit)" 4 | exit 0 5 | -------------------------------------------------------------------------------- /test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp; indent-tabs: nil -*- 2 | 3 | (defpackage #:cl-opencv-test 4 | (:use #:cl #:cl-opencv) 5 | (:export 6 | #:display 7 | #:show-camera 8 | #:show-camera-threshold 9 | #:camera-frame-diff 10 | #:camera-abs-diff 11 | #:camera-subtract)) 12 | 13 | -------------------------------------------------------------------------------- /test/test.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-opencv-test) 2 | 3 | ;;various settings that depend on the camera in use 4 | (defvar *default-width* 640) 5 | (defvar *default-height* 480) 6 | (defvar *frames-per-second* 30) 7 | (defvar *millis-per-frame* (round (/ 1000 *frames-per-second*))) 8 | 9 | (defun display (filename) 10 | "Open the image FILENAME and show it in a window." 11 | (let ((image (load-image filename 1))) 12 | (named-window "Display" 1) 13 | (show-image "Display" image) 14 | (loop while (not (= (wait-key 0) 27))) 15 | (release-image image) 16 | (destroy-window "Display"))) 17 | 18 | (defun show-camera (&optional (camera-index 0) (width *default-width*) 19 | (height *default-height*)) 20 | "Show the output from the camera CAMERA-INDEX." 21 | (with-capture (capture (create-camera-capture camera-index)) 22 | (let ((window-name "Camera")) 23 | (set-capture-property capture +cap-prop-frame-width+ width) 24 | (set-capture-property capture +cap-prop-frame-height+ height) 25 | (named-window window-name) 26 | (do ((frame (query-frame capture) (query-frame capture))) 27 | ((plusp (wait-key *millis-per-frame*)) nil) 28 | (show-image window-name frame)) 29 | (destroy-window window-name)))) 30 | 31 | (defun show-camera-threshold (&optional (camera-index 0) 32 | (width *default-width*) (height *default-height*)) 33 | "Show the camera output and a thresholded version in a single window." 34 | (with-capture (capture (create-camera-capture camera-index)) 35 | (let* ((img-size (make-cv-size :width width :height height)) 36 | (window-name "Camera/Threshold") 37 | (grayscale (create-image img-size +ipl-depth-8u+ 1)) 38 | (threshold (create-image img-size +ipl-depth-8u+ 1)) 39 | (threshold3 (create-image img-size +ipl-depth-8u+ 3)) 40 | (window (create-image (make-cv-size 41 | :width (* 2 (cv-size-width img-size)) 42 | :height (cv-size-height img-size)) 43 | +ipl-depth-8u+ 3)) 44 | (cam-roi (make-cv-rect :x 0 :y 0 :width width :height height)) 45 | (bw-roi (make-cv-rect :x width :y 0 :width width :height height))) 46 | (set-capture-property capture +cap-prop-frame-width+ 47 | (cv-size-width img-size)) 48 | (set-capture-property capture +cap-prop-frame-height+ 49 | (cv-size-height img-size)) 50 | (named-window window-name) 51 | (do ((frame (query-frame capture) (query-frame capture))) 52 | ((plusp (wait-key *millis-per-frame*)) nil) 53 | (set-image-roi window cam-roi) 54 | (copy frame window) 55 | (convert-image frame grayscale) 56 | (threshold grayscale threshold 128 255 +thresh-binary+) 57 | (convert-image threshold threshold3) 58 | (set-image-roi window bw-roi) 59 | (copy threshold3 window) 60 | (reset-image-roi window) 61 | (show-image window-name window)) 62 | (destroy-window window-name) 63 | (release-image window) 64 | (release-image threshold3) 65 | (release-image threshold) 66 | (release-image grayscale)))) 67 | 68 | (defun camera-frame-diff (&optional (camera-index 0) (width *default-width*) 69 | (height *default-height*)) 70 | (with-capture (capture (create-camera-capture camera-index)) 71 | (let* ((img-size (make-cv-size :width width :height height)) 72 | (window-name "Frame Difference") 73 | (images (list (create-image img-size +ipl-depth-8u+ 1) 74 | (create-image img-size +ipl-depth-8u+ 1))) 75 | (dest (create-image img-size +ipl-depth-8u+ 1))) 76 | (set-capture-property capture +cap-prop-frame-width+ 77 | (cv-size-width img-size)) 78 | (set-capture-property capture +cap-prop-frame-height+ 79 | (cv-size-height img-size)) 80 | (named-window window-name) 81 | (do ((frame (query-frame capture) (query-frame capture)) 82 | (frame-num 0 (1+ frame-num))) 83 | ((plusp (wait-key *millis-per-frame*)) nil) 84 | (convert-image frame (elt images (mod frame-num 2))) 85 | (abs-diff (first images) (second images) dest) 86 | (show-image window-name dest)) 87 | (destroy-window window-name) 88 | (mapcar #'release-image images) 89 | (release-image dest)))) 90 | 91 | ;; TODO fix camera-abs-diff 92 | (defun camera-abs-diff (&optional (camera-index 0) (width *default-width*) 93 | (height *default-height*)) 94 | (with-capture (capture (create-camera-capture camera-index)) 95 | (let* ((img-size (make-cv-size :width width :height height)) 96 | (window-name "Frame Absolute Difference") 97 | (dest (create-image img-size +ipl-depth-8u+ 3)) 98 | (scalar (make-scalar 128.0 128.0 128.0))) 99 | (set-capture-property capture +cap-prop-frame-width+ 100 | (cv-size-width img-size)) 101 | (set-capture-property capture +cap-prop-frame-height+ 102 | (cv-size-height img-size)) 103 | (named-window window-name) 104 | (do ((frame (query-frame capture) (query-frame capture))) 105 | ((plusp (wait-key *millis-per-frame*)) nil) 106 | (abs-diff-scalar frame dest scalar) 107 | (show-image window-name dest)) 108 | (destroy-window window-name) 109 | (release-image dest)))) 110 | 111 | (defun camera-subtract (&optional (camera-index 0) (width *default-width*) 112 | (height *default-height*)) 113 | (with-capture (capture (create-camera-capture camera-index)) 114 | (let* ((img-size (make-cv-size :width width :height height)) 115 | (window-name "Frame Subtract") 116 | (last-frame (create-image img-size +ipl-depth-8u+ 3)) 117 | (dest (create-image img-size +ipl-depth-8u+ 3))) 118 | (set-capture-property capture +cap-prop-frame-width+ 119 | (cv-size-width img-size)) 120 | (set-capture-property capture +cap-prop-frame-height+ 121 | (cv-size-height img-size)) 122 | (named-window window-name) 123 | (do ((frame (query-frame capture) (query-frame capture))) 124 | ((plusp (wait-key *millis-per-frame*)) nil) 125 | (subtract frame last-frame dest) 126 | (show-image window-name dest) 127 | (copy frame last-frame)) 128 | (destroy-window window-name) 129 | (release-image last-frame) 130 | (release-image dest)))) 131 | 132 | (defun show-video (filename) 133 | "Show the video in FILENAME in a window." 134 | (with-capture (capture (create-file-capture filename)) 135 | (let ((width 136 | (truncate (get-capture-property capture +cap-prop-frame-width+))) 137 | (height 138 | (truncate (get-capture-property capture +cap-prop-frame-height+))) 139 | (frames 140 | (truncate (get-capture-property capture +cap-prop-frame-count+)))) 141 | (format t "~a: ~:dx~:d ~:d frames~%" filename width height frames) 142 | (named-window filename) 143 | (do ((frame (query-frame capture) (query-frame capture))) 144 | ((or (plusp (wait-key *millis-per-frame*)) 145 | (cffi:null-pointer-p frame)) nil) 146 | (show-image filename frame)) 147 | (destroy-window filename)))) 148 | 149 | (defun strip-summarize (filename) 150 | "Read a video from FILENAME and create a summary by taking a 151 | vertical slice of pixels from the middle of each frame and creating an 152 | image." 153 | (with-capture (capture (create-file-capture filename)) 154 | (let* ((width 155 | (truncate (get-capture-property capture +cap-prop-frame-width+))) 156 | (height 157 | (truncate (get-capture-property capture +cap-prop-frame-height+))) 158 | (frames 159 | (truncate (get-capture-property capture +cap-prop-frame-count+))) 160 | (x (/ width 2)) 161 | (frame-roi (make-cv-rect :x x :y 0 :width 1 :height height)) 162 | (img-size (make-cv-size :width frames :height height)) 163 | (img (create-image img-size +ipl-depth-8u+ 3))) 164 | (format t "~a: ~:dx~:d ~:d frames~%" filename width height frames) 165 | (format t "frame ROI: ~a~%" frame-roi) 166 | (format t "summary size: ~a~%" img-size) 167 | (named-window filename) 168 | (do* ((frame (query-frame capture) (query-frame capture)) 169 | (frame-num 0 (1+ frame-num)) 170 | (img-roi (make-cv-rect :width 1 :height height) 171 | (make-cv-rect :x frame-num :width 1 :height height))) 172 | ((cffi:null-pointer-p frame) nil) 173 | (reset-image-roi img) 174 | (show-image filename img) 175 | (set-image-roi frame frame-roi) 176 | (set-image-roi img img-roi) 177 | (copy frame img)) 178 | (reset-image-roi img) 179 | (save-image (concatenate 'string filename ".tif") img) 180 | ;(release-image img) 181 | (destroy-window filename) 182 | img))) 183 | 184 | 185 | 186 | 187 | 188 | --------------------------------------------------------------------------------