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

Last change on this file since 14900 was 14900, checked in by Alex Shinn, 12 years ago

forgot a file

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