Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 128 lines (113 sloc) 4.035 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
#i_img * T_PTR_NULL
Imager::Color T_PTROBJ
Imager::Color::Float T_PTROBJ
Imager::ImgRaw T_IMAGER_IMAGE
Imager::Font::TT T_PTROBJ
Imager::IO T_PTROBJ
Imager::FillHandle T_PTROBJ
Imager::Internal::Hlines T_PTROBJ
const char * T_PV
float T_FLOAT
float* T_ARRAY
undef_int T_IV_U
undef_neg_int T_IV_NEGU
HASH T_HVREF
utf8_str T_UTF8_STR
i_img_dim T_IV

# these types are for use by Inline, which can't handle types containing ::
Imager__Color T_PTROBJ_INV
Imager__Color__Float T_PTROBJ_INV
Imager__ImgRaw T_IMAGER_IMAGE
Imager__FillHandle T_PTROBJ_INV
Imager__IO T_PTROBJ_INV

# mostly intended for non-Imager-core use
Imager T_IMAGER_FULL_IMAGE

off_t T_OFF_T

# STRLEN isn't in the default typemap in older perls
STRLEN T_UV

#############################################################################
INPUT
T_PTR_NULL
if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
else $var = NULL

# the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
T_AVREF
        if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
            $var = (AV*)SvRV($arg);
        else
            Perl_croak(aTHX_ \"$var is not an array reference\")

# handles Imager objects rather than just raw objects
T_IMAGER_IMAGE
        if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
            IV tmp = SvIV((SV*)SvRV($arg));
            $var = INT2PTR($type,tmp);
        }
        else if (sv_derived_from($arg, \"Imager\") &&
                 SvTYPE(SvRV($arg)) == SVt_PVHV) {
            HV *hv = (HV *)SvRV($arg);
            SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
            if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
                IV tmp = SvIV((SV*)SvRV(*sv));
                $var = INT2PTR($type,tmp);
            }
            else
                Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
        }
        else
            Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");

T_IMAGER_FULL_IMAGE
        if (sv_derived_from($arg, \"Imager\") &&
                 SvTYPE(SvRV($arg)) == SVt_PVHV) {
            HV *hv = (HV *)SvRV($arg);
            SV **sv = hv_fetch(hv, \"IMG\", 3, 0);
            if (sv && *sv && sv_derived_from(*sv, \"Imager::ImgRaw\")) {
                IV tmp = SvIV((SV*)SvRV(*sv));
                $var = INT2PTR($type,tmp);
            }
            else
                Perl_croak(aTHX_ \"$var is not of type Imager::ImgRaw\");
        }
        else
            Perl_croak(aTHX_ \"$var is not of type Imager\");

# same as T_PTROBJ, but replace __ with ::, the opposite of the way
# xsubpp's processing works
# this is to compensate for Inline's problem with type names containing ::
T_PTROBJ_INV
        if (sv_derived_from($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\")) {
            IV tmp = SvIV((SV*)SvRV($arg));
            $var = INT2PTR($type,tmp);
        }
        else
            croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");

T_OFF_T
  $var = i_sv_off_t(aTHX_ $arg);

#############################################################################
OUTPUT
T_IV_U
if ($var == 0) $arg=&PL_sv_undef;
else sv_setiv($arg, (IV)$var);
T_IV_NEGU
if ($var < 0) $arg=&PL_sv_undef;
else sv_setiv($arg, (IV)$var);
T_PTR_NULL
sv_setiv($arg, (IV)$var);

# same as T_PTROBJ
T_IMAGER_IMAGE
        sv_setref_pv($arg, \"Imager::ImgRaw\", (void*)$var);

T_PTROBJ_INV
        sv_setref_pv($arg, \"${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\", (void*)$var);

# ugh, the things we do for ease of use
# this isn't suitable in some cases
T_IMAGER_FULL_IMAGE
        if ($var) {
          SV *imobj = NEWSV(0, 0);
          HV *hv = newHV();
          sv_setref_pv(imobj, \"Imager::ImgRaw\", $var);
          hv_store(hv, "IMG", 3, imobj, 0);
          $arg = sv_2mortal(sv_bless(newRV_noinc((SV*)hv), gv_stashpv("Imager", 1)));
        }
        else {
          $arg = &PL_sv_undef;
        }
T_OFF_T
$arg = i_new_sv_off_t(aTHX_ $var);
Something went wrong with that request. Please try again.