]> git.imager.perl.org - imager.git/blobdiff - typemap
[rt #69243] remove unnecessary warning comment from i_gsampf()
[imager.git] / typemap
diff --git a/typemap b/typemap
index 20980004650f80f1e1e83fad47c25f68cf0bb3f6..907451e3fbed1c6e773285cc541ca42b5f9ca227 100644 (file)
--- a/typemap
+++ b/typemap
@@ -5,7 +5,6 @@ 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
@@ -15,6 +14,11 @@ HASH                 T_HVREF
 utf8_str               T_UTF8_STR
 i_img_dim              T_IV
 
+double *               T_AVARRAY
+int *                          T_AVARRAY
+i_img_dim *            T_AVARRAY
+i_color *              T_AVARRAY
+
 # these types are for use by Inline, which can't handle types containing ::
 Imager__Color           T_PTROBJ_INV
 Imager__Color__Float    T_PTROBJ_INV
@@ -25,26 +29,12 @@ 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
-
-i_channel_list         T_IM_CHANNEL_LIST
-
 #############################################################################
 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\")) {
@@ -91,33 +81,28 @@ T_PTROBJ_INV
         else
             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
 
-T_OFF_T
-  $var = i_sv_off_t(aTHX_ $arg);
-
-T_IM_CHANNEL_LIST
-        SvGETMAGIC($arg);
-       if (SvOK($arg)) {
-         AV *channels_av;
-         int i;
-         if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
-           croak(\"$var is not an array ref\");
-         }
-         channels_av = (AV *)SvRV($arg);
-         $var.count = av_len(channels_av) + 1;
-         if ($var.count < 1) {
-           croak(\"$pname: no channels provided\");
-         }
-         $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
-         for (i = 0; i < $var.count; ++i) {
-           SV **entry = av_fetch(channels_av, i, 0);
-           $var.channels[i] = entry ? SvIV(*entry) : 0;
-         }
-        }
-       else {
-         /* assumes we have an image */
-         $var.count = im->channels;
-         $var.channels = NULL;
-       }
+T_AVARRAY
+       STMT_START {
+               SV* const xsub_tmp_sv = $arg;
+               SvGETMAGIC(xsub_tmp_sv);
+               if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){
+                   AV *xsub_tmp_av = (AV*)SvRV(xsub_tmp_sv);
+                   STRLEN xsub_index;
+                   size_$var = av_len(xsub_tmp_av) + 1;
+                   $var = $ntype(size_$var);
+                   for (xsub_index = 0; xsub_index < size_$var; ++xsub_index) {
+                       SV **sv = av_fetch(xsub_tmp_av, xsub_index, 0);
+                       if (sv) {
+                         ${var}[xsub_index] = Sv${(my $ntt = $ntype) =~ s/Ptr$//; \(ucfirst $ntt)}(*sv, \"$pname\");
+                        }
+                   }
+               }
+               else{
+                   Perl_croak(aTHX_ \"%s: %s is not an ARRAY reference\",
+                               ${$ALIAS?\q[GvNAME(CvGV(cv))]:\qq[\"$pname\"]},
+                               \"$var\");
+               }
+       } STMT_END
 
 
 #############################################################################
@@ -151,5 +136,3 @@ T_IMAGER_FULL_IMAGE
         else {
           $arg = &PL_sv_undef;
         }
-T_OFF_T
-       $arg = i_new_sv_off_t(aTHX_ $var);