Capturing and displaying video (webcam) frames using OpenCV from Racket

opencv-demo.rkt

#lang racket/base

(provide )

(require ffi/unsafe)
(require ffi/unsafe/define)
(require ffi/unsafe/cvector)
(require ffi/vector)

(define highgui-lib (ffi-lib "libopencv_highgui" '("2.4" #f)))

(define-ffi-definer define-highgui highgui-lib #:default-make-fail make-not-available)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define _char _uint8)

(define-cstruct _IplImage
  ([nSize _int]
   [ID _int] ;; should be 0
   [nChannels _int]
   [alphaChannel _int]
   [depth _int]
   [colorModel (_array _char 4)]
   [channelSeq (_array _char 4)]
   [dataOrder _int]
   [origin _int]
   [align _int]
   [width _int]
   [height _int]
   [roi _pointer] ;; IplROI *
   [maskROT _pointer] ;; IplImage *
   [imageId _pointer]
   [tileInfo _pointer] ;; IplTileInfo *
   [imageSize _int] ;; in bytes ((height * widthStep) for interleaved data, per header)
   [imageData _pointer]
   [widthStep _int]
   [BorderMode (_array _int 4)]
   [BorderConst (_array _int 4)]
   [imageDataOrigin _pointer]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define CV_CAP_PROP_FRAME_WIDTH 3)
(define CV_CAP_PROP_FRAME_HEIGHT 4)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-highgui cvCreateCameraCapture (_fun _int -> _pointer))
(define-highgui cvGetCaptureProperty (_fun _pointer _int -> _double))
(define-highgui cvSetCaptureProperty (_fun _pointer _int _double -> _int))
(define-highgui cvQueryFrame (_fun _pointer -> _IplImage-pointer))
(define-highgui cvReleaseCapture (_fun (_ptr io _pointer) -> _void))

(define-highgui cvNamedWindow (_fun _string _int -> _int))
(define-highgui cvShowImage (_fun _string _IplImage-pointer -> _void))

(define-highgui cvWaitKey (_fun _int -> _int))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(module+ main
  (define c (cvCreateCameraCapture 0))
  (cvSetCaptureProperty c CV_CAP_PROP_FRAME_WIDTH 160.0)
  (cvSetCaptureProperty c CV_CAP_PROP_FRAME_HEIGHT 120.0)
  (void (cvNamedWindow "test" 0))

  (define (dump-image-info im)
    (printf "height ~a\n" (IplImage-height im))
    (printf "width ~a\n" (IplImage-width im))
    (printf "widthStep ~a\n" (IplImage-widthStep im))
    (printf "nChannels ~a\n" (IplImage-nChannels im))
    (printf "depth ~a\n" (IplImage-depth im))
    (printf "imageData ~a\n" (IplImage-imageData im))
    (printf "imageSize ~a\n" (IplImage-imageSize im))
    (newline))

  (void
   (let loop ()
     (define im (cvQueryFrame c))
     (dump-image-info im)
     (cvShowImage "test" im)
     (case (cvWaitKey 5)
       [(27 81 113) #t] ;; escape, q, Q
       [else (loop)])))

  (cvReleaseCapture c))