source: project/release/3/objc/trunk/convert.scm @ 9966

Last change on this file since 9966 was 9966, checked in by Kon Lovett, 13 years ago

Using canonical directory structure.

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