Racket [Scheme] / Cocoa Glue – Part IV

As promised, here’s my current unit tests for my Racket / cocoa glue code. It’s just tests for my conversion code.

#lang racket

(require rackunit

 "string->NSString and back"
 (let ([strings (list "1" "two" "◻" "◻◾" "◻five◾")])
   (for ((s strings))
     (let ([converted-string (string->NSString s)])
       (check-not-equal? s converted-string)
       (check-equal? s (NSString->string converted-string))))))

 (let* ([strings (list "a" "b" "c")]
        [foreign-strings (map string->NSString strings)]
        [ns-array (list->NSArray foreign-strings)])
   (check-equal? (NSArray-length ns-array)
                 (length strings))
   (for ((i (in-naturals))
         (string strings))
       (NSArray-ref ns-array i))))))

 (let ([strings (list "1" "two" "◻◾◻")])
    (map NSString->string
           (map string->NSString strings)))))))

(define-simple-check (check-dict/NSDictionary-equiv? dict NSDict)
  (check-equal? (tell-int32 NSDict count) 
                (dict-count dict))
    (for (((k dict-value) (in-dict dict)))
      (let ([NSDict-value (tell NSDict objectForKey: (string->NSString k))])
         (NSString->string dict-value)
         (NSString->string NSDict-value)))))

(let* ([keys (list "a" "b" "c")]
       [string-values (list "1" "2" "3")]
       [foreign-values (map string->NSString string-values)]
       [alist (map cons keys foreign-values)])
    (dictionary->NSDictionary alist)))
    (dictionary->NSMutableDictionary alist))))

Racket [Scheme] / Cocoa Glue – Part III

For the third installment of my glue code between Cocoa and Racket, here is some data type conversion code. It’s all in Racket, using the Objective-C FFI. It includes conversions for strings to NSString and back, as well as converting between lists and NSArray and Racket dictionaries to NSDictionary and NSMutableDictionary. Also included are some helper functions for accessing NSArrays.

Next installment will be my unit tests for this code, so get excited.


#lang racket

(provide (all-defined-out))

(require ffi/unsafe

(import-class NSString)
(import-class NSArray)
(import-class NSDictionary)
(import-class NSMutableDictionary)

(define-syntax-rule (define-typed-tell fn-id type-id)
  (define-syntax-rule (fn-id obj msg (... ...))
    (tell #:type type-id obj msg (... ...))))

(define-typed-tell tell-int32  _int32)
(define-typed-tell tell-string _string)

(define (objC-tagged p)
  (unless (cpointer-has-tag? p 'id)
    (cpointer-push-tag! p 'id))

(define (string->NSString str)
  (tell NSString stringWithUTF8String: #:type _string str))

(define (NSString->string ns-string)
  (tell-string ns-string UTF8String))

(define (cvector->NSArray vec)
  (tell NSArray 
        arrayWithObjects: #:type _pointer (cvector-ptr vec)
        count: #:type _int32 (cvector-length vec)))

(define (list->NSArray lst #:type (type _pointer))
  (let ([vec (list->cvector lst type)])
    (cvector->NSArray vec)))

(define (NSArray-length ar)
  (tell-int32 ar count))

(define (NSArray-ref ar n)
  (tell ar objectAtIndex: #:type _int32 n))

(define (NSArray->list array)
  (for/list ((n (in-range (NSArray-length array))))
    (NSArray-ref array n)))

(define (dict-keys dict)
  (dict-map dict (lambda (k v) k)))

(define (dict-values dict)
  (dict-map dict (lambda (k v) v)))

(define (dictionary->NSDictionary dict)
  (tell NSDictionary
        dictionaryWithObjects: (list->NSArray (dict-values dict))
        forKeys: (list->NSArray
                  (map string->NSString (dict-keys dict)))))

(define (dictionary->NSMutableDictionary d)
  (let ([mutable (tell NSMutableDictionary dictionaryWithCapacity: #:type _int32 (dict-count d))])
    (for (((key value) (in-dict d)))
      (tell mutable 
            setObject: value
            forKey: (string->NSString key)))

Racket [Scheme] / Cocoa Glue – Part II

Part two of my enthralling posts about working with Cocoa from Racket.

Below is more of the code from the C / Objective-C library. You will notice that I use a couple of macros to deal with the NSAutoReleasePools. It’s potentially too clever for it’s own good. This code deals with opening video files for reading, writing, adding frames and exporting to h.264. It also includes a function for getting the contents of the current opengl texture as an NSImage.

#define POOL_START() NSAutoreleasePool *GENSYM00 = [[NSAutoreleasePool alloc] init]
#define POOL_DRAIN() [GENSYM00 drain]
#define WITH_POOL(type, f) { POOL_START(); type v = f; POOL_DRAIN(); return v;}
#define WITH_POOL_VOID(f)  { POOL_START(); f; POOL_DRAIN(); }

extern NSImage * glue_get_viewport_NSImage()
   GLint viewPort[4];
   glGetIntegerv( GL_VIEWPORT, viewPort );
   int width   = viewPort[2];
   int height  = viewPort[3];
   NSBitmapImageRep *rep = [[[NSBitmapImageRep alloc]
                             pixelsWide: width
                             pixelsHigh: height
                             bitsPerPixel:0] autorelease];
   glReadBuffer( GL_FRONT );
	glReadPixels( 0, 0, width, height, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, [rep bitmapData] );   
   NSImage * image = glue_NSBitmapImageRep_to_NSImage( rep );
   [image setFlipped:YES];
   // need this to actually flip image?
   [image lockFocusOnRepresentation:rep]; 
   [image unlockFocus];
   return image;

extern void * glue_quicktime_movie_open_write( const char * outputFile )
   WITH_POOL( QTMovie*, [[QTMovie alloc] 
                         initToWritableFile: [NSString stringWithUTF8String: outputFile]
                         error: NULL] );

extern void * glue_quicktime_movie_open_read( const char * inputFile )
   WITH_POOL( QTMovie*, ([[QTMovie alloc] 
                         initWithAttributes: [NSDictionary dictionaryWithObjectsAndKeys:
                                              [NSString stringWithUTF8String: inputFile], 
                                              NO, QTMovieOpenAsyncOKAttribute,
                         error: nil]) );

extern void glue_quicktime_movie_set_current_time( QTMovie * movie, long timeValue, long timeScale )
   [movie setCurrentTime: QTMakeTime( timeValue, timeScale)];

extern NSImage * glue_quicktime_movie_get_current_frame( QTMovie * movie )
   return [movie currentFrameImage];

extern long glue_quicktime_movie_get_duration( QTMovie * movie )
   QTTime t = [movie duration];
   return (1000 * t.timeValue) / t.timeScale;

extern void glue_quicktime_movie_write( QTMovie * movie )
   [movie updateMovieFile];

extern void glue_quicktime_movie_add_frame( QTMovie * movie, NSImage * img,
                                           int length, int lengthScale )
   [movie addImage: img 
       forDuration: QTMakeTime(length, lengthScale)
    withAttributes: [NSDictionary dictionaryWithObject: @"tiff"
                                                forKey: QTAddImageCodecType]];

extern void glue_quicktime_movie_add_frame_current( QTMovie * movie, int length, int lengthScale )
   WITH_POOL_VOID( glue_quicktime_movie_add_frame( movie, 
                                                  length, lengthScale ) );

extern void glue_quicktime_movie_export_mp4_264( QTMovie * movie, const char * filePath )
   WITH_POOL_VOID ( ([movie writeToFile: [NSString stringWithUTF8String: filePath]
                         withAttributes: [NSDictionary dictionaryWithObjectsAndKeys:
                                          [NSNumber numberWithBool:YES], QTMovieExport,
                                          [NSNumber numberWithLong:'M4VH'], QTMovieExportType, nil]] ) );

Here’s the pertinent pieces of the FFI interface for Racket:

(define-glue glue-quicktime-movie-open-write : _string -> _pointer)
(define-glue glue-quicktime-movie-open-read : _string -> _pointer)
(define-glue glue-quicktime-movie-get-duration : _pointer -> _int32)
(define-glue glue-quicktime-movie-set-current-time : _pointer _int32 _int32 -> _void)
(define-glue glue-quicktime-movie-get-current-frame : _pointer -> _pointer)
(define-glue glue-quicktime-movie-add-frame : _pointer _pointer _int32 _int32 -> _void)
(define-glue glue-quicktime-movie-write : _pointer -> _void)
(define-glue glue-quicktime-movie-add-frame-current : _pointer _int32 _int32 -> _void)
(define-glue glue-quicktime-movie-export-mp4-264 : _pointer _string -> _void)

Racket [Scheme] / Cocoa Glue

I’ve been working on some video apps in Racket on my Mac, but I want to use some of the OSX features like Core Image Filters and QTKit. Racket has really good foreign function interface to both C and Objective-C, but a few things fall through the cracks. For example, it does not seem possible to pass a structure on the stack from Racket into Objective-C, which is required for a number of the image and video related APIs. Some other things are just easier to write in Objective-C. So I’ve been working on a library that makes some of these things easier.

My library consists of three pieces. An Objective-C library with a C interface, a Racket FFI interface to that library, and some Racket wrappers around Objective-C to make the interface simpler. Here’s some pieces.

Below is the Objective-C code for the C Interface for some image conversion routines. The most useful piece of this is the conversion routines from CIImage to NSImage and back, which are useful when using the Core Image Filters.

extern int glue_image_width( NSImage * img )
   return [img size].width;

extern int glue_image_height( NSImage * img )
   return [img size].height;

extern GLuint glue_NSBitmapImageRep_to_texture( NSBitmapImageRep * rep )
   GLuint targetTexture;
   glGenTextures( 1, &targetTexture );
   int width            = [rep pixelsWide];
   int height           = [rep pixelsHigh];
   GLenum format        = [rep hasAlpha] ? GL_RGBA : GL_RGB;
   int numPixelsInRow   = [rep bytesPerRow] / ([rep bitsPerPixel] >> 3);
   glBindTexture( target, targetTexture );
   glPixelStorei(GL_UNPACK_ROW_LENGTH, numPixelsInRow); 
   glTexImage2D( target, 0, GL_RGBA, width, height, 0, format, GL_UNSIGNED_BYTE, [rep bitmapData] );
   glTexParameterf( target, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
   glTexParameterf( target, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
   glPixelStorei(GL_UNPACK_ROW_LENGTH, 0);
   return targetTexture;

extern NSBitmapImageRep * glue_NSImage_to_NSBitmapImageRep( NSImage * img )
   return [NSBitmapImageRep imageRepWithData: [img TIFFRepresentation]];

extern CIImage * glue_NSImage_to_CIImage( NSImage * ns )
   NSBitmapImageRep * rep = glue_NSImage_to_NSBitmapImageRep( ns );

   return [[[CIImage alloc]
            initWithBitmapImageRep: rep] autorelease];

extern NSImage * glue_CIImage_to_NSImage( CIImage * ci )
   int width   = [ci extent].size.width;
   int height  = [ci extent].size.height;

   NSImage * img = [[[NSImage alloc] initWithSize: NSMakeSize(width,height)] autorelease];
   [img lockFocus];
   [[[NSGraphicsContext currentContext] CIContext]
    drawImage: ci 
    atPoint: CGPointMake( 0,0 )
    fromRect: [ci extent]];
   [img unlockFocus];
   return img;

The Racket FFI definitions for the above functions:

(provide (all-defined-out))

(require ffi/unsafe)
(require ffi/unsafe/define)
(define glue-lib (ffi-lib "./cocoa-glue/build/Debug/cocoa-glue"))

(define-syntax define-glue
  (syntax-rules (:)
    [(_ name : type ...)
     (define name
        (regexp-replaces 'name '((#rx"-" "_")))
        glue-lib (_fun type ...)))]))

(define-glue glue-image-width : _pointer -> _int32)
(define-glue glue-image-height : _pointer -> _int32)
(define-glue glue-CIImage-to-NSImage : _pointer -> _pointer)
(define-glue glue-NSImage-to-CIImage : _pointer -> _pointer)
(define-glue glue-NSBitmapImageRep-to-texture : _pointer -> _uint32)
(define-glue glue-NSImage-to-NSBitmapImageRep : _pointer -> _pointer)