inline static HaskellObj gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value) { switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INTERFACE: if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) return rts_mkPtr(cap, g_value_get_object(value)); else break; case G_TYPE_CHAR: return rts_mkChar(cap, g_value_get_char(value)); case G_TYPE_UCHAR: return rts_mkChar(cap, g_value_get_uchar(value)); case G_TYPE_BOOLEAN: return rts_mkBool(cap, g_value_get_boolean(value)); case G_TYPE_INT: return rts_mkInt(cap, g_value_get_int(value)); case G_TYPE_UINT: return rts_mkWord(cap, g_value_get_uint(value)); case G_TYPE_LONG: return rts_mkInt(cap, g_value_get_long(value)); case G_TYPE_ULONG: return rts_mkWord(cap, g_value_get_ulong(value)); /* case G_TYPE_INT64: return rts_mkInt64(cap, g_value_get_int64(value)); case G_TYPE_UINT64: return rts_mkWord64(cap, g_value_get_uint64(value)); */ case G_TYPE_ENUM: return rts_mkInt(cap, g_value_get_enum(value)); case G_TYPE_FLAGS: return rts_mkWord(cap, g_value_get_enum(value)); case G_TYPE_FLOAT: return rts_mkFloat(cap, g_value_get_float(value)); case G_TYPE_DOUBLE: return rts_mkDouble(cap, g_value_get_double(value)); case G_TYPE_STRING: return rts_mkPtr(cap, (char *)g_value_get_string(value)); /* CHECKME: is the string freed? */ case G_TYPE_POINTER: return rts_mkPtr(cap, g_value_get_pointer(value)); case G_TYPE_BOXED: return rts_mkPtr(cap, g_value_get_boxed(value)); /* case G_TYPE_PARAM: return g_value_get_param(value); */ case G_TYPE_OBJECT: return rts_mkPtr(cap, g_value_get_object(value)); } g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n" "please report this as a bug to [email protected]", g_type_name(G_VALUE_TYPE(value))); }
static HaskellObj #ifdef GHC_RTS_USES_CAPABILITY gtk2hs_value_as_haskellobj(Capability *cap, const GValue *value) { #else gtk2hs_value_as_haskellobj(const GValue *value) { #endif switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INTERFACE: if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) return rts_mkPtr(CAP g_value_get_object(value)); else break; case G_TYPE_CHAR: return rts_mkChar(CAP g_value_get_schar(value)); case G_TYPE_UCHAR: return rts_mkChar(CAP g_value_get_uchar(value)); case G_TYPE_BOOLEAN: return rts_mkBool(CAP g_value_get_boolean(value)); case G_TYPE_INT: return rts_mkInt(CAP g_value_get_int(value)); case G_TYPE_UINT: return rts_mkWord(CAP g_value_get_uint(value)); case G_TYPE_LONG: return rts_mkInt(CAP g_value_get_long(value)); case G_TYPE_ULONG: return rts_mkWord(CAP g_value_get_ulong(value)); /* case G_TYPE_INT64: return rts_mkInt64(CAP g_value_get_int64(value)); case G_TYPE_UINT64: return rts_mkWord64(CAP g_value_get_uint64(value)); */ case G_TYPE_ENUM: return rts_mkInt(CAP g_value_get_enum(value)); case G_TYPE_FLAGS: return rts_mkWord(CAP g_value_get_enum(value)); case G_TYPE_FLOAT: return rts_mkFloat(CAP g_value_get_float(value)); case G_TYPE_DOUBLE: return rts_mkDouble(CAP g_value_get_double(value)); case G_TYPE_STRING: return rts_mkPtr(CAP (char *)g_value_get_string(value)); /* CHECKME: is the string freed? */ case G_TYPE_POINTER: return rts_mkPtr(CAP g_value_get_pointer(value)); case G_TYPE_BOXED: return rts_mkPtr(CAP g_value_get_boxed(value)); case G_TYPE_PARAM: return rts_mkPtr(CAP g_value_get_param(value)); case G_TYPE_OBJECT: return rts_mkPtr(CAP g_value_get_object(value)); } g_error("gtk2hs_value_as_haskellobj: unable to handle GValue with type %s\n" "please report this as a bug to [email protected]", g_type_name(G_VALUE_TYPE(value))); } void gtk2hs_value_from_haskellobj(GValue *value, HaskellObj obj) { switch (G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value))) { case G_TYPE_INVALID: case G_TYPE_NONE: return; case G_TYPE_INTERFACE: /* we only handle interface types that have a GObject prereq */ if (g_type_is_a(G_VALUE_TYPE(value), G_TYPE_OBJECT)) { g_value_set_object(value, rts_getPtr(obj)); } else { break; } return; case G_TYPE_CHAR: g_value_set_schar(value, rts_getChar(obj)); return; case G_TYPE_UCHAR: g_value_set_schar(value, rts_getChar(obj)); return; case G_TYPE_BOOLEAN: g_value_set_boolean(value, rts_getBool(obj)); return; case G_TYPE_INT: g_value_set_int(value, rts_getInt(obj)); return; case G_TYPE_UINT: g_value_set_uint(value, rts_getWord(obj)); return; case G_TYPE_LONG: g_value_set_long(value, rts_getInt(obj)); return; case G_TYPE_ULONG: g_value_set_ulong(value, rts_getWord(obj)); return; /* case G_TYPE_INT64: g_value_set_int64(value, rts_getInt64(obj)); return; case G_TYPE_UINT64: g_value_set_uint64(value, rts_getWord64(obj)); return; */ case G_TYPE_ENUM: g_value_set_enum(value, rts_getInt(obj)); return; case G_TYPE_FLAGS: g_value_set_flags(value, rts_getInt(obj)); return; case G_TYPE_FLOAT: g_value_set_float(value, rts_getFloat(obj)); return; case G_TYPE_DOUBLE: g_value_set_double(value, rts_getDouble(obj)); return; case G_TYPE_STRING: g_value_set_string(value, rts_getPtr(obj)); return; case G_TYPE_POINTER: g_value_set_pointer(value, rts_getPtr(obj)); return; /* case G_TYPE_BOXED: { g_value_set_boxed(value, obj); break; } case G_TYPE_PARAM: g_value_set_param(value, (obj)); break; */ case G_TYPE_OBJECT: g_value_set_object(value, rts_getPtr(obj)); return; } g_error("gtk2hs_value_from_haskellobj: unable to handle GValue with type %s\n" "please report this as a bug to [email protected]", g_type_name(G_VALUE_TYPE(value))); }