/* forgl.c zilla 23apr - export some of SGI GL graphics library to scheme
 * mod 12nov,26sep,22sep
 *
 * distinguish our additional or higher level functions by naming them
 * like gl-word-word naming, versus gl-wordword for a pure gl library function.
 *
 ****NOTE THE ELK COPYING GC: ALL Object REFERENCES MUST BE GC_LINKED
 ****ACROSS CALLS WHICH MAY ALLOCATE STORAGE.  ALL C VARIABLES WHICH 
 ****ARE ASSIGNED FROM THE ADDRESS OF AN OBJECT MUST BE REASSIGNED
 ****AFTER A GC.
 * 
 * Routines which expect char,short can be successfully declared
 * as having int foreign args.  Float/double distinction is tricky however.
 * Under ansi C, any function which is declared in prototype style
 * (presumably including gl library calls) will take and return
 * Floats, not doubles.  Functions which have prototypes but
 * which are themselves declared in the traditional style will
 * take doubles but return floats.
 * Under sgi traditional C, all functions with prototypes will
 * take/return floats, regardless of how the function itself is declared.
 */

#include <theusual.h>

#if Esgi

/* THIS FILE is difficult to compile.  There is a conflict between
 * gl.h Object and scheme.h Object.  It compiled ok with -cckr,
 * but we want to use the new ansi definition macro GLFUNC().
 * Without -cckr, need to define -DSgiAnsi for theusual.h to work.
 * Then, gl.h Object conflicts.  solution--had to #define _XtObject_h,
 * this seems? to fix things.
 */

#ifdef _GL_UNDEF_TYPES
: error gl-undef
#endif

#define _XtObject_h
#include <gl/gl.h>
#include <gl/device.h>

#ifdef Object
  : error Object
#endif

#include <scheme.h>
#include <zelk.h>

/* return mouse x as fraction of window size */
#define MOUSEFX { "gl-mouse-fx", (vfunction *)gl_mouse_fx, "Rf" } ,
float gl_mouse_fx()
{
  long ox,oy,sx,sy;
  getorigin(&ox,&oy);
  getsize(&sx,&sy);
  return (float)(getvaluator(MOUSEX)-ox) / (float)(sx - EfloatC(1.));
}


/* return mouse y as fraction of window size */
#define MOUSEFY { "gl-mouse-fy", (vfunction *)gl_mouse_fy, "Rf" } ,
float gl_mouse_fy()
{
  long ox,oy,sx,sy;
  getorigin(&ox,&oy);
  getsize(&sx,&sy);
  return (float)(getvaluator(MOUSEY)-oy) / (float)(sy - EfloatC(1.));
}


/* read the event queue */
#define QREAD Pqread, "gl-qread", 0,0,EVAL,
extern Object P_Cons Zproto((Object,Object));

static Object Pqread()
{
  long devid;
  short data;
  Object Ocar,Ocdr,Ocons;
  GC_Node2;

  devid = qread(&data);
  GC_Link2(Ocar,Ocdr);
  Ocar = Make_Integer(devid);
  Ocdr = Make_Integer((int4)data);
  Ocons = P_Cons(Ocar,Ocdr);
  GC_Unlink;

  return Ocons;
} /*Pqread*/


#define GETSIZE { "gl-getsize", (vfunction *)Pgetsize, "A" } ,
static void Pgetsize(long s[2])
{   getsize(&(s[0]),&(s[1]));  }


#define GETORIGIN { "gl-getorigin", (vfunction *)Pgetorigin, "A" } ,
static void Pgetorigin(long s[2])
{   getorigin(&(s[0]),&(s[1]));  }


/* ansi version of a macro which automatically adds the prefix gl- */
#define GLFUNC(name,args) \
{ "gl-" # name , (vfunction *)name, args } ,

/* attempt at K&R C version of this macro
#define GLFUNC(name,args) \
{ "gl-name", (vfunction *)name, args } ,
*/


#ifdef ZILLAONLY
/* some test functions */

#include <VF.h>
unsigned long octcolor[6] = {
    0xff0000,			/* [0] = blue */
    0x00ff00,			/* [1] = green */
    0x0000ff,			/* [2] = red */
    0xff00ff,	    		/* [3] = magenta */
    0xffff00,			/* [4] = cyan */
    0xffffff,			/* [5] = white */
};


#define DRAWSTRIP  GLFUNC(drawstrip,"AAI")
static void
drawstrip(row1,row2,stride)
  float *row1,*row2;
  register int stride;
{
  register int i;
  register int len;
  Ztrace(("drawstrip: %.2f %.2f %.2f \n",
          row1[0],row1[1],row1[2]));
  Ztrace(("         : %.2f %.2f %.2f...\n",
          row2[0],row2[1],row2[2]));

  len = VFlen((VF)row1);
  if (VFlen((VF)row2) != len) Panic("drawstrip-length mismatch");

  bgnqstrip();
  shademodel(GOURAUD);
  len /= 3;
  for( i=0; i < len; i++ ) {
/* cpack(octcolor[i%8]); */

    v3f(row1);  v3f(row2);
    row1 += stride;
    row2 += stride;
  }
  endqstrip();
  Ztrace(("--drawstrip\n"));
} /*drawstrip*/


/* drawstrip with corresponding packed colors */
#define DRAWSTRIPCP  GLFUNC(drawstrip_cp,"AAIA")
static void
drawstrip_cp(row1,row2,stride,cp)
  float *row1,*row2;
  register int stride;
  int *cp;
{
  register int i;
  register int len;
  Ztrace(("drawstrip: %.2f %.2f %.2f \n",
          row1[0],row1[1],row1[2]));
  Ztrace(("         : %.2f %.2f %.2f...\n",
          row2[0],row2[1],row2[2]));

  len = VFlen((VF)row1);
  if (VFlen((VF)row2) != len) Panic("drawstrip-length mismatch");

  bgnqstrip();
  shademodel(GOURAUD);
  len /= 3;
  for( i=0; i < len; i++ ) {
    cpack(*cp); cp++;

    v3f(row1);  v3f(row2);
    row1 += stride;
    row2 += stride;
  }
  endqstrip();
  Ztrace(("--drawstrip\n"));
} /*drawstrip-cp*/
#endif /*ZILLAONLY*/





static struct fordef ftab[] = {

/* window constraints */
  GLFUNC(foreground,"")         /* check if obsolete? */
  GLFUNC(prefsize,  "II")
  GLFUNC(prefposition,"IIII")   /*x,dx,y,dy?*/

/* general window */
  GLFUNC(winopen,"SRI")         /* returns a gid */
  GLFUNC(wintitle,"S")
  GLFUNC(winconstraints,"")     /* bind new constraints after creation */
  GLFUNC(reshapeviewport,"")    /* sets view to dimensions of window */
                                /* call whenever window size changes */
  GLFUNC(winset,"I")
  GLFUNC(winclose,"I")
  GETSIZE
  GETORIGIN

  GLFUNC(winpop,"")
  GLFUNC(RGBmode,"")
  GLFUNC(doublebuffer,"")  
  GLFUNC(swapbuffers,"")  
  GLFUNC(zbuffer,"B")
  GLFUNC(gconfig,"")
  GLFUNC(setmonitor,"I")
  
  GLFUNC(gexit,     "")
  GLFUNC(gflush,    "")
  GLFUNC(clear,     "")
  GLFUNC(czclear,   "II")       /* u_long color, long zval */
  GLFUNC(zclear,    "")
  GLFUNC(getgdesc,  "IRI")      /* long,long */

/* input */
  GLFUNC(curson,    "") 
  GLFUNC(cursoff,   "") 

  GLFUNC(qreset,    "")
  GLFUNC(qdevice,   "I")  /*u_short*/
  GLFUNC(qtest,     "RI") /*long*/
  GLFUNC(getvaluator,"IRI")
  MOUSEFX
  MOUSEFY

/* menus */
  GLFUNC(defpup,    "SRI") /* TEMPORARY!! defpup can have args! */
  GLFUNC(freepup,   "I")
  GLFUNC(addtopup,  "IS")
  GLFUNC(dopup,     "IRI")

/* text */
  GLFUNC(cmov2,     "ff") /* 2d position for next string*/
  GLFUNC(charstr,   "S")  /* draw string at current position */

/* views */
  GLFUNC(ortho2,    "ffff")     /* l,r,b,t !! */
  GLFUNC(ortho,    "ffffff")
  GLFUNC(perspective,"Ifff") /*angle is short*/
  GLFUNC(polarview,"fIII")  /* dist, azimuth,incidence,twist */

/* colors */
  GLFUNC(color,     "I") /*integer predefined color e.g. 7=white*/
  GLFUNC(c3i,       "A") /*RGB 0..255*/
  GLFUNC(c3f,       "A") /*RGB 0..1*/
  GLFUNC(cpack,     "I") /*32bit packed*/
  GLFUNC(lmdef,     "IIIA")  /*deftype,index,n, float props[]*/
  GLFUNC(lmbind,    "II") /*short target,index*/
#ifdef no  /* this is in "libgutil". */
  GLFUNC(grey,      "fRI"); /*sets current color to this greylevel, */
                            /*returns colorindex*/
#endif

/* 2d drawing */
  GLFUNC(rect,      "ffff") /* outline rectangle x1,y1, x2,y2 */
  GLFUNC(rectf,     "ffff") /* filled rectangle x1,y1, x2,y2 */

  GLFUNC(bgnline,   "")
  GLFUNC(endline,   "")

/* 3d drawing */
  GLFUNC(bgnpolygon,   "")
  GLFUNC(endpolygon,   "")
  GLFUNC(bgnqstrip,   "")
  GLFUNC(endqstrip,   "")
  GLFUNC(v2i,       "A")
/*  GLFUNC(v3i,       "A") */
  GLFUNC(v2f,       "A")
  GLFUNC(v3f,       "A")
  GLFUNC(n3f,       "A")
  GLFUNC(v4f,       "A")

# ifdef ZILLAONLY
    DRAWSTRIP
    DRAWSTRIPCP
# endif

/* shading, lighting */ 
  GLFUNC(shademodel,"I")

/* matrices */
  GLFUNC(pushmatrix,"")
  GLFUNC(popmatrix,"")
  GLFUNC(loadmatrix,"A")
  GLFUNC(getmatrix,"A")
  GLFUNC(multmatrix,"A")        /* CTM = A*CTM */
  GLFUNC(mmode,"I")             /* matrix mode: SINGLE(default),... */

/* xforms */
  GLFUNC(translate, "fff")
  GLFUNC(scale,     "fff")
  GLFUNC(rot,       "fI")  /*,char*/

  {(char *)0, (vfunction *)0, (char *)0}
};



static struct primdef Prims[] = {
  QREAD
  (Object (*)())0, (char *)0, 0,0,EVAL
};


/*global*/ FORPKG0 pkg_GL = {
    0,				        /*packagetype. 0=current*/
    (int (*)())0,		        /*init_*/
    0,				        /*stab,*/
    (struct fordef *)ftab,	        /*ftab,*/
    (struct fordef_usage *)0	        /*futab,*/
};


void Init_gl()
{
  Zforpkginit("pkg_GL",(PKG_type *)&pkg_GL);
  ZLprimdeftab(Prims);
}


#endif /*Esgi*/
