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 im_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_checked
  16 im_double               T_NV_checked
  17
  18
  19 # these types are for use by Inline, which can't handle types containing ::
  20 Imager__Color           T_PTROBJ_INV
  21 Imager__Color__Float    T_PTROBJ_INV
  22 Imager__ImgRaw          T_IMAGER_IMAGE
  23 Imager__FillHandle      T_PTROBJ_INV
  24 Imager__IO              T_PTROBJ_INV
  25
  26 # mostly intended for non-Imager-core use
  27 Imager                  T_IMAGER_FULL_IMAGE
  28
  29 #############################################################################
  30 INPUT
  31 T_PTR_NULL
  32         if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
  33         else $var = NULL
  34
  35 # handles Imager objects rather than just raw objects
  36 T_IMAGER_IMAGE
  37         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
  38             IV tmp = SvIV((SV*)SvRV($arg));
  39             $var = INT2PTR($type,tmp);
  40         }
  41         else if (sv_derived_from($arg, \"Imager\") &&
  42                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  43             HV *hv = (HV *)SvRV($arg);
  44             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  45             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  46                 IV tmp = SvIV((SV*)SvRV(*sv));
  47                 $var = INT2PTR($type,tmp);
  48             }
  49             else
  50                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  51         }
  52         else
  53             Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  54
  55 T_IMAGER_FULL_IMAGE
  56         if (sv_derived_from($arg, \"Imager\") &&
  57                  SvTYPE(SvRV($arg)) == SVt_PVHV) {
  58             HV *hv = (HV *)SvRV($arg);
  59             SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
  60             if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
  61                 IV tmp = SvIV((SV*)SvRV(*sv));
  62                 $var = INT2PTR($type,tmp);
  63             }
  64             else
  65                 Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
  66         }
  67         else
  68             Perl_croak(aTHX_ \"$var is not of type Imager\");
  69
  70 # same as T_PTROBJ, but replace __ with ::, the opposite of the way
  71 # xsubpp's processing works
  72 # this is to compensate for Inline's problem with type names containing ::
  73 T_PTROBJ_INV
  74         if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
  75             IV tmp = SvIV((SV*)SvRV($arg));
  76             $var = INT2PTR($type,tmp);
  77         }
  78         else
  79             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
  80
  81 T_NV_checked
  82         {
  83             SvGETMAGIC($arg);
  84             if (SvROK($arg) && !SvAMAGIC($arg)) {
  85                 croak(\"Numeric argument '$var' shouldn't be a reference\");
  86             }
  87             else {
  88                 $var = ($type)SvNV($arg);
  89             }
  90         }
  91
  92 T_IV_checked
  93         {
  94             SvGETMAGIC($arg);
  95             if (SvROK($arg) && !SvAMAGIC($arg)) {
  96                 croak(\"Numeric argument '$var' shouldn't be a reference\");
  97             }
  98             else {
  99                 $var = ($type)SvIV($arg);
 100             }
 101         }
 102
 103 #############################################################################
 104 OUTPUT
 105 T_IV_U
 106         if ($var == 0) $arg=&PL_sv_undef;
 107         else sv_setiv($arg, (IV)$var);
 108 T_IV_NEGU
 109         if ($var < 0) $arg=&PL_sv_undef;
 110         else sv_setiv($arg, (IV)$var);
 111 T_PTR_NULL
 112         sv_setiv($arg, (IV)$var);
 113
 114 # same as T_PTROBJ
 115 T_IMAGER_IMAGE
 116         sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);
 117
 118 T_PTROBJ_INV
 119         sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);
 120
 121 # ugh, the things we do for ease of use
 122 # this isn't suitable in some cases
 123 T_IMAGER_FULL_IMAGE
 124         if ($var) {
 125           SV *imobj = NEWSV(0, 0);
 126           HV *hv = newHV();
 127           sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
 128           hv_store(hv, "IMG", 3, imobj, 0);
 129           $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
 130         }
 131         else {
 132           $arg = &PL_sv_undef;
 133         }
 134
 135 T_IV_checked
 136         sv_setiv($arg, (IV)$var);
 137
 138 T_NV_checked
 139         sv_setnv($arg, (NV)$var);