1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
#i_img * T_PTR_NULL
Imager::Color T_PTROBJ
Imager::Color::Float T_PTROBJ
Imager::ImgRaw T_IMAGER_IMAGE
Imager::Font::TT T_PTROBJ
Imager::IO T_PTROBJ
Imager::FillHandle T_PTROBJ
const char * T_PV
im_float T_FLOAT
float* T_ARRAY
undef_int T_IV_U
undef_neg_int T_IV_NEGU
HASH T_HVREF
utf8_str T_UTF8_STR
i_img_dim T_IV_checked
im_double T_NV_checked
# these types are for use by Inline, which can't handle types containing ::
Imager__Color T_PTROBJ_INV
Imager__Color__Float T_PTROBJ_INV
Imager__ImgRaw T_IMAGER_IMAGE
Imager__FillHandle T_PTROBJ_INV
Imager__IO T_PTROBJ_INV
# mostly intended for non-Imager-core use
Imager T_IMAGER_FULL_IMAGE
#############################################################################
INPUT
T_PTR_NULL
if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
else $var = NULL
# handles Imager objects rather than just raw objects
T_IMAGER_IMAGE
if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type,tmp);
}
else if (sv_derived_from($arg, \"Imager\") &&
SvTYPE(SvRV($arg)) == SVt_PVHV) {
HV *hv = (HV *)SvRV($arg);
SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
IV tmp = SvIV((SV*)SvRV(*sv));
$var = INT2PTR($type,tmp);
}
else
Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
}
else
Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
T_IMAGER_FULL_IMAGE
if (sv_derived_from($arg, \"Imager\") &&
SvTYPE(SvRV($arg)) == SVt_PVHV) {
HV *hv = (HV *)SvRV($arg);
SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
IV tmp = SvIV((SV*)SvRV(*sv));
$var = INT2PTR($type,tmp);
}
else
Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
}
else
Perl_croak(aTHX_ \"$var is not of type Imager\");
# same as T_PTROBJ, but replace __ with ::, the opposite of the way
# xsubpp's processing works
# this is to compensate for Inline's problem with type names containing ::
T_PTROBJ_INV
if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = INT2PTR($type,tmp);
}
else
croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
T_NV_checked
{
SvGETMAGIC($arg);
if (SvROK($arg) && !SvAMAGIC($arg)) {
croak(\"Numeric argument '$var' shouldn't be a reference\");
}
else {
$var = ($type)SvNV($arg);
}
}
T_IV_checked
{
SvGETMAGIC($arg);
if (SvROK($arg) && !SvAMAGIC($arg)) {
croak(\"Numeric argument '$var' shouldn't be a reference\");
}
else {
$var = ($type)SvIV($arg);
}
}
#############################################################################
OUTPUT
T_IV_U
if ($var == 0) $arg=&PL_sv_undef;
else sv_setiv($arg, (IV)$var);
T_IV_NEGU
if ($var < 0) $arg=&PL_sv_undef;
else sv_setiv($arg, (IV)$var);
T_PTR_NULL
sv_setiv($arg, (IV)$var);
# same as T_PTROBJ
T_IMAGER_IMAGE
sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
T_PTROBJ_INV
sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
# ugh, the things we do for ease of use
# this isn't suitable in some cases
T_IMAGER_FULL_IMAGE
if ($var) {
SV *imobj = NEWSV(0, 0);
HV *hv = newHV();
sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
hv_store(hv, "IMG", 3, imobj, 0);
$arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
}
else {
$arg = &PL_sv_undef;
}
T_IV_checked
sv_setiv($arg, (IV)$var);
T_NV_checked
sv_setnv($arg, (NV)$var);
|
