5 c opencv common-lisp libffi cffi
我的印象是 CFFI 不能按值传递结构，但 CFFI 文档说：
要将结构按值传递或返回给函数，请加载 cffi-libffi 系统并将结构指定为
(:struct structure-name)。要传递或返回指针，您可以使用:pointer或(:pointer (:struct structure-name))。
我正在重新包装 cl-opencv 函数get-size，它是这个 opencv 函数的包装器：
CvSize cvGetSize(const CvArr* arr)
并且由于我认为 CFFI 在 cl-opencv 的作者编写库时无法使用 cffi-libffi 系统按值传递结构体，因此他不得不使用以下所有代码来包装cvGetSize：
(defmacro make-structure-serializers (struct slot1 slot2)
"Create a serialization and deserialization function for the
structure STRUCT with integer slots SLOT1 and SLOT2. These functions
will pack and unpack the structure into an INT64."
(let ((pack-fn (intern (concatenate 'string (string struct)
(string '->int64))))
(slot1-fn (intern (concatenate 'string (string struct) "-"
(string slot1))))
(slot2-fn (intern (concatenate 'string (string struct) "-"
(string slot2))))
(unpack-fn (intern (concatenate 'string (string 'int64->)
(string struct))))
(make-fn (intern (concatenate 'string (string 'make-)
(string struct)))))
`(progn
(defun ,pack-fn (s)
(+ (,slot1-fn s) (ash (,slot2-fn s) 32)))
(defun ,unpack-fn (n)
(,make-fn ,slot1 (logand n #x00000000ffffffff)
,slot2 (ash n -32))))))
;; CvSize - Input = (defparameter a (make-size :width 640 :height 480)) Output = #S(SIZE :WIDTH 640 :HEIGHT 480) for
;; following the two.
(defstruct size (width 0) (height 0))
(make-structure-serializers :size :width :height)
;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) :int64
(arr cv-array))
(defun get-size (arr)
"Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
(let ((nsize (%get-size arr)))
(int64->size nsize)))
鉴于上面引用的 CFFI 文档，我将如何按值传递此cvGetSize结构CvSize？
我打算更新cl-opencv包，我想知道在 cl-opencv 包中的何处以及如何根据 CFFI 文档“加载 cffi-libffi 系统”，以及在哪里“将结构指定为(:struct structure-name)”和“使用 :pointer 或 (:pointer (:struct structure-name))”“传递或返回指针。”
我可以使用有关如何使用上述cvGetSize包装器执行此操作的详细说明：
;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) :int64
(arr cv-array))
(defun get-size (arr)
"Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
(let ((nsize (%get-size arr)))
(int64->size nsize)))
编辑@Rörd
我很欣赏你的意见回应
无论哪种方式，我都会遇到相同的错误……但出于测试目的，可以说我将 cffi-libffi 加载到我当前的会话中（带有输出）
CL-OPENCV> (asdf:oos 'asdf:load-op :cffi-libffi)
#<ASDF:LOAD-OP NIL {10076CCF13}>
NIL
它加载所以我只运行 defcfun 和你提供的 defcstruct 像这样（带输出）：
CL-OPENCV> (cffi:defcstruct cv-size
(width :int)
(height :int))
(:STRUCT CV-SIZE)
CL-OPENCV>
(defcfun ("cvGetSize" %get-size) (:struct cv-size)
(arr cv-array))
; in: DEFCFUN ("cvGetSize" %GET-SIZE)
; ("cvGetSize" CL-OPENCV::%GET-SIZE)
;
; caught ERROR:
; illegal function call
;
; compilation unit finished
; caught 1 ERROR condition
Execution of a form compiled with errors.
Form:
("cvGetSize" %GET-SIZE)
Compile-time error:
illegal function call
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Restarts:
0: [RETRY] Retry SLIME REPL evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [ABORT] Abort thread (#<THREAD "repl-thread" RUNNING {1007BA8063}>)
Backtrace:
0: ((LAMBDA ()))
[No Locals]
1: (SB-INT:SIMPLE-EVAL-IN-LEXENV ("cvGetSize" %GET-SIZE) #<NULL-LEXENV>)
Locals:
SB-DEBUG::ARG-0 = ("cvGetSize" %GET-SIZE)
SB-DEBUG::ARG-1 = #<NULL-LEXENV>
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY)) #<NULL-LEXENV>)
Locals:
SB-DEBUG::ARG-0 = (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY))
SB-DEBUG::ARG-1 = #<NULL-LEXENV>
3: (EVAL (DEFCFUN ("cvGetSize" %GET-SIZE) (:STRUCT CV-SIZE) (ARR CV-ARRAY)))
Locals:
我知道 libffi 安装正确，因为加载了 gsll（使用 cffi-libffi），我运行了 gsll 测试，它们都通过了此处显示（带输出）
(ql:quickload "lisp-unit")
(in-package :gsl)
(lisp-unit:run-tests)
To load "lisp-unit":
Load 1 ASDF system:
lisp-unit
Loading "lisp-unit"
..................................
Unit Test Summary
| 4023 assertions total
| 4022 passed
| 1 failed
| 0 execution errors
| 0 missing tests
#<TEST-RESULTS-DB Total(4023) Passed(4022) Failed(1) Errors(0)>
它似乎没有用 (:struct cv-size) 作为问题调用 defcfun，因为当我调用它时
(defcfun ("cvGetSize" %get-size) cv-size
(arr cv-array))
我得到同样的错误
Execution of a form compiled with errors.
Form:
("cvGetSize" %GET-SIZE)
Compile-time error:
我可以像这样运行我的 ipl-image 结构
CL-OPENCV> ;; ;(cffi:foreign-type-size '(:struct ipl-image)) = 144
(cffi:defcstruct ipl-image
(n-size :int)
(id :int)
(n-channels :int)
(alpha-channel :int)
(depth :int)
(color-model :pointer)
(channel-seq :pointer)
(data-order :int)
(origin :int)
(align :int)
(width :int)
(height :int)
(roi :pointer)
(mask-roi :pointer)
(image-id :pointer)
(tile-info :pointer)
(image-size :int)
(image-data :string)
(width-step :int)
(border-mode :pointer)
(border-const :pointer)
(image-data-origin :string))
output>(:STRUCT IPL-IMAGE)
我的创建图像包装器现在加载了 cffi-libffi 并且你的 (:struct ipl-image) 运行良好，但......显示输出
;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" %create-image) (:struct ipl-image)
(size :int64)
(depth :int)
(channels :int))
(defun create-image (size depth channels)
"Create an image with dimensions given by SIZE, DEPTH bits per
channel, and CHANNELS number of channels."
(let ((nsize (size->int64 size)))
(%create-image nsize depth channels)))
创建图像
但是当我跑步时
(defparameter img-size (make-size :width 640 :height 480))
(defparameter img (create-image img-size +ipl-depth-8u+ 1))
在 repl 创建一个图像没有任何反应 repl 只是挂起...
但是当我使用 ipl-image 而不是 (:struct ipl-image) 运行创建图像包装器时
我可以运行：
(defparameter img-size (make-size :width 640 :height 480))
(defparameter img (create-image img-size +ipl-depth-8u+ 1))
很好然后运行它来访问结构值（带输出）
(cffi:with-foreign-slots ((
n-size
id
n-channels
alpha-channel
depth
color-model
channel-seq
data-order
origin
align
width
height
roi
mask-roi
image-id
tile-info
image-size
image-data
width-step
border-mode
border-const
image-data-origin) img (:struct ipl-image))
(cffi:mem-ref img :char )
(format t "n-size ~a ~%" n-size)
(format t "id ~a ~%" id)
(format t "n-channels ~a ~%" n-channels)
(format t "alpha-channel ~a ~%" alpha-channel)
(format t "depth ~a ~%" depth)
(format t "color-model ~a ~%" color-model)
(format t "channel-seq ~a ~%" channel-seq)
(format t "data-order ~a ~%" data-order)
(format t "origin ~a ~%" origin)
(format t "align ~a ~%" align)
(format t "width ~a ~%" width)
(format t "height ~a ~%" height)
(format t "roi ~a ~%" roi)
(format t "mask-roi ~a ~%" mask-roi)
(format t "image-id ~a ~%" image-id)
(format t "tile-info ~a ~%" tile-info)
(format t "image-size ~a ~%" image-size)
(format t "image-data ~a ~%" image-data)
(format t "width-step ~a ~%" width-step)
(format t "border-mode ~a ~%" border-mode)
(format t "border-const ~a ~%" border-const)
(format t "image-data-origin ~a ~%" image-data-origin))
output>
n-size 144
id 0
n-channels 1
alpha-channel 0
depth 8
color-model #.(SB-SYS:INT-SAP #X59415247)
channel-seq #.(SB-SYS:INT-SAP #X400000000)
data-order 640
origin 480
align 0
width 0
height 0
roi #.(SB-SYS:INT-SAP #X00000000)
mask-roi #.(SB-SYS:INT-SAP #X00000000)
image-id #.(SB-SYS:INT-SAP #X0004B000)
tile-info #.(SB-SYS:INT-SAP #X7FFFF7F04020)
image-size 640
image-data NIL
width-step 0
border-mode #.(SB-SYS:INT-SAP #X00000000)
border-const #.(SB-SYS:INT-SAP #X00000000)
image-data-origin
但我没有得到一个按价值得到的结构体
color-model #.(SB-SYS:INT-SAP #X59415247)
当我用这个在 c 中计算出该值 img->colorModel 时
IplImage* img=cvCreateImage(cvSize(640,480), IPL_DEPTH_8U, 3);
cout << "colorModel = " << endl << " " << img->colorModel << endl << endl;
output> colorModel =
RGB
所以任何帮助将不胜感激
好的 1 编辑：
我再次尝试，它在这里工作是我的输出
CL-OPENCV> (asdf:oos 'asdf:load-op :cffi-libffi)
#<ASDF:LOAD-OP NIL {1006D7B1F3}>
NIL
CL-OPENCV>
;; ;(cffi:foreign-type-size '(:struct cv-size)) = 8
(cffi:defcstruct cv-size
(width :int)
(height :int))
;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) (:struct cv-size)
(arr cv-array))
STYLE-WARNING: redefining CL-OPENCV::%GET-SIZE in DEFUN
%GET-SIZE
CL-OPENCV>
(defparameter img-size (make-size :width 640 :height 480))
(defparameter img (create-image img-size +ipl-depth-8u+ 1))
IMG
CL-OPENCV>
(defparameter size (%get-size img))
SIZE
CL-OPENCV> size
(HEIGHT 480 WIDTH 640)
CL-OPENCV>
不知道我第一次做错了什么但是......如果你能检查我的结果并验证我刚刚通过值传递了一个结构，我将永远感激
谢谢罗德
好的，如果您仍然有兴趣帮助我调试 Rord，请再次编辑
如果出现错误：
The value (HEIGHT 480 WIDTH 640)
is not of type
SB-SYS:SYSTEM-AREA-POINTER.
[Condition of type TYPE-ERROR]
这是导致它的历史记录（这是在我发布 prev.edit 之后直接发生的，所以我的 emacs 仍然加载了所有 prev.edits 代码）：
CL-OPENCV> (defun get-size (arr)
"Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
(cffi:with-foreign-slots ((width height) (%get-size arr) (:struct cv-size))
(make-size :width width :height height)))
STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
GET-SIZE
CL-OPENCV>
(defparameter img-size (make-size :width 640 :height 480))
(defparameter img (create-image img-size +ipl-depth-8u+ 1))
IMG
CL-OPENCV>
(defparameter size (get-size img))
The value (HEIGHT 480 WIDTH 640)
is not of type
SB-SYS:SYSTEM-AREA-POINTER.
[Condition of type TYPE-ERROR]
我明白了，因为：
(defparameter size (get-size img))
访问您的 defun ......我跟踪它，所以当我刚运行时 - 显示输出：
CL-OPENCV>
;; ;(cffi:foreign-type-size '(:struct cv-size)) = 8
(cffi:defcstruct cv-size
(width :int)
(height :int))
;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" %get-size) (:struct cv-size)
(arr cv-array))
STYLE-WARNING: redefining CL-OPENCV::%GET-SIZE in DEFUN
%GET-SIZE
CL-OPENCV> (defparameter capture (create-camera-capture 0))
CAPTURE
CL-OPENCV> (defparameter frame (query-frame capture))
FRAME
CL-OPENCV>
(defparameter size (%get-size frame))
SIZE
CL-OPENCV> size
(HEIGHT 480 WIDTH 640)
CL-OPENCV> (cffi:with-foreign-slots ((width height) size (:struct cv-size))
(list width height ))
我得到错误：
The value (HEIGHT 480 WIDTH 640)
is not of type
SB-SYS:SYSTEM-AREA-POINTER.
[Condition of type
我认为这是因为您的 defcfun 的输出只是一个列表，而 with-foreign-slots 需要一个指针
我跑了这个：
(HEIGHT 480 WIDTH 640)
CL-OPENCV> (first size)
HEIGHT
验证，它只是一个列表
顺便说一句，我使用这些功能进行测试
(defparameter capture (create-camera-capture 0))
(defparameter frame (query-frame capture))
因为有更纯的输出...create-image 使用了我最初发布在此顶部的 get-size 的hackery？
我想使用 create-image 和 get-size w/o 所有的hackery，只使用结构来返回，这样我就可以停止使用 make-size 并使它更纯......所以任何建议都会成为金子……这是我想要创建图像的方式……我只需要让它接受来自您（罗德的）defcfun 的输出……我现在正在尝试将您的 defcfun 输出（（高度） 480 WIDTH 640)) 指向一个指针......所以它只会在这个
;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" %create-image) ipl-image
(size cv-size)
(depth :int)
(channels :int))
或者整个制作尺寸的东西将成为必需品......
也仅供参考，我更改了您添加的 defun
(defun get-size (arr)
"Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
(setf arr (%get-size arr))
(make-size :width (cadddr arr) :height (cadr arr)))
现在它可以工作了......如果我搞砸了一些东西并且你的defun会更好，它仍然是古玩
编辑！！！！我想通了！！！！！
here is the repl output :
; SLIME 2012-05-25
CL-OPENCV> ;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" get-size) (:pointer (:struct cv-size))
(arr cv-array))
STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
GET-SIZE
CL-OPENCV> ;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" create-image) (:pointer (:struct ipl-image))
(size (:pointer (:struct ipl-image)))
(depth :int)
(channels :int))
STYLE-WARNING: redefining CL-OPENCV:CREATE-IMAGE in DEFUN
CREATE-IMAGE
CL-OPENCV> (defun detect-red-objects (&optional (camera-index 0))
"Uses IN-RANGE-SCALAR to detect red objects"
(with-capture (capture (create-camera-capture camera-index))
(let ((window-name-1 "Video")
(window-name-2 "Ball"))
(named-window window-name-1)
(named-window window-name-2)
(move-window window-name-1 290 225)
(move-window window-name-2 940 225)
(do* ((frame (query-frame capture) (query-frame capture))
(img (clone-image frame))
(frame (clone-image img))
(img-size (get-size frame))
(img-hsv (create-image img-size +ipl-depth-8u+ 3))
(img-hsv-size (get-size img-hsv))
(img-thresh (create-image img-hsv-size +ipl-depth-8u+ 1))
(scalar-1 (make-cv-scalar 170.0 160.0 60.0))
(scalar-2 (make-cv-scalar 180.0 256.0 256.0)))
((plusp (wait-key *millis-per-frame*)) nil)
(smooth frame frame +gaussian+ 3 3)
(cvt-color frame img-hsv +bgr2hsv+)
(in-range-s img-hsv scalar-1 scalar-2 img-thresh)
(smooth img-thresh img-thresh +gaussian+ 3 3)
(show-image window-name-1 frame)
(show-image window-name-2 img-thresh))
(destroy-all-windows))))
DETECT-RED-OBJECTS
(the function detect-red-objects runs btw!...
编辑！！！！我明白了！！！！！...部分....II - 更好！
I messed up the struct on create-image the first time but it still ran...weird...but it runs when put the create-image struct back to cv-size....so no prob there...here is revised repl output
; SLIME 2012-05-25
CL-OPENCV> ;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" get-size) (:pointer (:struct cv-size))
(arr cv-array))
STYLE-WARNING: redefining CL-OPENCV:GET-SIZE in DEFUN
GET-SIZE
CL-OPENCV> ;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" create-image) (:pointer (:struct ipl-image))
(size (:pointer (:struct cv-size)))
(depth :int)
(channels :int))
STYLE-WARNING: redefining CL-OPENCV:CREATE-IMAGE in DEFUN
CREATE-IMAGE
CL-OPENCV> (defun detect-red-objects (&optional (camera-index 0))
"Uses IN-RANGE-SCALAR to detect red objects"
(with-capture (capture (create-camera-capture camera-index))
(let ((window-name-1 "Video")
(window-name-2 "Ball"))
(named-window window-name-1)
(named-window window-name-2)
(move-window window-name-1 290 225)
(move-window window-name-2 940 225)
(do* ((frame (query-frame capture) (query-frame capture))
(img (clone-image frame))
(frame (clone-image img))
(img-size (get-size frame))
(img-hsv (create-image img-size +ipl-depth-8u+ 3))
(img-hsv-size (get-size img-hsv))
(img-thresh (create-image img-hsv-size +ipl-depth-8u+ 1))
(scalar-1 (make-cv-scalar 170.0 160.0 60.0))
(scalar-2 (make-cv-scalar 180.0 256.0 256.0)))
((plusp (wait-key *millis-per-frame*)) nil)
(smooth frame frame +gaussian+ 3 3)
(cvt-color frame img-hsv +bgr2hsv+)
(in-range-s img-hsv scalar-1 scalar-2 img-thresh)
(smooth img-thresh img-thresh +gaussian+ 3 3)
(show-image window-name-1 frame)
(show-image window-name-2 img-thresh))
(destroy-all-windows))))
DETECT-RED-OBJECTS
@利亚姆编辑
好的，我试过你的从外国翻译的方法，它确实有效，我在我的 structs.lisp 文件中定义了这些
(cffi:defcstruct (cv-size :class cv-size-type)
(width :int)
(height :int))
(defmethod cffi:translate-from-foreign (p (type cv-size-type))
(let ((plist (call-next-method)))
(make-size :width (getf plist 'width)
:height (getf plist 'height))))
和 get-size 和 create-image 是这样定义的
;; CvSize cvGetSize(const CvArr* arr)
(cffi:defcfun ("cvGetSize" get-size) (:struct cv-size)
(arr cv-arr))
;; IplImage* cvCreateImage(CvSize size, int depth, int channels)
(cffi:defcfun ("cvCreateImage" %create-image) ipl-image
(size :int64)
(depth :int)
(channels :int))
(defun create-image (size depth channels)
"Create an image with dimensions given by SIZE, DEPTH bits per
channel, and CHANNELS number of channels."
(let ((nsize (size->int64 size)))
(%create-image nsize depth channels)))
这里是 size->int64 的定义
(DEFUN SIZE->INT64 (S) (+ (SIZE-WIDTH S) (ASH (SIZE-HEIGHT S) 32)))
但我喜欢翻译外国定义方法的想法
所以我想知道你是否可以向我展示如何从方法中制作下面的翻译成外国版本这真的会让我的图书馆唱歌......我的目标是为 opencv 制作一个完整的 cffi 包装器和 gsll 一样好是 gsl 所以这真的有助于更快地发生....再次感谢您对这一切的帮助
(defmethod cffi:translate-from-foreign (p (type cv-size-type))
(let ((plist (call-next-method)))
(make-size :width (getf plist 'width)
:height (getf plist 'height))))
要“加载 cffi-libffi 系统”，您需要将其指定为库文件中的依赖项.asd。（注意：cffi-libffi 需要在您的系统上安装 C 库 libffi。）
为了能够使用(:struct structure-name)，您需要首先使用 定义结构cffi:defcstruct，如下所示（我在这里假设cffi:defcstruct、cffi:defcfun、 和cffi:with-foreign-slots被导入到当前包中）：
(defcstruct cv-size
(width :int)
(height :int))
然后你可以(:struct cv-size)像defcfun这样使用：
(defcfun ("cvGetSize" %get-size) (:struct cv-size)
(arr cv-array))
编辑：修复了get-size按值传递结构。
最后定义get-size如下：
(defun get-size (arr)
"Get the dimensions of the OpenCV array ARR. Return a size struct with the
dimensions."
(let ((%size (%get-size arr)))
(make-size :width (getf %size 'width)
:height (getf %size 'height))))
编辑2：
如果我正确理解 Liam 的答案，这就是如何编写一个translate-from-foreign方法，以便它直接创建结构，而不创建中间 plist：
(defmethod cffi:translate-from-foreign (p (type cv-size-type))
(with-foreign-slots ((width height) p (:struct cv-size))
(make-size :width width :height height)))