source: project/release/4/objc/trunk/convert.scm @ 14899

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

initial conversion, not yet working

File size: 11.8 KB
Line 
1;;; type conversion
2
3;; Objective C type signature definitions.
4(define objc:ID  "@")  ;; Should probably use @encode for these.
5(define objc:SEL ":")
6(define objc:INT "i")
7(define objc:DBL "d")
8(define objc:FLT "f")
9(define objc:CHR "c")
10(define objc:PTR "^")
11(define objc:SHT "s")
12(define objc:LNG "l")
13(define objc:USHT "S")
14(define objc:UINT "I")
15(define objc:UCHR "C")
16(define objc:BOOL "c")
17(define objc:ULNG "L")
18(define objc:VOID "v")
19(define objc:CLASS "#")
20(define objc:CHARPTR "*")  ;; hmm
21(define objc:NSRECT  (foreign-value "@encode(NSRect)"  c-string))
22(define objc:NSPOINT (foreign-value "@encode(NSPoint)" c-string))
23(define objc:NSSIZE  (foreign-value "@encode(NSSize)"  c-string))
24(define objc:NSRANGE (foreign-value "@encode(NSRange)" c-string))
25
26;;; Convert Objective C references to Scheme objects.
27
28(define-syntax define-result-conversion
29  (er-macro-transformer
30   (lambda (expr rename compare)
31     (let ((name (cadr expr))
32           (from (caddr expr))
33           (to (cadddr expr)))
34       `(,(rename 'define) ,name
35         (,(rename 'foreign-lambda*) ,to
36          (((pointer ,from) obj)) "return(*obj);"))))))
37
38(define-result-conversion ref->float  float   "float")
39(define-result-conversion ref->double double  "double")
40(define-result-conversion ref->int    integer "int")
41(define-result-conversion ref->short  short   "short")
42(define-result-conversion ref->long   long    "long")
43(define-result-conversion ref->char   char    "char")
44(define-result-conversion ref->uint   unsigned-integer "unsigned int")
45(define-result-conversion ref->ushort unsigned-short   "unsigned short")
46(define-result-conversion ref->ulong  unsigned-long    "unsigned long")
47(define-result-conversion ref->uchar  unsigned-char    "unsigned char")
48(define-result-conversion ref->ptr    c-pointer "void *")
49(define-result-conversion ref->string c-string  "void *")
50
51(define ref->void noop)
52
53(define (objc:ref->class ref)
54  (objc:pointer->class (ref->ptr ref)))
55
56(define (objc:ref->instance ref)
57  (objc:pointer->instance (ref->ptr ref)))     ;; retains object
58
59(define (objc:ref->char-or-bool ref)
60  (objc:char->char-or-bool (ref->char ref)))
61
62(define (objc:char->char-or-bool c)
63  (if (eqv? c #\nul) #f c))
64
65;; This is not correct, we should convert to a selector object
66;; which can be stringified if desired.
67(define objc:ref->selector ref->string)
68(define (objc:selector->ref sel buf)
69  (ptr->ref (string->selector sel) buf))
70
71;;;; Reference to structures: NSRect, NSPoint, NSSize
72
73;;;;; Manipulation of C structures
74;; It would be cheaper to have a C function fill the record in one shot.  These are
75;; only used "during the making of".
76(define NSRect-x (foreign-lambda* float (((pointer "NSRect") rect)) "return(rect->origin.x);"))
77(define NSRect-y (foreign-lambda* float (((pointer "NSRect") rect)) "return(rect->origin.y);"))
78(define NSRect-width  (foreign-lambda* float (((pointer "NSRect") rect)) "return(rect->size.width);"))
79(define NSRect-height (foreign-lambda* float (((pointer "NSRect") rect)) "return(rect->size.height);"))
80(define NSRect-x-set! (foreign-lambda* void (((pointer "NSRect") rect) (float val))
81                                       "rect->origin.x = val;"))
82(define NSRect-y-set! (foreign-lambda* float (((pointer "NSRect") rect) (float val))
83                                       "rect->origin.y = val;"))
84(define NSRect-width-set!
85  (foreign-lambda* float (((pointer "NSRect") rect) (float val)) "rect->size.width = val;"))
86(define NSRect-height-set!
87  (foreign-lambda* float (((pointer "NSRect") rect) (float val)) "rect->size.height = val;"))
88
89(define-foreign-record-type (NSPoint "NSPoint")
90  (float x NSPoint-x NSPoint-x-set!)
91  (float y NSPoint-y NSPoint-y-set!))
92(define-foreign-record-type (NSSize "NSSize")
93  (float width NSSize-width NSSize-width-set!)
94  (float height NSSize-height NSSize-height-set!))
95(define-foreign-record-type (NSRange "NSRange")
96  (unsigned-int location NSRange-location NSRange-location-set!)
97  (unsigned-int length NSRange-length NSRange-length-set!))
98
99;;;;; Scheme record counterparts to C structs
100
101(define-record-type ns:rect
102  (make-ns:rect x y width height)
103  ns:rect?
104  (x ns:rect-x ns:rect-x-set!)
105  (y ns:rect-y ns:rect-y-set!)
106  (width ns:rect-width ns:rect-width-set!)
107  (height ns:rect-height ns:rect-height-set!))
108
109(define-record-type ns:point
110  (make-ns:point x y)
111  ns:point?
112  (x ns:point-x ns:point-x-set!)
113  (y ns:point-y ns:point-y-set!))
114
115(define-record-type ns:size
116  (make-ns:size width height)
117  ns:size?
118  (width ns:size-width ns:size-width-set!)
119  (height ns:size-height ns:size-height-set!))
120
121(define-record-type ns:range
122  (make-ns:range location length)
123  ns:range?
124  (location ns:range-location ns:range-location-set!)
125  (length ns:range-length ns:range-length-set!))
126
127(define-record-printer (ns:rect r port)
128  (fprintf port "#<ns:rect origin: (~a ~a) size: (~a ~a)>"
129           (ns:rect-x r) (ns:rect-y r)
130           (ns:rect-width r) (ns:rect-height r)))
131(define-record-printer (ns:point p port)
132  (fprintf port "#<ns:point x: ~a y: ~a>" (ns:point-x p) (ns:point-y p)))
133(define-record-printer (ns:size s port)
134  (fprintf port "#<ns:size w: ~a h: ~a>" (ns:size-width s)
135                                         (ns:size-height s)))
136(define-record-printer (ns:range r port)
137  (fprintf port "#<ns:range location: ~a length: ~a>" (ns:range-location r) (ns:range-length r)))
138
139;; Constructor aliases.
140(define ns:make-rect  make-ns:rect)
141(define ns:make-point make-ns:point)
142(define ns:make-size  make-ns:size)
143(define ns:make-range make-ns:range)
144
145
146;;;;; Ref->structure converters
147(define (ref->ns:rect ref)
148  (ns:make-rect (NSRect-x ref)
149               (NSRect-y ref)
150               (NSRect-width ref)
151               (NSRect-height ref)))
152(define (ref->ns:point ref)
153  (ns:make-point (NSPoint-x ref)
154                (NSPoint-y ref)))
155(define (ref->ns:size ref)
156  (ns:make-size (NSSize-width ref)
157               (NSSize-height ref)))
158(define (ref->ns:range ref)
159  (ns:make-range (NSRange-location ref)
160                (NSRange-length ref)))
161
162;; Return the proper ref->structure conversion function based on type signature.
163(define ref->struct
164  (let ((struct-table (alist->hash-table `((,objc:NSRECT  . ,ref->ns:rect)
165                                           (,objc:NSPOINT . ,ref->ns:point)
166                                           (,objc:NSRANGE . ,ref->ns:range)
167                                           (,objc:NSSIZE  . ,ref->ns:size))
168                                         string=?)))
169    (lambda (type-signature)
170      (hash-table-ref struct-table type-signature
171                      (lambda ()
172                        (error 'result-converter
173                               "can not convert structure type" type-signature))))))
174
175;;;; Master result converter
176(define (result-converter method-signature)
177  (let loop ((i 0))
178    (case (string-ref method-signature i)
179      ((#\v) ref->void)
180      ((#\s) ref->short)
181      ((#\i) ref->int)
182      ((#\l) ref->long)
183      ((#\C) ref->uchar)
184      ((#\I) ref->uint)
185      ((#\S) ref->ushort)
186      ((#\L) ref->ulong)
187      ((#\f) ref->float)
188      ((#\d) ref->double)
189      ((#\*) ref->string)
190      ((#\^) ref->ptr)
191      ((#\c) objc:ref->char-or-bool)
192      ((#\@) objc:ref->instance)
193      ((#\#) objc:ref->class)
194      ((#\:) objc:ref->selector)
195      ((#\{) (ref->struct method-signature))
196      ((#\r #\n #\N #\R #\V #\o #\O) (loop (fx+ i 1)))  ;; const etc. prefix modifiers
197      (else (error 'result-converter "can not convert result type" method-signature)))))
198
199(define (objc:ref->scheme-object ptr type)
200  ((result-converter type) ptr))
201     
202;;; Convert Scheme objects to Objective C references.
203
204;; These take c-pointers as their second (destination buffer) argument,
205;; so use make-locative when you need to put the result in a byte-vector.
206
207(define-syntax define-arg-conversion
208  (er-macro-transformer
209   (lambda (expr rename compare)
210     (let ((name (cadr expr))
211           (from (caddr expr))
212           (to (cadddr expr)))
213       `(define ,name
214          (foreign-lambda* c-pointer ((,from val) ((pointer ,to) buf))
215            "*buf = val; return(buf);"))))))
216
217(define-arg-conversion int->ref    integer "int")
218(define-arg-conversion float->ref  float   "float")
219(define-arg-conversion double->ref double  "double")
220(define-arg-conversion short->ref  short   "short")
221(define-arg-conversion long->ref   long    "long")
222(define-arg-conversion char->ref   char    "char")
223(define-arg-conversion uint->ref   unsigned-integer "unsigned int")
224(define-arg-conversion ushort->ref unsigned-short   "unsigned short")
225(define-arg-conversion ulong->ref  unsigned-long    "unsigned long")
226(define-arg-conversion uchar->ref  unsigned-char    "unsigned char")
227(define-arg-conversion ptr->ref    c-pointer "void *")
228; (define-arg-conversion string->ref c-string  "void *")  ;; Disabled--need permanent storage space
229;                                                         ;; for lifetime of ref.
230(define (string->ref str buf) (error 'string->ref "conversion to char * unimplemented"))
231
232(define (void->ref obj buf) buf)
233 
234(define (objc:class->ref c buf)
235  (ptr->ref (objc:class->pointer c) buf))
236
237
238;; (Auto-convert strings to NSStrings when ID is expected.)
239;; (Convert #f to nil, implicitly done in ptr->ref.)
240(define (objc:instance->ref o buf)
241  (let ((ptr (objc:instance->pointer
242              (if (string? o) (objc:nsstring o) o))))
243    (if ptr
244        (retain-and-autorelease ptr))   ;; The GC might destroy the corresponding Scheme object.
245    (ptr->ref ptr buf)))
246
247(define (objc:char-or-bool->ref c buf)
248  (char->ref (objc:char-or-bool->char c) buf))
249
250(define (objc:char-or-bool->char c)
251  (case c
252    ((#f) #\nul)
253    ((#t) #\x1)
254    (else c)))
255
256;;;; Structure to reference converters.
257
258(define (ns:rect->ref r buf)
259  (NSRect-x-set! buf (ns:rect-x r))
260  (NSRect-y-set! buf (ns:rect-y r))
261  (NSRect-width-set! buf (ns:rect-width r))
262  (NSRect-height-set! buf  (ns:rect-height r))
263  buf)
264(define (ns:point->ref p buf)
265  (NSPoint-x-set! buf (ns:point-x p))
266  (NSPoint-y-set! buf (ns:point-y p))
267  buf)
268(define (ns:size->ref s buf)
269  (NSSize-width-set! buf (ns:size-width s))
270  (NSSize-height-set! buf (ns:size-height s))
271  buf)
272(define (ns:range->ref r buf)
273  (NSRange-location-set! buf (ns:range-location r))
274  (NSRange-length-set! buf (ns:range-length r))
275  buf)
276
277;; Return the proper ref->structure conversion function based on type signature.
278(define struct->ref
279  (let ((struct-table (alist->hash-table `((,objc:NSRECT  . ,ns:rect->ref)
280                                           (,objc:NSPOINT . ,ns:point->ref)
281                                           (,objc:NSRANGE . ,ns:range->ref)
282                                           (,objc:NSSIZE  . ,ns:size->ref))
283                                         string=?)))
284    (lambda (type-signature)
285      (hash-table-ref struct-table type-signature
286                      (lambda ()
287                        (error 'arg-converter
288                               "can not convert structure type" type-signature))))))
289
290
291;;;; Master argument converter
292
293(define (arg-converter method-signature)
294  (let loop ((i 0))
295    (case (string-ref method-signature i)
296      ((#\v) void->ref)
297      ((#\s) short->ref)
298      ((#\i) int->ref)
299      ((#\l) long->ref)
300      ((#\C) uchar->ref)
301      ((#\I) uint->ref)
302      ((#\S) ushort->ref)
303      ((#\L) ulong->ref)
304      ((#\f) float->ref)
305      ((#\d) double->ref)
306      ((#\*) string->ref)   ; disabled above
307;     ((#\^) ptr->ref)     ; suspicious: could be return by reference (void**)
308                           ; or pass by reference (void *)
309      ((#\c) objc:char-or-bool->ref)
310      ((#\@) objc:instance->ref)
311      ((#\#) objc:class->ref)
312      ((#\:) objc:selector->ref)
313      ((#\{) (struct->ref method-signature)) 
314      ((#\r #\n #\N #\R #\V #\o #\O) (loop (fx+ i 1)))  ;; const etc. prefix modifiers
315      (else (error 'arg-converter "can not convert argument type" method-signature)))))
316
317;; buf-ptr should be a c-pointer (locative), not a container
318(define (objc:scheme-object->ref obj type buf-ptr)
319  ((arg-converter type) obj buf-ptr))
Note: See TracBrowser for help on using the repository browser.