Skip to content
Browse files

Imported local cl-opencv.

Imported all of the existing files in my local cl-opencv repo into
this repo so I can place the code on github.
  • Loading branch information...
1 parent e64b065 commit 640f275660e106d0a97aeaa8595b518d449035dd @jbromley jbromley committed Feb 7, 2011
Showing with 271 additions and 17 deletions.
  1. +1 −17 README
  2. +3 −0 TODO
  3. +13 −0 cl-opencv-test.asd
  4. +12 −0 cl-opencv.asd
  5. +152 −0 highgui.lisp
  6. +50 −0 package.lisp
  7. +4 −0 test.sh
  8. +8 −0 test/package.lisp
  9. +28 −0 test/test.lisp
View
18 README
@@ -1,20 +1,4 @@
cl-opencv
=========
-This is a project that aims to provide Common Lisp bindings to a
-reasonable subset of the OpenCV library (see
-http://opencv.willowgarage.com for details). The initial focus will be
-on image capture and transforms, though later this may be expanded to
-deal with the machine learning and other aspects of OpenCV. I will
-attempt to test at least SBCL and CLISP, but cannot really guarantee
-anything beyond SBCL, as this is the Lisp I use in my projects.
-
-This project was forked from ryepup's cl-opencv
-(https://github.com/ryepup/cl-opencv) as that project seems to have
-stagnated fairly quickly after its inception.
-
-
-
-
-
-
+These are OpenCV bindings for SBCL. They do not promise to be complete.
View
3 TODO
@@ -0,0 +1,3 @@
+TODO
+====
+
View
13 cl-opencv-test.asd
@@ -0,0 +1,13 @@
+;;; -*- mode: lisp; indent-tabs: nil -*-
+
+(asdf:defsystem #:cl-opencv-test
+ :description "Test programs for cl-opencv."
+ :author "J. Bromley <jbromley@gmail.com>"
+ :version "0.1"
+ :depends-on (#:cl-opencv)
+ :components
+ ((:module "test"
+ :components
+ ((:file "package")
+ (:file "test" :depends-on ("package"))))))
+
View
12 cl-opencv.asd
@@ -0,0 +1,12 @@
+;;; -*- mode: lisp; indent-tabs: nil -*-
+
+(asdf:defsystem #:cl-opencv
+ :name "cl-opencv"
+ :author "J. Bromley <jbromley@gmail.com>"
+ :version "0.1"
+ :description "OpenCV bindings for SBCL"
+ :depends-on (:cffi)
+ :serial t
+ :components ((:file "package")
+ (:file "highgui" :depends-on ("package"))))
+
View
152 highgui.lisp
@@ -0,0 +1,152 @@
+;;; -*- mode: lisp; indent-tabs: nil -*-
+;;; cl-opencv.lisp
+;;; OpenCV bindings for SBCL
+;;;
+(in-package :cl-opencv)
+
+(when (member :darwin cl:*features*)
+ (pushnew #p"/opt/local/lib/" cffi:*foreign-library-directories*))
+
+(define-foreign-library highgui
+ (:darwin (:or "libopencv_highgui.2.2.0.dylib" "libopencv_highgui.dylib"))
+ (:unix (:or "libhighgui.so.2.1.0" "libhighgui.so"))
+ (t (:default "libhighgui")))
+
+(use-foreign-library highgui)
+
+(defctype capture :pointer)
+(defctype ipl-image :pointer)
+
+(defmacro defanonenum (&body enums)
+ "Converts anonymous enums to Lisp constants."
+ `(cl:progn ,@(cl:loop for value in enums
+ for index = 0 then (cl:1+ index)
+ when (cl:listp value)
+ do (cl:setf index (cl:second value)
+ value (cl:first value))
+ collect `(cl:defconstant ,value ,index))))
+
+;; Window constants for cvNamedWindow.
+(defanonenum
+ +window-normal+
+ +window-autosize+)
+
+(defcfun ("cvNamedWindow" %named-window) :int
+ "Internal helper function for NAMED-WINDOW."
+ (name :string)
+ (flags :int))
+
+(defun named-window (name &optional (flags +window-autosize+))
+ "Create a window named NAME size according to
+FLAGS. +WINDOW-AUTOSIZE+ sizes the window according to its
+contents. Note that current OpenCV only supports +WINDOW-AUTOSIZE+."
+ (%named-window name flags))
+
+(defcfun ("cvDestroyWindow" destroy-window) :void
+ "Destroy the named window with name NAME and free its resources."
+ (name :string))
+
+(defcfun ("cvDestroyAllWindows" destroy-all-windows) :void
+ "Destroy all named windows and free their resources.")
+
+;; Color mode constants for cvLoadImage.
+(defanonenum
+ (+load-image-unchanged+ -1)
+ +load-image-grayscale+
+ +load-image-color+
+ +load-image-anydepth+
+ (+load-image-anycolor+ 4))
+
+(defcfun ("cvLoadImage" load-image) ipl-image
+ "Load the image at path FILENAME using color options IS-COLOR."
+ (filename :string)
+ (is-color :int))
+
+(defcfun ("cvReleaseImage" %release-image) :void
+ (image-ptr :pointer))
+
+(defun release-image (image)
+ "Release the resources use by the image held in IMAGE."
+ (with-foreign-object (image-ptr :pointer)
+ (setf (mem-ref image-ptr :pointer) image)
+ (%release-image image-ptr)))
+
+(defcfun ("cvShowImage" show-image) :void
+ "Show the picture IMAGE in the named window NAME."
+ (name :string)
+ (image ipl-image))
+
+(defcfun ("cvWaitKey" wait-key) :int
+ "Wait up to DELAY milliseconds for a key press. Return the key press
+if any. If DELAY is zero, this function doesn't return until a key is
+pressed."
+ (delay :int))
+
+(defcfun ("cvCreateCameraCapture" create-camera-capture) capture
+ "Capture a video stream from a camera."
+ (index :int))
+
+(defcfun ("cvGrabFrame" grab-frame) :int
+ "Grabs a frame from the video capture stream CAPTURE-SRC. The image is
+stored internally. Use RETRIEVE-FRAME to retrieve the grabbed frame."
+ (capture-src capture))
+
+(defcfun ("cvRetrieveFrame" retrieve-frame) ipl-image
+ "Returns a pointer to the last image grabbed from CAPTURE-SRC with
+GRAB-FRAME."
+ (capture-src capture))
+
+
+(defcfun ("cvQueryFrame" query-frame) ipl-image
+ "Grab a frame from a video capture stream CAPTURE, decompress it and
+return it."
+ (capture-src capture))
+
+(defcfun ("cvReleaseCapture" %release-capture) :void
+ (image-ptr :pointer))
+
+(defun release-capture (capture-src)
+ "Release the resources use by the capture stream CAPTURE-SRC."
+ (with-foreign-object (capture-ptr :pointer)
+ (setf (mem-ref capture-ptr :pointer) capture-src)
+ (%release-capture capture-ptr)))
+
+;; Constants for cvSetCaptureProperty and cvGetCaptureProperty.
+(defanonenum
+ +cap-prop-pos-msec+ ; video position in milliseconds or capture timestamp
+ +cap-prop-pos-frames+ ; 0-based index of frame to be decoded/captures next
+ +cap-prop-pos-avi-ratio+ ; relative position of video file (0 to 1).
+ +cap-prop-frame-width+ ; width of frames in the video stream
+ +cap-prop-frame-height+ ; height of frames in the video stream
+ +cap-prop-fps+ ; frame rate
+ +cap-prop-fourcc+ ; 4-character code of the codec
+ +cap-prop-frame-count+ ; number of frames in video file
+ +cap-prop-format+ ; format of Mat objects returned by retrieve
+ +cap-prop-mode+ ; backend-specific value indicating capture mode
+ +cap-prop-brightness+ ; brightness of the image (only cameras)
+ +cap-prop-contrast+ ; contrast of the image (only cameras)
+ +cap-prop-saturation+ ; saturation of the image (only cameras)
+ +cap-prop-hue+ ; hue of the image (only cameras)
+ +cap-prop-gain+ ; gain of the image (only cameras)
+ +cap-prop-exposure+ ; exposure of the image (only cameras)
+ +cap-prop-convert-rgb+ ; indicates whether images should be converted to RGB
+ +cap-prop-white-balance+ ; currently unsupported
+ +cap-prop-rectification+); ? (only supported by DC1394 v 2.x backend)
+
+(defcfun ("cvSetCaptureProperty" %set-capture-property) :int
+ "Sets the value of the property PROPERTY-ID from the
+capture stream CAPTURE-SRC to VALUE."
+ (capture-src capture)
+ (property-id :int)
+ (value :double))
+
+(defun set-capture-property (capture-src property-id value)
+ "Sets the value of the property PROPERTY-ID of the capture source
+CAPTURE-SRC to the value VALUE."
+ (%set-capture-property capture-src property-id (coerce value 'double-float)))
+
+(defcfun ("cvGetCaptureProperty" get-capture-property) :double
+ "Retrieves that value of property PROPERTY-ID from the capture
+stream CAPTURE-SRC."
+ (capture-src capture)
+ (property-id :int))
View
50 package.lisp
@@ -0,0 +1,50 @@
+;;; -*- mode: lisp; indent-tabs: nil -*-
+
+(defpackage :cl-opencv
+ (:use #:cl #:cffi)
+ (:export
+ #:ipl-image
+ #:capture
+ #:+window-normal+
+ #:+window-autosize+
+ #:named-window
+ #:destroy-window
+ #:destroy-all-windows
+
+ #:+load-image-unchanged+
+ #:+load-image-grayscale+
+ #:+load-image-color+
+ #:+load-image-anydepth+
+ #:+load-image-anycolor+
+ #:load-image
+
+ #:release-image
+ #:show-image
+ #:wait-key
+ #:create-camera-capture
+ #:grab-frame
+ #:retrieve-frame
+ #:query-frame
+ #:release-capture
+
+ #:+cap-prop-pos-msec+
+ #:+cap-prop-pos-frames+
+ #:+cap-prop-pos-avi-ratio+
+ #:+cap-prop-frame-width+
+ #:+cap-prop-frame-height+
+ #:+cap-prop-fps+
+ #:+cap-prop-fourcc+
+ #:+cap-prop-frame-count+
+ #:+cap-prop-format+
+ #:+cap-prop-mode+
+ #:+cap-prop-brightness+
+ #:+cap-prop-contrast+
+ #:+cap-prop-saturation+
+ #:+cap-prop-hue+
+ #:+cap-prop-gain+
+ #:+cap-prop-exposure+
+ #:+cap-prop-convert-rgb+
+ #:+cap-prop-white-balance+
+ #:+cap-prop-rectification+
+ #:set-capture-property
+ #:get-capture-property))
View
4 test.sh
@@ -0,0 +1,4 @@
+#!/bin/sh
+sbcl --noinform --eval "(asdf:operate 'asdf:load-op :cl-opencv-test)" \
+ --eval "(cl-opencv-test:show-camera)" --eval "(sb-ext:quit)"
+exit 0
View
8 test/package.lisp
@@ -0,0 +1,8 @@
+;;; -*- mode: lisp; indent-tabs: nil -*-
+
+(defpackage #:cl-opencv-test
+ (:use #:cl #:cl-opencv)
+ (:export
+ #:display
+ #:show-camera))
+
View
28 test/test.lisp
@@ -0,0 +1,28 @@
+(in-package #:cl-opencv-test)
+
+(defun display (filename)
+ "Open the image FILENAME and show it in a window."
+ (let ((image (cl-opencv:load-image filename 1)))
+ (cl-opencv:named-window "Display" 1)
+ (cl-opencv:show-image "Display" image)
+ (loop while
+ (not (= (cl-opencv:wait-key 0) 27)))
+ (cl-opencv:release-image image)
+ (cl-opencv:destroy-window "Display")))
+
+(defun show-camera (&optional (camera-index 0))
+ "Show the output from the camera CAMERA-INDEX."
+ (let ((capture (cl-opencv:create-camera-capture camera-index))
+ (window-name "Camera")
+ (frame nil))
+ (cl-opencv:set-capture-property capture +cap-prop-frame-width+ 640)
+ (cl-opencv:set-capture-property capture +cap-prop-frame-height+ 480)
+ (cl-opencv:named-window window-name)
+ (do ((frame (cl-opencv:query-frame capture)
+ (cl-opencv:query-frame capture)))
+ ((= 27 (cl-opencv:wait-key 33)) nil)
+ (cl-opencv:show-image window-name frame))
+ (cl-opencv:destroy-window window-name)
+ (cl-opencv:release-capture capture)))
+
+

0 comments on commit 640f275

Please sign in to comment.
Something went wrong with that request. Please try again.