1 /******************************** -*- C -*- ****************************
2 *
3 * OpenGLU gluTess bindings.
4 *
5 *
6 ***********************************************************************/
7
8 /***********************************************************************
9 *
10 * Copyright 2008, 2009 Free Software Foundation, Inc.
11 * Written by Paolo Bonzini.
12 *
13 * This file is part of GNU Smalltalk.
14 *
15 * GNU Smalltalk is free software; you can redistribute it and/or modify it
16 * under the terms of the GNU General Public License as published by the Free
17 * Software Foundation; either version 2, or (at your option) any later
18 * version.
19 *
20 * Linking GNU Smalltalk statically or dynamically with other modules is
21 * making a combined work based on GNU Smalltalk. Thus, the terms and
22 * conditions of the GNU General Public License cover the whole
23 * combination.
24 *
25 * In addition, as a special exception, the Free Software Foundation
26 * give you permission to combine GNU Smalltalk with free software
27 * programs or libraries that are released under the GNU LGPL and with
28 * independent programs running under the GNU Smalltalk virtual machine.
29 *
30 * You may copy and distribute such a system following the terms of the
31 * GNU GPL for GNU Smalltalk and the licenses of the other code
32 * concerned, provided that you include the source code of that other
33 * code when and as the GNU GPL requires distribution of source code.
34 *
35 * Note that people who make modified versions of GNU Smalltalk are not
36 * obligated to grant this special exception for their modified
37 * versions; it is their choice whether to do so. The GNU General
38 * Public License gives permission to release a modified version without
39 * this exception; this exception also makes it possible to release a
40 * modified version which carries forward this exception.
41 *
42 * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
43 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
44 * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
45 * more details.
46 *
47 * You should have received a copy of the GNU General Public License along with
48 * GNU Smalltalk; see the file COPYING. If not, write to the Free Software
49 * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
50 *
51 ***********************************************************************/
52
53 /*
54 this file is distributed under the same terms as GNU Smalltalk
55 */
56 #include "gstopengl.h"
57 #include <stdio.h>
58 #include <stdlib.h>
59 #include <string.h>
60
61 #define nil vm_proxy->nilOOP
62
63
64 #include "gstopengl.h"
65 #include <stdio.h>
66 #include <stdlib.h>
67 #include <string.h>
68
69
70 #define nil vm_proxy->nilOOP
71
72 /* Send the callback message to the receiver */
73 static void
gst_glu_tessCallback_sendMessageTo(OOP receiver,GLenum which,OOP * args,int nArgs)74 gst_glu_tessCallback_sendMessageTo (OOP receiver, GLenum which,
75 OOP* args, int nArgs)
76 {
77 OOP aBlock; /* Callback's block */
78
79 /* Retreive the callback block */
80 vm_proxy->msgSendf (&aBlock, "%o %o getCallback: %i", receiver, which);
81 if (aBlock != nil)
82 vm_proxy->nvmsgSend(aBlock, NULL, args, nArgs);
83 }
84
85 static void
gst_glu_tessCallback_Tess_Begin_Data(GLenum type,void * data)86 gst_glu_tessCallback_Tess_Begin_Data ( GLenum type, void* data )
87 {
88 OOP args[1];
89 args[0] = vm_proxy->intToOOP(type);
90 gst_glu_tessCallback_sendMessageTo((OOP)data, GLU_TESS_BEGIN, args, 1);
91 }
92
93 static void
gst_glu_tessCallback_Tess_Vertex_Data(OOP vertex,void * data)94 gst_glu_tessCallback_Tess_Vertex_Data ( OOP vertex, void* data )
95 {
96 gst_glu_tessCallback_sendMessageTo((OOP)data, GLU_TESS_VERTEX, &vertex, 1);
97 }
98
99 static void
gst_glu_tessCallback_Tess_EdgeFlag_Data(GLenum edge,void * data)100 gst_glu_tessCallback_Tess_EdgeFlag_Data ( GLenum edge, void* data )
101 {
102 OOP args[1];
103 args[0] = vm_proxy->boolToOOP( edge );
104 gst_glu_tessCallback_sendMessageTo((OOP)data, GLU_TESS_EDGE_FLAG, args, 1);
105 }
106
107 static void
gst_glu_tessCallback_Tess_End_Data(void * data)108 gst_glu_tessCallback_Tess_End_Data (void* data )
109 {
110 gst_glu_tessCallback_sendMessageTo((OOP)data, GLU_TESS_END, NULL, 0);
111 }
112
113 static void
gst_glu_tessCallback_Tess_Combine_Data(GLdouble * coords,void ** vertexData,GLfloat * weight,void ** outData,void * data)114 gst_glu_tessCallback_Tess_Combine_Data (GLdouble* coords, void** vertexData,
115 GLfloat* weight, void** outData,
116 void* data)
117 {
118 OOP weightArray, vertexDataArray, coordsArray;
119 int i;
120 OOP *vd = (OOP *) vertexData;
121 OOP tessOOP = data;
122
123 /* Make three arrays from the parameters */
124 coordsArray = vm_proxy->objectAlloc (vm_proxy->arrayClass, 3);
125 for (i = 0; i < 3; ++i)
126 vm_proxy->OOPAtPut (coordsArray, i, vm_proxy->floatToOOP (coords[i]));
127
128 vertexDataArray = vm_proxy->objectAlloc (vm_proxy->arrayClass, 4);
129 for (i = 0; i < 4; ++i)
130 vm_proxy->OOPAtPut (vertexDataArray, i, vd[i]);
131
132 weightArray = vm_proxy->objectAlloc (vm_proxy->arrayClass, 4);
133 for (i = 0; i < 4; ++i)
134 vm_proxy->OOPAtPut (weightArray, i, vm_proxy->floatToOOP (weight[i]));
135
136 /* This callback is mapped in Smalltalk to explicit * and + operations, so we
137 send it directly to the tesselator object. */
138 *outData =
139 vm_proxy->strMsgSend (tessOOP, "combine:data:weights:", coordsArray,
140 vertexDataArray, weightArray, NULL);
141 }
142
143 /* Pointers to the Glu Tess callback functions */
144 struct gst_glu_callback {
145 GLenum which;
146 GLenum whichData;
147 GLUfuncptr func;
148 };
149
150 /* Number of known callbacks */
151 #define N_GLU_CALLBACKS 6
152
153 static struct gst_glu_callback gst_glu_tessCallbackFuncs[] = {
154 { GLU_TESS_BEGIN, GLU_TESS_BEGIN_DATA,
155 (GLUfuncptr) gst_glu_tessCallback_Tess_Begin_Data },
156 { GLU_TESS_VERTEX, GLU_TESS_VERTEX_DATA,
157 (GLUfuncptr) gst_glu_tessCallback_Tess_Vertex_Data },
158 { GLU_TESS_EDGE_FLAG, GLU_TESS_EDGE_FLAG_DATA,
159 (GLUfuncptr) gst_glu_tessCallback_Tess_EdgeFlag_Data },
160 { GLU_TESS_COMBINE, GLU_TESS_COMBINE_DATA,
161 (GLUfuncptr) gst_glu_tessCallback_Tess_Combine_Data },
162 { GLU_TESS_END, GLU_TESS_END_DATA,
163 (GLUfuncptr) gst_glu_tessCallback_Tess_End_Data }
164 };
165
166 /* Retreive the callback index from the Callback contant definition */
167 static struct gst_glu_callback *
gst_glu_tess_getCallbackIndex(GLenum which)168 gst_glu_tess_getCallbackIndex(GLenum which)
169 {
170 int i;
171 for (i = 0; i < N_GLU_CALLBACKS; ++i)
172 /* If function is found, return index */
173 if (gst_glu_tessCallbackFuncs[i].which == which)
174 return &gst_glu_tessCallbackFuncs[i];
175
176 return (struct gst_glu_callback *) NULL;
177 }
178
179
180 static void
gst_opengl_gluTessConnectSignal(GLUtesselator * tess,GLenum which)181 gst_opengl_gluTessConnectSignal (GLUtesselator *tess, GLenum which)
182 {
183 struct gst_glu_callback *cb_data = gst_glu_tess_getCallbackIndex (which);
184
185 if (!cb_data)
186 return; /* Should fire an interrupt */
187
188 /* Add a pointer to the tess object to retreive informations during
189 the callback */
190 gluTessCallback (tess, cb_data->whichData, cb_data->func);
191 }
192
193
194 static GLUtesselator *
gst_opengl_gluNewTess(void)195 gst_opengl_gluNewTess (void)
196 {
197 GLUtesselator *tess = gluNewTess ();
198 gluTessCallback(tess, GLU_TESS_BEGIN, (GLUfuncptr) glBegin);
199 gluTessCallback(tess, GLU_TESS_VERTEX, (GLUfuncptr) gst_opengl_glVertexv);
200 gluTessCallback(tess, GLU_TESS_END, glEnd);
201 return tess;
202 }
203
204 /* Init module */
gst_initModule_gluTess()205 void gst_initModule_gluTess() {
206 vm_proxy = vm_proxy;
207
208 /* Define C Functions */
209 vm_proxy->defineCFunc ("gluNewTess", gst_opengl_gluNewTess);
210 vm_proxy->defineCFunc ("gluDeleteTess", gluDeleteTess);
211 vm_proxy->defineCFunc ("gluTessBeginContour", gluTessBeginContour);
212 vm_proxy->defineCFunc ("gluTessBeginPolygon", gluTessBeginPolygon);
213 vm_proxy->defineCFunc ("gluTessEndContour", gluTessEndContour);
214 vm_proxy->defineCFunc ("gluTessEndPolygon", gluTessEndPolygon);
215 vm_proxy->defineCFunc ("gluTessNormal", gluTessNormal);
216 vm_proxy->defineCFunc ("gluTessProperty", gluTessProperty);
217 vm_proxy->defineCFunc ("gluTessVertex", gluTessVertex);
218 vm_proxy->defineCFunc ("gluTessConnectSignal", gst_opengl_gluTessConnectSignal);
219 }
220
221