> By the way, should I continue to post some new versions
? Are you
> interested by this module ?
I have a suggestion.
You can declare the Color, Point, etc. classes as either
this:
Object variable: #float subclass: #Color
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: ''!
Then, override new to be "^self basicNew: N" where
N is the number of
instance variables, and then add methods like
red
^self at: 1
red: aFloat
self at: 1 put: aFloat
and so on.
(The same works for #double; you can also have an abstract
class
defining all these methods, and concrete classes for each
type).
Then, apply the attached patch. With it, you have a new way
to pass
arguments to C functions, #array, and if you have defined
the classes as
above, this new way maps naturally to the sole argument of
functions
like glColor3fv:
glColor3fv: color
<cCall: 'glColor3fv' returning: #void args:
#(#array)>!
This is also stored way way more efficiently.
Paolo
* local directory is at bonzini gnu.org--2004b/smalltalk--devo--2.2--patch-202
* comparing to bonzini gnu.org--2004b/smalltalk--devo--2.2--patch-202
M ./doc/gst.texi
M ./libgst/cint.c
M ./libgst/sym.c
M ./libgst/sym.h
* modified files
--- orig/doc/gst.texi
+++ mod/doc/gst.texi
 -2742,6
+2742,12  C object value passed as code{void *}
Pointer to C object value passed as code{void **}. The code
is modified on output to reflect the value stored into the
passed object.
+ item array
+The Smalltalk object must be of an indexable class; the
pointer to the
+first indexed instance variable is passed. The pointer
might move
+upon garbage collection, so the object must either be
fixed,
+or the called C routine should not call back to Smalltalk.
+
item smalltalk
Pass the object pointer to C. The C routine should treat
the value as a
pointer to anonymous storage. This pointer can be returned
to Smalltalk
 -2767,6
+2773,7  Table of parameter conversions:
multitable {Declared param type} {Boolean (True,
False)} { code (C promotion rule)}
item Declared param type tab Object type
tab
C parameter type used
+ item array tab any indexable class
tab
void *
item boolean tab Boolean (True,
False) tab int
item byteArray tab ByteArray
tab
char *
item cObject tab CObject
tab
void *
--- orig/libgst/cint.c
+++ mod/libgst/cint.c
 -93,7
+93,8  typedef enum
CDATA_WCHAR,
CDATA_WSTRING,
CDATA_WSTRING_OUT,
- CDATA_SYMBOL_OUT
+ CDATA_SYMBOL_OUT,
+ CDATA_ARRAY /* pass pointer to base for indexable
objects */
}
cdata_type;
 -205,6
+206,9  static void init_dld (void);
PTR dld_open (const char *filename);
/* Callout to tests callins. */
+static void test_array (int *oopData);
+
+/* Callout to tests callins. */
static void test_callin (OOP oop);
/* Callout to test the CString class */
 -273,6
+277,7  static const char *c_type_name[] = {
"wchar_t", /* CDATA_WCHAR */
"wchar_t *", /* CDATA_WSTRING */
"wchar_t *", /* CDATA_WSTRING_OUT */
+ "void *", /* CDATA_ARRAY */
};
/* A map between symbols and the cdata_type enum. */
 -304,6
+309,7  static const symbol_type_map type_map[]
{&_gst_wchar_symbol, CDATA_WCHAR},
{&_gst_wstring_symbol, CDATA_WSTRING},
{&_gst_wstring_out_symbol, CDATA_WSTRING_OUT},
+ {&_gst_array_symbol, CDATA_ARRAY},
{NULL, CDATA_UNKNOWN}
};
 -429,6
+435,13  my_opendir (const char *dir)
}
void
+test_array (int *data)
+{
+ while (*data != -1)
+ printf ("%d ", *data++);
+}
+
+void
test_callin (OOP oop)
{
OOP o, sel;
 -526,6
+539,7  _gst_init_cfuncs (void)
_gst_define_cfunc ("getArgv", get_argv);
/* Test functions */
+ _gst_define_cfunc ("testArray", test_array);
_gst_define_cfunc ("testCallin", test_callin);
_gst_define_cfunc ("testCString",
test_cstring);
_gst_define_cfunc ("testCObjectPtr",
test_cobject_ptr);
 -760,6
+774,7  get_ffi_type (OOP returnTypeOOP)
switch (TO_INT (returnTypeOOP))
{
case CDATA_OOP:
+ case CDATA_ARRAY:
case CDATA_COBJECT:
case CDATA_COBJECT_PTR:
case CDATA_SYMBOL:
 -828,12
+843,12  push_smalltalk_obj (OOP oop,
oop == _gst_nil_oop ? CDATA_COBJECT :
class == _gst_char_class ? CDATA_CHAR :
class == _gst_unicode_character_class ? CDATA_WCHAR :
- class == _gst_byte_array_class ? CDATA_BYTEARRAY :
is_a_kind_of (class, _gst_integer_class) ? CDATA_LONG :
- is_a_kind_of (class, _gst_string_class) ? CDATA_STRING :
- is_a_kind_of (class, _gst_unicode_string_class) ?
CDATA_WSTRING :
is_a_kind_of (class, _gst_c_object_class) ? CDATA_COBJECT
:
is_a_kind_of (class, _gst_float_class) ? CDATA_DOUBLE :
+ class == _gst_byte_array_class ? CDATA_BYTEARRAY :
+ is_a_kind_of (class, _gst_string_class) ? CDATA_STRING :
+ is_a_kind_of (class, _gst_unicode_string_class) ?
CDATA_WSTRING :
CDATA_OOP;
break;
 -873,6
+888,18  push_smalltalk_obj (OOP oop,
return;
}
+ else if (cType == CDATA_ARRAY)
+ {
+ if (CLASS_IS_INDEXABLE (class))
+ {
+ int first = CLASS_FIXED_FIELDS (class);
+ cp->u.ptrVal = (PTR) &OOP_TO_OBJ
(oop)->data[first];
+ INC_ADD_OOP (oop); /* make sure it doesn't get
gc'd */
+ SET_TYPE (&ffi_type_pointer);
+ return;
+ }
+ }
+
else if (is_a_kind_of (class, _gst_integer_class))
{
switch (cType)
 -1027,7
+1054,6  push_smalltalk_obj (OOP oop,
}
}
-
bad_type (class, cType);
}
--- orig/libgst/sym.c
+++ mod/libgst/sym.c
 -95,6
+95,7  symbol_info;
OOP _gst_and_symbol = NULL;
+OOP _gst_array_symbol = NULL;
OOP _gst_as_scaled_decimal_scale_symbol = NULL;
OOP _gst_at_put_symbol = NULL;
OOP _gst_at_symbol = NULL;
 -278,6
+279,7  static scope cur_scope = NULL;
and is used to restore the global variables upon image
load. */
static const symbol_info sym_info[] = {
{&_gst_and_symbol, "and:"},
+ {&_gst_array_symbol, "array"},
{&_gst_as_scaled_decimal_scale_symbol,
"asScaledDecimal:scale:"},
{&_gst_at_put_symbol, "at:put:"},
{&_gst_at_symbol, "at:"},
--- orig/libgst/sym.h
+++ mod/libgst/sym.h
 -89,6
+89,7  extern int _gst_use_undeclared
ATTRIBUTE_HIDDEN;
extern OOP _gst_and_symbol ATTRIBUTE_HIDDEN;
+extern OOP _gst_array_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_as_scaled_decimal_scale_symbol
ATTRIBUTE_HIDDEN;
extern OOP _gst_at_put_symbol ATTRIBUTE_HIDDEN;
extern OOP _gst_at_symbol ATTRIBUTE_HIDDEN;
_______________________________________________
help-smalltalk mailing list
help-smalltalk gnu.org
http://lists.gnu.org/mailman/listinfo/help-smalltalk
|