Fix tess.st OpenGL demo
[gst-gobject-introspection:gst-gobject-introspection.git] / packages / opengl / test / tess.st
1 "======================================================================
2 |
3 |   OpenGL gluTess Example
4 |
5 |
6  ======================================================================"
7
8 "======================================================================
9 |
10 | Copyright 2008 Free Software Foundation, Inc.
11 | Written by Paolo Bonzini.
12 |
13 | This file is part of the GNU Smalltalk class library.
14 |
15 | The GNU Smalltalk class library is free software; you can redistribute it
16 | and/or modify it under the terms of the GNU Lesser General Public License
17 | as published by the Free Software Foundation; either version 2.1, or (at
18 | your option) any later version.
19
20 | The GNU Smalltalk class library is distributed in the hope that it will be
21 | useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
23 | General Public License for more details.
24
25 | You should have received a copy of the GNU Lesser General Public License
26 | along with the GNU Smalltalk class library; see the file COPYING.LIB.
27 | If not, write to the Free Software Foundation, 59 Temple Place - Suite
28 | 330, Boston, MA 02110-1301, USA.  
29 |
30  ======================================================================"
31
32
33
34
35 \f
36 Eval [
37     PackageLoader fileInPackage: 'OpenGL'.
38     PackageLoader fileInPackage: 'GLUT'
39 ]
40
41
42 \f
43 Namespace current: OpenGL [
44
45 Object subclass: ColoredVertex [
46     | color vertex |
47
48     ColoredVertex class >> color: c vertex: v [
49         ^self new color: c; vertex: v; yourself
50     ]
51
52     + aColoredVertex [
53         ^self class
54             color: color + aColoredVertex color
55             vertex: vertex + aColoredVertex vertex
56     ]
57
58     * coeff [
59         ^self class color: color * coeff vertex: vertex * coeff
60     ]
61
62     color [ ^color ]
63     color: aColor [ color := aColor ]
64     vertex [ ^vertex ]
65     vertex: aVertex [ vertex := aVertex ]
66
67     x [ ^vertex x ]
68     y [ ^vertex y ]
69     z [ ^vertex z ]
70     x: x [ vertex x: x ]
71     y: y [ vertex y: y ]
72     z: z [ vertex z: z ]
73     w: w [ vertex w: w ]
74 ]
75
76 Object subclass: OpenGLTest [
77     | aWindow windowNumber tess1 tess2 tess3 |
78     
79     <category: 'OpenGL'>
80     <comment: nil>
81
82     init [
83         "Create the window and initialize callbacks"
84
85         <category: 'test'>
86         "An array to store the image"
87         aWindow := Glut new.
88         aWindow glutInit: 'une surface smalltalkienne'.
89         aWindow glutInitDisplayMode: Glut glutRgb.
90         aWindow glutInitWindowSize: (Point x: 300 y: 200).
91         aWindow glutInitWindowPosition: (Point x: 100 y: 100).
92         windowNumber := aWindow glutCreateWindow: 'Tesselation'.
93
94         "Init window color."
95         aWindow glClearColor: Color black.
96         aWindow 
97             callback: Glut displayFuncEvent
98             to: [ self display ].
99         aWindow 
100             callback: Glut reshapeFuncEvent
101             to: [ :w :h | self reshape: w height: h ]
102     ]
103
104     mainIteration [
105         aWindow mainIteration
106     ]
107
108     display [
109         <category: 'test'>
110         | i j |
111         aWindow glClear: OpenGLInterface glColorBufferBit.
112         self displayArrow: -10@0.
113         self displayHollowRectangle: 0@0.
114         self displayStar: 10@0.
115         aWindow glPushMatrix.
116         aWindow glPopMatrix.
117         aWindow glutSwapBuffers
118     ]
119
120     colorAt: point [
121         | ang dist r g b t |
122         ang := point y arcTan: point x.
123         dist := 0@0 dist: point.
124         r := ang sin / 2 + 0.5.
125         g := ang cos / 2 + 0.5.
126         b := 1 - r - g max: 0.
127         t := (r max: g) max: b.
128
129         r := r / t.
130         g := g / t.
131         b := b / t.
132
133         ^Color
134             red: r + ((1 - r) * (1 - dist))
135             green: g + ((1 - g) * (1 - dist))
136             blue: b + ((1 - b) * (1 - dist))
137            
138     ]
139
140     displayStar [
141         tess3 isNil ifTrue: [
142             tess3 := Tesselator new.
143             tess3
144                 gluTessProperty: OpenGLInterface gluTessWindingRule
145                 value: OpenGLInterface gluTessWindingNonzero.
146             tess3
147                 callback: OpenGLInterface gluTessVertex
148                 to: [ :v | aWindow glColor: v color; glVertex: v vertex ] ].
149
150         tess3
151             gluTessBeginPolygon;
152             gluTessBeginContour.
153
154         90 to: 810 by: 144 do: [ :deg || x y |
155             y := deg degreesToRadians sin.
156             x := deg degreesToRadians cos.
157             tess3 gluTessVertex: (ColoredVertex
158                 color: (self colorAt: x@y)
159                 vertex: (Vertex x: x y: y) * 4) ].
160
161         tess3
162             gluTessEndContour;
163             gluTessEndPolygon
164     ]
165
166     displayHollowRectangle [
167         tess2 isNil ifTrue: [ tess2 := Tesselator new ].
168         aWindow glColor: Color white.
169
170         tess2
171             gluTessBeginPolygon;
172             gluTessBeginContour;
173             gluTessVertex: -3 y: -2;
174             gluTessVertex: -3 y: 2;
175             gluTessVertex: 3 y: 2;
176             gluTessVertex: 3 y: -2;
177             gluTessEndContour;
178             gluTessBeginContour;
179             gluTessVertex: 2 y: -1;
180             gluTessVertex: 2 y: 1;
181             gluTessVertex: -2 y: 1;
182             gluTessVertex: -2 y: -1;
183             gluTessEndContour;
184             gluTessEndPolygon
185     ]
186
187     displayArrow [
188         | size |
189         tess1 isNil ifTrue: [
190             tess1 := Tesselator new.
191             tess1
192                 callback: OpenGLInterface gluTessVertex
193                 to: [ :v | aWindow glColor: (self colorAt: v * 0.25); glVertex: v ] ].
194         size := 8 sqrt negated.
195         tess1
196             gluTessBeginPolygon;
197             gluTessBeginContour;
198             gluTessVertex: size negated y: size;
199             gluTessVertex: 0 y: 4;
200             gluTessVertex: size y: size;
201             gluTessVertex: 0 y: 0;
202             gluTessEndContour;
203             gluTessEndPolygon
204     ]
205
206     displayStar: pos [
207         aWindow glPushMatrix.
208         aWindow glTranslatef: pos x y: pos y z: 0.
209         self displayStar.
210         aWindow glPopMatrix
211     ]
212
213     displayHollowRectangle: pos [
214         aWindow glPushMatrix.
215         aWindow glTranslatef: pos x y: pos y z: 0.
216         self displayHollowRectangle.
217         aWindow glPopMatrix
218     ]
219
220     displayArrow: pos [
221         aWindow glPushMatrix.
222         aWindow glTranslatef: pos x y: pos y z: 0.
223         self displayArrow.
224         aWindow glPopMatrix
225     ]
226
227     reshape: w height: h [
228         <category: 'test'>
229         aWindow glViewport: (Vertex x: 0 y: 0) extend: (Vertex x: w y: h).
230         aWindow glMatrixMode: OpenGLInterface glProjection.
231         aWindow glLoadIdentity.
232         w * 2 / 3 <= h
233             ifTrue:
234                 [aWindow
235                     gluOrtho2D: -15.0
236                     right: 15.0
237                     bottom: -15.0 * h / w
238                     top: 15.0 * h / w]
239             ifFalse:
240                 [aWindow
241                     gluOrtho2D: -10.0 * w / h
242                     right: 10.0 * w / h
243                     bottom: -10.0
244                     top: 10.0].
245         aWindow glMatrixMode: OpenGLInterface glModelview.
246         aWindow glLoadIdentity
247     ]
248
249     window [
250         <category: 'access'>
251         ^aWindow
252     ]
253
254     window: a [
255         <category: 'access'>
256         aWindow := a
257     ]
258 ]
259
260 ]
261
262
263 \f
264 Namespace current: OpenGL [
265     OpenGLTest new init; mainIteration.
266     Processor activeProcess suspend
267
268 ]
269