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