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 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
  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
  27 #############################################################################
  28 INPUT
  29 T_PTR_NULL
  30         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
  31         else $var = NULL
  32
  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
  79
  80 #############################################################################
  81 OUTPUT
  82 T_IV_U
  83         if ($var == 0) $arg=&PL_sv_undef;
  84         else sv_setiv($arg, (IV)$var);
  85 T_IV_NEGU
  86         if ($var < 0) $arg=&PL_sv_undef;
  87         else sv_setiv($arg, (IV)$var);
  88 T_PTR_NULL
  89         sv_setiv($arg, (IV)$var);
  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();
 104           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
 105           hv_store(hv, "IMG", 3, imobj, 0);
 106           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
 107         }
 108         else {
 109           $arg = &PL_sv_undef;
 110         }