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]
                             initWithBitmapDataPlanes:nil
                             pixelsWide: width
                             pixelsHigh: height
                             bitsPerSample:8
                             samplesPerPixel:4
                             hasAlpha:YES
                             isPlanar:NO
                             colorSpaceName:NSCalibratedRGBColorSpace
                             bytesPerRow:0
                             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], 
                                              QTMovieFileNameAttribute,
                                              NO, QTMovieOpenAsyncOKAttribute,
                                              nil]
                         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, 
                                                  glue_get_viewport_NSImage(),
                                                  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);
   
   GLenum target = GL_TEXTURE_RECTANGLE_EXT;
   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
       (get-ffi-obj
        (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)