;;; objc-cocoa.scm

(module cocoa
  (ns:application-main ns:beep ns:log ns:rect-fill cocoa:run
   ns:rect->locative ns:point->locative
   ns:size->locative ns:range->locative)

(import scheme chicken)
(import foreign)
(require-library srfi-13)
(require-extension extras lolevel objc)
(import-for-syntax (only srfi-13 string-upcase))

#>
#import <Cocoa/Cocoa.h>
<#

;;; Wrappers for global functions

;; http://developer.apple.com/documentation/Cocoa/Reference/ApplicationKit/ObjC_classic/Functions/AppKitFunctions.html

(define (ns:application-main)
  (define NSApplicationMain
    (foreign-safe-lambda int "NSApplicationMain" int c-pointer))
  (apply NSApplicationMain (receive (argc+argv))))

(define ns:beep (foreign-lambda void "NSBeep"))

(define (ns:log fstr . args)
  (define NSLog (foreign-lambda* void ((c-string s))
                 "NSString *str = [[NSString alloc] initWithUTF8String: s];"
		 "NSLog(str);"
		 "[str release];"))
  (NSLog (apply sprintf fstr args)))
  
(define (ns:rect-fill r)
  (define NSRectFill (foreign-lambda* void (((pointer "NSRect") r))
                                      "NSRectFill(*r);"))
  (NSRectFill (ns:rect->locative r)))

;;; Wrappers for enums

;; http://developer.apple.com/documentation/Cocoa/Reference/ApplicationKit/ObjC_classic/TypesAndConstants/AppKitTypes.html

;; None yet.

;;; Debugging

;; Resume the current application.
(define-objc-classes (cocoa:NSApplication NSApplication))
(define (cocoa:run)
    [@ [@ cocoa:NSApplication sharedApplication] run])


;;; Conversion of ns:struct types into "locatives" that may be passed to functions
;;; that require C pointers.  The locative points to a *new* byte vector
;;; containing a C representation of the type -- not the ns:struct record itself.

;; Note: these are really intended for passing structs by value to global (non-method)
;; functions.  Passing by reference to a function will work, but any modifications
;; to the struct will be discarded.

;; Transformation:
;; (define-ns:struct->locative rect)  =>
;; (define ns:rect->locative
;;   (let ((size (objc:sizeof-type objc:NSRECT)))
;;     (lambda (rect)
;;       (ns:rect->ref rect (make-locative (make-blob size))))))

(define-syntax define-ns:struct->locative
  (lambda (e r c)
    (define (symbol-conc . symbols)
      (string->symbol (apply conc symbols)))
    (let* ((type (cadr e))
           (struct-name (conc "ns:" type))
           (type-name   (conc "objc:NS"
                              (string-upcase (->string type))))
           (size (r 'size))
           (rect (r 'rect)))
      `(,(r 'define) ,(symbol-conc struct-name '->locative)
        (,(r 'let) ((,size
                          (,(r 'objc:sizeof-type)
                           ,(string->symbol type-name))))
         (,(r 'lambda) (,rect)
          (,(symbol-conc struct-name '->ref)
           ,rect
           (,(r 'make-locative)
            (,(r 'make-blob) ,size)))))))))

;;;; The ns:struct->locative conversions

(define-ns:struct->locative rect)
(define-ns:struct->locative point)
(define-ns:struct->locative size)
(define-ns:struct->locative range)

)