source: project/release/4/objc/trunk/objc-cocoa.scm @ 17867

Last change on this file since 17867 was 17867, checked in by Jim Ursetto, 11 years ago

objc: compiles now

File size: 3.1 KB
Line 
1;;; objc-cocoa.scm
2
3(require-library lolevel srfi-13)
4
5(module objc-cocoa
6  (ns:application-main ns:beep ns:log ns:rect-fill cocoa:run
7   ns:rect->locative ns:point->locative
8   ns:size->locative ns:range->locative)
9
10(import scheme chicken)
11(import foreign)
12(require-extension extras lolevel objc-base)
13(import-for-syntax (only srfi-13 string-upcase))
14
15#>
16#import <Cocoa/Cocoa.h>
17<#
18
19;;; Wrappers for global functions
20
21;; http://developer.apple.com/documentation/Cocoa/Reference/ApplicationKit/ObjC_classic/Functions/AppKitFunctions.html
22
23(define (ns:application-main)
24  (define NSApplicationMain
25    (foreign-safe-lambda int "NSApplicationMain" int c-pointer))
26  (apply NSApplicationMain (receive (argc+argv))))
27
28(define ns:beep (foreign-lambda void "NSBeep"))
29
30(define (ns:log fstr . args)
31  (define NSLog (foreign-lambda* void ((c-string s))
32                 "NSString *str = [[NSString alloc] initWithUTF8String: s];"
33                 "NSLog(str);"
34                 "[str release];"))
35  (NSLog (apply sprintf fstr args)))
36 
37(define (ns:rect-fill r)
38  (define NSRectFill (foreign-lambda* void (((pointer "NSRect") r))
39                                      "NSRectFill(*r);"))
40  (NSRectFill (ns:rect->locative r)))
41
42;;; Wrappers for enums
43
44;; http://developer.apple.com/documentation/Cocoa/Reference/ApplicationKit/ObjC_classic/TypesAndConstants/AppKitTypes.html
45
46;; None yet.
47
48;;; Debugging
49
50;; Resume the current application.
51(define-objc-classes (cocoa:NSApplication NSApplication))
52(define (cocoa:run)
53    @[ @[ cocoa:NSApplication sharedApplication] run])
54
55
56;;; Conversion of ns:struct types into "locatives" that may be passed to functions
57;;; that require C pointers.  The locative points to a *new* byte vector
58;;; containing a C representation of the type -- not the ns:struct record itself.
59
60;; Note: these are really intended for passing structs by value to global (non-method)
61;; functions.  Passing by reference to a function will work, but any modifications
62;; to the struct will be discarded.
63
64;; Transformation:
65;; (define-ns:struct->locative rect)  =>
66;; (define ns:rect->locative
67;;   (let ((size (objc:sizeof-type objc:NSRECT)))
68;;     (lambda (rect)
69;;       (ns:rect->ref rect (make-locative (make-blob size))))))
70
71(define-syntax define-ns:struct->locative
72  (lambda (e r c)
73    (define (symbol-conc . symbols)
74      (string->symbol (apply conc symbols)))
75    (let* ((type (cadr e))
76           (struct-name (conc "ns:" type))
77           (type-name   (conc "objc:NS"
78                              (string-upcase (->string type))))
79           (size (r 'size))
80           (rect (r 'rect)))
81      `(,(r 'define) ,(symbol-conc struct-name '->locative)
82        (,(r 'let) ((,size
83                          (,(r 'objc:sizeof-type)
84                           ,(string->symbol type-name))))
85         (,(r 'lambda) (,rect)
86          (,(symbol-conc struct-name '->ref)
87           ,rect
88           (,(r 'make-locative)
89            (,(r 'make-blob) ,size)))))))))
90
91;;;; The ns:struct->locative conversions
92
93(define-ns:struct->locative rect)
94(define-ns:struct->locative point)
95(define-ns:struct->locative size)
96(define-ns:struct->locative range)
97
98)
Note: See TracBrowser for help on using the repository browser.