Yesterday I put together a cover song chain playlist. It’s got some good stuff on it, and as an added bonus, the last song in the playlist is a cover version of the first artist, so it’s a loop. It’s also under 80 minutes so it would fit on a CD.

There are two potentially questionable links. I counted Prince’s version of Nothing Compares 2 U as a cover of Sinead O’Connor’s version even though he wrote it. Also, “Love the One You’re With” is technically a Stephen Stills solo song, but I followed it with a Crosby, Stills and Nash song. I’ve seen CSN in concert and they played it, so I’m going to allow it.

Below is an excerpt of the fireworks show.

#lang racket

(require rackunit
         "cocoa-glue.rkt"
         ffi/unsafe
         ffi/unsafe/objc)

(test-case
 "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))))))

(test-case
 "list->NSArray"
 (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))
     (check-equal?
      string
      (NSString->string
       (NSArray-ref ns-array i))))))

(test-case
 "list->NSArray->list"
 (let ([strings (list "1" "two" "◻◾◻")])
   (check-equal?
    strings
    (map NSString->string
         (NSArray->list
          (list->NSArray
           (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))])
        (check-equal?
         (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)])
  (test-case
   "dictionary->NSDictionary"
   (check-dict/NSDictionary-equiv?
    alist
    (dictionary->NSDictionary alist)))
  (test-case
   "dictionary->NSMutableDictionary"
   (check-dict/NSDictionary-equiv?
    alist
    (dictionary->NSMutableDictionary alist))))

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

cocoa-glue-data-types.rkt:

#lang racket

(provide (all-defined-out))

(require ffi/unsafe
         ffi/unsafe/objc
         ffi/cvector)

(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))
  p)

(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)))
    mutable))

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)