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 i_channel_list          T_IM_CHANNEL_LIST
  34
  35 #############################################################################
  36 INPUT
  37 T_PTR_NULL
  38         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
  39         else $var = NULL
  40
  41 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
  42 T_AVREF
  43         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
  44             $var = (AV*)SvRV($arg);
  45         else
  46             Perl_croak(aTHX_ \"$var is not an array reference\")
  47
  48 # handles Imager objects rather than just raw objects
  49 T_IMAGER_IMAGE
  50         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
  51             IV tmp = SvIV((SV*)SvRV($arg));
  52             $var = INT2PTR($type,tmp);
  53         }
  54         else 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::ImgRaw\");
  67
  68 T_IMAGER_FULL_IMAGE
  69         if (sv_derived_from($arg, \"Imager\") &&
  70                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  71             HV *hv = (HV *)SvRV($arg);
  72             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  73             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  74                 IV tmp = SvIV((SV*)SvRV(*sv));
  75                 $var = INT2PTR($type,tmp);
  76             }
  77             else
  78                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  79         }
  80         else
  81             Perl_croak(aTHX_ \"$var is not of type Imager\");
  82
  83 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
  84 # xsubpp's processing works
  85 # this is to compensate for Inline's problem with type names containing ::
  86 T_PTROBJ_INV
  87         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
  88             IV tmp = SvIV((SV*)SvRV($arg));
  89             $var = INT2PTR($type,tmp);
  90         }
  91         else
  92             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
  93
  94 T_OFF_T
  95   $var = i_sv_off_t(aTHX_ $arg);
  96
  97 T_IM_CHANNEL_LIST
  98         SvGETMAGIC($arg);
  99         if (SvOK($arg)) {
 100           AV *channels_av;
 101           int i;
 102           if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
 103             croak(\"$var is not an array ref\");
 104           }
 105           channels_av = (AV *)SvRV($arg);
 106           $var.count = av_len(channels_av) + 1;
 107           if ($var.count < 1) {
 108             croak(\"$pname: no channels provided\");
 109           }
 110           $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
 111           for (i = 0; i < $var.count; ++i) {
 112             SV **entry = av_fetch(channels_av, i, 0);
 113             $var.channels[i] = entry ? SvIV(*entry) : 0;
 114           }
 115         }
 116         else {
 117           /* assumes we have an image */
 118           $var.count = im->channels;
 119           $var.channels = NULL;
 120         }
 121
 122
 123 #############################################################################
 124 OUTPUT
 125 T_IV_U
 126         if ($var == 0) $arg=&PL_sv_undef;
 127         else sv_setiv($arg, (IV)$var);
 128 T_IV_NEGU
 129         if ($var < 0) $arg=&PL_sv_undef;
 130         else sv_setiv($arg, (IV)$var);
 131 T_PTR_NULL
 132         sv_setiv($arg, (IV)$var);
 133
 134 # same as T_PTROBJ
 135 T_IMAGER_IMAGE
 136         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
 137
 138 T_PTROBJ_INV
 139         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
 140
 141 # ugh, the things we do for ease of use
 142 # this isn't suitable in some cases
 143 T_IMAGER_FULL_IMAGE
 144         if ($var) {
 145           SV *imobj = NEWSV(0, 0);
 146           HV *hv = newHV();
 147           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
 148           hv_store(hv, "IMG", 3, imobj, 0);
 149           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
 150         }
 151         else {
 152           $arg = &PL_sv_undef;
 153         }
 154 T_OFF_T
 155         $arg = i_new_sv_off_t(aTHX_ $var);