/***********************************************************

Copyright 1991-1995 by Stichting Mathematisch Centrum, Amsterdam,

The Netherlands.

All Rights Reserved

Permission to use, copy, modify, and distribute this software and its

documentation for any purpose and without fee is hereby granted,

provided that the above copyright notice appear in all copies and that

both that copyright notice and this permission notice appear in

supporting documentation, and that the names of Stichting Mathematisch

Centrum or CWI not be used in advertising or publicity pertaining to

distribution of the software without specific, written prior permission.

STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO

THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND

FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE

FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES

WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN

ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT

OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

******************************************************************/

/*

Input used to generate the Python module "glmodule.c".

The stub generator is a Python script called "cgen.py".

Each definition must be contained on one line:

<returntype> <name> <type> <arg> <type> <arg>

<returntype> can be: void, short, long (XXX maybe others?)

<type> can be: char, string, short, float, long, or double

string indicates a null terminated string;

if <type> is char and <arg> begins with a *, the * is stripped

and <type> is changed into string

<arg> has the form <mode> or <mode>[<subscript>]

where <mode> can be

s: arg is sent

r: arg is received (arg is a pointer)

and <subscript> can be (N and I are numbers):

N

argI

retval

N*argI

N*I

N*retval

In the case where the subscript consists of two parts

separated by *, the first part is the width of the matrix, and

the second part is the length of the matrix. This order is

opposite from the order used in C to declare a two-dimensional

matrix.

*/

/*

* An attempt has been made to make this module switch threads on qread

* calls. It is far from safe, though.

*/

#include <gl.h>

#include <device.h>

#include "allobjects.h"

#include "import.h"

#include "modsupport.h"

#include "cgensupport.h"

#include "ceval.h"

/*

Some stubs are too complicated for the stub generator.

We can include manually written versions of them here.

A line starting with '%' gives the name of the function so the stub

generator can include it in the table of functions.

*/

% qread

static object *

gl_qread(self, args)

object *self;

object *args;

{

long retval;

short arg1 ;

BGN_SAVE

retval = qread( & arg1 );

END_SAVE

{ object *v = newtupleobject( 2 );

if (v == NULL) return NULL;

settupleitem(v, 0, mknewlongobject(retval));

settupleitem(v, 1, mknewshortobject(arg1));

return v;

}

}

/*

varray -- an array of v.. calls.

The argument is an array (maybe list or tuple) of points.

Each point must be a tuple or list of coordinates (x, y, z).

The points may be 2- or 3-dimensional but must all have the

same dimension. Float and int values may be mixed however.

The points are always converted to 3D double precision points

by assuming z=0.0 if necessary (as indicated in the man page),

and for each point v3d() is called.

*/

% varray

static object *

gl_varray(self, args)

object *self;

object *args;

{

object *v, *w;

int i, n, width;

double vec[3];

object * (*getitem) FPROTO((object *, int));

if (!getiobjectarg(args, 1, 0, &v))

return NULL;

if (is_listobject(v)) {

n = getlistsize(v);

getitem = getlistitem;

}

else if (is_tupleobject(v)) {

n = gettuplesize(v);

getitem = gettupleitem;

}

else {

err_badarg();

return NULL;

}

if (n == 0) {

INCREF(None);

return None;

}

if (n > 0)

w = (*getitem)(v, 0);

width = 0;

if (w == NULL) {

}

else if (is_listobject(w)) {

width = getlistsize(w);

}

else if (is_tupleobject(w)) {

width = gettuplesize(w);

}

switch (width) {

case 2:

vec[2] = 0.0;

/* Fall through */

case 3:

break;

default:

err_badarg();

return NULL;

}

for (i = 0; i < n; i++) {

w = (*getitem)(v, i);

if (!getidoublearray(w, 1, 0, width, vec))

return NULL;

v3d(vec);

}

INCREF(None);

return None;

}

/*

vnarray, nvarray -- an array of n3f and v3f calls.

The argument is an array (list or tuple) of pairs of points and normals.

Each pair is a tuple (NOT a list) of a point and a normal for that point.

Each point or normal must be a tuple (NOT a list) of coordinates (x, y, z).

Three coordinates must be given. Float and int values may be mixed.

For each pair, n3f() is called for the normal, and then v3f() is called

for the vector.

vnarray and nvarray differ only in the order of the vector and normal in

the pair: vnarray expects (v, n) while nvarray expects (n, v).

*/

static object *gen_nvarray(); /* Forward */

% nvarray

static object *

gl_nvarray(self, args)

object *self;

object *args;

{

return gen_nvarray(args, 0);

}

% vnarray

static object *

gl_vnarray(self, args)

object *self;

object *args;

{

return gen_nvarray(args, 1);

}

/* Generic, internal version of {nv,nv}array: inorm indicates the

argument order, 0: normal first, 1: vector first. */

static object *

gen_nvarray(args, inorm)

object *args;

int inorm;

{

object *v, *w, *wnorm, *wvec;

int i, n;

float norm[3], vec[3];

object * (*getitem) FPROTO((object *, int));

if (!getiobjectarg(args, 1, 0, &v))

return NULL;

if (is_listobject(v)) {

n = getlistsize(v);

getitem = getlistitem;

}

else if (is_tupleobject(v)) {

n = gettuplesize(v);

getitem = gettupleitem;

}

else {

err_badarg();

return NULL;

}

for (i = 0; i < n; i++) {

w = (*getitem)(v, i);

if (!is_tupleobject(w) || gettuplesize(w) != 2) {

err_badarg();

return NULL;

}

wnorm = gettupleitem(w, inorm);

wvec = gettupleitem(w, 1 - inorm);

if (!getifloatarray(wnorm, 1, 0, 3, norm) ||

!getifloatarray(wvec, 1, 0, 3, vec))

return NULL;

n3f(norm);

v3f(vec);

}

INCREF(None);

return None;

}

/* nurbssurface(s_knots[], t_knots[], ctl[][], s_order, t_order, type).

The dimensions of ctl[] are computed as follows:

[len(s_knots) - s_order], [len(t_knots) - t_order]

*/

% nurbssurface

static object *

gl_nurbssurface(self, args)

object *self;

object *args;

{

long arg1 ;

double * arg2 ;

long arg3 ;

double * arg4 ;

double *arg5 ;

long arg6 ;

long arg7 ;

long arg8 ;

long ncoords;

long s_byte_stride, t_byte_stride;

long s_nctl, t_nctl;

long s, t;

object *v, *w, *pt;

double *pnext;

if (!getilongarraysize(args, 6, 0, &arg1))

return NULL;

if ((arg2 = NEW(double, arg1 )) == NULL) {

return err_nomem();

}

if (!getidoublearray(args, 6, 0, arg1 , arg2))

return NULL;

if (!getilongarraysize(args, 6, 1, &arg3))

return NULL;

if ((arg4 = NEW(double, arg3 )) == NULL) {

return err_nomem();

}

if (!getidoublearray(args, 6, 1, arg3 , arg4))

return NULL;

if (!getilongarg(args, 6, 3, &arg6))

return NULL;

if (!getilongarg(args, 6, 4, &arg7))

return NULL;

if (!getilongarg(args, 6, 5, &arg8))

return NULL;

if (arg8 == N_XYZ)

ncoords = 3;

else if (arg8 == N_XYZW)

ncoords = 4;

else {

err_badarg();

return NULL;

}

s_nctl = arg1 - arg6;

t_nctl = arg3 - arg7;

if (!getiobjectarg(args, 6, 2, &v))

return NULL;

if (!is_listobject(v) || getlistsize(v) != s_nctl) {

err_badarg();

return NULL;

}

if ((arg5 = NEW(double, s_nctl*t_nctl*ncoords )) == NULL) {

return err_nomem();

}

pnext = arg5;

for (s = 0; s < s_nctl; s++) {

w = getlistitem(v, s);

if (w == NULL || !is_listobject(w) ||

getlistsize(w) != t_nctl) {

err_badarg();

return NULL;

}

for (t = 0; t < t_nctl; t++) {

pt = getlistitem(w, t);

if (!getidoublearray(pt, 1, 0, ncoords, pnext))

return NULL;

pnext += ncoords;

}

}

s_byte_stride = sizeof(double) * ncoords;

t_byte_stride = s_byte_stride * s_nctl;

nurbssurface( arg1 , arg2 , arg3 , arg4 ,

s_byte_stride , t_byte_stride , arg5 , arg6 , arg7 , arg8 );

DEL(arg2);

DEL(arg4);

DEL(arg5);

INCREF(None);

return None;

}

/* nurbscurve(knots, ctlpoints, order, type).

The length of ctlpoints is len(knots)-order. */

%nurbscurve

static object *

gl_nurbscurve(self, args)

object *self;

object *args;

{

long arg1 ;

double * arg2 ;

long arg3 ;

double * arg4 ;

long arg5 ;

long arg6 ;

int ncoords, npoints;

int i;

object *v;

double *pnext;

if (!getilongarraysize(args, 4, 0, &arg1))

return NULL;

if ((arg2 = NEW(double, arg1 )) == NULL) {

return err_nomem();

}

if (!getidoublearray(args, 4, 0, arg1 , arg2))

return NULL;

if (!getilongarg(args, 4, 2, &arg5))

return NULL;

if (!getilongarg(args, 4, 3, &arg6))

return NULL;

if (arg6 == N_ST)

ncoords = 2;

else if (arg6 == N_STW)

ncoords = 3;

else {

err_badarg();

return NULL;

}

npoints = arg1 - arg5;

if (!getiobjectarg(args, 4, 1, &v))

return NULL;

if (!is_listobject(v) || getlistsize(v) != npoints) {

err_badarg();

return NULL;

}

if ((arg4 = NEW(double, npoints*ncoords )) == NULL) {

return err_nomem();

}

pnext = arg4;

for (i = 0; i < npoints; i++) {

if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))

return NULL;

pnext += ncoords;

}

arg3 = (sizeof(double)) * ncoords;

nurbscurve( arg1 , arg2 , arg3 , arg4 , arg5 , arg6 );

DEL(arg2);

DEL(arg4);

INCREF(None);

return None;

}

/* pwlcurve(points, type).

Points is a list of points. Type must be N_ST. */

%pwlcurve

static object *

gl_pwlcurve(self, args)

object *self;

object *args;

{

object *v;

long type;

double *data, *pnext;

long npoints, ncoords;

int i;

if (!getiobjectarg(args, 2, 0, &v))

return NULL;

if (!getilongarg(args, 2, 1, &type))

return NULL;

if (!is_listobject(v)) {

err_badarg();

return NULL;

}

npoints = getlistsize(v);

if (type == N_ST)

ncoords = 2;

else {

err_badarg();

return NULL;

}

if ((data = NEW(double, npoints*ncoords)) == NULL) {

return err_nomem();

}

pnext = data;

for (i = 0; i < npoints; i++) {

if (!getidoublearray(getlistitem(v, i), 1, 0, ncoords, pnext))

return NULL;

pnext += ncoords;

}

pwlcurve(npoints, data, sizeof(double)*ncoords, type);

DEL(data);

INCREF(None);

return None;

}

/* Picking and Selecting */

static short *pickbuffer = NULL;

static long pickbuffersize;

static object *

pick_select(args, func)

object *args;

void (*func)();

{

if (!getilongarg(args, 1, 0, &pickbuffersize))

return NULL;

if (pickbuffer != NULL) {

err_setstr(RuntimeError,

"pick/gselect: already picking/selecting");

return NULL;

}

if ((pickbuffer = NEW(short, pickbuffersize)) == NULL) {

return err_nomem();

}

(*func)(pickbuffer, pickbuffersize);

INCREF(None);

return None;

}

static object *

endpick_select(args, func)

object *args;

long (*func)();

{

object *v, *w;

int i, nhits, n;

if (!getnoarg(args))

return NULL;

if (pickbuffer == NULL) {

err_setstr(RuntimeError,

"endpick/endselect: not in pick/select mode");

return NULL;

}

nhits = (*func)(pickbuffer);

if (nhits < 0) {

nhits = -nhits; /* How to report buffer overflow otherwise? */

}

/* Scan the buffer to see how many integers */

n = 0;

for (; nhits > 0; nhits--) {

n += 1 + pickbuffer[n];

}

v = newlistobject(n);

if (v == NULL)

return NULL;

/* XXX Could do it nicer and interpret the data structure here,

returning a list of lists. But this can be done in Python... */

for (i = 0; i < n; i++) {

w = newintobject((long)pickbuffer[i]);

if (w == NULL) {

DECREF(v);

return NULL;

}

setlistitem(v, i, w);

}

DEL(pickbuffer);

pickbuffer = NULL;

return v;

}

extern void pick(), gselect();

extern long endpick(), endselect();

%pick

static object *gl_pick(self, args) object *self, *args; {

return pick_select(args, pick);

}

%endpick

static object *gl_endpick(self, args) object *self, *args; {

return endpick_select(args, endpick);

}

%gselect

static object *gl_gselect(self, args) object *self, *args; {

return pick_select(args, gselect);

}

%endselect

static object *gl_endselect(self, args) object *self, *args; {

return endpick_select(args, endselect);

}

/* XXX The generator botches this one. Here's a quick hack to fix it. */

/* XXX The generator botches this one. Here's a quick hack to fix it. */

% getmatrix float r[16]

static object *

gl_getmatrix(self, args)

object *self;

object *args;

{

Matrix arg1;

object *v, *w;

int i, j;

getmatrix( arg1 );

v = newlistobject(16);

if (v == NULL) {

return err_nomem();

}

for (i = 0; i < 4; i++) for (j = 0; j < 4; j++) {

w = mknewfloatobject(arg1[i][j]);

if (w == NULL) {

DECREF(v);

return NULL;

}

setlistitem(v, i*4+j, w);

}

return v;

}

/* Here's an alternate version that returns a 4x4 matrix instead of

a vector. Unfortunately it is incompatible with loadmatrix and

multmatrix... */

% altgetmatrix float r[4][4]

static object *

gl_altgetmatrix(self, args)

object *self;

object *args;

{

Matrix arg1;

object *v, *w;

int i, j;

getmatrix( arg1 );

v = newlistobject(4);

if (v == NULL) {

return NULL;

}

for (i = 0; i < 4; i++) {

w = newlistobject(4);

if (w == NULL) {

DECREF(v);

return NULL;

}

setlistitem(v, i, w);

}

for (i = 0; i < 4; i++) {

for (j = 0; j < 4; j++) {

w = mknewfloatobject(arg1[i][j]);

if (w == NULL) {

DECREF(v);

return NULL;

}

setlistitem(getlistitem(v, i), j, w);

}

}

return v;

}

% lrectwrite

static object *

gl_lrectwrite(self, args)

object *self;

object *args;

{

short x1 ;

short y1 ;

short x2 ;

short y2 ;

string parray ;

object *s;

int pixcount;

if (!getishortarg(args, 5, 0, &x1))

return NULL;

if (!getishortarg(args, 5, 1, &y1))

return NULL;

if (!getishortarg(args, 5, 2, &x2))

return NULL;

if (!getishortarg(args, 5, 3, &y2))

return NULL;

if (!getistringarg(args, 5, 4, &parray))

return NULL;

if (!getiobjectarg(args, 5, 4, &s))

return NULL;

#if 0

/* Don't check this, it breaks experiments with pixmode(PM_SIZE, ...) */

pixcount = (long)(x2+1-x1) * (long)(y2+1-y1);

if (!is_stringobject(s) || getstringsize(s) != pixcount*sizeof(long)) {

err_setstr(RuntimeError,

"string arg to lrectwrite has wrong size");

return NULL;

}

#endif

lrectwrite( x1 , y1 , x2 , y2 , (unsigned long *) parray );

INCREF(None);

return None;

}

% lrectread

static object *

gl_lrectread(self, args)

object *self;

object *args;

{

short x1 ;

short y1 ;

short x2 ;

short y2 ;

object *parray;

int pixcount;

if (!getishortarg(args, 4, 0, &x1))

return NULL;

if (!getishortarg(args, 4, 1, &y1))

return NULL;

if (!getishortarg(args, 4, 2, &x2))

return NULL;

if (!getishortarg(args, 4, 3, &y2))

return NULL;

pixcount = (long)(x2+1-x1) * (long)(y2+1-y1);

parray = newsizedstringobject((char *)NULL, pixcount*sizeof(long));

if (parray == NULL)

return NULL; /* No memory */

lrectread(x1, y1, x2, y2, (unsigned long *) getstringvalue(parray));

return parray;

}

% readdisplay

static object *

gl_readdisplay(self, args)

object *self;

object *args;

{

short x1, y1, x2, y2;

unsigned long *parray, hints;

long size, size_ret;

object *rv;

if ( !getargs(args, "hhhhl", &x1, &y1, &x2, &y2, &hints) )

return 0;

size = (long)(x2+1-x1) * (long)(y2+1-y1);

rv = newsizedstringobject((char *)NULL, size*sizeof(long));

if ( rv == NULL )

return NULL;

parray = (unsigned long *)getstringvalue(rv);

size_ret = readdisplay(x1, y1, x2, y2, parray, hints);

if ( size_ret != size ) {

printf("gl_readdisplay: got %d pixels, expected %d\n",

size_ret, size);

err_setstr(RuntimeError, "readdisplay returned unexpected length");

return NULL;

}

return rv;

}

/* Desperately needed, here are tools to compress and decompress

the data manipulated by lrectread/lrectwrite.

gl.packrect(width, height, packfactor, bigdata) --> smalldata

makes 'bigdata' 4*(packfactor**2) times smaller by:

- turning it into B/W (a factor 4)

- replacing squares of size pacfactor by one

representative

gl.unpackrect(width, height, packfactor, smalldata) --> bigdata

is the inverse; the numeric arguments must be *the same*.

Both work best if width and height are multiples of packfactor

(in fact unpackrect will leave garbage bytes).

*/

% packrect

static object *

gl_packrect(self, args)

object *self;

object *args;

{

long width, height, packfactor;

char *s;

object *unpacked, *packed;

int pixcount, packedcount, x, y, r, g, b;

unsigned long pixel;

unsigned char *p;

unsigned long *parray;

if (!getilongarg(args, 4, 0, &width))

return NULL;

if (!getilongarg(args, 4, 1, &height))

return NULL;

if (!getilongarg(args, 4, 2, &packfactor))

return NULL;

if (!getistringarg(args, 4, 3, &s)) /* For type checking only */

return NULL;

if (!getiobjectarg(args, 4, 3, &unpacked))

return NULL;

if (width <= 0 || height <= 0 || packfactor <= 0) {

err_setstr(RuntimeError, "packrect args must be > 0");

return NULL;

}

pixcount = width*height;

packedcount = ((width+packfactor-1)/packfactor) *

((height+packfactor-1)/packfactor);

if (getstringsize(unpacked) != pixcount*sizeof(long)) {

err_setstr(RuntimeError,

"string arg to packrect has wrong size");

return NULL;

}

packed = newsizedstringobject((char *)NULL, packedcount);

if (packed == NULL)

return NULL;

parray = (unsigned long *) getstringvalue(unpacked);

p = (unsigned char *) getstringvalue(packed);

for (y = 0; y < height; y += packfactor, parray += packfactor*width) {

for (x = 0; x < width; x += packfactor) {

pixel = parray[x];

r = pixel & 0xff;

g = (pixel >> 8) & 0xff;

b = (pixel >> 16) & 0xff;

*p++ = (30*r+59*g+11*b) / 100;

}

}

return packed;

}

% unpackrect

static unsigned long unpacktab[256];

static int unpacktab_inited = 0;

static object *

gl_unpackrect(self, args)

object *self;

object *args;

{

long width, height, packfactor;

char *s;

object *unpacked, *packed;

int pixcount, packedcount, y;

register unsigned char *p;

register unsigned long *parray;

if (!unpacktab_inited) {

register int white;

for (white = 256; --white >= 0; )

unpacktab[white] = white * 0x010101L;

unpacktab_inited++;

}

if (!getilongarg(args, 4, 0, &width))

return NULL;

if (!getilongarg(args, 4, 1, &height))

return NULL;

if (!getilongarg(args, 4, 2, &packfactor))

return NULL;

if (!getistringarg(args, 4, 3, &s)) /* For type checking only */

return NULL;

if (!getiobjectarg(args, 4, 3, &packed))

return NULL;

if (width <= 0 || height <= 0 || packfactor <= 0) {

err_setstr(RuntimeError, "packrect args must be > 0");

return NULL;

}

pixcount = width*height;

packedcount = ((width+packfactor-1)/packfactor) *

((height+packfactor-1)/packfactor);

if (getstringsize(packed) != packedcount) {

err_setstr(RuntimeError,

"string arg to unpackrect has wrong size");

return NULL;

}

unpacked = newsizedstringobject((char *)NULL, pixcount*sizeof(long));

if (unpacked == NULL)

return NULL;

parray = (unsigned long *) getstringvalue(unpacked);

p = (unsigned char *) getstringvalue(packed);

if (packfactor == 1 && width*height > 0) {

/* Just expand bytes to longs */

register int x = width * height;

do {

*parray++ = unpacktab[*p++];

} while (--x >= 0);

}

else {

register int y;

for (y = 0; y < height-packfactor+1;

y += packfactor, parray += packfactor*width) {

register int x;

for (x = 0; x < width-packfactor+1; x += packfactor) {

register unsigned long pixel = unpacktab[*p++];

register int i;

for (i = packfactor*width; (i-=width) >= 0;) {

register int j;

for (j = packfactor; --j >= 0; )

parray[i+x+j] = pixel;

}

}

}

}

return unpacked;

}

% gversion

static object *

gl_gversion(self, args)

object *self;

object *args;

{

char buf[20];

gversion(buf);

return newstringobject(buf);

}

/* End of manually written stubs */

%%

long getshade

if !solaris void devport short s long s

void rdr2i long s long s

void rectfs short s short s short s short s

void rects short s short s short s short s

void rmv2i long s long s

void noport

void popviewport

void clear

void clearhitcode

void closeobj

void cursoff

void curson

void doublebuffer

void finish

void gconfig

void ginit

void greset

void multimap

void onemap

void popattributes

void popmatrix

void pushattributes

void pushmatrix

void pushviewport

void qreset

void RGBmode

void singlebuffer

void swapbuffers

void gsync

void gflush

void tpon

void tpoff

void clkon

void clkoff

void ringbell

#void callfunc

void gbegin

void textinit

void initnames

void pclos

void popname

if !solaris void spclos

void zclear

void screenspace

void reshapeviewport

void winpush

void winpop

void foreground

void endfullscrn

if !solaris void endpupmode

void fullscrn

if !solaris void pupmode

void winconstraints

void pagecolor short s

void textcolor short s

void color short s

void curveit short s

void font short s

void linewidth short s

void setlinestyle short s

void setmap short s

void swapinterval short s

void writemask short s

if !solaris void textwritemask short s

void qdevice short s

void unqdevice short s

void curvebasis short s

void curveprecision short s

void loadname short s

void passthrough short s

void pushname short s

void setmonitor short s

if !solaris void setshade short s

void setpattern short s

if !solaris void pagewritemask short s

#

void callobj long s

void delobj long s

void editobj long s

void makeobj long s

void maketag long s

void chunksize long s

void compactify long s

void deltag long s

void lsrepeat long s

void objinsert long s

void objreplace long s

void winclose long s

void blanktime long s

void freepup long s

# This is not in the library!?

###void pupcolor long s

#

void backbuffer long s

void frontbuffer long s

if !solaris void lsbackup long s

void resetls long s

void lampon long s

void lampoff long s

void setbell long s

void blankscreen long s

void depthcue long s

void zbuffer long s

void backface long s

#

void cmov2i long s long s

void draw2i long s long s

void move2i long s long s

void pnt2i long s long s

void patchbasis long s long s

void patchprecision long s long s

void pdr2i long s long s

void pmv2i long s long s

void rpdr2i long s long s

void rpmv2i long s long s

void xfpt2i long s long s

void objdelete long s long s

void patchcurves long s long s

void minsize long s long s

void maxsize long s long s

void keepaspect long s long s