/
typemap
138 lines (125 loc) · 4.29 KB
/
typemap
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
#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
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
double * T_AVARRAY
int * T_AVARRAY
i_img_dim * T_AVARRAY
i_color * T_AVARRAY
# 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_AVARRAY
STMT_START {
SV* const xsub_tmp_sv = $arg;
SvGETMAGIC(xsub_tmp_sv);
if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
AV *xsub_tmp_av = (AV*)SvRV(xsub_tmp_sv);
STRLEN xsub_index;
size_$var = av_len(xsub_tmp_av) + 1;
$var = $ntype(size_$var);
for (xsub_index = 0; xsub_index < size_$var; ++xsub_index) {
SV **sv = av_fetch(xsub_tmp_av, xsub_index, 0);
if (sv) {
${var}[xsub_index] = Sv${(my $ntt = $ntype) =~ s/Ptr$//; \(ucfirst $ntt)}(*sv, \"$pname\");
}
}
}
else{
Perl_croak(aTHX_ \"%s: %s is not an ARRAY reference\",
${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
\"$var\");
}
} STMT_END
#############################################################################
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;
}