SEXP d2q(SEXP foo)
{
if (! isReal(foo))
error("argument must be real");
int n = LENGTH(foo);
int i;
for (i = 0; i < n; i++)
if (! R_finite(REAL(foo)[i]))
error("argument not finite-valued");
SEXP bar, bark;
PROTECT(bar = allocVector(STRSXP, n));
PROTECT(bark = ATTRIB(foo));
if (bark != R_NilValue)
SET_ATTRIB(bar, duplicate(bark));
UNPROTECT(1);
mpq_t value;
mpq_init(value);
int k;
for (k = 0; k < n; k++) {
double z = REAL(foo)[k];
mpq_set_d(value, z);
char *zstr = NULL;
zstr = mpq_get_str(zstr, 10, value);
SET_STRING_ELT(bar, k, mkChar(zstr));
free(zstr);
}
mpq_clear(value);
UNPROTECT(1);
return(bar);
}
SEXP qsign(SEXP foo)
{
if (! isString(foo))
error("argument must be character");
int n = LENGTH(foo);
SEXP bar, bark;
PROTECT(bar = allocVector(INTSXP, n));
PROTECT(bark = ATTRIB(foo));
if (bark != R_NilValue)
SET_ATTRIB(bar, duplicate(bark));
UNPROTECT(1);
mpq_t value;
mpq_init(value);
for (int k = 0; k < n; k++) {
const char *zstr = CHAR(STRING_ELT(foo, k));
if (mpq_set_str(value, zstr, 10) == -1) {
mpq_clear(value);
error("error converting string to GMP rational");
}
mpq_canonicalize(value);
INTEGER(bar)[k] = mpq_sgn(value);
}
mpq_clear(value);
UNPROTECT(1);
return(bar);
}
/* R function qsort(x, index.return) */
SEXP attribute_hidden do_qsort(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP x, sx;
int indx_ret, n;
double *vx = NULL;
int *ivx = NULL;
Rboolean x_real, x_int;
checkArity(op, args);
x = CAR(args);
if (!isNumeric(x))
error(_("argument is not a numeric vector"));
x_real= TYPEOF(x) == REALSXP;
x_int = !x_real && (TYPEOF(x) == INTSXP || TYPEOF(x) == LGLSXP);
PROTECT(sx = (x_real || x_int) ? duplicate(x) : coerceVector(x, REALSXP));
SET_ATTRIB(sx, R_NilValue);
SET_OBJECT(sx, 0);
/* if x has names, drop them, since they won't be ordered
if (!isNull(getAttrib(sx, R_NamesSymbol)))
setAttrib(sx, R_NamesSymbol, R_NilValue); */
indx_ret = asLogical(CADR(args));
n = LENGTH(x);
if(x_int) ivx = INTEGER(sx); else vx = REAL(sx);
if(indx_ret) {
SEXP ans, ansnames, indx;
int i, *ix;
/* answer will have x = sorted x , ix = index :*/
PROTECT(ans = allocVector(VECSXP, 2));
PROTECT(ansnames = allocVector(STRSXP, 2));
PROTECT(indx = allocVector(INTSXP, n));
ix = INTEGER(indx);
for(i = 0; i < n; i++)
ix[i] = i+1;
if(x_int)
R_qsort_int_I(ivx, ix, 1, n);
else
R_qsort_I(vx, ix, 1, n);
SET_VECTOR_ELT(ans, 0, sx);
SET_VECTOR_ELT(ans, 1, indx);
SET_STRING_ELT(ansnames, 0, mkChar("x"));
SET_STRING_ELT(ansnames, 1, mkChar("ix"));
setAttrib(ans, R_NamesSymbol, ansnames);
UNPROTECT(4);
return ans;
}
else {
if(x_int)
R_qsort_int(ivx, 1, n);
else
R_qsort(vx, 1, n);
UNPROTECT(1);
return sx;
}
}
static SEXP removeAttrib(SEXP vec, SEXP name)
{
SEXP t;
if(TYPEOF(vec) == CHARSXP)
error("cannot set attribute on a CHARSXP");
if (name == R_NamesSymbol && isList(vec)) {
for (t = vec; t != R_NilValue; t = CDR(t))
SET_TAG(t, R_NilValue);
return R_NilValue;
}
else {
if (name == R_DimSymbol)
SET_ATTRIB(vec, stripAttrib(R_DimNamesSymbol, ATTRIB(vec)));
SET_ATTRIB(vec, stripAttrib(name, ATTRIB(vec)));
if (name == R_ClassSymbol)
SET_OBJECT(vec, 0);
}
return R_NilValue;
}
/* This is allowed to change 'out' */
attribute_hidden
SEXP do_copyDFattr(SEXP call, SEXP op, SEXP args, SEXP env)
{
checkArity(op, args);
SEXP in = CAR(args), out = CADR(args);
SET_ATTRIB(out, ATTRIB(in));
IS_S4_OBJECT(in) ? SET_S4_OBJECT(out) : UNSET_S4_OBJECT(out);
SET_OBJECT(out, OBJECT(in));
return out;
}
static SEXP
int_vectorSubscript(int nx, SEXP s, int *stretch, AttrGetter dng,
StringEltGetter strg, SEXP x, Rboolean in)
{
int ns;
SEXP ans=R_NilValue, tmp;
ns = length(s);
/* special case for simple indices -- does not duplicate */
if (ns == 1 && TYPEOF(s) == INTSXP && ATTRIB(s) == R_NilValue) {
int i = INTEGER(s)[0];
if (0 < i && i <= nx) {
*stretch = 0;
return s;
}
}
PROTECT(s=duplicate(s));
SET_ATTRIB(s, R_NilValue);
switch (TYPEOF(s)) {
case NILSXP:
*stretch = 0;
ans = allocVector(INTSXP, 0);
break;
case LGLSXP:
/* *stretch = 0; */
ans = logicalSubscript(s, ns, nx, stretch);
break;
case INTSXP:
ans = integerSubscript(s, ns, nx, stretch);
break;
case REALSXP:
PROTECT(tmp = coerceVector(s, INTSXP));
ans = integerSubscript(tmp, ns, nx, stretch);
UNPROTECT(1);
break;
case STRSXP:
{
SEXP names = dng(x, R_NamesSymbol);
/* *stretch = 0; */
ans = stringSubscript(s, ns, nx, names, strg, stretch, in);
}
break;
case SYMSXP:
*stretch = 0;
if (s == R_MissingArg) {
ans = nullSubscript(nx);
break;
}
default:
error(_("invalid subscript type"));
}
UNPROTECT(1);
return ans;
}
static SEXP commentgets(SEXP vec, SEXP comment)
{
if (vec == R_NilValue)
error(_("attempt to set an attribute on NULL"));
if (isNull(comment) || isString(comment)) {
if (length(comment) <= 0) {
SET_ATTRIB(vec, stripAttrib(R_CommentSymbol, ATTRIB(vec)));
}
else {
installAttrib(vec, R_CommentSymbol, comment);
}
return R_NilValue;
}
error(_("attempt to set invalid 'comment' attribute"));
return R_NilValue;/*- just for -Wall */
}
SEXP R_copyTruncate(SEXP x, SEXP R_n) {
if (isNull(x) || TYPEOF(x) != VECSXP)
error("'x' not of type list");
if (isNull(R_n) || TYPEOF(R_n) != INTSXP)
error("'n' not of type integer");
int i, k, n;
SEXP s, r, t = 0;
n = INTEGER(R_n)[0];
if (n < 0)
error("'n' invalid value");
r = PROTECT(allocVector(VECSXP, LENGTH(x)));
for (i = 0; i < LENGTH(x); i++) {
s = VECTOR_ELT(x, i);
if (TYPEOF(s) != STRSXP)
error("component not of type character");
if (LENGTH(s) > n) {
SET_VECTOR_ELT(r, i, (t = allocVector(STRSXP, n)));
for (k = 0; k < n; k++)
SET_STRING_ELT(t, k, STRING_ELT(s, k));
copyMostAttrib(t, s);
if ((s = getAttrib(s, R_NamesSymbol)) != R_NilValue) {
SEXP v;
setAttrib(t, R_NamesSymbol, (v = allocVector(STRSXP, n)));
for (k = 0; k < n; k++)
SET_STRING_ELT(v, k, STRING_ELT(s, k));
}
} else
SET_VECTOR_ELT(r, i, s);
}
UNPROTECT(1);
if (!t)
return x;
SET_ATTRIB(r, ATTRIB(x));
SET_OBJECT(r, OBJECT(x));
if (IS_S4_OBJECT(x))
SET_S4_OBJECT(r);
return r;
}
SEXP classgets(SEXP vec, SEXP klass)
{
if (isNull(klass) || isString(klass)) {
if (length(klass) <= 0) {
SET_ATTRIB(vec, stripAttrib(R_ClassSymbol, ATTRIB(vec)));
SET_OBJECT(vec, 0);
}
else {
/* When data frames were a special data type */
/* we had more exhaustive checks here. Now that */
/* use JMCs interpreted code, we don't need this */
/* FIXME : The whole "classgets" may as well die. */
/* HOWEVER, it is the way that the object bit gets set/unset */
int i;
Rboolean isfactor = FALSE;
if (vec == R_NilValue)
error(_("attempt to set an attribute on NULL"));
for(i = 0; i < length(klass); i++)
if(streql(CHAR(STRING_ELT(klass, i)), "factor")) { /* ASCII */
isfactor = TRUE;
break;
}
if(isfactor && TYPEOF(vec) != INTSXP) {
/* we cannot coerce vec here, so just fail */
error(_("adding class \"factor\" to an invalid object"));
}
installAttrib(vec, R_ClassSymbol, klass);
SET_OBJECT(vec, 1);
}
return R_NilValue;
}
error(_("attempt to set invalid 'class' attribute"));
return R_NilValue;/*- just for -Wall */
}
/* Tweaks here based in part on PR#14934 */
static SEXP installAttrib(SEXP vec, SEXP name, SEXP val)
{
SEXP t = R_NilValue; /* -Wall */
if(TYPEOF(vec) == CHARSXP)
error("cannot set attribute on a CHARSXP");
/* this does no allocation */
for (SEXP s = ATTRIB(vec); s != R_NilValue; s = CDR(s)) {
if (TAG(s) == name) {
SETCAR(s, val);
return val;
}
t = s; // record last attribute, if any
}
/* The usual convention is that the caller protects,
so this is historical over-cautiousness */
PROTECT(vec); PROTECT(name); PROTECT(val);
SEXP s = CONS(val, R_NilValue);
SET_TAG(s, name);
if (ATTRIB(vec) == R_NilValue) SET_ATTRIB(vec, s); else SETCDR(t, s);
UNPROTECT(3);
return val;
}
SEXP R_rowSubset_sgCMatrix(SEXP x, SEXP s) {
if (!inherits(x, "sgCMatrix"))
error("'x' not of class sgCMatrix");
int i, j, k, f, l, n, *o;
SEXP r, dx, px, ix, pr, ir;
dx = getAttrib(x, install("Dimnames"));
#ifdef _COMPAT_
r = CONS(dx, ATTRIB(x));
SET_TAG(r, R_DimNamesSymbol);
SET_ATTRIB(x, r);
PROTECT(s = arraySubscript(0, s, getAttrib(x, install("Dim")), getAttrib, (STRING_ELT), x));
SET_ATTRIB(x, CDR(r));
#else
PROTECT(s = _int_array_subscript(0, s, "Dim", "Dimnames", x, TRUE, R_NilValue));
#endif
n = INTEGER(getAttrib(x, install("Dim")))[0];
o = INTEGER(PROTECT(allocVector(INTSXP, n)));
memset(o, 0, sizeof(int) * n);
l = 1;
for (i = 0; i < LENGTH(s); i++) {
j = INTEGER(s)[i];
if (j == NA_INTEGER)
error("invalid subscript(s)");
if (j < l)
error("invalid subscript(s)");
if (o[j-1] == 0)
o[j-1] = i+1;
else
error("invalid subscript(s)");
l = j;
}
ix = getAttrib(x, install("i"));
n = 0;
if (LENGTH(s))
for (i = 0; i < LENGTH(ix); i++)
if (o[INTEGER(ix)[i]])
n++;
px = getAttrib(x, install("p"));
PROTECT(r = NEW_OBJECT(MAKE_CLASS("sgCMatrix")));
setAttrib(r, install("p"), (pr = allocVector(INTSXP, LENGTH(px))));
setAttrib(r, install("i"), (ir = allocVector(INTSXP, n)));
f = n = INTEGER(pr)[0] = 0;
for (i = 1; i < LENGTH(px); i++) {
l = INTEGER(px)[i];
if (LENGTH(s))
for (k = f; k < l; k++) {
j = o[INTEGER(ix)[k]];
if (j)
INTEGER(ir)[n++] = j-1;
}
INTEGER(pr)[i] = n;
f = l;
}
setAttrib(r, install("Dim"), (ir = allocVector(INTSXP, 2)));
INTEGER(ir)[0] = LENGTH(s);
INTEGER(ir)[1] = LENGTH(px)-1;
if (isNull((ix = VECTOR_ELT(dx, 0))))
setAttrib(r, install("Dimnames"), dx);
else {
setAttrib(r, install("Dimnames"), (ir = allocVector(VECSXP, 2)));
setAttrib(ir, R_NamesSymbol, getAttrib(dx, R_NamesSymbol));
SET_VECTOR_ELT(ir, 1, VECTOR_ELT(dx, 1));
if (LENGTH(s) > 0) {
SET_VECTOR_ELT(ir, 0, (pr = allocVector(STRSXP, LENGTH(s))));
for (i = 0; i < LENGTH(s); i++)
SET_STRING_ELT(pr, i, STRING_ELT(ix, INTEGER(s)[i]-1));
} else
SET_VECTOR_ELT(ir, 0, R_NilValue);
}
UNPROTECT(3);
return r;
}
static SEXP stringSubscript(SEXP s, int ns, int nx, SEXP names,
StringEltGetter strg, int *stretch, Rboolean in)
{
SEXP indx, indexnames;
int i, j, nnames, sub, extra;
int canstretch = *stretch;
#ifdef USE_HASHING
Rboolean usehashing = in && (ns * nx > 1000);
#else
Rboolean usehashing = FALSE;
#endif
PROTECT(s);
PROTECT(names);
PROTECT(indexnames = allocVector(STRSXP, ns));
nnames = nx;
extra = nnames;
/* Process each of the subscripts. First we compare with the names
* on the vector and then (if there is no match) with each of the
* previous subscripts, since (if assigning) we may have already
* added an element of that name. (If we are not assigning, any
* nonmatch will have given an error.)
*/
#ifdef USE_HASHING
if(usehashing) {
/* must be internal, so names contains a character vector */
PROTECT(indx = match(names, s, 0));
for (i = 0; i < ns; i++) SET_STRING_ELT(indexnames, i, R_NilValue);
} else {
#endif
PROTECT(indx = allocVector(INTSXP, ns));
for (i = 0; i < ns; i++) {
sub = 0;
if (names != R_NilValue) {
for (j = 0; j < nnames; j++) {
SEXP names_j = strg(names, j);
if (!in && TYPEOF(names_j) != CHARSXP)
error(_("character vector element does not have type CHARSXP"));
if (NonNullStringMatch(STRING_ELT(s, i), names_j)) {
sub = j + 1;
SET_STRING_ELT(indexnames, i, R_NilValue);
break;
}
}
}
INTEGER(indx)[i] = sub;
}
#ifdef USE_HASHING
}
#endif
for (i = 0; i < ns; i++) {
sub = INTEGER(indx)[i];
if (sub == 0) {
for (j = 0 ; j < i ; j++)
if (NonNullStringMatch(STRING_ELT(s, i), STRING_ELT(s, j))) {
sub = INTEGER(indx)[j];
SET_STRING_ELT(indexnames, i, STRING_ELT(s, j));
break;
}
}
if (sub == 0) {
if (!canstretch)
error(_("subscript out of bounds"));
extra += 1;
sub = extra;
SET_STRING_ELT(indexnames, i, STRING_ELT(s, i));
}
INTEGER(indx)[i] = sub;
}
/* Ghastly hack! We attach the new names to the attribute */
/* slot on the returned subscript vector. */
if (extra != nnames)
SET_ATTRIB(indx, indexnames);
if (canstretch)
*stretch = extra;
UNPROTECT(4);
return indx;
}
static void
st_DrawTex(struct gl_context *ctx, GLfloat x, GLfloat y, GLfloat z,
GLfloat width, GLfloat height)
{
struct st_context *st = ctx->st;
struct pipe_context *pipe = st->pipe;
struct cso_context *cso = st->cso_context;
struct pipe_resource *vbuffer = NULL;
GLuint i, numTexCoords, numAttribs;
GLboolean emitColor;
uint semantic_names[2 + MAX_TEXTURE_UNITS];
uint semantic_indexes[2 + MAX_TEXTURE_UNITS];
struct pipe_vertex_element velements[2 + MAX_TEXTURE_UNITS];
unsigned offset;
st_flush_bitmap_cache(st);
st_invalidate_readpix_cache(st);
st_validate_state(st, ST_PIPELINE_RENDER);
/* determine if we need vertex color */
if (ctx->FragmentProgram._Current->info.inputs_read & VARYING_BIT_COL0)
emitColor = GL_TRUE;
else
emitColor = GL_FALSE;
/* determine how many enabled sets of texcoords */
numTexCoords = 0;
for (i = 0; i < ctx->Const.MaxTextureUnits; i++) {
if (ctx->Texture.Unit[i]._Current &&
ctx->Texture.Unit[i]._Current->Target == GL_TEXTURE_2D) {
numTexCoords++;
}
}
/* total number of attributes per vertex */
numAttribs = 1 + emitColor + numTexCoords;
/* load vertex buffer */
{
#define SET_ATTRIB(VERT, ATTR, X, Y, Z, W) \
do { \
GLuint k = (((VERT) * numAttribs + (ATTR)) * 4); \
assert(k < 4 * 4 * numAttribs); \
vbuf[k + 0] = X; \
vbuf[k + 1] = Y; \
vbuf[k + 2] = Z; \
vbuf[k + 3] = W; \
} while (0)
const GLfloat x0 = x, y0 = y, x1 = x + width, y1 = y + height;
GLfloat *vbuf = NULL;
GLuint tex_attr;
u_upload_alloc(pipe->stream_uploader, 0,
numAttribs * 4 * 4 * sizeof(GLfloat), 4,
&offset, &vbuffer, (void **) &vbuf);
if (!vbuffer) {
return;
}
z = CLAMP(z, 0.0f, 1.0f);
/* positions (in clip coords) */
{
const struct gl_framebuffer *fb = ctx->DrawBuffer;
const GLfloat fb_width = (GLfloat)_mesa_geometric_width(fb);
const GLfloat fb_height = (GLfloat)_mesa_geometric_height(fb);
const GLfloat clip_x0 = (GLfloat)(x0 / fb_width * 2.0 - 1.0);
const GLfloat clip_y0 = (GLfloat)(y0 / fb_height * 2.0 - 1.0);
const GLfloat clip_x1 = (GLfloat)(x1 / fb_width * 2.0 - 1.0);
const GLfloat clip_y1 = (GLfloat)(y1 / fb_height * 2.0 - 1.0);
SET_ATTRIB(0, 0, clip_x0, clip_y0, z, 1.0f); /* lower left */
SET_ATTRIB(1, 0, clip_x1, clip_y0, z, 1.0f); /* lower right */
SET_ATTRIB(2, 0, clip_x1, clip_y1, z, 1.0f); /* upper right */
SET_ATTRIB(3, 0, clip_x0, clip_y1, z, 1.0f); /* upper left */
semantic_names[0] = TGSI_SEMANTIC_POSITION;
semantic_indexes[0] = 0;
}
/* colors */
if (emitColor) {
const GLfloat *c = ctx->Current.Attrib[VERT_ATTRIB_COLOR0];
SET_ATTRIB(0, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(1, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(2, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(3, 1, c[0], c[1], c[2], c[3]);
semantic_names[1] = TGSI_SEMANTIC_COLOR;
semantic_indexes[1] = 0;
tex_attr = 2;
}
else {
tex_attr = 1;
}
/* texcoords */
for (i = 0; i < ctx->Const.MaxTextureUnits; i++) {
if (ctx->Texture.Unit[i]._Current &&
ctx->Texture.Unit[i]._Current->Target == GL_TEXTURE_2D) {
struct gl_texture_object *obj = ctx->Texture.Unit[i]._Current;
const struct gl_texture_image *img = _mesa_base_tex_image(obj);
const GLfloat wt = (GLfloat) img->Width;
const GLfloat ht = (GLfloat) img->Height;
const GLfloat s0 = obj->CropRect[0] / wt;
const GLfloat t0 = obj->CropRect[1] / ht;
const GLfloat s1 = (obj->CropRect[0] + obj->CropRect[2]) / wt;
const GLfloat t1 = (obj->CropRect[1] + obj->CropRect[3]) / ht;
/*printf("crop texcoords: %g, %g .. %g, %g\n", s0, t0, s1, t1);*/
SET_ATTRIB(0, tex_attr, s0, t0, 0.0f, 1.0f); /* lower left */
SET_ATTRIB(1, tex_attr, s1, t0, 0.0f, 1.0f); /* lower right */
SET_ATTRIB(2, tex_attr, s1, t1, 0.0f, 1.0f); /* upper right */
SET_ATTRIB(3, tex_attr, s0, t1, 0.0f, 1.0f); /* upper left */
semantic_names[tex_attr] = st->needs_texcoord_semantic ?
TGSI_SEMANTIC_TEXCOORD : TGSI_SEMANTIC_GENERIC;
/* XXX: should this use semantic index i instead of 0 ? */
semantic_indexes[tex_attr] = 0;
tex_attr++;
}
}
u_upload_unmap(pipe->stream_uploader);
#undef SET_ATTRIB
}
cso_save_state(cso, (CSO_BIT_VIEWPORT |
CSO_BIT_STREAM_OUTPUTS |
CSO_BIT_VERTEX_SHADER |
CSO_BIT_TESSCTRL_SHADER |
CSO_BIT_TESSEVAL_SHADER |
CSO_BIT_GEOMETRY_SHADER |
CSO_BIT_VERTEX_ELEMENTS |
CSO_BIT_AUX_VERTEX_BUFFER_SLOT));
{
void *vs = lookup_shader(pipe, numAttribs,
semantic_names, semantic_indexes);
cso_set_vertex_shader_handle(cso, vs);
}
cso_set_tessctrl_shader_handle(cso, NULL);
cso_set_tesseval_shader_handle(cso, NULL);
cso_set_geometry_shader_handle(cso, NULL);
for (i = 0; i < numAttribs; i++) {
velements[i].src_offset = i * 4 * sizeof(float);
velements[i].instance_divisor = 0;
velements[i].vertex_buffer_index = 0;
velements[i].src_format = PIPE_FORMAT_R32G32B32A32_FLOAT;
}
cso_set_vertex_elements(cso, numAttribs, velements);
cso_set_stream_outputs(cso, 0, NULL, NULL);
/* viewport state: viewport matching window dims */
{
const struct gl_framebuffer *fb = ctx->DrawBuffer;
const GLboolean invert = (st_fb_orientation(fb) == Y_0_TOP);
const GLfloat width = (GLfloat)_mesa_geometric_width(fb);
const GLfloat height = (GLfloat)_mesa_geometric_height(fb);
struct pipe_viewport_state vp;
vp.scale[0] = 0.5f * width;
vp.scale[1] = height * (invert ? -0.5f : 0.5f);
vp.scale[2] = 1.0f;
vp.translate[0] = 0.5f * width;
vp.translate[1] = 0.5f * height;
vp.translate[2] = 0.0f;
cso_set_viewport(cso, &vp);
}
util_draw_vertex_buffer(pipe, cso, vbuffer,
cso_get_aux_vertex_buffer_slot(cso),
offset, /* offset */
PIPE_PRIM_TRIANGLE_FAN,
4, /* verts */
numAttribs); /* attribs/vert */
pipe_resource_reference(&vbuffer, NULL);
/* restore state */
cso_restore_state(cso);
}
static void
st_DrawTex(struct gl_context *ctx, GLfloat x, GLfloat y, GLfloat z,
GLfloat width, GLfloat height)
{
struct st_context *st = ctx->st;
struct pipe_context *pipe = st->pipe;
struct cso_context *cso = ctx->st->cso_context;
struct pipe_resource *vbuffer;
struct pipe_transfer *vbuffer_transfer;
GLuint i, numTexCoords, numAttribs;
GLboolean emitColor;
uint semantic_names[2 + MAX_TEXTURE_UNITS];
uint semantic_indexes[2 + MAX_TEXTURE_UNITS];
struct pipe_vertex_element velements[2 + MAX_TEXTURE_UNITS];
GLbitfield inputs = VERT_BIT_POS;
st_validate_state(st);
/* determine if we need vertex color */
if (ctx->FragmentProgram._Current->Base.InputsRead & FRAG_BIT_COL0)
emitColor = GL_TRUE;
else
emitColor = GL_FALSE;
/* determine how many enabled sets of texcoords */
numTexCoords = 0;
for (i = 0; i < ctx->Const.MaxTextureUnits; i++) {
if (ctx->Texture.Unit[i]._ReallyEnabled & TEXTURE_2D_BIT) {
inputs |= VERT_BIT_TEX(i);
numTexCoords++;
}
}
/* total number of attributes per vertex */
numAttribs = 1 + emitColor + numTexCoords;
/* create the vertex buffer */
vbuffer = pipe_buffer_create(pipe->screen, PIPE_BIND_VERTEX_BUFFER,
PIPE_USAGE_STREAM,
numAttribs * 4 * 4 * sizeof(GLfloat));
/* load vertex buffer */
{
#define SET_ATTRIB(VERT, ATTR, X, Y, Z, W) \
do { \
GLuint k = (((VERT) * numAttribs + (ATTR)) * 4); \
assert(k < 4 * 4 * numAttribs); \
vbuf[k + 0] = X; \
vbuf[k + 1] = Y; \
vbuf[k + 2] = Z; \
vbuf[k + 3] = W; \
} while (0)
const GLfloat x0 = x, y0 = y, x1 = x + width, y1 = y + height;
GLfloat *vbuf = (GLfloat *) pipe_buffer_map(pipe, vbuffer,
PIPE_TRANSFER_WRITE,
&vbuffer_transfer);
GLuint attr;
z = CLAMP(z, 0.0f, 1.0f);
/* positions (in clip coords) */
{
const struct gl_framebuffer *fb = st->ctx->DrawBuffer;
const GLfloat fb_width = (GLfloat)fb->Width;
const GLfloat fb_height = (GLfloat)fb->Height;
const GLfloat clip_x0 = (GLfloat)(x0 / fb_width * 2.0 - 1.0);
const GLfloat clip_y0 = (GLfloat)(y0 / fb_height * 2.0 - 1.0);
const GLfloat clip_x1 = (GLfloat)(x1 / fb_width * 2.0 - 1.0);
const GLfloat clip_y1 = (GLfloat)(y1 / fb_height * 2.0 - 1.0);
SET_ATTRIB(0, 0, clip_x0, clip_y0, z, 1.0f); /* lower left */
SET_ATTRIB(1, 0, clip_x1, clip_y0, z, 1.0f); /* lower right */
SET_ATTRIB(2, 0, clip_x1, clip_y1, z, 1.0f); /* upper right */
SET_ATTRIB(3, 0, clip_x0, clip_y1, z, 1.0f); /* upper left */
semantic_names[0] = TGSI_SEMANTIC_POSITION;
semantic_indexes[0] = 0;
}
/* colors */
if (emitColor) {
const GLfloat *c = ctx->Current.Attrib[VERT_ATTRIB_COLOR0];
SET_ATTRIB(0, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(1, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(2, 1, c[0], c[1], c[2], c[3]);
SET_ATTRIB(3, 1, c[0], c[1], c[2], c[3]);
semantic_names[1] = TGSI_SEMANTIC_COLOR;
semantic_indexes[1] = 0;
attr = 2;
}
else {
attr = 1;
}
/* texcoords */
for (i = 0; i < ctx->Const.MaxTextureUnits; i++) {
if (ctx->Texture.Unit[i]._ReallyEnabled & TEXTURE_2D_BIT) {
struct gl_texture_object *obj = ctx->Texture.Unit[i]._Current;
struct gl_texture_image *img = obj->Image[0][obj->BaseLevel];
const GLfloat wt = (GLfloat) img->Width;
const GLfloat ht = (GLfloat) img->Height;
const GLfloat s0 = obj->CropRect[0] / wt;
const GLfloat t0 = obj->CropRect[1] / ht;
const GLfloat s1 = (obj->CropRect[0] + obj->CropRect[2]) / wt;
const GLfloat t1 = (obj->CropRect[1] + obj->CropRect[3]) / ht;
/*printf("crop texcoords: %g, %g .. %g, %g\n", s0, t0, s1, t1);*/
SET_ATTRIB(0, attr, s0, t0, 0.0f, 1.0f); /* lower left */
SET_ATTRIB(1, attr, s1, t0, 0.0f, 1.0f); /* lower right */
SET_ATTRIB(2, attr, s1, t1, 0.0f, 1.0f); /* upper right */
SET_ATTRIB(3, attr, s0, t1, 0.0f, 1.0f); /* upper left */
semantic_names[attr] = TGSI_SEMANTIC_GENERIC;
semantic_indexes[attr] = 0;
attr++;
}
}
pipe_buffer_unmap(pipe, vbuffer_transfer);
#undef SET_ATTRIB
}
cso_save_viewport(cso);
cso_save_vertex_shader(cso);
cso_save_vertex_elements(cso);
cso_save_vertex_buffers(cso);
{
void *vs = lookup_shader(pipe, numAttribs,
semantic_names, semantic_indexes);
cso_set_vertex_shader_handle(cso, vs);
}
for (i = 0; i < numAttribs; i++) {
velements[i].src_offset = i * 4 * sizeof(float);
velements[i].instance_divisor = 0;
velements[i].vertex_buffer_index = 0;
velements[i].src_format = PIPE_FORMAT_R32G32B32A32_FLOAT;
}
cso_set_vertex_elements(cso, numAttribs, velements);
/* viewport state: viewport matching window dims */
{
const struct gl_framebuffer *fb = st->ctx->DrawBuffer;
const GLboolean invert = (st_fb_orientation(fb) == Y_0_TOP);
const GLfloat width = (GLfloat)fb->Width;
const GLfloat height = (GLfloat)fb->Height;
struct pipe_viewport_state vp;
vp.scale[0] = 0.5f * width;
vp.scale[1] = height * (invert ? -0.5f : 0.5f);
vp.scale[2] = 1.0f;
vp.scale[3] = 1.0f;
vp.translate[0] = 0.5f * width;
vp.translate[1] = 0.5f * height;
vp.translate[2] = 0.0f;
vp.translate[3] = 0.0f;
cso_set_viewport(cso, &vp);
}
util_draw_vertex_buffer(pipe, cso, vbuffer,
0, /* offset */
PIPE_PRIM_TRIANGLE_FAN,
4, /* verts */
numAttribs); /* attribs/vert */
pipe_resource_reference(&vbuffer, NULL);
/* restore state */
cso_restore_viewport(cso);
cso_restore_vertex_shader(cso);
cso_restore_vertex_elements(cso);
cso_restore_vertex_buffers(cso);
}
/* R function qsort(x, index.return) */
SEXP attribute_hidden do_qsort(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP x, sx;
int indx_ret;
double *vx = NULL;
int *ivx = NULL;
Rboolean x_real, x_int;
checkArity(op, args);
x = CAR(args);
if (!isNumeric(x))
error(_("argument is not a numeric vector"));
x_real= TYPEOF(x) == REALSXP;
x_int = !x_real && (TYPEOF(x) == INTSXP || TYPEOF(x) == LGLSXP);
PROTECT(sx = (x_real || x_int) ? duplicate(x) : coerceVector(x, REALSXP));
SET_ATTRIB(sx, R_NilValue);
SET_OBJECT(sx, 0);
indx_ret = asLogical(CADR(args));
R_xlen_t n = XLENGTH(x);
#ifdef LONG_VECTOR_SUPPORT
Rboolean isLong = n > INT_MAX;
#endif
if(x_int) ivx = INTEGER(sx); else vx = REAL(sx);
if(indx_ret) {
SEXP ans, ansnames, indx;
/* answer will have x = sorted x , ix = index :*/
PROTECT(ans = allocVector(VECSXP, 2));
PROTECT(ansnames = allocVector(STRSXP, 2));
#ifdef LONG_VECTOR_SUPPORT
if (isLong) {
PROTECT(indx = allocVector(REALSXP, n));
double *ix = REAL(indx);
for(R_xlen_t i = 0; i < n; i++) ix[i] = (double) (i+1);
if(x_int) R_qsort_int_R(ivx, ix, 1, n);
else R_qsort_R(vx, ix, 1, n);
} else
#endif
{
PROTECT(indx = allocVector(INTSXP, n));
int *ix = INTEGER(indx);
int nn = (int) n;
for(int i = 0; i < nn; i++) ix[i] = i+1;
if(x_int) R_qsort_int_I(ivx, ix, 1, nn);
else R_qsort_I(vx, ix, 1, nn);
}
SET_VECTOR_ELT(ans, 0, sx);
SET_VECTOR_ELT(ans, 1, indx);
SET_STRING_ELT(ansnames, 0, mkChar("x"));
SET_STRING_ELT(ansnames, 1, mkChar("ix"));
setAttrib(ans, R_NamesSymbol, ansnames);
UNPROTECT(4);
return ans;
} else {
if(x_int)
R_qsort_int(ivx, 1, n);
else
R_qsort(vx, 1, n);
UNPROTECT(1);
return sx;
}
}
