; 1. Compile obj-support.m with
;   gcc -g -framework Foundation -framework Cocoa -dynamiclib -o objc-support.dylib -fvisibility=default  objc-support.m 
; 2. Run
;      mzscheme -t objc.scm

#lang scheme

(provide (all-defined-out))

(require scheme/foreign
	 mzlib/etc
	 (only-in '#%foreign ffi-call ffi-obj))
(unsafe!)

(display "Loading objc-support.dylib...\n")
(flush-output)

(define lib 
  (parameterize ([current-directory (this-expression-source-directory)])
	       (ffi-lib "objc-support.dylib")))

(cond [lib (display "objc-support.dylib successfully loaded.\n")
           (flush-output)]
      [else (display "FAILED: Unable to load objc-support.dylib \n")
	    (flush-output)
	    (exit)])

; Define Scheme structs to hold values returned from the ObjC-runtime

(define-struct objc:instance (ptr))
(define-struct objc:class (ptr))
(define-struct objc:selector (ptr))
(define-struct objc:signature (ptr))

(define _instance  (make-ctype _pointer objc:instance-ptr make-objc:instance)) 
(define _class     (make-ctype _pointer objc:class-ptr make-objc:class)) 
(define _selector  (make-ctype _pointer objc:selector-ptr make-objc:selector)) 
(define _signature (make-ctype _pointer objc:signature-ptr make-objc:signature)) 

(define _instance_or_class 
  (make-ctype _pointer 
	      (lambda (x)
		(cond [(objc:class? x)     (objc:class-ptr x)]
		      [(objc:instance? x)  (objc:instance-ptr x)]
		      [else (error '_instance_or_class "got: ~a" x)]))
	      error))

(define _something 
  (make-ctype _pointer 
	      (lambda (x)
		(cond [(objc:class? x)     (objc:class-ptr x)]
		      [(objc:instance? x)  (objc:instance-ptr x)]
		      [(objc:selector? x)  (objc:selector-ptr x)]
		      [(objc:signature? x) (objc:signature-ptr x)]
				       [else (error '_somehing "got: ~a" x)]))
	      error))

; Get the support functions in objc-support.m

(define objc-description      (get-ffi-obj "objc_description" lib      (_fun _instance_or_class -> _string)))
(define string->class         (get-ffi-obj "string_to_class" lib       (_fun _string -> _class)))
(define string->selector      (get-ffi-obj "string_to_selector" lib    (_fun _string -> _selector)))
(define selector-chars        (get-ffi-obj "selector_chars" lib        (_fun _selector -> _string)))
(define raw:selector->signature   (get-ffi-obj "selector_to_signature" lib (_fun _instance_or_class _selector _bool -> _signature)))
(define method-return-type    (get-ffi-obj "method_return_type" lib    (_fun _signature -> _string)))
(define method-argument-count (get-ffi-obj "method_argument_count" lib (_fun _signature -> _int)))
(define method-argument-type  (get-ffi-obj "method_argument_type" lib  (_fun _signature _int -> _string)))
(define make-nsstring         (get-ffi-obj "make_nsstring" lib 	       (_fun _string -> _instance)))
(define is-nsstring?          (get-ffi-obj "is_nsstring" lib           (_fun _instance -> _bool)))
(define objc-release          (get-ffi-obj "objc_release" lib 	       (_fun _something -> _void)))
;; Cocoa
(define objc-application-main (get-ffi-obj "objc_NSApplicationMain" lib       (_fun -> _int)))

;; Make signatures easier to work with

(define (selector->signature ic s)
  (raw:selector->signature ic s (objc:class? ic)))

(define (method-signature o sel)
  (let ([sig (selector->signature o sel)])
    (and sig
	 (let ([n (method-argument-count sig)])
	   (begin0
	    (if (<= n 2)
		(list (method-return-type sig))
		(cons (method-return-type sig)
		      (map (lambda (j) (method-argument-type sig (+ j 2)))
			   (build-list (- n 2) values))))
	    (objc-release sig))))))

; for debugging... 
(define (print-objc o)
  (let ([d (objc-description o)])
    (display
     (cond 
      [(and (objc:instance? o) (is-nsstring? o)) d]
      [(objc:instance? o)   (format "#<objc-instance ~a>" d)]
      [(objc:class? o)      (format "#<objc-class ~a>"    d)]
      [(objc:selector? o)   (format "#<objc-selector ~a>" d)]
      [(objc:signature? o)  (format "#<objc-signature ~a>" d)]
      [else (error 'objc:print "huh")]))))

; Initialize the autorelase allocation pool 
; (otherwise we will get "leaking" errors)

(define objc-allocate-autorelease-pool (get-ffi-obj "objc_allocate_autorelease_pool" lib (_fun -> _void)))
(objc-allocate-autorelease-pool)

; Before calling a method one must use method-return-type to find
; out the return type of the method. The return type is represented
; as a string. The function return-type below converts the string representation
; into the ctypes used by PLT's foreign function interface.
; (For now only simple types, instances, classes, and selectors are supported)

(define (return-type ot)
  ; Table 12-1 page 123 in the Objective C v2 reference
  ; TODO:  #\q  = long long
  ;               [array type]
  ;               {name=type ...}   ; structure
  ;               (name=type,...)   ; union
  ;               bnum              ; A bit field of num bits
  ;               ^type             ; A pointer to type
  ;               ?                 ; An unknown type (e.g. function pointers)
  (let loop ([i 0])
    (case (string-ref ot i)
      [(#\c) _int]  ; signed char
      [(#\v) _void]
      [(#\s #\i #\l #\C #\I #\S #\L) _int]
      [(#\f) _float]
      [(#\d) _double]
      [(#\*) _string]
      [(#\@) _instance]
      [(#\#) _class]
      [(#\:) _selector]
      [(#\^) _pointer]  ; TODO ?
      ; these encode  const, in, inout, out, bycopy, byref, and oneway respectively
      [(#\r #\n #\N #\o #\O #\R #\V) (loop (+ i 1))]
      [else (error 'return-type "got: ~a" ot)])))

; We need the same conversion for function arguments...
(define in-type return-type)


; The heart:
;            obj-send calls the method of obj given by the selector.
;            Since the arguments and return type depend of obj-send
;            depend on the method in question, ffi-call is used
;            to construct new Scheme representations of objc_msgSend
;            each time it is called (TODO: These values could 
;            be cached to improve performance)

(define obj-send 
  ;; NOTE: The value constructed by ffi-call could be stored in a cache
  (let ([msg-send (ffi-obj #"objc_msgSend" lib)])
    (lambda (obj sel . args)
      (let* ([sel (if (symbol? sel) (string->selector (symbol->string sel)) sel)]
	     [sig (selector->signature obj sel)]
	     [out-type (return-type (method-return-type sig))])
	(apply (ffi-call msg-send 
			 (append (list _something _selector) 
				 (map in-type (cdr (method-signature obj sel))))
			 out-type)
	       obj sel args)))))

;;; TEST

;; TEST1
;(display (obj-send (make-nsstring "Fooz") 'length))
;(newline)

;; TEST2
;(display (method-signature (make-nsstring "Fooz") 
;	 		    (string->selector "characterAtIndex:")))
;(newline)

;; TEST3
;(display (integer->char 
;	  (obj-send (make-nsstring "abcde") (string->selector "characterAtIndex:") 2)))
;(newline)


;; THE PROBLEM

; The return value of objc-application-main returns 0,
; which indicate the bundle was not loaded. Why, oh why?
(display "Bundle loaded?: ")
(display (objc-application-main))   
(newline)

(display "Press enter to stop.\n")
(flush-output)
(read-line)

(exit)