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 #############################################################################
  34 INPUT
  35 T_PTR_NULL
  36         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
  37         else $var = NULL
  38
  39 # the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
  40 T_AVREF
  41         if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
  42             $var = (AV*)SvRV($arg);
  43         else
  44             Perl_croak(aTHX_ \"$var is not an array reference\")
  45
  46 # handles Imager objects rather than just raw objects
  47 T_IMAGER_IMAGE
  48         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
  49             IV tmp = SvIV((SV*)SvRV($arg));
  50             $var = INT2PTR($type,tmp);
  51         }
  52         else if (sv_derived_from($arg, \"Imager\") &&
  53                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  54             HV *hv = (HV *)SvRV($arg);
  55             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  56             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  57                 IV tmp = SvIV((SV*)SvRV(*sv));
  58                 $var = INT2PTR($type,tmp);
  59             }
  60             else
  61                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  62         }
  63         else
  64             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  65
  66 T_IMAGER_FULL_IMAGE
  67         if (sv_derived_from($arg, \"Imager\") &&
  68                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  69             HV *hv = (HV *)SvRV($arg);
  70             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  71             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  72                 IV tmp = SvIV((SV*)SvRV(*sv));
  73                 $var = INT2PTR($type,tmp);
  74             }
  75             else
  76                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  77         }
  78         else
  79             Perl_croak(aTHX_ \"$var is not of type Imager\");
  80
  81 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
  82 # xsubpp's processing works
  83 # this is to compensate for Inline's problem with type names containing ::
  84 T_PTROBJ_INV
  85         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
  86             IV tmp = SvIV((SV*)SvRV($arg));
  87             $var = INT2PTR($type,tmp);
  88         }
  89         else
  90             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
  91
  92 T_OFF_T
  93   $var = i_sv_off_t(aTHX_ $arg);
  94
  95 #############################################################################
  96 OUTPUT
  97 T_IV_U
  98         if ($var == 0) $arg=&PL_sv_undef;
  99         else sv_setiv($arg, (IV)$var);
 100 T_IV_NEGU
 101         if ($var < 0) $arg=&PL_sv_undef;
 102         else sv_setiv($arg, (IV)$var);
 103 T_PTR_NULL
 104         sv_setiv($arg, (IV)$var);
 105
 106 # same as T_PTROBJ
 107 T_IMAGER_IMAGE
 108         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
 109
 110 T_PTROBJ_INV
 111         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
 112
 113 # ugh, the things we do for ease of use
 114 # this isn't suitable in some cases
 115 T_IMAGER_FULL_IMAGE
 116         if ($var) {
 117           SV *imobj = NEWSV(0, 0);
 118           HV *hv = newHV();
 119           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
 120           hv_store(hv, "IMG", 3, imobj, 0);
 121           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
 122         }
 123         else {
 124           $arg = &PL_sv_undef;
 125         }
 126 T_OFF_T
 127         $arg = i_new_sv_off_t(aTHX_ $var);