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 Imager::Internal::Hlines T_PTROBJ
   9 const char *            T_PV
  10 float                   T_FLOAT
  11 float*                  T_ARRAY
  12 undef_int               T_IV_U
  13 undef_neg_int           T_IV_NEGU
  14 HASH                    T_HVREF
  15 utf8_str                T_UTF8_STR
  16 i_img_dim               T_IV
  17
  18 # these types are for use by Inline, which can't handle types containing ::
  19 Imager__Color           T_PTROBJ_INV
  20 Imager__Color__Float    T_PTROBJ_INV
  21 Imager__ImgRaw          T_IMAGER_IMAGE
  22 Imager__FillHandle      T_PTROBJ_INV
  23 Imager__IO              T_PTROBJ_INV
  24
  25 # mostly intended for non-Imager-core use
  26 Imager                  T_IMAGER_FULL_IMAGE
  27
  28 off_t                   T_OFF_T
  29
  30 # STRLEN isn't in the default typemap in older perls
  31 STRLEN                  T_UV
  32
  33 # internal types used in Imager.xs
  34 i_channel_list          T_IM_CHANNEL_LIST
  35 i_sample_list           T_IM_SAMPLE_LIST
  36 i_fsample_list          T_IM_FSAMPLE_LIST
  37
  38 #############################################################################
  39 INPUT
  40 T_PTR_NULL
  41         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
  42         else $var = NULL
  43
  44 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
  45 T_AVREF
  46         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
  47             $var = (AV*)SvRV($arg);
  48         else
  49             Perl_croak(aTHX_ \"$var is not an array reference\")
  50
  51 # handles Imager objects rather than just raw objects
  52 T_IMAGER_IMAGE
  53         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
  54             IV tmp = SvIV((SV*)SvRV($arg));
  55             $var = INT2PTR($type,tmp);
  56         }
  57         else if (sv_derived_from($arg, \"Imager\") &&
  58                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  59             HV *hv = (HV *)SvRV($arg);
  60             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  61             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  62                 IV tmp = SvIV((SV*)SvRV(*sv));
  63                 $var = INT2PTR($type,tmp);
  64             }
  65             else
  66                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  67         }
  68         else
  69             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  70
  71 T_IMAGER_FULL_IMAGE
  72         if (sv_derived_from($arg, \"Imager\") &&
  73                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  74             HV *hv = (HV *)SvRV($arg);
  75             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  76             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  77                 IV tmp = SvIV((SV*)SvRV(*sv));
  78                 $var = INT2PTR($type,tmp);
  79             }
  80             else
  81                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  82         }
  83         else
  84             Perl_croak(aTHX_ \"$var is not of type Imager\");
  85
  86 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
  87 # xsubpp's processing works
  88 # this is to compensate for Inline's problem with type names containing ::
  89 T_PTROBJ_INV
  90         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
  91             IV tmp = SvIV((SV*)SvRV($arg));
  92             $var = INT2PTR($type,tmp);
  93         }
  94         else
  95             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
  96
  97 T_OFF_T
  98   $var = i_sv_off_t(aTHX_ $arg);
  99
 100 T_IM_CHANNEL_LIST
 101         SvGETMAGIC($arg);
 102         if (SvOK($arg)) {
 103           AV *channels_av;
 104           int i;
 105           if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
 106             croak(\"$var is not an array ref\");
 107           }
 108           channels_av = (AV *)SvRV($arg);
 109           $var.count = av_len(channels_av) + 1;
 110           if ($var.count < 1) {
 111             croak(\"$pname: no channels provided\");
 112           }
 113           $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
 114           for (i = 0; i < $var.count; ++i) {
 115             SV **entry = av_fetch(channels_av, i, 0);
 116             $var.channels[i] = entry ? SvIV(*entry) : 0;
 117           }
 118         }
 119         else {
 120           /* assumes we have an image */
 121           $var.count = im->channels;
 122           $var.channels = NULL;
 123         }
 124
 125 T_IM_SAMPLE_LIST
 126         SvGETMAGIC($arg);
 127         if (!SvOK($arg))
 128           croak(\"$var must be a scalar or an arrayref\");
 129         if (SvROK($arg)) {
 130           i_img_dim i;
 131           AV *av;
 132           i_sample_t *s;
 133           if (SvTYPE(SvRV($arg)) != SVt_PVAV)
 134             croak(\"$var must be a scalar or an arrayref\");
 135           av = (AV *)SvRV($arg);
 136           $var.count = av_len(av) + 1;
 137           if ($var.count < 1)
 138             croak(\"$pname: no samples provided in $var\");
 139           s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
 140           for (i = 0; i < $var.count; ++i) {
 141             SV **entry = av_fetch(av, i, 0);
 142             s[i] = entry ? SvIV(*entry) : 0;
 143           }
 144           $var.samples = s;
 145         }
 146         else {
 147           /* non-magic would be preferable here */
 148           $var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
 149           if ($var.count == 0)
 150             croak(\"$pname: no samples provided in $var\");
 151         }
 152
 153 T_IM_FSAMPLE_LIST
 154         SvGETMAGIC($arg);
 155         if (!SvOK($arg))
 156           croak(\"$var must be a scalar or an arrayref\");
 157         if (SvROK($arg)) {
 158           i_img_dim i;
 159           AV *av;
 160           i_fsample_t *s;
 161           if (SvTYPE(SvRV($arg)) != SVt_PVAV)
 162             croak(\"$var must be a scalar or an arrayref\");
 163           av = (AV *)SvRV($arg);
 164           $var.count = av_len(av) + 1;
 165           if ($var.count < 1)
 166             croak(\"$pname: no samples provided in $var\");
 167           s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
 168           for (i = 0; i < $var.count; ++i) {
 169             SV **entry = av_fetch(av, i, 0);
 170             s[i] = entry ? SvNV(*entry) : 0;
 171           }
 172           $var.samples = s;
 173         }
 174         else {
 175           /* non-magic would be preferable here */
 176           $var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
 177           if ($var.count % sizeof(double))
 178             croak(\"$pname: $var doesn't not contain a integer number of samples\");
 179           $var.count /= sizeof(double);
 180           if ($var.count == 0)
 181             croak(\"$pname: no samples provided in $var\");
 182         }
 183
 184 #############################################################################
 185 OUTPUT
 186 T_IV_U
 187         if ($var == 0) $arg=&PL_sv_undef;
 188         else sv_setiv($arg, (IV)$var);
 189 T_IV_NEGU
 190         if ($var < 0) $arg=&PL_sv_undef;
 191         else sv_setiv($arg, (IV)$var);
 192 T_PTR_NULL
 193         sv_setiv($arg, (IV)$var);
 194
 195 # same as T_PTROBJ
 196 T_IMAGER_IMAGE
 197         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
 198
 199 T_PTROBJ_INV
 200         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
 201
 202 # ugh, the things we do for ease of use
 203 # this isn't suitable in some cases
 204 T_IMAGER_FULL_IMAGE
 205         if ($var) {
 206           SV *imobj = NEWSV(0, 0);
 207           HV *hv = newHV();
 208           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
 209           hv_store(hv, "IMG", 3, imobj, 0);
 210           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
 211         }
 212         else {
 213           $arg = &PL_sv_undef;
 214         }
 215 T_OFF_T
 216         $arg = i_new_sv_off_t(aTHX_ $var);