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