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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
# definitions we don't want to make visible to the world
# because they're intended for use specifically by Imager.xs
# internal types used in Imager.xs
i_channel_list T_IM_CHANNEL_LIST
i_sample_list T_IM_SAMPLE_LIST
i_fsample_list T_IM_FSAMPLE_LIST
i_polygon_list T_IM_POLYGON_LIST
off_t T_OFF_T
Imager::Internal::Hlines T_PTROBJ
Imager::Context T_PTROBJ
i_palidx T_IV
double * T_AVARRAY
int * T_AVARRAY
i_img_dim * T_AVARRAY
i_color * T_AVARRAY
i_poly_fill_mode_t T_I_POLY_FILL_MODE_T
#############################################################################
INPUT
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_IM_SAMPLE_LIST
SvGETMAGIC($arg);
if (!SvOK($arg))
croak(\"$var must be a scalar or an arrayref\");
if (SvROK($arg)) {
i_img_dim i;
AV *av;
i_sample_t *s;
if (SvTYPE(SvRV($arg)) != SVt_PVAV)
croak(\"$var must be a scalar or an arrayref\");
av = (AV *)SvRV($arg);
$var.count = av_len(av) + 1;
if ($var.count < 1)
croak(\"$pname: no samples provided in $var\");
s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
for (i = 0; i < $var.count; ++i) {
SV **entry = av_fetch(av, i, 0);
s[i] = entry ? SvIV(*entry) : 0;
}
$var.samples = s;
}
else {
/* non-magic would be preferable here */
$var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
if ($var.count == 0)
croak(\"$pname: no samples provided in $var\");
}
T_IM_FSAMPLE_LIST
SvGETMAGIC($arg);
if (!SvOK($arg))
croak(\"$var must be a scalar or an arrayref\");
if (SvROK($arg)) {
i_img_dim i;
AV *av;
i_fsample_t *s;
if (SvTYPE(SvRV($arg)) != SVt_PVAV)
croak(\"$var must be a scalar or an arrayref\");
av = (AV *)SvRV($arg);
$var.count = av_len(av) + 1;
if ($var.count < 1)
croak(\"$pname: no samples provided in $var\");
s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
for (i = 0; i < $var.count; ++i) {
SV **entry = av_fetch(av, i, 0);
s[i] = entry ? SvNV(*entry) : 0;
}
$var.samples = s;
}
else {
/* non-magic would be preferable here */
$var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
if ($var.count % sizeof(double))
croak(\"$pname: $var doesn't not contain a integer number of samples\");
$var.count /= sizeof(double);
if ($var.count == 0)
croak(\"$pname: no samples provided in $var\");
}
T_IM_POLYGON_LIST
S_get_polygon_list(aTHX_ &$var, $arg);
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
T_I_POLY_FILL_MODE_T
$var = S_get_poly_fill_mode(aTHX_ $arg);
#############################################################################
OUTPUT
T_OFF_T
$arg = i_new_sv_off_t(aTHX_ $var);
|
