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

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

objc: compiles now

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