]>
Commit | Line | Data |
---|---|---|
02d1d628 AMH |
1 | #i_img * T_PTR_NULL |
2 | Imager::Color T_PTROBJ | |
faa9b3e7 | 3 | Imager::Color::Float T_PTROBJ |
92bda632 | 4 | Imager::ImgRaw T_IMAGER_IMAGE |
4b19f77a | 5 | Imager::Font::TT T_PTROBJ |
02d1d628 | 6 | Imager::IO T_PTROBJ |
f1ac5027 | 7 | Imager::FillHandle T_PTROBJ |
02d1d628 AMH |
8 | const char * T_PV |
9 | float T_FLOAT | |
10 | float* T_ARRAY | |
11 | undef_int T_IV_U | |
a659442a | 12 | undef_neg_int T_IV_NEGU |
02d1d628 | 13 | HASH T_HVREF |
1bd75e4c | 14 | utf8_str T_UTF8_STR |
40068b33 | 15 | i_img_dim T_IV |
92bda632 TC |
16 | |
17 | # these types are for use by Inline, which can't handle types containing :: | |
18 | Imager__Color T_PTROBJ_INV | |
19 | Imager__Color__Float T_PTROBJ_INV | |
20 | Imager__ImgRaw T_IMAGER_IMAGE | |
21 | Imager__FillHandle T_PTROBJ_INV | |
22 | Imager__IO T_PTROBJ_INV | |
23 | ||
24 | # mostly intended for non-Imager-core use | |
25 | Imager T_IMAGER_FULL_IMAGE | |
26 | ||
02d1d628 AMH |
27 | ############################################################################# |
28 | INPUT | |
29 | T_PTR_NULL | |
5997b792 | 30 | if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg)); |
02d1d628 | 31 | else $var = NULL |
e5744e01 | 32 | |
92bda632 TC |
33 | # handles Imager objects rather than just raw objects |
34 | T_IMAGER_IMAGE | |
35 | if (sv_derived_from($arg, \"Imager::ImgRaw\")) { | |
36 | IV tmp = SvIV((SV*)SvRV($arg)); | |
37 | $var = INT2PTR($type,tmp); | |
38 | } | |
39 | else if (sv_derived_from($arg, \"Imager\") && | |
40 | SvTYPE(SvRV($arg)) == SVt_PVHV) { | |
41 | HV *hv = (HV *)SvRV($arg); | |
42 | SV **sv = hv_fetch(hv, \"IMG\", 3, 0); | |
43 | if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) { | |
44 | IV tmp = SvIV((SV*)SvRV(*sv)); | |
45 | $var = INT2PTR($type,tmp); | |
46 | } | |
47 | else | |
48 | Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\"); | |
49 | } | |
50 | else | |
51 | Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\"); | |
52 | ||
53 | T_IMAGER_FULL_IMAGE | |
54 | if (sv_derived_from($arg, \"Imager\") && | |
55 | SvTYPE(SvRV($arg)) == SVt_PVHV) { | |
56 | HV *hv = (HV *)SvRV($arg); | |
57 | SV **sv = hv_fetch(hv, \"IMG\", 3, 0); | |
58 | if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) { | |
59 | IV tmp = SvIV((SV*)SvRV(*sv)); | |
60 | $var = INT2PTR($type,tmp); | |
61 | } | |
62 | else | |
63 | Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\"); | |
64 | } | |
65 | else | |
66 | Perl_croak(aTHX_ \"$var is not of type Imager\"); | |
67 | ||
68 | # same as T_PTROBJ, but replace __ with ::, the opposite of the way | |
69 | # xsubpp's processing works | |
70 | # this is to compensate for Inline's problem with type names containing :: | |
71 | T_PTROBJ_INV | |
72 | if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) { | |
73 | IV tmp = SvIV((SV*)SvRV($arg)); | |
74 | $var = INT2PTR($type,tmp); | |
75 | } | |
76 | else | |
77 | croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\"); | |
78 | ||
19e9591b | 79 | |
02d1d628 AMH |
80 | ############################################################################# |
81 | OUTPUT | |
82 | T_IV_U | |
83 | if ($var == 0) $arg=&PL_sv_undef; | |
84 | else sv_setiv($arg, (IV)$var); | |
a659442a TC |
85 | T_IV_NEGU |
86 | if ($var < 0) $arg=&PL_sv_undef; | |
87 | else sv_setiv($arg, (IV)$var); | |
02d1d628 AMH |
88 | T_PTR_NULL |
89 | sv_setiv($arg, (IV)$var); | |
92bda632 TC |
90 | |
91 | # same as T_PTROBJ | |
92 | T_IMAGER_IMAGE | |
93 | sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var); | |
94 | ||
95 | T_PTROBJ_INV | |
96 | sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var); | |
97 | ||
98 | # ugh, the things we do for ease of use | |
99 | # this isn't suitable in some cases | |
100 | T_IMAGER_FULL_IMAGE | |
101 | if ($var) { | |
102 | SV *imobj = NEWSV(0, 0); | |
103 | HV *hv = newHV(); | |
92bda632 TC |
104 | sv_setref_pv(imobj, \"Imager::ImgRaw\", $var); |
105 | hv_store(hv, "IMG", 3, imobj, 0); | |
b340c629 | 106 | $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1))); |
92bda632 TC |
107 | } |
108 | else { | |
109 | $arg = &PL_sv_undef; | |
110 | } |