lablgl-1.05/000755 000765 000024 00000000000 12217024422 013640 5ustar00garriguestaff000000 000000 lablgl-1.05/.cvsignore000644 000765 000024 00000000020 12217024174 015634 0ustar00garriguestaff000000 000000 Makefile.config lablgl-1.05/CHANGES000644 000765 000024 00000006304 12217024174 014642 0ustar00garriguestaff000000 000000 LablGL 1.05: ------------ 2013-09-20: * make it work with the OCaml 4.01 windows installer (both lablglut and togl) 2013-09-11: * add configuration file for Ubuntu 2012-10-18: * allow building with make -j 2012-06-05: * switch to Togl 1.7, doesn't need Tk internals anymore 2012-03-06: * add `bgr and `bgra to Gl.format and GlTex.format (reported by Vu Ngoc San) 2010-06-16: * fix Glut.special_of_int to raise no exception (reported by malc) 2010-03-11: * merge glShader support by Florent Monnier LablGL 1.04: ------------ 2008-12-21: * support windows compilation for ocaml 3.11 2008-10-25: * support Tcl/Tk 8.5 * require Raw.static in GlArray (reported by malc) * check for GL_ARB_texture_non_power_of_two in GlTex (reported by malc) 2008-01-10: * fix GlMap.eval_coord2 (reported by Florent Monnier) LablGL 1.03: --------------------- 2007-04-13: [Jacques] * add glPolygonOffset * fix Glut.createMenu * fix GlTex.gen_textures 2006-07-29: [Jacques] * make LablGlut's callback window dependent * simplify glutInit 2006-03-23: [Jacques] * avoid all uses of stderr in stubs (caused incompatibilities) * use mingw import libraries * mingw build works again (but togl only works in dll mode) LablGL 1.02: ------------ 2005-10-28: [Jacques] * fix GlMat.mult_transpose (Gregory Guyomarc'h) 2005-10-20: [Jacques] * correct GlTex.image2d border bug (Eric Cooper) 2005-10-14: [Jacques] * add glGetError 2004-07-20: [Jacques] * add index_logic_op and color_logic_op LablGL 1.01: ------------ 2004-07-13: [Jacques] * merge Jon Harrop's tesselator support LablGL 1.00: ------------ 2003-10-01: [Jacques] * split togl, move examples to Togl/examples * add mingw support 2003-09-29: [Jacques] * reorganized directories and Makefiles 2003-09-25: [Christophe] * merge ijtrotts' LablGlut 2003-09-24: [Christophe] * add glArray support LablGL 0.99: ------------ * add texture binding functions, contributed by Chris Hecker * add support for Tcl/Tk8.4 * allow compiling and installing without Tk LablGL 0.98: ------------ * add windows port * add lablGL.spec (Ben Martin) * add GLU_VERSION and GLU_EXTENSIONS tags * check returned strings LablGL 0.97: ------------ * support ocaml 3.04 LablGL 0.96: ------------ * adapt to new label mode / new variant syntax * split library into lablgl.cma and togl.cma to support ocaml dynamic linking LablGL 0.95: ------------ * corrected variant matching for Objective Caml 3.01 * add variance annotations * some bug fixes LablGL 0.94: ------------ * corrected syntax for Objective Caml 3.00 LablGL 0.93: ------------ * use Objective Caml 2.99 instead of Objective Label. * a few functions changed, to comply with the new semantics for optional arguments. * togl.cmo is not included in lablgl.cma, to allow easy linking with lablgtk. LablGL 0.92: ------------ * allow use of newer patch levels for Tk. * corrected bugs in the Raw module. Now, it handles correctly alignment constraints on doubles. * added the Raw.sub function, which extracts a slice from an existing raw array. Values are still physically shared with the original array. LablGL 0.91: ------------ * switched to Togl-1.5. The previous versions had problems on Linux. LablGL 0.9: ----------- * first public release lablgl-1.05/COPYRIGHT000644 000765 000024 00000002735 12217024174 015146 0ustar00garriguestaff000000 000000 Copyright (c) 1997-2001 Jacques Garrigue and Kyoto University. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lablgl-1.05/LablGlut/000755 000765 000024 00000000000 12217024174 015352 5ustar00garriguestaff000000 000000 lablgl-1.05/Makefile000644 000765 000024 00000001776 12217024174 015317 0ustar00garriguestaff000000 000000 # Main Makefile, to compile subdirectories # default LIBDIR = `ocamlc -where` INSTALLDIR = $(LIBDIR)/lablGL DLLDIR = $(LIBDIR)/stublibs CONFIG = Makefile.config include $(CONFIG) all: lib togl glut opt: libopt toglopt glutopt lib: cd src && $(MAKE) all LIBDIR="$(LIBDIR)" libopt: cd src && $(MAKE) opt togl: lib cd Togl/src && $(MAKE) all toglopt: libopt cd Togl/src && $(MAKE) opt glut: lib cd LablGlut/src && $(MAKE) glutopt: libopt cd LablGlut/src && $(MAKE) opt preinstall: cd src && $(MAKE) preinstall INSTALLDIR="$(INSTALLDIR)" DLLDIR="$(DLLDIR)" cd Togl/src && $(MAKE) preinstall INSTALLDIR="$(INSTALLDIR)" DLLDIR="$(DLLDIR)" cd LablGlut/src && $(MAKE) preinstall INSTALLDIR="$(INSTALLDIR)" DLLDIR="$(DLLDIR)" install: @$(MAKE) real-install INSTALLDIR="$(INSTALLDIR)" DLLDIR="$(DLLDIR)" real-install: cd src && $(MAKE) install cd Togl/src && $(MAKE) install cd LablGlut/src && $(MAKE) install clean: cd src && $(MAKE) clean cd Togl/src && $(MAKE) clean cd LablGlut/src && $(MAKE) clean lablgl-1.05/Makefile.common000644 000765 000024 00000002013 12217024174 016567 0ustar00garriguestaff000000 000000 # Common parts of the Makefile, shared by everybody # Ocaml commands CAMLC=ocamlc CAMLOPT=ocamlopt COMPILER=$(CAMLC) -c -w s OPTCOMP=$(CAMLOPT) -c LIBRARIAN=ocamlmklib OPTLIB=$(CAMLOPT) -a LINKER=$(CAMLC) OPTLINK=$(CAMLOPT) SRCDIR=$(TOPDIR)/src VAR2DEF=ocamlrun $(SRCDIR)/var2def VAR2SWITCH=ocamlrun $(SRCDIR)/var2switch # Default settings CONFIG = $(TOPDIR)/Makefile.config LIBDIR = `$(CAMLC) -where` DLLDIR = $(LIBDIR)/stublibs INSTALLDIR = $(LIBDIR)/lablGL TOGLDIR = Togl TOGL_WS = TOGL_X11 COPTS = -c -O # Default toolchain (unix) TOOLCHAIN = unix XA = .a XB = XE = XO = .o XS = .so # Windows specific MKLIB=link /lib /nologo /debugtype:CV /out: MKDLL=link /nologo /dll /out: OCAMLDLL= "$(LIBDIR)/ocamlrun$(XA)" include $(CONFIG) # Default rules .SUFFIXES: .ml .mli .cmo .cmi .cmx .c .var .h .opt $(XA) $(XO) $(XE) .d$(XO) .ml.cmo: $(COMPILER) $(OCAMLINC) $< .ml.cmx: $(OPTCOMP) $(OCAMLINC) $< .mli.cmi: $(COMPILER) $(OCAMLINC) $< .c$(XO): $(COMPILER) -ccopt "$(COPTS) $(INCLUDES)" $< .var.h: $(VAR2DEF) < $< > $@ lablgl-1.05/Makefile.config.ex000644 000765 000024 00000003322 12217024174 017163 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # ##### Adjust these always # Uncomment if you have the fast ".opt" compilers #CAMLC = ocamlc.opt #CAMLOPT = ocamlopt.opt # Where to put the lablgl script BINDIR = /usr/local/bin # Where to find X headers XINCLUDES = -I/usr/X11R6/include # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) #XLIBS = -L/usr/X11R6/lib -lXext -lXmu -lX11 -lXi # Where to find Tcl/Tk headers # This must the same version as for LablTk TKINCLUDES = -I/usr/local/include # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) #TKLIBS = -L/usr/local/lib -ltk84 -ltcl84 # Where to find OpenGL/Mesa/Glut headers and libraries GLINCLUDES = GLLIBS = -lGL -lGLU GLUTLIBS = -lglut # The following libraries may be required (try to add them one at a time) #GLLIBS = -lGL -lGLU -lXmu -lXext -lXi -lcipher -lpthread # How to index a library after installing (ranlib required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TKLIBS = tk83.lib tcl83.lib gdi32.lib user32.lib #GLLIBS = opengl32.lib glu32.lib #TOOLCHAIN = msvc #XA = .lib #XB = .bat #XE = .exe #XO = .obj #XS = .dll ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # Togl Window System # Should be one of TOGL_X11, TOGL_WGL (windows), TOGL_AGL (macosx) # TOGL_AGL isn't supported currently #TOGL_WS = TOGL_X11 # C Compiler options #COPTS = -c -O lablgl-1.05/Makefile.config.freebsd000644 000765 000024 00000002757 12217024174 020174 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # # Makefile.config that has been tested under FreeBSD 4.8 ##### Adjust these always # Where to put the lablgl script BINDIR = /usr/local/bin # Where to find X headers XINCLUDES = -I/usr/X11R6/include # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) XLIBS = -L/usr/X11R6/lib -lXext -lXmu -lX11 # Where to find Tcl/Tk headers # This must the same version as for LablTk TKINCLUDES = -I/usr/local/include/tcl8.4 -I/usr/local/include/tk8.4 # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) TKLIBS = -L/usr/local/lib -ltk84 -ltcl84 # Where to find OpenGL/Mesa headers and libraries GLINCLUDES = GLLIBS = -lGL -lGLU GLUTLIBS = -lglut # The following libraries may be required (try to add them one at a time) # How to index a library after installing (required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TKLIBS = tk83.lib tcl83.lib gdi32.lib user32.lib #GLLIBS = opengl32.lib glu32.lib #TOOLCHAIN = msvc #XA = .lib #XB = .bat #XE = .exe #XO = .obj #XS = .dll ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # C Compiler options #COPTS = -c -O lablgl-1.05/Makefile.config.linux.mdk000644 000765 000024 00000002641 12217024174 020463 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # # Makefile.config that has been tested under Linux Mandrake 9.1 ##### Adjust these always # Where to put the lablgl script BINDIR = /usr/local/bin # Where to find X headers XINCLUDES = -I/usr/X11R6/include # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) XLIBS = -L/usr/X11R6/lib -lXext -lXmu -lX11 # Where to find Tcl/Tk headers # This must the same version as for LablTk TKINCLUDES = # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) TKLIBS = # Where to find OpenGL/Mesa headers and libraries GLINCLUDES = GLLIBS = -lGL -lGLU GLUTLIBS = -lglut # The following libraries may be required (try to add them one at a time) # How to index a library after installing (required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TKLIBS = tk83.lib tcl83.lib gdi32.lib user32.lib #GLLIBS = opengl32.lib glu32.lib #TOOLCHAIN = msvc #XA = .lib #XB = .bat #XE = .exe #XO = .obj #XS = .dll ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # C Compiler options #COPTS = -c -O lablgl-1.05/Makefile.config.mingw000644 000765 000024 00000004414 12217024174 017673 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # ##### Adjust these always # Uncomment if you have the fast ".opt" compilers CAMLC = ocamlc.opt CAMLOPT = ocamlopt.opt LIBRARIAN = ocamlmklib -verbose -ocamlc ocamlc -ocamlopt ocamlopt # Where to put the lablgl script OCAMLDIR = c:/OCaml BINDIR = $(OCAMLDIR)/bin DLLDIR = $(OCAMLDIR)/lib/stublibs INSTALLDIR = $(OCAMLDIR)/lib/lablGL # Where to find X headers #XINCLUDES = -I/usr/X11R6/include # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) #XLIBS = -L/usr/X11R6/lib -lXext -lXmu -lX11 # Where to find Tcl/Tk headers # This must the same version as for LablTk TK_ROOT = C:/Tcl TKINCLUDES = -I"$(TK_ROOT)/include" # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) #TKLIBS = -ltk83 -ltcl83 #TKLIBS = -ldopt "$(TK_ROOT)/bin/tcl85.dll" -ldopt "$(TK_ROOT)/bin/tk85.dll" TKLIBS0 = -L$(TK_ROOT)/lib tcl85.lib tk85.lib -lws2_32 -luser32 -lgdi32 TKLIBS = -ldopt -L$(TK_ROOT)/bin -ldopt tcl85.dll -ldopt tk85.dll \ -ccopt -L$(TK_ROOT)/lib -cclib tcl85.lib -cclib tk85.lib \ -lws2_32 -luser32 -lgdi32 # Where to find OpenGL/Mesa/Glut headers and libraries GLINCLUDES = -DHAS_GLEXT_H -DGL_GLEXT_PROTOTYPES -DGLU_VERSION_1_3 GLLIBS = -lglu32 -lopengl32 GLLIBS0 = $(GLLIBS) GLUTLIBS = -lglut32 GLUTLIBS0 = $(GLUTLIBS) # The following libraries may be required (try to add them one at a time) #GLLIBS = -lGL -lGLU -lXmu -lXext -lXi -lcipher -lpthread # How to index a library after installing (ranlib required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TOOLCHAIN = msvc XB = .bat XE = .exe XS = .dll MKLIB = ar rcs MKDLL = gcc -mno-cygwin -shared -o ##### Adjust these if non standard # The Objective Caml library directory # must set it by hand as spaces are not allowed #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # Togl Window System # Should be one of TOGL_X11, TOGL_WGL (windows), TOGL_AGL (macosx) # TOGL_AGL isn't supported currently TOGL_WS = TOGL_WGL # C Compiler options COPTS = -c -O -DHAS_SYS_TIME lablgl-1.05/Makefile.config.msvc000644 000765 000024 00000003773 12217024174 017531 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # ##### Adjust these always # Uncomment if you have the fast ".opt" compilers CAMLC = ocamlc.opt CAMLOPT = ocamlopt.opt LIBRARIAN = ocamlmklib -verbose -ocamlc ocamlc -ocamlopt ocamlopt # Where to put the lablgl script OCAMLDIR = c:/Program Files/Objective Caml MSVC BINDIR = $(OCAMLDIR)/bin DLLDIR = $(OCAMLDIR)/lib/stublibs INSTALLDIR = $(OCAMLDIR)/lib/lablGL # Where to find X headers XINCLUDES = -I/usr/X11R6/include # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) #XLIBS = -L/usr/X11R6/lib -lXext -lXmu -lX11 # Where to find Tcl/Tk headers # This must the same version as for LablTk TK_ROOT = C:/Tcl TKINCLUDES = -I$(TK_ROOT)/include # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) TKLIBS0 = -L$(TK_ROOT)/lib tk84.lib tcl84.lib gdi32.lib user32.lib TKLIBS = -ldopt "$(TKLIBS0)" -cclib "$(TKLIBS0)" # Where to find OpenGL/Mesa/Glut headers and libraries GLINCLUDES = GLLIBS0 = opengl32.lib glu32.lib GLLIBS = -ldopt "$(GLLIBS0)" -cclib "$(GLLIBS0)" GLUTLIBS0 = glut32.lib GLUTLIBS = -ldopt "$(GLUTLIBS0)" -cclib "$(GLUTLIBS0)" # The following libraries may be required (try to add them one at a time) #GLLIBS = -lGL -lGLU -lXmu -lXext -lXi -lcipher -lpthread # How to index a library after installing (ranlib required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TOOLCHAIN = msvc XA = .lib XB = .bat XE = .exe XO = .obj XS = .dll ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # Togl Window System # Should be one of TOGL_X11, TOGL_WGL (windows), TOGL_AGL (macosx) # TOGL_AGL isn't supported currently TOGL_WS = TOGL_WGL # C Compiler options COPTS = -c lablgl-1.05/Makefile.config.osx000644 000765 000024 00000002644 12217024174 017366 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # ##### Adjust these always # Uncomment if you have the fast ".opt" compilers CAMLC = ocamlc.opt CAMLOPT = ocamlopt.opt # Where to put the lablgl script BINDIR = /usr/local/bin # Where to find Tcl/Tk headers # This must be the same version as for LablTk # On OSX, Togl works only with the X11 version of Tk # Here we use the X11 version of tk and mesa installed by macports # While we only use the GLX part of mesa, the libGL.dylib in # /usr/X11/lib is not compatible with macports. TKINCLUDES = -I/opt/local/include # Libs for Togl TKLIBS = -L/opt/local/lib -lGL -lXmu # Where to find OpenGL/Mesa headers and libraries GLINCLUDES = GLLIBS = -framework OpenGL GLUTLIBS = -framework GLUT # How to index a library after installing (ranlib required on MacOSX) RANLIB = ranlib ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # Togl Window System # Should be one of TOGL_X11, TOGL_WGL (windows), TOGL_AGL (macosx) # TOGL_AGL isn't supported currently #TOGL_WS = TOGL_X11 # C Compiler options #COPTS = -c -O lablgl-1.05/Makefile.config.ubuntu000644 000765 000024 00000002620 12217024174 020071 0ustar00garriguestaff000000 000000 # LablGL and Togl configuration file # # Please have a look at the config/Makefile in the Objective Caml distribution, # or at the labltklink script to get the information needed here # # Makefile.config that has been tested under Linux Mandrake 9.1 ##### Adjust these always # Where to put the lablgl script BINDIR = /usr/local/bin # Where to find X headers XINCLUDES = # X libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) XLIBS = -lXext -lXmu -lX11 # Where to find Tcl/Tk headers # This must the same version as for LablTk TKINCLUDES = -I/usr/include/tcl8.5 # Tcl/Tk libs (for broken RTLD_GLOBAL: e.g. FreeBSD 4.0) TKLIBS = # Where to find OpenGL/Mesa headers and libraries GLINCLUDES = GLLIBS = -lGL -lGLU GLUTLIBS = -lglut # The following libraries may be required (try to add them one at a time) # How to index a library after installing (required on MacOSX) RANLIB = : #RANLIB = ranlib ##### Uncomment these for windows #TKLIBS = tk83.lib tcl83.lib gdi32.lib user32.lib #GLLIBS = opengl32.lib glu32.lib #TOOLCHAIN = msvc #XA = .lib #XB = .bat #XE = .exe #XO = .obj #XS = .dll ##### Adjust these if non standard # The Objective Caml library directory #LIBDIR = `ocamlc -where` # Where to put dlls (if dynamic loading available) #DLLDIR = `ocamlc -where`/stublibs # Where to put LablGL (standard) #INSTALLDIR = $(LIBDIR)/lablGL # Where is Togl (default) #TOGLDIR = Togl # C Compiler options #COPTS = -c -O lablgl-1.05/META000644 000765 000024 00000000654 12217024174 014322 0ustar00garriguestaff000000 000000 description "Bindings for OpenGL" version="1.05" directory="+lablGL" archive(byte) = "lablgl.cma" archive(native) = "lablgl.cmxa" package "togl" ( exists_if = "togl.cma,togl.cmxa" requires = "labltk lablgl" archive(byte) = "togl.cma" archive(native) = "togl.cmxa" ) package "glut" ( exists_if = "lablglut.cma,lablglut.cmxa" requires = "lablgl" archive(byte) = "lablglut.cma" archive(native) = "lablglut.cmxa" )lablgl-1.05/README000644 000765 000024 00000024677 12217024174 014544 0ustar00garriguestaff000000 000000 LablGL 1.05: Installation and Use instructions 1. Description LablGL is an OpenGL interface for Objective Caml. It includes two interfaces: the Togl widget, for comfortable use with LablTk, and LablGlut for standalone applications not using Tcl/Tk. 2. Requisites * Objective Caml 3.05 to 4.01 * LablTk (included in Objective Caml, requires Tcl/Tk) for Togl support * OpenGL * glut (included in Mesa) for glut support * GNU make (for conditionals) Objective Caml can be obtained from http://caml.inria.fr/ocaml/ OpenGL (with hardware support) may already be on your machine. XFree86 supports the GLX protocol since version 4.0, with hardware acceleration on some platforms. It is available on most recent Linux configurations. If you are not lucky enough to have built-in OpenGL support, you can still use Mesa, an openGL-compatible freeware, which works on almost everything. http://www.mesa3d.org/ LablGl also uses the Togl widget, but the code is already included in this distribution (version 1.7). You may obtain more information about Togl at: http://www.mesa3d.org/brianp/Togl.html Note that Togl is only compatible with vanilla Tcl/Tk: specially patched versions may not work. For instance 8.2.3+ included in old debian distributions does not work. LablGlut requires glut, which is already included in recent versions of Mesa and XFree86. For windows you need to obtain it from http://www.xmission.com/~nate/glut.html 3. Installation Precompiled versions of lablGL are available for Windows, and a number of Unix versions. For Linux, just install the package. Windows binary distribution: The file lablgl-1.05-win32.zip supports the mingw windows installer for ocaml 4.01. a) Install the lablGL distribution. The simplest way is to use the command-line version of unzip, and unpack it on top of your Objective Caml distribution. C:\Program Files\Objective Caml> unzip lablgl-1.04-win32.zip If you unpacked it somewhere else you must copy manually the contents of the bin, lib\stublibs and lib\lablGL directories to the corresponding directories of the Objective Caml distribution. b) Compile the Caml parts. Go to the lib\lablGL directory, and execute the following command C:\...\lib\lablGL\> ocaml build.ml It will generate the bytecode and native versions of the library. Note that every time you install a new version of Objective Caml you will need to repeat this last step. Look carefully at the last line of output of this script, it should tell you which ocaml port you are using. If the guess is wrong, you edit build.ml to correct this. c) For glut support, download glut32.dll and copy it to the bin directory of the OCaml distribution (or somewhere else in your path.) After this, you should be able to compile and run programs as either bytecode or native code. Compilation from source (if there is no package): 0) On MacOSX, if you want to use Togl, you must use the X11 version of Tcl/Tk. Here we assume that ocaml was installed from macports. Then you must also install the mesa port from macports, to obtain a compatible version of GLX. a) Create Makefile.config. Some tested configurations are provided. If none of them fits your needs, start with Makefile.config.ex. b) Build LablGL with both Togl(Tcl/Tk) and Glut support. % make If you need only Togl support, do % make togl If you need only Glut support, do % make glut If you need neither (use the library with lablGtk for instance) % make lib c) For the native code version (you need the native code version of LablTk), % make opt Similarly, you can also do % make {toglopt,glutopt,libopt} d) Install LablGL % make install This will install all the available parts. To compile for Windows, Makefile.config.msvc and Makefile.config.mingw are provided. Note however that the DLL produced for Togl by mingw does not work with the ocaml 3.11 binary distribution, you must use the one produced by MSVC, included in the binary distribution above. 4. Use Examples are in the Togl/examples and LablGlut/examples directories. * The lablgl toplevel This is a toplevel, like ocaml, including LablTk, Unix, Str, LablGL and Togl. You may use it either as a toplevel, or directly to run scripts. To run an example in Togl/examples, type: % lablgl example.ml where example.ml is one of: (by order of complexity) simple.ml scene.ml checker.ml double.ml planet.ml texturesurf.ml gears.ml morph3d.ml tennis.ml Note that some XFree86 do not seem to support single buffer rendering. The first 3 examples will not work in that case. * Similarely, there is a lablglut toplevel. For instance, move to the folder LablGlut/examples/lablGL and type % lablglut gears.ml * compiling and linking You need to include either labltk.cma, lablgl.cma and togl.cma or' lablgl.cma and lablglut.cma in your link: ocamlc -I +labltk -I +lablGL \ labltk.cma lablgl.cma togl.cma ... -o program ocamlc -I +lablGL lablgl.cma lablglut.cma ... -o program 5. Writing programs All of the GL and GLU libraries are available. Read a good book about how to use these. Translating from OpenGL to LablGL is rather straightforward: there is a LablGL function for each OpenGL one. For ease of retrieving, both GL and GLU are cut in smaller modules of related functions. See in appendix A which modules your function is in. By default it has the same name, gl or glu omited, and capitals replaced by underscores. When arguments are labelled, the names are taken from the man page or the C prototype. OpenGL makes heavy use of enumerations, with names starting with GL_ or GLU_ . Since their meaning is often overloaded, they are all converted to polymorphic variants. In most cases just replace prefix by a backquote and convert to low case. When you have a doubt the best way is to have a look with OCamlBrowser. Using Togl is also straightforward. Everything works like in LablTk. You create an openGL widget with Togl.create, and then you apply various functions on it. See Togl's README in Togl/src/Togl/README for details. To use LablGlut you need to look at glut's documentation on your system. The approach is close to LablGL's. 6. Comments and bug reports mailto:garrigue@kurims.kyoto-u.ac.jp This library has been tested on a number of programs, but this is far from testing all of OpenGL functionality. There are bugs, but at least we didn't find any in our examples. 7. Authors Jacques Garrigue, Isaac Trotts, Erick Tryzelaar and Christophe Raffali participated to this release. A. Modules There are 12 modules for GL and 5 modules for GLU. Modules marked with (*) contain LablGL specific functions. Gl: Common data types and functions. glFlush glFinish glEnable glDisable glIsEnabled glGetError GlArray: Array functions glEdgeFlagPointer -> edge_flag glTexCoordPointer -> tex_coord glIndexPointer -> index glNormalPointer -> normal glVertexPointer -> vertex glEnableClientState -> enable glDisableClientState -> disable glArrayElement -> element glDrawArrays glDrawElements GlClear: Clearing functions. glClear glClearAccum -> accum glClearColor -> color glClearDepth -> depth glClearIndex -> index glClearStencil -> stencil GlDraw: Drawing functions. glBegin -> begins glColor glCullFace glEdgeFlag glEnd -> ends glFrontFace glIndex glLineStipple glLineWidth glNormal glPointSize glPolygonOffset glPolygonMode glPolygonStipple glRect glShadeModel glVertex glViewport GlFunc: Filtering functions. glAccum glAlphaFunc glBlendFunc glColorMask glDepthFunc glDepthMask glDrawBuffer glIndexMask glLogicOp glReadBuffer glStencilFunc glStencilMask glStencilOp GlLight: Lighting functions. glColorMaterial glFog glLight glLightModel (gl 1.2 with `color_control) glMaterial GlList: Call list functions. (*) glCallList -> call glCallLists glDeleteLists glEndList -> ends glGenLists glIsList glNewList -> begins GlMap: Map and meshes functions. glEvalCoord1 glEvalCoord2 glEvalMesh1 glEvalMesh2 glEvalPoint1 glEvalPoint2 glMap1 glMap2 glMapGrid1 -> grid1 glMapGrid2 -> grid2 GlMat: Matrix functions. (*) glFrustum glLoadIdentity glLoadMatrix -> load glLoadTransposeMatrix -> load_transpose (gl 1.3) glMatrixMode -> mode glMultMatrix -> mult glMultTransposeMatrix -> mult_transpose (gl 1.3) glOrtho glPopMatrix -> pop glPushMatrix -> push glRotate glScale glTranslate glGetDoublev -> get_matrix (only for modelview, projection, and texture) GlMisc: Miscellanous functions. glClipPlane glGetString glHint glInitNames glLoadName glPassThrough glPopAttrib glPopName glPushAttrib glPushName glRenderMode glScissor glSelectBuffer GlPix: Rasterized pixel functions. (*) glBitmap glCopyPixels -> copy glDrawPixels -> draw glPixelMap -> map glPixelStore -> store glPixelTransfer -> transfer glPixelZoom -> zoom glRasterPos glReadPixels -> read GlTex: Texturing functions. glTexCoord -> coord glTexEnv -> env glTexGen -> gen glTexImage1D -> image1d glTexImage2D -> image2d glTexParameter -> parameter (gl 1.4 with generate_mipmap) GluMat: GLU matrix functions. gluLookAt gluOrtho2D gluPerspective gluPickMatrix gluProject gluUnProject GluMisc: GLU miscellanous functions. gluBuild1DMipmaps gluBuild2DMipmaps gluGetString gluScaleImage GluNurbs: Nurbs functions. gluBeginCurve gluBeginSurface gluBeginTrim gluEndCurve gluEndSurface gluEndTrim gluLoadSamplingMatrices gluNewNurbsRenderer -> create gluNurbsCurve -> curve gluNurbsProperty -> property gluNurbsPwlCurve -> pwl_curve gluNurbsSurface -> surface GluQuadric: Quadric functions. gluCylinder gluDisk gluNewQuadric -> create gluPartialDisk gluQuadricDrawStyle -> draw_style gluQuadricNormals -> normals gluQuadricOrientation -> orientation gluQuadricTexture -> texture gluSphere GluTess: Tessalating functions. Only glu 1.2 API is supported. Either render directly or produce lists of triangles. lablgl-1.05/src/000755 000765 000024 00000000000 12217024174 014433 5ustar00garriguestaff000000 000000 lablgl-1.05/Togl/000755 000765 000024 00000000000 12217024174 014551 5ustar00garriguestaff000000 000000 lablgl-1.05/Togl/examples/000755 000765 000024 00000000000 12217024174 016367 5ustar00garriguestaff000000 000000 lablgl-1.05/Togl/src/000755 000765 000024 00000000000 12217024174 015340 5ustar00garriguestaff000000 000000 lablgl-1.05/Togl/src/.cvsignore000644 000765 000024 00000000056 12217024174 017341 0ustar00garriguestaff000000 000000 lablgl lablgltop *_tags.c *_tags.h dll* *.lib lablgl-1.05/Togl/src/.depend000644 000765 000024 00000000050 12217024174 016573 0ustar00garriguestaff000000 000000 togl.cmo: togl.cmi togl.cmx: togl.cmi lablgl-1.05/Togl/src/lablgl.bat000755 000765 000024 00000000201 12217024174 017261 0ustar00garriguestaff000000 000000 @rem toplevel for lablgl with Togl support ocaml -I +labltk -I +lablGL labltk.cma lablgl.cma togl.cma %1 %2 %3 %4 %5 %6 %7 %8 %9 lablgl-1.05/Togl/src/Makefile000644 000765 000024 00000005111 12217024174 016776 0ustar00garriguestaff000000 000000 # Include shared parts TOPDIR = ../.. include $(TOPDIR)/Makefile.common # Composite options INCLUDES = -I$(SRCDIR) -I$(TOGLDIR) \ $(TKINCLUDES) -I. $(GLINCLUDES) $(XINCLUDES) LIBS = $(TKLIBS) $(GLLIBS) $(XLIBS) LIBDIRS = ifeq (TOGL_WS,TOGL_X11) COPTS += -DUSE_TCL_STUBS -DUSE_TK_STUBS endif OCAMLINC=-I +labltk -I $(SRCDIR) # Files TOGLOBJS = ml_togl$(XO) $(TOGLDIR)/togl$(XO) # Extra rules .cmx.opt: $(TOPDIR)/src/lablgl.cmxa togl.cmxa $(OPTLINK) -o $@ $(OCAMLINC) -ccopt -L. \ unix.cmxa labltk.cmxa ../../lablgl.cmxa togl.cmxa $< all: lablgltop$(XE) lablgl$(XB) opt: togl.cmxa libtogl.a: togl.cma togl.cma: togl.cmo $(TOGLOBJS) $(CONFIG) $(LIBRARIAN) -o togl togl.cmo $(TOGLOBJS) $(GLLIBS) $(TKLIBS) $(XLIBS) togl.cmxa: togl.cmx $(TOGLOBJS) $(CONFIG) $(LIBRARIAN) -o togl togl.cmx $(TOGLOBJS) $(GLLIBS) $(TKLIBS) $(XLIBS) $(TOGLDIR)/togl$(XO): $(TOGLDIR)/togl.c $(TOPDIR)/Makefile.config cd $(TOGLDIR) && \ $(CAMLC) -verbose -c -ccopt "-D$(TOGL_WS) $(COPTS) $(INCLUDES)" togl.c lablgltop$(XE): ../../src/lablgl.cma togl.cma ocamlmktop $(CUSTOMTOP) -I . $(OCAMLINC) -o $@ \ labltk.cma lablgl.cma togl.cma lablgl: $(CONFIG) Makefile libtogl$(XA) $(MAKE) INSTALLDIR="$(INSTALLDIR)" real-$@ real-lablgl: @echo generate lablgl echo "#!/bin/sh" > lablgl echo "# toplevel with lablGL and Togl" >> lablgl if test -f dlltogl$(XS); then \ echo 'exec ocaml -I +labltk -I "$(INSTALLDIR)" lablgl.cma labltk.cma togl.cma $$*' >> lablgl; \ else echo 'exec "$(INSTALLDIR)/lablgltop" -I +labltk -I "$(INSTALLDIR)" $$*' >> lablgl; fi chmod 755 lablgl togl_tags.c: togl_tags.var $(VAR2SWITCH) TOGL_ < togl_tags.var > $@ preinstall: cp togl.mli togl.ml libtogl$(XA) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) libtogl$(XA) @if test -f dlltogl$(XS); then $(MAKE) installdll; \ else $(MAKE) installtop; fi cp lablgl$(XB) "$(BINDIR)" install: @if test -f lablgltop$(XE); then $(MAKE) toglinstall; fi toglinstall: preinstall cp togl.cmi togl.cma $(INSTTOP) "$(INSTALLDIR)" @if test -f togl.cmxa; then $(MAKE) toglinstallopt; fi installdll: cp dlltogl$(XS) "$(DLLDIR)" installtop: cp lablgltop$(XE) "$(INSTALLDIR)" toglinstallopt: cp togl.cmxa togl$(XA) togl.cmx "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) togl$(XA) clean: rm -f *.cm* *.o *.obj *.so *.lib *.a *.dll *.exe *.opt *_tags.c \ *_tags.h *~ lablgltop$(EX) lablgl rm -f $(TOGLDIR)/Makefile $(TOGLDIR)/*.o $(TOGLDIR)/*.obj depend: ocamldep -pp camlp4o *.ml *.mli > .depend #dependencies ml_tk$(XO): $(TOPDIR)/src/ml_gl.h tk_tags.h tk_tags.c ml_togl$(XO) : $(TOPDIR)/src/ml_gl.h togl_tags.h togl_tags.c include .depend lablgl-1.05/Togl/src/ml_togl.c000644 000765 000024 00000010713 12217024174 017143 0ustar00garriguestaff000000 000000 /* $Id: ml_togl.c,v 1.16 2006-03-23 06:01:55 garrigue Exp $ */ #ifdef _WIN32 #include #endif #include #ifdef __APPLE__ #include #else #include #endif #include #include #include #include #include #include #include #include "togl.h" #include "ml_gl.h" #include "togl_tags.h" /* extern Tcl_Interp *cltclinterp; */ /* The Tcl interpretor */ /* extern void tk_error (char *message); */ /* Raise TKerror */ int TOGLenum_val(value tag) { switch(tag) { #include "togl_tags.c" } invalid_argument ("Unknown Togl tag"); } /* Avoid direct use of stderr */ void togl_prerr(const char *msg) { value ml_msg = copy_string(msg); value *prerr = caml_named_value("togl_prerr"); if (!prerr) caml_failwith(msg); caml_callback_exn(*prerr, ml_msg); } CAMLprim value ml_Togl_Init (value unit) /* ML */ { value *interp = caml_named_value("cltclinterp"); Tcl_Interp *cltclinterp = (interp ? (Tcl_Interp *) Nativeint_val(Field(*interp,0)) : NULL); if (cltclinterp == NULL || Togl_Init(cltclinterp) == TCL_ERROR) raise_with_string(*caml_named_value("tkerror"), "Togl_Init failed"); return Val_unit; } /* Does not register the structure with Caml ! static value Val_togl (struct Togl *togl) { value wrapper = alloc(1,No_scan_tag); Field(wrapper,0) = (value) togl; return wrapper; } */ enum { CreateFunc = 0, DisplayFunc, ReshapeFunc, DestroyFunc, TimerFunc, OverlayDisplayFunc, RenderFunc, LastFunc }; static value *callbacks = NULL; #define CALLBACK(func) \ static void callback_##func (struct Togl *togl) \ { callback (Field(*callbacks, func), Val_addr(togl)); } #define CALLBACK_const(func) \ static void callback_##func (const struct Togl *togl) \ { callback (Field(*callbacks, func), Val_addr(togl)); } #define ENABLER(func) \ CAMLprim value ml_Togl_##func (value unit) \ { if (callbacks == NULL) callbacks = caml_named_value ("togl_callbacks"); \ Togl_##func (callback_##func); \ return Val_unit; } CALLBACK (CreateFunc) CALLBACK (DisplayFunc) CALLBACK (ReshapeFunc) CALLBACK (DestroyFunc) CALLBACK (TimerFunc) CALLBACK (OverlayDisplayFunc) CALLBACK_const (RenderFunc) ENABLER (CreateFunc) ENABLER (DisplayFunc) ENABLER (ReshapeFunc) ENABLER (DestroyFunc) ENABLER (TimerFunc) ENABLER (OverlayDisplayFunc) ML_0 (Togl_ResetDefaultCallbacks) ML_1 (Togl_PostRedisplay, Addr_val) ML_1 (Togl_SwapBuffers, Addr_val) ML_1_ (Togl_Ident, Addr_val, copy_string) ML_1_ (Togl_Width, Addr_val, Val_int) ML_1_ (Togl_Height, Addr_val, Val_int) CAMLprim value ml_Togl_LoadBitmapFont (value togl, value font) /* ML */ { char *fontname = NULL; if (Is_block(font)) fontname = String_val (Field(font,0)); else switch (font) { case MLTAG_Fixed_8x13: fontname = TOGL_BITMAP_8_BY_13; break; case MLTAG_Fixed_9x15: fontname = TOGL_BITMAP_9_BY_15; break; case MLTAG_Times_10: fontname = TOGL_BITMAP_TIMES_ROMAN_10; break; case MLTAG_Times_24: fontname = TOGL_BITMAP_TIMES_ROMAN_24; break; case MLTAG_Helvetica_10: fontname = TOGL_BITMAP_HELVETICA_10; break; case MLTAG_Helvetica_12: fontname = TOGL_BITMAP_HELVETICA_12; break; case MLTAG_Helvetica_18: fontname = TOGL_BITMAP_HELVETICA_18; break; } return Val_int (Togl_LoadBitmapFont (Addr_val(togl), fontname)); } ML_2 (Togl_UnloadBitmapFont, Addr_val, Int_val) ML_2 (Togl_UseLayer, Addr_val, TOGLenum_val) #ifdef _WIN32 CAMLprim value ml_Togl_ShowOverlay(value v) { invalid_argument("Togl_ShowOverlay: not implemented"); return Val_unit; } #else ML_1 (Togl_ShowOverlay, Addr_val) #endif ML_1 (Togl_HideOverlay, Addr_val) ML_1 (Togl_PostOverlayRedisplay, Addr_val) ML_1_ (Togl_ExistsOverlay, Addr_val, Val_int) ML_1_ (Togl_GetOverlayTransparentValue, Addr_val, Val_int) CAMLprim value ml_Togl_DumpToEpsFile (value togl, value filename, value rgb) { if (callbacks == NULL) callbacks = caml_named_value ("togl_callbacks"); if (Togl_DumpToEpsFile(Addr_val(togl), String_val(filename), Int_val(rgb), callback_RenderFunc) == TCL_ERROR) raise_with_string(*caml_named_value("tkerror"), "Dump to EPS file failed"); return Val_unit; } #if 0 && defined(_WIN32) && !defined(CAML_DLL) && (WINVER < 0x0500) /* VC7 or later, building with pre-VC7 runtime libraries */ long _ftol( double ); /* defined by VC6 C libs */ long _ftol2( double dblSource ) { return _ftol( dblSource ); } #endif lablgl-1.05/Togl/src/Togl/000755 000765 000024 00000000000 12217024174 016245 5ustar00garriguestaff000000 000000 lablgl-1.05/Togl/src/togl.ml000644 000765 000024 00000017432 12217024174 016646 0ustar00garriguestaff000000 000000 (* $Id: togl.ml,v 1.23 2006-03-23 00:39:27 garrigue Exp $ *) open StdLabels open Tk open Protocol let may x name f = match x with None -> [] | Some a -> [TkToken name; TkToken (f a)] let cbool x = if x then "1" else "0" let cint = string_of_int let id x = x let togl_options_optionals f = fun ?accum ?accumalphasize ?accumbluesize ?accumgreensize ?accumredsize ?alpha ?alphasize ?auxbuffers ?bluesize ?depth ?depthsize ?double ?greensize ?height (* ?ident *) ?overlay ?privatecmap ?redsize ?rgba ?stencil ?stencilsize ?stereo (* ?time *) ?width -> f (may accum "-accum" cbool @ may accumalphasize "-accumalphasize" cint @ may accumbluesize "-accumbluesize" cint @ may accumgreensize "-accumgreensize" cint @ may accumredsize "-accumredsize" cint @ may alpha "-alpha" cbool @ may alphasize "-alphasize" cint @ may auxbuffers "-auxbuffers" cint @ may bluesize "-bluesize" cint @ may depth "-depth" cbool @ may depthsize "-depthsize" cint @ may double "-double" cbool @ may greensize "-greensize" cint @ may height "-height" cint (* @ may ident "-ident" id *) @ may overlay "-overlay" cbool @ may privatecmap "-privatecmap" cbool @ may redsize "-redsize" cint @ may rgba "-rgba" cbool @ may stencil "-stencil" cbool @ may stencilsize "-stencilsize" cint @ may stereo "-stereo" cbool (* @ may time "-time" cint *) @ may width "-width" cint) type t external init : unit -> unit = "ml_Togl_Init" external _create_func : unit -> unit = "ml_Togl_CreateFunc" external _display_func : unit -> unit = "ml_Togl_DisplayFunc" external _reshape_func : unit -> unit = "ml_Togl_ReshapeFunc" external _destroy_func : unit -> unit = "ml_Togl_DestroyFunc" external _timer_func : unit -> unit = "ml_Togl_TimerFunc" external _overlay_display_func : unit -> unit = "ml_Togl_OverlayDisplayFunc" external _reset_default_callbacks : unit -> unit = "ml_Togl_ResetDefaultCallbacks" external _post_redisplay : t -> unit = "ml_Togl_PostRedisplay" external _swap_buffers : t -> unit = "ml_Togl_SwapBuffers" external _ident : t -> string = "ml_Togl_Ident" external _height : t -> int = "ml_Togl_Height" external _width : t -> int = "ml_Togl_Width" type font = [ `Fixed_8x13 | `Fixed_9x15 | `Times_10 | `Times_24 | `Helvetica_10 | `Helvetica_12 | `Helvetica_18 | `Xfont of string ] external _load_bitmap_font : t -> font:font -> GlList.base = "ml_Togl_LoadBitmapFont" external _unload_bitmap_font : t -> base:GlList.base -> unit = "ml_Togl_UnloadBitmapFont" external _use_layer : t -> num:int -> unit = "ml_Togl_UseLayer" external _show_overlay : t -> unit = "ml_Togl_ShowOverlay" external _hide_overlay : t -> unit = "ml_Togl_HideOverlay" external _post_overlay_redisplay : t -> unit = "ml_Togl_PostOverlayRedisplay" external _exists_overlay : t -> bool = "ml_Togl_ExistsOverlay" external _get_overlay_transparent_value : t -> int = "ml_Togl_GetOverlayTransparentValue" external _dump_to_eps_file : t -> string -> bool -> unit = "ml_Togl_DumpToEpsFile" type w type widget = w Widget.widget let togl_table = Hashtbl.create 7 let wrap f (w : widget) = let togl = try Hashtbl.find togl_table w with Not_found -> raise (TkError "Unreferenced togl widget") in f togl let render = wrap _post_redisplay let swap_buffers = wrap _swap_buffers let height = wrap _height let width = wrap _width let load_bitmap_font = wrap _load_bitmap_font let unload_bitmap_font = wrap _unload_bitmap_font let use_layer = wrap _use_layer let show_overlay = wrap _show_overlay let hide_overlay = wrap _hide_overlay let overlay_redisplay = wrap _post_overlay_redisplay let exists_overlay = wrap _exists_overlay let get_overlay_transparent_value = wrap _get_overlay_transparent_value let make_current togl = ignore (tkEval [|TkToken (Widget.name togl); TkToken "makecurrent"|]) let null_func _ = () let display_table = Hashtbl.create 7 and reshape_table = Hashtbl.create 7 and overlay_table = Hashtbl.create 7 let cb_of_togl table togl = try let key = _ident togl in let cb = Hashtbl.find table key in ignore (tkEval [|TkToken key; TkToken "makecurrent"|]); cb () with Not_found -> () let create_id = 0 and display_id = 1 and reshape_id = 2 and destroy_id = 3 and timer_id = 4 and overlay_display_id = 5 and render_id = 6 let callback_table = [|null_func; cb_of_togl display_table; cb_of_togl reshape_table; null_func; null_func; cb_of_togl overlay_table; null_func|] let () = Callback.register "togl_callbacks" callback_table; (* Also export an error-reporting function *) Callback.register "togl_prerr" (fun msg -> prerr_string msg; flush stderr) let callback_func table (w : widget) ~cb = let key = Widget.name w in (try Hashtbl.remove table key with Not_found -> ()); Hashtbl.add table key cb let display_func = callback_func display_table let reshape_func w ~cb = make_current w; cb (); callback_func reshape_table w ~cb let overlay_display_func = callback_func overlay_table let dump_to_eps_file ~filename ?(rgba=false) ?render togl = let render = match render with Some f -> f | None -> try Hashtbl.find display_table (_ident togl) with Not_found -> raise (TkError "Togl.dump_to_eps_file : no render function") in callback_table.(render_id) <- (fun _ -> render()); _dump_to_eps_file togl filename rgba let dump_to_eps_file ~filename ?rgba ?render = wrap (dump_to_eps_file ~filename ?rgba ?render) let rec timer_func ~ms ~cb = ignore (Timer.add ~ms ~callback:(fun () -> cb (); timer_func ~ms ~cb)) let configure ?height ?width w = let options = may height "-height" cint @ may width "-width" cint in tkEval [|TkToken (Widget.name w); TkTokenList options|] (* class widget w t = val w : widget = w val t = t method widget = w method name = coe w method configure = configure ?w method bind = bind w method redisplay = post_redisplay t method swap_buffers = swap_buffers t method width = width t method height = height t method load_font = load_bitmap_font t method unload_font = unload_bitmap_font t method use_layer = use_layer t method show_overlay = show_overlay t method hide_overlay = hide_overlay t method overlay_redisplay = post_overlay_redisplay t method exist_overlay = exists_overlay t method overlay_transparent_value = get_overlay_transparent_value t method dump_to_eps_file = dump_to_eps_file t method make_current = tkEval [|TkToken (Widget.name w); TkToken "makecurrent"|]; () end *) let ready = ref false let init_togl () = init (); _create_func (); _display_func (); _reshape_func (); _overlay_display_func (); _destroy_func (); ready := true let create ?name = togl_options_optionals (fun options parent -> prerr_endline "Before init"; if not !ready then init_togl (); prerr_endline "After init"; let w : widget = Widget.new_atom "togl" ~parent ?name in let togl = ref None in callback_table.(create_id) <- (fun t -> togl := Some t; Hashtbl.add togl_table w t); callback_table.(destroy_id) <- (fun t -> begin try Hashtbl.remove togl_table w with Not_found -> () end; List.iter [display_table; reshape_table; overlay_table] ~f: begin fun tbl -> try Hashtbl.remove tbl (Widget.name w) with Not_found -> () end); prerr_endline "Before create"; let command = [|TkToken "togl"; TkToken (Widget.name w); TkToken "-ident"; TkToken (Widget.name w); TkTokenList options|] in let _res : string = try tkEval command with TkError "invalid command name \"togl\"" -> raise (TkError "Togl initialization failed") in prerr_endline "After create"; match !togl with None -> raise (TkError "Togl widget creation failed") | Some t -> w) lablgl-1.05/Togl/src/togl.mli000644 000765 000024 00000003143 12217024174 017011 0ustar00garriguestaff000000 000000 (* $Id: togl.mli,v 1.6 2000-04-03 02:57:44 garrigue Exp $ *) type w type widget = w Widget.widget val render : widget -> unit val swap_buffers : widget -> unit val height : widget -> int val width : widget -> int type font = [ `Fixed_8x13 | `Fixed_9x15 | `Times_10 | `Times_24 | `Helvetica_10 | `Helvetica_12 | `Helvetica_18 | `Xfont of string ] val load_bitmap_font : widget -> font:font -> GlList.base val unload_bitmap_font : widget -> base:GlList.base -> unit val use_layer : widget -> num:int -> unit val show_overlay : widget -> unit val hide_overlay : widget -> unit val overlay_redisplay : widget -> unit val exists_overlay : widget -> bool val get_overlay_transparent_value : widget -> int val make_current : widget -> unit val display_func : widget -> cb:(unit -> unit) -> unit val reshape_func : widget -> cb:(unit -> unit) -> unit val overlay_display_func : widget -> cb:(unit -> unit) -> unit val dump_to_eps_file : filename:string -> ?rgba:bool -> ?render:(unit -> unit) -> widget -> unit val timer_func : ms:int -> cb:(unit -> unit) -> unit val configure : ?height:int -> ?width:int -> widget -> string val create : ?name:string -> ?accum:bool -> ?accumalphasize:int -> ?accumbluesize:int -> ?accumgreensize:int -> ?accumredsize:int -> ?alpha:bool -> ?alphasize:int -> ?auxbuffers:int -> ?bluesize:int -> ?depth:bool -> ?depthsize:int -> ?double:bool -> ?greensize:int -> ?height:int -> ?overlay:bool -> ?privatecmap:bool -> ?redsize:int -> ?rgba:bool -> ?stencil:bool -> ?stencilsize:int -> ?stereo:bool -> ?width:int -> 'a Widget.widget -> widget lablgl-1.05/Togl/src/togl_tags.var000644 000765 000024 00000000445 12217024174 020040 0ustar00garriguestaff000000 000000 overlay normal $$ Fixed_8x13 -> TOGL_BITMAP_8_BY_13 Fixed_9x15 -> TOGL_BITMAP_9_BY_15 Times_10 -> TOGL_BITMAP_TIMES_ROMAN_10 Times_24 -> TOGL_BITMAP_TIMES_ROMAN_24 Helvetica_10 -> TOGL_BITMAP_HELVETICA_10 Helvetica_12 -> TOGL_BITMAP_HELVETICA_12 Helvetica_18 -> TOGL_BITMAP_HELVETICA_18 Xfont lablgl-1.05/Togl/src/Togl/ben.rgb000644 000765 000024 00000141447 12217024174 017520 0ustar00garriguestaff000000 000000 no nameXj} 0!#;$&G')T*,U-/]02a35b68\9;V<>f?AwCDF GIJLMOPRSU VXY[\u]_Y`b>ce"fh i{jlPmo"pqsLtv wXxy{%|^}~%477*&2/.& o}Tf5Ob#Y7ymBjB]>'rD l3FkN‘Sg{$ "6#%>&(K)+S,.U/1]24]57^8:W;=c>@lACEFH IKLNOQRTUWXZ[x\^b_aEbd&eghikbln1oqresuvvwyzQ{|} Famz|{zt>[sWLH ]+y\;{J X=mGX: l%rc¨_p !1"$;%'H(*U+-U.0Z13]46]79[:<^=?k@BDEGHJKMNPQSTVWYZ[]m^`Rac0dfghjnkmBnpq|rt5uvx6ytz{})~Zq/GMJqHfBm6eB+a4M!h5({ |}}|{|w}~~{{y||}xyx{yzw}z}{z{vxsxwpvrmslljhia\ZVZTTOP^J\XS[N3H<B7?^@>XG=A=9>?7:8=;GBICHIIO?9C<9C=ABH@DDHBMF@DIAAKE@FC9?0,0(!~~{~}~}}z}}||u}xvxtzx{ursvpkehfcbcbY\XSWOXXVZTLTK3<9@7B\C;VG:CEAAFDIFJEPMPLHLKOJJKMFHLIKLMPSMQNNJEJFDPIBGE<C:-5,!~~}}{|{|}|z|~z|y{yuwurmqlifeg_]\]\UUTVMZSRXL:@5>6VXLQXC=A>BCPFMPIHGMLOGH[VLBOJOZOJROIRUHNNLG@>KDMHGK?>>616'&e2!C!v2eC!2e2vCe!2eTe!!eܘ!eeCeee2eeeTeeTeTeeTe2e2e2!22CeCeeeeT!e2C22!!v22C!22ev2!22T2!!2e!2ܘ2C22e2T2eT22T2Te2˘2!2!2Ce2C2e222T!2C22!!v22C!22v2!22T2!!22!22Cee2ee2T2e2eT22T2eeT22!22C2e22C2e222eT!222Ce2!!2e!C22!!222!e2eee!eee2e2Ce2eeCeeTee!eCeTeeee!2e!!T2!veeeee4e2!!22!C2!!22e2!22e1!2ˇ2C2eC22T22!2e2ee2C22T2e2e2!22e!!T2!ve22222e22!!22!C2!!2e2!2e!242C2eC22T22!ee2eeCe2T2e22!222!!T2!ve22e2e222e2ee2TC!2!2e2!!2!2!eˇ22!ee2e!ee2eeeeeeeCee˘e2eܘeeTv2!!!eeCeeeee˘e2e˝T!2!22!!!!e22!22e22!22e22222C22e2222e2e2Tv2!!!2ee2C22e222e2T!!e2!!!!eˇ2!22e22!224e222e22e222e2C2eee2ee2e22Tv!!!2e2C2222ee22ee2e!e!C!22T!!!!Cee2e!ܘee!evee2eeCee2eeeCTeeeeeeeTe!ee!!!CveTeeeee!e!eee22!ee!!22T!!!!C222!eܘ22!2v2C222CeT22ee2T22!ee!!v2T2e22!ee22!e2e!e!!2T!!!!C2422!22!2v2ܘC222e22CT22e22e2e2eT224!e4e!!veT2ee2e2e2!e22!2e2e2e222!!!e!!!!CC˿e2!eeC22TeTee2eܘe2eeܘeeܘCeTeTeeeee2e2C!Teܘeeeee2ee22e2!!!2!!!!C22!22e˩C222T22e2e2e22C2T2T2ee2e22222!T22ee2e2e2!!!2!!!!C˿22!22C222T222e2e22ee2eCe2eT2T2eee22e2e222!T2e2ee22ee22e2!!ee2!2!22!!2!C˿T!e!!e2eCeeeT2TeTeeTe˘eeeeeeܘ2eCT2!e2!eeeeTeeeˁ!!2e2!!22!!2!CT!2!!eܘ22C2222T2Tee22T22e222e22CT2!22!22eT2ee2!!ee2!!2!!2!C˿T!2!!e224C2222Te22Te2e222e2Te22ee22ee2e22e22CT2!e2!2e22e2e22T2422e!2eC!!!!ee!eTe22eee!ee2e2Te2eeeTeeeeeveeeeeeeee!e2e2eeCeeeeܘeee2ˁ!22C!!!!e2!2T22!2e2T2e2T2e2e2ev2222e22!22ee22C22e22e2!2eC!!!e2!2T2e2!22T2e22eT2e2ee2e22v2e2e22e222!22e2eCe2ee2eee22ee2e!!2!v22!C!!˘2Ce2eCe!eeeeCeeTeTeCeTeTe2Ceev!e2eeTeeˁ!!!ve2!Ce!!e22C2!222e22eC2T2Te22eC2ee2Tee2eT2e2eC2ev!22T2e2!!!ve2!Ce!!e22C2!222e242C2T2Te2eeCee˘ee2Te2T22eC2ev!22e2e2e2Te22e2C!!eee!2!!!!ee2˘2e!eeTee!eeTee2eeC!eeTee˘TTeeeTeeeve2e2!eeeee!!2e2!2!!e22ee22!2T22!22T2222C!22T2e2222eeT22T2ee2Te222v22e22!2e22e2!!2ee!!!e2e22!42T22!2eT22C!222eTee224e2e2TeeT2e22eTe222v2222!2e2e2e˘2e2e222e!2ve!22vܘe!2e!˘e!eeTeeCeeeeeCeeeTeeeee!TeeC2C2eeCeeeCˁ!2v2!!!!!!2vܘ2!22!e2!2Te2C22e2ee22C22222e2Te2e2e2e2!Te22Ce22ee2e2eC222C˂!2v2!!!!!!22vܘ2!22!˘2!24Te2C222e2e2C22242eeeT2ee2ee22e222!Tee2C22e22e2e22eeCe222eCeee!C!CeT!2!22vC2e2eܘe2e!ee2evCeeCeeeeeCeeTeee2!e!eeee˘eee˘2!!eT!!2vܘC222ܘ2!2e222vC2C22e2e2e22eeC2T222e2!e2!2ˇ2e2e222!!T!!vC2422ܘ2!2e2vC24Ce22ee222eC22eT2e2224e2!2!22e22˘2e2e2e2e2!2!!e!!!C!C!!Tee2e!2ee2eCeeeeeܘeeTܘee˘e2eeCeܘeTeeeCe2!!!2e!!C!!!T˿2!eܘ2eC2e2e22ee222e2e22T22e2e2e2e2T2ee2eC22ˁ2!!!2!!C!!!T2!2C2ee2e22e22e2ee22eee2e2eTeee2eee224eeܘ22eTˇ2eee2eeCe2e22!e!e2!!2Ce2e2eCe2eee2eeCeeeTeeeCܘTeTeee2T!eeeTee22!2!22!!C2ܘC222˩2e2C22˩2T2e2eeC22e2T22eeT22e222eT!22e2eT222!2!22!!C2C222C222e2Te22e2eeC2eeeT2eeeT22222eT!˘22e22e2T22ee!C!C2ee!v2!!e2!eTee2eTeCe!eeC2eeeeeeeee˘TTeeTve2e2eeee2!!22e!v2!22!2T222T2C2!2e2C22e2e2e222e2ee2e2T2T2e2eev22222e!!2ee!v2!22!2T2422T2C2!22C22e2e2e22e2e2e2e2e2eeTeTe22e2v2e222e2e2eev2!!2!e!!2!2C2e22e2eee2e2eeCeCTTeTee˘eeCTeܘe!!eeeeeTeev2!!22e!e!!!22e22e2ܘ2CCTT22eeT2e2e22Ceee2T22e2!!e22122T22v2!!22!e!!!22e2e22ܘ2C4CTT2eeTe22e22eeCeTee22eܘ2!!42ee2ee22T22ee!!T22v!2e2!eee2eeve2eeCe2eeeeeTeTeTC˘eܘTeee˘e!eTeܘee˘eeTeTee!!22ve!2ee2!2ˇ2222v222eC222e22e22eT22eeT22TeCe2e2ee2T22˘2e222!2T22e22T2Teee!!22v!2e!22e2v2eC2242e22eT2e2eTe2TeC2eeeTe22e2eee2!2T24ee422e2T22eT2e˩e!!e2e2e2!!2!!e2e2ee2e2TeeCeCeeTܘCTTeܘeTee2!eCee!e˩2!!22ee2!!!!2e2T22C2Ce222T22C2ee2T222Te2ee22T22e2e!2eC22!2e˩2!!2ee2!!!!2e2Te2C2C2e22eTeeCe2T2eeTe2ee2ee22e2T2242e!2Ce2e2!2ܘ2e!e2e2!2eT!!22eܘ2e2eeeeeTTTTeeeeeeeeeee2!e22!2!2eT!!2˿2e2e222e22T2eeT2T2T2e2ee2e2e2ee222e2e2!e22!22e!2T!!222ܘ2ee2422ee2e2e2TeeeT2TeTeee22ee2e22e2e22˘24ee2ee22e!e2!C2e!ee!2e2e2ee2eCeCeTeee˘eCܘee˘ee˘eeeeeTee!2˿22!22!2e!22222eC2CTe2e2ee22Cee2eee2e2e2e22222T22e2!222!22!2e!2e22eC2C4Te22eee2eCeee22eee2ee2e222422eT222e22!ee2e!2!C!2!Te!eTTee2eeC2eeܘeeeee˘TܘCܘeeeeeeeܘeeeeeC2Ce2e2!2!!!T2!2TT222e˿2C22ܘ2e2ee2e2e2Tee2Ceee2e2ee2e22e22222ee2ee2CeCe2e24!2!!!T2!2TT22C2ܘ2eee2e2eeeeTeeeCeeeee2eee22e2ee2222e2ee2e22C2C2222!e2!2C!2!!eTeCeeCeeeܘTeTTeeeTeeeeeTeee˘22!2!C!!!2T2Ce22C2e2e22T22e2T2e2eeeT2e2e2T2e22e22Tee22!22!2C!!!eT2C2e2C22e22e2ee2eeeT2eeeT2eeeeTee22e2e2eeT222ee2e2ee2T222eeee!2Cee2!eeCeeCTeCeeeeeeTTܘ˘eTeeCeeeeeeTe222!2e2222!22eC22C2T2C22e22e22Teee2eeT22eee2eee22Te2e2C22e2222Tee2e2222!2e222!22Ce2CT2C222e22ee2TeeTeeee2eTe222C2eee2ee222eTee2e!e!T2e2!!CC!2eevܘeܘeTeeeeeeeeeeܘee˘eeT˘!2!2e2!!C!222v2e2T22ee2e2eee22ee2ee2e2e22ee22ee22e22e2T2e2!2!222!!C!222ve2e2T22e22e2ee2eeeee2eee2eeee2ee2e2e22e22e2eeTee2eeeee!!2T2C2!2!C2eeeTeeeeT˘eeTeee˘eeܘeeTeT2eܘ!!2T22!2!222ee2eT2222Teee2e2e2ee2e2Te22e2e22e22ee22T22T2e˘˩24eܘ!!2T22!2!222e2e2e22eT2e2e2e2Teeee2eeeeTee22ee2eee22ee2ee2eTeeTe2e2˩!eCee!e!eCeeTeܘeeee˘ee˘eeTܘeeeC22!2eܘ2!!Ce2e2Te2e22e2e2e22e2e2e2ee22eee2e2222e2T2e2e2222e22eC˘2˩!2ܘ2!4!4C2e2eeܘ2e2eTee2e2e22eeeee2ee2eee22e2eeT2ee2e22ee2eCee!ev2!eCT2!!C2CCeTeeeTeeeTeܘTC˘C˘eeTeT˘2!2v2!2CT2!!2C2eT22e2T222e2ee2Tee2eee2T2ee22Ce2Ce2eee22eTe2222T222!2v2!2CT2!!2C2T22ee22e2eT2e22e2eeeTee2TeeeCeeCe2ee2eeTe2eeeTeee2!eC22C2˩22!!2!2eeܘCeeeeܘTeeeTTeeeT˘˘2!2Ce22˩2!!2!22e2C222ee22T22e2e2e22e2e2e2e2e2ee2eeT22ee2Te22ee22T2!2C222˩2!!2!22eeC2e22e22e2e22ee2eeTeeee2ee22eee2e2eTeeeTe2ee2eTe2e2ee2e!22˘e2!eeTee˘eeeeeeT˘TܘeeTeeee2!22˘2!22e2T222ee2Teee2Te2e2eee2e22ee2e2e2e22eT2e2e222e22e2˂2e2!22e22!42ee22e2T2ee22eee2e2e2TeeeeTeee2eeeeeeT2e2e22e2e2Ce2CC2e!CeeT!C2eCeeeTeTeeTeeeT˘Tee˘ܘTTeeT˘˘C2C22!22˘T!2C22e22T2T2T2ee2Te2e2e2T2e2ee2e2ee22e2ee2T2T2e22e2T2eC42C22!2eT!4C2eee22eeT2e2T2e2eT22eeee2eTeeeTeee22eeeeeTeT2e2eeTeeee2C2e!e!eܩe!22!eeeCeܘeeCeeT˘eeTeeeT˘12C2!2!2eܩ2!22!22ˇ2Cee2e22Cee22Teee2eee2ee22ee2e2ee2222T222e2T2e22C22!2!2ܩ2!22!2e2e2Ce2e2eee2e22eeCe2eTeeeee2eܘeeee2T22ee2T2ee2e2ee2!!e2e˿v22CeCeeeeeTܘeeCeeT˘e˘e2eeTܘeeܘTT˘˘222!!2v22C22eee2ee22T22C22ee2ee22Teee2eee22e2ee2e22T2ee22T2T2242!!2˿v222C222e22e2e2eT2e22C2e2eeeeeeTeee2eeee2eeT2e22TeTe!e!eCe!e2e2v˩e2!eTeT˘CCCeTeeee!e˘ee˘eve!2!eC2!222v22!2T2T2e2C2Cee2C22T222eee2e2ee22eee22ee2e2e2!2e22˘22ee22e˘ve!2!eC2!2v˩22!2T2T2eeC2Ce2C2eT2e2eeeeee2eee2!2e2ee2e2e2eeevee2e!e!e2ee2e˘eeTCCeCeTTe˘ܘT˘˘ˇeCeTveC2422e22!2!222e2TC2C2e2Ce2ee2TT22eee2ee2eee2ee2T2e22eeee2ee2Ce222eTveC2e224e22!2!22e22e22TCeCeeeCeeee22TT2eeeeeeeTeeeee˘e2eeC2e2eTvCeTe!v22!ee2!e˿T2evTTeܘTTTeTeܘTܘeTTe22eeT2!ev2!22!2T2vTT22T22TT2eeT2ʘ2T2eee2eee22eee2ee22eee2eee2e2eee2ee22eTe22eT2!ev22!242!e˿T2vTTee2eT2eTT2e2T2ee2TeeeeeeeeܘeeTe2ee2e22e2˘eeeTܘTTC˘eeee˘ee2e22e2ee2e2TeT2T222Cee22e2e2e2e2ee2eee2e2e2ee2e2˘222ee22e22e22e2˘2e2eee22eTeTeT2eeCee2e22e˘eeeeee˘e2e2eee222e!Cee2e2eC˩eCeTTTTT˘TTeeܘ˘eeeeT˿Te2!eC2222C2C22T2T2Te2T2Te2T2eT2ee22eeeee2eeee2ee2e2ee2ee2e2e2T2e2eeTe2!Ce22424C˩2C22TeT2TeeT2Te2TeeTee2eeeeeeee2e2e2˘eTe˿eT22v˘veCe2eveeTTTTeT˘eeC˘˘˘eܿee2v2ve2C2v2T2T2eeT2T2eT2e2e2ee2Ceee2e2e2eee2eeee2eee2eeee2eee2ee22ܿee22eee2v2v2C2v2eeTeTe2eeTeTeeTe2eee2eeeeCeeeeeeeeeeeeeeܿe22vTeee2e2eeCeTܘTTeTeT˘˘˘ee2vT22222C22T2T2Te2e2Te2e22eeeT2eeee2e2e2eee2ee2eee2ܘee2eee2vTe2eC2eTeTeTee2e2eeTeee2eTeeeeeeeee2eeeeee2eeeeܘeC2e2veܘeeCeTܘe˘T˘˘˘˘˘ܘ˘Te22ee2ܘ2C2ve2e2e2e2Ce2ee2e2Te2e2e2Teeee2eee2eeee2ee2e2e2eee2ܘT2e2eee2ee2ܘ2C2ve2e2eee2eeeC2eeTe2Teeeeeee˘e˘eܘeeTe2CTT2Te2eTeTC˘eT˘˘˘˘˘˘evCTT˘2eT2ee2T2eeee2T2e22Ceee2e2ee2e2T22eeee2eee2ee2eee2eeܘ2e2eevCTT2T2eeTe2eTee2eCe22e2ee2eeTeeeeeee˘eeeeee2v2eeܘT2eeC2eeeeeT˘CTeTCܘ˘˘˂eve2eeTܘ22˩2C2e2ee2T2ee2Ce2T22eeee22T2e2eeee2Ce2ee2eee2eeeeeee2ee22eev2eT222C22ee2eeeeTeeeeCeeTe2eeeTeeeeCeeeeeeeeܘeeev22eeTˇe2ee2˘TTTܘT˘T˘e˘˘˘˘˘˘e2T222e2e2T2Te˘e2eT2T22ee2e2e2Te22eee2eee2eee2eeee2ee2e2e2eee2Tˇ22e2eeT2Teee2TeTe2eeeTeee˘eeeeeeeeeeeeee2eee2eCe2eeTT˘TTܘTe˘˘ˆ˿ee22e22C˿2T2T2e2T22e2Te22T2eeee2eee22eee2eee2eee2eeee2ee2e2ee2eeee2e2e22224C2eTeTeeeTeeeeTeeeTeeeeeeeeeee2eee˿e222Cee!eܘe2e˘TTeT˘ܘ˘˘˘˘˘˛˘˿TTeeeC22!2e22T2eee2eTe2e22e2e2222e2eeeTeeeeee2e2eeeܘeee2TeTeeC2e!2eܘ22eeTeeTee2e2eeeTeeeeeeeee˘ܘeeeeTeT22e2eCeeeeTܘTTTTeˊ˘˘˘˘˘˃ܘ˘eee222C2222TeT2T2eT22eee2Tee2e2eee2ee22eeeee2eeee2eeee2ee22eeeeeee2ee222C2ee2TeTeTeeTee2eT2e2ee˘eܘeeeeee˘eee222eee!eeeeeܘCC˘˘˘˘˘ˇˋ˘Teev22!e2e2ܘ22e2C2ee2ee2e2ee22Cee2e2eeeee2eee2e2eeeeܘee2e2e2Tev22!e2e2e2eܘeCeeeeeCeeeܘeeeeeeeeܘ˘ܘe2T22vee2eTeCeCeܘe˘ee˘˘˘˘˘˘ܘ˘˘eeee2T2C2C2ee2ee2e2ee22ee2e2e2eee2eee2eeeee2eeee2ee2eeeeeee2e2eee2T2C2C2e22eee2eeeeeeeeeeeeeeeeeeeee2ee2eee!e2e˩ee˘eeT˘eTˆ˘˘eeee22!222ܘ2e2ee2Teee2ee2e2ee2ee2Teeeee2eeee2eeee2eeee22e2ee22!2˩22e2e2ܘee2eeeTeeeeeeeeeTeeeeeeee2e2e2e2ee!e!eeT˘ܘ˘˘˘ˋ˘˅eee22!2!2e2Tܘe22eeee2e2ee2eee2ee2eeee2eeeeeee2ee2e2eeeeee2e2ee22!2!2e2eTe2eeeee2˘eeeeeeee˘ee2ee2Te!e2eveeC˘˘˘˘˘˘˘˘eCeveT2!22v˘22eCe2ee2eee2eee2e2ee2eee2eeeeeeee2eeeee22e22C2veT2!224v2e2eeeeCeeeeeeeee˘eܘeeeeeeeeeee2eC22veee!eTeeevvC˘T˩ˇ˘˘˘˘˘˘˘˘eevvee2!2T222vvCe2e2ee2Tee2ee2eeeeeee2eee2ee2eeeee2e2e22evve2!2T22e2e22vvCeeeTeeeeeeeܘeeeeܘee˘ee˘ee2eevv2eeeCTeeeCe˘˘ˑ˘˘˘˘˕˘ܘeeee22T22e2C2ee2eee2e2ee2eeee2eeeee2eeeeeee2ee2eeeee22ee22eee22T2e2C22e22eeeeܘeeeeeeeeeeeܘeeeee2T22Teeeee˘Tˇ˘˘˘ː˘˘˘˘CeeT22T22e2e22eeTe2eee2ee2ee2e2eee2eeeeeeee2ee2eeeeee2C2eeT22T22e22ee22eT2eeeeܘee˘eeeeeeeeeeeeC2e22eTC˘˂˘˘˘˘˘˘˘ˁeee2e2TC2ee2e2ee2ee2e2e2eeeee2eeeeee2eeeee˘2eeee2e2TCeeeeeeeeee˘ee˘eeeeeeeeeeeee2ee!eTe˘˘˘˘˘˘˘˃˂evev1!2T22e2e2eee2ee2e2eeee2eee2eeeee2evev!2T2ee2eeeeeeeeeeeܘee˘ee˘eee˘ee2v22ve2e!TeeC˘˘˘˘˘˘˘˘e22!T22eCeee2eee2e2ee22ee2eee22e2eee2e2eee2eee2ee2e˘ee2e22!T22eCeeeee˘eee˘eeeeeeee˘eee2e2e!2TeeT˘˘˘˘˃˘˘˘ˁ˘Cee2!2T222Tee2ee2eee2eeeeee2eeeee2eee22eˇeee2Ce2!2T2e222Teeeeeeeeeeeܘeeeeeee2eeeܘeeCe22ee2eCeTe˩ܘ˘ܘ˘˘˘˘˘˂˒˘Tve222C22T22ܘe2ee2e2eeeeee2eeee2eeee22eeeeeTevee24C22eeTee˩eeeܘeܘeeeeeeeeeeeeT2v22ee!!eee˘˘˘˘ˉ˘˂˂ˊ˘ee2e!!2e22ee2eee2eeeee2eee2eee2ee22ee2eeee2eeee!!2eeee2˘eeeeeeܘeeeeeeeeeeeeee2e22e22e!eee˘˘˘˘˘˘˘˘ˇve2e2!22ee22ee2ee2eeeee2e2e2eeee2eee22eeeee˘vee222!22ee2eeeeeeeeeeeeeeeeeeee2eeܘeeeev2evee2!eee˘˘˘˘˘ˈ˘˂˃ˈee2ve2!22eeeeee2e2eeeee22eeeee2eeeeeee2v242!22eeeeeeeeeee˘eeeeeee˘ee2TT2e2e˘˘˘ee˘˄˘˘˘ˇܘeTTe2˿2eee22eeee2eee2ee2ee2e2ee2ee22eeeeeeeeeTTe2eeeeeeeeeeee2eeeܘee˘eee2eeeeeeee2ee܇e2eeTT˘˔˘˘˘˃ˇ˘ܘev2܇2T2Te2ee2ee2eeeee2e2eeeeee2eee22eeeeeeeve2܇222TeTeeeeeeeeeeeeee˘ee22v2e2eeTeT܇˘˘˘ܘ˘˘˘˘ˍ˘e ee2T2eeTeee2eee2ee܇eee2eee2ee2eeeee2eeee22eeee 22T2e2Teee܇eeeeeeeeܘeeܘeeeeeܘe2eeee2e eee2eeTee˘e˘˘˘˘˘˘˘ˋ˘˘e e2T2eee2ee2e2ee2ee2e22ee22e2ee2eeee2ee˘ee e22eTe2e2eee˘eee˘eeeeeeee˘eeeeeee2 e2eeeܘe˘ܘ˘˘˘e˘˘˘˘ˊ˘˘ 2e22222eeeee22eȘe2e˘e22ee2ee2eeee2eeeeeee 2e22ee22eeeeeeeܘeee2eeeeeeeeee2 eeCvTe˘˘˘˘˘˘e˘ܘee˘˘ e2CvT2e22eeee2eeeeee2ee2eȘe2e222eeee22eeee ee2CvTe2ee2eeeeeeeeeeee2e˘2ee2ee˘eeܘeeee TTe˘eT˘˘˘eCeCeee˘ˁ˘TT22eT2ee2e2eee2eee2e2C2e2eeCe22e2ee2e2eee2eeeeeeTT2e2eTeeeeeeeܘeeCe˘eCe2e2eeeeeeeCTe˘ܘ˘˘˘eC˘ee˘˘ˏ˘eC˘T222eeee2eee2e2e2e2eȘe2ee2Cee2eee2eeeeeeeeCT22eeeeeeeeeeeee2ee2eeCe2e2eeeܘeeeeee2ee˘T˘˘˘˘˘˘e˘eeTe˔˘˘ܘe22eTeeeeeee2e22Șe2T2ee2eeeeeܘe2eT2eeeeeeeeee2 e22eeT2eeeeeeeeeeeeCve˘ee˘˘ˁ˄eeC2e2eeee2eee2v2eȘe2ee2e2eeeeee˩e22Ceeeeeeeeev22˘eee2ee22eeeeeeee˩2eve˘˘˘˘˘˘˘ܩe˄˘v2e2eeee2eeeee22ܩ2eȘȘe˿ee22eee22eeee2ev2e2eeeܘeeeeeeee2ܩ2eeeeee2e˘eܘee2eeeeT˘˘˘˘˘TC˘˿e˘˘˘˘e22eTeeee2eee2TCe2ȘȘȘȘe222eeeeܘ222eTeeeeeeeeeTCeeeeˆܘ2e˘eeee2ee˘˘˘˘ee˘˘˘˘ܘ22e2eeeee2e2eeȘeeeee2eˇeeܘe2eeeeeeeeeeeeeeܘeeeeeeee˘˿Tˇ˘˘˂ˁ˘˘ee22eeee2eeeee22TeȘȘeeeee2eeee˘222eeeeeeee2Teeeeeeeeeeeܘee˘˘˘˘e˄˘ˆˋ˘˘ee22eee2eˇee2ee˿e22ee˘Ș222eee˘ee22eeeeˇeeeeee2eeeeeeeeee˘eeeeeeev˘˘˘˘ܘ˘Te ˅e˘ˇee2veeeee2e˘T2˘˘ȘȘee22e2eeeee22veeeeeT22eeeeeeeee2e˘ee˘eeee˘˘˘˘˘˘e evܩeeeeeee22eeȘȘȄe22ve22eeeܩeeeeeeee˘eeeee2eeeeee eeee2e2veeeeܩ ˘˘˘˘˘˘˘˘Ce˘˃ ܘeeeeeeeCeeȘȘȘȘȘȘ˘e22ee2e2eee2e˘eeeeeeeeeCeeee eee2e2e2eeܘe ˘T˘˘˘˘ee eTeeeeeeee2eeȘe2e222eee22 eTeeeeeeeeee2eeeeeeeeeee2e2eܘee e˘˘˘˘e ˘eeˇe! eeeeeee2e22Ș˘ee2e22e2e! 2e2eeeeeee2eeeeeeeee22e22ee2eܘ ˘eˆ˘eeT" ee2eee2eeeee2ee2222eeeee22e2Te2e" eeeeeeee˘2eee2eeeeee2eeTe2" e܇˘˘˘˘˩ee˂eee# ee܇e2eeeee2e22eee2222e2e# ˘e2e2e܇eee222eeeee2e2ee22eܘ#˘˘ˆe˘˘˘e˘e˿˘%˘ee2eeee2eee2ee2ee22eeeeȂe2e22˘%ܘe2e2eeeee˄e2eee2eeee2e22e2eee$˘˘˩˘˩˘˘˘ܘeeee˘eeT%ˋ˩˘˩˘eeeeee2e2ee2ee22eee2eȎee222Te%eeeee2eeeeeeeܘ22e2ee22e2e2ee22e2˘eTee2%˩˘˿˘Teˁe˘eC˩e&˩˘˘˘˘˘˘e˃eee2e2Te22eee21eeȘ˘22Ce&ee2e˃eeeeeTe2e22e2e2e2e22eeee22Ce2e%˩eT2TeveeTe˘˘˘˘eeT˄eˇeeee&˩˘eTeTeveeTeeeeeee2e2e2Teee2eee2ee˘e22&e2T2T2eev22T2e˘eee2ee2T22e2eeee2ee22e2&˩2eCev˩˿Teˇe˘e2eee'˩˩ee2eCevee˘˿ܘeee22eT2eeȘȘee22ee22'ee2C22v22eeeeܘeeT2e22eeee22eee22e'˩˩˩v TeeːT˘e˘ee'˩˩˩ve2Te22eeeTee eee212eee2'eeev˘ ˊܘ2eeTee2e22T2eee222e22e22e'˘˩˘ˎ˩˩˩˩˂eeܘee˄eˆ˂e˘T˘e'ˈ˘˔˩˩˩˩˘˘e22e22ee22eeeee221ee˘2T'eeeܘܘe˘e22ee2ee2ee2eeeee22e22Te2e2'˩˩˘܄˘eeeeˊeˎ˘Ceeee'˩˩˩܄e2e2eee2eeeeeeCe22eeee'ee܄˂ee22ee2ee2e2 e2C2e22e2e'&eeˇee˄eˁ˘eee˄ee'!e2222eeee2e2eeee'ˁ ˁ ˃ˉ22e2e2 eee2ee22e2e22e'˩˩˂ˈ˘Ceeˑee˘ee&˩˩ˍe2C22eee2eeee2e'eܘ˘ܘܘܘe2C2e2eeee 2e2e2&˘˩˘˘˄ e˘ee˘eee&ˁˉ˘22e22eeeeee2e&ee˘2e2e2e2eee 2ee&ˋ˩ ee˘ee˃eee&ˆ˩ 2e12eeee˘e2ee&˃ˁˁˁ˃222e2e2 e2e22e&˘˩ˁ ˆeeeee&ˁˁ ˇ2e22eeeee2ee&e˘˘e2eee 2e2ee%˿˃˘2˂ܘeeˁ˃eve%˿˃˘2˘e2ee2e2eee2e22ee˘eee21ev%e22ee˘22e2e2ee2e2v2e%˅˩˘˥e˘˂˘eeCee%˃˩ˬܘe2eeee22eee2eeeee2C%eeܘܘܘܘܘ˘˘ܘܘ˂e2e2ee2eeee22e2C22e%˃˩ˇe˘ee2eeee$˅˘˩˩ˇee2ee22eȘ22eeeee22e$eeeeee222e2e˘e2e2e22e2e$ˁˈC!!ˁ#eee˂ ˘e22e"ˁˆC!"e2e2eeee22e"eeCeeˉ2e22e˄ee22e22e222222ee!ˉev ˞e˅˙˘e2!eeeeee ˩˩ev ˎee2eeee2eeeeee22!e 22ev2e ܘܘ˘˘ܘˎ2ee22e˘e2e2e22e2!22e2ee ˄eve˩ˆeee˃e˃eeCeeevee˩ˆe2e2eee2eeeee1Ceev2e2eeee˘2ee2e2e2C22e222eˁ˃C˂"eee 2eeeeeˁ˃C!"ee2eeeeeȘe21e eCeܘ 2ee2e2eeeee22e 2eˈ2!v˄eˁ˄˘eeeeeˏe!!vee1eeeeeeȊee22 e2vee222ee2e ee2e˘e22e2eˋ˩veCee"e˃˘˂˘ee˘eeˋ˩veCee!e2e2eeeeeȆee1eܘ2v2C22e˂2e2eee22e˘e22ˉ2!!v%e˘eeeveˊe!!!v$e2eee eeee˘e2ev˘2!!ve 2e2ee2e2e2e2ee˘e2e2v2e˅˘Cv$e˃ eeˋ˘ee˅˘C!v#2e2eeeeȇee2eeeCve 2e2e22ee˘ee2e222eˆ˩e!2vˁ!ee˘ ˘eev˩e!2v˂ eeȘeȄ˘e2v˘ܘe2!veܘ2eee2ee2ee˂e˘ee22eee2v2ˇee!!e%ee eeveeeˌe!!e#e2eeȘe˘e ȁeȅȘvee2!!ee!2ee22eee22e e22˘e2v2eˉve!!e%e e˘eveˋve!!e˘#2eeȅȘeȁ22vv2!2˘ 2eee2eeeeee2˘e2v22ee˘e!!!v˂!e˘eeeeee˘e!v˂!eeȆ2eeeܘܘܘee2!!!ve˘e2eeee22eeee2eee22ee2e2eeˇv!2!2e$e ˘e!ee2eevˇv!2!2e˂ ȘeeȘeee2!2e2evev!!22˘e2eeeee2eeee2ee22!2ee2v22eˉee!!e%e  ˘e!e!eeeeˌe!e Ș2e˘ȘȂe ˘ee1!!eȘe!eeܘe2!ee˘e22eeeee2e22 e22!22!2e˃T!e˃eˇC!C!ee˄T2!e˅e˘eeȁeeeeeCee!!e˘eeT!2e2eee2ee2 e22C2e2!2e˩T2!22e#˘˓e!e2Cee˩T2!22e˘ee˘eee2eeec2!!2e2Cܘ˘eT2!2ee2eee2e22e2e22e22e2e22!2e2C222e˂eT"eˇ!!T˓ee!2!e2ee˂e!Teeeeeeee!!Te2eee22!2!2e2!ee˘e2T˘e22eeee2ee22e2e!!Te22e2!22e˩e!!e%˘˂ˆe2!!eee!2C2e˩e!!e ȘeeeȘee2!!2e2e2!22ܘ2!!2eee2e2ee2e2ee222!!22!22ee˃e2e˄e˃˘˄e22eee2eeee˂e2e˃Ȅ˘2eeeȁee222e2e212eeܘee222eee2 e222eee2222e˘v!e%2ee˘eeee2!2ee˘v!!e˂Ȅe2ee22˘eeȘe2ee21221e22!ee˘˘ܘev!2˘e2e2˘22ee 22222!2e22eˉv!T%C2eˋeC!e˘˘ee2e2ee!22eeˊv!T ȏC22ee2eC!eeȅee2212.e121!2eevTeeC22e2eC!ee22ee2222!2e2eˈve2TeeˁeeeT2!22e2ee 2eeeeˈveeTee˘˂Ș2e1T2!22eȘee2e2c2 2eee˘eev22T22eee ˃ ee22T2!22e2˘e222e22 2e˘e!e"˘2!!ee2e ˇ˘ee! !Ce˘!eˁe2!e212122122eeȘeeee21! !Ceeܘܘܘe2!2˘e22!2222ee˘ee2e2e2e2! !C2e˂vT"e!!ee2eˆ2!!4ee˂vT e2!!122e2e2eȂee2c2!!eeevTee2!2e2ee22!222˩v2!22e ˂e!!ee2!e 22 eeve˩v2!22e˘˃1!!12!1eȄȘe2 !2evev!22eܘ!!2222!2eee2e2 22v2e˃eC2e˃2222e˘C!!2eeˉC2e2e˂22221221212eȁee2!!2e2C2ee˘e2222222ee2!222eˇe2!e!2!2ee˘eC2 2eeeˋe!2e e!2ceȘ˘ee1C2 2ee22e2!222ee˅˄ee22C 222e˘e!!!T˄ܘe2!2ee˘C22ee˂e!T˘˃ܘ22!!22e Ȃee22 eeee2!!!Teeeܘ e2!2e˃eee22eeˍveTeev˘˩˂T!!e˘e2!!eeeeˈveTeev˩T!!!1e2eȂȂe22!eeev2T22vee˂eT!!2ee2!2222ˇe!!CT2!!ee˘e!!2eeˌe!!!CT2!!12ceee1!!2eeܘe2!!CeT!!22ee22!2e˃eC˩˄e2!!2e˃e! !eev˃e!C˄e2!!!2ee ˘e2 !eveeCeܘ22!2eˋ˘e2 !22v2˅ee2e˘˩˂v!e˘e!2e˂e˩˘ˁv!2ceee Șe21! 2eeܘe2eev22e2e2ee˘ee2!22eˇe!!!C˄22ee˘ee!2!eeeˏe!!!C2!!2eeee21!!2!eee!!!Ceܘ2e˘ee2!!222eˇe!!2 2!ee ee22!2!eeˎe2˘2!!12eeeȃe2!2!!eeee22e˘!2ee2e2222eˋeC2C2e˩˃C!2e˘e2!!!!22eeˈC2Cee˃C!22_eeeȁȗee1!!!!!!22e˘e2CC22eeC!222e2ee2!!!!!2222e˂e2e˘!!!!2e˘e2!2!!!4eˇe2e22e!!22ee22!2!!e˘e2e˘!!2ee˄ee2!!2e˃vC!Te ˘eC!2!!22Tv˃vC˃T2!2eeȁȜee2!2!2!2Tv˘evCe˂T2e2eee2!!Tv2eˍe22!2T˘˩˃22˘ ee!2!!2!!!!2eveˁˇe22!2T˩˂e!22e˘e21!2!!2!!!!2eve2!Te˘e2eee22!!!!2v2eˊeC2eTe˄C!!!e˘ 222!!!!CeeˈCeeTe˘˄C!!!12e˂ȉe22!!!!!Ce˘eeC22T2eeܘC!!2eeee22!!!C2˃e!C#!2˘ ˘2!!!!!!2ee˄e!C˘2e˘e22!!!2eee2!Cee˘2eee2!!!!22e˃e!2˂2!2!e˘ˇe2!!! !2Ce˃e22!!2!2e˂ee2! !!2Cee22ee!!2ee22! 2C22˄v2e˩!!!2˘ee2!!2!2!2ev˃ve˩˘e!!!2ee2!!2!!2!!2eveev2eee!!2e2!!2v2ˇe!!!C˂"22!ee˅ee2!!!!!2eˁˎe!!!C!22!!!1eceeee22!!!!!22e˘2!!!Ceeܘ2!!!22e2e2!!!!2eˈe!2˂"e!!ee!2!!!!22C4eˏe!2˘"e!!!2e21!2!!22Cee˘˘ee22ee˂2!!! 2!!2C2eeˈe2CeCe˩˩2!!2!22e22!!!!!22eev˿ˈeeCeCe˩˘2!2!2212e2!!!!!!!!22eev˿ee2CC2eee2!!222!!!!22ve˂e!2C˂#C!2!!2!!!!!!!!!!2e˂e!2C˘!C!2!!2!!!!!!!!!!!22eeee2!2Ce˘C!!!2!!!!!!2ˉe!!2%e!!!!2!!!!!!!!!!2ee ˈe!!2˂#2!!!!2!!!!!!!2ee ee!2ee˂2!!!!!!!!2e˃e2e˘ˁ 22!!!!!!!!!!!2!!22ev ˄˘e2˘˂22!!!!!!!!2!22ev e2222eeܘ2!!!!!!22v ˊeC2C2e˂$e!!!!!!2!2!2!Cee!ˈeCeCee˘"e!!!!!2!2!!2!Cee!e2C2C22eee!e!!!C22ee!˂e!2˂'e2!!!!!2!!22e#˃e2˂'22!!!!2!!!!!!22ee#˘e22ee#2!!!!!!2e#ˁˊv2˃$܇Ce2!!2!!2!!2Cev$˘ˇv!!2e˘˃$܇C2!2!2!!!!2!2Cev$ev2ee#܇C2!!!2Cve$˂eTe(22!2!22ee&˂eTe˘˘'22!!!!!2!22ee&ee2T2e&2!!!!22&ˉe!2.ܘ!!!2!!!C2ee)ˉ˘e!!2ˁ,ܘ!!!2!C2e)ee˘)ܘ!!!!!!C22ee)˿˃e!˃,ܘe22!!2e*˃e!˘,ܘe2!!!2ee*ܘe2!ee+ee2!!!2e*˅e2Te˘/ee!222-˅eeTe˘˘˘.˘e1!222e-ee22T22 e-ee2!22-˃e2!2˘˂41˄e2!2˘4˘e1e!22ee˘1ܘe1˅e!n˅e!˃ke2!ejˁ˂e2ev˘jˁ2ev˘ˁiee22v2ei˃e2C˩˂l˃e2eC˘iܘe22Ceeeilablgl-1.05/Togl/src/Togl/double.c000644 000765 000024 00000015342 12217024174 017670 0ustar00garriguestaff000000 000000 /* $Id: double.c,v 1.14 2005/04/23 07:49:13 gregcouch Exp $ */ /* * Togl - a Tk OpenGL widget * Copyright (C) 1996-1997 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ #include "togl.h" #include #include /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef SUN extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #endif static GLuint FontBase; static float xAngle = 0.0, yAngle = 0.0, zAngle = 0.0; static GLfloat CornerX, CornerY, CornerZ; /* where to print strings */ /* * Togl widget create callback. This is called by Tcl/Tk when the widget has * been realized. Here's where one may do some one-time context setup or * initializations. */ void create_cb(Togl *togl) { FontBase = Togl_LoadBitmapFont(togl, TOGL_BITMAP_8_BY_13); if (!FontBase) { printf("Couldn't load font!\n"); exit(1); } } /* * Togl widget reshape callback. This is called by Tcl/Tk when the widget * has been resized. Typically, we call glViewport and perhaps setup the * projection matrix. */ void reshape_cb(Togl *togl) { int width = Togl_Width(togl); int height = Togl_Height(togl); float aspect = (float) width / (float) height; glViewport(0, 0, width, height); /* Set up projection transform */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); glFrustum(-aspect, aspect, -1.0, 1.0, 1.0, 10.0); CornerX = -aspect; CornerY = -1.0; CornerZ = -1.1; /* Change back to model view transform for rendering */ glMatrixMode(GL_MODELVIEW); } static void print_string(const char *s) { glCallLists(strlen(s), GL_UNSIGNED_BYTE, s); } /* * Togl widget display callback. This is called by Tcl/Tk when the widget's * contents have to be redrawn. Typically, we clear the color and depth * buffers, render our objects, then swap the front/back color buffers. */ void display_cb(Togl *togl) { static GLuint cubeList = 0; const char *ident; glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); glLoadIdentity(); /* Reset modelview matrix to the identity * matrix */ glTranslatef(0.0, 0.0, -3.0); /* Move the camera back three units */ glRotatef(xAngle, 1.0, 0.0, 0.0); /* Rotate by X, Y, and Z angles */ glRotatef(yAngle, 0.0, 1.0, 0.0); glRotatef(zAngle, 0.0, 0.0, 1.0); glEnable(GL_DEPTH_TEST); if (!cubeList) { cubeList = glGenLists(1); glNewList(cubeList, GL_COMPILE); /* Front face */ glBegin(GL_QUADS); glColor3f(0.0, 0.7, 0.1); /* Green */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(-1.0, -1.0, 1.0); /* Back face */ glColor3f(0.9, 1.0, 0.0); /* Yellow */ glVertex3f(-1.0, 1.0, -1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); /* Top side face */ glColor3f(0.2, 0.2, 1.0); /* Blue */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(-1.0, 1.0, -1.0); /* Bottom side face */ glColor3f(0.7, 0.0, 0.1); /* Red */ glVertex3f(-1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); glEnd(); glEndList(); } glCallList(cubeList); glDisable(GL_DEPTH_TEST); glLoadIdentity(); glColor3f(1.0, 1.0, 1.0); glRasterPos3f(CornerX, CornerY, CornerZ); glListBase(FontBase); ident = Togl_Ident(togl); if (strcmp(ident, "Single") == 0) { print_string("Single buffered"); } else { print_string("Double buffered"); } Togl_SwapBuffers(togl); } int setXrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setXrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } xAngle = atof(argv[2]); /* printf( "before %f ", xAngle ); */ if (xAngle < 0.0) { xAngle += 360.0; } else if (xAngle > 360.0) { xAngle -= 360.0; } /* printf( "after %f \n", xAngle ); */ Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int setYrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setYrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } yAngle = atof(argv[2]); if (yAngle < 0.0) { yAngle += 360.0; } else if (yAngle > 360.0) { yAngle -= 360.0; } Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int getXrot_cb(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { sprintf(interp->result, "%d", (int) xAngle); return TCL_OK; } int getYrot_cb(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) { sprintf(interp->result, "%d", (int) yAngle); return TCL_OK; } /* * Called by Tk_Main() to let me initialize the modules (Togl) I will need. */ TOGL_EXTERN int Double_Init(Tcl_Interp *interp) { #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } #ifdef macintosh Togl_MacSetupMainInterp(interp); #endif /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(create_cb); Togl_DisplayFunc(display_cb); Togl_ReshapeFunc(reshape_cb); /* * Make a new Togl widget command so the Tcl code can set a C variable. */ Togl_CreateCommand("setXrot", setXrot_cb); Togl_CreateCommand("setYrot", setYrot_cb); /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ Tcl_CreateCommand(interp, "getXrot", (Tcl_CmdProc *) getXrot_cb, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "getYrot", (Tcl_CmdProc *) getYrot_cb, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } lablgl-1.05/Togl/src/Togl/double.tcl000644 000765 000024 00000005522 12217024174 020227 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # $Id: double.tcl,v 1.5 2001/12/20 13:59:31 beskow Exp $ # Togl - a Tk OpenGL widget # Copyright (C) 1996 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # $Log: double.tcl,v $ # Revision 1.5 2001/12/20 13:59:31 beskow # Improved error-handling in togl.c in case of window creation failure # Added pkgIndex target to makefile # Updated documentation to reflect stubs-interface (Togl.html + new README.stubs) # Added tk8.4a3 headers # Removed obsolete Tk internal headers # # Revision 1.4 2001/01/29 18:11:53 brianp # Jonas Beskow's changes to use Tcl/Tk stub interface # # Revision 1.3 1998/03/12 03:52:31 brianp # now sharing display lists between the widgets # # Revision 1.2 1996/10/23 23:31:56 brianp # added -ident options to togl calls # # Revision 1.1 1996/10/23 23:17:22 brianp # Initial revision # # An Tk/OpenGL widget demo with two windows, one single buffered and the # other double buffered. load [file dirname [info script]]/double[info sharedlibextension] proc setup {} { wm title . "Single vs Double Buffering" frame .f1 # create first Togl widget togl .f1.o1 -width 200 -height 200 -rgba true -double false -depth true -ident Single # create second Togl widget, share display lists with first widget togl .f1.o2 -width 200 -height 200 -rgba true -double true -depth true -ident Double -sharelist Single scale .sx -label {X Axis} -from 0 -to 360 -command {setAngle x} -orient horizontal scale .sy -label {Y Axis} -from 0 -to 360 -command {setAngle y} -orient horizontal button .btn -text Quit -command exit bind .f1.o1 { motion_event [lindex [%W config -width] 4] \ [lindex [%W config -height] 4] \ %x %y } bind .f1.o2 { motion_event [lindex [%W config -width] 4] \ [lindex [%W config -height] 4] \ %x %y } pack .f1.o1 .f1.o2 -side left -padx 3 -pady 3 -fill both -expand t pack .f1 -fill both -expand t pack .sx -fill x pack .sy -fill x pack .btn -fill x } # This is called when mouse button 1 is pressed and moved in either of # the OpenGL windows. proc motion_event { width height x y } { .f1.o1 setXrot [expr 360.0 * $y / $height] .f1.o2 setXrot [expr 360.0 * $y / $height] .f1.o1 setYrot [expr 360.0 * ($width - $x) / $width] .f1.o2 setYrot [expr 360.0 * ($width - $x) / $width] # .sx set [expr 360.0 * $y / $height] # .sy set [expr 360.0 * ($width - $x) / $width] .sx set [getXrot] .sy set [getYrot] } # This is called when a slider is changed. proc setAngle {axis value} { global xAngle yAngle zAngle switch -exact $axis { x {.f1.o1 setXrot $value .f1.o2 setXrot $value} y {.f1.o1 setYrot $value .f1.o2 setYrot $value} } } # Execution starts here! setup lablgl-1.05/Togl/src/Togl/gears.c000644 000765 000024 00000024773 12217024174 017527 0ustar00garriguestaff000000 000000 /* gears.c */ /* * 3-D gear wheels. This program is in the public domain. * * Brian Paul * * * Modified to work under Togl as a widget for TK 1997 * * Philip Quaife * */ #include "togl.h" #include #include #include #ifndef M_PI # define M_PI 3.14159265 #endif struct WHIRLYGIZMO { GLint Gear1, Gear2, Gear3; GLfloat Rotx, Roty, Rotz; GLfloat Angle; int Height, Width; }; /* * Draw a gear wheel. You'll probably want to call this function when * building a display list since we do a lot of trig here. * * Input: inner_radius - radius of hole at center * outer_radius - radius at center of teeth * width - width of gear * teeth - number of teeth * tooth_depth - depth of tooth */ static void gear(GLfloat inner_radius, GLfloat outer_radius, GLfloat width, GLint teeth, GLfloat tooth_depth) { GLint i; GLfloat r0, r1, r2; GLfloat angle, da; GLfloat u, v, len; r0 = inner_radius; r1 = outer_radius - tooth_depth / 2.0; r2 = outer_radius + tooth_depth / 2.0; da = 2.0 * M_PI / teeth / 4.0; glShadeModel(GL_FLAT); glNormal3f(0.0, 0.0, 1.0); /* draw front face */ glBegin(GL_QUAD_STRIP); for (i = 0; i <= teeth; i++) { angle = i * 2.0 * M_PI / teeth; glVertex3f(r0 * cos(angle), r0 * sin(angle), width * 0.5); glVertex3f(r1 * cos(angle), r1 * sin(angle), width * 0.5); glVertex3f(r0 * cos(angle), r0 * sin(angle), width * 0.5); glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), width * 0.5); } glEnd(); /* draw front sides of teeth */ glBegin(GL_QUADS); da = 2.0 * M_PI / teeth / 4.0; for (i = 0; i < teeth; i++) { angle = i * 2.0 * M_PI / teeth; glVertex3f(r1 * cos(angle), r1 * sin(angle), width * 0.5); glVertex3f(r2 * cos(angle + da), r2 * sin(angle + da), width * 0.5); glVertex3f(r2 * cos(angle + 2 * da), r2 * sin(angle + 2 * da), width * 0.5); glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), width * 0.5); } glEnd(); glNormal3f(0.0, 0.0, -1.0); /* draw back face */ glBegin(GL_QUAD_STRIP); for (i = 0; i <= teeth; i++) { angle = i * 2.0 * M_PI / teeth; glVertex3f(r1 * cos(angle), r1 * sin(angle), -width * 0.5); glVertex3f(r0 * cos(angle), r0 * sin(angle), -width * 0.5); glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), -width * 0.5); glVertex3f(r0 * cos(angle), r0 * sin(angle), -width * 0.5); } glEnd(); /* draw back sides of teeth */ glBegin(GL_QUADS); da = 2.0 * M_PI / teeth / 4.0; for (i = 0; i < teeth; i++) { angle = i * 2.0 * M_PI / teeth; glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), -width * 0.5); glVertex3f(r2 * cos(angle + 2 * da), r2 * sin(angle + 2 * da), -width * 0.5); glVertex3f(r2 * cos(angle + da), r2 * sin(angle + da), -width * 0.5); glVertex3f(r1 * cos(angle), r1 * sin(angle), -width * 0.5); } glEnd(); /* draw outward faces of teeth */ glBegin(GL_QUAD_STRIP); for (i = 0; i < teeth; i++) { angle = i * 2.0 * M_PI / teeth; glVertex3f(r1 * cos(angle), r1 * sin(angle), width * 0.5); glVertex3f(r1 * cos(angle), r1 * sin(angle), -width * 0.5); u = r2 * cos(angle + da) - r1 * cos(angle); v = r2 * sin(angle + da) - r1 * sin(angle); len = sqrt(u * u + v * v); u /= len; v /= len; glNormal3f(v, -u, 0.0); glVertex3f(r2 * cos(angle + da), r2 * sin(angle + da), width * 0.5); glVertex3f(r2 * cos(angle + da), r2 * sin(angle + da), -width * 0.5); glNormal3f(cos(angle), sin(angle), 0.0); glVertex3f(r2 * cos(angle + 2 * da), r2 * sin(angle + 2 * da), width * 0.5); glVertex3f(r2 * cos(angle + 2 * da), r2 * sin(angle + 2 * da), -width * 0.5); u = r1 * cos(angle + 3 * da) - r2 * cos(angle + 2 * da); v = r1 * sin(angle + 3 * da) - r2 * sin(angle + 2 * da); glNormal3f(v, -u, 0.0); glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), width * 0.5); glVertex3f(r1 * cos(angle + 3 * da), r1 * sin(angle + 3 * da), -width * 0.5); glNormal3f(cos(angle), sin(angle), 0.0); } glVertex3f(r1 * cos(0), r1 * sin(0), width * 0.5); glVertex3f(r1 * cos(0), r1 * sin(0), -width * 0.5); glEnd(); glShadeModel(GL_SMOOTH); /* draw inside radius cylinder */ glBegin(GL_QUAD_STRIP); for (i = 0; i <= teeth; i++) { angle = i * 2.0 * M_PI / teeth; glNormal3f(-cos(angle), -sin(angle), 0.0); glVertex3f(r0 * cos(angle), r0 * sin(angle), -width * 0.5); glVertex3f(r0 * cos(angle), r0 * sin(angle), width * 0.5); } glEnd(); } /* * static GLfloat view_rotx=20.0, view_roty=30.0, view_rotz=0.0; static GLint * gear1, gear2, gear3; static GLfloat angle = 0.0; */ static GLuint limit; static GLuint count = 1; static GLubyte polycolor[4] = { 255, 255, 255, 255 }; static void draw(Togl *togl) { struct WHIRLYGIZMO *Wg; glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); Wg = Togl_GetClientData(togl); glDisable(GL_TEXTURE_2D); glPushMatrix(); glRotatef(Wg->Rotx, 1.0, 0.0, 0.0); glRotatef(Wg->Roty, 0.0, 1.0, 0.0); glRotatef(Wg->Rotz, 0.0, 0.0, 1.0); glPushMatrix(); glTranslatef(-3.0, -2.0, 0.0); glRotatef(Wg->Angle, 0.0, 0.0, 1.0); glEnable(GL_DEPTH_TEST); glCallList(Wg->Gear1); glEnable(GL_DEPTH_TEST); glPopMatrix(); glPushMatrix(); glTranslatef(3.1, -2.0, 0.0); glRotatef(-2.0 * Wg->Angle - 9.0, 0.0, 0.0, 1.0); glCallList(Wg->Gear2); glPopMatrix(); glPushMatrix(); glTranslatef(-3.1, 4.2, 0.0); glRotatef(-2.0 * Wg->Angle - 25.0, 0.0, 0.0, 1.0); glCallList(Wg->Gear3); glPopMatrix(); glPopMatrix(); Togl_SwapBuffers(togl); } static void zap(Togl *togl) { struct WHIRLYGIZMO *Wg; Wg = Togl_GetClientData(togl); free(Wg); } static void idle(Togl *togl) { struct WHIRLYGIZMO *Wg; Wg = Togl_GetClientData(togl); Wg->Angle += 2.0; Togl_PostRedisplay(togl); } /* change view angle, exit upon ESC */ /* * static GLenum key(int k, GLenum mask) { switch (k) { case TK_UP: view_rotx * += 5.0; return GL_TRUE; case TK_DOWN: view_rotx -= 5.0; return GL_TRUE; case * TK_LEFT: view_roty += 5.0; return GL_TRUE; case TK_RIGHT: view_roty -= 5.0; * return GL_TRUE; case TK_z: view_rotz += 5.0; return GL_TRUE; case TK_Z: * view_rotz -= 5.0; return GL_TRUE; } return GL_FALSE; } */ /* new window size or exposure */ static void reshape(Togl *togl) { int width, height; width = Togl_Width(togl); height = Togl_Height(togl); glViewport(0, 0, (GLint) width, (GLint) height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); if (width > height) { GLfloat w = (GLfloat) width / (GLfloat) height; glFrustum(-w, w, -1.0, 1.0, 5.0, 60.0); } else { GLfloat h = (GLfloat) height / (GLfloat) width; glFrustum(-1.0, 1.0, -h, h, 5.0, 60.0); } glMatrixMode(GL_MODELVIEW); glLoadIdentity(); glTranslatef(0.0, 0.0, -40.0); glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); } static void init(Togl *togl) { struct WHIRLYGIZMO *Wg; static GLfloat red[4] = { 0.8, 0.1, 0.0, 1.0 }; static GLfloat green[4] = { 0.0, 0.8, 0.2, 1.0 }; static GLfloat blue[4] = { 0.2, 0.2, 1.0, 1.0 }; static GLfloat pos[4] = { 5.0, 5.0, 10.0, 0.0 }; glLightfv(GL_LIGHT0, GL_POSITION, pos); glEnable(GL_CULL_FACE); glEnable(GL_LIGHTING); glEnable(GL_LIGHT0); glEnable(GL_DEPTH_TEST); /* make the gears */ Wg = malloc(sizeof (*Wg)); if (!Wg) { Tcl_SetResult(Togl_Interp(togl), "\"Cannot allocate client data for widget\"", TCL_STATIC); } Wg->Gear1 = glGenLists(1); glNewList(Wg->Gear1, GL_COMPILE); glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, red); gear(1.0, 4.0, 1.0, 20, 0.7); glEndList(); Wg->Gear2 = glGenLists(1); glNewList(Wg->Gear2, GL_COMPILE); glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, green); gear(0.5, 2.0, 2.0, 10, 0.7); glEndList(); Wg->Gear3 = glGenLists(1); glNewList(Wg->Gear3, GL_COMPILE); glMaterialfv(GL_FRONT, GL_AMBIENT_AND_DIFFUSE, blue); gear(1.3, 2.0, 0.5, 10, 0.7); glEndList(); glEnable(GL_NORMALIZE); Wg->Height = Togl_Height(togl); Wg->Width = Togl_Width(togl); Wg->Angle = 0.0; Wg->Rotx = 0.0; Wg->Roty = 0.0; Wg->Rotz = 0.0; Togl_SetClientData(togl, (ClientData) Wg); } int position(Togl *togl, int argc, CONST84 char *argv[]) { struct WHIRLYGIZMO *Wg; Tcl_Interp *interp = Togl_Interp(togl); char Result[100]; Wg = Togl_GetClientData(togl); /* error checking */ if (argc != 2) { Tcl_SetResult(interp, "wrong # args: should be \"pathName \"", TCL_STATIC); return TCL_ERROR; } /* Let result string equal value */ sprintf(Result, "%g %g", Wg->Roty, Wg->Rotx); Tcl_SetResult(interp, Result, TCL_VOLATILE); return TCL_OK; } int rotate(Togl *togl, int argc, CONST84 char *argv[]) { struct WHIRLYGIZMO *Wg; Tcl_Interp *interp = Togl_Interp(togl); Wg = Togl_GetClientData(togl); /* error checking */ if (argc != 4) { Tcl_SetResult(interp, "wrong # args: should be \"pathName xrot yrot\"", TCL_STATIC); return TCL_ERROR; } Wg->Roty = atof(argv[2]); Wg->Rotx = atof(argv[3]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } TOGL_EXTERN int Gears_Init(Tcl_Interp *interp) { /* * Initialize Tcl, Tk, and the Togl widget module. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(init); Togl_DestroyFunc(zap); Togl_DisplayFunc(draw); Togl_ReshapeFunc(reshape); Togl_TimerFunc(idle); Togl_CreateCommand("rotate", rotate); Togl_CreateCommand("position", position); return TCL_OK; } lablgl-1.05/Togl/src/Togl/gears.tcl000755 000765 000024 00000003564 12217024174 020065 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # Togl - a Tk OpenGL widget # Copyright (C) 1996-1997 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # # Test Togl using GL Gears Demo # # Copyright (C) 1997 Philip Quaife # load [file dirname [info script]]/gears[info sharedlibextension] proc setup {} { global startx starty xangle0 yangle0 xangle yangle RotCnt global vTime set RotCnt 1 set xangle 0.0 set yangle 0.0 set vTime 100 wm title . "Rotating Gear Widget Test" label .t -text "Click and drag to rotate image" pack .t -side top -padx 2 -pady 10 frame .f pack .f -side top button .f.n1 -text " Add " -command AutoRot button .f.r1 -text "Remove" -command DelRot button .f.b1 -text " Quit " -command exit entry .f.t -width 4 -textvariable vTime pack .f.n1 .f.t .f.r1 .f.b1 -side left -anchor w -padx 5 newRot .w0 10 } proc AutoRot {} { global RotCnt vTime newRot .w$RotCnt $vTime set RotCnt [expr $RotCnt + 1] } proc DelRot {} { global RotCnt vTime if { $RotCnt != 0 } { set RotCnt [expr $RotCnt - 1] destroy .w$RotCnt } } proc newRot {win {tick 100} } { togl $win -width 200 -height 200 -rgba true -double true -depth true -privatecmap false -time $tick bind $win {RotStart %x %y %W} bind $win {RotMove %x %y %W} pack $win -expand true -fill both } proc RotStart {x y W } { global startx starty xangle0 yangle0 xangle yangle set startx $x set starty $y set vPos [$W position] set xangle0 [lindex $vPos 0] set yangle0 [lindex $vPos 1] } proc RotMove {x y W} { global startx starty xangle0 yangle0 xangle yangle set xangle [expr $xangle0 + ($x - $startx) ] set yangle [expr $yangle0 + ($y - $starty) ] $W rotate $xangle $yangle } setup lablgl-1.05/Togl/src/Togl/image.c000644 000765 000024 00000014147 12217024174 017502 0ustar00garriguestaff000000 000000 /* * SGI rgb file reader borrowed from gltk library */ #include "togl.h" /* added by GG to include windows.h */ #include #include #include #include "image.h" #ifndef SEEK_SET # define SEEK_SET 0 #endif static void tkQuit(void) { exit(0); } /******************************************************************************/ typedef struct _rawImageRec { unsigned short imagic; unsigned short type; unsigned short dim; unsigned short sizeX, sizeY, sizeZ; unsigned long min, max; unsigned long wasteBytes; char name[80]; unsigned long colorMap; FILE *file; unsigned char *tmp, *tmpR, *tmpG, *tmpB, *tmpA; unsigned long rleEnd; GLuint *rowStart; GLint *rowSize; } rawImageRec; /******************************************************************************/ static void ConvertShort(unsigned short *array, long length) { unsigned long b1, b2; unsigned char *ptr; ptr = (unsigned char *) array; while (length--) { b1 = *ptr++; b2 = *ptr++; *array++ = (b1 << 8) | (b2); } } static void ConvertLong(GLuint *array, long length) { unsigned long b1, b2, b3, b4; unsigned char *ptr; ptr = (unsigned char *) array; while (length--) { b1 = *ptr++; b2 = *ptr++; b3 = *ptr++; b4 = *ptr++; *array++ = (b1 << 24) | (b2 << 16) | (b3 << 8) | (b4); } } static rawImageRec * RawImageOpen(char *fileName) { union { int testWord; char testByte[4]; } endianTest; rawImageRec *raw; GLenum swapFlag; int x; endianTest.testWord = 1; if (endianTest.testByte[0] == 1) { swapFlag = GL_TRUE; } else { swapFlag = GL_FALSE; } raw = (rawImageRec *) malloc(sizeof (rawImageRec)); if (raw == NULL) { fprintf(stderr, "Out of memory!\n"); tkQuit(); } if ((raw->file = fopen(fileName, "rb")) == NULL) { perror(fileName); tkQuit(); } fread(raw, 1, 12, raw->file); if (swapFlag) { ConvertShort(&raw->imagic, 6); } raw->tmp = (unsigned char *) malloc(raw->sizeX * 256); raw->tmpR = (unsigned char *) malloc(raw->sizeX * 256); raw->tmpG = (unsigned char *) malloc(raw->sizeX * 256); raw->tmpB = (unsigned char *) malloc(raw->sizeX * 256); raw->tmpA = (unsigned char *) malloc(raw->sizeX * 256); if (raw->tmp == NULL || raw->tmpR == NULL || raw->tmpG == NULL || raw->tmpB == NULL || raw->tmpA == NULL) { fprintf(stderr, "Out of memory!\n"); tkQuit(); } if ((raw->type & 0xFF00) == 0x0100) { x = raw->sizeY * raw->sizeZ * sizeof (GLuint); raw->rowStart = (GLuint *) malloc(x); raw->rowSize = (GLint *) malloc(x); if (raw->rowStart == NULL || raw->rowSize == NULL) { fprintf(stderr, "Out of memory!\n"); tkQuit(); } raw->rleEnd = 512 + (2 * x); fseek(raw->file, 512, SEEK_SET); fread(raw->rowStart, 1, x, raw->file); fread(raw->rowSize, 1, x, raw->file); if (swapFlag) { ConvertLong(raw->rowStart, x / sizeof (GLuint)); ConvertLong((GLuint *) raw->rowSize, x / sizeof (GLint)); } } return raw; } static void RawImageClose(rawImageRec * raw) { fclose(raw->file); free(raw->tmp); free(raw->tmpR); free(raw->tmpG); free(raw->tmpB); free(raw->tmpA); free(raw); } static void RawImageGetRow(rawImageRec * raw, unsigned char *buf, int y, int z) { unsigned char *iPtr, *oPtr, pixel; int count; if ((raw->type & 0xFF00) == 0x0100) { fseek(raw->file, raw->rowStart[y + z * raw->sizeY], SEEK_SET); fread(raw->tmp, 1, (unsigned int) raw->rowSize[y + z * raw->sizeY], raw->file); iPtr = raw->tmp; oPtr = buf; while (1) { pixel = *iPtr++; count = (int) (pixel & 0x7F); if (!count) { return; } if (pixel & 0x80) { while (count--) { *oPtr++ = *iPtr++; } } else { pixel = *iPtr++; while (count--) { *oPtr++ = pixel; } } } } else { fseek(raw->file, 512 + (y * raw->sizeX) + (z * raw->sizeX * raw->sizeY), SEEK_SET); fread(buf, 1, raw->sizeX, raw->file); } } static void RawImageGetData(rawImageRec * raw, TK_RGBImageRec * final) { unsigned char *ptr; int i, j; final->data = (unsigned char *) malloc((raw->sizeX + 1) * (raw->sizeY + 1) * 4); if (final->data == NULL) { fprintf(stderr, "Out of memory!\n"); tkQuit(); } ptr = final->data; for (i = 0; i < (int) (raw->sizeY); i++) { RawImageGetRow(raw, raw->tmpR, i, 0); RawImageGetRow(raw, raw->tmpG, i, 1); RawImageGetRow(raw, raw->tmpB, i, 2); if (raw->sizeZ == 4) { /* 4 components */ RawImageGetRow(raw, raw->tmpA, i, 3); for (j = 0; j < (int) (raw->sizeX); j++) { *ptr++ = *(raw->tmpR + j); *ptr++ = *(raw->tmpG + j); *ptr++ = *(raw->tmpB + j); *ptr++ = *(raw->tmpA + j); } } else { /* 3 components */ for (j = 0; j < (int) (raw->sizeX); j++) { *ptr++ = *(raw->tmpR + j); *ptr++ = *(raw->tmpG + j); *ptr++ = *(raw->tmpB + j); } } } } TK_RGBImageRec * tkRGBImageLoad(char *fileName) { rawImageRec *raw; TK_RGBImageRec *final; raw = RawImageOpen(fileName); final = (TK_RGBImageRec *) malloc(sizeof (TK_RGBImageRec)); if (final == NULL) { fprintf(stderr, "Out of memory!\n"); tkQuit(); } final->sizeX = raw->sizeX; final->sizeY = raw->sizeY; final->sizeZ = raw->sizeZ; RawImageGetData(raw, final); RawImageClose(raw); return final; } /******************************************************************************/ lablgl-1.05/Togl/src/Togl/image.h000644 000765 000024 00000000337 12217024174 017503 0ustar00garriguestaff000000 000000 /* image.h */ #ifndef IMAGE_H # define IMAGE_H typedef struct _TK_RGBImageRec { int sizeX, sizeY, sizeZ; unsigned char *data; } TK_RGBImageRec; extern TK_RGBImageRec *tkRGBImageLoad(char *fileName); #endif lablgl-1.05/Togl/src/Togl/index.c000644 000765 000024 00000010241 12217024174 017516 0ustar00garriguestaff000000 000000 /* $Id: index.c,v 1.10 2005/04/23 07:49:13 gregcouch Exp $ */ /* * Togl - a Tk OpenGL widget * Copyright (C) 1996-1997 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ /* * An example Togl program using color-index mode. */ #include "togl.h" #include #include /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef SUN extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #endif /* Our color indexes: */ static unsigned long black, red, green, blue; /* Rotation angle */ static float Angle = 0.0; /* * Togl widget create callback. This is called by Tcl/Tk when the widget has * been realized. Here's where one may do some one-time context setup or * initializations. */ void create_cb(Togl *togl) { /* allocate color indexes */ black = Togl_AllocColor(togl, 0.0, 0.0, 0.0); red = Togl_AllocColor(togl, 1.0, 0.0, 0.0); green = Togl_AllocColor(togl, 0.0, 1.0, 0.0); blue = Togl_AllocColor(togl, 0.0, 0.0, 1.0); /* If we were using a private read/write colormap we'd setup our color * table with something like this: */ /* * black = 1; Togl_SetColor( togl, black, 0.0, 0.0, 0.0 ); red = 2; * Togl_SetColor( togl, red, 1.0, 0.0, 0.0 ); green = 3; Togl_SetColor( * togl, green, 0.0, 1.0, 0.0 ); blue = 4; Togl_SetColor( togl, blue, 0.0, * 0.0, 1.0 ); */ glShadeModel(GL_FLAT); glDisable(GL_DITHER); } /* * Togl widget reshape callback. This is called by Tcl/Tk when the widget * has been resized. Typically, we call glViewport and perhaps setup the * projection matrix. */ void reshape_cb(Togl *togl) { int width = Togl_Width(togl); int height = Togl_Height(togl); float aspect = (float) width / (float) height; glViewport(0, 0, width, height); /* Set up projection transform */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); glOrtho(-aspect, aspect, -1.0, 1.0, -1.0, 1.0); /* Change back to model view transform for rendering */ glMatrixMode(GL_MODELVIEW); } /* * Togl widget display callback. This is called by Tcl/Tk when the widget's * contents have to be redrawn. Typically, we clear the color and depth * buffers, render our objects, then swap the front/back color buffers. */ void display_cb(Togl *togl) { glClearIndex(black); glClear(GL_COLOR_BUFFER_BIT); glPushMatrix(); glTranslatef(0.3, -0.3, 0.0); glRotatef(Angle, 0.0, 0.0, 1.0); glIndexi(red); glBegin(GL_TRIANGLES); glVertex2f(-0.5, -0.3); glVertex2f(0.5, -0.3); glVertex2f(0.0, 0.6); glEnd(); glPopMatrix(); glPushMatrix(); glRotatef(Angle, 0.0, 0.0, 1.0); glIndexi(green); glBegin(GL_TRIANGLES); glVertex2f(-0.5, -0.3); glVertex2f(0.5, -0.3); glVertex2f(0.0, 0.6); glEnd(); glPopMatrix(); glPushMatrix(); glTranslatef(-0.3, 0.3, 0.0); glRotatef(Angle, 0.0, 0.0, 1.0); glIndexi(blue); glBegin(GL_TRIANGLES); glVertex2f(-0.5, -0.3); glVertex2f(0.5, -0.3); glVertex2f(0.0, 0.6); glEnd(); glPopMatrix(); glFlush(); Togl_SwapBuffers(togl); } void timer_cb(Togl *togl) { Angle += 5.0; Togl_PostRedisplay(togl); } TOGL_EXTERN int Index_Init(Tcl_Interp *interp) { /* * Initialize Tcl, Tk, and the Togl widget module. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(create_cb); Togl_DisplayFunc(display_cb); Togl_ReshapeFunc(reshape_cb); Togl_TimerFunc(timer_cb); /* * Make a new Togl widget command so the Tcl code can set a C variable. */ /* NONE */ /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ return TCL_OK; } lablgl-1.05/Togl/src/Togl/index.tcl000644 000765 000024 00000002453 12217024174 020064 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # $Id: index.tcl,v 1.5 2001/12/20 13:59:31 beskow Exp $ # Togl - a Tk OpenGL widget # Copyright (C) 1996 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # $Log: index.tcl,v $ # Revision 1.5 2001/12/20 13:59:31 beskow # Improved error-handling in togl.c in case of window creation failure # Added pkgIndex target to makefile # Updated documentation to reflect stubs-interface (Togl.html + new README.stubs) # Added tk8.4a3 headers # Removed obsolete Tk internal headers # # Revision 1.4 2001/01/29 18:11:53 brianp # Jonas Beskow's changes to use Tcl/Tk stub interface # # Revision 1.3 1998/01/24 14:05:50 brianp # added quit button (Ben Bederson) # # Revision 1.2 1997/04/11 01:37:34 brianp # added a timer to rotate the triangles # # Revision 1.1 1996/10/23 23:18:11 brianp # Initial revision # # A Tk/OpenGL widget demo using color-index mode. load [file dirname [info script]]/index[info sharedlibextension] proc setup {} { wm title . "Color index demo" togl .win -width 200 -height 200 -rgba false -double true -privatecmap false -time 10 button .btn -text Quit -command exit pack .win -expand true -fill both pack .btn -expand true -fill both } # Execution starts here! setup lablgl-1.05/Togl/src/Togl/LICENSE000644 000765 000024 00000002705 12217024174 017256 0ustar00garriguestaff000000 000000 This software is copyrighted by Brian Paul (brian@mesa3d.org) and Benjamin Bederson (bederson@cs.umd.edu). The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. lablgl-1.05/Togl/src/Togl/overlay.c000644 000765 000024 00000010672 12217024174 020100 0ustar00garriguestaff000000 000000 /* $Id: overlay.c,v 1.7 2005/04/23 07:49:13 gregcouch Exp $ */ /* * Togl - a Tk OpenGL widget * Copyright (C) 1996-1997 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ /* * An example Togl program using an overlay. */ #include "togl.h" #include #include /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef SUN extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #endif /* Overlay color indexes: */ static unsigned long Red, Green; /* * Togl widget create callback. This is called by Tcl/Tk when the widget has * been realized. Here's where one may do some one-time context setup or * initializations. */ void create_cb(Togl *togl) { /* allocate overlay color indexes */ Red = Togl_AllocColorOverlay(togl, 1.0, 0.0, 0.0); Green = Togl_AllocColorOverlay(togl, 0.0, 1.0, 0.0); /* in this demo we always show the overlay */ if (Togl_ExistsOverlay(togl)) { Togl_ShowOverlay(togl); printf("Red and green lines are in the overlay\n"); } else { printf("Sorry, this display doesn't support overlays\n"); } } /* * Togl widget reshape callback. This is called by Tcl/Tk when the widget * has been resized. Typically, we call glViewport and perhaps setup the * projection matrix. */ void reshape_cb(Togl *togl) { int width = Togl_Width(togl); int height = Togl_Height(togl); float aspect = (float) width / (float) height; /* Set up viewing for normal plane's context */ glViewport(0, 0, width, height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); glOrtho(-aspect, aspect, -1.0, 1.0, -1.0, 1.0); glMatrixMode(GL_MODELVIEW); /* Set up viewing for overlay plane's context */ if (Togl_ExistsOverlay(togl)) { Togl_UseLayer(togl, TOGL_OVERLAY); glViewport(0, 0, width, height); glMatrixMode(GL_PROJECTION); glLoadIdentity(); glOrtho(-1.0, 1.0, -1.0, 1.0, -1.0, 1.0); glMatrixMode(GL_MODELVIEW); Togl_UseLayer(togl, TOGL_NORMAL); } } /* * Togl widget overlay display callback. This is called by Tcl/Tk when the * overlay has to be redrawn. */ void overlay_display_cb(Togl *togl) { glClear(GL_COLOR_BUFFER_BIT); glIndexi(Red); glBegin(GL_LINES); glVertex2f(-1.0, -1.0); glVertex2f(1.0, 1.0); glVertex2f(-1.0, 1.0); glVertex2f(1.0, -1.0); glEnd(); glIndexi(Green); glBegin(GL_LINE_LOOP); glVertex2f(-0.5, -0.5); glVertex2f(0.5, -0.5); glVertex2f(0.5, 0.5); glVertex2f(-0.5, 0.5); glEnd(); glFlush(); } /* * Togl widget display callback. This is called by Tcl/Tk when the widget's * contents have to be redrawn. Typically, we clear the color and depth * buffers, render our objects, then swap the front/back color buffers. */ void display_cb(Togl *togl) { glClear(GL_COLOR_BUFFER_BIT); glLoadIdentity(); glBegin(GL_TRIANGLES); glColor3f(1.0, 0.0, 1.0); glVertex2f(-0.5, -0.3); glVertex2f(0.5, -0.3); glVertex2f(0.0, 0.6); glColor3f(1.0, 1.0, 0.0); glVertex2f(-0.5 + 0.2, -0.3 - 0.2); glVertex2f(0.5 + 0.2, -0.3 - 0.2); glVertex2f(0.0 + 0.2, 0.6 - 0.2); glColor3f(0.0, 1.0, 1.0); glVertex2f(-0.5 + 0.4, -0.3 - 0.4); glVertex2f(0.5 + 0.4, -0.3 - 0.4); glVertex2f(0.0 + 0.4, 0.6 - 0.4); glEnd(); glFlush(); } /* * Called by Tk_Main() to let me initialize the modules (Togl) I will need. */ TOGL_EXTERN int Overlay_Init(Tcl_Interp *interp) { /* * Initialize Tcl, Tk, and the Togl widget module. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(create_cb); Togl_DisplayFunc(display_cb); Togl_ReshapeFunc(reshape_cb); Togl_OverlayDisplayFunc(overlay_display_cb); /* * Make a new Togl widget command so the Tcl code can set a C variable. */ /* NONE */ /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ return TCL_OK; } lablgl-1.05/Togl/src/Togl/overlay.tcl000644 000765 000024 00000002302 12217024174 020427 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # $Id: overlay.tcl,v 1.4 2001/12/20 13:59:31 beskow Exp $ # Togl - a Tk OpenGL widget # Copyright (C) 1996 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # $Log: overlay.tcl,v $ # Revision 1.4 2001/12/20 13:59:31 beskow # Improved error-handling in togl.c in case of window creation failure # Added pkgIndex target to makefile # Updated documentation to reflect stubs-interface (Togl.html + new README.stubs) # Added tk8.4a3 headers # Removed obsolete Tk internal headers # # Revision 1.3 2001/01/29 18:11:53 brianp # Jonas Beskow's changes to use Tcl/Tk stub interface # # Revision 1.2 1998/01/24 14:05:50 brianp # added quit button (Ben Bederson) # # Revision 1.1 1997/03/07 01:26:38 brianp # Initial revision # # # A Tk/OpenGL widget demo using an overlay. load [file dirname [info script]]/overlay[info sharedlibextension] proc setup {} { wm title . "Overlay demo" togl .win -width 200 -height 200 -rgba true -double false -overlay true button .btn -text Quit -command exit pack .win -expand true -fill both pack .btn -expand true -fill both } # Execution starts here! setup lablgl-1.05/Togl/src/Togl/stereo.c000644 000765 000024 00000021216 12217024174 017714 0ustar00garriguestaff000000 000000 /* $Id: stereo.c,v 1.6 2005/04/23 07:49:13 gregcouch Exp $ */ /* * Togl - a Tk OpenGL widget * Copyright (C) 1996-1997 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ #include "togl.h" #include #include /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef SUN extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #endif static GLuint FontBase; static float xAngle = 0.0, yAngle = 0.0, zAngle = 0.0; static GLfloat CornerX, CornerY, CornerZ; /* where to print strings */ static GLfloat scale = 1.0; /* * Togl widget create callback. This is called by Tcl/Tk when the widget has * been realized. Here's where one may do some one-time context setup or * initializations. */ void create_cb(Togl *togl) { FontBase = Togl_LoadBitmapFont(togl, TOGL_BITMAP_8_BY_13); if (!FontBase) { printf("Couldn't load font!\n"); exit(1); } } /* * Togl widget reshape callback. This is called by Tcl/Tk when the widget * has been resized. Typically, we call glViewport and perhaps setup the * projection matrix. */ void reshape_cb(Togl *togl) { int width = Togl_Width(togl); int height = Togl_Height(togl); float aspect = (float) width / (float) height; glViewport(0, 0, width, height); /* Set up projection transform */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); glFrustum(-aspect, aspect, -1.0, 1.0, 1.0, 10.0); CornerX = -aspect; CornerY = -1.0; CornerZ = -1.1; /* Change back to model view transform for rendering */ glMatrixMode(GL_MODELVIEW); } static void print_string(const char *s) { glCallLists(strlen(s), GL_UNSIGNED_BYTE, s); } /* * Togl widget display callback. This is called by Tcl/Tk when the widget's * contents have to be redrawn. Typically, we clear the color and depth * buffers, render our objects, then swap the front/back color buffers. */ void display_cb(Togl *togl) { const char *ident; GLfloat eyeDist = 2.0; GLfloat eyeOffset = 0.05; glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); glLoadIdentity(); /* Reset modelview matrix to the identity * matrix */ glTranslatef(0.0, 0.0, -3.0); /* Move the camera back three units */ glScalef(scale, scale, scale); /* Zoom in and out */ glRotatef(xAngle, 1.0, 0.0, 0.0); /* Rotate by X, Y, and Z angles */ glRotatef(yAngle, 0.0, 1.0, 0.0); glRotatef(zAngle, 0.0, 0.0, 1.0); glEnable(GL_DEPTH_TEST); /* stereo right eye */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); Togl_StereoFrustum(-1, 1, -1, 1, 1, 10, eyeDist, eyeOffset); glMatrixMode(GL_MODELVIEW); #ifdef OLD_STEREO Togl_OldStereoDrawBuffer(GL_BACK_RIGHT); Togl_OldStereoClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); #else glDrawBuffer(GL_BACK_RIGHT); glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); #endif /* Front face */ glBegin(GL_QUADS); glColor3f(0.0, 0.7, 0.1); /* Green */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(-1.0, -1.0, 1.0); /* Back face */ glColor3f(0.9, 1.0, 0.0); /* Yellow */ glVertex3f(-1.0, 1.0, -1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); /* Top side face */ glColor3f(0.2, 0.2, 1.0); /* Blue */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(-1.0, 1.0, -1.0); /* Bottom side face */ glColor3f(0.7, 0.0, 0.1); /* Red */ glVertex3f(-1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); glEnd(); /* stereo left eye */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); Togl_StereoFrustum(-1, 1, -1, 1, 1, 10, eyeDist, -eyeOffset); glMatrixMode(GL_MODELVIEW); #ifdef OLD_STEREO Togl_OldStereoDrawBuffer(GL_BACK_LEFT); Togl_OldStereoClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); #else glDrawBuffer(GL_BACK_LEFT); glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); #endif /* Front face */ glBegin(GL_QUADS); glColor3f(0.0, 0.7, 0.1); /* Green */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(-1.0, -1.0, 1.0); /* Back face */ glColor3f(0.9, 1.0, 0.0); /* Yellow */ glVertex3f(-1.0, 1.0, -1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); /* Top side face */ glColor3f(0.2, 0.2, 1.0); /* Blue */ glVertex3f(-1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, 1.0); glVertex3f(1.0, 1.0, -1.0); glVertex3f(-1.0, 1.0, -1.0); /* Bottom side face */ glColor3f(0.7, 0.0, 0.1); /* Red */ glVertex3f(-1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, 1.0); glVertex3f(1.0, -1.0, -1.0); glVertex3f(-1.0, -1.0, -1.0); glEnd(); glDisable(GL_DEPTH_TEST); glLoadIdentity(); glColor3f(1.0, 1.0, 1.0); glRasterPos3f(CornerX, CornerY, CornerZ); glListBase(FontBase); /* ident = Togl_Ident( togl ); if (strcmp(ident,"Single")==0) { * print_string( "Single buffered" ); } else { print_string( "Double * buffered" ); } */ print_string(Togl_Ident(togl)); Togl_SwapBuffers(togl); } int setXrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setXrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } xAngle = atof(argv[2]); /* printf( "before %f ", xAngle ); */ if (xAngle < 0.0) { xAngle += 360.0; } else if (xAngle > 360.0) { xAngle -= 360.0; } /* printf( "after %f \n", xAngle ); */ Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int setYrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setYrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } yAngle = atof(argv[2]); if (yAngle < 0.0) { yAngle += 360.0; } else if (yAngle > 360.0) { yAngle -= 360.0; } Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int getXrot_cb(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { sprintf(interp->result, "%d", (int) xAngle); return TCL_OK; } int getYrot_cb(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { sprintf(interp->result, "%d", (int) yAngle); return TCL_OK; } int scale_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName scale ?value?\"", TCL_STATIC); return TCL_ERROR; } scale = atof(argv[2]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } TOGL_EXTERN int Stereo_Init(Tcl_Interp *interp) { /* * Initialize Tcl, Tk, and the Togl widget module. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(create_cb); Togl_DisplayFunc(display_cb); Togl_ReshapeFunc(reshape_cb); /* * Make a new Togl widget command so the Tcl code can set a C variable. */ Togl_CreateCommand("setXrot", setXrot_cb); Togl_CreateCommand("setYrot", setYrot_cb); Togl_CreateCommand("scale", scale_cb); /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ Tcl_CreateCommand(interp, "getXrot", getXrot_cb, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "getYrot", getYrot_cb, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } lablgl-1.05/Togl/src/Togl/stereo.tcl000644 000765 000024 00000005543 12217024174 020261 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # $Id: stereo.tcl,v 1.4 2004/12/21 05:28:39 gregcouch Exp $ # Togl - a Tk OpenGL widget # Copyright (C) 1996 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # $Log: stereo.tcl,v $ # Revision 1.4 2004/12/21 05:28:39 gregcouch # Apply outstanding patches and Mac OS X support. # # Revision 1.3 2001/12/20 13:59:31 beskow # Improved error-handling in togl.c in case of window creation failure # Added pkgIndex target to makefile # Updated documentation to reflect stubs-interface (Togl.html + new README.stubs) # Added tk8.4a3 headers # Removed obsolete Tk internal headers # # Revision 1.2 2001/01/29 18:11:53 brianp # Jonas Beskow's changes to use Tcl/Tk stub interface # # Revision 1.1 1997/10/01 02:53:12 brianp # Initial revision # # # Revision 1.1 1997/9/28 18:54:46 Ben Evans # Initial revision. Based on double.tcl # # An Tk/OpenGL widget demo with two windows, one single buffered and the # other double buffered. load [file dirname [info script]]/stereo[info sharedlibextension] proc setup {} { global scale set scale 1.0 wm title . "Full Screen Stereo Buffering" frame .f1 togl .f1.o1 -width 200 -height 200 -rgba true -stereo true -double true -depth true -ident "stereo buffer" scale .sx -label {X Axis} -from 0 -to 360 -command {setAngle x} -orient horizontal scale .sy -label {Y Axis} -from 0 -to 360 -command {setAngle y} -orient horizontal button .btn -text Quit -command exit bind .f1.o1 { motion_event [lindex [%W config -width] 4] \ [lindex [%W config -height] 4] \ %x %y } bind .f1.o1 { set startx %x set starty %y set scale0 $scale } bind .f1.o1 { set q [ expr ($starty - %y) / 400.0 ] set scale [expr $scale0 * exp($q)] .f1.o1 scale $scale } pack .f1.o1 -side left -padx 3 -pady 3 -fill both -expand t pack .f1 -fill both -expand t pack .sx -fill x pack .sy -fill x pack .btn -fill x if {[string first $::tcl_platform(os) IRIX] != -1} { puts "use /usr/gfx/setmon -n 60 to reset display and /usr/gfx/setmon -n STR_RECT to put in display in stereo mode" } } # This is called when mouse button 1 is pressed and moved in either of # the OpenGL windows. proc motion_event { width height x y } { .f1.o1 setXrot [expr 360.0 * $y / $height] .f1.o1 setYrot [expr 360.0 * ($width - $x) / $width] # .sx set [expr 360.0 * $y / $height] # .sy set [expr 360.0 * ($width - $x) / $width] .sx set [getXrot] .sy set [getYrot] } # This is called when a slider is changed. proc setAngle {axis value} { global xAngle yAngle zAngle switch -exact $axis { x {.f1.o1 setXrot $value} y {.f1.o1 setYrot $value} } } # Execution starts here! setup lablgl-1.05/Togl/src/Togl/texture.c000644 000765 000024 00000034671 12217024174 020124 0ustar00garriguestaff000000 000000 /* $Id: texture.c,v 1.10 2005/04/23 07:49:14 gregcouch Exp $ */ /* * Togl - a Tk OpenGL widget * Copyright (C) 1996-1997 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ /* * An example Togl program demonstrating texture mapping */ #include "togl.h" #include #include #if defined(TOGL_AGL) || defined(TOGL_AGL_CLASSIC) # include #else # include #endif #include "image.h" /* * The following variable is a special hack that is needed in order for * Sun shared libraries to be used for Tcl. */ #ifdef SUN extern int matherr(); int *tclDummyMathPtr = (int *) matherr; #endif #define CHECKER 0 #define FACE 1 #define TREE 2 static GLenum minfilter = GL_NEAREST_MIPMAP_LINEAR; static GLenum magfilter = GL_LINEAR; static GLenum swrap = GL_REPEAT; static GLenum twrap = GL_REPEAT; static GLenum envmode = GL_MODULATE; static GLubyte polycolor[4] = { 255, 255, 255, 255 }; static int image = CHECKER; static GLfloat coord_scale = 1.0; static GLfloat xrot = 0.0; static GLfloat yrot = 0.0; static GLfloat scale = 1.0; static GLint width, height; static GLboolean blend = GL_FALSE; /* * Load a texture image. n is one of CHECKER, FACE or TREE. */ void texture_image(int n) { if (n == CHECKER) { #define WIDTH 64 #define HEIGHT 64 GLubyte teximage[WIDTH * HEIGHT][4]; int i, j; for (i = 0; i < HEIGHT; i++) { for (j = 0; j < WIDTH; j++) { GLubyte value; value = ((i / 4 + j / 4) % 2) ? 0xff : 0x00; teximage[i * WIDTH + j][0] = value; teximage[i * WIDTH + j][1] = value; teximage[i * WIDTH + j][2] = value; teximage[i * WIDTH + j][3] = value; } } glEnable(GL_TEXTURE_2D); gluBuild2DMipmaps(GL_TEXTURE_2D, 4, WIDTH, HEIGHT, GL_RGBA, GL_UNSIGNED_BYTE, teximage); blend = GL_FALSE; #undef WIDTH #undef HEIGHT } else if (n == FACE) { TK_RGBImageRec *img = tkRGBImageLoad("ben.rgb"); if (img) { glEnable(GL_TEXTURE_2D); glPixelStorei(GL_UNPACK_ALIGNMENT, 1); gluBuild2DMipmaps(GL_TEXTURE_2D, img->sizeZ, img->sizeX, img->sizeY, img->sizeZ == 3 ? GL_RGB : GL_RGBA, GL_UNSIGNED_BYTE, img->data); blend = GL_TRUE; } } else if (n == TREE) { TK_RGBImageRec *img = tkRGBImageLoad("tree2.rgba"); if (img) { glEnable(GL_TEXTURE_2D); glPixelStorei(GL_UNPACK_ALIGNMENT, 1); gluBuild2DMipmaps(GL_TEXTURE_2D, img->sizeZ, img->sizeX, img->sizeY, img->sizeZ == 3 ? GL_RGB : GL_RGBA, GL_UNSIGNED_BYTE, img->data); blend = GL_TRUE; } } else { abort(); } } /* * Togl widget create callback. This is called by Tcl/Tk when the widget has * been realized. Here's where one may do some one-time context setup or * initializations. */ void create_cb(Togl *togl) { glEnable(GL_DEPTH_TEST); /* Enable depth buffering */ texture_image(CHECKER); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, magfilter); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, minfilter); } /* * Togl widget reshape callback. This is called by Tcl/Tk when the widget * has been resized. Typically, we call glViewport and perhaps setup the * projection matrix. */ void reshape_cb(Togl *togl) { width = Togl_Width(togl); height = Togl_Height(togl); glViewport(0, 0, width, height); } static void check_error(char *where) { GLenum error; while (1) { error = glGetError(); if (error == GL_NO_ERROR) { break; } printf("OpenGL error near %s: %s\n", where, gluErrorString(error)); } } /* * Togl widget display callback. This is called by Tcl/Tk when the widget's * contents have to be redrawn. Typically, we clear the color and depth * buffers, render our objects, then swap the front/back color buffers. */ void display_cb(Togl *togl) { float aspect = (float) width / (float) height; check_error("begin display\n"); glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); /* Draw background image */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); glMatrixMode(GL_MODELVIEW); glLoadIdentity(); glDisable(GL_TEXTURE_2D); glDisable(GL_DEPTH_TEST); glBegin(GL_POLYGON); glColor3f(0.0, 0.0, 0.3); glVertex2f(-1.0, -1.0); glColor3f(0.0, 0.0, 0.3); glVertex2f(1.0, -1.0); glColor3f(0.0, 0.0, 0.9); glVertex2f(1.0, 1.0); glColor3f(0.0, 0.0, 0.9); glVertex2f(-1.0, 1.0); glEnd(); /* draw textured object */ glMatrixMode(GL_PROJECTION); glLoadIdentity(); glFrustum(-aspect, aspect, -1.0, 1.0, 2.0, 10.0); glMatrixMode(GL_MODELVIEW); glLoadIdentity(); glTranslatef(0.0, 0.0, -5.0); glScalef(scale, scale, scale); glRotatef(yrot, 0.0, 1.0, 0.0); glRotatef(xrot, 1.0, 0.0, 0.0); glEnable(GL_DEPTH_TEST); glEnable(GL_TEXTURE_2D); glColor4ubv(polycolor); if (blend) { glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable(GL_BLEND); } glBegin(GL_POLYGON); glTexCoord2f(0.0, 0.0); glVertex2f(-1.0, -1.0); glTexCoord2f(coord_scale, 0.0); glVertex2f(1.0, -1.0); glTexCoord2f(coord_scale, coord_scale); glVertex2f(1.0, 1.0); glTexCoord2f(0.0, coord_scale); glVertex2f(-1.0, 1.0); glEnd(); glDisable(GL_BLEND); Togl_SwapBuffers(togl); } /* * Called when a magnification filter radio button is pressed. */ int magfilter_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); if (strcmp(argv[2], "GL_NEAREST") == 0) { magfilter = GL_NEAREST; } else if (strcmp(argv[2], "GL_LINEAR") == 0) { magfilter = GL_LINEAR; } else { Tcl_SetResult(interp, "unknown magnification filter type", TCL_STATIC); return TCL_ERROR; } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, magfilter); Togl_PostRedisplay(togl); return TCL_OK; } /* * Called when a minification filter radio button is pressed. */ int minfilter_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); if (strcmp(argv[2], "GL_NEAREST") == 0) { minfilter = GL_NEAREST; } else if (strcmp(argv[2], "GL_LINEAR") == 0) { minfilter = GL_LINEAR; } else if (strcmp(argv[2], "GL_NEAREST_MIPMAP_NEAREST") == 0) { minfilter = GL_NEAREST_MIPMAP_NEAREST; } else if (strcmp(argv[2], "GL_LINEAR_MIPMAP_NEAREST") == 0) { minfilter = GL_LINEAR_MIPMAP_NEAREST; } else if (strcmp(argv[2], "GL_NEAREST_MIPMAP_LINEAR") == 0) { minfilter = GL_NEAREST_MIPMAP_LINEAR; } else if (strcmp(argv[2], "GL_LINEAR_MIPMAP_LINEAR") == 0) { minfilter = GL_LINEAR_MIPMAP_LINEAR; } else { Tcl_SetResult(interp, "unknown minification filter type", TCL_STATIC); return TCL_ERROR; } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, minfilter); Togl_PostRedisplay(togl); return TCL_OK; } int xrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setXrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } xrot = atof(argv[2]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int yrot_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName setYrot ?angle?\"", TCL_STATIC); return TCL_ERROR; } yrot = atof(argv[2]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } int scale_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName scale ?value?\"", TCL_STATIC); return TCL_ERROR; } scale = atof(argv[2]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when S texture coordinate wrapping is changed. */ int swrap_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName swrap ?mode?\"", TCL_STATIC); return TCL_ERROR; } if (strcmp(argv[2], "GL_CLAMP") == 0) { swrap = GL_CLAMP; } else if (strcmp(argv[2], "GL_REPEAT") == 0) { swrap = GL_REPEAT; } else { Tcl_SetResult(interp, "unknown wrap value", TCL_STATIC); return TCL_ERROR; } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, swrap); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when T texture coordinate wrapping is changed. */ int twrap_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName twrap ?mode?\"", TCL_STATIC); return TCL_ERROR; } if (strcmp(argv[2], "GL_CLAMP") == 0) { twrap = GL_CLAMP; } else if (strcmp(argv[2], "GL_REPEAT") == 0) { twrap = GL_REPEAT; } else { Tcl_SetResult(interp, "unknown wrap value", TCL_STATIC); return TCL_ERROR; } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, twrap); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when the texture environment mode is changed. */ int envmode_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName envmode ?mode?\"", TCL_STATIC); return TCL_ERROR; } if (strcmp(argv[2], "GL_MODULATE") == 0) { envmode = GL_MODULATE; } else if (strcmp(argv[2], "GL_DECAL") == 0) { envmode = GL_DECAL; } else if (strcmp(argv[2], "GL_BLEND") == 0) { envmode = GL_BLEND; } else { Tcl_SetResult(interp, "unknown texture env mode", TCL_STATIC); return TCL_ERROR; } glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, envmode); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when the polygon color is changed. */ int polycolor_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 5) { Tcl_SetResult(interp, "wrong # args: should be \"pathName polycolor ?r? ?g? ?b?\"", TCL_STATIC); return TCL_ERROR; } polycolor[0] = atoi(argv[2]); polycolor[1] = atoi(argv[3]); polycolor[2] = atoi(argv[4]); Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when the texture image is to be changed */ int image_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName image ?name?\"", TCL_STATIC); return TCL_ERROR; } if (strcmp(argv[2], "CHECKER") == 0) { texture_image(CHECKER); } else if (strcmp(argv[2], "FACE") == 0) { texture_image(FACE); } else if (strcmp(argv[2], "TREE") == 0) { texture_image(TREE); } else { Tcl_SetResult(interp, "unknown texture image", TCL_STATIC); return TCL_ERROR; } Togl_PostRedisplay(togl); /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } /* * Called when the texture coordinate scale is changed. */ int coord_scale_cb(Togl *togl, int argc, CONST84 char *argv[]) { Tcl_Interp *interp = Togl_Interp(togl); float s; /* error checking */ if (argc != 3) { Tcl_SetResult(interp, "wrong # args: should be \"pathName coord_scale ?scale?\"", TCL_STATIC); return TCL_ERROR; } s = atof(argv[2]); if (s > 0.0 && s < 10.0) { coord_scale = s; Togl_PostRedisplay(togl); } /* Let result string equal value */ strcpy(interp->result, argv[2]); return TCL_OK; } TOGL_EXTERN int Texture_Init(Tcl_Interp *interp) { /* * Initialize Tcl, Tk, and the Togl widget module. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif if (Togl_Init(interp) == TCL_ERROR) { return TCL_ERROR; } /* * Specify the C callback functions for widget creation, display, * and reshape. */ Togl_CreateFunc(create_cb); Togl_DisplayFunc(display_cb); Togl_ReshapeFunc(reshape_cb); /* * Make a new Togl widget command so the Tcl code can set a C variable. */ Togl_CreateCommand("min_filter", minfilter_cb); Togl_CreateCommand("mag_filter", magfilter_cb); Togl_CreateCommand("xrot", xrot_cb); Togl_CreateCommand("yrot", yrot_cb); Togl_CreateCommand("scale", scale_cb); Togl_CreateCommand("swrap", swrap_cb); Togl_CreateCommand("twrap", twrap_cb); Togl_CreateCommand("envmode", envmode_cb); Togl_CreateCommand("polycolor", polycolor_cb); Togl_CreateCommand("image", image_cb); Togl_CreateCommand("coord_scale", coord_scale_cb); /* * Call Tcl_CreateCommand for application-specific commands, if * they weren't already created by the init procedures called above. */ return TCL_OK; } lablgl-1.05/Togl/src/Togl/texture.tcl000644 000765 000024 00000022446 12217024174 020461 0ustar00garriguestaff000000 000000 #!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" # $Id: texture.tcl,v 1.5 2001/12/20 13:59:31 beskow Exp $ # Togl - a Tk OpenGL widget # Copyright (C) 1996 Brian Paul and Ben Bederson # See the LICENSE file for copyright details. # $Log: texture.tcl,v $ # Revision 1.5 2001/12/20 13:59:31 beskow # Improved error-handling in togl.c in case of window creation failure # Added pkgIndex target to makefile # Updated documentation to reflect stubs-interface (Togl.html + new README.stubs) # Added tk8.4a3 headers # Removed obsolete Tk internal headers # # Revision 1.4 2001/01/29 18:11:53 brianp # Jonas Beskow's changes to use Tcl/Tk stub interface # # Revision 1.3 1998/01/24 14:05:50 brianp # added quit button (Ben Bederson) # # Revision 1.2 1997/09/30 23:54:46 brianp # new layout # # Revision 1.1 1996/10/23 23:18:36 brianp # Initial revision # # Togl texture map demo load [file dirname [info script]]/texture[info sharedlibextension] # Called magnification filter changes proc new_magfilter {} { global magfilter .f1.view mag_filter $magfilter } # Called minification filter changes proc new_minfilter {} { global minfilter .f1.view min_filter $minfilter } # Called when texture image radio button changes proc new_image {} { global teximage .f1.view image $teximage } # Called when texture S wrap button changes proc new_swrap {} { global swrap .f1.view swrap $swrap } # Called when texture T wrap button changes proc new_twrap {} { global twrap .f1.view twrap $twrap } # Called when texture environment radio button selected proc new_env {} { global envmode .f1.view envmode $envmode } # Called when polygon color sliders change proc new_color { foo } { global poly_red poly_green poly_blue .f1.view polycolor $poly_red $poly_green $poly_blue } proc new_coord_scale { name element op } { global coord_scale .f1.view coord_scale $coord_scale } # Make the widgets proc setup {} { global magfilter global minfilter global teximage global swrap global twrap global envmode global poly_red global poly_green global poly_blue global coord_scale global startx starty # location of mouse when button pressed global xangle yangle global xangle0 yangle0 global scale scale0 wm title . "Texture Map Options" ### Two frames: top half and bottom half frame .f1 frame .f2 ### The OpenGL window togl .f1.view -width 250 -height 250 -rgba true -double true -depth true ### Filter radio buttons frame .f1.filter -relief ridge -borderwidth 3 frame .f1.filter.mag -relief ridge -borderwidth 2 label .f1.filter.mag.label -text "Magnification Filter" -anchor w radiobutton .f1.filter.mag.nearest -text GL_NEAREST -anchor w -variable magfilter -value GL_NEAREST -command new_magfilter radiobutton .f1.filter.mag.linear -text GL_LINEAR -anchor w -variable magfilter -value GL_LINEAR -command new_magfilter frame .f1.filter.min -relief ridge -borderwidth 2 label .f1.filter.min.label -text "Minification Filter" -anchor w radiobutton .f1.filter.min.nearest -text GL_NEAREST -anchor w -variable minfilter -value GL_NEAREST -command new_minfilter radiobutton .f1.filter.min.linear -text GL_LINEAR -anchor w -variable minfilter -value GL_LINEAR -command new_minfilter radiobutton .f1.filter.min.nearest_mipmap_nearest -text GL_NEAREST_MIPMAP_NEAREST -anchor w -variable minfilter -value GL_NEAREST_MIPMAP_NEAREST -command new_minfilter radiobutton .f1.filter.min.linear_mipmap_nearest -text GL_LINEAR_MIPMAP_NEAREST -anchor w -variable minfilter -value GL_LINEAR_MIPMAP_NEAREST -command new_minfilter radiobutton .f1.filter.min.nearest_mipmap_linear -text GL_NEAREST_MIPMAP_LINEAR -anchor w -variable minfilter -value GL_NEAREST_MIPMAP_LINEAR -command new_minfilter radiobutton .f1.filter.min.linear_mipmap_linear -text GL_LINEAR_MIPMAP_LINEAR -anchor w -variable minfilter -value GL_LINEAR_MIPMAP_LINEAR -command new_minfilter pack .f1.filter.mag -fill x pack .f1.filter.mag.label -fill x pack .f1.filter.mag.nearest -side top -fill x pack .f1.filter.mag.linear -side top -fill x pack .f1.filter.min -fill both -expand true pack .f1.filter.min.label -side top -fill x pack .f1.filter.min.nearest -side top -fill x pack .f1.filter.min.linear -side top -fill x pack .f1.filter.min.nearest_mipmap_nearest -side top -fill x pack .f1.filter.min.linear_mipmap_nearest -side top -fill x pack .f1.filter.min.nearest_mipmap_linear -side top -fill x pack .f1.filter.min.linear_mipmap_linear -side top -fill x ### Texture coordinate scale and wrapping frame .f2.coord -relief ridge -borderwidth 3 frame .f2.coord.scale -relief ridge -borderwidth 2 label .f2.coord.scale.label -text "Max Texture Coord" -anchor w entry .f2.coord.scale.entry -textvariable coord_scale trace variable coord_scale w new_coord_scale frame .f2.coord.s -relief ridge -borderwidth 2 label .f2.coord.s.label -text "GL_TEXTURE_WRAP_S" -anchor w radiobutton .f2.coord.s.repeat -text "GL_REPEAT" -anchor w -variable swrap -value GL_REPEAT -command new_swrap radiobutton .f2.coord.s.clamp -text "GL_CLAMP" -anchor w -variable swrap -value GL_CLAMP -command new_swrap frame .f2.coord.t -relief ridge -borderwidth 2 label .f2.coord.t.label -text "GL_TEXTURE_WRAP_T" -anchor w radiobutton .f2.coord.t.repeat -text "GL_REPEAT" -anchor w -variable twrap -value GL_REPEAT -command new_twrap radiobutton .f2.coord.t.clamp -text "GL_CLAMP" -anchor w -variable twrap -value GL_CLAMP -command new_twrap pack .f2.coord.scale -fill both -expand true pack .f2.coord.scale.label -side top -fill x pack .f2.coord.scale.entry -side top -fill x pack .f2.coord.s -fill x pack .f2.coord.s.label -side top -fill x pack .f2.coord.s.repeat -side top -fill x pack .f2.coord.s.clamp -side top -fill x pack .f2.coord.t -fill x pack .f2.coord.t.label -side top -fill x pack .f2.coord.t.repeat -side top -fill x pack .f2.coord.t.clamp -side top -fill x ### Texture image radio buttons (just happens to fit into the coord frame) frame .f2.env -relief ridge -borderwidth 3 frame .f2.env.image -relief ridge -borderwidth 2 label .f2.env.image.label -text "Texture Image" -anchor w radiobutton .f2.env.image.checker -text "Checker" -anchor w -variable teximage -value CHECKER -command new_image radiobutton .f2.env.image.tree -text "Tree" -anchor w -variable teximage -value TREE -command new_image radiobutton .f2.env.image.face -text "Face" -anchor w -variable teximage -value FACE -command new_image pack .f2.env.image -fill x pack .f2.env.image.label -side top -fill x pack .f2.env.image.checker -side top -fill x pack .f2.env.image.tree -side top -fill x pack .f2.env.image.face -side top -fill x ### Texture Environment label .f2.env.label -text "GL_TEXTURE_ENV_MODE" -anchor w radiobutton .f2.env.modulate -text "GL_MODULATE" -anchor w -variable envmode -value GL_MODULATE -command new_env radiobutton .f2.env.decal -text "GL_DECAL" -anchor w -variable envmode -value GL_DECAL -command new_env radiobutton .f2.env.blend -text "GL_BLEND" -anchor w -variable envmode -value GL_BLEND -command new_env pack .f2.env.label -fill x pack .f2.env.modulate -side top -fill x pack .f2.env.decal -side top -fill x pack .f2.env.blend -side top -fill x ### Polygon color frame .f2.color -relief ridge -borderwidth 3 label .f2.color.label -text "Polygon color" -anchor w scale .f2.color.red -label Red -from 0 -to 255 -orient horizontal -variable poly_red -command new_color scale .f2.color.green -label Green -from 0 -to 255 -orient horizontal -variable poly_green -command new_color scale .f2.color.blue -label Blue -from 0 -to 255 -orient horizontal -variable poly_blue -command new_color pack .f2.color.label -fill x pack .f2.color.red -side top -fill x pack .f2.color.green -side top -fill x pack .f2.color.blue -side top -fill x ### Main widgets pack .f1.view -side left -fill both -expand true pack .f1.filter -side left -fill y pack .f1 -side top -fill both -expand true pack .f2.coord .f2.env -side left -fill both pack .f2.color -fill x pack .f2 -side top -fill x button .btn -text Quit -command exit pack .btn -expand true -fill both bind .f1.view { set startx %x set starty %y set xangle0 $xangle set yangle0 $yangle } bind .f1.view { set xangle [expr $xangle0 + (%x - $startx) / 3.0 ] set yangle [expr $yangle0 + (%y - $starty) / 3.0 ] .f1.view yrot $xangle .f1.view xrot $yangle } bind .f1.view { set startx %x set starty %y set scale0 $scale } bind .f1.view { set q [ expr ($starty - %y) / 400.0 ] set scale [expr $scale0 * exp($q)] .f1.view scale $scale } # set default values: set minfilter GL_NEAREST_MIPMAP_LINEAR set magfilter GL_LINEAR set swrap GL_REPEAT set twrap GL_REPEAT set envmode GL_MODULATE set teximage CHECKER set poly_red 255 set poly_green 255 set poly_blue 255 set coord_scale 1.0 set xangle 0.0 set yangle 0.0 set scale 1.0 } # Execution starts here! setup lablgl-1.05/Togl/src/Togl/tkFont.h000644 000765 000024 00000017435 12217024174 017675 0ustar00garriguestaff000000 000000 /* * tkFont.h -- * * Declarations for interfaces between the generic and platform-specific * parts of the font package. This information is not visible outside of * the font package. * * Copyright (c) 1996-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TKFONT #define _TKFONT #ifdef BUILD_tk #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT #endif /* * The following structure keeps track of the attributes of a font. It can be * used to keep track of either the desired attributes or the actual * attributes gotten when the font was instantiated. */ struct TkFontAttributes { Tk_Uid family; /* Font family, or NULL to represent plaform- * specific default system font. */ int size; /* Pointsize of font, 0 for default size, or * negative number meaning pixel size. */ int weight; /* Weight flag; see below for def'n. */ int slant; /* Slant flag; see below for def'n. */ int underline; /* Non-zero for underline font. */ int overstrike; /* Non-zero for overstrike font. */ }; /* * Possible values for the "weight" field in a TkFontAttributes structure. * Weight is a subjective term and depends on what the company that created * the font considers bold. */ #define TK_FW_NORMAL 0 #define TK_FW_BOLD 1 #define TK_FW_UNKNOWN -1 /* Unknown weight. This value is used for * error checking and is never actually stored * in the weight field. */ /* * Possible values for the "slant" field in a TkFontAttributes structure. */ #define TK_FS_ROMAN 0 #define TK_FS_ITALIC 1 #define TK_FS_OBLIQUE 2 /* This value is only used when parsing X font * names to determine the closest match. It is * only stored in the XLFDAttributes * structure, never in the slant field of the * TkFontAttributes. */ #define TK_FS_UNKNOWN -1 /* Unknown slant. This value is used for error * checking and is never actually stored in * the slant field. */ /* * The following structure keeps track of the metrics for an instantiated * font. The metrics are the physical properties of the font itself. */ typedef struct TkFontMetrics { int ascent; /* From baseline to top of font. */ int descent; /* From baseline to bottom of font. */ int maxWidth; /* Width of widest character in font. */ int fixed; /* Non-zero if this is a fixed-width font, * 0 otherwise. */ } TkFontMetrics; /* * The following structure is used to keep track of the generic information * about a font. Each platform-specific font is represented by a structure * with the following structure at its beginning, plus any platform-specific * stuff after that. */ typedef struct TkFont { /* * Fields used and maintained exclusively by generic code. */ int resourceRefCount; /* Number of active uses of this font (each * active use corresponds to a call to * Tk_AllocFontFromTable or Tk_GetFont). If * this count is 0, then this TkFont structure * is no longer valid and it isn't present in * a hash table: it is being kept around only * because there are objects referring to it. * The structure is freed when * resourceRefCount and objRefCount are both * 0. */ int objRefCount; /* The number of Tcl objects that reference * this structure. */ Tcl_HashEntry *cacheHashPtr;/* Entry in font cache for this structure, * used when deleting it. */ Tcl_HashEntry *namedHashPtr;/* Pointer to hash table entry that * corresponds to the named font that the * tkfont was based on, or NULL if the tkfont * was not based on a named font. */ Screen *screen; /* The screen where this font is valid. */ int tabWidth; /* Width of tabs in this font (pixels). */ int underlinePos; /* Offset from baseline to origin of underline * bar (used for drawing underlines on a * non-underlined font). */ int underlineHeight; /* Height of underline bar (used for drawing * underlines on a non-underlined font). */ /* * Fields used in the generic code that are filled in by * platform-specific code. */ Font fid; /* For backwards compatibility with XGCValues * structures. Remove when TkGCValues is * implemented. */ TkFontAttributes fa; /* Actual font attributes obtained when the * the font was created, as opposed to the * desired attributes passed in to * TkpGetFontFromAttributes(). The desired * metrics can be determined from the string * that was used to create this font. */ TkFontMetrics fm; /* Font metrics determined when font was * created. */ struct TkFont *nextPtr; /* Points to the next TkFont structure with * the same name. All fonts with the same name * (but different displays) are chained * together off a single entry in a hash * table. */ } TkFont; /* * The following structure is used to return attributes when parsing an XLFD. * The extra information is of interest to the Unix-specific code when * attempting to find the closest matching font. */ typedef struct TkXLFDAttributes { Tk_Uid foundry; /* The foundry of the font. */ int slant; /* The tristate value for the slant, which is * significant under X. */ int setwidth; /* The proportionate width, see below for * definition. */ Tk_Uid charset; /* The actual charset string. */ } TkXLFDAttributes; /* * Possible values for the "setwidth" field in a TkXLFDAttributes structure. * The setwidth is whether characters are considered wider or narrower than * normal. */ #define TK_SW_NORMAL 0 #define TK_SW_CONDENSE 1 #define TK_SW_EXPAND 2 #define TK_SW_UNKNOWN 3 /* Unknown setwidth. This value may be stored * in the setwidth field. */ /* * The following defines specify the meaning of the fields in a fully * qualified XLFD. */ #define XLFD_FOUNDRY 0 #define XLFD_FAMILY 1 #define XLFD_WEIGHT 2 #define XLFD_SLANT 3 #define XLFD_SETWIDTH 4 #define XLFD_ADD_STYLE 5 #define XLFD_PIXEL_SIZE 6 #define XLFD_POINT_SIZE 7 #define XLFD_RESOLUTION_X 8 #define XLFD_RESOLUTION_Y 9 #define XLFD_SPACING 10 #define XLFD_AVERAGE_WIDTH 11 #define XLFD_CHARSET 12 #define XLFD_NUMFIELDS 13 /* Number of fields in XLFD. */ /* * Low-level API exported by generic code to platform-specific code. */ #define TkInitFontAttributes(fa) memset((fa), 0, sizeof(TkFontAttributes)); #define TkInitXLFDAttributes(xa) memset((xa), 0, sizeof(TkXLFDAttributes)); MODULE_SCOPE int TkFontParseXLFD(CONST char *string, TkFontAttributes *faPtr, TkXLFDAttributes *xaPtr); MODULE_SCOPE char ** TkFontGetAliasList(CONST char *faceName); MODULE_SCOPE char *** TkFontGetFallbacks(void); MODULE_SCOPE int TkFontGetPixels(Tk_Window tkwin, int size); MODULE_SCOPE int TkFontGetPoints(Tk_Window tkwin, int size); MODULE_SCOPE char ** TkFontGetGlobalClass(void); MODULE_SCOPE char ** TkFontGetSymbolClass(void); MODULE_SCOPE int TkCreateNamedFont(Tcl_Interp *interp, Tk_Window tkwin, CONST char *name, TkFontAttributes *faPtr); MODULE_SCOPE int TkDeleteNamedFont(Tcl_Interp *interp, Tk_Window tkwin, CONST char *name); MODULE_SCOPE int TkFontGetFirstTextLayout(Tk_TextLayout layout, Tk_Font *font, char *dst); /* * Low-level API exported by platform-specific code to generic code. */ MODULE_SCOPE void TkpDeleteFont(TkFont *tkFontPtr); MODULE_SCOPE void TkpFontPkgInit(TkMainInfo *mainPtr); MODULE_SCOPE TkFont * TkpGetFontFromAttributes(TkFont *tkFontPtr, Tk_Window tkwin, CONST TkFontAttributes *faPtr); MODULE_SCOPE void TkpGetFontFamilies(Tcl_Interp *interp, Tk_Window tkwin); MODULE_SCOPE TkFont * TkpGetNativeFont(Tk_Window tkwin, CONST char *name); #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT #endif /* _TKFONT */ lablgl-1.05/Togl/src/Togl/togl.c000644 000765 000024 00000357213 12217024174 017371 0ustar00garriguestaff000000 000000 /* $Id: togl.c,v 1.73 2005/10/26 07:40:22 gregcouch Exp $ */ /* vi:set sw=4: */ /* * Togl - a Tk OpenGL widget * * Copyright (C) 1996-2002 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ /* * Currently we support X11, Win32 and Macintosh only */ #include "togl.h" /* Use TCL_STUPID to cast (const char *) to (char *) where the Tcl function * prototype argument should really be const */ #define TCL_STUPID (char *) /* Use WIDGREC to cast widgRec arguments */ #define WIDGREC (char *) /*** Windows headers ***/ #if defined(TOGL_WGL) # define WIN32_LEAN_AND_MEAN # include # undef WIN32_LEAN_AND_MEAN # include /*** X Window System headers ***/ #elif defined(TOGL_X11) # include # include # include /* for XA_RGB_DEFAULT_MAP atom */ # if defined(__vms) # include /* for XmuLookupStandardColormap */ # else # include /* for XmuLookupStandardColormap */ # endif # include /*** Mac headers ***/ #elif defined(TOGL_AGL_CLASSIC) # include # include # include # include #elif defined(TOGL_AGL) # define Cursor QDCursor # include # undef Cursor # define _TKINTXLIBDECLS /* Avoid using tkIntXlibDecls.h */ # include "tkMacOSX.h" # include /* usa MacDrawable */ # include #else /* make sure only one platform defined */ # error Unsupported platform, or confused platform defines... #endif /*** Standard C headers ***/ #include #include #include #ifdef TOGL_WGL # include #endif #if TK_MAJOR_VERSION < 8 # error Sorry Togl requires Tcl/Tk ver 8.0 or higher. #endif #if defined(TOGL_AGL_CLASSIC) # if TK_MAJOR_VERSION < 8 || (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION < 3) # error Sorry Mac classic version requires Tcl/Tk ver 8.3.0 or higher. # endif #endif /* TOGL_AGL_CLASSIC */ #if defined(TOGL_AGL) # if TK_MAJOR_VERSION < 8 || (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION < 4) # error Sorry Mac Aqua version requires Tcl/Tk ver 8.4.0 or higher. # endif #endif /* TOGL_AGL */ /* workaround for bug #123153 in tcl ver8.4a2 (tcl.h) */ #if defined(Tcl_InitHashTable) && defined(USE_TCL_STUBS) # undef Tcl_InitHashTable # define Tcl_InitHashTable (tclStubsPtr->tcl_InitHashTable) #endif #if TK_MAJOR_VERSION > 8 || (TK_MAJOR_VERSION == 8 && TK_MINOR_VERSION >= 4) # define HAVE_TK_SETCLASSPROCS /* pointer to Tk_SetClassProcs function in the stub table */ static void (*SetClassProcsPtr) _ANSI_ARGS_((Tk_Window, Tk_ClassProcs *, ClientData)); #endif /* * Copy of TkClassProcs declarations form tkInt.h * (this is needed for Tcl ver =< 8.4a3) */ typedef Window (TkClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin, Window parent, ClientData instanceData)); typedef void (TkClassGeometryProc) _ANSI_ARGS_((ClientData instanceData)); typedef void (TkClassModalProc) _ANSI_ARGS_((Tk_Window tkwin, XEvent *eventPtr)); typedef struct TkClassProcs { TkClassCreateProc *createProc; TkClassGeometryProc *geometryProc; TkClassModalProc *modalProc; } TkClassProcs; /* Defaults */ #define DEFAULT_WIDTH "400" #define DEFAULT_HEIGHT "400" #define DEFAULT_IDENT "" #define DEFAULT_FONTNAME "fixed" #define DEFAULT_TIME "1" #ifdef TOGL_WGL /* Maximum size of a logical palette corresponding to a colormap in color index * mode. */ # define MAX_CI_COLORMAP_SIZE 4096 # if TOGL_USE_FONTS != 1 /* * copy of TkWinColormap from tkWinInt.h */ typedef struct { HPALETTE palette; /* Palette handle used when drawing. */ UINT size; /* Number of entries in the palette. */ int stale; /* 1 if palette needs to be realized, otherwise * 0. If the palette is stale, then an idle * handler is scheduled to realize the palette. */ Tcl_HashTable refCounts; /* Hash table of palette entry reference counts * indexed by pixel value. */ } TkWinColormap; # else # include "tkWinInt.h" # endif static LRESULT(CALLBACK *tkWinChildProc) (HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) = NULL; # define TK_WIN_CHILD_CLASS_NAME "TkChild" #endif /* TOGL_WGL */ #define MAX(a,b) (((a)>(b))?(a):(b)) #define TCL_ERR(interp, string) \ do { \ Tcl_ResetResult(interp); \ Tcl_AppendResult(interp, string, NULL); \ return TCL_ERROR; \ } while (0) /* The constant DUMMY_WINDOW is used to signal window creation failure from the * Togl_CreateWindow() */ #define DUMMY_WINDOW ((Window) -1) #define ALL_EVENTS_MASK \ (KeyPressMask | \ KeyReleaseMask | \ ButtonPressMask | \ ButtonReleaseMask | \ EnterWindowMask | \ LeaveWindowMask | \ PointerMotionMask | \ ExposureMask | \ VisibilityChangeMask | \ FocusChangeMask | \ PropertyChangeMask | \ ColormapChangeMask) struct Togl { Togl *Next; /* next in linked list */ #if defined(TOGL_WGL) HDC tglGLHdc; /* Device context of device that OpenGL calls * will be drawn on */ HGLRC tglGLHglrc; /* OpenGL rendering context to be made current */ int CiColormapSize; /* (Maximum) size of colormap in color index * mode */ #elif defined(TOGL_X11) GLXContext GlCtx; /* Normal planes GLX context */ #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) AGLContext aglCtx; #endif /* TOGL_WGL */ Display *display; /* X's token for the window's display. */ Tk_Window TkWin; /* Tk window structure */ Tcl_Interp *Interp; /* Tcl interpreter */ Tcl_Command widgetCmd; /* Token for togl's widget command */ #ifndef NO_TK_CURSOR Tk_Cursor Cursor; /* The widget's cursor */ #endif int Width, Height; /* Dimensions of window */ int SetGrid; /* positive is grid size for window manager */ int TimerInterval; /* Time interval for timer in milliseconds */ #if (TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION) >= 705 Tcl_TimerToken timerHandler; /* Token for togl's timer handler */ #else Tk_TimerToken timerHandler; /* Token for togl's timer handler */ #endif Bool RgbaFlag; /* configuration flags (ala GLX parameters) */ int RgbaRed; int RgbaGreen; int RgbaBlue; Bool DoubleFlag; Bool DepthFlag; int DepthSize; Bool AccumFlag; int AccumRed; int AccumGreen; int AccumBlue; int AccumAlpha; Bool AlphaFlag; int AlphaSize; Bool StencilFlag; int StencilSize; Bool PrivateCmapFlag; Bool OverlayFlag; Bool StereoFlag; #ifdef __sgi Bool OldStereoFlag; #endif int AuxNumber; Bool Indirect; int PixelFormat; const char *ShareList; /* name (ident) of Togl to share dlists with */ const char *ShareContext; /* name (ident) to share OpenGL context with */ const char *Ident; /* User's identification string */ ClientData Client_Data; /* Pointer to user data */ Bool UpdatePending; /* Should normal planes be redrawn? */ Togl_Callback *CreateProc; /* Callback when widget is created */ Togl_Callback *DisplayProc; /* Callback when widget is rendered */ Togl_Callback *ReshapeProc; /* Callback when window size changes */ Togl_Callback *DestroyProc; /* Callback when widget is destroyed */ Togl_Callback *TimerProc; /* Callback when widget is idle */ /* Overlay stuff */ #if defined(TOGL_X11) GLXContext OverlayCtx; /* Overlay planes OpenGL context */ #elif defined(TOGL_WGL) HGLRC tglGLOverlayHglrc; #endif /* TOGL_X11 */ Window OverlayWindow; /* The overlay window, or 0 */ Togl_Callback *OverlayDisplayProc; /* Overlay redraw proc */ Bool OverlayUpdatePending; /* Should overlay be redrawn? */ Colormap OverlayCmap; /* colormap for overlay is created */ int OverlayTransparentPixel; /* transparent pixel */ Bool OverlayIsMapped; /* for DumpToEpsFile: Added by Miguel A. de Riera Pasenau 10.01.1997 */ XVisualInfo *VisInfo; /* Visual info of the current */ /* context needed for DumpToEpsFile */ GLfloat *EpsRedMap; /* Index2RGB Maps for Color index modes */ GLfloat *EpsGreenMap; GLfloat *EpsBlueMap; GLint EpsMapSize; /* = Number of indices in our Togl */ }; /* NTNTNT need to change to handle Windows Data Types */ /* * Prototypes for functions local to this file */ static int Togl_Cmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); static void Togl_EventProc(ClientData clientData, XEvent *eventPtr); static Window Togl_CreateWindow(Tk_Window, Window, ClientData); static void Togl_WorldChanged(ClientData); #ifdef MESA_COLOR_HACK static int get_free_color_cells(Display *display, int screen, Colormap colormap); static void free_default_color_cells(Display *display, Colormap colormap); #endif static void ToglCmdDeletedProc(ClientData); #if defined(__sgi) /* SGI-only stereo */ static void oldStereoMakeCurrent(Display *dpy, Window win, GLXContext ctx); static void oldStereoInit(Togl *togl, int stereoEnabled); #endif #if defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) static void SetMacBufRect(Togl *togl); #endif /* * Setup Togl widget configuration options: */ static Tk_ConfigSpec configSpecs[] = { {TK_CONFIG_PIXELS, TCL_STUPID "-height", "height", "Height", DEFAULT_HEIGHT, Tk_Offset(Togl, Height), 0, NULL}, {TK_CONFIG_PIXELS, TCL_STUPID "-width", "width", "Width", DEFAULT_WIDTH, Tk_Offset(Togl, Width), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-setgrid", "setGrid", "SetGrid", "0", Tk_Offset(Togl, SetGrid), 0}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-rgba", "rgba", "Rgba", "true", Tk_Offset(Togl, RgbaFlag), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-redsize", "redsize", "RedSize", "1", Tk_Offset(Togl, RgbaRed), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-greensize", "greensize", "GreenSize", "1", Tk_Offset(Togl, RgbaGreen), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-bluesize", "bluesize", "BlueSize", "1", Tk_Offset(Togl, RgbaBlue), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-double", "double", "Double", "false", Tk_Offset(Togl, DoubleFlag), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-depth", "depth", "Depth", "false", Tk_Offset(Togl, DepthFlag), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-depthsize", "depthsize", "DepthSize", "1", Tk_Offset(Togl, DepthSize), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-accum", "accum", "Accum", "false", Tk_Offset(Togl, AccumFlag), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-accumredsize", "accumredsize", "AccumRedSize", "1", Tk_Offset(Togl, AccumRed), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-accumgreensize", "accumgreensize", "AccumGreenSize", "1", Tk_Offset(Togl, AccumGreen), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-accumbluesize", "accumbluesize", "AccumBlueSize", "1", Tk_Offset(Togl, AccumBlue), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-accumalphasize", "accumalphasize", "AccumAlphaSize", "1", Tk_Offset(Togl, AccumAlpha), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-alpha", "alpha", "Alpha", "false", Tk_Offset(Togl, AlphaFlag), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-alphasize", "alphasize", "AlphaSize", "1", Tk_Offset(Togl, AlphaSize), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-stencil", "stencil", "Stencil", "false", Tk_Offset(Togl, StencilFlag), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-stencilsize", "stencilsize", "StencilSize", "1", Tk_Offset(Togl, StencilSize), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-auxbuffers", "auxbuffers", "AuxBuffers", "0", Tk_Offset(Togl, AuxNumber), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-privatecmap", "privateCmap", "PrivateCmap", "false", Tk_Offset(Togl, PrivateCmapFlag), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-overlay", "overlay", "Overlay", "false", Tk_Offset(Togl, OverlayFlag), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-stereo", "stereo", "Stereo", "false", Tk_Offset(Togl, StereoFlag), 0, NULL}, #ifdef __sgi {TK_CONFIG_BOOLEAN, TCL_STUPID "-oldstereo", "oldstereo", "OldStereo", "false", Tk_Offset(Togl, OldStereoFlag), 0, NULL}, #endif #ifndef NO_TK_CURSOR {TK_CONFIG_ACTIVE_CURSOR, TCL_STUPID "-cursor", "cursor", "Cursor", "", Tk_Offset(Togl, Cursor), TK_CONFIG_NULL_OK}, #endif {TK_CONFIG_INT, TCL_STUPID "-time", "time", "Time", DEFAULT_TIME, Tk_Offset(Togl, TimerInterval), 0, NULL}, {TK_CONFIG_STRING, TCL_STUPID "-sharelist", "sharelist", "ShareList", NULL, Tk_Offset(Togl, ShareList), 0, NULL}, {TK_CONFIG_STRING, TCL_STUPID "-sharecontext", "sharecontext", "ShareContext", NULL, Tk_Offset(Togl, ShareContext), 0, NULL}, {TK_CONFIG_STRING, TCL_STUPID "-ident", "ident", "Ident", DEFAULT_IDENT, Tk_Offset(Togl, Ident), 0, NULL}, {TK_CONFIG_BOOLEAN, TCL_STUPID "-indirect", "indirect", "Indirect", "false", Tk_Offset(Togl, Indirect), 0, NULL}, {TK_CONFIG_INT, TCL_STUPID "-pixelformat", "pixelFormat", "PixelFormat", "0", Tk_Offset(Togl, PixelFormat), 0, NULL}, {TK_CONFIG_END, NULL, NULL, NULL, NULL, 0, 0, NULL} }; /* * Default callback pointers. When a new Togl widget is created it * will be assigned these initial callbacks. */ static Togl_Callback *DefaultCreateProc = NULL; static Togl_Callback *DefaultDisplayProc = NULL; static Togl_Callback *DefaultReshapeProc = NULL; static Togl_Callback *DefaultDestroyProc = NULL; static Togl_Callback *DefaultOverlayDisplayProc = NULL; static Togl_Callback *DefaultTimerProc = NULL; static ClientData DefaultClientData = NULL; static Tcl_HashTable CommandTable; /* * Head of linked list of all Togl widgets */ static Togl *ToglHead = NULL; /* * Add given togl widget to linked list. */ static void AddToList(Togl *t) { t->Next = ToglHead; ToglHead = t; } /* * Remove given togl widget from linked list. */ static void RemoveFromList(Togl *t) { Togl *prev = NULL; Togl *pos = ToglHead; while (pos) { if (pos == t) { if (prev) { prev->Next = pos->Next; } else { ToglHead = pos->Next; } return; } prev = pos; pos = pos->Next; } } /* * Return pointer to togl widget given a user identifier string. */ static Togl * FindTogl(const char *ident) { Togl *t = ToglHead; while (t) { if (strcmp(t->Ident, ident) == 0) return t; t = t->Next; } return NULL; } #if defined(TOGL_X11) /* * Return pointer to another togl widget with same OpenGL context. */ static Togl * FindToglWithSameContext(Togl *togl) { Togl *t; for (t = ToglHead; t != NULL; t = t->Next) { if (t == togl) continue; # if defined(TOGL_WGL) if (t->tglGLHglrc == togl->tglGLHglrc) # elif defined(TOGL_X11) if (t->GlCtx == togl->GlCtx) # elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) if (t->aglCtx == togl->aglCtx) # endif return t; } return NULL; } #endif #ifdef USE_OVERLAY /* * Return pointer to another togl widget with same OpenGL overlay context. */ static Togl * FindToglWithSameOverlayContext(Togl *togl) { Togl *t; for (t = ToglHead; t != NULL; t = t->Next) { if (t == togl) continue; # if defined(TOGL_X11) if (t->OverlayCtx == togl->OverlayCtx) # elif defined(TOGL_WGL) if (t->tglGLOverlayHglrc == togl->tglGLOverlayHglrc) # endif return t; } return NULL; } #endif #if defined(TOGL_X11) /* * Return an X colormap to use for OpenGL RGB-mode rendering. * Input: dpy - the X display * scrnum - the X screen number * visinfo - the XVisualInfo as returned by glXChooseVisual() * Return: an X Colormap or 0 if there's a _serious_ error. */ static Colormap get_rgb_colormap(Display *dpy, int scrnum, const XVisualInfo *visinfo, Tk_Window tkwin) { Atom hp_cr_maps; Status status; int numCmaps; int i; XStandardColormap *standardCmaps; Window root = XRootWindow(dpy, scrnum); Bool using_mesa; /* * First check if visinfo's visual matches the default/root visual. */ if (visinfo->visual == Tk_Visual(tkwin)) { /* use the default/root colormap */ Colormap cmap; cmap = Tk_Colormap(tkwin); # ifdef MESA_COLOR_HACK (void) get_free_color_cells(dpy, scrnum, cmap); # endif return cmap; } /* * Check if we're using Mesa. */ if (strstr(glXQueryServerString(dpy, scrnum, GLX_VERSION), "Mesa")) { using_mesa = True; } else { using_mesa = False; } /* * Next, if we're using Mesa and displaying on an HP with the "Color * Recovery" feature and the visual is 8-bit TrueColor, search for a * special colormap initialized for dithering. Mesa will know how to * dither using this colormap. */ if (using_mesa) { hp_cr_maps = XInternAtom(dpy, "_HP_RGB_SMOOTH_MAP_LIST", True); if (hp_cr_maps # ifdef __cplusplus && visinfo->visual->c_class == TrueColor # else && visinfo->visual->class == TrueColor # endif && visinfo->depth == 8) { status = XGetRGBColormaps(dpy, root, &standardCmaps, &numCmaps, hp_cr_maps); if (status) { for (i = 0; i < numCmaps; i++) { if (standardCmaps[i].visualid == visinfo->visual->visualid) { Colormap cmap = standardCmaps[i].colormap; (void) XFree(standardCmaps); return cmap; } } (void) XFree(standardCmaps); } } } /* * Next, try to find a standard X colormap. */ # if !HP && !SUN # ifndef SOLARIS_BUG status = XmuLookupStandardColormap(dpy, visinfo->screen, visinfo->visualid, visinfo->depth, XA_RGB_DEFAULT_MAP, /* replace */ False, /* retain */ True); if (status == 1) { status = XGetRGBColormaps(dpy, root, &standardCmaps, &numCmaps, XA_RGB_DEFAULT_MAP); if (status == 1) { for (i = 0; i < numCmaps; i++) { if (standardCmaps[i].visualid == visinfo->visualid) { Colormap cmap = standardCmaps[i].colormap; (void) XFree(standardCmaps); return cmap; } } (void) XFree(standardCmaps); } } # endif # endif /* * If we get here, give up and just allocate a new colormap. */ return XCreateColormap(dpy, root, visinfo->visual, AllocNone); } #elif defined(TOGL_WGL) /* Code to create RGB palette is taken from the GENGL sample program of Win32 * SDK */ static unsigned char threeto8[8] = { 0, 0111 >> 1, 0222 >> 1, 0333 >> 1, 0444 >> 1, 0555 >> 1, 0666 >> 1, 0377 }; static unsigned char twoto8[4] = { 0, 0x55, 0xaa, 0xff }; static unsigned char oneto8[2] = { 0, 255 }; static int defaultOverride[13] = { 0, 3, 24, 27, 64, 67, 88, 173, 181, 236, 247, 164, 91 }; static PALETTEENTRY defaultPalEntry[20] = { {0, 0, 0, 0}, {0x80, 0, 0, 0}, {0, 0x80, 0, 0}, {0x80, 0x80, 0, 0}, {0, 0, 0x80, 0}, {0x80, 0, 0x80, 0}, {0, 0x80, 0x80, 0}, {0xC0, 0xC0, 0xC0, 0}, {192, 220, 192, 0}, {166, 202, 240, 0}, {255, 251, 240, 0}, {160, 160, 164, 0}, {0x80, 0x80, 0x80, 0}, {0xFF, 0, 0, 0}, {0, 0xFF, 0, 0}, {0xFF, 0xFF, 0, 0}, {0, 0, 0xFF, 0}, {0xFF, 0, 0xFF, 0}, {0, 0xFF, 0xFF, 0}, {0xFF, 0xFF, 0xFF, 0} }; static unsigned char ComponentFromIndex(int i, UINT nbits, UINT shift) { unsigned char val; val = (unsigned char) (i >> shift); switch (nbits) { case 1: val &= 0x1; return oneto8[val]; case 2: val &= 0x3; return twoto8[val]; case 3: val &= 0x7; return threeto8[val]; default: return 0; } } static Colormap Win32CreateRgbColormap(PIXELFORMATDESCRIPTOR pfd) { TkWinColormap *cmap = (TkWinColormap *) ckalloc(sizeof (TkWinColormap)); LOGPALETTE *pPal; int n, i; n = 1 << pfd.cColorBits; pPal = (PLOGPALETTE) LocalAlloc(LMEM_FIXED, sizeof (LOGPALETTE) + n * sizeof (PALETTEENTRY)); pPal->palVersion = 0x300; pPal->palNumEntries = n; for (i = 0; i < n; i++) { pPal->palPalEntry[i].peRed = ComponentFromIndex(i, pfd.cRedBits, pfd.cRedShift); pPal->palPalEntry[i].peGreen = ComponentFromIndex(i, pfd.cGreenBits, pfd.cGreenShift); pPal->palPalEntry[i].peBlue = ComponentFromIndex(i, pfd.cBlueBits, pfd.cBlueShift); pPal->palPalEntry[i].peFlags = 0; } /* fix up the palette to include the default GDI palette */ if ((pfd.cColorBits == 8) && (pfd.cRedBits == 3) && (pfd.cRedShift == 0) && (pfd.cGreenBits == 3) && (pfd.cGreenShift == 3) && (pfd.cBlueBits == 2) && (pfd.cBlueShift == 6)) { for (i = 1; i <= 12; i++) pPal->palPalEntry[defaultOverride[i]] = defaultPalEntry[i]; } cmap->palette = CreatePalette(pPal); LocalFree(pPal); cmap->size = n; cmap->stale = 0; /* Since this is a private colormap of a fix size, we do not need a valid * hash table, but a dummy one */ Tcl_InitHashTable(&cmap->refCounts, TCL_ONE_WORD_KEYS); return (Colormap) cmap; } static Colormap Win32CreateCiColormap(Togl *togl) { /* Create a colormap with size of togl->CiColormapSize and set all entries * to black */ LOGPALETTE logPalette; TkWinColormap *cmap = (TkWinColormap *) ckalloc(sizeof (TkWinColormap)); logPalette.palVersion = 0x300; logPalette.palNumEntries = 1; logPalette.palPalEntry[0].peRed = 0; logPalette.palPalEntry[0].peGreen = 0; logPalette.palPalEntry[0].peBlue = 0; logPalette.palPalEntry[0].peFlags = 0; cmap->palette = CreatePalette(&logPalette); cmap->size = togl->CiColormapSize; ResizePalette(cmap->palette, cmap->size); /* sets new entries to black */ cmap->stale = 0; /* Since this is a private colormap of a fix size, we do not need a valid * hash table, but a dummy one */ Tcl_InitHashTable(&cmap->refCounts, TCL_ONE_WORD_KEYS); return (Colormap) cmap; } #endif /* TOGL_X11 */ /* * Togl_Init * * Called upon system startup to create Togl command. */ int Togl_Init(Tcl_Interp *interp) { int major, minor, patchLevel, releaseType; #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.1", 0) == NULL) { return TCL_ERROR; } #endif #ifdef USE_TK_STUBS if (Tk_InitStubs(interp, TCL_STUPID "8.1", 0) == NULL) { return TCL_ERROR; } #endif /* Skip all this on Tcl/Tk 8.0 or older. Seems to work */ #if TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION > 800 Tcl_GetVersion(&major, &minor, &patchLevel, &releaseType); # ifdef HAVE_TK_SETCLASSPROCS if (major > 8 || (major == 8 && (minor > 4 || (minor == 4 && (releaseType > 0 || patchLevel >= 2))))) { # ifdef USE_TK_STUBS SetClassProcsPtr = tkStubsPtr->tk_SetClassProcs; # else SetClassProcsPtr = Tk_SetClassProcs; # endif } else { SetClassProcsPtr = NULL; } # else if (major > 8 || (major == 8 && (minor > 4 || (minor == 4 && (releaseType > 0 || patchLevel >= 2))))) { TCL_ERR(interp, "Sorry, this instance of Togl was not compiled to work with Tcl/Tk 8.4a2 or higher."); } # endif #endif if (Tcl_PkgProvide(interp, "Togl", TOGL_VERSION) != TCL_OK) { return TCL_ERROR; } if (Tcl_CreateCommand(interp, "togl", Togl_Cmd, (ClientData) Tk_MainWindow(interp), NULL) == NULL) return TCL_ERROR; Tcl_InitHashTable(&CommandTable, TCL_STRING_KEYS); return TCL_OK; } /* * Register a C function to be called when an Togl widget is realized. */ void Togl_CreateFunc(Togl_Callback *proc) { DefaultCreateProc = proc; } /* * Register a C function to be called when an Togl widget must be redrawn. */ void Togl_DisplayFunc(Togl_Callback *proc) { DefaultDisplayProc = proc; } /* * Register a C function to be called when an Togl widget is resized. */ void Togl_ReshapeFunc(Togl_Callback *proc) { DefaultReshapeProc = proc; } /* * Register a C function to be called when an Togl widget is destroyed. */ void Togl_DestroyFunc(Togl_Callback *proc) { DefaultDestroyProc = proc; } /* * Register a C function to be called from TimerEventHandler. */ void Togl_TimerFunc(Togl_Callback *proc) { DefaultTimerProc = proc; } /* * Reset default callback pointers to NULL. */ void Togl_ResetDefaultCallbacks(void) { DefaultCreateProc = NULL; DefaultDisplayProc = NULL; DefaultReshapeProc = NULL; DefaultDestroyProc = NULL; DefaultOverlayDisplayProc = NULL; DefaultTimerProc = NULL; DefaultClientData = NULL; } /* * Chnage the create callback for a specific Togl widget. */ void Togl_SetCreateFunc(Togl *togl, Togl_Callback *proc) { togl->CreateProc = proc; } /* * Change the display/redraw callback for a specific Togl widget. */ void Togl_SetDisplayFunc(Togl *togl, Togl_Callback *proc) { togl->DisplayProc = proc; } /* * Change the reshape callback for a specific Togl widget. */ void Togl_SetReshapeFunc(Togl *togl, Togl_Callback *proc) { togl->ReshapeProc = proc; } /* * Change the destroy callback for a specific Togl widget. */ void Togl_SetDestroyFunc(Togl *togl, Togl_Callback *proc) { togl->DestroyProc = proc; } /* * Togl_Timer * * Gets called from Tk_CreateTimerHandler. */ static void Togl_Timer(ClientData clientData) { Togl *togl = (Togl *) clientData; if (togl->TimerProc) { togl->TimerProc(togl); /* Re-register this callback since Tcl/Tk timers are "one-shot". That * is, after the timer callback is called it not normally called again. * * * * * * * * * That's not the behavior we want for Togl. */ #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401 togl->timerHandler = Tcl_CreateTimerHandler(togl->TimerInterval, Togl_Timer, (ClientData) togl); #else togl->timerHandler = Tk_CreateTimerHandler(togl->TimeInterval, Togl_Timer, (ClientData) togl); #endif } } /* * Change the timer callback for a specific Togl widget. * Pass NULL to disable the callback. */ void Togl_SetTimerFunc(Togl *togl, Togl_Callback *proc) { togl->TimerProc = proc; if (proc) { #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401 togl->timerHandler = Tcl_CreateTimerHandler(togl->TimerInterval, Togl_Timer, (ClientData) togl); #else togl->timerHandler = Tk_CreateTimerHandler(togl->TimeInterval, Togl_Timer, (ClientData) togl); #endif } } /* * Togl_CreateCommand * * Declares a new C sub-command of Togl callable from Tcl. * Every time the sub-command is called from Tcl, the * C routine will be called with all the arguments from Tcl. */ void Togl_CreateCommand(char *cmd_name, Togl_CmdProc *cmd_proc) { int new_item; Tcl_HashEntry *entry; entry = Tcl_CreateHashEntry(&CommandTable, cmd_name, &new_item); Tcl_SetHashValue(entry, cmd_proc); } /* * Togl_MakeCurrent * * Bind the OpenGL rendering context to the specified * Togl widget. */ void Togl_MakeCurrent(const Togl *togl) { #if defined(TOGL_WGL) int res = wglMakeCurrent(togl->tglGLHdc, togl->tglGLHglrc); assert(res == TRUE); #elif defined(TOGL_X11) if (!togl->GlCtx) return; (void) glXMakeCurrent(togl->display, togl->TkWin ? Tk_WindowId(togl->TkWin) : None, togl->GlCtx); # if defined(__sgi) if (togl->OldStereoFlag) oldStereoMakeCurrent(togl->display, togl->TkWin ? Tk_WindowId(togl->TkWin) : None, togl->GlCtx); # endif /*__sgi STEREO */ #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) if (!togl->aglCtx) return; aglSetCurrentContext(togl->aglCtx); #endif } #ifdef TOGL_AGL_CLASSIC /* tell OpenGL which part of the Mac window to render to */ static void SetMacBufRect(Togl *togl) { GLint wrect[4]; /* set wrect[0,1] to lower left corner of widget */ wrect[2] = ((TkWindow *) (togl->TkWin))->changes.width; wrect[3] = ((TkWindow *) (togl->TkWin))->changes.height; wrect[0] = ((TkWindow *) (togl->TkWin))->privatePtr->xOff; wrect[1] = ((TkWindow *) (togl->TkWin))->privatePtr->toplevel->portPtr-> portRect.bottom - wrect[3] - ((TkWindow *) (togl->TkWin))->privatePtr->yOff; aglSetInteger(togl->aglCtx, AGL_BUFFER_RECT, wrect); aglEnable(togl->aglCtx, AGL_BUFFER_RECT); aglUpdateContext(togl->aglCtx); } #elif defined(TOGL_AGL) /* tell OpenGL which part of the Mac window to render to */ static void SetMacBufRect(Togl *togl) { GLint wrect[4]; /* set wrect[0,1] to lower left corner of widget */ wrect[2] = Tk_Width(togl->TkWin); wrect[3] = Tk_Height(togl->TkWin); wrect[0] = ((TkWindow *) (togl->TkWin))->privatePtr->xOff; Rect r; GetPortBounds(((TkWindow *) (togl->TkWin))->privatePtr->toplevel->grafPtr, &r); wrect[1] = r.bottom - wrect[3] - ((TkWindow *) (togl->TkWin))->privatePtr->yOff; aglSetInteger(togl->aglCtx, AGL_BUFFER_RECT, wrect); aglEnable(togl->aglCtx, AGL_BUFFER_RECT); aglUpdateContext(togl->aglCtx); } #endif /* * Called when the widget's contents must be redrawn. Basically, we * just call the user's render callback function. * * Note that the parameter type is ClientData so this function can be * passed to Tk_DoWhenIdle(). */ static void Togl_Render(ClientData clientData) { Togl *togl = (Togl *) clientData; if (togl->DisplayProc) { #ifdef TOGL_AGL_CLASSIC /* Mac is complicated here because OpenGL needs to know what part of * the parent window to render into, and it seems that region need to * be invalidated before drawing, so that QuickDraw will allow OpenGL * to transfer pixels into that part of the window. I'm not even * totally sure how or why this works as it does, since this aspect of * Mac OpenGL seems to be totally undocumented. This was put together * by trial and error! (thiessen) */ MacRegion r; RgnPtr rp = &r; GrafPtr curPort, parentWin; parentWin = (GrafPtr) (((MacDrawable *) (Tk_WindowId(togl->TkWin)))->toplevel-> portPtr); if (!parentWin) return; #endif Togl_MakeCurrent(togl); #ifdef TOGL_AGL_CLASSIC /* Set QuickDraw port and clipping region */ GetPort(&curPort); SetPort(parentWin); r.rgnBBox.left = ((TkWindow *) (togl->TkWin))->privatePtr->xOff; r.rgnBBox.right = r.rgnBBox.left + ((TkWindow *) (togl->TkWin))->changes.width - 1; r.rgnBBox.top = ((TkWindow *) (togl->TkWin))->privatePtr->yOff; r.rgnBBox.bottom = r.rgnBBox.top + ((TkWindow *) (togl->TkWin))->changes.height - 1; r.rgnSize = sizeof (Region); InvalRgn(&rp); SetClip(&rp); /* this may seem an odd place to put this, with possibly redundant * calls to aglSetInteger(AGL_BUFFER_RECT...), but for some reason * performance is actually a lot better if this is called before every * render... */ SetMacBufRect(togl); #endif #ifdef TOGL_AGL SetMacBufRect(togl); #endif togl->DisplayProc(togl); #ifdef TOGL_AGL_CLASSIC SetPort(curPort); /* restore previous port */ #endif } #if defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) else { /* Always need to update on resize */ SetMacBufRect(togl); } #endif togl->UpdatePending = False; } static void RenderOverlay(ClientData clientData) { Togl *togl = (Togl *) clientData; if (togl->OverlayFlag && togl->OverlayDisplayProc) { #if defined(TOGL_WGL) int res = wglMakeCurrent(togl->tglGLHdc, togl->tglGLHglrc); assert(res == TRUE); #elif defined(TOGL_X11) (void) glXMakeCurrent(Tk_Display(togl->TkWin), togl->OverlayWindow, togl->OverlayCtx); # if defined(__sgi) if (togl->OldStereoFlag) oldStereoMakeCurrent(Tk_Display(togl->TkWin), togl->OverlayWindow, togl->OverlayCtx); # endif /*__sgi STEREO */ #endif /* TOGL_WGL */ togl->OverlayDisplayProc(togl); } togl->OverlayUpdatePending = False; } /* * It's possible to change with this function or in a script some * options like RGBA - ColorIndex ; Z-buffer and so on */ int Togl_Configure(Tcl_Interp *interp, Togl *togl, int argc, const char *argv[], int flags) { Bool oldRgbaFlag = togl->RgbaFlag; int oldRgbaRed = togl->RgbaRed; int oldRgbaGreen = togl->RgbaGreen; int oldRgbaBlue = togl->RgbaBlue; Bool oldDoubleFlag = togl->DoubleFlag; Bool oldDepthFlag = togl->DepthFlag; int oldDepthSize = togl->DepthSize; Bool oldAccumFlag = togl->AccumFlag; int oldAccumRed = togl->AccumRed; int oldAccumGreen = togl->AccumGreen; int oldAccumBlue = togl->AccumBlue; int oldAccumAlpha = togl->AccumAlpha; Bool oldAlphaFlag = togl->AlphaFlag; int oldAlphaSize = togl->AlphaSize; Bool oldStencilFlag = togl->StencilFlag; int oldStencilSize = togl->StencilSize; int oldAuxNumber = togl->AuxNumber; int oldWidth = togl->Width; int oldHeight = togl->Height; int oldSetGrid = togl->SetGrid; if (Tk_ConfigureWidget(interp, togl->TkWin, configSpecs, argc, argv, WIDGREC togl, flags) == TCL_ERROR) { return (TCL_ERROR); } #ifndef USE_OVERLAY if (togl->OverlayFlag) { TCL_ERR(interp, "Sorry, overlay was disabled"); } #endif if (togl->Width != oldWidth || togl->Height != oldHeight || togl->SetGrid != oldSetGrid) { Togl_WorldChanged((ClientData) togl); /* this added per Lou Arata */ Tk_ResizeWindow(togl->TkWin, togl->Width, togl->Height); if (togl->ReshapeProc && #if defined(TOGL_WGL) togl->tglGLHglrc #elif defined(TOGL_X11) togl->GlCtx #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) togl->aglCtx #endif ) { Togl_MakeCurrent(togl); togl->ReshapeProc(togl); } } if (togl->RgbaFlag != oldRgbaFlag || togl->RgbaRed != oldRgbaRed || togl->RgbaGreen != oldRgbaGreen || togl->RgbaBlue != oldRgbaBlue || togl->DoubleFlag != oldDoubleFlag || togl->DepthFlag != oldDepthFlag || togl->DepthSize != oldDepthSize || togl->AccumFlag != oldAccumFlag || togl->AccumRed != oldAccumRed || togl->AccumGreen != oldAccumGreen || togl->AccumBlue != oldAccumBlue || togl->AccumAlpha != oldAccumAlpha || togl->AlphaFlag != oldAlphaFlag || togl->AlphaSize != oldAlphaSize || togl->StencilFlag != oldStencilFlag || togl->StencilSize != oldStencilSize || togl->AuxNumber != oldAuxNumber) { #ifdef MESA_COLOR_HACK free_default_color_cells(Tk_Display(togl->TkWin), Tk_Colormap(togl->TkWin)); #endif } #if defined(__sgi) oldStereoInit(togl, togl->OldStereoFlag); #endif return TCL_OK; } static int Togl_Widget(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[]) { Togl *togl = (Togl *) clientData; int result = TCL_OK; Tcl_HashEntry *entry; Tcl_HashSearch search; Togl_CmdProc *cmd_proc; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?options?\"", NULL); return TCL_ERROR; } Tk_Preserve((ClientData) togl); if (!strncmp(argv[1], "configure", MAX(1, strlen(argv[1])))) { if (argc == 2) { /* Return list of all configuration parameters */ result = Tk_ConfigureInfo(interp, togl->TkWin, configSpecs, WIDGREC togl, (char *) NULL, 0); } else if (argc == 3) { if (strcmp(argv[2], "-extensions") == 0) { /* Return a list of OpenGL extensions available */ const char *extensions; extensions = (const char *) glGetString(GL_EXTENSIONS); Tcl_SetResult(interp, TCL_STUPID extensions, TCL_STATIC); result = TCL_OK; } else { /* Return a specific configuration parameter */ result = Tk_ConfigureInfo(interp, togl->TkWin, configSpecs, WIDGREC togl, argv[2], 0); } } else { /* Execute a configuration change */ result = Togl_Configure(interp, togl, argc - 2, argv + 2, TK_CONFIG_ARGV_ONLY); } } else if (!strncmp(argv[1], "render", MAX(1, strlen(argv[1])))) { /* force the widget to be redrawn */ Togl_Render((ClientData) togl); } else if (!strncmp(argv[1], "swapbuffers", MAX(1, strlen(argv[1])))) { /* force the widget to be redrawn */ Togl_SwapBuffers(togl); } else if (!strncmp(argv[1], "makecurrent", MAX(1, strlen(argv[1])))) { /* force the widget to be redrawn */ Togl_MakeCurrent(togl); } #if TOGL_USE_FONTS == 1 else if (!strncmp(argv[1], "loadbitmapfont", MAX(1, strlen(argv[1])))) { if (argc == 3) { GLuint fontbase; Tcl_Obj *fontbaseAsTclObject; fontbase = Togl_LoadBitmapFont(togl, argv[2]); if (fontbase) { fontbaseAsTclObject = Tcl_NewIntObj(fontbase); Tcl_SetObjResult(interp, fontbaseAsTclObject); result = TCL_OK; } else { Tcl_AppendResult(interp, "Could not allocate font", NULL); result = TCL_ERROR; } } else { Tcl_AppendResult(interp, "wrong # args", NULL); result = TCL_ERROR; } } else if (!strncmp(argv[1], "unloadbitmapfont", MAX(1, strlen(argv[1])))) { if (argc == 3) { Togl_UnloadBitmapFont(togl, atoi(argv[2])); result = TCL_OK; } else { Tcl_AppendResult(interp, "wrong # args", NULL); result = TCL_ERROR; } } #endif /* TOGL_USE_FONTS */ else { /* Probably a user-defined function */ entry = Tcl_FindHashEntry(&CommandTable, argv[1]); if (entry != NULL) { cmd_proc = (Togl_CmdProc *) Tcl_GetHashValue(entry); result = cmd_proc(togl, argc, argv); } else { Tcl_AppendResult(interp, "Togl: Unknown option: ", argv[1], "\n", "Try: configure or render\n", "or one of the user-defined commands:\n", NULL); entry = Tcl_FirstHashEntry(&CommandTable, &search); while (entry) { Tcl_AppendResult(interp, " ", Tcl_GetHashKey(&CommandTable, entry), "\n", NULL); entry = Tcl_NextHashEntry(&search); } result = TCL_ERROR; } } Tk_Release((ClientData) togl); return result; } /* * Togl_Cmd * * Called when Togl is executed - creation of a Togl widget. * * Creates a new window * * Creates an 'Togl' data structure * * Creates an event handler for this window * * Creates a command that handles this object * * Configures this Togl for the given arguments */ static int Togl_Cmd(ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv) { const char *name; Tk_Window mainwin = (Tk_Window) clientData; Tk_Window tkwin; Togl *togl; if (argc <= 1) { TCL_ERR(interp, "wrong # args: should be \"pathName read filename\""); } /* Create the window. */ name = argv[1]; tkwin = Tk_CreateWindowFromPath(interp, mainwin, name, (char *) NULL); if (tkwin == NULL) { return TCL_ERROR; } Tk_SetClass(tkwin, "Togl"); /* Create Togl data structure */ togl = (Togl *) malloc(sizeof (Togl)); if (!togl) { return TCL_ERROR; } togl->Next = NULL; #if defined(TOGL_WGL) togl->tglGLHdc = NULL; togl->tglGLHglrc = NULL; #elif defined(TOGL_X11) togl->GlCtx = NULL; togl->OverlayCtx = NULL; #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) togl->aglCtx = NULL; #endif /* TOGL_WGL */ togl->display = Tk_Display(tkwin); togl->TkWin = tkwin; togl->Interp = interp; #ifndef NO_TK_CURSOR togl->Cursor = None; #endif togl->Width = 0; togl->Height = 0; togl->SetGrid = 0; togl->TimerInterval = 0; togl->RgbaFlag = True; togl->RgbaRed = 1; togl->RgbaGreen = 1; togl->RgbaBlue = 1; togl->DoubleFlag = False; togl->DepthFlag = False; togl->DepthSize = 1; togl->AccumFlag = False; togl->AccumRed = 1; togl->AccumGreen = 1; togl->AccumBlue = 1; togl->AccumAlpha = 1; togl->AlphaFlag = False; togl->AlphaSize = 1; togl->StencilFlag = False; togl->StencilSize = 1; togl->OverlayFlag = False; togl->StereoFlag = False; #ifdef __sgi togl->OldStereoFlag = False; #endif togl->AuxNumber = 0; togl->Indirect = False; togl->PixelFormat = 0; togl->UpdatePending = False; togl->OverlayUpdatePending = False; togl->CreateProc = DefaultCreateProc; togl->DisplayProc = DefaultDisplayProc; togl->ReshapeProc = DefaultReshapeProc; togl->DestroyProc = DefaultDestroyProc; togl->TimerProc = DefaultTimerProc; togl->OverlayDisplayProc = DefaultOverlayDisplayProc; togl->ShareList = NULL; togl->ShareContext = NULL; togl->Ident = NULL; togl->Client_Data = DefaultClientData; /* for EPS Output */ togl->EpsRedMap = togl->EpsGreenMap = togl->EpsBlueMap = NULL; togl->EpsMapSize = 0; /* Create command event handler */ togl->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(tkwin), Togl_Widget, (ClientData) togl, (Tcl_CmdDeleteProc *) ToglCmdDeletedProc); /* * Setup the Tk_ClassProcs callbacks to point at our own window creation * function * * We need to check at runtime if we should use the new Tk_SetClassProcs() * API or if we need to modify the window structure directly */ #ifdef HAVE_TK_SETCLASSPROCS if (SetClassProcsPtr != NULL) { /* use public API (Tk 8.4+) */ Tk_ClassProcs *procsPtr; procsPtr = (Tk_ClassProcs *) Tcl_Alloc(sizeof (Tk_ClassProcs)); procsPtr->size = sizeof (Tk_ClassProcs); procsPtr->createProc = Togl_CreateWindow; procsPtr->worldChangedProc = Togl_WorldChanged; procsPtr->modalProc = NULL; /* Tk_SetClassProcs(togl->TkWin,procsPtr,(ClientData)togl); */ (SetClassProcsPtr) (togl->TkWin, procsPtr, (ClientData) togl); } else #endif { /* use private API */ /* * We need to set these fields in the Tk_FakeWin structure: dummy17 = * classProcsPtr dummy18 = instanceData */ TkClassProcs *procsPtr; Tk_FakeWin *winPtr = (Tk_FakeWin *) (togl->TkWin); procsPtr = (TkClassProcs *) Tcl_Alloc(sizeof (TkClassProcs)); procsPtr->createProc = Togl_CreateWindow; procsPtr->geometryProc = Togl_WorldChanged; procsPtr->modalProc = NULL; winPtr->dummy17 = (char *) procsPtr; winPtr->dummy18 = (ClientData) togl; } Tk_CreateEventHandler(tkwin, ExposureMask | StructureNotifyMask, Togl_EventProc, (ClientData) togl); /* Configure Togl widget */ if (Togl_Configure(interp, togl, argc - 2, argv + 2, 0) == TCL_ERROR) { Tk_DestroyWindow(tkwin); Tcl_AppendResult(interp, "Couldn't configure togl widget\n", NULL); goto error; } /* * If OpenGL window wasn't already created by Togl_Configure() we * create it now. We can tell by checking if the GLX context has * been initialized. */ if (! #if defined(TOGL_WGL) togl->tglGLHdc #elif defined(TOGL_X11) togl->GlCtx #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) togl->aglCtx #endif ) { Tk_MakeWindowExist(togl->TkWin); if (Tk_WindowId(togl->TkWin) == DUMMY_WINDOW) { return TCL_ERROR; } Togl_MakeCurrent(togl); } /* If defined, call create callback */ if (togl->CreateProc) { togl->CreateProc(togl); } /* If defined, call reshape proc */ if (togl->ReshapeProc) { togl->ReshapeProc(togl); } /* If defined, setup timer */ if (togl->TimerProc) { (void) Tk_CreateTimerHandler(togl->TimerInterval, Togl_Timer, (ClientData) togl); } Tcl_AppendResult(interp, Tk_PathName(tkwin), NULL); /* Add to linked list */ AddToList(togl); return TCL_OK; error: (void) Tcl_DeleteCommand(interp, "togl"); /* free(togl); Don't free it, if we do a crash occurs later... */ return TCL_ERROR; } #ifdef USE_OVERLAY /* * Do all the setup for overlay planes * Return: TCL_OK or TCL_ERROR */ static int SetupOverlay(Togl *togl) { # if defined(TOGL_X11) # ifdef GLX_TRANSPARENT_TYPE_EXT static int ovAttributeList[] = { GLX_BUFFER_SIZE, 2, GLX_LEVEL, 1, GLX_TRANSPARENT_TYPE_EXT, GLX_TRANSPARENT_INDEX_EXT, None }; # else static int ovAttributeList[] = { GLX_BUFFER_SIZE, 2, GLX_LEVEL, 1, None }; # endif Display *dpy; XVisualInfo *visinfo; TkWindow *winPtr = (TkWindow *) togl->TkWin; XSetWindowAttributes swa; Tcl_HashEntry *hPtr; int new_flag; dpy = Tk_Display(togl->TkWin); visinfo = glXChooseVisual(dpy, Tk_ScreenNumber(winPtr), ovAttributeList); if (!visinfo) { Tcl_AppendResult(togl->Interp, Tk_PathName(winPtr), ": No suitable overlay index visual available", (char *) NULL); togl->OverlayCtx = 0; togl->OverlayWindow = 0; togl->OverlayCmap = 0; return TCL_ERROR; } # ifdef GLX_TRANSPARENT_INDEX_EXT { int fail = glXGetConfig(dpy, visinfo, GLX_TRANSPARENT_INDEX_VALUE_EXT, &togl->OverlayTransparentPixel); if (fail) togl->OverlayTransparentPixel = 0; /* maybe, maybe ... */ } # else togl->OverlayTransparentPixel = 0; /* maybe, maybe ... */ # endif /* share display lists with normal layer context */ togl->OverlayCtx = glXCreateContext(dpy, visinfo, togl->GlCtx, !togl->Indirect); swa.colormap = XCreateColormap(dpy, XRootWindow(dpy, visinfo->screen), visinfo->visual, AllocNone); togl->OverlayCmap = swa.colormap; swa.border_pixel = 0; swa.event_mask = ALL_EVENTS_MASK; togl->OverlayWindow = XCreateWindow(dpy, Tk_WindowId(togl->TkWin), 0, 0, togl->Width, togl->Height, 0, visinfo->depth, InputOutput, visinfo->visual, CWBorderPixel | CWColormap | CWEventMask, &swa); hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable, (char *) togl->OverlayWindow, &new_flag); Tcl_SetHashValue(hPtr, winPtr); /* XMapWindow( dpy, togl->OverlayWindow ); */ togl->OverlayIsMapped = False; /* Make sure window manager installs our colormap */ XSetWMColormapWindows(dpy, togl->OverlayWindow, &togl->OverlayWindow, 1); return TCL_OK; # elif defined(TOGL_WGL) || defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) /* not yet implemented on these */ return TCL_ERROR; # endif } #endif /* USE_OVERLAY */ #ifdef TOGL_WGL # define TOGL_CLASS_NAME "Togl Class" static Bool ToglClassInitialized = False; static LRESULT CALLBACK Win32WinProc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam) { LONG result; Togl *togl = (Togl *) GetWindowLong(hwnd, 0); WNDCLASS childClass; switch (message) { case WM_WINDOWPOSCHANGED: /* Should be processed by DefWindowProc, otherwise a double buffered * context is not properly resized when the corresponding window is * resized. */ break; case WM_DESTROY: if (togl->tglGLHglrc) { wglDeleteContext(togl->tglGLHglrc); } if (togl->tglGLHdc) { ReleaseDC(hwnd, togl->tglGLHdc); } free(togl); break; default: # if USE_STATIC_LIB return TkWinChildProc(hwnd, message, wParam, lParam); # else /* * OK, since TkWinChildProc is not explicitly exported in the * dynamic libraries, we have to retrieve it from the class info * registered with windows. * */ if (tkWinChildProc == NULL) { GetClassInfo(Tk_GetHINSTANCE(), TK_WIN_CHILD_CLASS_NAME, &childClass); tkWinChildProc = childClass.lpfnWndProc; } return tkWinChildProc(hwnd, message, wParam, lParam); # endif } result = DefWindowProc(hwnd, message, wParam, lParam); Tcl_ServiceAll(); return result; } #endif /* TOGL_WGL */ /* * Togl_CreateWindow * * Window creation function, invoked as a callback from Tk_MakeWindowExist. * Creates an OpenGL window for the Togl widget. */ static Window Togl_CreateWindow(Tk_Window tkwin, Window parent, ClientData instanceData) { Togl *togl = (Togl *) instanceData; XVisualInfo *visinfo = NULL; Display *dpy; Colormap cmap; int scrnum; Window window; #if defined(TOGL_X11) Bool directCtx = True; int attrib_list[1000]; int attrib_count; int dummy; XSetWindowAttributes swa; # define MAX_ATTEMPTS 12 static int ci_depths[MAX_ATTEMPTS] = { 8, 4, 2, 1, 12, 16, 8, 4, 2, 1, 12, 16 }; static int dbl_flags[MAX_ATTEMPTS] = { 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1 }; #elif defined(TOGL_WGL) HWND hwnd, parentWin; int pixelformat; HANDLE hInstance; WNDCLASS ToglClass; PIXELFORMATDESCRIPTOR pfd; XVisualInfo VisInf; #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) GLint attribs[20]; int na; AGLPixelFormat fmt; XVisualInfo VisInf; #endif /* TOGL_X11 */ dpy = Tk_Display(togl->TkWin); #if defined(TOGL_X11) /* Make sure OpenGL's GLX extension supported */ if (!glXQueryExtension(dpy, &dummy, &dummy)) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: X server has no OpenGL GLX extension", TCL_STATIC); return DUMMY_WINDOW; } if (togl->ShareContext && FindTogl(togl->ShareContext)) { /* share OpenGL context with existing Togl widget */ Togl *shareWith = FindTogl(togl->ShareContext); assert(shareWith != NULL); assert(shareWith->GlCtx != NULL); togl->GlCtx = shareWith->GlCtx; togl->VisInfo = shareWith->VisInfo; visinfo = togl->VisInfo; } else { if (togl->PixelFormat) { XVisualInfo template; int count = 1; template.visualid = togl->PixelFormat; visinfo = XGetVisualInfo(dpy, VisualIDMask, &template, &count); if (visinfo == NULL) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't choose pixel format", TCL_STATIC); return DUMMY_WINDOW; } /* fill in flags normally passed in that affect behavior */ (void) glXGetConfig(dpy, visinfo, GLX_RGBA, &togl->RgbaFlag); (void) glXGetConfig(dpy, visinfo, GLX_DOUBLEBUFFER, &togl->DoubleFlag); (void) glXGetConfig(dpy, visinfo, GLX_STEREO, &togl->StereoFlag); } else { int attempt; /* It may take a few tries to get a visual */ for (attempt = 0; attempt < MAX_ATTEMPTS; attempt++) { attrib_count = 0; attrib_list[attrib_count++] = GLX_USE_GL; if (togl->RgbaFlag) { /* RGB[A] mode */ attrib_list[attrib_count++] = GLX_RGBA; attrib_list[attrib_count++] = GLX_RED_SIZE; attrib_list[attrib_count++] = togl->RgbaRed; attrib_list[attrib_count++] = GLX_GREEN_SIZE; attrib_list[attrib_count++] = togl->RgbaGreen; attrib_list[attrib_count++] = GLX_BLUE_SIZE; attrib_list[attrib_count++] = togl->RgbaBlue; if (togl->AlphaFlag) { attrib_list[attrib_count++] = GLX_ALPHA_SIZE; attrib_list[attrib_count++] = togl->AlphaSize; } /* for EPS Output */ if (togl->EpsRedMap) free(togl->EpsRedMap); if (togl->EpsGreenMap) free(togl->EpsGreenMap); if (togl->EpsBlueMap) free(togl->EpsBlueMap); togl->EpsRedMap = togl->EpsGreenMap = togl->EpsBlueMap = NULL; togl->EpsMapSize = 0; } else { /* Color index mode */ int depth; attrib_list[attrib_count++] = GLX_BUFFER_SIZE; depth = ci_depths[attempt]; attrib_list[attrib_count++] = depth; } if (togl->DepthFlag) { attrib_list[attrib_count++] = GLX_DEPTH_SIZE; attrib_list[attrib_count++] = togl->DepthSize; } if (togl->DoubleFlag || dbl_flags[attempt]) { attrib_list[attrib_count++] = GLX_DOUBLEBUFFER; } if (togl->StencilFlag) { attrib_list[attrib_count++] = GLX_STENCIL_SIZE; attrib_list[attrib_count++] = togl->StencilSize; } if (togl->AccumFlag) { attrib_list[attrib_count++] = GLX_ACCUM_RED_SIZE; attrib_list[attrib_count++] = togl->AccumRed; attrib_list[attrib_count++] = GLX_ACCUM_GREEN_SIZE; attrib_list[attrib_count++] = togl->AccumGreen; attrib_list[attrib_count++] = GLX_ACCUM_BLUE_SIZE; attrib_list[attrib_count++] = togl->AccumBlue; if (togl->AlphaFlag) { attrib_list[attrib_count++] = GLX_ACCUM_ALPHA_SIZE; attrib_list[attrib_count++] = togl->AccumAlpha; } } if (togl->AuxNumber != 0) { attrib_list[attrib_count++] = GLX_AUX_BUFFERS; attrib_list[attrib_count++] = togl->AuxNumber; } if (togl->Indirect) { directCtx = False; } if (togl->StereoFlag) { attrib_list[attrib_count++] = GLX_STEREO; } attrib_list[attrib_count++] = None; visinfo = glXChooseVisual(dpy, Tk_ScreenNumber(togl->TkWin), attrib_list); if (visinfo) { /* found a GLX visual! */ break; } } togl->VisInfo = visinfo; if (visinfo == NULL) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't get visual", TCL_STATIC); return DUMMY_WINDOW; } /* * Create a new OpenGL rendering context. */ if (togl->ShareList) { /* share display lists with existing togl widget */ Togl *shareWith = FindTogl(togl->ShareList); GLXContext shareCtx; if (shareWith) shareCtx = shareWith->GlCtx; else shareCtx = None; togl->GlCtx = glXCreateContext(dpy, visinfo, shareCtx, directCtx); } else { /* don't share display lists */ togl->GlCtx = glXCreateContext(dpy, visinfo, None, directCtx); } if (togl->GlCtx == NULL) { Tcl_SetResult(togl->Interp, TCL_STUPID "could not create rendering context", TCL_STATIC); return DUMMY_WINDOW; } } } #endif /* TOGL_X11 */ #ifdef TOGL_WGL parentWin = Tk_GetHWND(parent); hInstance = Tk_GetHINSTANCE(); if (!ToglClassInitialized) { ToglClassInitialized = True; ToglClass.style = CS_HREDRAW | CS_VREDRAW; ToglClass.cbClsExtra = 0; ToglClass.cbWndExtra = 4; /* to save struct Togl* */ ToglClass.hInstance = hInstance; ToglClass.hbrBackground = NULL; ToglClass.lpszMenuName = NULL; ToglClass.lpszClassName = TOGL_CLASS_NAME; ToglClass.lpfnWndProc = Win32WinProc; ToglClass.hIcon = NULL; ToglClass.hCursor = NULL; if (!RegisterClass(&ToglClass)) { Tcl_SetResult(togl->Interp, TCL_STUPID "unable register Togl window class", TCL_STATIC); return DUMMY_WINDOW; } } hwnd = CreateWindow(TOGL_CLASS_NAME, NULL, WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS, 0, 0, togl->Width, togl->Height, parentWin, NULL, hInstance, NULL); SetWindowLong(hwnd, 0, (LONG) togl); SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE); togl->tglGLHdc = GetDC(hwnd); pfd.nSize = sizeof (PIXELFORMATDESCRIPTOR); pfd.nVersion = 1; pfd.dwFlags = PFD_DRAW_TO_WINDOW | PFD_SUPPORT_OPENGL; if (togl->DoubleFlag) { pfd.dwFlags |= PFD_DOUBLEBUFFER; } /* The stereo flag is not supported in the current generic OpenGL * implementation, but may be supported by specific hardware devices. */ if (togl->StereoFlag) { pfd.dwFlags |= PFD_STEREO; } if (togl->PixelFormat) { pixelformat = togl->PixelFormat; } else { pfd.cColorBits = togl->RgbaRed + togl->RgbaGreen + togl->RgbaBlue; pfd.iPixelType = togl->RgbaFlag ? PFD_TYPE_RGBA : PFD_TYPE_COLORINDEX; /* Alpha bitplanes are not supported in the current generic OpenGL * implementation, but may be supported by specific hardware devices. */ pfd.cAlphaBits = togl->AlphaFlag ? togl->AlphaSize : 0; pfd.cAccumBits = togl->AccumFlag ? (togl->AccumRed + togl->AccumGreen + togl->AccumBlue + togl->AccumAlpha) : 0; pfd.cDepthBits = togl->DepthFlag ? togl->DepthSize : 0; pfd.cStencilBits = togl->StencilFlag ? togl->StencilSize : 0; /* Auxiliary buffers are not supported in the current generic OpenGL * implementation, but may be supported by specific hardware devices. */ pfd.cAuxBuffers = togl->AuxNumber; pfd.iLayerType = PFD_MAIN_PLANE; if ((pixelformat = ChoosePixelFormat(togl->tglGLHdc, &pfd)) == 0) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't choose pixel format", TCL_STATIC); return DUMMY_WINDOW; } } if (SetPixelFormat(togl->tglGLHdc, pixelformat, &pfd) == FALSE) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't choose pixel format", TCL_STATIC); return DUMMY_WINDOW; } /* Get the actual pixel format */ DescribePixelFormat(togl->tglGLHdc, pixelformat, sizeof (pfd), &pfd); if (togl->PixelFormat) { /* fill in flags normally passed in that affect behavior */ togl->RgbaFlag = pfd.iPixelType == PFD_TYPE_RGBA; togl->DoubleFlag = pfd.cDepthBits > 0; togl->StereoFlag = (pfd.dwFlags & PFD_STEREO) != 0; // TODO: set depth flag, and more } else if (togl->StereoFlag && (pfd.dwFlags & PFD_STEREO) == 0) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't choose stereo pixel format", TCL_STATIC); return DUMMY_WINDOW; } if (togl->ShareContext && FindTogl(togl->ShareContext)) { /* share OpenGL context with existing Togl widget */ Togl *shareWith = FindTogl(togl->ShareContext); assert(shareWith); assert(shareWith->tglGLHglrc); togl->tglGLHglrc = shareWith->tglGLHglrc; togl->VisInfo = shareWith->VisInfo; visinfo = togl->VisInfo; } else { /* * Create a new OpenGL rendering context. And check to share lists. */ togl->tglGLHglrc = wglCreateContext(togl->tglGLHdc); if (togl->ShareList) { /* share display lists with existing togl widget */ Togl *shareWith = FindTogl(togl->ShareList); if (shareWith) wglShareLists(shareWith->tglGLHglrc, togl->tglGLHglrc); } if (!togl->tglGLHglrc) { Tcl_SetResult(togl->Interp, TCL_STUPID "could not create rendering context", TCL_STATIC); return DUMMY_WINDOW; } /* Just for portability, define the simplest visinfo */ visinfo = &VisInf; visinfo->visual = DefaultVisual(dpy, DefaultScreen(dpy)); visinfo->depth = visinfo->visual->bits_per_rgb; togl->VisInfo = visinfo; } #endif /* TOGL_WGL */ /* * find a colormap */ scrnum = Tk_ScreenNumber(togl->TkWin); if (togl->RgbaFlag) { /* Colormap for RGB mode */ #if defined(TOGL_X11) cmap = get_rgb_colormap(dpy, scrnum, visinfo, togl->TkWin); #elif defined(TOGL_WGL) if (pfd.dwFlags & PFD_NEED_PALETTE) { cmap = Win32CreateRgbColormap(pfd); } else { cmap = DefaultColormap(dpy, scrnum); } /* for EPS Output */ if (togl->EpsRedMap) free(togl->EpsRedMap); if (togl->EpsGreenMap) free(togl->EpsGreenMap); if (togl->EpsBlueMap) free(togl->EpsBlueMap); togl->EpsRedMap = togl->EpsGreenMap = togl->EpsBlueMap = NULL; togl->EpsMapSize = 0; #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) cmap = DefaultColormap(dpy, scrnum); /* for EPS Output */ if (togl->EpsRedMap) free(togl->EpsRedMap); if (togl->EpsGreenMap) free(togl->EpsGreenMap); if (togl->EpsBlueMap) free(togl->EpsBlueMap); togl->EpsRedMap = togl->EpsGreenMap = togl->EpsBlueMap = NULL; togl->EpsMapSize = 0; #endif /* TOGL_X11 */ } else { /* Colormap for CI mode */ #ifdef TOGL_WGL togl->CiColormapSize = 1 << pfd.cColorBits; togl->CiColormapSize = togl->CiColormapSize < MAX_CI_COLORMAP_SIZE ? togl->CiColormapSize : MAX_CI_COLORMAP_SIZE; #endif /* TOGL_WGL */ if (togl->PrivateCmapFlag) { /* need read/write colormap so user can store own color entries */ #if defined(TOGL_X11) cmap = XCreateColormap(dpy, XRootWindow(dpy, visinfo->screen), visinfo->visual, AllocAll); #elif defined(TOGL_WGL) cmap = Win32CreateCiColormap(togl); #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) /* need to figure out how to do this correctly on Mac... */ cmap = DefaultColormap(dpy, scrnum); #endif /* TOGL_X11 */ } else { if (visinfo->visual == DefaultVisual(dpy, scrnum)) { /* share default/root colormap */ cmap = Tk_Colormap(togl->TkWin); } else { /* make a new read-only colormap */ cmap = XCreateColormap(dpy, XRootWindow(dpy, visinfo->screen), visinfo->visual, AllocNone); } } } #if !defined(TOGL_AGL) /* Make sure Tk knows to switch to the new colormap when the cursor is over * this window when running in color index mode. */ (void) Tk_SetWindowVisual(togl->TkWin, visinfo->visual, visinfo->depth, cmap); #endif #ifdef TOGL_WGL /* Install the colormap */ SelectPalette(togl->tglGLHdc, ((TkWinColormap *) cmap)->palette, TRUE); RealizePalette(togl->tglGLHdc); #endif /* TOGL_WGL */ #if defined(TOGL_X11) swa.colormap = cmap; swa.border_pixel = 0; swa.event_mask = ALL_EVENTS_MASK; window = XCreateWindow(dpy, parent, 0, 0, togl->Width, togl->Height, 0, visinfo->depth, InputOutput, visinfo->visual, CWBorderPixel | CWColormap | CWEventMask, &swa); /* Make sure window manager installs our colormap */ (void) XSetWMColormapWindows(dpy, window, &window, 1); #elif defined(TOGL_WGL) window = Tk_AttachHWND(togl->TkWin, hwnd); #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) { TkWindow *winPtr = (TkWindow *) togl->TkWin; window = TkpMakeWindow(winPtr, parent); } #endif /* TOGL_X11 */ #ifdef USE_OVERLAY if (togl->OverlayFlag) { if (SetupOverlay(togl) == TCL_ERROR) { fprintf(stderr, "Warning: couldn't setup overlay.\n"); togl->OverlayFlag = False; } } #endif /* USE_OVERLAY */ /* Request the X window to be displayed */ (void) XMapWindow(dpy, window); #if defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) if (togl->ShareContext && FindTogl(togl->ShareContext)) { /* share OpenGL context with existing Togl widget */ Togl *shareWith = FindTogl(togl->ShareContext); assert(shareWith); assert(shareWith->aglCtx); togl->aglCtx = shareWith->aglCtx; togl->VisInfo = shareWith->VisInfo; visinfo = togl->VisInfo; } else { AGLContext shareCtx = NULL; if (togl->PixelFormat) { /* fill in RgbaFlag, DoubleFlag, and StereoFlag */ fmt = (AGLPixelFormat) togl->PixelFormat; GLint has_rgba, has_doublebuf, has_stereo; if (aglDescribePixelFormat(fmt, AGL_RGBA, &has_rgba) && aglDescribePixelFormat(fmt, AGL_DOUBLEBUFFER, &has_doublebuf) && aglDescribePixelFormat(fmt, AGL_STEREO, &has_stereo)) { togl->RgbaFlag = (has_rgba ? True : False); togl->DoubleFlag = (has_doublebuf ? True : False); togl->StereoFlag = (has_stereo ? True : False); } else { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: failed querying pixel format attributes", TCL_STATIC); return DUMMY_WINDOW; } } else { /* Need to do this after mapping window, so MacDrawable structure * is more completely filled in */ na = 0; attribs[na++] = AGL_MINIMUM_POLICY; attribs[na++] = AGL_ROBUST; if (togl->RgbaFlag) { /* RGB[A] mode */ attribs[na++] = AGL_RGBA; attribs[na++] = AGL_RED_SIZE; attribs[na++] = togl->RgbaRed; attribs[na++] = AGL_GREEN_SIZE; attribs[na++] = togl->RgbaGreen; attribs[na++] = AGL_BLUE_SIZE; attribs[na++] = togl->RgbaBlue; if (togl->AlphaFlag) { attribs[na++] = AGL_ALPHA_SIZE; attribs[na++] = togl->AlphaSize; } } else { /* Color index mode */ attribs[na++] = AGL_BUFFER_SIZE; attribs[na++] = 8; } if (togl->DepthFlag) { attribs[na++] = AGL_DEPTH_SIZE; attribs[na++] = togl->DepthSize; } if (togl->DoubleFlag) { attribs[na++] = AGL_DOUBLEBUFFER; } if (togl->StencilFlag) { attribs[na++] = AGL_STENCIL_SIZE; attribs[na++] = togl->StencilSize; } if (togl->AccumFlag) { attribs[na++] = AGL_ACCUM_RED_SIZE; attribs[na++] = togl->AccumRed; attribs[na++] = AGL_ACCUM_GREEN_SIZE; attribs[na++] = togl->AccumGreen; attribs[na++] = AGL_ACCUM_BLUE_SIZE; attribs[na++] = togl->AccumBlue; if (togl->AlphaFlag) { attribs[na++] = AGL_ACCUM_ALPHA_SIZE; attribs[na++] = togl->AccumAlpha; } } if (togl->AuxNumber != 0) { attribs[na++] = AGL_AUX_BUFFERS; attribs[na++] = togl->AuxNumber; } attribs[na++] = AGL_NONE; if ((fmt = aglChoosePixelFormat(NULL, 0, attribs)) == NULL) { Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't choose pixel format", TCL_STATIC); return DUMMY_WINDOW; } } /* * Check whether to share lists. */ if (togl->ShareList) { /* share display lists with existing togl widget */ Togl *shareWith = FindTogl(togl->ShareList); if (shareWith) shareCtx = shareWith->aglCtx; } if ((togl->aglCtx = aglCreateContext(fmt, shareCtx)) == NULL) { GLenum err = aglGetError(); aglDestroyPixelFormat(fmt); if (err == AGL_BAD_MATCH) Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't create context, shared context doesn't match", TCL_STATIC); else if (err == AGL_BAD_CONTEXT) Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't create context, bad shared context", TCL_STATIC); else if (err == AGL_BAD_PIXELFMT) Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't create context, bad pixel format", TCL_STATIC); else Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't create context, unknown reason", TCL_STATIC); return DUMMY_WINDOW; } aglDestroyPixelFormat(fmt); if (!aglSetDrawable(togl->aglCtx, # if defined(TOGL_AGL) ((MacDrawable *) (window))->toplevel->grafPtr # else ((MacDrawable *) (window))->toplevel->portPtr # endif )) { aglDestroyContext(togl->aglCtx); Tcl_SetResult(togl->Interp, TCL_STUPID "Togl: couldn't set drawable", TCL_STATIC); return DUMMY_WINDOW; } /* Just for portability, define the simplest visinfo */ visinfo = &VisInf; visinfo->visual = DefaultVisual(dpy, DefaultScreen(dpy)); visinfo->depth = visinfo->visual->bits_per_rgb; Tk_SetWindowVisual(togl->TkWin, visinfo->visual, visinfo->depth, cmap); } #endif /* TOGL_AGL_CLASSIC || TOGL_AGL */ #if defined(TOGL_X11) /* Check for a single/double buffering snafu */ { int dbl_flag; if (glXGetConfig(dpy, visinfo, GLX_DOUBLEBUFFER, &dbl_flag)) { if (!togl->DoubleFlag && dbl_flag) { /* We requested single buffering but had to accept a */ /* double buffered visual. Set the GL draw buffer to */ /* be the front buffer to simulate single buffering. */ glDrawBuffer(GL_FRONT); } } } #endif /* TOGL_X11 */ /* for EPS Output */ if (!togl->RgbaFlag) { int index_size; #if defined(TOGL_X11) || defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) GLint index_bits; glGetIntegerv(GL_INDEX_BITS, &index_bits); index_size = 1 << index_bits; #elif defined(TOGL_WGL) index_size = togl->CiColormapSize; #endif /* TOGL_X11 */ if (togl->EpsMapSize != index_size) { if (togl->EpsRedMap) free(togl->EpsRedMap); if (togl->EpsGreenMap) free(togl->EpsGreenMap); if (togl->EpsBlueMap) free(togl->EpsBlueMap); togl->EpsMapSize = index_size; togl->EpsRedMap = (GLfloat *) calloc(index_size, sizeof (GLfloat)); togl->EpsGreenMap = (GLfloat *) calloc(index_size, sizeof (GLfloat)); togl->EpsBlueMap = (GLfloat *) calloc(index_size, sizeof (GLfloat)); } } return window; } /* * Togl_WorldChanged * * Add support for setgrid option. */ static void Togl_WorldChanged(ClientData instanceData) { Togl *togl = (Togl *) instanceData; Tk_GeometryRequest(togl->TkWin, togl->Width, togl->Height); Tk_SetInternalBorder(togl->TkWin, 0); if (togl->SetGrid > 0) { Tk_SetGrid(togl->TkWin, togl->Width / togl->SetGrid, togl->Height / togl->SetGrid, togl->SetGrid, togl->SetGrid); } else { Tk_UnsetGrid(togl->TkWin); } } /* * ToglCmdDeletedProc * * This procedure is invoked when a widget command is deleted. If * the widget isn't already in the process of being destroyed, * this command destroys it. * * Results: * None. * * Side effects: * The widget is destroyed. * *---------------------------------------------------------------------- */ static void ToglCmdDeletedProc(ClientData clientData) { Togl *togl = (Togl *) clientData; Tk_Window tkwin = togl->TkWin; /* * This procedure could be invoked either because the window was * destroyed and the command was then deleted (in which case tkwin * is NULL) or because the command was deleted, and then this procedure * destroys the widget. */ if (togl && tkwin) { Tk_DeleteEventHandler(tkwin, ExposureMask | StructureNotifyMask, Togl_EventProc, (ClientData) togl); } #if defined(TOGL_X11) if (togl->GlCtx) { if (FindToglWithSameContext(togl) == NULL) glXDestroyContext(togl->display, togl->GlCtx); togl->GlCtx = NULL; } # ifdef USE_OVERLAY if (togl->OverlayCtx) { Tcl_HashEntry *entryPtr; TkWindow *winPtr = (TkWindow *) togl->TkWin; if (winPtr) { entryPtr = Tcl_FindHashEntry(&winPtr->dispPtr->winTable, (char *) togl->OverlayWindow); Tcl_DeleteHashEntry(entryPtr); } if (FindToglWithSameOverlayContext(togl) == NULL) glXDestroyContext(togl->display, togl->OverlayCtx); togl->OverlayCtx = NULL; } # endif /* USE_OVERLAY */ #endif /* TODO: delete contexts on other platforms */ if (tkwin != NULL) { if (togl->SetGrid > 0) { Tk_UnsetGrid(tkwin); } togl->TkWin = NULL; Tk_DestroyWindow(tkwin); } } /* * Togl_Destroy * * Gets called when an Togl widget is destroyed. */ static void Togl_Destroy( #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401 char * #else ClientData #endif clientData) { Togl *togl = (Togl *) clientData; Tk_FreeOptions(configSpecs, WIDGREC togl, togl->display, 0); #ifndef NO_TK_CURSOR if (togl->Cursor != None) { Tk_FreeCursor(togl->display, togl->Cursor); } #endif if (togl->DestroyProc) { togl->DestroyProc(togl); } /* remove from linked list */ RemoveFromList(togl); #if !defined(TOGL_WGL) /* TODO: why not on Windows? */ free(togl); #endif } /* * This gets called to handle Togl window configuration events */ static void Togl_EventProc(ClientData clientData, XEvent *eventPtr) { Togl *togl = (Togl *) clientData; switch (eventPtr->type) { case Expose: if (eventPtr->xexpose.count == 0) { if (!togl->UpdatePending && eventPtr->xexpose.window == Tk_WindowId(togl->TkWin)) { Togl_PostRedisplay(togl); } #if defined(TOGL_X11) if (!togl->OverlayUpdatePending && togl->OverlayFlag && togl->OverlayIsMapped && eventPtr->xexpose.window == togl->OverlayWindow) { Togl_PostOverlayRedisplay(togl); } #endif /* TOGL_X11 */ } break; case ConfigureNotify: if (togl->Width != Tk_Width(togl->TkWin) || togl->Height != Tk_Height(togl->TkWin)) { togl->Width = Tk_Width(togl->TkWin); togl->Height = Tk_Height(togl->TkWin); (void) XResizeWindow(Tk_Display(togl->TkWin), Tk_WindowId(togl->TkWin), togl->Width, togl->Height); #if defined(TOGL_X11) if (togl->OverlayFlag) { (void) XResizeWindow(Tk_Display(togl->TkWin), togl->OverlayWindow, togl->Width, togl->Height); (void) XRaiseWindow(Tk_Display(togl->TkWin), togl->OverlayWindow); } #endif /* TOGL_X11 */ Togl_MakeCurrent(togl); if (togl->ReshapeProc) { togl->ReshapeProc(togl); } else { glViewport(0, 0, togl->Width, togl->Height); #if defined(TOGL_X11) if (togl->OverlayFlag) { Togl_UseLayer(togl, TOGL_OVERLAY); glViewport(0, 0, togl->Width, togl->Height); Togl_UseLayer(togl, TOGL_NORMAL); } #endif /* TOGL_X11 */ } #ifndef TOGL_WGL /* causes double redisplay on Win32 platform */ Togl_PostRedisplay(togl); #endif /* TOGL_WGL */ } break; case MapNotify: #if defined(TOGL_AGL) { /* * See comment for the UnmapNotify case below. */ AGLDrawable d = TkMacOSXGetDrawablePort(Tk_WindowId(togl->TkWin)); aglSetDrawable(togl->aglCtx, d); } #endif /* TOGL_AGL */ break; case UnmapNotify: #if defined(TOGL_AGL) { /* * For Mac OS X Aqua, Tk subwindows are not implemented as * separate Aqua windows. They are just different regions of * a single Aqua window. To unmap them they are just not drawn. * Have to disconnect the AGL context otherwise they will continue * to be displayed directly by Aqua. */ aglSetDrawable(togl->aglCtx, NULL); } #endif /* TOGL_AGL */ break; case DestroyNotify: if (togl->TkWin != NULL) { if (togl->SetGrid > 0) { Tk_UnsetGrid(togl->TkWin); } togl->TkWin = NULL; #if (TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION) >= 800 /* This function new in Tcl/Tk 8.0 */ (void) Tcl_DeleteCommandFromToken(togl->Interp, togl->widgetCmd); #endif } if (togl->TimerProc != NULL) { #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401 Tcl_DeleteTimerHandler(togl->timerHandler); #else Tk_DeleteTimerHandler(togl->timerHandler); #endif } if (togl->UpdatePending) { #if (TCL_MAJOR_VERSION * 100 + TCL_MINOR_VERSION) >= 705 Tcl_CancelIdleCall(Togl_Render, (ClientData) togl); #else Tk_CancelIdleCall(Togl_Render, (ClientData) togl); #endif } #if (TK_MAJOR_VERSION * 100 + TK_MINOR_VERSION) >= 401 Tcl_EventuallyFree((ClientData) togl, Togl_Destroy); #else Tk_EventuallyFree((ClientData) togl, Togl_Destroy); #endif break; default: /* nothing */ ; } } void Togl_PostRedisplay(Togl *togl) { if (!togl->UpdatePending) { togl->UpdatePending = True; Tk_DoWhenIdle(Togl_Render, (ClientData) togl); } } void Togl_SwapBuffers(const Togl *togl) { if (togl->DoubleFlag) { #if defined(TOGL_WGL) int res = SwapBuffers(togl->tglGLHdc); assert(res == TRUE); #elif defined(TOGL_X11) glXSwapBuffers(Tk_Display(togl->TkWin), Tk_WindowId(togl->TkWin)); #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) aglSwapBuffers(togl->aglCtx); #endif /* TOGL_WGL */ } else { glFlush(); } } const char * Togl_Ident(const Togl *togl) { return togl->Ident; } int Togl_Width(const Togl *togl) { return togl->Width; } int Togl_Height(const Togl *togl) { return togl->Height; } Tcl_Interp * Togl_Interp(const Togl *togl) { return togl->Interp; } Tk_Window Togl_TkWin(const Togl *togl) { return togl->TkWin; } #if defined(TOGL_X11) /* * A replacement for XAllocColor. This function should never * fail to allocate a color. When XAllocColor fails, we return * the nearest matching color. If we have to allocate many colors * this function isn't too efficient; the XQueryColors() could be * done just once. * Written by Michael Pichler, Brian Paul, Mark Kilgard * Input: dpy - X display * cmap - X colormap * cmapSize - size of colormap * In/Out: color - the XColor struct * Output: exact - 1=exact color match, 0=closest match */ static void noFaultXAllocColor(Display *dpy, Colormap cmap, int cmapSize, XColor *color, int *exact) { XColor *ctable, subColor; int i, bestmatch; double mindist; /* 3*2^16^2 exceeds long int precision. */ /* First try just using XAllocColor. */ if (XAllocColor(dpy, cmap, color)) { *exact = 1; return; } /* Retrieve color table entries. */ /* XXX alloca candidate. */ ctable = (XColor *) malloc(cmapSize * sizeof (XColor)); for (i = 0; i < cmapSize; i++) { ctable[i].pixel = i; } (void) XQueryColors(dpy, cmap, ctable, cmapSize); /* Find best match. */ bestmatch = -1; mindist = 0; for (i = 0; i < cmapSize; i++) { double dr = (double) color->red - (double) ctable[i].red; double dg = (double) color->green - (double) ctable[i].green; double db = (double) color->blue - (double) ctable[i].blue; double dist = dr * dr + dg * dg + db * db; if (bestmatch < 0 || dist < mindist) { bestmatch = i; mindist = dist; } } /* Return result. */ subColor.red = ctable[bestmatch].red; subColor.green = ctable[bestmatch].green; subColor.blue = ctable[bestmatch].blue; free(ctable); /* Try to allocate the closest match color. This should only fail if the * cell is read/write. Otherwise, we're incrementing the cell's reference * count. */ if (!XAllocColor(dpy, cmap, &subColor)) { /* do this to work around a problem reported by Frank Ortega */ subColor.pixel = (unsigned long) bestmatch; subColor.red = ctable[bestmatch].red; subColor.green = ctable[bestmatch].green; subColor.blue = ctable[bestmatch].blue; subColor.flags = DoRed | DoGreen | DoBlue; } *color = subColor; } #elif defined(TOGL_WGL) static UINT Win32AllocColor(const Togl *togl, float red, float green, float blue) { /* Modified version of XAllocColor emulation of Tk. - returns index, * instead of color itself - allocates logical palette entry even for * non-palette devices */ TkWinColormap *cmap = (TkWinColormap *) Tk_Colormap(togl->TkWin); UINT index; COLORREF newColor, closeColor; PALETTEENTRY entry, closeEntry; int new, refCount; Tcl_HashEntry *entryPtr; entry.peRed = (unsigned char) (red * 255 + .5); entry.peGreen = (unsigned char) (green * 255 + .5); entry.peBlue = (unsigned char) (blue * 255 + .5); entry.peFlags = 0; /* * Find the nearest existing palette entry. */ newColor = RGB(entry.peRed, entry.peGreen, entry.peBlue); index = GetNearestPaletteIndex(cmap->palette, newColor); GetPaletteEntries(cmap->palette, index, 1, &closeEntry); closeColor = RGB(closeEntry.peRed, closeEntry.peGreen, closeEntry.peBlue); /* * If this is not a duplicate and colormap is not full, allocate a new entry. */ if (newColor != closeColor) { if (cmap->size == (unsigned int) togl->CiColormapSize) { entry = closeEntry; } else { cmap->size++; ResizePalette(cmap->palette, cmap->size); index = cmap->size - 1; SetPaletteEntries(cmap->palette, index, 1, &entry); SelectPalette(togl->tglGLHdc, cmap->palette, TRUE); RealizePalette(togl->tglGLHdc); } } newColor = PALETTERGB(entry.peRed, entry.peGreen, entry.peBlue); entryPtr = Tcl_CreateHashEntry(&cmap->refCounts, (char *) newColor, &new); if (new) { refCount = 1; } else { refCount = ((int) Tcl_GetHashValue(entryPtr)) + 1; } Tcl_SetHashValue(entryPtr, (ClientData) refCount); /* for EPS output */ togl->EpsRedMap[index] = (GLfloat) (entry.peRed / 255.0); togl->EpsGreenMap[index] = (GLfloat) (entry.peGreen / 255.0); togl->EpsBlueMap[index] = (GLfloat) (entry.peBlue / 255.0); return index; } static void Win32FreeColor(const Togl *togl, unsigned long index) { TkWinColormap *cmap = (TkWinColormap *) Tk_Colormap(togl->TkWin); COLORREF cref; UINT count, refCount; PALETTEENTRY entry, *entries; Tcl_HashEntry *entryPtr; if (index >= cmap->size) { panic("Tried to free a color that isn't allocated."); } GetPaletteEntries(cmap->palette, index, 1, &entry); cref = PALETTERGB(entry.peRed, entry.peGreen, entry.peBlue); entryPtr = Tcl_FindHashEntry(&cmap->refCounts, (char *) cref); if (!entryPtr) { panic("Tried to free a color that isn't allocated."); } refCount = (int) Tcl_GetHashValue(entryPtr) - 1; if (refCount == 0) { count = cmap->size - index; entries = (PALETTEENTRY *) ckalloc(sizeof (PALETTEENTRY) * count); GetPaletteEntries(cmap->palette, index + 1, count, entries); SetPaletteEntries(cmap->palette, index, count, entries); SelectPalette(togl->tglGLHdc, cmap->palette, TRUE); RealizePalette(togl->tglGLHdc); ckfree((char *) entries); cmap->size--; Tcl_DeleteHashEntry(entryPtr); } else { Tcl_SetHashValue(entryPtr, (ClientData) refCount); } } static void Win32SetColor(const Togl *togl, unsigned long index, float red, float green, float blue) { TkWinColormap *cmap = (TkWinColormap *) Tk_Colormap(togl->TkWin); PALETTEENTRY entry; entry.peRed = (unsigned char) (red * 255 + .5); entry.peGreen = (unsigned char) (green * 255 + .5); entry.peBlue = (unsigned char) (blue * 255 + .5); entry.peFlags = 0; SetPaletteEntries(cmap->palette, index, 1, &entry); SelectPalette(togl->tglGLHdc, cmap->palette, TRUE); RealizePalette(togl->tglGLHdc); /* for EPS output */ togl->EpsRedMap[index] = (GLfloat) (entry.peRed / 255.0); togl->EpsGreenMap[index] = (GLfloat) (entry.peGreen / 255.0); togl->EpsBlueMap[index] = (GLfloat) (entry.peBlue / 255.0); } #endif /* TOGL_X11 */ unsigned long Togl_AllocColor(const Togl *togl, float red, float green, float blue) { if (togl->RgbaFlag) { (void) fprintf(stderr, "Error: Togl_AllocColor illegal in RGBA mode.\n"); return 0; } /* TODO: maybe not... */ if (togl->PrivateCmapFlag) { (void) fprintf(stderr, "Error: Togl_FreeColor illegal with private colormap\n"); return 0; } #if defined(TOGL_X11) { XColor xcol; int exact; xcol.red = (short) (red * 65535.0); xcol.green = (short) (green * 65535.0); xcol.blue = (short) (blue * 65535.0); noFaultXAllocColor(Tk_Display(togl->TkWin), Tk_Colormap(togl->TkWin), Tk_Visual(togl->TkWin)->map_entries, &xcol, &exact); /* for EPS output */ togl->EpsRedMap[xcol.pixel] = (float) xcol.red / 65535.0; togl->EpsGreenMap[xcol.pixel] = (float) xcol.green / 65535.0; togl->EpsBlueMap[xcol.pixel] = (float) xcol.blue / 65535.0; return xcol.pixel; } #elif defined(TOGL_WGL) return Win32AllocColor(togl, red, green, blue); #elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) /* still need to implement this on Mac... */ return 0; #endif /* TOGL_X11 */ } void Togl_FreeColor(const Togl *togl, unsigned long pixel) { if (togl->RgbaFlag) { (void) fprintf(stderr, "Error: Togl_AllocColor illegal in RGBA mode.\n"); return; } /* TODO: maybe not... */ if (togl->PrivateCmapFlag) { (void) fprintf(stderr, "Error: Togl_FreeColor illegal with private colormap\n"); return; } #if defined(TOGL_X11) (void) XFreeColors(Tk_Display(togl->TkWin), Tk_Colormap(togl->TkWin), &pixel, 1, 0); #elif defined(TOGL_WGL) Win32FreeColor(togl, pixel); #endif /* TOGL_X11 */ } void Togl_SetColor(const Togl *togl, unsigned long index, float red, float green, float blue) { if (togl->RgbaFlag) { (void) fprintf(stderr, "Error: Togl_AllocColor illegal in RGBA mode.\n"); return; } if (!togl->PrivateCmapFlag) { (void) fprintf(stderr, "Error: Togl_SetColor requires a private colormap\n"); return; } #if defined(TOGL_X11) { XColor xcol; xcol.pixel = index; xcol.red = (short) (red * 65535.0); xcol.green = (short) (green * 65535.0); xcol.blue = (short) (blue * 65535.0); xcol.flags = DoRed | DoGreen | DoBlue; (void) XStoreColor(Tk_Display(togl->TkWin), Tk_Colormap(togl->TkWin), &xcol); /* for EPS output */ togl->EpsRedMap[xcol.pixel] = (float) xcol.red / 65535.0; togl->EpsGreenMap[xcol.pixel] = (float) xcol.green / 65535.0; togl->EpsBlueMap[xcol.pixel] = (float) xcol.blue / 65535.0; } #elif defined(TOGL_WGL) Win32SetColor(togl, index, red, green, blue); #endif /* TOGL_X11 */ } #if TOGL_USE_FONTS == 1 # if defined(TOGL_WGL) # include "tkWinInt.h" # include "tkFont.h" /* * The following structure represents Windows' implementation of a font. */ typedef struct WinFont { TkFont font; /* Stuff used by generic font package. Must be * first in structure. */ HFONT hFont; /* Windows information about font. */ HWND hwnd; /* Toplevel window of application that owns * this font, used for getting HDC. */ int widths[256]; /* Widths of first 256 chars in this font. */ } WinFont; # endif /* TOGL_WGL */ # define MAX_FONTS 1000 static GLuint ListBase[MAX_FONTS]; static GLuint ListCount[MAX_FONTS]; /* * Load the named bitmap font as a sequence of bitmaps in a display list. * fontname may be one of the predefined fonts like TOGL_BITMAP_8_BY_13 * or an X font name, or a Windows font name, etc. */ GLuint Togl_LoadBitmapFont(const Togl *togl, const char *fontname) { static Bool FirstTime = True; # if defined(TOGL_X11) XFontStruct *fontinfo; # elif defined(TOGL_WGL) WinFont *winfont; HFONT oldFont; TEXTMETRIC tm; # endif /* TOGL_X11 */ int first, last, count; GLuint fontbase; const char *name; /* Initialize the ListBase and ListCount arrays */ if (FirstTime) { int i; for (i = 0; i < MAX_FONTS; i++) { ListBase[i] = ListCount[i] = 0; } FirstTime = False; } /* * This method of selecting X fonts according to a TOGL_ font name * is a kludge. To be fixed when I find time... */ if (fontname == TOGL_BITMAP_8_BY_13) { name = "8x13"; } else if (fontname == TOGL_BITMAP_9_BY_15) { name = "9x15"; } else if (fontname == TOGL_BITMAP_TIMES_ROMAN_10) { name = "-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1"; } else if (fontname == TOGL_BITMAP_TIMES_ROMAN_24) { name = "-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1"; } else if (fontname == TOGL_BITMAP_HELVETICA_10) { name = "-adobe-helvetica-medium-r-normal--10-100-75-75-p-57-iso8859-1"; } else if (fontname == TOGL_BITMAP_HELVETICA_12) { name = "-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1"; } else if (fontname == TOGL_BITMAP_HELVETICA_18) { name = "-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1"; } else if (!fontname) { name = DEFAULT_FONTNAME; } else { name = (const char *) fontname; } assert(name); # if defined(TOGL_X11) fontinfo = (XFontStruct *) XLoadQueryFont(Tk_Display(togl->TkWin), name); if (!fontinfo) { return 0; } first = fontinfo->min_char_or_byte2; last = fontinfo->max_char_or_byte2; # elif defined(TOGL_WGL) winfont = (WinFont *) Tk_GetFont(togl->Interp, togl->TkWin, name); if (!winfont) { return 0; } oldFont = SelectObject(togl->tglGLHdc, winfont->hFont); GetTextMetrics(togl->tglGLHdc, &tm); first = tm.tmFirstChar; last = tm.tmLastChar; # elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) first = 10; /* don't know how to determine font range on * Mac... */ last = 127; # endif /* TOGL_X11 */ count = last - first + 1; fontbase = glGenLists((GLuint) (last + 1)); if (fontbase == 0) { # ifdef TOGL_WGL SelectObject(togl->tglGLHdc, oldFont); Tk_FreeFont((Tk_Font) winfont); # endif /* TOGL_WGL */ return 0; } # if defined(TOGL_WGL) wglUseFontBitmaps(togl->tglGLHdc, first, count, (int) fontbase + first); SelectObject(togl->tglGLHdc, oldFont); Tk_FreeFont((Tk_Font) winfont); # elif defined(TOGL_X11) glXUseXFont(fontinfo->fid, first, count, (int) fontbase + first); # elif defined(TOGL_AGL_CLASSIC) || defined(TOGL_AGL) aglUseFont(togl->aglCtx, 1, 0, 14, /* for now, only app font, regular * 14-point */ 10, 118, fontbase + first); # endif /* Record the list base and number of display lists for * Togl_UnloadBitmapFont(). */ { int i; for (i = 0; i < MAX_FONTS; i++) { if (ListBase[i] == 0) { ListBase[i] = fontbase; ListCount[i] = last + 1; break; } } } return fontbase; } /* * Release the display lists which were generated by Togl_LoadBitmapFont(). */ void Togl_UnloadBitmapFont(const Togl *togl, GLuint fontbase) { int i; (void) togl; for (i = 0; i < MAX_FONTS; i++) { if (ListBase[i] == fontbase) { glDeleteLists(ListBase[i], ListCount[i]); ListBase[i] = ListCount[i] = 0; return; } } } #endif /* TOGL_USE_FONTS */ /* * Overlay functions */ void Togl_UseLayer(Togl *togl, int layer) { if (!togl->OverlayWindow) return; if (layer == TOGL_OVERLAY) { #if defined(TOGL_WGL) int res = wglMakeCurrent(togl->tglGLHdc, togl->tglGLOverlayHglrc); assert(res == TRUE); #elif defined(TOGL_X11) (void) glXMakeCurrent(Tk_Display(togl->TkWin), togl->OverlayWindow, togl->OverlayCtx); # if defined(__sgi) if (togl->OldStereoFlag) oldStereoMakeCurrent(Tk_Display(togl->TkWin), togl->OverlayWindow, togl->OverlayCtx); # endif /* __sgi STEREO */ #endif /* TOGL_WGL */ } else if (layer == TOGL_NORMAL) { #if defined(TOGL_WGL) int res = wglMakeCurrent(togl->tglGLHdc, togl->tglGLHglrc); assert(res == TRUE); #elif defined(TOGL_X11) (void) glXMakeCurrent(Tk_Display(togl->TkWin), Tk_WindowId(togl->TkWin), togl->GlCtx); # if defined(__sgi) if (togl->OldStereoFlag) oldStereoMakeCurrent(Tk_Display(togl->TkWin), Tk_WindowId(togl->TkWin), togl->GlCtx); # endif /* __sgi STEREO */ #endif /* TOGL_WGL */ } else { /* error */ } } void Togl_ShowOverlay(Togl *togl) { #if defined(TOGL_X11) /* not yet implemented on Windows */ if (togl->OverlayWindow) { (void) XMapWindow(Tk_Display(togl->TkWin), togl->OverlayWindow); (void) XInstallColormap(Tk_Display(togl->TkWin), togl->OverlayCmap); togl->OverlayIsMapped = True; } #endif /* TOGL_X11 */ } void Togl_HideOverlay(Togl *togl) { if (togl->OverlayWindow && togl->OverlayIsMapped) { (void) XUnmapWindow(Tk_Display(togl->TkWin), togl->OverlayWindow); togl->OverlayIsMapped = False; } } void Togl_PostOverlayRedisplay(Togl *togl) { if (!togl->OverlayUpdatePending && togl->OverlayWindow && togl->OverlayDisplayProc) { Tk_DoWhenIdle(RenderOverlay, (ClientData) togl); togl->OverlayUpdatePending = True; } } void Togl_OverlayDisplayFunc(Togl_Callback *proc) { DefaultOverlayDisplayProc = proc; } int Togl_ExistsOverlay(const Togl *togl) { return togl->OverlayFlag; } int Togl_GetOverlayTransparentValue(const Togl *togl) { return togl->OverlayTransparentPixel; } int Togl_IsMappedOverlay(const Togl *togl) { return togl->OverlayFlag && togl->OverlayIsMapped; } unsigned long Togl_AllocColorOverlay(const Togl *togl, float red, float green, float blue) { #if defined(TOGL_X11) /* not yet implemented on Windows */ if (togl->OverlayFlag && togl->OverlayCmap) { XColor xcol; xcol.red = (short) (red * 65535.0); xcol.green = (short) (green * 65535.0); xcol.blue = (short) (blue * 65535.0); if (!XAllocColor(Tk_Display(togl->TkWin), togl->OverlayCmap, &xcol)) return (unsigned long) -1; return xcol.pixel; } #endif /* TOGL_X11 */ return (unsigned long) -1; } void Togl_FreeColorOverlay(const Togl *togl, unsigned long pixel) { #if defined(TOGL_X11) /* not yet implemented on Windows */ if (togl->OverlayFlag && togl->OverlayCmap) { (void) XFreeColors(Tk_Display(togl->TkWin), togl->OverlayCmap, &pixel, 1, 0); } #endif /* TOGL_X11 */ } /* * User client data */ void Togl_ClientData(ClientData clientData) { DefaultClientData = clientData; } ClientData Togl_GetClientData(const Togl *togl) { return togl->Client_Data; } void Togl_SetClientData(Togl *togl, ClientData clientData) { togl->Client_Data = clientData; } /* * X11-only functions * Contributed by Miguel A. De Riera Pasenau (miguel@DALILA.UPC.ES) */ Display * Togl_Display(const Togl *togl) { return Tk_Display(togl->TkWin); } Screen * Togl_Screen(const Togl *togl) { return Tk_Screen(togl->TkWin); } int Togl_ScreenNumber(const Togl *togl) { return Tk_ScreenNumber(togl->TkWin); } Colormap Togl_Colormap(const Togl *togl) { return Tk_Colormap(togl->TkWin); } #ifdef MESA_COLOR_HACK /* * Let's know how many free colors do we have */ # if 0 static unsigned char rojo[] = { 4, 39, 74, 110, 145, 181, 216, 251 }, verde[] = { 4, 39, 74, 110, 145, 181, 216, 251}, azul[] = { 4, 39, 74, 110, 145, 181, 216, 251}; unsigned char rojo[] = { 4, 36, 72, 109, 145, 182, 218, 251 }, verde[] = { 4, 36, 72, 109, 145, 182, 218, 251}, azul[] = { 4, 36, 72, 109, 145, 182, 218, 251}; azul[] = { 0, 85, 170, 255}; # endif # define RLEVELS 5 # define GLEVELS 9 # define BLEVELS 5 /* to free dithered_rgb_colormap pixels allocated by Mesa */ static unsigned long *ToglMesaUsedPixelCells = NULL; static int ToglMesaUsedFreeCells = 0; static int get_free_color_cells(Display *display, int screen, Colormap colormap) { if (!ToglMesaUsedPixelCells) { XColor xcol; int i; int colorsfailed, ncolors = XDisplayCells(display, screen); long r, g, b; ToglMesaUsedPixelCells = (unsigned long *) calloc(ncolors, sizeof (unsigned long)); /* Allocate X colors and initialize color_table[], red_table[], etc */ /* de Mesa 2.1: xmesa1.c setup_dithered_(...) */ i = colorsfailed = 0; for (r = 0; r < RLEVELS; r++) for (g = 0; g < GLEVELS; g++) for (b = 0; b < BLEVELS; b++) { int exact; xcol.red = (r * 65535) / (RLEVELS - 1); xcol.green = (g * 65535) / (GLEVELS - 1); xcol.blue = (b * 65535) / (BLEVELS - 1); noFaultXAllocColor(display, colormap, ncolors, &xcol, &exact); ToglMesaUsedPixelCells[i++] = xcol.pixel; if (!exact) { colorsfailed++; } } ToglMesaUsedFreeCells = i; XFreeColors(display, colormap, ToglMesaUsedPixelCells, ToglMesaUsedFreeCells, 0x00000000); } return ToglMesaUsedFreeCells; } static void free_default_color_cells(Display *display, Colormap colormap) { if (ToglMesaUsedPixelCells) { XFreeColors(display, colormap, ToglMesaUsedPixelCells, ToglMesaUsedFreeCells, 0x00000000); free(ToglMesaUsedPixelCells); ToglMesaUsedPixelCells = NULL; ToglMesaUsedFreeCells = 0; } } #endif /* * Generate EPS file. * Contributed by Miguel A. De Riera Pasenau (miguel@DALILA.UPC.ES) */ /* Function that creates a EPS File from a created pixmap on the current * context. Based on the code from Copyright (c) Mark J. Kilgard, 1996. * Parameters: name_file, b&w / Color flag, redraw function. The redraw * function is needed in order to draw things into the new created pixmap. */ /* Copyright (c) Mark J. Kilgard, 1996. */ static GLvoid * grabPixels(int inColor, unsigned int width, unsigned int height) { GLvoid *buffer; GLint swapbytes, lsbfirst, rowlength; GLint skiprows, skippixels, alignment; GLenum format; unsigned int size; if (inColor) { format = GL_RGB; size = width * height * 3; } else { format = GL_LUMINANCE; size = width * height * 1; } buffer = (GLvoid *) malloc(size); if (buffer == NULL) return NULL; /* Save current modes. */ glGetIntegerv(GL_PACK_SWAP_BYTES, &swapbytes); glGetIntegerv(GL_PACK_LSB_FIRST, &lsbfirst); glGetIntegerv(GL_PACK_ROW_LENGTH, &rowlength); glGetIntegerv(GL_PACK_SKIP_ROWS, &skiprows); glGetIntegerv(GL_PACK_SKIP_PIXELS, &skippixels); glGetIntegerv(GL_PACK_ALIGNMENT, &alignment); /* Little endian machines (DEC Alpha for example) could benefit from * setting GL_PACK_LSB_FIRST to GL_TRUE instead of GL_FALSE, but this would * * * * * * * * * require changing the generated bitmaps too. */ glPixelStorei(GL_PACK_SWAP_BYTES, GL_FALSE); glPixelStorei(GL_PACK_LSB_FIRST, GL_FALSE); glPixelStorei(GL_PACK_ROW_LENGTH, 0); glPixelStorei(GL_PACK_SKIP_ROWS, 0); glPixelStorei(GL_PACK_SKIP_PIXELS, 0); glPixelStorei(GL_PACK_ALIGNMENT, 1); /* Actually read the pixels. */ glReadPixels(0, 0, width, height, format, GL_UNSIGNED_BYTE, (GLvoid *) buffer); /* Restore saved modes. */ glPixelStorei(GL_PACK_SWAP_BYTES, swapbytes); glPixelStorei(GL_PACK_LSB_FIRST, lsbfirst); glPixelStorei(GL_PACK_ROW_LENGTH, rowlength); glPixelStorei(GL_PACK_SKIP_ROWS, skiprows); glPixelStorei(GL_PACK_SKIP_PIXELS, skippixels); glPixelStorei(GL_PACK_ALIGNMENT, alignment); return buffer; } static int generateEPS(const char *filename, int inColor, unsigned int width, unsigned int height) { FILE *fp; GLvoid *pixels; unsigned char *curpix; unsigned int components, i; int pos; unsigned int bitpixel; pixels = grabPixels(inColor, width, height); if (pixels == NULL) return 1; if (inColor) components = 3; /* Red, green, blue. */ else components = 1; /* Luminance. */ fp = fopen(filename, "w"); if (fp == NULL) { return 2; } (void) fprintf(fp, "%%!PS-Adobe-2.0 EPSF-1.2\n"); (void) fprintf(fp, "%%%%Creator: OpenGL pixmap render output\n"); (void) fprintf(fp, "%%%%BoundingBox: 0 0 %d %d\n", width, height); (void) fprintf(fp, "%%%%EndComments\n"); i = (((width * height) + 7) / 8) / 40; /* # of lines, 40 bytes per * line */ (void) fprintf(fp, "%%%%BeginPreview: %d %d %d %d\n%%", width, height, 1, i); pos = 0; curpix = (unsigned char *) pixels; for (i = 0; i < width * height * components;) { bitpixel = 0; if (inColor) { double pix = 0; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x80; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x40; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x20; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x10; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x08; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x04; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x02; pix = 0.30 * (double) curpix[i] + 0.59 * (double) curpix[i + 1] + 0.11 * (double) curpix[i + 2]; i += 3; if (pix > 127.0) bitpixel |= 0x01; } else { if (curpix[i++] > 0x7f) bitpixel |= 0x80; if (curpix[i++] > 0x7f) bitpixel |= 0x40; if (curpix[i++] > 0x7f) bitpixel |= 0x20; if (curpix[i++] > 0x7f) bitpixel |= 0x10; if (curpix[i++] > 0x7f) bitpixel |= 0x08; if (curpix[i++] > 0x7f) bitpixel |= 0x04; if (curpix[i++] > 0x7f) bitpixel |= 0x02; if (curpix[i++] > 0x7f) bitpixel |= 0x01; } (void) fprintf(fp, "%02x", bitpixel); if (++pos >= 40) { (void) fprintf(fp, "\n%%"); pos = 0; } } if (pos) (void) fprintf(fp, "\n%%%%EndPreview\n"); else (void) fprintf(fp, "%%EndPreview\n"); (void) fprintf(fp, "gsave\n"); (void) fprintf(fp, "/bwproc {\n"); (void) fprintf(fp, " rgbproc\n"); (void) fprintf(fp, " dup length 3 idiv string 0 3 0\n"); (void) fprintf(fp, " 5 -1 roll {\n"); (void) fprintf(fp, " add 2 1 roll 1 sub dup 0 eq\n"); (void) fprintf(fp, " { pop 3 idiv 3 -1 roll dup 4 -1 roll dup\n"); (void) fprintf(fp, " 3 1 roll 5 -1 roll put 1 add 3 0 }\n"); (void) fprintf(fp, " { 2 1 roll } ifelse\n"); (void) fprintf(fp, " } forall\n"); (void) fprintf(fp, " pop pop pop\n"); (void) fprintf(fp, "} def\n"); (void) fprintf(fp, "systemdict /colorimage known not {\n"); (void) fprintf(fp, " /colorimage {\n"); (void) fprintf(fp, " pop\n"); (void) fprintf(fp, " pop\n"); (void) fprintf(fp, " /rgbproc exch def\n"); (void) fprintf(fp, " { bwproc } image\n"); (void) fprintf(fp, " } def\n"); (void) fprintf(fp, "} if\n"); (void) fprintf(fp, "/picstr %d string def\n", width * components); (void) fprintf(fp, "%d %d scale\n", width, height); (void) fprintf(fp, "%d %d %d\n", width, height, 8); (void) fprintf(fp, "[%d 0 0 %d 0 0]\n", width, height); (void) fprintf(fp, "{currentfile picstr readhexstring pop}\n"); (void) fprintf(fp, "false %d\n", components); (void) fprintf(fp, "colorimage\n"); curpix = (unsigned char *) pixels; pos = 0; for (i = width * height * components; i != 0; i--) { (void) fprintf(fp, "%02hx", *curpix++); if (++pos >= 40) { (void) fprintf(fp, "\n"); pos = 0; } } if (pos) (void) fprintf(fp, "\n"); (void) fprintf(fp, "grestore\n"); free(pixels); if (fclose(fp) != 0) return 1; return 0; } /* int Togl_DumpToEpsFile( const Togl *togl, const char *filename, int inColor, * void (*user_redraw)(void)) */ /* changed by GG */ int Togl_DumpToEpsFile(const Togl *togl, const char *filename, int inColor, void (*user_redraw) (const Togl *)) { Bool using_mesa = False; #if 0 Pixmap eps_pixmap; GLXPixmap eps_glxpixmap; XVisualInfo *vi = togl->VisInfo; Window win = Tk_WindowId(togl->TkWin); #endif int retval; unsigned int width = togl->Width, height = togl->Height; #if defined(TOGL_X11) Display *dpy = Tk_Display(togl->TkWin); int scrnum = Tk_ScreenNumber(togl->TkWin); if (strstr(glXQueryServerString(dpy, scrnum, GLX_VERSION), "Mesa")) using_mesa = True; else #endif /* TOGL_X11 */ using_mesa = False; /* I don't use Pixmap do drawn into, because the code should link with Mesa * libraries and OpenGL libraries, and the which library we use at run time * should not matter, but the name of the calls differs one from another: * MesaGl: glXCreateGLXPixmapMESA( dpy, vi, eps_pixmap, * Tk_Colormap(togl->TkWin)) OpenGl: glXCreateGLXPixmap( dpy, vi, * eps_pixmap); instead of this I read direct from back buffer of the * screeen. */ #if 0 eps_pixmap = XCreatePixmap(dpy, win, width, height, vi->depth); if (using_mesa) eps_glxpixmap = glXCreateGLXPixmapMESA(dpy, vi, eps_pixmap, Tk_Colormap(togl->TkWin)); else eps_glxpixmap = glXCreateGLXPixmap(dpy, vi, eps_pixmap); glXMakeCurrent(dpy, eps_glxpixmap, togl->GlCtx); user_redraw(); #endif if (!togl->RgbaFlag) { #if defined(TOGL_WGL) /* Due to the lack of a unique inverse mapping from the frame buffer to * the logical palette we need a translation map from the complete * logical palette. */ { int n, i; TkWinColormap *cmap = (TkWinColormap *) Tk_Colormap(togl->TkWin); LPPALETTEENTRY entry = malloc(togl->EpsMapSize * sizeof (PALETTEENTRY)); n = GetPaletteEntries(cmap->palette, 0, togl->EpsMapSize, entry); for (i = 0; i < n; i++) { togl->EpsRedMap[i] = (GLfloat) (entry[i].peRed / 255.0); togl->EpsGreenMap[i] = (GLfloat) (entry[i].peGreen / 255.0); togl->EpsBlueMap[i] = (GLfloat) (entry[i].peBlue / 255.0); } free(entry); } #endif /* TOGL_WGL */ glPixelMapfv(GL_PIXEL_MAP_I_TO_R, togl->EpsMapSize, togl->EpsRedMap); glPixelMapfv(GL_PIXEL_MAP_I_TO_G, togl->EpsMapSize, togl->EpsGreenMap); glPixelMapfv(GL_PIXEL_MAP_I_TO_B, togl->EpsMapSize, togl->EpsBlueMap); } /* user_redraw(); */ user_redraw(togl); /* changed by GG */ /* glReadBuffer( GL_FRONT); */ /* by default it read GL_BACK in double buffer mode */ glFlush(); retval = generateEPS(filename, inColor, width, height); #if 0 glXMakeCurrent(dpy, win, togl->GlCtx); glXDestroyGLXPixmap(dpy, eps_glxpixmap); XFreePixmap(dpy, eps_pixmap); #endif return retval; } /* * Full screen stereo for SGI graphics * Contributed by Ben Evans (Ben.Evans@anusf.anu.edu.au) * This code was based on SGI's /usr/share/src/OpenGL/teach/stereo */ #if defined(__sgi) static struct stereoStateRec { Bool useSGIStereo; Display *currentDisplay; Window currentWindow; GLXContext currentContext; GLenum currentDrawBuffer; int currentStereoBuffer; Bool enabled; char *stereoCommand; char *restoreCommand; } stereo; /* call instead of glDrawBuffer */ void Togl_OldStereoDrawBuffer(GLenum mode) { if (stereo.useSGIStereo) { stereo.currentDrawBuffer = mode; switch (mode) { case GL_FRONT: case GL_BACK: case GL_FRONT_AND_BACK: /* ** Simultaneous drawing to both left and right buffers isn't ** really possible if we don't have a stereo capable visual. ** For now just fall through and use the left buffer. */ case GL_LEFT: case GL_FRONT_LEFT: case GL_BACK_LEFT: stereo.currentStereoBuffer = STEREO_BUFFER_LEFT; break; case GL_RIGHT: case GL_FRONT_RIGHT: stereo.currentStereoBuffer = STEREO_BUFFER_RIGHT; mode = GL_FRONT; break; case GL_BACK_RIGHT: stereo.currentStereoBuffer = STEREO_BUFFER_RIGHT; mode = GL_BACK; break; default: break; } if (stereo.currentDisplay && stereo.currentWindow) { glXWaitGL(); /* sync with GL command stream before calling X */ XSGISetStereoBuffer(stereo.currentDisplay, stereo.currentWindow, stereo.currentStereoBuffer); glXWaitX(); /* sync with X command stream before calling GL */ } } glDrawBuffer(mode); } /* call instead of glClear */ void Togl_OldStereoClear(GLbitfield mask) { GLenum drawBuffer; if (stereo.useSGIStereo) { drawBuffer = stereo.currentDrawBuffer; switch (drawBuffer) { case GL_FRONT: Togl_OldStereoDrawBuffer(GL_FRONT_RIGHT); glClear(mask); Togl_OldStereoDrawBuffer(drawBuffer); break; case GL_BACK: Togl_OldStereoDrawBuffer(GL_BACK_RIGHT); glClear(mask); Togl_OldStereoDrawBuffer(drawBuffer); break; case GL_FRONT_AND_BACK: Togl_OldStereoDrawBuffer(GL_RIGHT); glClear(mask); Togl_OldStereoDrawBuffer(drawBuffer); break; case GL_LEFT: case GL_FRONT_LEFT: case GL_BACK_LEFT: case GL_RIGHT: case GL_FRONT_RIGHT: case GL_BACK_RIGHT: default: break; } } glClear(mask); } static void oldStereoMakeCurrent(Display *dpy, Window win, GLXContext ctx) { if (dpy && (dpy != stereo.currentDisplay)) { int event, error; /* Make sure new Display supports SGIStereo */ if (XSGIStereoQueryExtension(dpy, &event, &error) == False) { dpy = NULL; } } if (dpy && win && (win != stereo.currentWindow)) { /* Make sure new Window supports SGIStereo */ if (XSGIQueryStereoMode(dpy, win) == X_STEREO_UNSUPPORTED) { win = None; } } if (ctx && (ctx != stereo.currentContext)) { GLint drawBuffer; glGetIntegerv(GL_DRAW_BUFFER, &drawBuffer); Togl_OldStereoDrawBuffer((GLenum) drawBuffer); } stereo.currentDisplay = dpy; stereo.currentWindow = win; stereo.currentContext = ctx; } /* call before using stereo */ static void oldStereoInit(Togl *togl, int stereoEnabled) { stereo.useSGIStereo = stereoEnabled; stereo.currentDisplay = NULL; stereo.currentWindow = None; stereo.currentContext = NULL; stereo.currentDrawBuffer = GL_NONE; stereo.currentStereoBuffer = STEREO_BUFFER_NONE; stereo.enabled = False; } #endif /* __sgi STEREO */ void Togl_StereoFrustum(GLfloat left, GLfloat right, GLfloat bottom, GLfloat top, GLfloat zNear, GLfloat zFar, GLfloat eyeDist, GLfloat eyeOffset) { GLfloat eyeShift = (eyeDist - zNear) * (eyeOffset / eyeDist); glFrustum(left + eyeShift, right + eyeShift, bottom, top, zNear, zFar); glTranslatef(-eyeShift, 0, 0); } #ifdef TOGL_AGL_CLASSIC /* needed to make shared library on Mac with CodeWarrior; should be overridden * by user app */ /* * int main(int argc, char *argv[]) { return -1; } */ /* the following code is borrowed from tkMacAppInit.c */ /* *---------------------------------------------------------------------- * * MacintoshInit -- * * This procedure calls Mac specific initilization calls. Most of * these calls must be made as soon as possible in the startup * process. * * Results: * Returns TCL_OK if everything went fine. If it didn't the * application should probably fail. * * Side effects: * Inits the application. * *---------------------------------------------------------------------- */ int Togl_MacInit(void) { int i; long result, mask = 0x0700; /* mask = system 7.x */ # if GENERATING68K && !GENERATINGCFM SetApplLimit(GetApplLimit() - (TK_MAC_68K_STACK_GROWTH)); # endif MaxApplZone(); for (i = 0; i < 4; i++) { (void) MoreMasters(); } /* * Tk needs us to set the qd pointer it uses. This is needed * so Tk doesn't have to assume the availablity of the qd global * variable. Which in turn allows Tk to be used in code resources. */ tcl_macQdPtr = &qd; /* * If appearance is present, then register Tk as an Appearance client * This means that the mapping from non-Appearance to Appearance cdefs * will be done for Tk regardless of the setting in the Appearance * control panel. */ if (TkMacHaveAppearance()) { RegisterAppearanceClient(); } InitGraf(&tcl_macQdPtr->thePort); InitFonts(); InitWindows(); InitMenus(); InitDialogs((long) NULL); InitCursor(); /* * Make sure we are running on system 7 or higher */ if ((NGetTrapAddress(_Gestalt, ToolTrap) == NGetTrapAddress(_Unimplemented, ToolTrap)) || (((Gestalt(gestaltSystemVersion, &result) != noErr) || (result < mask)))) { panic("Tcl/Tk requires System 7 or higher."); } /* * Make sure we have color quick draw * (this means we can't run on 68000 macs) */ if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr) || (result < gestalt32BitQD13))) { panic("Tk requires Color QuickDraw."); } FlushEvents(everyEvent, 0); SetEventMask(everyEvent); Tcl_MacSetEventProc(TkMacConvertEvent); return TCL_OK; } int Togl_MacSetupMainInterp(Tcl_Interp *interp) { TkMacInitAppleEvents(interp); TkMacInitMenus(interp); return TCL_OK; } #endif /* TOGL_AGL_CLASSIC */ lablgl-1.05/Togl/src/Togl/togl.h000644 000765 000024 00000014234 12217024174 017367 0ustar00garriguestaff000000 000000 /* $Id: togl.h,v 1.28 2005/10/27 07:45:48 gregcouch Exp $ */ /* vi:set sw=4: */ /* * Togl - a Tk OpenGL widget * * Copyright (C) 1996-1998 Brian Paul and Ben Bederson * See the LICENSE file for copyright details. */ #ifndef TOGL_H # define TOGL_H /* Define the window system in Makefile.config */ /* # include "togl_ws.h" */ # ifdef TOGL_WGL # define WIN32_LEAN_AND_MEAN # include # undef WIN32_LEAN_AND_MEAN # if defined(_MSC_VER) # define DllEntryPoint DllMain # endif # endif # ifdef _WIN32 # define TOGL_EXTERN __declspec(dllexport) extern # else # define TOGL_EXTERN extern # endif /* _WIN32 */ # ifdef TOGL_AGL_CLASSIC # ifndef MAC_TCL # define MAC_TCL 1 # endif # endif # ifdef TOGL_AGL # ifndef MAC_OSX_TCL # define MAC_OSX_TCL 1 # endif # ifndef MAC_OSX_TK # define MAC_OSX_TK 1 # endif # endif # include # include # if defined(TOGL_AGL) || defined(TOGL_AGL_CLASSIC) # include # else # include # endif # ifdef __sgi # include # include # endif # ifndef CONST84 # define CONST84 # endif # ifndef NULL # define NULL 0 # endif # ifndef TOGL_USE_FONTS # define TOGL_USE_FONTS 1 /* needed for demos */ # endif # ifdef __cplusplus /* *INDENT-OFF* */ extern "C" { /* *INDENT-ON* */ # endif # define TOGL_VERSION "1.7" # define TOGL_MAJOR_VERSION 1 # define TOGL_MINOR_VERSION 7 /* * "Standard" fonts which can be specified to Togl_LoadBitmapFont() */ # define TOGL_BITMAP_8_BY_13 ((char *) 1) # define TOGL_BITMAP_9_BY_15 ((char *) 2) # define TOGL_BITMAP_TIMES_ROMAN_10 ((char *) 3) # define TOGL_BITMAP_TIMES_ROMAN_24 ((char *) 4) # define TOGL_BITMAP_HELVETICA_10 ((char *) 5) # define TOGL_BITMAP_HELVETICA_12 ((char *) 6) # define TOGL_BITMAP_HELVETICA_18 ((char *) 7) /* * Normal and overlay plane constants */ # define TOGL_NORMAL 1 # define TOGL_OVERLAY 2 struct Togl; typedef struct Togl Togl; typedef void (Togl_Callback) (Togl *togl); typedef int (Togl_CmdProc) (Togl *togl, int argc, CONST84 char *argv[]); TOGL_EXTERN int Togl_Init(Tcl_Interp *interp); /* * Default/initial callback setup functions */ TOGL_EXTERN void Togl_CreateFunc(Togl_Callback *proc); TOGL_EXTERN void Togl_DisplayFunc(Togl_Callback *proc); TOGL_EXTERN void Togl_ReshapeFunc(Togl_Callback *proc); TOGL_EXTERN void Togl_DestroyFunc(Togl_Callback *proc); TOGL_EXTERN void Togl_TimerFunc(Togl_Callback *proc); TOGL_EXTERN void Togl_ResetDefaultCallbacks(void); /* * Change callbacks for existing widget */ TOGL_EXTERN void Togl_SetCreateFunc(Togl *togl, Togl_Callback *proc); TOGL_EXTERN void Togl_SetDisplayFunc(Togl *togl, Togl_Callback *proc); TOGL_EXTERN void Togl_SetReshapeFunc(Togl *togl, Togl_Callback *proc); TOGL_EXTERN void Togl_SetDestroyFunc(Togl *togl, Togl_Callback *proc); TOGL_EXTERN void Togl_SetTimerFunc(Togl *togl, Togl_Callback *proc); /* * Miscellaneous */ TOGL_EXTERN int Togl_Configure(Tcl_Interp *interp, Togl *togl, int argc, const char *argv[], int flags); TOGL_EXTERN void Togl_MakeCurrent(const Togl *togl); TOGL_EXTERN void Togl_CreateCommand(char *cmd_name, Togl_CmdProc *cmd_proc); TOGL_EXTERN void Togl_PostRedisplay(Togl *togl); TOGL_EXTERN void Togl_SwapBuffers(const Togl *togl); /* * Query functions */ TOGL_EXTERN const char *Togl_Ident(const Togl *togl); TOGL_EXTERN int Togl_Width(const Togl *togl); TOGL_EXTERN int Togl_Height(const Togl *togl); TOGL_EXTERN Tcl_Interp *Togl_Interp(const Togl *togl); TOGL_EXTERN Tk_Window Togl_TkWin(const Togl *togl); /* * Color Index mode */ TOGL_EXTERN unsigned long Togl_AllocColor(const Togl *togl, float red, float green, float blue); TOGL_EXTERN void Togl_FreeColor(const Togl *togl, unsigned long index); TOGL_EXTERN void Togl_SetColor(const Togl *togl, unsigned long index, float red, float green, float blue); # if TOGL_USE_FONTS == 1 /* * Bitmap fonts */ TOGL_EXTERN GLuint Togl_LoadBitmapFont(const Togl *togl, const char *fontname); TOGL_EXTERN void Togl_UnloadBitmapFont(const Togl *togl, GLuint fontbase); # endif /* * Overlay functions */ TOGL_EXTERN void Togl_UseLayer(Togl *togl, int layer); TOGL_EXTERN void Togl_ShowOverlay(Togl *togl); TOGL_EXTERN void Togl_HideOverlay(Togl *togl); TOGL_EXTERN void Togl_PostOverlayRedisplay(Togl *togl); TOGL_EXTERN void Togl_OverlayDisplayFunc(Togl_Callback *proc); TOGL_EXTERN int Togl_ExistsOverlay(const Togl *togl); TOGL_EXTERN int Togl_GetOverlayTransparentValue(const Togl *togl); TOGL_EXTERN int Togl_IsMappedOverlay(const Togl *togl); TOGL_EXTERN unsigned long Togl_AllocColorOverlay(const Togl *togl, float red, float green, float blue); TOGL_EXTERN void Togl_FreeColorOverlay(const Togl *togl, unsigned long index); /* * User client data */ TOGL_EXTERN void Togl_ClientData(ClientData clientData); TOGL_EXTERN ClientData Togl_GetClientData(const Togl *togl); TOGL_EXTERN void Togl_SetClientData(Togl *togl, ClientData clientData); # ifdef TOGL_X11 /* * X11-only commands. * Contributed by Miguel A. De Riera Pasenau (miguel@DALILA.UPC.ES) */ TOGL_EXTERN Display *Togl_Display(const Togl *togl); TOGL_EXTERN Screen *Togl_Screen(const Togl *togl); TOGL_EXTERN int Togl_ScreenNumber(const Togl *togl); TOGL_EXTERN Colormap Togl_Colormap(const Togl *togl); # endif # ifdef __sgi /* * SGI stereo-only commands. * Contributed by Ben Evans (Ben.Evans@anusf.anu.edu.au) */ TOGL_EXTERN void Togl_OldStereoDrawBuffer(GLenum mode); TOGL_EXTERN void Togl_OldStereoClear(GLbitfield mask); # endif TOGL_EXTERN void Togl_StereoFrustum(GLfloat left, GLfloat right, GLfloat bottom, GLfloat top, GLfloat near, GLfloat far, GLfloat eyeDist, GLfloat eyeOffset); /* * Generate EPS file. * Contributed by Miguel A. De Riera Pasenau (miguel@DALILA.UPC.ES) */ TOGL_EXTERN int Togl_DumpToEpsFile(const Togl *togl, const char *filename, int inColor, void (*user_redraw) (const Togl *)); # ifdef TOGL_AGL_CLASSIC /* * Mac-specific setup functions */ extern int Togl_MacInit(void); extern int Togl_MacSetupMainInterp(Tcl_Interp *interp); # endif # ifdef __cplusplus /* *INDENT-OFF* */ } /* *INDENT-ON* */ # endif #endif lablgl-1.05/Togl/src/Togl/Togl.html000644 000765 000024 00000102010 12217024174 020032 0ustar00garriguestaff000000 000000 Togl

Togl — a Tk OpenGL widget

Copyright (C) 1996-2002 Brian Paul and Ben Bederson


Contents


Introduction

Togl is a Tk widget for OpenGL rendering. Togl was originally based on OGLTK, written by Benjamin Bederson at the University of New Mexico. Togl adds the new features:
  • color-index mode support including color allocation functions
  • support for requesting stencil, accumulation, alpha buffers, etc
  • multiple OpenGL drawing widgets
  • OpenGL extension testing from Tcl
  • simple, portable font support
  • overlay plane support

Togl allows one to create and manage a special Tk/OpenGL widget with Tcl and render into it with a C program. That is, a typical Togl program will have Tcl code for managing the user interface and a C program for computations and OpenGL rendering.

Togl is copyrighted by Brian Paul (brian_e_paul@yahoo.com) and Benjamin Bederson (bederson@cs.umd.edu). See the LICENSE file for details.

The Togl project and home page are hosted by SourceForge.

Prerequisites

You should have Tcl and Tk installed on your computer. Togl works with Tcl/Tk version 8.0 and up. The Mac OS X version requires version 8.4.

You must also have OpenGL or Mesa (a free alternative to OpenGL) installed on your computer.

One should be familiar with Tcl, Tk, OpenGL, and C programming to use Togl effectively.

Getting Togl

The current version of Togl is 1.7. Togl can be downloaded from SourceForge.

Mailing list

See the Togl project at SourceForge for mailing list information.

Using Togl With Your Application

There are basically two ways of using Togl with your application:

  • Link or "compile in" Togl with your executable or shared library. In this case you must call Togl_Init() from your C code to initialize Togl. This is the way the included Togl examples are built.
  • Install the Togl shared library and pkgIndex.tcl file (using make install) and then load it into wish using package require Togl. Then, before creating the Togl widget, call functions in your application code (also a compiled into a shared library and loaded into wish) to setup the Togl widget for the OpenGL rendering. Create the blank Togl widget, and then you're managing redraws and buffer swapping from the Tcl level.
Since Togl is compiled into a shared library using the Tcl/Tk stubs-interface, the same binary can be used with any version of Tck/Tk from 8.06 and up. See README.stubs for more info.

Unix/X11 usage

Unix/X systems only need the togl.c, togl.h and the public Tcl/Tk include files.

Windows 95/NT/2000/XP usage

Windows platforms need tkWinInt.h and other internal Tk header files. So you need a Tcl/Tk source distribution in addition to the Togl distribution (or copy over the various include files).

Here's the minimal way to build Togl with Tcl/Tk using the gcc that is distributed as part of the cygwin tools (Microsoft's compilers work too): 

VER=8.4.12
SRCDIR=`pwd`

cd $SRCDIR/tcl$VER/win
env 'CC=gcc -mno-cygwin' ./configure --enable-threads
make libtclstub84.a

cd $SRCDIR/tk$VER/win
env 'CC=gcc -mno-cygwin' ./configure --enable-threads
make libtkstub84.a

cd $SRCDIR/Togl
env 'CC=gcc -mno-cygwin' ./configure --with-tcl=../tcl$VER/win --with-tk=../tk$VER/win

make
The resulting Togl17.dll and pkgIndex.tcl should be installed into your Tcl distribution just like any other package.

Mac OS X usage

These special instructions are for building the Aqua version of Togl. Mac OS X needs tkMacOSXInt.h and other internal Tk header files. Unfortunately, the Tcl and Tk frameworks that Apple distributes are missing the internal headers. So you need a Tcl/Tk source distribution in addition to the Togl distribution (or copy over the various include files). You would probably want a newer version of Tcl and Tk anyway because each minor revision of 8.4 has many Aqua bug fixes.

Here's one way to build Tcl, Tk, and Togl on Mac OS X (assuming they are all in the same directory) to install in your home directory: 

VER=8.4.12

mkdir -p ~/bin
make -C tcl$VER/macosx install PREFIX="${HOME}" INSTALL_PATH="${HOME}/Library/Frameworks"
make -C tk$VER/macosx install PREFIX="${HOME}" INSTALL_PATH="${HOME}/Library/Frameworks"

(cd Togl; ./configure --prefix="${HOME}")
make -C Togl install

C Togl Functions

These are the Togl functions one may call from a C program.

#include "togl.h"

For portability, you should include the togl.h header before any other OpenGL header so that various Windows 95/NT/2000/XP stuff falls into place.

Setup and Initialization Functions

int Togl_Init(Tcl_Interp *interp)
Initializes the Togl module. This is typically called from the Tk_Main() function or via Tcl's package require command.
void Togl_CreateFunc(Togl_Callback *proc)
void Togl_DisplayFunc(Togl_Callback *proc)
void Togl_ReshapeFunc(Togl_Callback *proc)
void Togl_DestroyFunc(Togl_Callback *proc)
Register C functions to be called by Tcl/Tk when a widget is realized, must be redrawn, is resized, or is destroyed respectively.

Each C callback must be of the form: 

	void callback(Togl *togl)
	{
	   ...your code...
	}
void Togl_TimerFunc(Togl_Callback *proc)
Register a C timer callback function which will be called every n milliseconds. The interval n is specified by the -time option to the Togl Tcl command.

The C callback must be of the form: 

	void my_timer_callback(Togl *togl)
	{
	   ...your code...
	}
void Togl_ResetDefaultCallbacks(void)
Reset all default callback pointers to NULL.
void Togl_CreateCommand(char *cmd_name, Togl_CmdProc *cmd_proc)
Used to create a new Togl sub-command. The C function which implements the command must be of the form: 

	int callback(Togl *togl, int argc, char *argv[])
	{
	   ...your code...
	   return TCL_OK or TCL_ERROR;
	}

Drawing-related Commands

void Togl_PostRedisplay(Togl *togl)
Signals that the widget should be redrawn. When Tk is next idle the user's C render callback will be invoked. This is typically called from within a Togl sub-command which was registered with Togl_CreateCommand().
void Togl_SwapBuffers(const Togl *togl)
Swaps the front and back color buffers for a double-buffered widget. glFlush() is executed if the window is single-buffered. This is typically called in the rendering function which was registered with Togl_DisplayFunc().
void Togl_MakeCurrent(const Togl *togl)
Sets the current rendering context to the given widget. This is done automatically before the Togl callback functions are called. So the call is only needed if you have multiple widgets with separate OpenGL contexts. If the argument is NULL, then the rendering context is cleared and subsequent OpenGL commands will fail.

Query Functions

char *Togl_Ident(const Togl *togl)
Returns a pointer to the identification string associated with a Togl widget or NULL if there's no identifier string.
int Togl_Width(const Togl *togl)
Returns the width of the given Togl widget. Typically called in the function registered with Togl_ReshapeFunc().
int Togl_Height(const Togl *togl)
Returns the height of the given Togl widget. Typically called in the function registered with Togl_ReshapeFunc().
Tcl_Interp *Togl_Interp(const Togl *togl)
Returns the Tcl interpreter associated with the given Togl widget.
Tk_Window Togl_TkWin(const Togl *togl)
Returns the Tk window associated with the given Togl widget.

Color Index Mode Functions

These functions are only used for color index mode.

unsigned long Togl_AllocColor(Togl *togl, float red, float green, float blue)
Allocate a color from a read-only colormap. Given a color specified by red, green, and blue return a colormap index (aka pixel value) whose entry most closely matches the red, green, blue color. Red, green, and blue are values in [0,1]. This function is only used in color index mode when the -privatecmap option is false.
void Togl_FreeColor(Togl *togl, unsigned long index)
Free a color in a read-only colormap. Index is a value which was returned by the Togl_AllocColor() function. This function is only used in color index mode when the -privatecmap option is false.
void Togl_SetColor(Togl *togl, int index, float red, float green, float blue)
Load the colormap entry specified by index with the given red, green and blue values. Red, green, and blue are values in [0,1]. This function is only used in color index mode when the -privatecmap option is true.

Font Functions

GLuint Togl_LoadBitmapFont(Togl *togl, const char *fontname)
Load the named font as a set of glBitmap display lists. fontname may be one of
  • TOGL_BITMAP_8_BY_13
  • TOGL_BITMAP_9_BY_15
  • TOGL_BITMAP_TIMES_ROMAN_10
  • TOGL_BITMAP_TIMES_ROMAN_24
  • TOGL_BITMAP_HELVETICA_10
  • TOGL_BITMAP_HELVETICA_12
  • TOGL_BITMAP_HELVETICA_18
  • or any X11 font name
Zero is returned if this function fails.
After Togl_LoadBitmapFont() has been called, returning fontbase, you can render a string s with:
glListBase(fontbase);
glCallLists(strlen(s), GL_BYTE, s);
To maximize the portability of your application it is best to use one of the predefined TOGL_BITMAP_* fonts.
void Togl_UnloadBitmapFont(Togl *togl, GLuint fontbase)
Destroys the bitmap display lists created by by Togl_LoadBitmapFont().

Client Data Functions

void Togl_SetClientData(Togl *togl, ClientData clientData)
clientData is a pointer to an arbitrary user data structure. Each Togl struct has such a pointer. This function sets the Togl widget's client data pointer.
ClientData Togl_GetClientData(const Togl *togl)
clientData is a pointer to an arbitrary user data structure. Each Togl struct has such a pointer. This function returns the Togl widget's client data pointer.
void Togl_ClientData(ClientData clientData)
clientData is a pointer to an arbitrary user data structure. Set default client data pointer for subsequent new Togl widgets. Default value is NULL.

Overlay Functions

These functions are modelled after GLUT's overlay sub-API.

void Togl_UseLayer(Togl *togl, int layer)
Select the layer into which subsequent OpenGL rendering will be directed. layer may be either TOGL_OVERLAY or TOGL_NORMAL.
void Togl_ShowOverlay(Togl *togl)
Display the overlay planes, if any.
void Togl_HideOverlay(Togl *togl)
Hide the overlay planes, if any.
void Togl_PostOverlayRedisplay(Togl *togl)
Signal that the overlay planes should be redraw. When Tk is next idle the user's C overlay display callback will be invoked. This is typically called from within a Togl sub-command which was registered with Togl_CreateCommand().
void Togl_OverlayDisplayFunc(Togl_Callback *proc)
Registers the C callback function which should be called to redraw the overlay planes. This is the function which will be called in response to Togl_PostOverlayRedisplay(). The callback must be of the form: 

	void RedrawOverlay(Togl *togl)
	{
	   ...your code...
	}
int Togl_ExistsOverlay(Togl *togl)
Returns 1 if overlay planes exist, 0 otherwise.
int Togl_GetOverlayTransparentValue(const Togl *togl)
Returns the color index of the overlay's transparent pixel value.
int Togl_IsMappedOverlay(const Togl *togl)
Returns 1 if the overlay planes are currently displayed, 0 otherwise.
unsigned long Togl_AllocColorOverlay(const Togl *togl, float red, float green, float blue)
Allocate a color in the overlay planes. Red, green, and blue are values in [0,1]. Return the color index or -1 if the allocation fails.
void Togl_FreeColorOverlay(const Togl *togl, unsigned long index)
Free a color which was allocated with Togl_AllocColorOverlay().

X11-only Functions

These functions are only implemented on systems using the X Window System. We recommend that you avoid using these functions in your application since they are not portable to other operating/window systems (use Togl_TkWin() and normal Tk functions instead).

Display *Togl_Display(const Togl *togl)
Returns the X Display of a Togl widget.
Screen *Togl_Screen(const Togl *togl)
Returns the X Screen of a Togl widget.
int Togl_ScreenNumber(const Togl *togl)
Returns the X screen number of a Togl widget.
Colormap Togl_Colormap(const Togl *togl)
Returns the X Colormap used by a Togl widget.

Postscript Output

int Togl_DumpToEpsFile(const Togl *togl, const char *filename, int rgbFlag, void (*user_redraw)())
Generate an encapsulated Postscript file of the image in a Togl widget. filename is the name of the file to generate. If rgbFlag is non-zero then an RGB image file is written, else a grayscale image file is written. user_redraw is a pointer to the function which will render the desired image. This will typically be the same as the function passed to Togl_DisplayFunc().

Tcl Togl commands

These are the Togl commands one may call from a Tcl program.

togl pathName [options]
Creates a new togl widget with name pathName and an optional list of configuration options. Options include:

Option Default Comments
-width 400 Width of widget in pixels.
-height 400 Height of widget in pixels.
 
-ident "" A user identification string. This is used match widgets for the -sharecontext and the -sharelist options (see below). This is also useful in your callback functions to determine which Togl widget is the caller.
 
-rgba true If true, use RGB(A) mode, otherwise use Color Index mode.
-redsize 1 Minimum number of bits in red component.
-greensize 1 Minimum number of bits in green component.
-bluesize 1 Minimum number of bits in blue component.
-alpha 1 If true and -rgba is true, request an alpha channel.
-alphasize 1 Minimum number of bits in alpha component.
 
-double false If true, request a double-buffered window, otherwise request a single-buffered window.
 
-depth false If true, request a depth buffer.
-depthsize 1 Minimum number of bits in depth buffer.
 
-accum false If true, request an accumulation buffer.
-accumredsize 1 Minimum number of bits in accumulation buffer red component.
-accumgreensize 1 Minimum number of bits in accumulation buffer green component.
-accumbluesize 1 Minimum number of bits in accumulation buffer blue component.
-accumalphasize 1 Minimum number of bits in accumulation buffer alpha component.
 
-stencil false If true, request a stencil buffer.
-stencilsize 1 Minimum number of bits in stencil component.
 
-auxbuffers 0 Desired number of auxiliary buffers.
 
-privatecmap false Only applicable in color index mode. If false, use a shared read-only colormap. If true, use a private read/write colormap.
 
-overlay false If true, request overlay planes.
 
-stereo false If true, request a stereo-capable window.
-oldstereo false On SGI workstations only: if true, request divided-screen stereo.
 
-time 1 Specifies the interval, in milliseconds, for calling the C timer callback function which was registered with Togl_TimerFunc.
 
-sharelist "" Name of an existing Togl widget with which to share display lists.
-sharecontext "" Name of an existing Togl widget with which to share the OpenGL context. NOTE: most other attributes such as double buffering, RGBA vs CI, ancillary buffer specs, etc are then ignored.
 
-indirect false If present, request an indirect rendering context. A direct rendering context is normally requested. Only significant on Unix/X11.
 
-cursor "" Set the cursor in the widget window.
 
-pixelformat 0 Set the pixel format to the (platform-dependent) given value.

pathName configure
Returns all configuration records for the named togl widget.
pathName configure -option
Returns configuration information for the specifed option which may be one of:
-width
Returns the width configuration of the widget in the form:
-width width Width W w
where W is the default width in pixels and w is the current width in pixels
-height
Returns the height configuration of the widget in the form:
-height height Height H h
where H is the default height in pixels and h is the current height in pixels
-extensions
Returns a list of OpenGL extensions available. For example: GL_EXT_polygon_offset GL_EXT_vertex_array
pathName configure -option value
Reconfigure a Togl widget. option may be any one of the options listed in the togl command above.
pathName render
Causes the render callback function to be called for pathName.
pathName swapbuffers
Causes front/back buffers to be swapped if in double buffer mode. And flushs the OpenGL command buffer if in single buffer mode. (So this is appropriate to call after every frame is drawn.)
pathName makecurrent
Make the widget specified by pathName and its OpenGL context the current ones.

Demo Programs

There are six demo programs:

double.tcl — compares single vs double buffering with two Togl widgets
texture.tcl — lets you play with texture mapping options
index.tcl — demo of using color index mode
overlay.tcl — example of using overlay planes (requires overlay hardware)
stereo.tcl — stereo example
gears.tcl — spinning gears demo

To compile the demos, edit the Makefile to suit your system, then type make demos. The demos are compiled into shared libraries, that can are loaded into the Tcl interpreter as Tcl/Tk-extensions. Demos are started by running the corrsponding Tcl script. To run a demo just type ./double.tcl or ./texture.tcl etc.

Stereo Rendering

Quad-buffered stereo-in-a-window is supported. Quad-buffer stereo is only available on workstation-class graphics cards (3Dlabs Wildcat series, ATI FireGL series, NVidia Quadro series, and SGI workstations). Legacy support for divided-screen stereo on SGI workstations is available via the -oldstereo option. Developers for SGI workstations might also like the autostereo package to automatically switch the display in and out of stereo (other systems already do it automatically).

Full-screen stereo that gaming graphics cards support (ATI Radeon, NVidia GeForce) is not supported.

Common Questions and Problems

If you have something to add to this section please let us know.

Bad Match X errors on Sun systems

There's a bug in Sun's XmuLookupStandardColormap X library function. If you compile togl.c with the SOLARIS_BUG symbol defined (-DSOLARIS_BUG) this function call will be omitted.

Reporting Bugs

There is a bug database on the Togl Project Page. You may also discuss bugs on the mailing list.

When reporting bugs please provide as much information as possible. Also, it's very helpful to us if you can provide an example program which demonstrates the problem.

Version History

Version 1.0 — March, 1996

  • Initial version

Version 1.1 (never officially released)

  • Added Togl_LoadBitmapFont function
  • Fixed a few bugs

Version 1.2 — November, 1996

  • added swapbuffers and makecurrent Tcl commands
  • More bug fixes
  • Upgraded to suport Tcl 7.6 and Tk 4.2
  • Added stereo and overlay plane support
  • Added Togl_Get/SetClientData() functions
  • Added Togl_DestroyFunc()

Version 1.3 — May 2, 1997

  • fixed a bug in Togl_Configure()
  • fixed a compilation problem in using Tcl_PkgProvide() with Tcl < 7.4
  • new overlay functions: Togl_ExistsOverlay, Togl_GetOverlayTransparentValue, Togl_IsMappedOverlay, Togl_AllocColorOverlay, Togl_FreeColorOverlay
  • added X11 functions: Togl_Display, Togl_Screen, Togl_ScreenNumber, Togl_Colormap
  • added Togl_DumpToEpsFile function
  • fixed a C++ compilation problem
  • more robust overlay code
  • added timers (Togl_TimerFunc) from Peter Dern and Elmar Gerwalin

Version 1.4 — September 17, 1997

  • Ported to Windows NT (Robert Casto)
  • Updated for Tcl/Tk 8.0
  • Added many config flags (-redsize, -depthsize, etc) (Matthias Ott)
  • Added Togl_Set*Func() functions to reassign callback functions (Matthias Ott)
  • Added Togl_ResetDefaultCallbacks() and Togl_ClientData() functions (Greg Couch)

Version 1.5 — September 18, 1998

  • Fixed a few Unix and Windows compilation bugs
  • Added Ben Evan's SGI stereo functions
  • Multiple expose events now reduced to one redraw
  • Destroying Togl widgets caused problems, patched by Adrian J. Chung
  • Added Togl_TkWin() function
  • Updated for Tcl/Tk 8.0p2
  • Added gears demo from Philip Quaife
  • Added -sharelist and -sharecontext config flags
  • Fixed a few overlay update bugs
  • Added -indirect config flag

Version 1.6 — May 7, 2003

  • Added Togl_SetTimerFunc function
  • Updated for Tcl/Tk 8.0.5 and 8.1
  • Context sharing added for Windows
  • Macintosh support (by Paul Thiessen)
  • Tcl/Tk stubs support — see README.tcl (by Jonas Beskow)

Version 1.7 — Jan 2006

  • Added Mac OS X support
  • Enabled asking for quad-buffered stereo pixel formats on all platforms (use -oldstereo on SGIs for splitscreen stereo — C API changed too)
  • Configuring the cursor is no longer slow
  • Added -pixelformat config flag
  • Added setgrid support (unfortunately many window managers can't cope with 1x1 pixel grid)
  • Only free context when last reference is gone
  • Switched to TEA-based configure (instead of editting make files)

Version 2.0 — ??? 2006


Future plans

  • add callback command options for create/display/reshape/destroy
  • add vertical sync control
  • multisampling support (can be worked-around by passing in a pixelformat)
  • replace EPS support with TK photo image support
  • simplify C API by requiring callback command options
  • stubify C API
  • Use Tcl object interface for callbacks
  • allow (require?) private colormap to given with TK photo image

Contributors

Several people have contributed new features to Togl. Among them are:

  • Ramon Ramsan — overlay plane support
  • Miguel A. De Riera Pasenau — more overlay functions, X11 functions and EPS output
  • Peter Dern and Elmar Gerwalin — Togl_TimerFunc and related code
  • Robert Casto — Windows NT port
  • Geza Groma — Windows 95/NT patches
  • Ben Evans — SGI stereo support
  • Paul Thiessen — Macintosh support
  • Jonas Beskow — Tcl/Tk stubs support
  • Paul Kienzle — TEA debugging and patches
  • Greg Couch — version 1.7
Many others have contributed bug fixes. Thanks for your contributions!
Last edited on 25 October 2005 by Greg Couch. lablgl-1.05/Togl/src/Togl/tree2.rgba000644 000765 000024 00000201000 12217024174 020114 0ustar00garriguestaff000000 000000 no name@@@?0?;?000@0@1@116@@000@0@,)55@?,0000 @0::@600000*@566@45)0000)@1540@4@004@)114@1@004F@1145)000@ 0@0*104)000 ,@0,45@)000 @0156@:@00 @@0*4>@;@0@  ((64,51:@6>,>( (( ($6,*>54@1,16:5$JJ (6C(@E50(((*@@1,54)$*441,, $$ $ T@?*> fa>151:4*((((((( (;))$(*)$1E41,, N@((6?C)(((  L\lF;,*5 65WF>4;4*(450(((((0E$4*5N   ,?((((*(056()0,()0,0$W NJ,1*FcPFI;IZoV>@ 44C50((,?   L,1N@00:440>F>*((((>5,)( *5>Jp0**5?$1$(@(((,:6($,4(140)*,**)6O4* ((5;6456TP``:1F??400((((*6 (N\ $YVpQ;1:>;:*00450500(((0NPF*((*0550())1045) (0((()*(()*)(,,)***5*))*( (((0>0(*:5J:0444>:0((()),4$(E@? ]C;;;;;6NQPFZN551466J0((055*0>4( *>:@()*,,**( ** (5:1($($(*) *)***1*$)* ( ((0**(((*:*00*:5((((**5 FC66((IP51( ;;;;54oJF:4:5;:5T:***44*(:0( (*( )),*$$  ( (:0 ( *( ((((*(((0:(4:((((((()),FI0C66;$L;TY;6I5; ;;;;44;o{Y444:5@:054*(((**(**((( ( (   0( ((  ((((( ( ((((((*(((** *0((((((((()**4>4:,5a?5:bTEC10?L;;;;::r`>@>:00>0(**((((((((( ( (     (4*((( (( (((( ((((((*(())(*((*)*,*0*:@4445>Lz;;;;;5bwY>@55*(**(((((( (      (((550*( ( (((( ( ((*(((((((((((****0**4*04>@YmJ;;;;5Q]|J:40:40(((((((((((( *( ( (   ((4E0((( (( (((( (((( (((((**(((((((((((**(4*400555JN>0;;;;5Yrf>50*0*(((((((( (((((>:( ( *(  *:0(( ((((*0*((*(( (((((((((( ((((((*(05(000554:@4*;;;;;5qcE:4*(((((((((( ((( 05( (    *((000((( *4*((((( (((((((((((((((***((44*5445>55540;;;;;@?cmTEJ:( ((((( ((((*:0  (((( (( ( (* (  (0>>0(( (0((( ( (((*((((*(((00540(*40*444:F:5440;;;;;ENc|kT>@5( ( ((((( **J4 ((( *4(   (040 (( ( ( (((( *0(((:@0((**00004:@YE444;;;;;?IT|qZfV>40( (( (((EJ*  (   (  ** (*4*( (*( (*( (((( (( ((50((*0:5**0:NNoJ445;;;;;?FNJ`TT@:50(( (((5b*  (   >E>0*0J:( (( (*( (( (0@*(*04PT504:E:>>55;;;;;;;;Y`P60440**( (((((* *0r5    (Vc\F@EJ5* (*(( 0(((((((( ( (0E\:055@@YE:V\E@:5455;;;;;;;;OZo;;;C4**( ((*((4 4\::0    (( *NfbYNVE00((**0(*( (((((((( (0>550>55*4@\mm`@514:54;;;::65WF`PC>C0((( ((( ((((( 0\V>0 (0*    40 *JT>5@*4>4*((*04*( (((( (((*00**(((*FJN>EE>;;>EFE;;;6l1I\rE:;@0(*( ((( (*0( (>F4* 4F* (    :FF50**545* (*50( ( *( (*(( (****(((*5@F504:J@WTVVT:;?;m{rrV>I@F5*@*( (( (45 (40( (5PF4   (  0@0(** *5@* ((054( :@*( *4( ((*(( (((5NE505:E:;LFF>5;Ec~mYELwbY5*@J0( (5(((0J*4*0*(((EEmpT   0  ((  (* ((:TP0((044(( ( ( 5J( 0( ( ((((*(((((((0>>005:::66;YF;;Ycmkf`bY:4@P@0( *( (0VFY@54((0EY{Y4   0J  ((4(  (0JJ0**(* * ( ( ((((0*((04**((0>*0>P:>5;lyE;;vbprqbm`@:450***(((( EbmJ4(*EoY|:( (( (0(  4: (>E44(((   ( (((*(((5\5*))),*4EP@55Nreb;;v|Q\cZI@T:00*0 05((( (@rY::\JE:(  *((( *4 ( 4@>5*(  ( (((**(*4@45,))0E]T>I45Lq@;;:PWmfbLcJ40*0*(>Y0( ( (>TfbbY>*(( 0(  ((((    (*(  ((( ( ((4*0*05>((*))*4`bZ@EFQY{:6;Z\~flc>(((*(0FE*(**( *>mTE* ( (  >J(  ((0     *0( (( (***045>4?;((*40@>C6JYZbJ@55;n6|wbJTmVE((((0:05**(0( (((***( (((( ( FT( (*5(   *4(**( (((((*04:FF5(,@?*0@`@554NfkZWC45565p~?5?apP@50 (:((( 4*(((54(( (((((( (( 4EV* (((*( (   ((*5TP0 ( ((((*0:@>P0(((,,(4;@514:n`x\|J66614ye>>PcP\@50( (*( *5@4*J@ ( *4( (( EV@ (0 4*  (:0(( ((*>TF* (( *@TTF>*((((**F??0*5:IVf\rN:::vY>PN@5:40(((((( (4@T*N> (0*(( ( ((@YN   ((   5N:0( ( (( (4( (* (0>N\T>(((((*5{F>0,1@PI]P{Z445:@I1JE:4045(*E@0( ( ( 4J(FE (  ((5J5(   (* (( *>F5* (((( ( ( ( (0>@4JT>0*((**EW464,1;IV]Q@FV55;:NZ154040EN4*P\>(4b: ((05(*5(  (:\5 ((((( 04 (( (( (0@E( (( (((( (( ((((0::(4:*50((*,,5050:?:OhF@:ozJ6;:ZF504FV`00EJ4(*cV(*0@N*0N0  0F4 4:E4:@(( >@( (:@@( ((*( (((((((**(**00*4***4?4;1*,;EI{E:::;CZ6@YC;44;@F04VN*((NV054:4((V:( (( * (*( PfN**0( *04*( *@0 ( ( ( ((*0*(**((4**05001>J;C?400IO~E>LZ:cZ5ZnJ50*04E5>T50*(mmF:E( ( ( (( (@0 55( 5bN( (((05((*(( (4(  (((  ((*0*(((((***4@106CTN;@>>1>NF;YZVCI6h\qaO5EV>@4:F44**JbWN:( :5 (( (>0( (0VP0( 44(*(((@N4(*****((** ((05( (*(((*(40((:4*0015;QN::?4C:NEO]wq@Lz|6a\aphO0\\FV:0@\E45:cc{>*( (:5((( (( *50(*4\Y4  >:( (( Pb@00(*00500*(( (((04 (((((*::0(***),4>:::OOJ5\F\qVFlVZk;IqQITf(Jc@`E04oP**4PYE4((((( 4:((( ((*04@4VN@(( :E*0 4>:*0*0500*004( *0*( ( ((((((*0:0*4(*),1:;:ECOP:?CEVoT?OL\JqILLIEP05|pfFEJkP*::\T>40((( (>*(:0( (((*4@:TFP*:V(*0 0((**05404*E>5*55J5( ((*00 (4((((((***(0*4J5((0416056CF::>]mECOFZCJ?Ep?]p60(Pk`@5>4:Vk`@:5***((*(( (JF4(((((*0:JEE*Ew4 (5EN@4FE5>cmT5:\pPF* *4**(((4E>*(((0*44(4:E\>0*5F00>50>:55;TV;JNQ:6?L`r@>(0{mOT0**4N`\c\m\EN**V>(( *40*(((0((*>J4(@*(4 *(>fkJ5445PwyVEFybF5*((00*>>>JF5*(*5:55:(0:V\:**0:>444::>>?>;booOJl;::wTTbT@((wb:555NTb{\F*0@>*(( (***(**4(5c5**4 (4*(0(4YkYJ:>F@fpfTcp`bJ>50*(0*ETYN4****>N\F5(*:N@0555JPE44>FE>JVO@]|lEPJ6:CNeVPrC0(4l~V@TJN\Yk{FN>:5** 40E(((04*4(:rN*04 (5:54 4fykVPTk{yocVPbTF4:504F`54@E:4*0:YcV4(*4::0@F@fcT>40>:?EJPJE;IOEOrk;:11YPC:1*4akY{TY00`w|mw\4 (VN*(((*0*((0Vm0(*:F004* 5o||wwpkYbkF4\pV55:JT`N(*NJ@40*0Nof@54EJE4>F4Ybk`405@bTEFJ>6PZTWO|:;:4?lP;0)*0FrWpbP0(04YNPTJ4(** \` ((((*((*:F* VkJ4(@( (>@V\kopTNN`@0VrF5:PmP****4@55>>JVb\N0F\`>NN:JPY\;:@VTEFE>@PVqqal6;:510J0000:y\pJ:(((((0@:P(04 ** (((((**((0*(45>5(>0 (*ETobVJJ@>05P{yJNY\bJ040>>5@EPVPJ@@4(4Tf@JYJVVbL;F@>O:;@:FFLJV|6;:p11ea@>0VmzZcJCF4:*0(((0V0(( ((((((0*( (4EJN@:0*(   (0>`rmF:545VkN\{cJ>44>E:0::4@E:000*(>YNP\@PT`C5>JE@;5::JVPaYL{F:;{n4:V@YFN;,*4>:@40((( 005( (*(*(((0* *T{T@:0(  :PTmfJ@4>VrcyTJ4(*TJF400*4>N@>:4*4YTT:>`VkPEOcf\ZE::YVTZlk`6ww\>;610)*5>`J@4(*0 (0 ((4*0***:0 4pyo`P4((*   (*>b{YT>>fkV>E0*:\VV55:>>>P>5NJ5(54>5PNF`TJcmcNTTE>JNTQN]nk4{\oQ;4*)*(((050>V:04*0 F0(0@((((*(0N>00( (:yb:50*(* (( (0kkJ>N\::::@J@F>4:@NFFV>4FJ5((5E5VYPP\bc\JT\mkF>JTrhevhl1k~w]`TF@4****)**F4:NF(*(( (kF04T0*((**4wT0 :PwT4:45:( (( ((0*fNFbPNPPEJV@4@J>FPF5:P@>N@4((5F>TbPE\aN>EJ\fFCOPwnzF66{@YJTEE55F44::@>F4P4** (*04* J@0(***4J5( (45*:F>5YY0  ( 0N5FT``NP`pcVVP04F`TPN40*4>@NF:4504:E>@E:CFJCJEN@@CIn]`c6:\NFNTOO`\PFNJYJJ0:05fT(*(0@* *:0(**((4:5@**((*(**05JYw>   4YfJJ\NcfbJNTTE@>4(0@cpVV@>0:PFJb`P@05ETJ\V:J`TVc@::>@Vw1P4|W:cIJ{P;Coko`EE:P4((FY:(( EJ( ((*(((*((*4f@0((*( 0>54( >N`YJVE>VTPcV0:0*545Nwy\NYPkwcm`@5bo`kP>TcccfP>FFQ4x4pmk]NoqC6>OYCzrE>P>6FTJ(JmE(((4cP5(E:00*(**(*5b{oJN:*(( (0:0 ( 0*PTN`P@`fF4*>T>5PE>JPkyJ>PopEYcokPJrcro|r\oYYqoaW4hOV54]cZ]WC1EpoP>V`5>fF**0:cT0(YV:5*(**0FcPm`ok0 ((*( (((( (Tomc\fN4N\4(@wJ>NNJN>Pm\J\ybTbPb@FVcr\cVVf|rqlTkpOVI56>6@::?QLCC1:PwWYPP>5NJ500>\Y* >T@54*(05\mN>f{N:@((*(((5( **((((JcJbyrE((4*4ffcfcP5@bkowE>>:00FJJN@VmwpkYVrmlcz:656>L|Z?m\zV>EFTac54>4:4*0>EE* *:>44*(*JT:(:{kFF(0T0( *( ((((( *0(TPV:**5*4crrkfkNETprrm::>:40ETYbNccYTO{n\r?6;:66>l~ff{NPFCL`Y5@:044040**(:>:(((*04:E*(:myY0(050((((((((((( *005>* (E40EPJ\ob\JNVcwykc@@@:>4@>Nk\Vbro\bPrxxfoooohV5:::;1CYz44NYc\TQ```o:@J:*E40*** :V5((((4N:(((4@T>4*40****( (*((*(((0PY\* (@*5\>Jb`cppormpyk|E0J:5@JENbpYTmll|rmolnwlla`::;;NT\{::6OlobY`YT\PY:bV:>J>(*TE0((*5f@((((0F@44>50**0((4F*5E400>Yb> (*F\``mF@kpwJNV`Tm@:YFEFFJYpw\Pc|{xqbyry~mxP6;;o:{`|rY`Y{YTFfP>Tc:0T>*(05Em>5*(*4F:5TF:4(>4*5*>*:N544Py0 0*(5>0@@0>:N>:J?I:>LICC\NNV|mT]lkbefkoyoahV;;;::;;~b@lYeYerrfNycTY:5bN:J0**:JPY44*((*0(:T**0*fN*0(444E540Jb@ ( (*:0(NP@5((0;I??6NT?4>Q\PTko\VfLO~bYeTe]waY]`;;;66;5bVWrn\]ONcwwFmFT>5NypP>co|P0*>oNF:50((*((*40(0::4*4(4J5Y>05:( ( (**>0*0500**4Fb]L?cP>:CNZcYfcVPP::ZZEJ`f\Lb;;;;65:55656Tf]oc?:5J:Fcr`w|{JF:Fr4(*>5*000(*:*(*54*>N*0*4* 5*EV5@c00*4( (055***005446\`cNPmLCQkbhv\ZVbYCCWqTQWpwCN;;;;;:6:;;NlJlkQLFrF\rc~yFEF0P\E4*(4N0****N`:(*0:>PfE0((((**Jc>5>*F>5*((*>5:0*404E5>VcFP`Vh{VFYeWeyWYVppaZoxy`\lzY~f\e\;;;;;;;;;;~fZTfeY\mzN]w\P\NJT>Vk:540@JFP@@kT500450>`k4>:*5>5Epf>*@TF*(((0:5:0440**@ye?N\YxZJ\QWekhe]cZOqc{O?ELL\wq;;;;;;;;;;::15OnxqO\rqqw]Qbvpmop\VVcr>>@45kPN|V\:44@5( *5E44>5@555w{E:YoJ0>(*:PF:*040**@mO]{Vb|peV]OWh`lmJV\whal?Wnao~Nqh;;;;;;;;;;::Q5LC\zF]rWI;>J>VTTT\k@:J@:@:5V0*4@F4*(*F4*0EEPJE0Jk45pN*4:ENfwr40544005@Nw~rbpnhV`hcYTVZ?CLEJp|e>>4loVZO5;;;;;;;;;;4IFQ\hxQWlOOC50?{xc`I>cJ>JV{rTEo4:@TE4:05*F545kYbff0*0(*FcJ**4>@@V>04440?EETTfknaNOpzZPZ>OLEOkzlFIlfq?555;;;;;;;;;;5kmynm?6WLF:5;CWyyry|`>46;>@bmYYm`4>PTV:4*4*(*5*PTPP>(*(((*******00>*0000*;Pwmy`zzYV|PVyOZZmfynO{x55;;;;;;;;;;;;k5nY>6;??FC:QkxkxoNJOC?LCOPTrk\cobF4T\\@E:@5**((0**(((0((054455*04550044445TrYnZhrr`f]\\OrfffVfWY\::;;;;;;;;;;;;;;;;;;c::CeIr`O\lQZxpFJENJpbk\mycNTN>N@5JofPNE@E0*00(((((*5>50:E>44*55E54Pk@:4@YmVNro|vv`vnVq|QTavN;;;;;;;;;;;;;;;;;;;::T@vfWZcpTxponrNYJFYwrpJrVNyE:mrP:>:>54b`(((((*YY::4FPE5:04>45\fN>5bVVO?@P~rk`TpTEO;?O:;;;;;;;;;;;;;;;;;;;:56~lpYTI>Wna|bJFJFVoNFcoJc{{VE``>F:*05Y@((((0:J:>TE5JE0:>@>**F@JVJbVJJ?TNoko\IJY>N?5J;;;;;;;;;;;;;;;;;;;;51YWpw\EPrr`Fc{YrpOTJETcyNTPNboNY`FJF5>Yb>(*T4 *(0PN>0>TF5>:(4\V>054:JbPw|ECC?m|~z{llk]v~bP\LmLO|`a;;;;;;;;;;;;;;;;;;;;5\JJam``wJ>CIJ`OEac`J`JIZfY`rkoyYmk:40>F\E((@0 *4*>E5:FE5E44**VJEP5@NE5{YYLY~parYEObW]zb\xob;;;;;;;;;;;;;;;;;;;;;Nok|>5Pl`ENQTeoQYTY\Tc{pooJE55::045J*((**0>05>5>@*44*To@:`5FPE55`mlQJO@?>l|~WNEJpInnbbZZ;;;;;;;;;;;;;;;;;;;;;;WrFfywwrcCFNPcbbW{pTEZykpw]V5E4@5>J`4**(44F455*045045JkV545TP``p5vnlCIEWICJPoYnQfxbN]f::;;;;;;;;;;;;;;;;;;;;;;WamPTYEaLJJ\J@FJTbn]rYN?bcw|ooC@O5Y>E5*5PTP@**:F5:5000>554\bf54@Vc::5511\Qff@5FeFP]Lrln6:;;;;;;;;;;;;;;;;;;;;;;;;;5vpnfPIIN\hL>E\|YornP@b`r{ZJcv@?T:>FF5((0ENF540400**4:E5:4FP`>5@Pr]oTYYY{nCEpO\I>E?wvP]{c@J;66;;;;;;;;;;;;;;;;;;;;;;;;;54{lFIh]poV?@?chbfkOYpc{xL54TVPq@J:J5**((0:4*4:0((05F\54>ETV:>@Jp{Tlr`5`|CzfJpC?;;55;lCW;44;;;;;;;;;;;;;;;;;;;;;;;;;;;qlEV{nx{I`cP`q\hOETCVeJF4;:N]aPPNVV5ET0*4:04>:0*5@@NF@>NTJE>N\TokbqbbT4{r;JJ5\QF;;;;;:6W;66;;;;;;;;;;;;;;;;;;;;;;;;;;;lcwhZZpok\YNb\@;>CLTkoZ>OFeE*:`>*54:Yc@04@J>NYJJVobYJmkaZZhcWO]O4YY``FF;~NF;;;;;;66|6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;c|ofYQbk|vrf;?`YYkaq{YO:6;:NI:@Nf@44:FP@5@@N`wEPNYpP@QymaL?WcFPYY{{`;`;;|@;;;;;;;:::6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;c\PVVTZlhCCF\yNqkar\?C;PPmm5F`>44>@@:@FcrcPbLLvI>QcezN;z~r`{`{{Y;;;;5;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;r5|xyLb|qy~~{Iq\`ha~~ll@ErnwPc\TEJF5:FPfF>@Nb{kmNPlPW]YT]mIl``F;;;Fn6;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;6|cԝrcYwb6C{EPPYVLYWWPO`F>:N\T::5:`bkNEPffywTLo\\hT|OPlmrqY]`;;;;F\lEC;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:56;y˼aT]]J6kbLcWvzqNPhbkzxxWw`VP@:IT:4>Jk`hfENf`VT`NTcNoQLNYWWOTf;;;;F\C;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;65::rcFLT\E{QQZqPP~Wb|LVbOJP>cfJ6FbrEL`TTbm`rLV?Cb;I`C]vYZx;;;;;@I]O;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;66:rQqc\|JTToWbyCJ{NJEw`wpZ@FP`cYPbze?E;JOV@pmw;;;;;;;;;;;;LYJ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;66;QP`4WLcZ]T::PheF|c`TLy|e>@m|kOFPTNbewZEF`kYLrw;;;;;;;;;;;;;;;JJ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;l:LZzxwxm66:NkJNovfbVLVpL45x~Y`TL@;?JPTprpofllw;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:6E?x64~lec;::;;;?@WZeTVopNOJL:4>xWWQ;?LYfcVfl~f;ww;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:6Wzz:4hac;;;;;;;5f;E~VTmTEbP;>6CavfzfJ6{TOraavY;Z;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:65NNyL;;;;;;>@{Yk`TkYC>`TEPIPF:a\J@bn\Y]lx~vohl;;;pN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:55;::I`]Y;;;;;;Yy`LYwP>Y|YVPW;4>pQFEao\WTbeekYC;;;;;ZfqN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:6:;::`TL;;;;;:FvevV?]wVVY5@>:bpofQcZm\Vflox?;;;;;;NqN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;LYL;;;;6:;F@Wlvo`WWT\yh5?J]PcF`ocW]|r:;;;;;;;;;N;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;>;@amVoV\wCP{O46?wozW|ObVZoY;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;C@IaxϲVVwJPLPJFONqycJoOblcJWWY;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;6@eeoO~VQN\yma\nf@EbmyVCnT`kLN\o;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;::Pbe]OQYJTwx`oaIN|{yxkJCwOҕY;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;yknlf\QLOhcWQo~p{{JwJ>c\Yn;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;6?xxxZQNWwwpfWQl`axWYETck]n;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;66|pfYWWˈlT\h:]JkYlfmZC>Y;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Vmzwʉ~{oYY6`CkweQ]hrY;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;:`wmclfl`eavONQ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Q{y]OfLLTfmlwoTZmJ@yC;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Qxw{wyc;@Noa|pWCPNC@IC;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;]|xL;;El;>@E:6:;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;JzWYL;;;;Nl|L;::;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      )         $$   ,,  $ 0* ,)$ (JI(0>F$0FE50(((* $  *4$$$ )*(*$ $ PC>4> TV>5;:>4*((((((( ($ $$( ,C (( O>**;?@10),,()(  FWcL?11:  :6F:4,0*((440(((((4C*5*5N  (,?(( (0(1,($ $()554)W(NE044F`PEE>I$VeO;E(54I>0**4@   I45?5*(0*00>J>0(***E:1, (5:Fc40,>@(5)(@((($;;($ ($ $,1440*:P1*$((5?;5:>WOc];5PII5440***4? ),Ya *TPemF:46;::*0*5:4:44**(4PYP0,)*455*,,(4441, (*(((($(($ ($$,144:1,04 (((4@0*0>>V>455;F@4***004;),OIF($$eF$ ]]]]]TJQOEOJ5445:;F0*(0>:44F5*(0@@F,00441,( $$( ** ( 5:1($($$ **,4160)00 ((((000***0@044*@:((**11>$ NN;?,))0OV;:*$ ]]]]NFbfJ@:5:55>:N5**0:>0*>5*( (*(()04*)( (((:0 ( ( (*(** ((((**((4:(:>((((((*),4LJ0F6>@((J?TW>>N>@)(]]]]II]YpV444:45:4540***40(0**(( ( (  *( (( (*((( ( ((((((****** 00( (((***(,0*5@5?5>]?::bTFC66EJ]]]]YYmm`@F@>44E5000*****(((((( ((      *50**(( ((((( ((((( ((((*0*(** (*(*000*0*:>445:>Jp]]]]]Ohop\@@:50*00*(***(((((((( (*(  (  (*:>4*(( (((( (((( (((((0*****((((((****4*04045@>V`E]]]]LWb{N:54>55*((((***(((((0* (*( (((( ( (  ((( **:J0*(( (((*((( **(* ((*((00((*(( ((*(****404445:5EJ>4]]]]L]xkE:40400*(*(***((((((@>* (( (( (( *(  ( (( ( ( 4@4*( ((*(040((0*( (((***((((((((((***45*0045:5>>40]]]]]NyfF@50***(((((**(((*((4>* ((( ( ((( (( ((   **(540*** *50***(( (((((*((((((*(***(*55*544:>55544]]]]]\JboVNP>*((( ((((*(((***0@4 ((*( ** (( (0 (  ((5EE5*(((0**( (((*((((*((*00440*0540445:E:5544]]]]]ZOe{mY@F>* (( ((((0*(((0*N5 (((((( ( *4(   ((4:4 (((( * ( ((((( *4***>@0****44004>@TE545]]]]]\YWyp]k`E:4*( ( ( (*(((0(FJ* ( (((  (  00 *050( (0* ( (*(((((( ( (*:0((04>5004:NNkF44:]]]]]\YONaVVF@>4** ( ((((((**:`* (((  EJ@404T@( (*( ( (*(( ((( (4@***45NN545:E>>>55]]]]]]]]\`V?4::400*(( (**((*( (*4o5 (  ( *`k`JFJP:0(*0**( ( (( ((0((((*((((( (0EV:05:E@YE:VY@@:55::]]]]]]]VQ`o@@CI500*(((((00**5( 5Y@>4 (( ((   ( *(  (0Pmf\PYF45((004**( (((((*(((( ( (4>550>5:45E`kfY@55:>>5]]]WTOIWJ]QICI50*((*(( (**(*((5c\F5( 040 ( (  ( 50  0PV@>E05E50((0450*(( ( ((((( (((**04*****4JNN>@E>??@FNJ]]QIn@N]oJ?@F500*(**0(((04(( *FP>4( (:J4  (  (@NJ:400>::0 ((4:0((( ( *( ((*( (****(((*5@F:45:JEVQ\YT@]\OovwYCJFN@4F40((**((*5:( *:5*((:VJ5 (   (*  5E4*40(4>F0((*:>4*( :>*( *5* ( ((**(( (((5N@50:>@>@NJJ@>]PknWLOyk]@4NV5*(*>***5P04*40***EJorV  (0  *(*( (*  ((@\T5(*4:5(( *( ( 5F( 4(( (( (*((((((*4@>00:::::;@\J]]]|{alkkcf`@:F\F4((0*((5bJ\@>5**4F\yY5 4J  *05(   *0PP40000 ( (( ( (((*4**(04**(*0>*4@N>@>@orF]]qanpncmcJE:>500000**( ((NkoN:00Fm\y>((( ( ((  ((*5* 45 ((EJ:50** ( ((((*(((:V50,,0105EN?>>Prb`]]qyT\c]LJY@5545*(4:0**( ((Er{\@E`{NJ:* *(((( (  (*(((( *0 ( 5FE>0* (( ( ((*(0***4>450015F]Q@I;?Qr|a]]FTWlhcOeP55050*EY4(((( *FYfcc\@*0*( (( 5*  ((**   ( (*0*(  *0(   ( (4*0*0::(**),45]]WCJLTawOO]ZZzflkF0**404NJ4044* (4FmVJ0(((*((( ( EN(  **0    ((( 04*( (((( (0*0045>5??**044?>E;OZZaWVIJ]nLnbIVp\J0((04@5:40*5* (**(*00* ((0***( *( (JV* (*0:(   ( 05***( ((***(*45>JE5*,C@00@\>55:Neh\]NFLOQLpC:Ecr\JE5((*@0*(((50***>4 ((( (*****( ** :FT*  ****(((  ( ( ((0:TP4( (((***4>@@P0**(11*5>C655>k]xY~ZOOP@CyhC@TfTbJ@5*((40( 0:F:0P@ *(0:((**( ( JV> (4 ((5*   *>4(( *(0EVF* (( (0EVPF>**(((*0E@?405:JTfZn`QPTrYCVTF:>:5**(**(( (*4EY0P@(((4*(* * (((*(J\N( (  *( (  :N>4* (*(*4* ** (4@PYT@***(*05rE>016EOJ]Q|YIIPYQJ6PJ@:45:00JE4((*((((5N*JF(((( ( ( ((0*>T@( ( ( *0 ** (0EJ:0(((((*((((( (( (4>@4JT:4**(*0FQ4;54:@LWZWEFYJQ]CO]6>55:5JT:4Y`E*4b>***4:*0:* ( (*@c@( (*((*(44(*( **( (((4EE* (( *(*((*( ((((4::(4:*54***1,5155@E@QeLE?oyYT]J\N>4:PYb55JP5*0kY(05FN44T0 ( ( ( (4P:( (5@F5:@** (EJ( (((>F@* ((** ( (((((**(*0***00*400*5@5;101CILqE@@?CEkPV`L@:>CJP5>\P40*VV5>:>4((V>( ((**( 4( ( *4* VfN0*0* (445*((( 0E4( ((( ( (**040***(*4**05444?L>F@555JPzE@JW>ckN]oO:445:N>EV@54*kfPEF( ((*((((( (F0 *(>>* :bN*(*0(4>*(*((( (:((  *** (**040*((((*004>44;EVP?E>?:CNFEYWVCLPk]p{hT:J\EJ;CN:544Nc]V@(( (E:(*((( (J5* 05bV5( (:4(0***EP500004***00(( (*5:( **(***(40((:400046;QP;;C6F>OFP`onEOz|Pa`bnmT4bbP`@5E\F:>>ccr@0*((( (>:***((( 0>5*5:cY5(  E>((*((YfE45*040>450*( ((*44 (*((*0*>:0*0*0*,4>;;;QQO:]L`rTJ|nTYmVYrWNTf0PcFcJ55kN04:VY@5***(( (5>***( (((05>J:bTF** >F04 5F@4404:444445* *40* (( (((***004>404**),1:>?FCQT?EEIQpY@LIaNv\WPOJT4:ofNJPmP5@@`V@:4***(((*@**E:0(*(04:JEbPV*:T(44 4(**05>5450J@:0>>N5( (*044 *5*((((*000*444N:*(4556466FI>>C`hIFQFZJOP\oIarC5*Tk`F>E:F\m\E@>444*00*((*YP:000*055>TJF0Fo0(( ((>NVJ:JJ>EkoY:@`oPF0( *500*((5F>*((*44:5*5>FY>0*>J04>:4>:::CV|W@QQTOL\WcrJC04wlPT544>Tcbmbp`FT00V@**((0:5540000*0EN5(F**4 0*EprT>55>V{{YJPwbJ>0(*440EE@NF5**0>@:>>*4>Y\:000>>445>>@>EC@bloQPmYYYwZ\m\J0*pcC:>@TVf{bP45FE0*( *040*045*>f>4*5 *50(4(5bm\N@FJFmrkVfr`cN@:40(44NV\P4**00ETbN>*0@PE0:::NPE45@FJ@PVPC\xkNWNTYWQe\TwI505lzWFYPV`YkyNTEE>40(50E***454:*>rT444 *:>:5 :k{m\TTk{wmcVTcVF5>>45Jb:5@E>504@`kY:*0:@:0EFFcbT@54@@ELJPNE>NOITwh~]WE?\QF>:45`ob|\`54br|ryb:(((0\N0((*444*(4`p5**@J5450(>r||yypk\cfF5`oY>>>TVbN*0FJE:445TpfF:5FJF4@F5V`f\54:EaPEJJ>;PYVYP{|T]VEFmW@5445Jy]pn\5*45YNY\J5*00 (\\(((***0**0@J0(\fP:*@( (@EY`op|pTNJbE4Y|pJ:@TmP*0005F::E@JYf`N4F\\>TP>NPVYC>EYQJFE@@PZoo]lP]VI>?O545:@y`vV@*****4@>T*44( *0(((****40**50*55F>*>4( ((0FVofYNPFE4:TypNP\`cN454@@:FJVVPJE@4*4Pc@JYJVV`L@NE@P??@>JFQN~WQ]Wp>>faFE:Yoz]cJJN>>05*(*4V50*( (((((****54*((*:FNTE>00* (4EcwpN@>5>YkTbycNE45@F>4@>5EF:444**>YPT\EPTVC;>NFI@:>>NVTb\P~YWYyh?YYI\OVC50:EEE54*(*(45:( ((*000**0:0((0YyPE:4* (>PTokNE:EVpfwVN5*4\NJ:554:@NE@>5*5\TT:E`YbPEPec`ZI>@YVW\hlkLry]E@?;614>EbNJ:*05((04( ((*0505040@4( (5oyo`T50(0( ((0@c{\V@EkkV@J54@b\Y>:>E@@N>:PP:*:5@:VPFYTNbh`PTTF@JPVVQhwnCy\pY@:415,*05@5>YE:>45(*N4*5E((*0004P@450 (>yb@::4(*( (( *5kykN@P\>@>@FNEJ@:>@PJJT>5NN:*0:F:YYPN\``VJV`mfJENTwkozmo?m~ra`WLE;4410,*4T:>NJ04**(*kJ45Y40*004:rT0 ( >TrP5@>>>* (* **40k|NNbTNPTFPYE5@NEJPF:>TE@TF500:J@T`J@YZN@IL`{bFFOVwx{VJPzE\NWIN>@F;:@@JFJ5T:4*((0450*TF4*000:N5( ((((5:0>N>:`\4( (( 5T>{FVbbPP\fc\VT5:NbYYP:40:EETJ>5:45:F@EE:ELNEPJNEEFNwaefNY\OOPWOO`cVNPV`PJ5@4>fT00(4F0(((4>5*0000:>:@00*(**000:P\w>(( :`fNP\PfkbNTVNEE@5*4Jkp\\F@5@TJNb\T@45FVN\T:F\T\fE>>EEVv;Y>~kYcNL{QCFpkobNJ>P:*(Pb@**(F|N0***00*000005k{F4***(( (4@:5*(( ( EPb\PYF@YVTmY4@40:5:Tyy\T\Tmwfm`@:`m\bJ>P\\ckT@IFT>y>rkf`]ppJ?ET\Iz{J@YF?JTJ0PwN00*5fP>0N@55**0004>cypNP:**( (*4>0 *( (( *50TYT`PEcfN50EYE>VF@NTmwJEVo{mET`fcNJm`mm|p\kWZqqcYLhTW;;`b\b`F:JrwWEV`>EoN445EkV40c`E@4*005Pr\o`of4( (0*0*(**(((((VrpcbbN5P\5*FrP@PPNP@Vp`Nbr`T`P\@FTb{kY`VVh~wonhWloTWYPPC;E>?IVQJJ:>Tx`cVYJ@TP>45Ec\0(E`J@:405>frT@kyN>E*(0((*5( (00***(JcNc{oE**54:mmckcT>Ecorr@>@:45NJJPETcombWWwmkey~YPPPCN|ZEney\EJTYfk@>J>@:04EJJ0(4@F550*4NY:*>{oNJ*4T0((4*((*****(04*YPV:44>4:fywof|kNJVpryk>>@:54JVY`PcycYTP{m]pPL]WQTCh~kh|Y`PNQ``>J@5::44440*@FE0**05::E0*@p{\0*5:400*0*(*(**((4:5>E0(0P55PTTbobYJPVbrwo{fEEE>@4E@Pf\V\mk\`TwyykppppkZIYWW];F\zFFTcmaYY```p@JT@4F54450(Ec>0***:T>0*(5ET@50:54400*(*0(*00*0:V\\0 *E*@kETkbfpomrkr{mF4N:>EFETboVTkek{pmqhkomnckVY]]LV\WYTOlpeZ`ZVb\\@f\@@TE00\J4*04>mE0*((4PJ55@@4004**5N0>N>45F`c@((((00PkkfoJEkp{rNP\aWoE;]FFNFJ\moYQe{yrnazqwzpycT]]pW`~qZ`ZYYNcTEVf>4VF40:@Nk@>0*0:P@:TF>:*@54>0J4@T>:>\w0((((400>E5JE4@>PE@NFL>@OJIJ\TPYyfT]k~keffepyqell]]]TT]]ykIpZk\mzvfTwk\b@>fVET:40ET``::0(*04*>T0455kP45*::>J>:5Tb@((*(((*0@50TPF>0,5@JE@;TVC;@TYNVkm\YkPTa\fWcfhbfk]]]NN]LbW\wk]bQTewwFkJYE>TyV@kpT40EoPP@@5(*0**05404E@:4:05P>\@5@@*((((((*04E405:54446Ib]NEfTE?EOZb\f`VVT@@]ZLObp`Wq]]]]ONWLJC@JYf`peFC>PEPkyf{PNENp:04>>4454*4@0**>50ET454:0(:4F\>Fc0504*((*5>>44454>::?bbcPTpQFVkblwZZVe\FJZpWTWmvLh]]]]]YQW]YQlOlm\YP{Tf{l~|{NJP5\bJ:40:T:4440Vb@*05@ETmF40*0004NfE>>0N@:0((0E>>45:55N>F`mJT`Yn{YI]h]hyYZWppb]pyyb]my]~h]op]]]]]]]]]]|h\Vpl]crzVcwbTbTTYE`mE:>5FPNYJEkY@555:0Eck:E@4@FENymE4EYJ0*0*5@>>4>:404J|mETc\z`O`Y\emlkah]WpcxQFJP~O`~]]]]]]]]]]YYE>WozyV`{wppbWex{rwpb`\mrEEF::kYTY\>55F:*(4@J::F@J@@@{{JE\pN5@00@TN@45:444FoQc|ZcymkZ`V\kbnoQZazmcmFZppo|Tqy]]]]]]]]]]YYY?OEayPb{YOCEPEY\`\bmJ@PF@JE@Y50:EJ50*0T>04JP\VP:Pm5@wP45>JTkyw54>5:55>ETzwcyvlYblhaZ\bILTNPq{eEEFppak`Q]]]]]]]]]]FLNT]hrZ`qQTF;:Izw|kmOEfNEP\y\Fo{5>FYJ5>5>4N>::oboom444*4NfN00:EEFY>45::5@LJV\mmnaQQpzbWbFWTNVl{pONlfrNIQQ]]]]]]]]]]IkoynnF@\NJC?EL`yzy{|bF>?CFNor``ob:ETV`>:050(4>0TVTT@*4**0444404455E045550@W{zw|cyy]ZY]xWbbpfynTyIL]]]]]]]]]]]]lNn\F@EFELLCTrzlzyPQWNETNZV`wmcfpmN:YccFN@F>**00400***40*4@::>>4::::44:::5>Yp\wcovvfmeccWqkkkWkY\kYY]]]]]]]]]]]]]]]]]]e?CFhLr`VarY`~rNONYTwfwcp{fV`VF\J@TrkPVFFN5455*(**00>F>5EPF::4@>F:5TpF>:Fbp\V|{xzc|r\qyWVbwZ]]]]]]]]]]]]]]]]]]]TTVIwfZ]hq\{wwmoYcPPcy{rT|bYPFpwT@E@F:5fb****04b`>@5P\J>@::E:>bfTE>fZ`YJJY{of\rVJP@I\Y]]]]]]]]]]]]]]]]]]]TLT~npZYNC]mb|bVQVNYpNNmwVp|bPc`EP@05>`E**004ET>@TE>VJ4EFF@44NET\PfZQOJYVpnrcPQ\EPE?T]]]]]]]]]]]]]]]]]]]]PF\\px`JWvp]J`v\{pQ`WN\kyJY`YowPbfPTJ>FbcE*0Y4(00:VPE4E\F5EE0:c\E5>>@PcV|JOLFpz~~kkfbxhYbToOQ{ck]]]]]]]]]]]]]]]]]]]]PbONcoaavLEFJP\OJbf]NkVTekYbwr{boo@::EN`F*(F5*050@J@@PJ:F:>40\PJT@FTF>|bbT]|qcvaLT~eZawccypq]]]]]]]]]]]]]]]]]]]]]Wp{l{E?Wm`IPVYhn]c`beWm|rpwPN>:EE55:N0(*44:E5>E>EF4>:4VrF@b@PVF>>brlVNQJEEl~~Z|PIPwOqohokk]]]]]]]]]]]]]]]]]]]]]]`vLevvxrcIJVVomocyVLa|o{{c\>N>F>EPb5040>>N:>>45:>5:>TpY>:>YVbbp>ywnLOL\NJNVoYlWcqfWblYY]]]]]]]]]]]]]]]]]]]]]]`cqWY\LeONPbPJTVboxcwbVFlkwrwNIT>`EJ>5>T\VE45@P@E>455E@>:fkk>:F`m@@>>;;cZhhJ;LkOQaTqmpPY]]]]]]]]]]]]]]]]]]]]]]]]YLrqvkVNLTcnQENfcryrZFlcw|cQeyJJ]>FJJ>0*4NTN>:5>:440>@J>@:PYcE>J\{`oW]\\w\ZpW]PEVVwxYb||hIP]PP]]]]]]]]]]]]]]]]]]]]]]]]]NE{mJNncvrZJIImrmkmQckyT@:\\VqFV@N:44005@>55@5005@Vb>:@J\`@EFNyYoxb>b~\zhOpV\]]QQ]rJ]]OO]]]]]]]]]]]]]]]]]]]]]]]]]]]ymIW~rz~Omo\kycnQNYJ]mON;E@YkcV\Y`Y>NY50:>:>FE54>FFYPFEV\PNEVbVrohwhhW;r]ZZPcac]]]]]YV\]TT]]]]]]]]]]]]]]]]]]]]]]]]]]]mkoeeyym`bQhcF@FINWrq\FTNmJ5EkE0>>EcoJ:>FNFY`TT`yk`Prkb`ale\TcV>\\bbZZ]~\c]]]]]]TTQ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]~fwla\hn~vrn@F`ZZkcqzZTC?@@QN?FVoJ::FNVJ>JJVfyNYVbwVFWypaPEYeLY\\b]b]]W]]]]]]]YYYQ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]eaY]]\alkFJNfyPqlhzcINCYYpm>PmF5:EFFENPoyoYkTVxLCWck|TEz{yvbbZ]]]]O]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]vNyyPly~{{P~xf`hb~ppIJypwTf\VFVP>@NYkNJJVfopTWlPZ`]YcpOmzbbY]]]cnJ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TfϜyfcrc>LNTPYYPa]aQTcNE@P\T>E>EkkoVPYkmYVwaakYTVmlqqZ`b]]]]cnp]a]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TLQYzźfY`fN>phVcYyzqOTqhmzzx]{h]VF>OY?>EVwkpoJTmfcYfQZlTpZQQ]ZYQWh]]]]cna]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]PJTTyeLPZaNVT`qQW]e~Q`lYPVLkmQ@Pk{LVf\\mpkxQ`IJhELbZb~v\kx]]]]]aVbh]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]NJYwWqkbNTZqZkxIPyQPJ{f{xbIP\km\YkoIJEOV\Yp]]]]]]]]]]]]bee]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]PP]YWcL~ؾZQe]]WVVVhcNfkZTy{fFLrkVLY\TfmaJOcl\h{]]]]]]]]]]]]]]]ee]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]oYP]y~vrwmQTYWkQTlwpm]QYpO>>~bhZQFEEVYYvxrphmm]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TPIEyPIzmff]YY]]]\V``e~\`wwVWQO@>F`bZ?FO\ok`oq~h]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TPZyyVJhbc]]]]]]]FfEN`\r\PkVEFCIlzloT>zYWykhyc]p]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]YPNOOf]]]]]]LIzble\o`LFbVO\TWOChfQJfva`enznhm]]]~h]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TIP]TFLaco]]]]]]h{bPb~ZEbbaY\E?Iw\OPmqaa\kmckmb]]]]]qzh]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TPY]TJa]f]]]]]WWrhw\Cfyba`?JECkwvmZh`va\kpoz\]]]]]]hh]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]fof]]]]TJL\NYkwwcaa`fzl@JTe\mJcql]b{qY]]]]]]]]]h]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]QINmlWw`fFZ~T>@Fzra~Tf``~p]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]\WWhyŭ``{NZVVNJWTw~kNoQcnhO]]p]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]QWfh~nT`\Ofrb]opJLfp~`NmYbkQQb~]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]WW`ehbQWaL]|vbxhNPz~xlQFwVəp]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]ymznhf\VWnm\Trzq{|]wLEc`]|]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TZyyyc\Wawwpf\Tpabwf\NWhlc|]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]TT|qh`Z\pY`lFaOkmwkmeOFo]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]bmyvŒrfZCaLkq\em˃o]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]Yox{ryyp~bwmwWPh]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]mxwaTkh]eypmwzlenQIb]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]mxwzvzw]\cqmph]a\TVab]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]o|yf]]c{]QVbYTY]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]foof]]]]k{f]YY]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]             ** *)),     1)($ II* (     0)()*  ,4>)$  ( 0*   * (0   )   6,,,>1()$*1;0 $ * )  ; *  *   *E$)  $0 $,,54 )$)  $ 14 ?:W`;) $   **($ ( *  $  )$(4)((((($@@?4?5( *  ((  *   () ,0  (((( \kJ00 4   *(   **)$(,$,1$$)$( (((( (JF4  (    ( 6$ 54*,$ *0((((((V@5 (  (0 (((*;\((((($:TE*    ( (04Pb:(((($05]E(  ((( ***:E5 (((($4C{4 *( (  ( ***45* ((((( CP0( (( ( (*4****((((((00PW@50(( (  ( ((  ((*0>00**((((((14Qx>40 4   4:   (04N>*0*(((((*5?lW:4*(00 0( (( (05@`@*00(((((*46:C5* (@ *  (5  (@@*(*0044400((((((((?Jb0  V( (*( ((  5N0 ( *4N50NV5500*00((((((()4:Q$$(*( :((  (*((0( 0** *(((5PcfY:0,,00*((($$$$E4>,((* ::* (*    >@E5>>4544544((($F,>O)((((*(  0(     *4:0(04@5LC:>50(*)FPJJ4()(**(  50  (05 (*E:0*05:4144400(4T6PfC:(*>4, ((( 4 00JN>  0**@ (55**0444,,1>5((?ZwN;>>544* (** 0(@0* 4:V:  >  **  ( (4(*4E4401CF5((Q@EWLE;@5( (4>0 0J:V\*( * ( 0N* $()5@4,*5FEP((\e:;?6,(,  (FP:((@c54*(  (4(*$ $(5LE5>)*:Va)(():?E5P@,0(*> 5@@EE4   ( **  )INL6::EEyN)((;:INY>;:0 0* (E40*4  (*4(10 ( 146,:F;>0*(((L$PT5015*  ( 0: (  (0:*$54 5N4***>OC>>1(($$ L`Q*()4>0(  ( (( 0:** (**4  $$*01)(*0ZE\vC`5(($ $QE$ 45*4( (0(50*5**   ( *04*( ;41$ *,4?N@Qv:((${P@$*0( ( (0>:0((:5((044(*m50($)4;6F;`@(($$0v1**  0* (>:4*(  (  (( 04 :F(,,$(06FJ@4;6((()6o:  ( *05>* @  * (4  (* (( (  ($)),00EW;4,Wc6$((>mhp0( (055 *0 @5 0: (> ( (*4(*0( (((   (*$($ 01;m:00001o@$,]hW60*(((**(5045 * F0>N: (  (,(,*($$:@r:4>F*L~@$WZ>T1(( * *:( NE( 0( (F:    * $(10***)$0>54EC?44f(J>Jwl@:(*@**$,5 5C:4(** 5:  ( * 0 $)(00))0),*>:>Icb5:`\(o>:CWL5 :@05)$4@0 **CCF(** (5> (* *    00   $))))110(606@C>yO?@kO(6rF41>F4>0:* (N5 5:* (* ((* 54*(4   ( ( ()(*)16,116E?11C>J4V0;wf444> (FJN405J: ((:5*( 0  (*(505(E (   *  (  0( ((( ))04044OY541:;04,4xP0FT) 4TmLE0(0(*>F:* (  (*( **05b( ( *  04* (05*(  0(   (*:*  0 **(00004J{C0:06n))*;EPV,, YN1: (5>@>:>:05>*  (0 4  *0(  (44*((:E4(  (((40( ( ( (5:(**(((*004444Y`\:6\(((QVw65>50krJ,(**5:@TcPTT@4 0*  ((E (( (00* *(000*44**((  (040(*50  0( (450((0:40:E>4Ql\4>C((Q05O?6Y1 *Wh>0@45EFNf{{fE*5* (  4 ( *(N4 ((*((0::44000445540*0**   *5 00( (444  ( *0*>@40((4046:>>:4>?>LNCw($ F>1*$ *PvlJ:Y:E( >NbFE:J5 >:  (( 5J *5 4::544400>F4((:54 (005*54* *45* 44* *0(:>>@*(05YI::>:1IPLNIrr$(($,Z4, (5cF;I54 (*:4*00  @F  (*EN4 0 **04:40**0(*555((0:4 *( *(**040 055*04(05:;,0:NcI:5:55FLfJVW$(($ f1 $$ *`L>hF1( **: (  ((( 0( (400(((  (55**4440 (* **040*((  0>005055@40544@0,44:>C>zyFqQ$($L>C0*(EJV>F414(*( >( ( *00((  050( 04(4:4*( ((*( (( ((( *5404*55E0*0:410004>FEL~F:h4$(TT (bb\>4C44*  **0  (*   :kbV:0* *(04*( (0::45*( 0**   (*(((((:54((:>J:4:EF@?444JFIIOJ6\$h`VbbNrF*0,($$ (*@0(   * ( ( (NPNF@ *0:0* 0J@:*  (404 (**(5( 00(( ((405F:4EJE::>55>@FE>5>L pWlELoV:,(  *:(  4  * @0 (VF*( 5>0*((JJ5 (*0(*((((4005( 00((*(::@>@FE@:>ETP:5>CVN:LNF FLwkN:50*($  * 054 P4( 5  (c@ (:`E(* (*5E**40:>*0*(*4* **(*40 (0**40 (0*5::5FI;046JfP::?CY>`ca5$(Tw0O05,e,((4((**0(5(:  0* (( (:*((*50 @E * >@**44**5E4000 *4000  **40( * (*4044*1454;:>55:>>EEWyJ($Z?4;@511:@6055@:: (J:  0*  *0(4  *EE`0*5*(4*454**04*((  (5>00*((400>:50 (455>:0:F>EJ50,1:JY(1(\>$E44q4))Lb@:0*40E((0(4\5 ( (Pk0((5**  (00*4* 00040 *  (0>F@4440:@:>PYP>0(FE>E:4ENNJE>555L(O(PE@C6;k0(*CL,Qb>*(5**:>5*5*(F>(** ( ( (EYV:@0 (0 *0*40*55**:* 40*44:>**0EJEJPFJV\F4E@EE:>\NVOOPET@EQLC6~ Y;J( NOE:04(4JPE5*4:((5* (@: >4** ( (404EfE``  (05405*(*4 *@>*(0000*4>54:E:0EY:0JY@45>EVNEJE@IWVTTF>PP5:4($)$0**15Z:01(*5YL44**((4*  *:: (*(*(( (*@>40P\:** * (**5:>( (>EE555:5(*:>:EPE***( (555:5@JNJF@@PNIFTY]lpq(((()4\:*@5Qc>004:@VV:( ( *( *44 ((((( ::b**P@44(@  004(  55:::@:4*4FF>TP>**40((4>>E5ETN@@>:\TJ;J\fw0(($$(*W{rLkFEZy46114fc`:>(*( ( *0* ((*4 *@EE (* (* * *004>:4045>EF:EE:**40*(405@>>ETNEJ>N@@:>E>>;:4(($$(*6ZZQ$ n4:>:4::::>**4( 0 (4( *:0 (*50( *   >@> ( 0(*4E5:E>>E>PP:EF* 50*054:@J>>QNNVTL>\LNVPC~Z6F((((6;>I$(`$0>NN>;6:64{J44b5(>0(*4*0*  *F5  *0((4   5(0( 0:@0 *444>0*>@JJ0::>6>0,;5455:@ENE@IWYOLFV@ZN`VbFY@:(((haLN$fWI:TTfEI6:6I5Pb@@0*54*:@(0* **5P0*  (0((E>( *( 00 (4(((4VT * (( *((*(400:*4,0:614>5:@TPF>CIZVLJJOP;@E?:;hE>(((((((Y];x,@5@6>@ObbbE0>F:05((:4(0( 05:E(*  *E E5 ((((0(( *5*  0( *05*(14,,,551)0;@>>JN@@J::YI@NCQ:V@656FOhcc((($$( @:4LZF:44@IIb:\45**0F@N4(@FYV0( 0P50**( ( **( ( (4(@0 ** 0 (*(( *6E@;0@5,,4:EJENF@@@,*@@14Elb;C0Ic(((($ $ (()>Q:I@Z***b:*0>J:@@>0**0\P@( 0* * *(*:( ( (05 4N ( *  (* ((((*((,EEF@@TJ60;ICJWJ@@NE11EeC:Icbbe*5(((((($$((q;Y0LET450>b4:>6NYF@@005(4:** :(  5E0(*4:E4 4@**0 400  0*0 (*((0*0@F5@N@FO>1@E>FWE?CEE>>41>@@6IWe4NNF:@((((((((((ZWQF4b;C>@@ZPcP1;F54>44>0:F**( 0c5:0**F5( (* *@J 00(( 0JE* 0>4 (**0 **(((4Y`L1>I>NQ>4C?@EPOLILE?TNkv0,,0|e4F@Q(((((((((((($(:EQF0;J>CLP>;EVE>EE@>>@F00*(*N>:NN:@( (4((0((4(4(((PP0*@N5(4 0>:*((0(((4bP@IY@EPFE>E;@NIPN:CEPNJVy5I?F;f6ZL((((((((((((;*40CY,:P>?;,15,>NFEF5:>>F4050***(EP5 (05(0( (40555 0F((NV: (0:>NY\**0*0**05@bcT]J@JJJ>@LJI@CE55>66WcO0)$OkY@C>((((((((((( 145?Om]:5:Z4F6,(0TNFE@:>1,>44::@E50@F (0@0(*((0( (P@>>J  0E5 *550@4*0*005:5@Ero]hVETFIC66PVE?I5;>6;JZT1;YPYr0((((((((((((( TEe~PW0*:000,40@TJFF@E>*),,005>J5>@> (:>>*( ( :@:0* (((0 (0**(5;Tf\YbYePETFOO>;QW@CW>IlIhcq@ZeY>bY((((((((((((((pbbI(PJ1*1*,150>>YPJ@414104415>F@T:EE4* :::*004(   (((00 ((*0((*0000>kbTEYICEQPZ\fPO`YLOFII@VfOO:::FLE((((((((((((((((((((cI()*?0PL??:45IC15144E>E>NNF440(**(4@@45400  (0( (*0** (*5**EP4405@VN@:FNJPYPP`{]YnLakCQEaY\@@Qla:((((((((((((((((((($$c5*IJ?CPTq;C>:LV4:545TPpT45F50FJ*(EJ5(*(0* JN @E**(4:4(*(*4**PT@54N;::5:>br\kTYmkk{oe>PJEWb?6?,5?(((((((((((((((((((($$(PFN:E6*:YOr~ZFPTVF:115>F544:05@J4*>Y@*0* *E4 *4**:4(45 *054(*@:@J>E:55:F>behZfYIcrZEFwofaaI66E1;4*6((((((((((((((((((((((;:QJJ5;NVL5QhrEEOP>>1,>@J5:54>504:450(*5@( >( >5* (04**0 (>@4*404>N@PJ:544T\TZNZvmbVVT>LqIaF?J;V;>bNI(((((((((((((((((((((@44ENrIJY:141:NC:FII:J515F>>FE>T@>FNE*( *0:**  (04(*0**5(*( >\:5F4:@:4cTE?;IeZPZ:4>hhLE{r;a]@WPmF`Zp{I(((((((((((((((((((((Yz0F\Wkp0,FNE:?C;EW>@>:56:JEJVPNfPN40*(**((*:  (4((*(55(0*(@T54J4>E:44JPVqlY@@E1,4V]a;f@*6If4EpWJICC((((((((((((((((((((((`6|Q5P]\e\VE65>5E@>6J@41:JJVTckF@F\?>(* *(05F* ((4 ( ((0***5N@404E>JJ`1Y>pzQ;?4C656EZ>YEOcI0?Pe:((((((((((((((((((((((((`6EqF6:;5L40:E:45::>F@J:5,:FVJPJT@YN0,:*@*4* *:E@4 *4(**(*(40*(:EJ00:EJ5541*,wmkN5LzW1):n@5;qE;ZT>((((((((((((((((((((((((((($]OmI@:51>E?:,4EPN:VVQ;1>@NJ\]60@L1,@0*05*  055(( ( *0500*5:E54:>NIN@FCCb>af01T?J100*JI1@OmhL,0(((((((((((((((((((((((((((($ ]Na15F@NJ6144JZC@NN\;:@JkE\Z5,$656\40*5*  *( (* (*5F4045>>4:::PYCPQmJ4J\h0P\Pn,],*(((((;ZT4;((((((((((((((((((((((((((((((@NZ1CPJTY5EE@EN@C::@16?mp45),,6?NI>55:@*4: *0((0*( *445555::5:5@EEVfNFQII@*WTqc(::(:l1*(((((((C((((((((((((((((((((((((((((((TTpm`IbkTNC:?JEVZP@>0;T@1,*,04?E@*55@1(>0 **0>F0*(4:0:F>:>FEF@N\VLCCQI>6E;,EEJJ55(T`,*((((((((O$((((((((((((((((((((((((((((((TpzZQFp`PE;6>FWQTV>)*:66FCNT6Y5((**41(04@4**45:4*44:FVY5>>@N4,>YTJ60?F6>rEEYYJ(J((TF)((((((((($V$((((((((((((((((((((((((((((((p`F|@cy|c?@;;?NNh1,1EbQ0ZNJ6bC:01,>:>@*0>4**445045EPbE>N?>O0*>JOZ5,hbcTJYJYYqF((((T$(((((((((((((((((((((((((((((((((((((((((bT F?rVcb>JYVNTVZJ4`@E:FC\]b>>10COT>:>:445*05:N:45:EbJFJ>:?4;FC?IJ:LfmcJJ5(((*TP$((((((((((((((((((((((((((((((((((((((((((($FFEhQNJ\wpQI)1J1:1Z5:6y:51|]15P@54*5@@0004@@J>5@NJY\PP?>J@@Oq?Q>CNTaW~FIJ((((*5?n*)(((((((((((((((((((((((((((((((((((((((($ (@qcJCEE5(?;6>>CQN5:L>OQJJ:J@@>40;:,,5:N?NJ:>FE@cffEJ:>J;Vc1,;Cp>@55EcT((((*Nph5)((((((((((((((((((((((((((((((((((((((($$$(LYhehE4>CC1NP44?O]60]Lz4FcZW4;@65:1FE6,;NT16E@@FVJYkV>E11N16ElV,FhYCCEEE((((()*?`0((((((((((((((((((((((((((((((((((((((( (L6bob`Nf\:5NI*?1Y>@:Np])*`c4]b;5P@NNTJ\cm?45>>FE@FOC041:h?E,pQT@(((((((EEE(((((,5v,((((((((((((((((((((((((((((((((((((((( (:;5(kf5,zE?E0((bNo4QL*PP@PL>:PLC,0ETolZT>55>@PPO\@5:OYE4cp>@(((((((((E((((((,,(((((((((((((((((((((((((((((((((((((((((((Fw(,IbQLZZ\PnN$((bN:W50VJhF@\V@;;I5**NWIN@;,*1>EF]`Z\\`\LNNccppp@c((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((($$0,x?$ aNJLmT((((((*16ENba@>FJ>>61,)0N`C@>(06FTTJywEF`pmLccc(Ecc@@((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((($$;QkT($N\ENT(((((((T**TWEEJ>:J@11*4@TL]T;(afb??\]EFY{@TTTT(@ccT((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((bbh(((E**Y4(((((()0c4JEENF;5JC;@6>5,JcE40@N`E?NYZcWVPNcTT(((QqcT5(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((b(($ $($))6E?((((((>Z~L>F`ZC5JbF@CC0(1VcC64LZNFEENYOVV@,(T((((@LTT5(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((bb(($$(($(n6;4((((($0r\>FkoyJ6IVF@E,11,JTQN>fwJFP4CFV`h*((cb((((5Tc5(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((b(((((((((4?4(((($()00IVFNpoT@@FJZW*16I>kcT,|kJW64Epla$(((((((((5E(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((**,IYCrbyykVJE\*;]>(**aTVo\c@P;Q,CyP?(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((0,1IlJ\qe??\0;6e44\,??WkZT0W4?CN*05~p?((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((($,NOOhoO4N??5E\PLJPN01FTZc?0W;@vN)1>~P((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((($$>I@>14T{E6@`ocEVkI46fmaZbycC44a4ep?((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((TOPON`E>:>WVccrq{E?]mc\Z6Q6,PI0|O((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((*@@EE>:@WWbcVOE?WPQr`Y`z@>4:@Q1P(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((\PEEEEcWZEc>>Y,?>W?PIWC10~hr?((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((bZ?TeP]`f]\TCL*?0VYJY>CNV?(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((EvZWpkNJOL{Wk;hIEI;6vZ;(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((;fcbx:1:E46?LYJcYT>@C50Yb,((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((;EObTp]I(0:bnZI\W@,:60,1,((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((EElb\@EE4((0Oalbb()*,$$(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((4\cc??4((((5aaN\fc4(((((((((((((((((((((((((((((((((((((((((((((((((((((((((((((lablgl-1.05/Togl/examples/checker.ml000644 000765 000024 00000004076 12217024174 020334 0ustar00garriguestaff000000 000000 (* $Id: checker.ml,v 1.8 2001-05-08 01:58:25 garrigue Exp $ *) let image_height = 64 and image_width = 64 let make_image () = let image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in for i = 0 to image_width - 1 do for j = 0 to image_height - 1 do Raw.sets (GlPix.to_raw image) ~pos:(3*(i*image_height+j)) (if (i land 8 ) lxor (j land 8) = 0 then [|255;255;255|] else [|0;0;0|]) done done; image let myinit () = GlClear.color (0.0, 0.0, 0.0); Gl.enable `depth_test; GlFunc.depth_func `less; let image = make_image () in GlPix.store (`unpack_alignment 1); GlTex.image2d image; List.iter (GlTex.parameter ~target:`texture_2d) [ `wrap_s `clamp; `wrap_t `clamp; `mag_filter `nearest; `min_filter `nearest ]; GlTex.env (`mode `decal); Gl.enable `texture_2d; GlDraw.shade_model `flat let display () = GlClear.clear [`color;`depth]; GlDraw.begins `quads; GlTex.coord2(0.0, 0.0); GlDraw.vertex3(-2.0, -1.0, 0.0); GlTex.coord2(0.0, 1.0); GlDraw.vertex3(-2.0, 1.0, 0.0); GlTex.coord2(1.0, 1.0); GlDraw.vertex3(0.0, 1.0, 0.0); GlTex.coord2(1.0, 0.0); GlDraw.vertex3(0.0, -1.0, 0.0); GlTex.coord2(0.0, 0.0); GlDraw.vertex3(1.0, -1.0, 0.0); GlTex.coord2(0.0, 1.0); GlDraw.vertex3(1.0, 1.0, 0.0); GlTex.coord2(1.0, 1.0); GlDraw.vertex3(2.41421, 1.0, -1.41421); GlTex.coord2(1.0, 0.0); GlDraw.vertex3(2.41421, -1.0, -1.41421); GlDraw.ends (); Gl.flush () let reshape togl = let w = Togl.width togl and h = Togl.height togl in GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:60.0 ~aspect:(1.0 *. float w /. float h) ~z:(1.0,30.0); GlMat.mode `modelview; GlMat.load_identity (); GlMat.translate ~z:(-3.6) () open Tk let main () = let top = openTk () in let togl = Togl.create ~width:500 ~height:500 ~rgba:true ~depth:true top in myinit (); Togl.display_func togl ~cb:display; Togl.reshape_func togl ~cb:(fun () -> reshape togl); pack ~expand:true ~fill:`Both [togl]; mainLoop () let _ = main () lablgl-1.05/Togl/examples/double.ml000644 000765 000024 00000010036 12217024174 020173 0ustar00garriguestaff000000 000000 (* $Id: double.ml,v 1.11 2001-05-08 01:58:25 garrigue Exp $ *) class view togl ~title = object (self) val mutable corner_x = 0. val mutable corner_y = 0. val mutable corner_z = 0. val font_base = Togl.load_bitmap_font togl ~font:`Fixed_8x13 val mutable x_angle = 0. val mutable y_angle = 0. val mutable z_angle = 0. method togl = togl method reshape = let width = Togl.width togl and height = Togl.height togl in let aspect = float width /. float height in GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height; (* Set up projection transform *) GlMat.mode `projection; GlMat.load_identity (); GlMat.frustum ~x:(-.aspect, aspect) ~y:(-1.0, 1.0) ~z:(1.0, 10.0); corner_x <- -. aspect; corner_y <- -1.0; corner_z <- -1.1; (* Change back to model view transform for rendering *) GlMat.mode `modelview method print_string s = GlList.call_lists ~base:font_base(`byte s) method display = GlClear.clear [`color;`depth]; GlMat.load_identity(); (* Reset modelview matrix to the identity matrix *) GlMat.translate ~z:(-3.0) (); (* Move the camera back three units *) GlMat.rotate ~angle:x_angle ~x:1. (); (* Rotate by X, Y, Z angles *) GlMat.rotate ~angle:y_angle ~y:1. (); GlMat.rotate ~angle:z_angle ~z:1. (); Gl.enable `depth_test; (* Front face *) GlDraw.begins `quads; GlDraw.color (0.0, 0.7, 0.1); (* Green *) GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3(1.0, 1.0, 1.0); GlDraw.vertex3(1.0, -1.0, 1.0); GlDraw.vertex3(-1.0, -1.0, 1.0); (* Back face *) GlDraw.color (0.9, 1.0, 0.0); (* Yellow *) GlDraw.vertex3(-1.0, 1.0, -1.0); GlDraw.vertex3(1.0, 1.0, -1.0); GlDraw.vertex3(1.0, -1.0, -1.0); GlDraw.vertex3(-1.0, -1.0, -1.0); (* Top side face *) GlDraw.color (0.2, 0.2, 1.0); (* Blue *) GlDraw.vertex3(-1.0, 1.0, 1.0); GlDraw.vertex3(1.0, 1.0, 1.0); GlDraw.vertex3(1.0, 1.0, -1.0); GlDraw.vertex3(-1.0, 1.0, -1.0); (* Bottom side face *) GlDraw.color (0.7, 0.0, 0.1); (* Red *) GlDraw.vertex3(-1.0, -1.0, 1.0); GlDraw.vertex3(1.0, -1.0, 1.0); GlDraw.vertex3(1.0, -1.0, -1.0); GlDraw.vertex3(-1.0, -1.0, -1.0); GlDraw.ends(); Gl.disable `depth_test; GlMat.load_identity(); GlDraw.color( 1.0, 1.0, 1.0 ); GlPix.raster_pos ~x:corner_x ~y:corner_y ~z:corner_z (); self#print_string title; Togl.swap_buffers togl method x_angle a = x_angle <- a; Togl.render togl method y_angle a = y_angle <- a; Togl.render togl method z_angle a = z_angle <- a; Togl.render togl end let create_view ~parent ~double = new view (Togl.create ~width:200 ~height:200 ~depth:true ~rgba:true ~double parent) open Tk let main () = let top = openTk () in let f = Frame.create top in let single = create_view ~parent:f ~double:false ~title:"Single buffer" and double = create_view ~parent:f ~double:true ~title:"Double buffer" in let sx = Scale.create ~label:"X Axis" ~min:0. ~max:360. ~orient:`Horizontal ~command:(fun x -> single#x_angle x; double#x_angle x) top and sy = Scale.create ~label:"Y Axis" ~min:0. ~max:360. ~orient:`Horizontal ~command:(fun y -> single#y_angle y; double#y_angle y) top and button = Button.create ~text:"Quit" ~command:(fun () -> destroy top) top in List.iter (fun o -> Togl.display_func o#togl ~cb:(fun () -> o#display); Togl.reshape_func o#togl ~cb:(fun () -> o#reshape); bind o#togl ~events:[`Modified([`Button1],`Motion)] ~fields:[`MouseX;`MouseY] ~action:(fun ev -> let width = Togl.width o#togl and height =Togl.height o#togl and x = ev.ev_MouseX and y = ev.ev_MouseY in let x_angle = 360. *. float y /. float height and y_angle = 360. *. float (width - x) /. float width in Scale.set sx x_angle; Scale.set sy y_angle)) [single;double]; pack ~side:`Left ~padx:3 ~pady:3 ~fill:`Both ~expand:true [single#togl; double#togl]; pack ~fill:`Both ~expand:true [f]; pack ~fill:`X [coe sx; coe sy; coe button]; mainLoop () let _ = main () lablgl-1.05/Togl/examples/gears.ml000644 000765 000024 00000015101 12217024174 020020 0ustar00garriguestaff000000 000000 (* $Id: gears.ml,v 1.16 2001-05-08 01:58:25 garrigue Exp $ *) (* * 3-D gear wheels. This program is in the public domain. * * Brian Paul * LablGL version by Jacques Garrigue *) let pi = acos (-1.) (* * Draw a gear wheel. You'll probably want to call this function when * building a display list since we do a lot of trig here. * * Input: inner_radius - radius of hole at center * outer_radius - radius at center of teeth * width - width of gear * teeth - number of teeth * tooth_depth - depth of tooth *) let gear ~inner ~outer ~width ~teeth ~tooth_depth = let r0 = inner and r1 = outer -. tooth_depth /. 2.0 and r2 = outer +. tooth_depth /. 2.0 in let ta = 2.0 *. pi /. float teeth in let da = ta /. 4.0 in GlDraw.shade_model `flat; GlDraw.normal ~z:1.0 (); let vertex ~r ~z ?(s=0) i = let angle = float i *. ta +. float s *. da in GlDraw.vertex ~x:(r *. cos angle) ~y:(r *. sin angle) ~z () in (* draw front face *) let z = width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r0 ~z; vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~z ~s:3; done; GlDraw.ends (); (* draw front sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r1 ~s:3 ~z; done; GlDraw.ends (); GlDraw.normal ~z:(-1.0) (); (* draw back face *) let z = -. width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r0 ~z; done; GlDraw.ends (); (* draw back sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r1 ~z; done; GlDraw.ends (); (* draw outward faces of teeth *) let z = width *. 0.5 and z' = width *. (-0.5) in GlDraw.begins `quad_strip; for i=0 to teeth - 1 do let angle = float i *. ta in vertex i ~r:r1 ~z; vertex i ~r:r1 ~z:z'; let u = r2 *. cos(angle+.da) -. r1 *. cos(angle) and v = r2 *. sin(angle+.da) -. r1 *. sin(angle) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:1 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:2 ~z:z'; let u = r1 *. cos(angle +. 3. *. da) -. r2 *. cos(angle +. 2. *. da) and v = r1 *. sin(angle +. 3. *. da) -. r2 *. sin(angle +. 2. *. da) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r1 ~s:3 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); done; vertex 0 ~r:r1 ~z; vertex 0 ~r:r1 ~z:z'; GlDraw.ends (); GlDraw.shade_model `smooth; (* draw inside radius cylinder *) GlDraw.begins `quad_strip; for i=0 to teeth do let angle = float i *. ta in GlDraw.normal ~x:(-. cos angle) ~y:(-. sin angle) (); vertex i ~r:r0 ~z:z'; vertex i ~r:r0 ~z; done; GlDraw.ends () class view ~gear1 ~gear2 ~gear3 ?(limit=0) togl = object (self) val mutable view_rotx = 0.0 val mutable view_roty = 0.0 val mutable view_rotz = 0.0 val mutable angle = 0.0 val mutable count = 1 method rotx a = view_rotx <- a method roty a = view_roty <- a method draw = GlClear.clear [`color;`depth]; GlMat.push (); GlMat.rotate ~angle:view_rotx ~x:1.0 (); GlMat.rotate ~angle:view_roty ~y:1.0 (); GlMat.rotate ~angle:view_rotz ~z:1.0 (); GlMat.push (); GlMat.translate ~x:(-3.0) ~y:(-2.0) (); GlMat.rotate ~angle:angle ~z:1.0 (); (* gear inner:1.0 outer:4.0 width:1.0 teeth:20 tooth_depth:0.7; *) GlList.call gear1; GlMat.pop (); GlMat.push (); GlMat.translate ~x:3.1 ~y:(-2.0) (); GlMat.rotate ~angle:(-2.0 *. angle -. 9.0) ~z:1.0 (); (* gear inner:0.5 outer:2.0 width:2.0 teeth:10 tooth_depth:0.7; *) GlList.call gear2; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-3.1) ~y:4.2 (); GlMat.rotate ~angle:(-2.0 *. angle -. 25.0) ~z:1.0 (); (* gear inner:1.3 outer:2.0 width:0.5 teeth:10 tooth_depth:0.7; *) GlList.call gear3; GlMat.pop (); GlMat.pop (); Togl.swap_buffers togl; count <- count + 1; if count =limit then exit 0 method idle = angle <- angle +. 2.0; self#draw method reshape = let w = Togl.width togl and h = Togl.height togl in GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); let r = float w /. float h in let r' = 1. /. r in if (w>h) then GlMat.frustum ~x:(-. r,r) ~y:(-1.0,1.0) ~z:(5.0,60.0) else GlMat.frustum ~x:(-1.0,1.0) ~y:(-.r',r') ~z:(5.0,60.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate ~z:(-40.0) (); GlClear.clear[`color;`depth] end let init () = let pos = 5.0, 5.0, 10.0, 0.0 and red = 0.8, 0.1, 0.0, 1.0 and green = 0.0, 0.8, 0.2, 1.0 and blue = 0.2, 0.2, 1.0, 1.0 in GlLight.light ~num:0 (`position pos); List.iter Gl.enable [`cull_face;`lighting;`light0;`depth_test;`normalize]; (* make the gears *) let make_gear ~inner ~outer ~width ~teeth ~color = let list = GlList.create `compile in GlLight.material ~face:`front (`ambient_and_diffuse color); gear ~inner ~outer ~width ~teeth ~tooth_depth:0.7; GlList.ends (); list in let gear1 = make_gear ~inner:1.0 ~outer:4.0 ~width:1.0 ~teeth:20 ~color:red and gear2 = make_gear ~inner:0.5 ~outer:2.0 ~width:2.0 ~teeth:10 ~color:green and gear3 = make_gear ~inner:1.3 ~outer:2.0 ~width:0.5 ~teeth:10 ~color:blue in (gear1, gear2, gear3) open Tk let main () = let top = openTk () in let f = Frame.create top in let v = Textvariable.create () in let my_scale = Scale.create ~min:0. ~max:180. ~showvalue:false ~highlightbackground:`Black in let togl = Togl.create f ~width:300 ~height:300 ~rgba:true ~depth:true ~double:true and sh = my_scale f ~orient:`Horizontal and sv = my_scale top ~orient:`Vertical in Wm.title_set top "Gears"; let gear1, gear2, gear3 = init() in let view = new view togl ~gear1 ~gear2 ~gear3 in Scale.configure sv ~command:(view#rotx); Scale.configure sh ~command:(view#roty); Scale.set sh 20.; Scale.set sv 40.; Togl.reshape_func togl ~cb:(fun () -> view#reshape); Togl.display_func togl ~cb:(fun () -> view#draw); Togl.timer_func ~ms:20 ~cb:(fun () -> view#idle); pack [sv] ~side:`Right ~fill:`Y; pack [f] ~expand:true ~fill:`Both; pack [togl] ~side:`Top ~expand:true ~fill:`Both; pack [sh] ~side:`Bottom ~fill:`X; Tk.mainLoop () let _ = main () lablgl-1.05/Togl/examples/gears_a.ml000644 000765 000024 00000016057 12217024174 020333 0ustar00garriguestaff000000 000000 (* $Id: gears_a.ml,v 1.2 2003-10-01 10:11:41 raffalli Exp $ *) (* * 3-D gear wheels. This program is in the public domain. * * Brian Paul * LablGL version by Jacques Garrigue * * gears_a.ml: use vertex arrays *) let pi = acos (-1.) (* * Draw a gear wheel. You'll probably want to call this function when * building a display list since we do a lot of trig here. * * Input: inner_radius - radius of hole at center * outer_radius - radius at center of teeth * width - width of gear * teeth - number of teeth * tooth_depth - depth of tooth *) let gear ~inner ~outer ~width ~teeth ~tooth_depth = let r0 = inner and r1 = outer -. tooth_depth /. 2.0 and r2 = outer +. tooth_depth /. 2.0 in let ta = 2.0 *. pi /. float teeth in let da = ta /. 4.0 in GlDraw.shade_model `flat; GlDraw.normal ~z:1.0 (); let vertex ~r ~z ?(s=0) i = let angle = float i *. ta +. float s *. da in GlDraw.vertex ~x:(r *. cos angle) ~y:(r *. sin angle) ~z () in let raw = Raw.create `float (12 * (teeth+1)) in GlArray.vertex `three raw; let count = ref 0 in let vertexa ~r ~z ?(s=0) i = let angle = float i *. ta +. float s *. da in let pos = !count * 3 in Raw.set_float raw ~pos (r *. cos angle); Raw.set_float raw ~pos:(pos+1) (r *. sin angle); Raw.set_float raw ~pos:(pos+2) z; incr count in (* draw front face *) let z = width *. 0.5 in for i=0 to teeth do vertexa i ~r:r0 ~z; vertexa i ~r:r1 ~z; vertexa i ~r:r0 ~z; vertexa i ~r:r1 ~z ~s:3; done; GlArray.draw_arrays `quad_strip 0 !count; count := 0; (* draw front sides of teeth *) for i=0 to teeth - 1 do vertexa i ~r:r1 ~z; vertexa i ~r:r2 ~s:1 ~z; vertexa i ~r:r2 ~s:2 ~z; vertexa i ~r:r1 ~s:3 ~z; done; GlArray.draw_arrays `quads 0 !count; count := 0; GlDraw.normal ~z:(-1.0) (); (* draw back face *) let z = -. width *. 0.5 in for i=0 to teeth do vertexa i ~r:r1 ~z; vertexa i ~r:r0 ~z; vertexa i ~r:r1 ~s:3 ~z; vertexa i ~r:r0 ~z; done; GlArray.draw_arrays `quad_strip 0 !count; count := 0; (* draw back sides of teeth *) for i=0 to teeth - 1 do vertexa i ~r:r1 ~s:3 ~z; vertexa i ~r:r2 ~s:2 ~z; vertexa i ~r:r2 ~s:1 ~z; vertexa i ~r:r1 ~z; done; GlArray.draw_arrays `quads 0 !count; count := 0; (* draw outward faces of teeth *) let z = width *. 0.5 and z' = width *. (-0.5) in GlDraw.begins `quad_strip; for i=0 to teeth - 1 do let angle = float i *. ta in vertex i ~r:r1 ~z; vertex i ~r:r1 ~z:z'; let u = r2 *. cos(angle+.da) -. r1 *. cos(angle) and v = r2 *. sin(angle+.da) -. r1 *. sin(angle) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:1 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:2 ~z:z'; let u = r1 *. cos(angle +. 3. *. da) -. r2 *. cos(angle +. 2. *. da) and v = r1 *. sin(angle +. 3. *. da) -. r2 *. sin(angle +. 2. *. da) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r1 ~s:3 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); done; vertex 0 ~r:r1 ~z; vertex 0 ~r:r1 ~z:z'; GlDraw.ends (); GlDraw.shade_model `smooth; (* draw inside radius cylinder *) GlDraw.begins `quad_strip; for i=0 to teeth do let angle = float i *. ta in GlDraw.normal ~x:(-. cos angle) ~y:(-. sin angle) (); vertex i ~r:r0 ~z:z'; vertex i ~r:r0 ~z; done; GlDraw.ends () class view ~gear1 ~gear2 ~gear3 ?(limit=0) togl = object (self) val mutable view_rotx = 0.0 val mutable view_roty = 0.0 val mutable view_rotz = 0.0 val mutable angle = 0.0 val mutable count = 1 method rotx a = view_rotx <- a method roty a = view_roty <- a method draw = GlClear.clear [`color;`depth]; GlMat.push (); GlMat.rotate ~angle:view_rotx ~x:1.0 (); GlMat.rotate ~angle:view_roty ~y:1.0 (); GlMat.rotate ~angle:view_rotz ~z:1.0 (); GlMat.push (); GlMat.translate ~x:(-3.0) ~y:(-2.0) (); GlMat.rotate ~angle:angle ~z:1.0 (); (* gear inner:1.0 outer:4.0 width:1.0 teeth:20 tooth_depth:0.7; *) GlList.call gear1; GlMat.pop (); GlMat.push (); GlMat.translate ~x:3.1 ~y:(-2.0) (); GlMat.rotate ~angle:(-2.0 *. angle -. 9.0) ~z:1.0 (); (* gear inner:0.5 outer:2.0 width:2.0 teeth:10 tooth_depth:0.7; *) GlList.call gear2; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-3.1) ~y:4.2 (); GlMat.rotate ~angle:(-2.0 *. angle -. 25.0) ~z:1.0 (); (* gear inner:1.3 outer:2.0 width:0.5 teeth:10 tooth_depth:0.7; *) GlList.call gear3; GlMat.pop (); GlMat.pop (); Togl.swap_buffers togl; count <- count + 1; if count =limit then exit 0 method idle = angle <- angle +. 2.0; self#draw method reshape = let w = Togl.width togl and h = Togl.height togl in GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); let r = float w /. float h in let r' = 1. /. r in if (w>h) then GlMat.frustum ~x:(-. r,r) ~y:(-1.0,1.0) ~z:(5.0,60.0) else GlMat.frustum ~x:(-1.0,1.0) ~y:(-.r',r') ~z:(5.0,60.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate ~z:(-40.0) (); GlClear.clear[`color;`depth] end let init () = let pos = 5.0, 5.0, 10.0, 0.0 and red = 0.8, 0.1, 0.0, 1.0 and green = 0.0, 0.8, 0.2, 1.0 and blue = 0.2, 0.2, 1.0, 1.0 in GlLight.light ~num:0 (`position pos); List.iter Gl.enable [`cull_face;`lighting;`light0;`depth_test;`normalize]; GlArray.enable `vertex; (* make the gears *) let make_gear ~inner ~outer ~width ~teeth ~color = let list = GlList.create `compile in GlLight.material ~face:`front (`ambient_and_diffuse color); gear ~inner ~outer ~width ~teeth ~tooth_depth:0.7; GlList.ends (); list in let gear1 = make_gear ~inner:1.0 ~outer:4.0 ~width:1.0 ~teeth:20 ~color:red and gear2 = make_gear ~inner:0.5 ~outer:2.0 ~width:2.0 ~teeth:10 ~color:green and gear3 = make_gear ~inner:1.3 ~outer:2.0 ~width:0.5 ~teeth:10 ~color:blue in (gear1, gear2, gear3) open Tk let main () = let top = openTk () in let f = Frame.create top in let v = Textvariable.create () in let my_scale = Scale.create ~min:0. ~max:180. ~showvalue:false ~highlightbackground:`Black in let togl = Togl.create f ~width:300 ~height:300 ~rgba:true ~depth:true ~double:true and sh = my_scale f ~orient:`Horizontal and sv = my_scale top ~orient:`Vertical in Wm.title_set top "Gears"; let gear1, gear2, gear3 = init() in let view = new view togl ~gear1 ~gear2 ~gear3 in Scale.configure sv ~command:(view#rotx); Scale.configure sh ~command:(view#roty); Scale.set sh 20.; Scale.set sv 40.; Togl.reshape_func togl ~cb:(fun () -> view#reshape); Togl.display_func togl ~cb:(fun () -> view#draw); Togl.timer_func ~ms:20 ~cb:(fun () -> view#idle); pack [sv] ~side:`Right ~fill:`Y; pack [f] ~expand:true ~fill:`Both; pack [togl] ~side:`Top ~expand:true ~fill:`Both; pack [sh] ~side:`Bottom ~fill:`X; Tk.mainLoop () let _ = main () lablgl-1.05/Togl/examples/Makefile000644 000765 000024 00000000076 12217024174 020032 0ustar00garriguestaff000000 000000 # Makefile for examples subdir clean: rm -f *.cm* *.o *.opt lablgl-1.05/Togl/examples/morph3d.ml000644 000765 000024 00000047736 12217024174 020316 0ustar00garriguestaff000000 000000 (* $Id: morph3d.ml,v 1.18 2001-05-08 01:58:25 garrigue Exp $ *) open StdLabels (*- * morph3d.c - Shows 3D morphing objects (TK Version) * * This program was inspired on a WindowsNT(R)'s screen saver. It was written * from scratch and it was not based on any other source code. * * Porting it to xlock (the final objective of this code since the moment I * decided to create it) was possible by comparing the original Mesa's gear * demo with it's ported version, so thanks for Danny Sung for his indirect * help (look at gear.c in xlock source tree). NOTE: At the moment this code * was sent to Brian Paul for package inclusion, the XLock Version was not * available. In fact, I'll wait it to appear on the next Mesa release (If you * are reading this, it means THIS release) to send it for xlock package * inclusion). It will probably there be a GLUT version too. * * Thanks goes also to Brian Paul for making it possible and inexpensive * to use OpenGL at home. * * Since I'm not a native english speaker, my apologies for any gramatical * mistake. * * My e-mail addresses are * * vianna@cat.cbpf.br * and * marcelo@venus.rdc.puc-rio.br * * Marcelo F. Vianna (Feb-13-1997) *) (* This document is VERY incomplete, but tries to describe the mathematics used in the program. At this moment it just describes how the polyhedra are generated. On futhurer versions, this document will be probabbly improved. Since I'm not a native english speaker, my apologies for any gramatical mistake. Marcelo Fernandes Vianna - Undergraduate in Computer Engeneering at Catholic Pontifical University - of Rio de Janeiro (PUC-Rio) Brasil. - e-mail: vianna@cat.cbpf.br or marcelo@venus.rdc.puc-rio.br - Feb-13-1997 POLYHEDRA GENERATION For the purpose of this program it's not sufficient to know the polyhedra vertexes coordinates. Since the morphing algorithm applies a nonlinear transformation over the surfaces (faces) of the polyhedron, each face has to be divided into smaller ones. The morphing algorithm needs to transform each vertex of these smaller faces individually. It's a very time consoming task. In order to reduce calculation overload, and since all the macro faces of the polyhedron are transformed by the same way, the generation is made by creating only one face of the polyhedron, morphing it and then rotating it around the polyhedron center. What we need to know is the face radius of the polyhedron (the radius of the inscribed sphere) and the angle between the center of two adjacent faces using the center of the sphere as the angle's vertex. The face radius of the regular polyhedra are known values which I decided to not waste my time calculating. Following is a table of face radius for the regular polyhedra with edge length = 1: TETRAHEDRON : 1/(2*sqrt(2))/sqrt(3) CUBE : 1/2 OCTAHEDRON : 1/sqrt(6) DODECAHEDRON : T^2 * sqrt((T+2)/5) / 2 -> where T=(sqrt(5)+1)/2 ICOSAHEDRON : (3*sqrt(3)+sqrt(15))/12 I've not found any reference about the mentioned angles, so I needed to calculate them, not a trivial task until I figured out how :) Curiously these angles are the same for the tetrahedron and octahedron. A way to obtain this value is inscribing the tetrahedron inside the cube by matching their vertexes. So you'll notice that the remaining unmatched vertexes are in the same straight line starting in the cube/tetrahedron center and crossing the center of each tetrahedron's face. At this point it's easy to obtain the bigger angle of the isosceles triangle formed by the center of the cube and two opposite vertexes on the same cube face. The edges of this triangle have the following lenghts: sqrt(2) for the base and sqrt(3)/2 for the other two other edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the cube this angle is obvious, but just for formality it can be easily obtained because we also know it's isosceles edge lenghts: sqrt(2)/2 for the base and 1/2 for the other two edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN((sqrt(2)/2)/1) = 90.000000000000000000 degrees | +-----------------------------------------------------------+ For the octahedron we use the same idea used for the tetrahedron, but now we inscribe the cube inside the octahedron so that all cubes's vertexes matches excatly the center of each octahedron's face. It's now clear that this angle is the same of the thetrahedron one: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the dodecahedron it's a little bit harder because it's only relationship with the cube is useless to us. So we need to solve the problem by another way. The concept of Face radius also exists on 2D polygons with the name Edge radius: Edge Radius For Pentagon (ERp) ERp = (1/2)/TAN(36 degrees) * VRp = 0.6881909602355867905 (VRp is the pentagon's vertex radio). Face Radius For Dodecahedron FRd = T^2 * sqrt((T+2)/5) / 2 = 1.1135163644116068404 Why we need ERp? Well, ERp and FRd segments forms a 90 degrees angle, completing this triangle, the lesser angle is a half of the angle we are looking for, so this angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERp/FRd) = 63.434948822922009981 degrees | +-----------------------------------------------------------+ For the icosahedron we can use the same method used for dodecahedron (well the method used for dodecahedron may be used for all regular polyhedra) Edge Radius For Triangle (this one is well known: 1/3 of the triangle height) ERt = sin(60)/3 = sqrt(3)/6 = 0.2886751345948128655 Face Radius For Icosahedron FRi= (3*sqrt(3)+sqrt(15))/12 = 0.7557613140761707538 So the angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERt/FRi) = 41.810314895778596167 degrees | +-----------------------------------------------------------+ *) let scale = 0.3 let vect_mul (x1,y1,z1) (x2,y2,z2) = (y1 *. z2 -. z1 *. y2, z1 *. x2 -. x1 *. z2, x1 *. y2 -. y1 *. x2) let sqr a = a *. a (* Increasing this values produces better image quality, the price is speed. *) (* Very low values produces erroneous/incorrect plotting *) let tetradivisions = 23 let cubedivisions = 20 let octadivisions = 21 let dodecadivisions = 10 let icodivisions = 15 let tetraangle = 109.47122063449069174 let cubeangle = 90.000000000000000000 let octaangle = 109.47122063449069174 let dodecaangle = 63.434948822922009981 let icoangle = 41.810314895778596167 let pi = acos (-1.) let sqrt2 = sqrt 2. let sqrt3 = sqrt 3. let sqrt5 = sqrt 5. let sqrt6 = sqrt 6. let sqrt15 = sqrt 15. let cossec36_2 = 0.8506508083520399322 let cosd x = cos (float x /. 180. *. pi) let sind x = sin (float x /. 180. *. pi) let cos72 = cosd 72 let sin72 = sind 72 let cos36 = cosd 36 let sin36 = sind 36 (*************************************************************************) let front_shininess = 60.0 let front_specular = 0.7, 0.7, 0.7, 1.0 let ambient = 0.0, 0.0, 0.0, 1.0 let diffuse = 1.0, 1.0, 1.0, 1.0 let position0 = 1.0, 1.0, 1.0, 0.0 let position1 = -1.0,-1.0, 1.0, 0.0 let lmodel_ambient = 0.5, 0.5, 0.5, 1.0 let lmodel_twoside = true let materialRed = 0.7, 0.0, 0.0, 1.0 let materialGreen = 0.1, 0.5, 0.2, 1.0 let materialBlue = 0.0, 0.0, 0.7, 1.0 let materialCyan = 0.2, 0.5, 0.7, 1.0 let materialYellow = 0.7, 0.7, 0.0, 1.0 let materialMagenta = 0.6, 0.2, 0.5, 1.0 let materialWhite = 0.7, 0.7, 0.7, 1.0 let materialGray = 0.2, 0.2, 0.2, 1.0 let all_gray = Array.create 20 materialGray let vertex ~xf ~yf ~zf ~ampvr2 = let xa = xf +. 0.01 and yb = yf +. 0.01 in let xf2 = sqr xf and yf2 = sqr yf in let factor = 1. -. (xf2 +. yf2) *. ampvr2 and factor1 = 1. -. (sqr xa +. yf2) *. ampvr2 and factor2 = 1. -. (xf2 +. sqr yb) *. ampvr2 in let vertx = factor *. xf and verty = factor *. yf and vertz = factor *. zf in let neiax = factor1 *. xa -. vertx and neiay = factor1 *. yf -. verty and neiaz = factor1 *. zf -. vertz and neibx = factor2 *. xf -. vertx and neiby = factor2 *. yb -. verty and neibz = factor2 *. zf -. vertz in GlDraw.normal3 (vect_mul (neiax, neiay, neiaz) (neibx, neiby, neibz)); GlDraw.vertex3 (vertx, verty, vertz) let triangle ~edge ~amp ~divisions ~z = let divi = float divisions in let vr = edge *. sqrt3 /. 3. in let ampvr2 = amp /. sqr vr and zf = edge *. z in let ax = edge *. (0.5 /. divi) and ay = edge *. (-0.5 *. sqrt3 /. divi) and bx = edge *. (-0.5 /. divi) in for ri = 1 to divisions do GlDraw.begins `triangle_strip; for ti = 0 to ri - 1 do vertex ~zf ~ampvr2 ~xf:(float (ri-ti) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti) *. ay +. float ti *. ay); vertex ~zf ~ampvr2 ~xf:(float (ri-ti-1) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti-1) *. ay +. float ti *. ay) done; vertex ~xf:(float ri *. bx) ~yf:(vr +. float ri *. ay) ~zf ~ampvr2; GlDraw.ends () done let square ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr (edge *. sqrt2 /. 2.) in for yi = 0 to divisions - 1 do let yf = edge *. (-0.5 +. float yi /. divi) in let yf2 = sqr yf in let y = yf +. 1.0 /. divi *. edge in let y2 = sqr y in GlDraw.begins `quad_strip; for xi = 0 to divisions do let xf = edge *. (-0.5 +. float xi /. divi) in vertex ~xf ~yf:y ~zf ~ampvr2; vertex ~xf ~yf ~zf ~ampvr2 done; GlDraw.ends () done let pentagon ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr(edge *. cossec36_2) in let x = Array.init 6 ~f:(fun fi -> -. cos (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) and y = Array.init 6 ~f:(fun fi -> sin (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) in for ri = 1 to divisions do for fi = 0 to 4 do GlDraw.begins `triangle_strip; for ti = 0 to ri-1 do vertex ~zf ~ampvr2 ~xf:(float(ri-ti) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti) *. y.(fi) +. float ti *. y.(fi+1)); vertex ~zf ~ampvr2 ~xf:(float(ri-ti-1) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti-1) *. y.(fi) +. float ti *. y.(fi+1)) done; vertex ~xf:(float ri *. x.(fi+1)) ~yf:(float ri *. y.(fi+1)) ~zf ~ampvr2; GlDraw.ends () done done let call_list list color = GlLight.material ~face:`both (`diffuse color); GlList.call list let draw_tetra ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(0.5 /. sqrt6); GlList.ends(); call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.tetraangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(sqrt3 /. 2.) (); call_list list color.(2); GlMat.pop(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(-.sqrt3 /. 2.) (); call_list list color.(3); GlList.delete list let draw_cube ~amp ~divisions ~color = let list = GlList.create `compile in square ~edge:2.0 ~amp ~divisions ~z:0.5; GlList.ends (); call_list list color.(0); for i = 1 to 3 do GlMat.rotate ~angle:cubeangle ~x:1.0 (); call_list list color.(i) done; GlMat.rotate ~angle:cubeangle ~y:1.0 (); call_list list color.(4); GlMat.rotate ~angle:(2.0 *. cubeangle) ~y:1.0 (); call_list list color.(5); GlList.delete list let draw_octa ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(1.0 /. sqrt6); GlList.ends (); let do_list (i,y) = GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-.octaangle) ~x:0.5 ~y (); call_list list color.(i); GlMat.pop() in call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); List.iter [2, sqrt3 /. 2.0; 3, -.sqrt3 /. 2.0] ~f:do_list; GlMat.rotate ~angle:180.0 ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(4)); GlList.call list; GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(5)); GlList.call list; GlMat.pop(); List.iter [6, sqrt3 /. 2.0; 7, -.sqrt3 /. 2.0] ~f:do_list; GlList.delete list let draw_dodeca ~amp ~divisions ~color = let tau = (sqrt5 +. 1.0) /. 2.0 in let list = GlList.create `compile in pentagon ~edge:2.0 ~amp ~divisions ~z:(sqr(tau) *. sqrt ((tau+.2.0)/.5.0) /. 2.0); GlList.ends (); let do_list (i,angle,x,y) = GlMat.push(); GlMat.rotate ~angle:angle ~x ~y (); call_list list color.(i); GlMat.pop(); in GlMat.push (); call_list list color.(0); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 1, -.dodecaangle, 1.0, 0.0; 2, -.dodecaangle, cos72, sin72; 3, -.dodecaangle, cos72, -.sin72; 4, dodecaangle, cos36, -.sin36; 5, dodecaangle, cos36, sin36 ]; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(6); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 7, -.dodecaangle, 1.0, 0.0; 8, -.dodecaangle, cos72, sin72; 9, -.dodecaangle, cos72, -.sin72; 10, dodecaangle, cos36, -.sin36 ]; GlMat.rotate ~angle:dodecaangle ~x:cos36 ~y:sin36 (); call_list list color.(11); GlList.delete list let draw_ico ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:1.5 ~amp ~divisions ~z:((3.0 *. sqrt3 +. sqrt15) /. 12.0); GlList.ends (); let do_list1 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(sqrt3/.2.0) (); call_list list color.(i) and do_list2 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(-.sqrt3/.2.0) (); call_list list color.(i) and do_list3 i = GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.icoangle) ~x:1.0 (); call_list list color.(i) in GlMat.push (); call_list list color.(0); GlMat.push (); do_list3 1; GlMat.push (); do_list1 2; GlMat.pop (); do_list2 3; GlMat.pop (); GlMat.push (); do_list1 4; GlMat.push (); do_list1 5; GlMat.pop(); do_list3 6; GlMat.pop (); do_list2 7; GlMat.push (); do_list2 8; GlMat.pop (); do_list3 9; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(10); GlMat.push (); do_list3 11; GlMat.push (); do_list1 12; GlMat.pop (); do_list2 13; GlMat.pop (); GlMat.push (); do_list1 14; GlMat.push (); do_list1 15; GlMat.pop (); do_list3 16; GlMat.pop (); do_list2 17; GlMat.push (); do_list2 18; GlMat.pop (); do_list3 19; GlList.delete list class view togl = object (self) val togl = togl val mutable smooth = true val mutable step = 0. val mutable obj = 1 val mutable draw_object = fun ~amp -> () val mutable magnitude = 0. method width = Togl.width togl method height = Togl.height togl method draw = let ratio = float self#height /. float self#width in GlClear.clear [`color;`depth]; GlMat.push (); GlMat.translate () ~z:(-10.0); GlMat.scale () ~x:(scale *. ratio) ~y:scale ~z:scale; GlMat.translate () ~x:(2.5 *. ratio *. sin (step *. 1.11)) ~y:(2.5 *. cos (step *. 1.25 *. 1.11)); GlMat.rotate ~angle:(step *. 100.) ~x:1.0 (); GlMat.rotate ~angle:(step *. 95.) ~y:1.0 (); GlMat.rotate ~angle:(step *. 90.) ~z:1.0 (); draw_object ~amp:((sin step +. 1.0/.3.0) *. (4.0/.5.0) *. magnitude); GlMat.pop(); Gl.flush(); Togl.swap_buffers togl; step <- step +. 0.05 method reshape = GlDraw.viewport ~x:0 ~y:0 ~w:self#width ~h:self#height; GlMat.mode `projection; GlMat.load_identity(); GlMat.frustum ~x:(-1.0, 1.0) ~y:(-1.0, 1.0) ~z:(5.0, 15.0); GlMat.mode `modelview method key sym = begin match sym with "1" -> obj <- 1 | "2" -> obj <- 2 | "3" -> obj <- 3 | "4" -> obj <- 4 | "5" -> obj <- 5 | "Return" -> smooth <- not smooth | "Escape" -> Tk.destroy (Winfo.toplevel togl); exit 0 | _ -> () end; self#pinit method pinit = begin match obj with 1 -> draw_object <- draw_tetra ~divisions:tetradivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite|]; magnitude <- 2.5 | 2 -> draw_object <- draw_cube ~divisions:cubedivisions ~color:[|materialRed; materialGreen; materialCyan; materialMagenta; materialYellow; materialBlue|]; magnitude <- 2.0 | 3 -> draw_object <- draw_octa ~divisions:octadivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialMagenta; materialGray; materialYellow|]; magnitude <- 2.5 | 4 -> draw_object <- draw_dodeca ~divisions:dodecadivisions ~color:[|materialRed; materialGreen; materialCyan; materialBlue; materialMagenta; materialYellow; materialGreen; materialCyan; materialRed; materialMagenta; materialBlue; materialYellow|]; magnitude <- 2.0 | 5 -> draw_object <- draw_ico ~divisions:icodivisions ~color:[|materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialGray|]; magnitude <- 3.5 | _ -> () end; GlDraw.shade_model (if smooth then `smooth else `flat) end open Tk let main () = List.iter ~f:print_string [ "Morph 3D - Shows morphing platonic polyhedra\n"; "Author: Marcelo Fernandes Vianna (vianna@cat.cbpf.br)\n"; "Ported to LablGL by Jacques Garrigue\n\n"; " [1] - Tetrahedron\n"; " [2] - Hexahedron (Cube)\n"; " [3] - Octahedron\n"; " [4] - Dodecahedron\n"; " [5] - Icosahedron\n"; "[RETURN] - Toggle smooth/flat shading\n"; " [ESC] - Quit\n" ]; flush stdout; let top = openTk () in let togl = Togl.create top ~width:640 ~height:480 ~depth:true ~double:true ~rgba:true in Wm.title_set top "Morph 3D - Shows morphing platonic polyhedra"; GlClear.depth 1.0; GlClear.color (0.0, 0.0, 0.0); GlDraw.color (1.0, 1.0, 1.0); GlClear.clear [`color;`depth]; Gl.flush(); Togl.swap_buffers togl; List.iter ~f:(GlLight.light ~num:0) [`ambient ambient; `diffuse diffuse; `position position0]; List.iter ~f:(GlLight.light ~num:1) [`ambient ambient; `diffuse diffuse; `position position1]; GlLight.light_model (`ambient lmodel_ambient); GlLight.light_model (`two_side lmodel_twoside); List.iter ~f:Gl.enable [`lighting;`light0;`light1;`depth_test;`normalize]; GlLight.material ~face:`both (`shininess front_shininess); GlLight.material ~face:`both (`specular front_specular); GlMisc.hint `fog `fastest; GlMisc.hint `perspective_correction `fastest; GlMisc.hint `polygon_smooth `fastest; let view = new view togl in view#pinit; Togl.display_func togl ~cb:(fun () -> view#draw); Togl.reshape_func togl ~cb:(fun () -> view#reshape); Togl.timer_func ~ms:20 ~cb:(fun () -> view#draw); bind togl ~events:[`KeyPress] ~fields:[`KeySymString] ~action:(fun ev -> view#key ev.ev_KeySymString); bind togl ~events:[`Enter] ~action:(fun _ -> Focus.set togl); pack [togl] ~expand:true ~fill:`Both; mainLoop () let _ = main () lablgl-1.05/Togl/examples/planet.ml000644 000765 000024 00000007143 12217024174 020211 0ustar00garriguestaff000000 000000 (* $Id: planet.ml,v 1.17 2001-09-07 06:50:01 garrigue Exp $ *) #load"unix.cma";; class planet togl = object (self) val togl = togl val mutable year = 0.0 val mutable day = 0.0 val mutable eye = 0.0 val mutable time = 0.0 method tick new_time = if time = 0. then time <- new_time else let diff = new_time -. time in time <- new_time; day <- mod_float (day +. diff *. 200.) 360.0; year <- mod_float (year +. diff *. 20.) 360.0 method day_add = day <- mod_float (day +. 10.0) 360.0 method day_subtract = day <- mod_float (day -. 10.0) 360.0 method year_add = year <- mod_float (year +. 5.0) 360.0 method year_subtract = year <- mod_float (year -. 5.0) 360.0 method eye x = eye <- x; self#display method display = GlClear.clear [`color;`depth]; GlDraw.color (1.0, 1.0, 1.0); GlMat.push(); GlMat.rotate ~angle:eye ~x:1. (); (* draw sun *) GlLight.material ~face:`front (`specular (1.0,1.0,0.0,1.0)); GlLight.material ~face:`front (`shininess 5.0); GluQuadric.sphere ~radius:1.0 ~slices:32 ~stacks:32 (); (* draw smaller planet *) GlMat.rotate ~angle:year ~y:1.0 (); GlMat.translate () ~x:3.0; GlMat.rotate ~angle:day ~y:1.0 (); GlDraw.color (0.0, 1.0, 1.0); GlDraw.shade_model `flat; GlLight.material ~face:`front(`shininess 128.0); GluQuadric.sphere ~radius:0.2 ~slices:10 ~stacks:10 (); GlDraw.shade_model `smooth; GlMat.pop (); Gl.flush (); Togl.swap_buffers togl end let myinit () = let light_ambient = 0.5, 0.5, 0.5, 1.0 and light_diffuse = 1.0, 0.8, 0.2, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in List.iter (GlLight.light ~num:0) [ `ambient light_ambient; `diffuse light_diffuse; `specular light_specular; `position light_position ]; GlFunc.depth_func `less; List.iter Gl.enable [`lighting; `light0; `depth_test]; GlDraw.shade_model `smooth let my_reshape togl = let w = Togl.width togl and h = Togl.height togl in GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity(); GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(1.0,20.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate () ~z:(-5.0) (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) open Tk let main () = let top = openTk () in let togl = Togl.create top ~width:700 ~height:500 ~double:true ~rgba:true ~depth:true in Wm.title_set top "Planet"; myinit (); let planet = new planet togl in let scale = Scale.create top ~min:(-45.) ~max:45. ~orient:`Vertical ~command:(planet#eye) ~showvalue:false ~highlightbackground:`Black in bind togl ~events:[`Enter] ~action:(fun _ -> Focus.set togl); bind scale ~events:[`Enter] ~action:(fun _ -> Focus.set scale); bind togl ~events:[`KeyPress] ~fields:[`KeySymString] ~action:(fun ev -> begin match ev.ev_KeySymString with "Left" -> planet#year_subtract | "Right" -> planet#year_add | "Up" -> planet#day_add | "Down" -> planet#day_subtract | "Escape" -> destroy top; exit 0 | _ -> () end; planet#display); Togl.timer_func ~ms:20 ~cb:(fun () -> planet#tick (Unix.gettimeofday()); planet#display); Togl.display_func togl ~cb:(fun () -> planet#display); Togl.reshape_func togl ~cb:(fun () -> my_reshape togl); my_reshape togl; pack [togl] ~side:`Left ~expand:true ~fill:`Both; pack [scale] ~side:`Right ~fill:`Y; Focus.set togl; mainLoop () let _ = Printexc.print main () lablgl-1.05/Togl/examples/README000644 000765 000024 00000000132 12217024174 017243 0ustar00garriguestaff000000 000000 $Id: README,v 1.3 2003-09-26 08:25:27 garrigue Exp $ Here are a few examples for LablGL. lablgl-1.05/Togl/examples/scene.ml000644 000765 000024 00000005744 12217024174 020030 0ustar00garriguestaff000000 000000 (* $Id: scene.ml,v 1.12 2001-05-08 01:58:26 garrigue Exp $ *) (* Initialize material property and light source. *) let myinit () = let light_ambient = 0.0, 0.0, 0.0, 1.0 and light_diffuse = 1.0, 1.0, 1.0, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in GlLight.light ~num:0 (`ambient light_ambient); GlLight.light ~num:0 (`diffuse light_diffuse); GlLight.light ~num:0 (`specular light_specular); GlLight.light ~num:0 (`position light_position); GlFunc.depth_func `less; List.iter Gl.enable [`lighting; `light0; `depth_test] let pi = acos (-1.) let solid_torus ~inner ~outer = let slices = 32 and faces = 16 in let slice_angle = 2.0 *. pi /. float slices and face_angle = 2.0 *. pi /. float faces in let vertex ~i ~j = let angle1 = slice_angle *. float i and angle2 = face_angle *. float j in GlDraw.normal3 (cos angle1 *. cos angle2, -. sin angle1 *. cos angle2, sin angle2); GlDraw.vertex3 ((outer +. inner *. cos angle2) *. cos angle1, -. (outer +. inner *. cos angle2) *. sin angle1, inner *. sin angle2) in GlDraw.begins `quads; for i = 0 to slices - 1 do for j = 0 to faces - 1 do vertex ~i ~j; vertex ~i:(i+1) ~j; vertex ~i:(i+1) ~j:(j+1); vertex ~i ~j:(j+1); done done; GlDraw.ends () let solid_cone ~radius ~height = GluQuadric.cylinder ~base:radius ~top:0. ~height ~slices:15 ~stacks:10 () let solid_sphere ~radius = GluQuadric.sphere ~radius ~slices:32 ~stacks:32 () let display () = GlClear.clear [`color; `depth]; GlMat.push (); GlMat.rotate ~angle:20.0 ~x:1.0 (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:0.5 (); GlMat.rotate ~angle:90.0 ~x:1.0 (); solid_torus ~inner:0.275 ~outer:0.85; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:(-0.5) (); GlMat.rotate ~angle:270.0 ~x:1.0 (); solid_cone ~radius:1.0 ~height:2.0; GlMat.pop (); GlMat.push (); GlMat.translate ~x:0.75 ~z:(-1.0) (); solid_sphere ~radius:1.0; GlMat.pop (); GlMat.pop (); Gl.flush () let my_reshape ~w ~h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); if w <= h then GlMat.ortho ~x:(-2.5,2.5) ~z:(-10.0,10.0) ~y:(-2.5 *. float h /. float w, 2.5 *. float h /. float w) else GlMat.ortho ~y:(-2.5,2.5) ~z:(-10.0,10.0) ~x:(-2.5 *. float w /. float h, 2.5 *. float w /. float h); GlMat.mode `modelview (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) open Tk let main () = let top = openTk () in let togl = Togl.create top ~rgba:true ~depth:true ~width:500 ~height:500 in Wm.title_set top "Scene"; myinit (); Togl.reshape_func togl ~cb:(fun () -> my_reshape ~w:(Togl.width togl) ~h:(Togl.height togl)); Togl.display_func togl ~cb:display; pack [togl] ~expand:true ~fill:`Both; mainLoop () let _ = Printexc.print main () lablgl-1.05/Togl/examples/simple.ml000644 000765 000024 00000002032 12217024174 020207 0ustar00garriguestaff000000 000000 (* $Id: simple.ml,v 1.10 2002-04-27 02:35:45 garrigue Exp $ *) open Tk let main () = (* Aux.init_display_mode [`rgb;`single;`depth]; Aux.init_position ~x:0 ~y:0 ~w:500 ~h:500; Aux.init_window ~title:"LablGL"; *) let top = openTk () in let togl = Togl.create top ~width:500 ~height:500 ~rgba:true ~depth:true ~double:true in Wm.title_set top "LablGL"; pack ~fill:`Both [togl]; Togl.display_func togl ~cb: begin fun () -> GlClear.color (0.0, 0.0, 0.0); GlClear.clear [`color]; GlDraw.color (1.0, 1.0, 1.0); GlMat.mode `projection; GlMat.load_identity (); GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0); GlDraw.begins `polygon; GlDraw.vertex ~x:(-0.5) ~y:(-0.5) (); GlDraw.vertex ~x:(-0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(-0.5) (); GlDraw.ends (); Gl.flush (); Togl.swap_buffers togl end; ignore (Timer.add ~ms:10000 ~callback:(fun () -> destroy top)); mainLoop () let _ = main () lablgl-1.05/Togl/examples/tennis.ml000644 000765 000024 00000033371 12217024174 020230 0ustar00garriguestaff000000 000000 (* This program was written by Yasuhiko Minamide, nan@kurims.kyoto-u.ac.jp *) (* $Id: tennis.ml,v 1.17 2001-05-08 01:58:26 garrigue Exp $ *) open StdLabels let image_height = 64 and image_width = 64 let make_image () = let image = GlPix.create `ubyte ~width:image_width ~height:image_height ~format:`rgba in for i = 0 to image_width - 1 do for j = 0 to image_height - 1 do Raw.sets (GlPix.to_raw image) ~pos:(4*(i*image_height+j)) (if (((i land 6 ) = 6) or ((j land 6) = 6)) then [|0;0;0;255|] else [|255;255;255;0|]) done done; image let image_height = 256 and image_width = 256 let make_image2 () = let on_circle (x0,y0) (x,y) = let d = (x -. x0) *. (x -. x0) +. (y -. y0) *. (y -. y0) in ((d > 0.9 *. 0.9) && (d < 1.1 *. 1.1)) in let on_line (x,y) = if x <= -.2.0 then on_circle (-. 2.0, 0.0) (x,y) else if x >= 2.0 then on_circle (2.0, 0.0) (x,y) else ((0.9 < y) && (y < 1.1)) || ((-1.1 <= y) && ( y <= -0.9)) in let on_white (i,j) = let x = (float (i - 128) /. 128.0) *. 6.0 in let y = (float (j - 128) /. 128.0) *. 2.0 in on_line (x,y) in let image = GlPix.create `ubyte ~width:image_width ~height:image_height ~format:`rgb in for i = 0 to image_width - 1 do for j = 0 to image_height - 1 do Raw.sets (GlPix.to_raw image) ~pos:(3*(i*image_height+j)) (if on_white (j,i) then [|255;255;255|] else [|255;255;0|]) done done; image let ft x = x *. 0.03 let cw = ft (9.0 +. 4.5) let cl = ft 39.0 let sw = ft 9.0 let sl = ft 21.0 let lw = 0.015 let wlw = 0.02 let square (x1, y1) (x2, y2) = List.iter ~f:GlDraw.vertex2 [ x1, y1; x2, y1; x2, y2; x1, y2 ] let collide ~pos ~vel ~plane ~func = let between (a,b,x) = let (a,b) = if a > b then (b,a) else (a,b) in (x > a) && (x < b) in let (xpos,ypos,zpos) = pos in let (dx,dy,dz) = vel in if dx = 0.0 then (xpos, ypos +. dy, zpos +. dz) else let ((x1,y1,z1),(x2,y2,z2)) = plane in let y = if dy = 0.0 then ypos else (dy /. dx) *. (x1 -. xpos) +. ypos in let z = if dz = 0.0 then zpos else (dz /. dx) *. (x1 -. xpos) +. zpos in if between (y1, y2, y) && between (z1, z2, z) && between (xpos, xpos +. dx, x1) then begin func (); (x1, y, z) end else (xpos +. dx, ypos +. dy, zpos +. dz) class ball () = object (self) val mutable x = 0.0 val mutable y = 0.0 val mutable z = 0.2 val mutable target_x = 0.0 val mutable target_y = 0.0 val mutable velocity = 0.0 val mutable angle_z = 0.0 val mutable vel_z = 0.0 val mutable vel_y = 0.0 val mutable vel_x = 0.0 val mutable moving = false val image = make_image2 () method set_vel v = velocity <- v /. 36.0; method set_velz v = angle_z <- v method reset = () method draw = Gl.disable `blend; GlDraw.color (1.0, 1.0, 0.0); GlMat.push (); GlMat.translate ~x ~y ~z (); GluQuadric.sphere ~radius:0.01 ~slices:8 ~stacks:8 (); GlMat.pop () method drawtexture = let q = GluQuadric.create () in GlMat.push (); Gl.enable `texture_2d; GlTex.image2d image; List.iter ~f:(GlTex.parameter ~target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; GlMat.translate ~x ~y ~z (); GluQuadric.texture q true; GluQuadric.sphere ~radius:0.01 ~slices:16 ~stacks:8 ~quad:q (); Gl.disable `texture_2d; GlMat.pop () method draw_shadow = Gl.disable `blend; GlDraw.color (0.0, 0.0, 0.0); GlMat.push (); GlMat.translate ~x ~y (); GluQuadric.disk ~inner:0.0 ~outer:0.01 ~slices:8 ~loops:8 (); GlMat.pop () method draw_target = let (x,y) = (target_x, target_y) in GlDraw.begins `quads; GlDraw.color (0.0, 0.0, 1.0); square (x -. 0.05, y +. 0.05) (x +. 0.05, y -. 0.05); GlDraw.ends () method do_tick delta = if moving then let (x',y',z') = collide ~pos:(x,y,z) ~vel:(-. vel_x *. delta, vel_y *. delta, vel_z *. delta) ~plane:((0.0, -. cw, 0.0), (0.0, cw, 0.1)) ~func:(function () -> begin vel_x <- 0.0; vel_y <- 0.0; vel_z <- 0.0 end) in let vel_z' = vel_z in let (z',vel_z') = if z' < 0.01 then (-. (z' -. 0.01) +. 0.01, -. vel_z' *. 0.7) else (z',vel_z') in let vel_z' = vel_z' -. delta *. 0.98 in vel_z <- vel_z'; x <- x'; y <- y'; z <- z' else (); moving method set_position x' y' = x <- x'; y <- y' method set_target x' y' = target_x <- x'; target_y <- y' method set_z z' = z <- z' /. 100. method get_position = (x, y) method calc_vel = let dx = x -. target_x and dy = target_y -. y in let d' = sqrt ( dx *. dx +. dy *. dy) in let cos_z = cos(angle_z /. 180. *. 3.14) in if cos_z = 0.0 or d' = 0.0 then () else let dz = d' *. (tan(angle_z /. 180. *. 3.14)) in let d = d' /. cos_z in begin vel_x <- velocity *. dx /. d; vel_y <- velocity *. dy /. d; vel_z <- velocity *. dz /. d end method switch = if moving then self#reset else self#calc_vel; moving <- not moving; moving end class poll = object val r = 0.008 val y = cw +. 0.05 +. 0.008 method draw = Gl.disable `blend; GlDraw.color (0.0, 0.0, 0.0); GlMat.push (); GlMat.translate ~y (); GluQuadric.cylinder ~slices:8 ~stacks:8 ~height:0.12 ~top:r ~base:r (); GlMat.pop (); GlMat.push (); GlMat.translate ~y:(-. y) (); GluQuadric.cylinder ~slices:8 ~stacks:8 ~height:0.12 ~top:r ~base:r (); GlMat.pop () end class court ~togl = object val court = Togl.make_current togl; let court = GlList.create `compile in GlDraw.shade_model `flat; GlDraw.begins `quads; GlDraw.color (0.2, 0.7, 0.2); square (cl, cw) (-.cl, -.cw); (* Lines *) GlDraw.color (1.0, 1.0, 1.0); square (-.cl, cw) (cl, cw -. lw); square (-.cl, -.cw) (cl, -.cw +. lw); square (cl, cw) (cl -. wlw, -. cw); square (-.cl, cw) (-.cl +. wlw, -.cw); square (-.sl, lw /. 2.) (sl, -.lw /. 2.); square (-.cl, sw) (cl, sw -. lw); square (-.cl, -.sw) (cl, -.sw +. lw); square (sl, sw) (sl -. lw, -. sw); square (-.sl, sw) (-.sl +. lw, -.sw); GlDraw.ends (); GlList.ends (); court method draw = GlList.call court end class player = object (* position of a player *) val mutable x = -1.0 val mutable y = 0.5 method move x' y' = x <- -. x'; y <- y' method position = (x,y) end class net ~togl = object val texture = Togl.make_current togl; make_image () (* let image = make_image () in GlTex.image2d image; List.iter f:(GlTex.parameter target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; *) method draw = Gl.enable `blend; GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha; GlDraw.color (0.0, 0.0, 0.0) ~alpha:1.0; GlTex.env (`mode `replace); Gl.enable `texture_2d; GlTex.image2d texture; List.iter ~f:(GlTex.parameter ~target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; GlDraw.begins `quads; GlTex.coord2(0.0, 0.0); GlDraw.vertex3(0.0, cw +. 0.05, 0.0); GlTex.coord2(0.0, 3.0); GlDraw.vertex3(0.0, cw +. 0.05, 0.115); GlTex.coord2(9.0, 3.0); GlDraw.vertex3(0.0, 0.0, 0.09); GlTex.coord2(9.0, 0.0); GlDraw.vertex3(0.0, 0.0, 0.0); GlTex.coord2(0.0, 0.0); GlDraw.vertex3(0.0, 0.0, 0.0); GlTex.coord2(0.0, 3.0); GlDraw.vertex3(0.0, 0.0, 0.09); GlTex.coord2(9.0, 3.0); GlDraw.vertex3(0.0, -.cw -. 0.05, 0.115); GlTex.coord2(9.0, 0.0); GlDraw.vertex3(0.0, -.cw -. 0.05, 0.0); GlDraw.ends (); Gl.disable `texture_2d; Gl.disable `blend; GlDraw.color (1.0, 1.0, 1.0); GlDraw.begins `quad_strip; List.iter ~f:(fun (y,z) -> GlDraw.vertex ~x:0. ~y ~z ()) [ cw +. 0.05, 0.11; cw +. 0.05, 0.115; 0.0, 0.085; 0.0, 0.09; -.cw -. 0.05, 0.11; -.cw -. 0.05, 0.115 ]; GlDraw.ends () end class view3d ~togl ~ball ~player ~viewtype = object val ball : ball = ball val player : player = player val court = new court ~togl val net = new net ~togl val poll = new poll method draw = Togl.make_current togl; GlClear.color (0.5, 0.5, 1.0); GlClear.clear [`color;`depth]; if viewtype () = "Top View" then begin GlMat.mode `projection; GlMat.load_identity (); GlMat.rotate ~angle:90.0 ~z:1.0 (); GlMat.ortho ~x:(-1.2,1.2) ~y:(-1.2,1.2) ~z:(0.0,2.0); GlMat.mode `modelview; GlMat.load_identity (); GluMat.look_at ~eye:(0.0, 0.0, 2.0) ~center:(0.0, 0.0, 0.0) ~up:(0.0, 1.0, 0.0) end else begin GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:40.0 ~aspect:1.0 ~z:(0.1,4.0); GlMat.mode `modelview; if viewtype () = "Center" then begin GlMat.load_identity (); let (x,y) = player#position in GluMat.look_at ~eye:(x, y, 0.2) ~center:(0.0, 0.0, 0.09) ~up:(-. x, -. y, 0.0) end else begin GlMat.load_identity (); let (x,y) = player#position in let (x',y') = ball#get_position in GluMat.look_at ~eye:(x, y, 0.2) ~center:(x', y', 0.09) ~up:(x' -. x, y' -. y, 0.0) end; end; GlDraw.shade_model `flat; (* Ground *) GlDraw.begins `quads; GlDraw.color (0.5, 0.5, 0.5); square (-5.0, 5.0) (5.0, -5.0); GlDraw.ends (); court#draw; let (x,y) = ball#get_position in if x < 0.0 then (net#draw; ball#draw_shadow; ball#draw) else (ball#draw_shadow; ball#draw; net#draw); poll#draw; Togl.swap_buffers togl; Gl.flush () end class view2d ~togl ~ball ~player = object val ball : ball = ball val player : player = player val court = new court ~togl:togl method draw = Togl.make_current togl; GlClear.clear [`color;`depth]; GlMat.mode `projection; GlMat.load_identity (); GlMat.rotate ~angle:90.0 ~z:1.0 (); GlMat.ortho ~x:(-1.5,1.5) ~y:(-1.5,1.5) ~z:(0.0,2.0); GlMat.mode `modelview; GlMat.load_identity (); let (x,y) = player#position in GluMat.look_at ~eye:(0.0, 0.0, 2.0) ~center:(0.0, 0.0, 0.0) ~up:(0.0, 1.0, 0.0); court#draw; ball#draw; let (x,y) = player#position in GlDraw.begins `quads; GlDraw.color (1.0, 0.0, 0.0); square (x -. 0.02, y +. 0.02) (x +. 0.02, y -. 0.02); GlDraw.ends (); ball#draw_target; Togl.swap_buffers togl; Gl.flush () end open Tk let main () = let top = openTk () in Wm.title_set top "Tennis Court"; let f0 = Frame.create top in let court3d = Togl.create f0 ~width:600 ~height:600 ~rgba:true ~double:true ~depth:true and f1 = Frame.create f0 in let court2d = Togl.create f1 ~width:200 ~height:200 ~rgba:true ~double:true ~depth:true and sx = Scale.create f1 ~label:"Velocity" ~min:0. ~max:200. ~orient:`Horizontal and sz = Scale.create f1 ~label:"Direction" ~min: (-. 90.) ~max:90. ~orient:`Horizontal and sht = Scale.create f1 ~label:"Height" ~min: 0. ~max:100. ~orient:`Horizontal and start = Button.create f1 ~text:"Start" in let viewseltv = Textvariable.create () in Textvariable.set viewseltv "Top View"; let viewself = Frame.create f1 in let viewsel = List.map ["Top View"; "Center"; "Ball"] ~f: begin fun t -> Radiobutton.create viewself ~text: t ~value: t ~variable: viewseltv end in pack viewsel; let viewtype = fun () -> Textvariable.get viewseltv in let ball = new ball () in let player = new player in let view3d = new view3d ~togl:court3d ~viewtype ~ball ~player and view2d = new view2d ~togl:court2d ~ball ~player in Scale.configure sx ~command:(ball#set_vel); Scale.configure sz ~command:(ball#set_velz); Button.configure start ~command: begin fun () -> Button.configure start ~text:(if ball#switch then "Stop" else "Start") end; Togl.timer_func ~ms:20 ~cb:(fun () -> if ball#do_tick 0.02 then (view3d#draw; view2d#draw)); Togl.display_func court3d ~cb:(fun () -> view3d#draw); Togl.display_func court2d ~cb:(fun () -> view2d#draw); bind court3d ~events:[`Modified([`Button1],`Motion)] ~fields:[`MouseX;`MouseY] ~action:(fun ev -> let width = Togl.width court3d and height =Togl.height court3d in let y = -. (float ev.ev_MouseX /. float width) +. 0.5 and x = float ev.ev_MouseY /. float height in player#move x y; view2d#draw; view3d#draw); bind court2d ~events:[`Modified([`Button1],`Motion)] ~fields:[`MouseX;`MouseY] ~action:(fun ev -> let width = Togl.width court2d and height =Togl.height court2d in let y = (float ev.ev_MouseX /. float width ) -. 0.5 and x = (float ev.ev_MouseY /. float height) -. 0.5 in let y = -. (y *. 3.0) and x = -. (x *. 3.0) in ball#set_position x y; view2d#draw; view3d#draw); bind court2d ~events:[`Modified([`Button2],`Motion)] ~fields:[`MouseX;`MouseY] ~action:(fun ev -> let width = Togl.width court2d and height =Togl.height court2d in let y = (float ev.ev_MouseX /. float width ) -. 0.5 and x = (float ev.ev_MouseY /. float height) -. 0.5 in let y = -. (y *. 3.0) and x = -. (x *. 3.0) in ball#set_target x y; print_float x; print_float y; print_string "\n"; view2d#draw; view3d#draw); let rec viewselfn () = begin Textvariable.handle viewseltv ~callback:viewselfn; view3d#draw end in viewselfn (); Scale.configure sht ~command:(fun z -> ball#set_z z; view3d#draw); pack [coe court2d; coe sx; coe sz; coe sht;coe start; coe viewself]; pack [coe court3d; coe f1] ~side:`Left; pack [f0] ~expand:true ~fill:`Both; mainLoop () let _ = main () lablgl-1.05/Togl/examples/tesselate.ml000644 000765 000024 00000001353 12217024174 020714 0ustar00garriguestaff000000 000000 (* $Id: tesselate.ml,v 1.1 2004-07-13 07:55:18 garrigue Exp $ *) open Tk let top = openTk() let togl = Togl.create top ~width:500 ~height:500 ~rgba:true ~depth:true ~double:true let () = Wm.title_set top "LablGL"; pack ~fill:`Both [togl]; Togl.display_func togl ~cb: begin fun () -> GlClear.color (0.0, 0.0, 0.0); GlClear.clear [`color]; GlDraw.color (1.0, 1.0, 1.0); GlMat.mode `projection; GlMat.load_identity (); GlMat.ortho ~x:(-1.0,2.0) ~y:(-1.0,2.0) ~z:(-1.0,2.0); GluTess.tesselate [[0.,0.,0.;1.,0.,0.;1.,1.,0.;0.,1.,0.]; [0.2,0.2,0.;0.2,0.8,0.;0.8,0.8,0.;0.8,0.2,0.]]; Gl.flush (); Togl.swap_buffers togl end; mainLoop() lablgl-1.05/Togl/examples/texturesurf.ml000644 000765 000024 00000006362 12217024174 021330 0ustar00garriguestaff000000 000000 (* $Id: texturesurf.ml,v 1.13 2001-05-08 01:58:26 garrigue Exp $ *) open StdLabels let texpts = [|[|0.0; 0.0; 0.0; 1.0|]; [|1.0; 0.0; 1.0; 1.0|]|] let ctrlpoints = [|[|-1.5; -1.5; 4.9; -0.5; -1.5; 2.0; 0.5; -1.5; -1.0; 1.5; -1.5; 2.0|]; [|-1.5; -0.5; 1.0; -0.5; -0.5; 3.0; 0.5; -0.5; 0.0; 1.5; -0.5; -1.0|]; [|-1.5; 0.5; 4.0; -0.5; 0.5; 0.0; 0.5; 0.5; 3.0; 1.5; 0.5; 4.0|]; [|-1.5; 1.5; -2.0; -0.5; 1.5; -2.0; 0.5; 1.5; 0.0; 1.5; 1.5; -1.0|]|] let image_width = 64 and image_height = 64 let pi = acos (-1.0) let display togl = GlClear.clear [`color;`depth]; GlDraw.color (1.0,1.0,1.0); GlMap.eval_mesh2 ~mode:`fill ~range1:(0,20) ~range2:(0,20); Gl.flush (); Togl.swap_buffers togl let make_image () = let image = GlPix.create `ubyte ~height:image_height ~width:image_width ~format:`rgb in let raw = GlPix.to_raw image and pos = GlPix.raw_pos image in for i = 0 to image_width - 1 do let ti = 2.0 *. pi *. float i /. float image_width in for j = 0 to image_height - 1 do let tj = 2.0 *. pi *. float j /. float image_height in Raw.sets raw ~pos:(pos ~x:j ~y:i) (Array.map ~f:(fun x -> truncate (127.0 *. (1.0 +. x))) [|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]); done; done; image let myinit () = let ctrlpoints = Raw.of_matrix ~kind:`double ctrlpoints and texpts = Raw.of_matrix ~kind:`double texpts in GlMap.map2 ~target:`vertex_3 (0.0, 1.0) ~order:4 (0.0, 1.0) ~order:4 ctrlpoints; GlMap.map2 ~target:`texture_coord_2 (0.0,1.0) ~order:2 (0.0,1.0) ~order:2 texpts; Gl.enable `map2_texture_coord_2; Gl.enable `map2_vertex_3; GlMap.grid2 ~n1:20 ~range1:(0.0,1.0) ~n2:20 ~range2:(0.0,1.0); let image = make_image () in GlTex.env (`mode `decal); List.iter ~f:(GlTex.parameter ~target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; GlTex.image2d image; List.iter ~f:Gl.enable [`texture_2d;`depth_test;`normalize]; GlDraw.shade_model `flat let my_reshape togl = let h = Togl.height togl and w = Togl.width togl in GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); let r = float h /. float w in if w <= h then GlMat.ortho ~x:(-4.0, 4.0) ~y:(-4.0 *. r, 4.0 *. r) ~z:(-4.0, 4.0) else GlMat.ortho ~x:(-4.0 /. r, 4.0 /. r) ~y:(-4.0, 4.0) ~z:(-4.0, 4.0); GlMat.mode `modelview; GlMat.load_identity (); GlMat.rotate ~angle:85. ~x:1. ~y:1. ~z:1. () open Tk let main () = let top = openTk () in let togl = Togl.create top ~rgba:true ~depth:true ~width:300 ~height:300 ~double:true in Wm.title_set top "Texture Surf"; myinit (); Togl.reshape_func togl ~cb:(fun () -> my_reshape togl); Togl.display_func togl ~cb:(fun () -> display togl); bind top ~events:[`KeyPress] ~fields:[`KeySymString] ~action:(fun ev -> match ev.ev_KeySymString with "Up" -> GlMat.rotate ~angle:(-5.) ~z:1.0 (); display togl | "Down" -> GlMat.rotate ~angle:(5.) ~z:1.0 (); display togl | "Left" -> GlMat.rotate ~angle:(5.) ~x:1.0 (); display togl | "Right" -> GlMat.rotate ~angle:(-5.) ~x:1.0 (); display togl | "Escape" -> destroy top; exit 0 | _ -> ()); pack [togl] ~expand:true ~fill:`Both; mainLoop () let _ = main () lablgl-1.05/src/.cvsignore000644 000765 000024 00000000244 12217024174 016433 0ustar00garriguestaff000000 000000 var2def var2switch gl_tags.c gl_tags.h glu_tags.c glu_tags.h raw_tags.c raw_tags.h togl_tags.c togl_tags.h build.ml lablgltop lablgl *.dll *.so *.exp *.lib .depend lablgl-1.05/src/.depend000644 000765 000024 00000003407 12217024174 015677 0ustar00garriguestaff000000 000000 build.cmo: build.cmx: gl.cmo: gl.cmi gl.cmx: gl.cmi glArray.cmo: raw.cmi glDraw.cmi gl.cmi glArray.cmi glArray.cmx: raw.cmx glDraw.cmx gl.cmx glArray.cmi glClear.cmo: gl.cmi glClear.cmi glClear.cmx: gl.cmx glClear.cmi glDraw.cmo: raw.cmi glPix.cmi gl.cmi glDraw.cmi glDraw.cmx: raw.cmx glPix.cmx gl.cmx glDraw.cmi glFunc.cmo: gl.cmi glFunc.cmi glFunc.cmx: gl.cmx glFunc.cmi glLight.cmo: gl.cmi glLight.cmi glLight.cmx: gl.cmx glLight.cmi glList.cmo: glList.cmi glList.cmx: glList.cmi glMap.cmo: raw.cmi glMap.cmi glMap.cmx: raw.cmx glMap.cmi glMat.cmo: raw.cmi glMat.cmi glMat.cmx: raw.cmx glMat.cmi glMisc.cmo: raw.cmi glMisc.cmi glMisc.cmx: raw.cmx glMisc.cmi glPix.cmo: raw.cmi gl.cmi glPix.cmi glPix.cmx: raw.cmx gl.cmx glPix.cmi glShader.cmo: glShader.cmi glShader.cmx: glShader.cmi glTex.cmo: raw.cmi glPix.cmi glMisc.cmi gl.cmi glTex.cmi glTex.cmx: raw.cmx glPix.cmx glMisc.cmx gl.cmx glTex.cmi gluMat.cmo: gl.cmi gluMat.cmi gluMat.cmx: gl.cmx gluMat.cmi gluMisc.cmo: raw.cmi glTex.cmi glPix.cmi gl.cmi gluMisc.cmi gluMisc.cmx: raw.cmx glTex.cmx glPix.cmx gl.cmx gluMisc.cmi gluNurbs.cmo: raw.cmi glMap.cmi gl.cmi gluNurbs.cmi gluNurbs.cmx: raw.cmx glMap.cmx gl.cmx gluNurbs.cmi gluQuadric.cmo: gluQuadric.cmi gluQuadric.cmx: gluQuadric.cmi gluTess.cmo: gluTess.cmi gluTess.cmx: gluTess.cmi raw.cmo: raw.cmi raw.cmx: raw.cmi var2def.cmo: var2def.cmx: var2switch.cmo: var2switch.cmx: gl.cmi: glArray.cmi: raw.cmi glDraw.cmi glClear.cmi: gl.cmi glDraw.cmi: glPix.cmi gl.cmi glFunc.cmi: gl.cmi glLight.cmi: gl.cmi glList.cmi: glMap.cmi: raw.cmi glMat.cmi: raw.cmi gl.cmi glMisc.cmi: raw.cmi glPix.cmi: raw.cmi gl.cmi glShader.cmi: glTex.cmi: glPix.cmi gl.cmi gluMat.cmi: gl.cmi gluMisc.cmi: glTex.cmi glPix.cmi gl.cmi gluNurbs.cmi: raw.cmi glMap.cmi gl.cmi gluQuadric.cmi: gluTess.cmi: raw.cmi: lablgl-1.05/src/build.ml.in000755 000765 000024 00000010553 12217024174 016500 0ustar00garriguestaff000000 000000 (* $Id: build.ml.in,v 1.5 2008-12-26 07:13:21 garrigue Exp $ *) (* A script to build lablGL libraries *) open StdLabels let ocamlc = ref "ocamlc.opt" let ocamlopt = ref "ocamlopt.opt" let flags = ref "-w s -I +labltk" let ccomp_type = ref "msvc" (* "msvc" for MSVC++, "cc" for Mingw. Attempt to autodetect *) let split ?(sep = [' ';'\t';'\r';'\n']) s = let len = String.length s in let rec loop last cur acc = if cur > len then acc else let next = cur+1 in if cur = len || List.mem s.[cur] sep then if cur > last then loop next next (String.sub s ~pos:last ~len:(cur-last) :: acc) else loop next next acc else loop last next acc in List.rev (loop 0 0 []) let lablgl_mls = split "@LABLGL_MLS@" let togl_mls = split "@TOGL_MLS@" let glut_mls = split "@GLUT_MLS@" let gl_libs = "@GLLIBS@" let tk_libs = "@TKLIBS@ " let glut_libs = "@GLUTLIBS@ " (* Hack to check for mingw *) let () = try let ic = open_in "../Makefile.config" in while true do let s = input_line ic in match split ~sep:[' ';'\t';'='] s with "CCOMPTYPE" :: cc :: _ -> ccomp_type := cc | _ -> () done with _ -> () let has_mingw_import nm = (* sufficient for now... *) Filename.check_suffix nm "32.lib" let norm_libs libs = if !ccomp_type = "msvc" then libs else let libs = List.map (split libs) ~f: (fun nm -> if has_mingw_import nm then "-l" ^ Filename.chop_extension nm else nm) in String.concat " " libs let gl_libs = norm_libs gl_libs let tk_libs = norm_libs tk_libs let glut_libs = norm_libs glut_libs let exe cmd args = let cmd = String.concat " " (cmd :: !flags :: args) in print_endline cmd; flush stdout; let err = Sys.command cmd in if err > 0 then failwith ("error "^string_of_int err) let may_remove f = if Sys.file_exists f then Sys.remove f let byte () = List.iter (lablgl_mls @ togl_mls @ glut_mls) ~f: begin fun file -> if Sys.file_exists (file ^ ".mli") then exe !ocamlc ["-c"; file^".mli"]; exe !ocamlc ["-c"; file^".ml"] end; List.iter ["lablgl", lablgl_mls, gl_libs; "togl", togl_mls, tk_libs; "lablglut", glut_mls, glut_libs] ~f:begin fun (lib, mls,libs) -> let cmos = List.map mls ~f:(fun nm -> nm ^".cmo") in exe !ocamlc (["-a -o"; lib^".cma"; "-cclib -l"^lib; "-dllib -l"^lib; "-cclib \""^libs^"\""] @ cmos); List.iter cmos ~f:may_remove end let native () = List.iter (lablgl_mls @ togl_mls @ glut_mls) ~f: (fun file -> exe !ocamlopt ["-c"; file^".ml"]); List.iter ["lablgl", lablgl_mls, gl_libs; "togl", togl_mls, tk_libs; "lablglut", glut_mls, glut_libs] ~f:begin fun (lib, mls,libs) -> let cmxs = List.map mls ~f:(fun nm -> nm ^".cmx") in exe !ocamlopt (["-a -o"; lib^".cmxa"; "-cclib -l"^lib; "-cclib \""^libs^"\""] @ cmxs); List.iter mls ~f:(fun nm -> may_remove (nm ^ ".obj"); may_remove (nm ^ ".o")) end let rename ~ext1 ~ext2 file = if Sys.file_exists (file^ext1) && not (Sys.file_exists (file^ext2)) then begin prerr_endline ("Renaming "^file^ext1^" to "^file^ext2); Sys.rename (file^ext1) (file^ext2) end let () = try let arg = if Array.length Sys.argv > 1 then Sys.argv.(1) else "" in if arg <> "" && arg <> "byte" && arg <> "opt" then begin prerr_endline "ocaml build.ml [ byte | opt ]"; prerr_endline " byte build bytecode library only"; prerr_endline " opt build both bytecode and native (default)"; exit 2 end; byte (); if arg = "opt" || arg <> "byte" then begin try native () with Failure err -> prerr_endline ("Native build failed: " ^ err); prerr_endline "You can still use the bytecode version" end; if !ccomp_type = "msvc" then begin List.iter ["liblablgl"; "libtogl"; "liblablglut"] ~f:(rename ~ext1:".a" ~ext2:".noa"); List.iter ["liblablgl"; "libtogl"; "liblablglut"] ~f:(rename ~ext1:".nolib" ~ext2:".lib"); prerr_endline "Now ready to use on an OCaml MSVC port" end else begin List.iter ["liblablgl"; "libtogl"; "liblablglut"] ~f:(rename ~ext1:".noa" ~ext2:".a"); List.iter ["liblablgl"; "libtogl"; "liblablglut"] ~f:(rename ~ext1:".lib" ~ext2:".nolib"); prerr_endline "Now ready to use on an OCaml Mingw port" end with Failure err -> prerr_endline ("Bytecode failed: " ^ err) lablgl-1.05/src/gl.ml000644 000765 000024 00000006163 12217024174 015375 0ustar00garriguestaff000000 000000 (* $Id: gl.ml,v 1.31 2012-03-06 03:31:02 garrigue Exp $ *) (* Register an exception *) exception GLerror of string let _ = Callback.register_exception "glerror" (GLerror "") (* Types common to all modules *) type rgb = float * float * float type rgba = float * float * float * float type point2 = float * float type point3 = float * float * float type point4 = float * float * float * float type vect3 = float * float *float type clampf = float type short = int type kind = [`bitmap|`byte|`float|`int|`short|`ubyte|`uint|`ushort] type real_kind = [`byte|`float|`int|`short|`ubyte|`uint|`ushort] type format = [`alpha|`bgr|`bgra|`blue|`color_index|`depth_component|`green|`luminance |`luminance_alpha|`red|`rgb|`rgba|`stencil_index] let format_size (#format as f) = match f with `rgba | `bgra -> 4 | `rgb | `bgr -> 3 | `luminance_alpha -> 2 | _ -> 1 type target = [`color_4|`index|`normal|`texture_coord_1|`texture_coord_2|`texture_coord_3 |`texture_coord_4|`trim_2|`trim_3|`vertex_3|`vertex_4] let target_size = function `index|`normal|`texture_coord_1 -> 1 | `texture_coord_2|`trim_2 -> 2 | `vertex_3|`texture_coord_3|`trim_3 -> 3 | `vertex_4|`color_4|`texture_coord_4 -> 4 type cmp_func = [`always|`equal|`gequal|`greater|`lequal|`less|`never|`notequal] type face = [`back|`both|`front] (* Basic functions *) external flush : unit -> unit = "ml_glFlush" external finish : unit -> unit = "ml_glFinish" type cap = [`alpha_test|`auto_normal|`blend|`clip_plane0|`clip_plane1|`clip_plane2 |`clip_plane3|`clip_plane4|`clip_plane5|`color_material|`cull_face |`depth_test|`dither|`fog|`light0|`light1|`light2|`light3|`light4|`light5 |`light6|`light7|`lighting|`line_smooth|`line_stipple |`index_logic_op |`color_logic_op |`map1_color_4|`map1_index|`map1_normal|`map1_texture_coord_1 |`map1_texture_coord_2|`map1_texture_coord_3|`map1_texture_coord_4 |`map1_vertex_3|`map1_vertex_4|`map2_color_4|`map2_index|`map2_normal |`map2_texture_coord_1|`map2_texture_coord_2|`map2_texture_coord_3 |`map2_texture_coord_4|`map2_vertex_3|`map2_vertex_4|`normalize|`point_smooth |`polygon_offset_fill|`polygon_offset_line|`polygon_offset_point |`polygon_smooth|`polygon_stipple|`scissor_test|`stencil_test|`texture_1d |`texture_2d|`texture_gen_q|`texture_gen_r|`texture_gen_s|`texture_gen_t] external enable : cap -> unit = "ml_glEnable" external disable : cap -> unit = "ml_glDisable" external is_enabled : cap -> bool = "ml_glIsEnabled" type error = [`no_error|`invalid_enum|`invalid_value|`invalid_operation |`stack_overflow|`stack_underflow|`out_of_memory|`table_too_large] external get_error : unit -> error = "ml_glGetError" let raise_error name = let err = get_error () in if err = `no_error then () else let s = List.assoc err [ `invalid_enum, "Invalid Enum"; `invalid_value, "Invalid Value"; `invalid_operation, "Invalid Operation"; `stack_overflow, "Stack Overflow"; `stack_underflow, "Stack Underflow"; `out_of_memory, "Out of Memory"; `table_too_large, "Table Too Large" ] in let s = if name = "" then s else (name ^ ": " ^ s) in raise (GLerror s) lablgl-1.05/src/gl.mli000644 000765 000024 00000004447 12217024174 015551 0ustar00garriguestaff000000 000000 (* $Id: gl.mli,v 1.23 2012-03-06 03:31:02 garrigue Exp $ *) (* Exceptions *) exception GLerror of string (* Types common to all modules *) type rgb = float * float * float type rgba = float * float * float * float type point2 = float * float type point3 = float * float * float type point4 = float * float * float * float type vect3 = float * float *float type clampf = float type short = int type kind = [`bitmap|`byte|`float|`int|`short|`ubyte|`uint|`ushort] type real_kind = [`byte|`float|`int|`short|`ubyte|`uint|`ushort] type format = [`alpha|`bgr|`bgra|`blue|`color_index|`depth_component|`green|`luminance |`luminance_alpha|`red|`rgb|`rgba|`stencil_index] val format_size : [< format] -> int type target = [`color_4|`index|`normal|`texture_coord_1|`texture_coord_2|`texture_coord_3 |`texture_coord_4|`trim_2|`trim_3|`vertex_3|`vertex_4] val target_size : [< target] -> int type cmp_func = [`always|`equal|`gequal|`greater|`lequal|`less|`never|`notequal] type face = [`back|`both|`front] (* Basic functions *) val flush : unit -> unit val finish : unit -> unit type cap = [`alpha_test|`auto_normal|`blend|`clip_plane0|`clip_plane1|`clip_plane2 |`clip_plane3|`clip_plane4|`clip_plane5|`color_material|`cull_face |`depth_test|`dither|`fog|`light0|`light1|`light2|`light3|`light4|`light5 |`light6|`light7|`lighting|`line_smooth|`line_stipple |`index_logic_op |`color_logic_op |`map1_color_4|`map1_index|`map1_normal|`map1_texture_coord_1 |`map1_texture_coord_2|`map1_texture_coord_3|`map1_texture_coord_4 |`map1_vertex_3|`map1_vertex_4|`map2_color_4|`map2_index|`map2_normal |`map2_texture_coord_1|`map2_texture_coord_2|`map2_texture_coord_3 |`map2_texture_coord_4|`map2_vertex_3|`map2_vertex_4|`normalize|`point_smooth |`polygon_offset_fill|`polygon_offset_line|`polygon_offset_point |`polygon_smooth|`polygon_stipple|`scissor_test|`stencil_test|`texture_1d |`texture_2d|`texture_gen_q|`texture_gen_r|`texture_gen_s|`texture_gen_t] val enable : cap -> unit val disable : cap -> unit val is_enabled : cap -> bool type error = [`no_error|`invalid_enum|`invalid_value|`invalid_operation |`stack_overflow|`stack_underflow|`out_of_memory|`table_too_large] val get_error : unit -> error val raise_error : string -> unit (* raise GLerror if there is a current error, otherwise do nothing *) lablgl-1.05/src/gl_tags.var000644 000765 000024 00000010616 12217024174 016571 0ustar00garriguestaff000000 000000 (* GLenum *) color depth accum stencil points lines polygon triangles quads line_strip line_loop triangle_strip triangle_fan quad_strip front back both -> GL_FRONT_AND_BACK point line fill cw ccw modelview projection texture modelview_matrix projection_matrix texture_matrix (* glEnable *) alpha_test auto_normal blend clip_plane0 clip_plane1 clip_plane2 clip_plane3 clip_plane4 clip_plane5 (* color_logic_op *) color_material cull_face depth_test dither fog (* index_logic_op *) light0 light1 light2 light3 light4 light5 light6 light7 lighting line_smooth line_stipple logic_op index_logic_op color_logic_op map1_color_4 map1_index map1_normal map1_texture_coord_1 map1_texture_coord_2 map1_texture_coord_3 map1_texture_coord_4 map1_vertex_3 map1_vertex_4 map2_color_4 map2_index map2_normal map2_texture_coord_1 map2_texture_coord_2 map2_texture_coord_3 map2_texture_coord_4 map2_vertex_3 map2_vertex_4 normalize point_smooth polygon_offset_fill polygon_offset_line polygon_offset_point polygon_smooth polygon_stipple scissor_test stencil_test texture_1d texture_2d texture_gen_q texture_gen_r texture_gen_s texture_gen_t (* glShadeModel *) flat smooth (* glLight *) ambient diffuse specular position spot_direction spot_exponent spot_cutoff constant_attenuation linear_attenuation quadratic_attenuation (* glMaterial *) (* ambient *) (* diffuse *) (* specular *) emission shininess ambient_and_diffuse color_indexes (* glDepthFunc, glAlphaFunc *) never less equal lequal greater notequal gequal always (* glBlendFunc *) zero one dst_color one_minus_dst_color src_alpha one_minus_src_alpha dst_alpha one_minus_dst_alpha src_alpha_saturate src_color one_minus_src_color (* glFog *) linear exp exp2 (* glNewList *) compile compile_and_execute (* data types *) bitmap byte short int float double ubyte -> GL_UNSIGNED_BYTE ushort -> GL_UNSIGNED_SHORT uint -> GL_UNSIGNED_INT (* glAccum *) load add mult return (* glDrawPixels *) color_index stencil_index depth_component rgb bgr rgba bgra red green blue alpha luminance luminance_alpha (* glHint *) dont_care fastest nicest (* glLogicOp *) clear set copy copy_inverted noop invert And nand Or nor xor equiv and_reverse and_inverted or_reverse or_inverted (* glPixelTransfer *) alpha_bias alpha_scale blue_bias blue_scale depth_bias depth_scale green_bias green_scale index_offset index_shift map_color map_stencil red_bias red_scale (* glPixelMap *) i_to_i -> GL_PIXEL_MAP_I_TO_I i_to_r -> GL_PIXEL_MAP_I_TO_R i_to_g -> GL_PIXEL_MAP_I_TO_G i_to_b -> GL_PIXEL_MAP_I_TO_B i_to_a -> GL_PIXEL_MAP_I_TO_A s_to_s -> GL_PIXEL_MAP_S_TO_S r_to_r -> GL_PIXEL_MAP_R_TO_R g_to_g -> GL_PIXEL_MAP_G_TO_G b_to_b -> GL_PIXEL_MAP_B_TO_B a_to_a -> GL_PIXEL_MAP_A_TO_A (* glPixelStore *) pack_swap_bytes pack_lsb_first pack_row_length pack_skip_pixels pack_skip_rows pack_alignment unpack_swap_bytes unpack_lsb_first unpack_row_length unpack_skip_pixels unpack_skip_rows unpack_alignment (* glReadBuffer *) front_left front_right back_left back_right left right (* glDrawBuffer *) none (* glStencilOp *) keep replace incr decr (* glTexEnv *) modulate decal (* glTexGen *) s t r q object_plane eye_plane eye_linear object_linear sphere_map (* glTexParameter *) min_filter -> GL_TEXTURE_MIN_FILTER mag_filter -> GL_TEXTURE_MAG_FILTER wrap_s -> GL_TEXTURE_WRAP_S wrap_t -> GL_TEXTURE_WRAP_T border_color -> GL_TEXTURE_BORDER_COLOR priority -> GL_TEXTURE_PRIORITY nearest nearest_mipmap_nearest linear_mipmap_nearest nearest_mipmap_linear linear_mipmap_linear generate_mipmap clamp repeat (* glGetString *) vendor renderer version extensions (* glRenderMode *) render select feedback (* glFeedBackBuffer *) _2d -> GL_2D _3d -> GL_3D _3d_color -> GL_3D_COLOR _3d_color_texture -> GL_3D_COLOR_TEXTURE _4d_color_texture -> GL_4D_COLOR_TEXTURE $$ (* glLightModel *) local_viewer two_side mode density start index End color_control separate_specular_color single_color (* glHint *) perspective_correction (* glMap1, glMap2 *) vertex_3 vertex_4 color_4 normal texture_coord_1 texture_coord_2 texture_coord_3 texture_coord_4 (* glPushAttrib *) accum_buffer color_buffer current depth_buffer enable eval hint list pixel_mode scissor stencil_buffer transform viewport (* glReadBuffer *) aux (* glArray *) edge_flag texture_coord vertex two three four (* glGetError *) no_error invalid_enum invalid_value invalid_operation stack_overflow stack_underflow out_of_memory table_too_large (* glCreateShader *) vertex_shader fragment_shader lablgl-1.05/src/glArray.ml000644 000765 000024 00000003270 12217024174 016370 0ustar00garriguestaff000000 000000 (* $Id: glArray.ml,v 1.6 2008-10-30 07:51:33 garrigue Exp $ *) open Gl open Raw type kind = [`edge_flag | `texture_coord | `color | `index | `normal | `vertex ] let check_static func f raw = if not (Raw.static raw) then invalid_arg ("GlArray." ^ func ^ " : buffer must be static"); f raw external _edge_flag : [< `bitmap] Raw.t -> unit = "ml_glEdgeFlagPointer" let edge_flag raw = check_static "edge_flag" _edge_flag raw external _tex_coord : [< `one | `two | `three | `four] -> [< `short | `int | `float | `double] Raw.t -> unit = "ml_glTexCoordPointer" let tex_coord n = check_static "tex_coord" (_tex_coord n) external _color : [< `three | `four] -> [< `byte | `ubyte | `short | `ushort | `int | `uint | `float | `double] Raw.t -> unit = "ml_glColorPointer" let color n = check_static "color" (_color n) external _index : [< `ubyte | `short | `int | `float | `double] Raw.t -> unit = "ml_glIndexPointer" let index raw = check_static "index" _index raw external _normal : [< `byte | `short | `int | `float | `double] Raw.t -> unit = "ml_glNormalPointer" let normal raw = check_static "normal" _normal raw external _vertex : [< `two | `three | `four] -> [< `short | `int | `float | `double] Raw.t -> unit = "ml_glVertexPointer" let vertex n = check_static "vertex" (_vertex n) external enable : kind -> unit= "ml_glEnableClientState" external disable : kind -> unit = "ml_glDisableClientState" external element : int -> unit = "ml_glArrayElement" external draw_arrays : GlDraw.shape -> first:int -> count:int -> unit = "ml_glDrawArrays" external draw_elements : GlDraw.shape -> count:int -> [< `ubyte | `ushort | `uint] Raw.t -> unit = "ml_glDrawElements" lablgl-1.05/src/glArray.mli000644 000765 000024 00000004325 12217024174 016543 0ustar00garriguestaff000000 000000 (** Vertex array manipulation functions *) (* $Id: glArray.mli,v 1.7 2008-10-25 02:22:58 garrigue Exp $ *) (** The six different kinds for array *) type kind = [ `color | `edge_flag | `index | `normal | `texture_coord | `vertex ] (** Tell openGL the address of the edgeFlag array. Raw array must be static. *) val edge_flag : [ `bitmap ] Raw.t -> unit (** Tell openGL the address of the texCoor array Raw array must be static. *) val tex_coord : [< `one | `two | `three | `four] -> [< `double | `float | `int | `short ] Raw.t -> unit (** Tell openGL the address of the color array Raw array must be static. *) val color : [< `three | `four] -> [< `byte | `double | `float | `int | `short | `ubyte | `uint | `ushort ] Raw.t -> unit (** Tell openGL the address of the index array Raw array must be static. *) val index : [< `double | `float | `int | `short | `ubyte ] Raw.t -> unit (** Tell openGL the address of the normal array Raw array must be static. *) val normal : [< `byte | `double | `float | `int | `short ] Raw.t -> unit (** Tell openGL the address of the vertex array Raw array must be static. *) val vertex : [< `two | `three | `four] -> [< `double | `float | `int | `short ] Raw.t -> unit (** Tell openGL the address of to use the specified array Raw array must be static. *) external enable : kind -> unit = "ml_glEnableClientState" (** Tell openGL the address of not to use the specified array Raw array must be static. *) external disable : kind -> unit = "ml_glDisableClientState" (* GlArray.element i sends to openGL the element i of all enabled arrays *) external element : int -> unit = "ml_glArrayElement" (* GlArray.draw_arrays shape i c sends to openGL a GlDraw.begins shape and all the element from i to i+c-1 of all enabled arrays and finally do a GlDraw.ends () *) external draw_arrays : GlDraw.shape -> first:int -> count:int -> unit = "ml_glDrawArrays" (* GlArray.draw_elements shape c tbl sends to openGL a GlDraw.begins shape and all the element from tbl[0] to tbl[c-1] of all enabled arrays and finally do a GlDraw.ends () *) external draw_elements : GlDraw.shape -> count:int -> [< `ubyte | `uint | `ushort ] Raw.t -> unit = "ml_glDrawElements" lablgl-1.05/src/glClear.ml000644 000765 000024 00000001222 12217024174 016333 0ustar00garriguestaff000000 000000 (* $Id: glClear.ml,v 1.5 2000-04-12 07:40:23 garrigue Exp $ *) open Gl external accum : float -> float -> float -> float -> unit = "ml_glClearAccum" let accum ?(alpha=1.) (r,g,b : rgb) = accum r g b alpha type buffer = [`color|`depth|`accum|`stencil] external clear : buffer list -> unit = "ml_glClear" external color : red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_glClearColor" let color ?(alpha=1.) (red, green, blue : rgb) = color ~red ~green ~blue ~alpha external depth : clampf -> unit = "ml_glClearDepth" external index : float -> unit = "ml_glClearIndex" external stencil : int -> unit = "ml_glClearStencil" lablgl-1.05/src/glClear.mli000644 000765 000024 00000000647 12217024174 016516 0ustar00garriguestaff000000 000000 (* $Id: glClear.mli,v 1.3 1999-11-15 09:55:05 garrigue Exp $ *) type buffer = [`accum|`color|`depth|`stencil] val clear : buffer list -> unit (* glClear: clear the specified buffers *) val accum : ?alpha:float -> Gl.rgb -> unit val color : ?alpha:float -> Gl.rgb -> unit val depth : Gl.clampf -> unit val index : float -> unit val stencil : int -> unit (* Set the clear value for each buffer: glClearAccum etc *) lablgl-1.05/src/glDraw.ml000644 000765 000024 00000003772 12217024174 016216 0ustar00garriguestaff000000 000000 (* $Id: glDraw.ml,v 1.6 2007-04-13 01:17:50 garrigue Exp $ *) open Gl external color : red:float -> green:float -> blue:float -> alpha:float -> unit = "ml_glColor4d" let color ?(alpha=1.) (red, green, blue : rgb) = color ~red ~green ~blue ~alpha external index : float -> unit = "ml_glIndexd" external cull_face : face -> unit = "ml_glCullFace" external edge_flag : bool -> unit = "ml_glEdgeFlag" external front_face : [`cw|`ccw] -> unit = "ml_glFrontFace" external line_width : float -> unit = "ml_glLineWidth" external line_stipple : factor:int -> pattern:short -> unit = "ml_glLineStipple" let line_stipple ?(factor=1) pattern = line_stipple ~factor ~pattern external point_size : float -> unit = "ml_glPointSize" external polygon_offset : factor:float -> units:float -> unit = "ml_glPolygonOffset" external polygon_mode : face:face -> [`point|`line|`fill] -> unit = "ml_glPolygonMode" external polygon_stipple : [`bitmap] Raw.t -> unit = "ml_glPolygonStipple" let polygon_stipple (img : GlPix.bitmap) = if GlPix.height img <> 32 or GlPix.width img <> 32 then invalid_arg "GlDraw.polygon_stipple"; polygon_stipple (GlPix.to_raw img) external shade_model : [`flat|`smooth] -> unit = "ml_glShadeModel" type shape = [ `points | `lines | `polygon | `triangles | `quads | `line_strip | `line_loop | `triangle_strip | `triangle_fan | `quad_strip ] external begins : shape -> unit = "ml_glBegin" external ends : unit -> unit = "ml_glEnd" external normal : x:float -> y:float -> z:float -> unit = "ml_glNormal3d" let normal ?(x=0.) ?(y=0.) ?(z=0.) () = normal ~x ~y ~z and normal3 (x,y,z) = normal ~x ~y ~z external rect : point2 -> point2 -> unit = "ml_glRectd" external vertex : x:float -> y:float -> ?z:float -> ?w:float -> unit -> unit = "ml_glVertex" let vertex2 (x,y : point2) = vertex ~x ~y () and vertex3 (x,y,z : point3) = vertex ~x ~y ~z () and vertex4 (x,y,z,w : point4) = vertex ~x ~y ~z ~w () external viewport : x:int -> y:int -> w:int -> h:int -> unit = "ml_glViewport" lablgl-1.05/src/glDraw.mli000644 000765 000024 00000002604 12217024174 016360 0ustar00garriguestaff000000 000000 (* $Id: glDraw.mli,v 1.3 2007-04-13 01:17:50 garrigue Exp $ *) open Gl val color : ?alpha:float -> rgb -> unit (* Sets the current color *) val index : float -> unit (* Sets the current index *) val cull_face : face -> unit (* Specifies which faces are candidates for culling *) val front_face : [`ccw|`cw] -> unit (* Specifies wether front faces are clockwise or not *) val edge_flag : bool -> unit val line_width : float -> unit val line_stipple : ?factor:int -> short -> unit (* [line_stipple :factor pattern] sets the line stipple to the 16-bit integer [pattern]. Each bit is used [factor] times *) val point_size : float -> unit val polygon_offset : factor:float -> units:float -> unit val polygon_mode : face:face -> [`fill|`line|`point] -> unit val polygon_stipple : GlPix.bitmap -> unit val shade_model : [`flat|`smooth] -> unit val normal : ?x:float -> ?y:float -> ?z:float -> unit -> unit val normal3 : vect3 -> unit (* [glNormal] *) val rect : point2 -> point2 -> unit type shape = [`line_loop|`line_strip|`lines|`points|`polygon|`quad_strip|`quads |`triangle_fan|`triangle_strip|`triangles] val begins : shape -> unit val ends : unit -> unit val vertex : x:float -> y:float -> ?z:float -> ?w:float -> unit -> unit val vertex2 : point2 -> unit val vertex3 : point3 -> unit val vertex4 : point4 -> unit val viewport : x:int -> y:int -> w:int -> h:int -> unit lablgl-1.05/src/glFunc.ml000644 000765 000024 00000004063 12217024174 016206 0ustar00garriguestaff000000 000000 (* $Id: glFunc.ml,v 1.7 2000-04-12 07:40:23 garrigue Exp $ *) open Gl external accum : op:[`accum|`load|`add|`mult|`return] -> float -> unit = "ml_glAccum" external alpha_func : cmp_func -> ref:clampf -> unit = "ml_glAlphaFunc" type sfactor = [ `zero | `one | `dst_color | `one_minus_dst_color | `src_alpha | `one_minus_src_alpha | `dst_alpha | `one_minus_dst_alpha | `src_alpha_saturate ] type dfactor = [ `zero | `one | `src_color | `one_minus_src_color | `src_alpha | `one_minus_src_alpha | `dst_alpha | `one_minus_dst_alpha ] external blend_func : src:sfactor -> dst:dfactor -> unit = "ml_glBlendFunc" external color_mask : bool -> bool -> bool -> bool -> unit = "ml_glColorMask" let color_mask ?(red=false) ?(green=false) ?(blue=false) ?(alpha=false) ()= color_mask red green blue alpha external depth_func : cmp_func -> unit = "ml_glDepthFunc" external depth_mask : bool -> unit = "ml_glDepthMask" external depth_range : near:float -> far:float -> unit = "ml_glDepthRange" type draw_buffer = [`none|`front_left|`front_right|`back_left|`back_right |`front|`back|`left|`right|`front_and_back|`aux of int] external draw_buffer : draw_buffer -> unit = "ml_glDrawBuffer" external index_mask : int -> unit = "ml_glIndexMask" type logic_op = [`clear|`set|`copy|`copy_inverted|`noop|`invert|`And|`nand|`Or|`nor |`xor|`equiv|`and_reverse|`and_inverted|`or_reverse|`or_inverted] external logic_op : logic_op -> unit = "ml_glLogicOp" type read_buffer = [`front_left|`front_right|`back_left|`back_right|`front|`back |`left|`right|`aux of int] external read_buffer : read_buffer -> unit = "ml_glReadBuffer" external stencil_func : cmp_func -> ref:int -> mask:int -> unit = "ml_glStencilFunc" external stencil_mask : int -> unit = "ml_glStencilMask" type stencil_op = [`keep|`zero|`replace|`incr|`decr|`invert] external stencil_op : fail:stencil_op -> zfail:stencil_op -> zpass:stencil_op -> unit = "ml_glStencilOp" let stencil_op ?(fail=`keep) ?(zfail=`keep) ?(zpass=`keep) () = stencil_op ~fail ~zfail ~zpass lablgl-1.05/src/glFunc.mli000644 000765 000024 00000002752 12217024174 016362 0ustar00garriguestaff000000 000000 (* $Id: glFunc.mli,v 1.4 2000-04-03 02:57:41 garrigue Exp $ *) val accum : op:[`accum|`add|`load|`mult|`return] -> float -> unit val alpha_func : Gl.cmp_func -> ref:Gl.clampf -> unit type sfactor = [`dst_alpha|`dst_color|`one|`one_minus_dst_alpha|`one_minus_dst_color |`one_minus_src_alpha|`src_alpha|`src_alpha_saturate|`zero] type dfactor = [`dst_alpha|`one|`one_minus_dst_alpha|`one_minus_src_alpha |`one_minus_src_color|`src_alpha|`src_color|`zero] val blend_func : src:sfactor -> dst:dfactor -> unit val color_mask : ?red:bool -> ?green:bool -> ?blue:bool -> ?alpha:bool -> unit -> unit val depth_func : Gl.cmp_func -> unit val depth_mask : bool -> unit val depth_range : near:float -> far:float -> unit val index_mask : int -> unit val stencil_func : Gl.cmp_func -> ref:int -> mask:int -> unit val stencil_mask : int -> unit type stencil_op = [`decr|`incr|`invert|`keep|`replace|`zero] val stencil_op : ?fail:stencil_op -> ?zfail:stencil_op -> ?zpass:stencil_op -> unit -> unit type logic_op = [`And|`Or|`and_inverted|`and_reverse|`clear|`copy|`copy_inverted|`equiv |`invert|`nand|`noop|`nor|`or_inverted|`or_reverse|`set|`xor] val logic_op : logic_op -> unit type draw_buffer = [`aux of int|`back|`back_left|`back_right|`front|`front_and_back|`front_left |`front_right|`left|`none|`right] val draw_buffer : draw_buffer -> unit type read_buffer = [`aux of int|`back|`back_left|`back_right|`front|`front_left|`front_right |`left|`right] val read_buffer : read_buffer -> unit lablgl-1.05/src/glLight.ml000644 000765 000024 00000002505 12217024174 016361 0ustar00garriguestaff000000 000000 (* $Id: glLight.ml,v 1.7 2003-04-24 16:42:59 erickt Exp $ *) open Gl type color_material = [`emission|`ambient|`diffuse|`specular|`ambient_and_diffuse] external color_material : face:face -> color_material -> unit = "ml_glColorMaterial" type fog_param = [ `mode of [`linear|`exp|`exp2] | `density of float | `start of float | `End of float | `index of float | `color of rgba ] external fog : fog_param -> unit = "ml_glFog" type light_param = [ `ambient of rgba | `diffuse of rgba | `specular of rgba | `position of point4 | `spot_direction of point3 | `spot_exponent of float | `spot_cutoff of float | `constant_attenuation of float | `linear_attenuation of float | `quadratic_attenuation of float ] external light : num:int -> light_param -> unit = "ml_glLight" type light_model_param = [ `ambient of rgba | `local_viewer of bool | `two_side of bool | `color_control of [`separate_specular_color | `single_color] ] external light_model : light_model_param -> unit = "ml_glLightModel" type material_param = [ `ambient of rgba | `diffuse of rgba | `specular of rgba | `emission of rgba | `shininess of float | `ambient_and_diffuse of rgba | `color_indexes of (float * float * float) ] external material : face:face -> material_param -> unit = "ml_glMaterial" lablgl-1.05/src/glLight.mli000644 000765 000024 00000002224 12217024174 016530 0ustar00garriguestaff000000 000000 (* $Id: glLight.mli,v 1.7 2003-04-24 16:42:59 erickt Exp $ *) open Gl type color_material = [`emission|`ambient|`diffuse|`specular|`ambient_and_diffuse] val color_material : face:face -> color_material -> unit type fog_param = [ `mode of [`linear|`exp|`exp2] | `density of float | `start of float | `End of float | `index of float | `color of rgba ] val fog : fog_param -> unit type light_param = [ `ambient of rgba | `diffuse of rgba | `specular of rgba | `position of point4 | `spot_direction of point3 | `spot_exponent of float | `spot_cutoff of float | `constant_attenuation of float | `linear_attenuation of float | `quadratic_attenuation of float ] val light : num:int -> light_param -> unit val light_model : [ `ambient of rgba | `local_viewer of bool | `two_side of bool | `color_control of [`separate_specular_color|`single_color] ] -> unit type material_param = [ `ambient of rgba | `diffuse of rgba | `specular of rgba | `emission of rgba | `shininess of float | `ambient_and_diffuse of rgba | `color_indexes of (float * float * float) ] val material : face:face -> material_param -> unit lablgl-1.05/src/glList.ml000644 000765 000024 00000001517 12217024174 016227 0ustar00garriguestaff000000 000000 (* $Id: glList.ml,v 1.4 2000-04-12 07:40:24 garrigue Exp $ *) type t = int type base = int external is_list : t -> bool = "ml_glIsList" external gen_lists : len:int -> base = "ml_glGenLists" external delete_lists : base -> len:int -> unit = "ml_glDeleteLists" external begins : t -> mode:[`compile|`compile_and_execute] -> unit = "ml_glNewList" external ends : unit -> unit = "ml_glEndList" external call : t -> unit = "ml_glCallList" external call_lists : [ `byte of string | `int of int array] -> unit = "ml_glCallLists" external list_base : base -> unit = "ml_glListBase" let nth base ~pos = base + pos let create mode = let l = gen_lists ~len:1 in begins l ~mode; l let delete l = delete_lists l ~len:1 let call_lists ?base lists = begin match base with None -> () | Some base -> list_base base end; call_lists lists lablgl-1.05/src/glList.mli000644 000765 000024 00000002331 12217024174 016373 0ustar00garriguestaff000000 000000 (* $Id: glList.mli,v 1.4 2000-04-03 02:57:41 garrigue Exp $ *) type t val create : [`compile|`compile_and_execute] -> t (* [create mode] creates a new display list in given mode. It is equivalent to [let base = gen_lists len:1 in begins (nth base pos:0)] *) val ends : unit -> unit (* glEndList: end a display list started by create or begins *) val call : t -> unit val delete : t -> unit type base val nth : base -> pos:int -> t (* [nth base :pos] returns the index of the list at base+pos *) val is_list : t -> bool (* [is_list l] is true if l indexes a display list *) val gen_lists : len:int -> base (* Generate len new display lists. They are indexed by [nth base pos:0] to [nth base pos:(len-1)] *) val begins : t -> mode:[`compile|`compile_and_execute] -> unit (* glNewList: start the definition of a display list in given mode *) val delete_lists : base -> len:int -> unit (* Delete len lists starting at base *) val call_lists : ?base:base -> [ `byte of string | `int of int array] -> unit (* Call the lists whose indexes are given either by a string (code of each character) or an array. If the base is omited, the base given in a previous call is assumed *) lablgl-1.05/src/glMap.ml000644 000765 000024 00000002410 12217024174 016022 0ustar00garriguestaff000000 000000 (* $Id: glMap.ml,v 1.4 2008-01-10 05:50:37 garrigue Exp $ *) external eval_coord1 : float -> unit = "ml_glEvalCoord1d" external eval_coord2 : float -> float -> unit = "ml_glEvalCoord2d" external eval_mesh1 : mode:[`point|`line] -> int -> int -> unit = "ml_glEvalMesh1" let eval_mesh1 ~mode ~range:(u1,u2) = eval_mesh1 ~mode u1 u2 external eval_mesh2 : mode:[`point|`line|`fill] -> int -> int -> int -> int -> unit = "ml_glEvalMesh2" let eval_mesh2 ~mode ~range1:(u1,u2) ~range2:(v1,v2) = eval_mesh2 ~mode u1 u2 v1 v2 external eval_point1 : int -> unit = "ml_glEvalPoint1" external eval_point2 : int -> int -> unit = "ml_glEvalPoint2" type target = [ `vertex_3 | `vertex_4 | `index | `color_4 | `normal | `texture_coord_1 | `texture_coord_2 | `texture_coord_3 | `texture_coord_4 ] external map1 : target:target -> (float*float) -> order:int -> [`double] Raw.t -> unit = "ml_glMap1d" external map2 : target:target -> (float*float) -> order:int -> (float*float) -> order:int -> [`double] Raw.t -> unit = "ml_glMap2d_bc" "ml_glMap2d" external grid1 : n:int -> range:(float * float) -> unit = "ml_glMapGrid1d" external grid2 : n1:int -> range1:(float * float) -> n2:int -> range2:(float * float) -> unit = "ml_glMapGrid2d" lablgl-1.05/src/glMap.mli000644 000765 000024 00000002470 12217024174 016201 0ustar00garriguestaff000000 000000 (* $Id: glMap.mli,v 1.3 2000-04-12 07:40:24 garrigue Exp $ *) type target = [ `vertex_3 | `vertex_4 | `index | `color_4 | `normal | `texture_coord_1 | `texture_coord_2 | `texture_coord_3 | `texture_coord_4 ] val map1 : target:target -> float * float -> order:int -> [`double] Raw.t -> unit (* [map1 :target (u1,u2) :order points] defines a 1-dimensional map. [order] is the number of control points in [points] *) val map2 : target:target -> float * float -> order:int -> float * float -> order:int -> [`double] Raw.t -> unit (* [map1 :target (u1,u2) order:uorder (v1,v2) order:vorder points] defines a 2-dimensional map. The number of control points in [points] is [uorder*vorder] *) val eval_coord1 : float -> unit val eval_coord2 : float -> float -> unit (* Evaluate the maps at given coordinates *) val grid1 : n:int -> range:float * float -> unit val grid2 : n1:int -> range1:float * float -> n2:int -> range2:float * float -> unit (* Define 1- and 2-dimensional meshes to the maps *) val eval_mesh1 : mode:[`line|`point] -> range:(int * int) -> unit val eval_mesh2 : mode:[`fill|`line|`point] -> range1:(int * int) -> range2:(int * int) -> unit val eval_point1 : int -> unit val eval_point2 : int -> int -> unit (* Evaluate meshes at given coordinates *) lablgl-1.05/src/glMat.ml000644 000765 000024 00000004737 12217024174 016044 0ustar00garriguestaff000000 000000 (* $Id: glMat.ml,v 1.11 2005-10-28 02:49:09 garrigue Exp $ *) type t = [`double] Raw.t external frustum : x:(float * float) -> y:(float * float) -> z:(float * float) -> unit = "ml_glFrustum" external load_identity : unit -> unit = "ml_glLoadIdentity" external load : t -> unit = "ml_glLoadMatrixd" let load m = if Raw.length m <> 16 then invalid_arg "Gl.load_matrix"; load m external load_transpose : t -> unit = "ml_glLoadTransposeMatrixd" let load_transpose m = if Raw.length m <> 16 then invalid_arg "Gl.load_transpose_matrix"; load_transpose m external get_matrix : [`modelview_matrix|`projection_matrix|`texture_matrix] -> t -> unit = "ml_glGetDoublev" let get_matrix mode = let model = Raw.create `double ~len:16 in get_matrix mode model; model external mode : [`modelview|`projection|`texture] -> unit = "ml_glMatrixMode" external mult : t -> unit = "ml_glMultMatrixd" let mult m = if Raw.length m <> 16 then invalid_arg "Gl.mult_matrix"; mult m external mult_transpose : t -> unit = "ml_glMultTransposeMatrixd" let mult_transpose m = if Raw.length m <> 16 then invalid_arg "Gl.mult_matrix"; mult_transpose m external ortho : x:(float * float) -> y:(float * float) -> z:(float * float) -> unit = "ml_glOrtho" external pop : unit -> unit = "ml_glPopMatrix" external push : unit -> unit = "ml_glPushMatrix" external rotate : angle:float -> x:float -> y:float -> z:float -> unit = "ml_glRotated" let rotate3 ~angle (x,y,z) = rotate ~angle ~x ~y ~z let rotate ~angle ?(x=0.) ?(y=0.) ?(z=0.) () = rotate ~angle ~x ~y ~z external scale : x:float -> y:float -> z:float -> unit = "ml_glScaled" let scale3 (x,y,z) = scale ~x ~y ~z let scale ?(x=0.) ?(y=0.) ?(z=0.) () = scale ~x ~y ~z external translate : x:float -> y:float -> z:float -> unit = "ml_glTranslated" let translate3 (x,y,z) = translate ~x ~y ~z let translate ?(x=0.) ?(y=0.) ?(z=0.) () = translate ~x ~y ~z let of_raw mat = if Raw.length mat <> 16 then invalid_arg "GlMatrix.of_array"; mat external to_raw : t -> [`double] Raw.t = "%identity" let of_array m : t = if Array.length m <> 4 then invalid_arg "GlMatrix.of_array"; let mat = Raw.create `double ~len:16 in for i = 0 to 3 do let arr = Array.unsafe_get m i in if Array.length arr <> 4 then invalid_arg "GlMatrix.of_array"; Raw.sets_float mat ~pos:(i*4) arr done; mat let to_array (mat : t) = let m = Array.create 4 [||] in for i = 0 to 3 do Array.unsafe_set m i (Raw.gets_float mat ~pos:(i*4) ~len:4) done; m lablgl-1.05/src/glMat.mli000644 000765 000024 00000002322 12217024174 016201 0ustar00garriguestaff000000 000000 (* $Id: glMat.mli,v 1.6 2003-04-22 03:24:02 erickt Exp $ *) open Gl type t val of_raw : [`double] Raw.t -> t external to_raw : t -> [`double] Raw.t = "%identity" (* Those two functions are just the identity, and keep sharing. [double] Raw.t is a raw array of 16 floating point values representing as 4x4 matrix *) val of_array : float array array -> t val to_array : t -> float array array val load : t -> unit val load_transpose : t -> unit val mult : t -> unit val mult_transpose : t -> unit val load_identity : unit -> unit val push : unit -> unit val pop : unit -> unit (* Push and pop the matrix on the stack *) val mode : [`modelview|`projection|`texture] -> unit val get_matrix : [`modelview_matrix|`projection_matrix|`texture_matrix] -> t val rotate : angle:float -> ?x:float -> ?y:float -> ?z:float -> unit -> unit val scale : ?x:float -> ?y:float -> ?z:float -> unit -> unit val translate : ?x:float -> ?y:float -> ?z:float -> unit -> unit val rotate3 : angle:float -> vect3 -> unit val scale3 : point3 -> unit val translate3 : point3 -> unit val ortho : x:float * float -> y:float * float -> z:float * float -> unit val frustum : x:float * float -> y:float * float -> z:float * float -> unit lablgl-1.05/src/glMisc.ml000644 000765 000024 00000004667 12217024174 016220 0ustar00garriguestaff000000 000000 (* $Id: glMisc.ml,v 1.8 2008-10-25 02:22:58 garrigue Exp $ *) open StdLabels external get_string : [`vendor|`renderer|`version|`extensions] -> string = "ml_glGetString" let rec check_substring ~sep ~start ~buf s = let len = String.length s in if String.length buf < len + start then false else if String.sub buf ~pos:start ~len = s && (String.length buf = len + start || buf.[len+start] = sep) then true else match try Some (String.index_from buf start sep) with Not_found -> None with | None -> false | Some n -> check_substring ~sep ~start:(n+1) ~buf s let check_extension s = check_substring ~sep:' ' ~start:0 ~buf:(get_string `extensions) s type equation = float * float * float * float external clip_plane : plane:int -> equation -> unit = "ml_glClipPlane" let clip_plane ~plane equation = if plane < 0 or plane > 5 then invalid_arg "Gl.clip_plane"; clip_plane ~plane equation type hint_target = [`fog|`line_smooth|`perspective_correction|`point_smooth|`polygon_smooth] external hint : hint_target -> [`fastest|`nicest|`dont_care] -> unit = "ml_glHint" external init_names : unit -> unit = "ml_glInitNames" external load_name : int -> unit = "ml_glLoadName" external pop_name : unit -> unit = "ml_glPopName" external push_name : int -> unit = "ml_glPushName" external pop_attrib : unit -> unit = "ml_glPopAttrib" type attrib = [ `accum_buffer|`color_buffer|`current|`depth_buffer|`enable|`eval|`fog | `hint|`lighting|`line|`list|`pixel_mode|`point|`polygon|`polygon_stipple | `scissor|`stencil_buffer|`texture|`transform|`viewport ] external push_attrib : attrib list -> unit = "ml_glPushAttrib" external pass_through : float -> unit = "ml_glPassThrough" external render_mode : [`render|`select|`feedback] -> int = "ml_glRenderMode" external select_buffer : int -> [`uint] Raw.t -> unit = "ml_glSelectBuffer" let select_buffer raw = if not (Raw.static raw) then invalid_arg "GlMisc.select_buffer : buffer must be static"; select_buffer (Raw.length raw) raw type feedback_mode = [`_2d |`_3d |`_3d_color |`_3d_color_texture |`_4d_color_texture] external feedback_buffer : int -> feedback_mode -> [`float] Raw.t -> unit = "ml_glFeedbackBuffer" let feedback_buffer ~mode buf = if not (Raw.static buf) then invalid_arg "GlMisc.feedback_buffer : buffer must be static"; feedback_buffer (Raw.length buf) mode buf external scissor : x:int -> y:int -> width:int -> height:int -> unit = "ml_glScissor" lablgl-1.05/src/glMisc.mli000644 000765 000024 00000002505 12217024174 016356 0ustar00garriguestaff000000 000000 (* $Id: glMisc.mli,v 1.6 2008-10-25 02:22:58 garrigue Exp $ *) (* Getting information *) val get_string : [`vendor|`renderer|`version|`extensions] -> string val check_extension : string -> bool (* Clipping planes *) type equation = float * float * float * float val clip_plane : plane:int -> equation -> unit (* Speed hint *) type hint_target = [`fog|`line_smooth|`perspective_correction|`point_smooth|`polygon_smooth] val hint : hint_target -> [`fastest|`nicest|`dont_care] -> unit (* Names *) val init_names : unit -> unit val load_name : int -> unit val push_name : int -> unit val pop_name : unit -> unit type attrib = [ `accum_buffer|`color_buffer|`current|`depth_buffer|`enable|`eval|`fog | `hint|`lighting|`line|`list|`pixel_mode|`point|`polygon|`polygon_stipple | `scissor|`stencil_buffer|`texture|`transform|`viewport ] val push_attrib : attrib list -> unit val pop_attrib : unit -> unit val render_mode : [`feedback|`render|`select] -> int val pass_through : float -> unit val select_buffer : [`uint] Raw.t -> unit (* argument must be a static Raw.t *) type feedback_mode = [`_2d |`_3d |`_3d_color |`_3d_color_texture |`_4d_color_texture] val feedback_buffer : mode:feedback_mode -> [`float] Raw.t -> unit (* argument must be a static Raw.t *) val scissor : x:int -> y:int -> width:int -> height:int -> unit lablgl-1.05/src/glPix.ml000644 000765 000024 00000006311 12217024174 016051 0ustar00garriguestaff000000 000000 (* $Id: glPix.ml,v 1.10 2005-10-14 13:35:32 garrigue Exp $ *) open Gl type ('a,'b) t = { format: 'a ; width: int ; height:int ; raw: 'b Raw.t } let create k ~format ~width ~height = let size = format_size format * width * height in let len = match k with `bitmap -> (size-1)/8+1 | #Gl.real_kind -> size in let raw = Raw.create k ~len in { format = format; width = width; height = height; raw = raw } let of_raw raw ~format ~width ~height = let size = format_size format * width * height and len = Raw.length raw in let len = match Raw.kind raw with `bitmap -> len * 8 | #Gl.real_kind -> len in if size > len then invalid_arg "GlPix.of_raw"; { format = format; width = width; height = height; raw = raw } let to_raw img = img.raw let format img = img.format let width img = img.width let height img = img.height let raw_pos img = let width = match Raw.kind img.raw with `bitmap -> (img.width-1)/8+1 | #Gl.real_kind -> img.width in let stride = format_size img.format in let line = stride * width in fun ~x ~y -> x * stride + y * line external bitmap : width:int -> height:int -> orig:point2 -> move:point2 -> [`bitmap] Raw.t -> unit = "ml_glBitmap" type bitmap = ([`color_index], [`bitmap]) t let bitmap (img : bitmap) = bitmap ~width:img.width ~height:img.height img.raw external copy : x:int -> y:int -> width:int -> height:int -> buffer:[`color|`depth|`stencil] -> unit = "ml_glCopyPixels" external draw : width:int -> height:int -> format:[< format] -> [< Gl.kind] Raw.t -> unit = "ml_glDrawPixels" let draw img = draw img.raw ~width:img.width ~height:img.height ~format:img.format type map = [`i_to_i|`i_to_r|`i_to_g|`i_to_b|`i_to_a |`s_to_s|`r_to_r|`g_to_g|`b_to_b|`a_to_a] external map : map -> [`float] Raw.t -> unit = "ml_glPixelMapfv" type store_param = [ `pack_swap_bytes of bool | `pack_lsb_first of bool | `pack_row_length of int | `pack_skip_pixels of int | `pack_skip_rows of int | `pack_alignment of int | `unpack_swap_bytes of bool | `unpack_lsb_first of bool | `unpack_row_length of int | `unpack_skip_pixels of int | `unpack_skip_rows of int | `unpack_alignment of int ] external store : store_param -> unit = "ml_glPixelStorei" type transfer_param = [ `map_color of bool | `map_stencil of bool | `index_shift of int | `index_offset of int | `red_scale of float | `red_bias of float | `green_scale of float | `green_bias of float | `blue_scale of float | `blue_bias of float | `alpha_scale of float | `alpha_bias of float | `depth_scale of float | `depth_bias of float ] external transfer : transfer_param -> unit = "ml_glPixelTransfer" external zoom : x:float -> y:float -> unit = "ml_glPixelZoom" external raster_pos : x:float -> y:float -> ?z:float -> ?w:float -> unit -> unit = "ml_glRasterPos" external read : x:int -> y:int -> width:int -> height:int -> format:[< format] -> [< Gl.kind] Raw.t -> unit = "ml_glReadPixels_bc" "ml_glReadPixels" let read ~x ~y ~width ~height ~format ~kind = let raw = Raw.create kind ~len:(width * height * format_size format) in read ~x ~y ~width ~height ~format raw; { raw = raw; width = width; height = height; format = format } lablgl-1.05/src/glPix.mli000644 000765 000024 00000004062 12217024174 016223 0ustar00garriguestaff000000 000000 (* $Id: glPix.mli,v 1.9 2004-12-02 02:01:16 garrigue Exp $ *) (* An abstract type for pixmaps *) type (+'a,+'b) t val create : ([< Gl.kind] as 'a) -> format:([< Gl.format] as 'b) -> width:int -> height:int -> ('b, 'a) t val of_raw : ([< Gl.kind] as 'a) Raw.t -> format:([< Gl.format] as 'b) -> width:int -> height:int -> ('b, 'a) t val to_raw : ('a, 'b) t -> 'b Raw.t val format : ('a, 'b) t -> 'a val width : ('a, 'b) t -> int val height : ('a, 'b) t -> int val raw_pos : ([< Gl.format], [< Gl.kind]) t -> x:int -> y:int -> int (* [raw_pos image :x :y] partially evaluates on [image] *) (* openGL functions *) val read : x:int -> y:int -> width:int -> height:int -> format:([< Gl.format] as 'a) -> kind:([< Gl.kind] as 'b) -> ('a, 'b) t type bitmap = ([`color_index], [`bitmap]) t val bitmap : bitmap -> orig:Gl.point2 -> move:Gl.point2 -> unit val draw : ([< Gl.format], [< Gl.kind]) t -> unit type map = [`a_to_a|`b_to_b|`g_to_g|`i_to_a|`i_to_b |`i_to_g|`i_to_i|`i_to_r|`r_to_r|`s_to_s] val map : map -> [`float] Raw.t -> unit type store_param = [ `pack_swap_bytes of bool | `pack_lsb_first of bool | `pack_row_length of int | `pack_skip_pixels of int | `pack_skip_rows of int | `pack_alignment of int | `unpack_swap_bytes of bool | `unpack_lsb_first of bool | `unpack_row_length of int | `unpack_skip_pixels of int | `unpack_skip_rows of int | `unpack_alignment of int ] val store : store_param -> unit type transfer_param = [ `map_color of bool | `map_stencil of bool | `index_shift of int | `index_offset of int | `red_scale of float | `red_bias of float | `green_scale of float | `green_bias of float | `blue_scale of float | `blue_bias of float | `alpha_scale of float | `alpha_bias of float | `depth_scale of float | `depth_bias of float ] val transfer : transfer_param -> unit val zoom : x:float -> y:float -> unit val raster_pos : x:float -> y:float -> ?z:float -> ?w:float -> unit -> unit val copy : x:int -> y:int -> width:int -> height:int -> buffer:[`color|`depth|`stencil] -> unit lablgl-1.05/src/glShader.ml000644 000765 000024 00000015262 12217024174 016524 0ustar00garriguestaff000000 000000 (* $Id: glShader.ml,v 1.1 2010-03-11 08:30:02 garrigue Exp $ *) (* Code contributed by Florent Monnier *) (** GLSL Shaders *) type shader_object type shader_program external create: shader_type:[`vertex_shader|`fragment_shader] -> shader_object = "ml_glcreateshader" external delete: shader:shader_object -> unit = "ml_gldeleteshader" external is_shader: shader:shader_object -> bool = "ml_glisshader" external source: shader:shader_object -> string -> unit = "ml_glshadersource" external compile: shader:shader_object -> unit = "ml_glcompileshader" external create_program: unit -> shader_program = "ml_glcreateprogram" external delete_program: program:shader_program -> unit = "ml_gldeleteprogram" external attach: program:shader_program -> shader:shader_object -> unit = "ml_glattachshader" external detach: program:shader_program -> shader:shader_object -> unit = "ml_gldetachshader" external link_program: program:shader_program -> unit = "ml_gllinkprogram" external use_program: program:shader_program -> unit = "ml_gluseprogram" external unuse_program: unit -> unit = "ml_glunuseprogram" external shader_compile_status: shader:shader_object -> bool = "ml_glgetshadercompilestatus" external shader_compile_status_exn: shader:shader_object -> unit = "ml_glgetshadercompilestatus_exn" external get_uniform_location: program:shader_program -> name:string -> int = "ml_glgetuniformlocation" external get_program_attached_shaders: program:shader_program -> int = "ml_glgetprogram_attached_shaders" external get_program_active_uniforms: program:shader_program -> int = "ml_glgetprogram_active_uniforms" external get_program_active_attributes: program:shader_program -> int = "ml_glgetprogram_active_attributes" external get_program_validate_status: program:shader_program -> bool = "ml_glgetprogram_validate_status" external get_program_link_status: program:shader_program -> bool = "ml_glgetprogram_link_status" external get_program_delete_status: program:shader_program -> bool = "ml_glgetprogram_delete_status" external uniform1f: location:int -> v0:float -> unit = "ml_gluniform1f" external uniform2f: location:int -> v0:float -> v1:float -> unit = "ml_gluniform2f" external uniform3f: location:int -> v0:float -> v1:float -> v2:float -> unit = "ml_gluniform3f" external uniform4f: location:int -> v0:float -> v1:float -> v2:float -> v3:float -> unit = "ml_gluniform4f" external uniform1i: location:int -> v0:int -> unit = "ml_gluniform1i" external uniform2i: location:int -> v0:int -> v1:int -> unit = "ml_gluniform2i" external uniform3i: location:int -> v0:int -> v1:int -> v2:int -> unit = "ml_gluniform3i" external uniform4i: location:int -> v0:int -> v1:int -> v2:int -> v3:int -> unit = "ml_gluniform4i" external uniform1fv: location:int -> value:float array -> unit = "ml_gluniform1fv" external uniform2fv: location:int -> count:int -> value:float array -> unit = "ml_gluniform2fv" external uniform3fv: location:int -> count:int -> value:float array -> unit = "ml_gluniform3fv" external uniform4fv: location:int -> count:int -> value:float array -> unit = "ml_gluniform4fv" external uniform1iv: location:int -> value:int array -> unit = "ml_gluniform1iv" external uniform2iv: location:int -> count:int -> value:int array -> unit = "ml_gluniform2iv" external uniform3iv: location:int -> count:int -> value:int array -> unit = "ml_gluniform3iv" external uniform4iv: location:int -> count:int -> value:int array -> unit = "ml_gluniform4iv" external uniform_matrix2f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2f" external uniform_matrix3f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3f" external uniform_matrix4f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4f" external uniform_matrix2x3f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2x3f" external uniform_matrix3x2f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3x2f" external uniform_matrix2x4f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2x4f" external uniform_matrix4x2f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4x2f" external uniform_matrix3x4f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3x4f" external uniform_matrix4x3f: location:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4x3f" external uniform_matrix2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2fv" external uniform_matrix3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3fv" external uniform_matrix4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4fv" external uniform_matrix2x3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2x3fv" external uniform_matrix3x2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3x2fv" external uniform_matrix2x4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix2x4fv" external uniform_matrix4x2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4x2fv" external uniform_matrix3x4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix3x4fv" external uniform_matrix4x3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit = "ml_gluniformmatrix4x3fv" external get_attrib_location: program:shader_program -> name:string -> int = "ml_glgetattriblocation" external bind_attrib_location: program:shader_program -> index:int -> name:string -> unit = "ml_glbindattriblocation" external vertex_attrib1s: index:int -> v:int -> unit = "ml_glvertexattrib1s" external vertex_attrib1d: index:int -> v:float -> unit = "ml_glvertexattrib1d" external vertex_attrib2s: index:int -> v0:int -> v1:int -> unit = "ml_glvertexattrib2s" external vertex_attrib2d: index:int -> v0:float -> v1:float -> unit = "ml_glvertexattrib2d" external vertex_attrib3s: index:int -> v0:int -> v1:int -> v2:int -> unit = "ml_glvertexattrib3s" external vertex_attrib3d: index:int -> v0:float -> v1:float -> v2:float -> unit = "ml_glvertexattrib3d" external vertex_attrib4s: index:int -> v0:int -> v1:int -> v2:int -> v3:int -> unit = "ml_glvertexattrib4s" external vertex_attrib4d: index:int -> v0:float -> v1:float -> v2:float -> v3:float -> unit = "ml_glvertexattrib4d" external get_shader_infolog: shader:shader_object -> string = "ml_glgetshaderinfolog" external get_program_infolog: program:shader_program -> string = "ml_glgetprograminfolog" lablgl-1.05/src/glShader.mli000644 000765 000024 00000007702 12217024174 016675 0ustar00garriguestaff000000 000000 (* $Id: glShader.mli,v 1.1 2010-03-11 08:30:02 garrigue Exp $ *) (* Code contributed by Florent Monnier *) (** GLSL Shaders *) type shader_object type shader_program val create: shader_type:[`vertex_shader|`fragment_shader] -> shader_object val delete: shader:shader_object -> unit val source: shader:shader_object -> string -> unit val compile: shader:shader_object -> unit val create_program: unit -> shader_program val delete_program: program:shader_program -> unit val attach: program:shader_program -> shader:shader_object -> unit val detach: program:shader_program -> shader:shader_object -> unit val link_program: program:shader_program -> unit val use_program: program:shader_program -> unit val unuse_program: unit -> unit val shader_compile_status: shader:shader_object -> bool val shader_compile_status_exn: shader:shader_object -> unit val get_uniform_location: program:shader_program -> name:string -> int val get_program_attached_shaders: program:shader_program -> int val get_program_active_uniforms: program:shader_program -> int val get_program_active_attributes: program:shader_program -> int val get_program_validate_status: program:shader_program -> bool val get_program_link_status: program:shader_program -> bool val get_program_delete_status: program:shader_program -> bool val uniform1f: location:int -> v0:float -> unit val uniform2f: location:int -> v0:float -> v1:float -> unit val uniform3f: location:int -> v0:float -> v1:float -> v2:float -> unit val uniform4f: location:int -> v0:float -> v1:float -> v2:float -> v3:float -> unit val uniform1i: location:int -> v0:int -> unit val uniform2i: location:int -> v0:int -> v1:int -> unit val uniform3i: location:int -> v0:int -> v1:int -> v2:int -> unit val uniform4i: location:int -> v0:int -> v1:int -> v2:int -> v3:int -> unit val uniform1fv: location:int -> value:float array -> unit val uniform2fv: location:int -> count:int -> value:float array -> unit val uniform3fv: location:int -> count:int -> value:float array -> unit val uniform4fv: location:int -> count:int -> value:float array -> unit val uniform1iv: location:int -> value:int array -> unit val uniform2iv: location:int -> count:int -> value:int array -> unit val uniform3iv: location:int -> count:int -> value:int array -> unit val uniform4iv: location:int -> count:int -> value:int array -> unit val uniform_matrix2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix2x3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix3x2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix2x4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix4x2fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix3x4fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val uniform_matrix4x3fv: location:int -> count:int -> transpose:bool -> value:float array -> unit val get_attrib_location: program:shader_program -> name:string -> int val bind_attrib_location: program:shader_program -> index:int -> name:string -> unit val vertex_attrib1s: index:int -> v:int -> unit val vertex_attrib1d: index:int -> v:float -> unit val vertex_attrib2s: index:int -> v0:int -> v1:int -> unit val vertex_attrib2d: index:int -> v0:float -> v1:float -> unit val vertex_attrib3s: index:int -> v0:int -> v1:int -> v2:int -> unit val vertex_attrib3d: index:int -> v0:float -> v1:float -> v2:float -> unit val vertex_attrib4s: index:int -> v0:int -> v1:int -> v2:int -> v3:int -> unit val vertex_attrib4d: index:int -> v0:float -> v1:float -> v2:float -> v3:float -> unit val get_shader_infolog: shader:shader_object -> string val get_program_infolog: program:shader_program -> string lablgl-1.05/src/glTex.ml000644 000765 000024 00000007510 12217024174 016053 0ustar00garriguestaff000000 000000 (* $Id: glTex.ml,v 1.14 2012-03-06 03:31:02 garrigue Exp $ *) open Gl open GlPix external coord1 : float -> unit = "ml_glTexCoord1d" external coord2 : float -> float -> unit = "ml_glTexCoord2d" external coord3 : float -> float -> float -> unit = "ml_glTexCoord3d" external coord4 : float -> float -> float -> float -> unit = "ml_glTexCoord4d" (*external multi_coord2 : *) let default x = function Some x -> x | None -> x let coord ~s ?t ?r ?q () = match q with Some q -> coord4 s (default 0.0 t) (default 0.0 r) q | None -> match r with Some r -> coord3 s (default 0.0 t) r | None -> match t with Some t -> coord2 s t | None -> coord1 s let coord2 (s,t) = coord2 s t let coord3 (s,t,r) = coord3 s t r let coord4 (s,t,r,q) = coord4 s t r q type env_param = [ `mode of [`modulate|`decal|`blend|`replace] | `color of rgba ] external env : env_param -> unit = "ml_glTexEnv" type coord = [`s|`t|`r|`q] type gen_param = [ `mode of [`object_linear|`eye_linear|`sphere_map] | `object_plane of point4 | `eye_plane of point4 ] external gen : coord:coord -> gen_param -> unit = "ml_glTexGen" let npot = ref None let check_pow2 n = if !npot = None then npot := Some (GlMisc.check_extension "GL_ARB_texture_non_power_of_two"); (!npot = Some true) || (n land (n - 1) = 0) type format = [ `color_index | `red | `green | `blue | `alpha | `rgb | `bgr | `rgba | `bgra | `luminance | `luminance_alpha ] external image1d : proxy:bool -> level:int -> internal:int -> width:int -> border:int -> format:[< format] -> [< kind] Raw.t -> unit = "ml_glTexImage1D_bc""ml_glTexImage1D" let image1d ?(proxy=false) ?(level=0) ?internal:i ?(border=false) img = let internal = match i with None -> format_size (format img) | Some i -> i in let border = if border then 1 else 0 in if not (check_pow2 (width img - 2 * border)) then raise (GLerror "Gl.image1d : bad width"); if height img < 1 then raise (GLerror "Gl.image1d : bad height"); image1d ~proxy ~level ~internal ~width:(width img) ~border ~format:(format img) (to_raw img) external image2d : proxy:bool -> level:int -> internal:int -> width:int -> height:int -> border:int -> format:[< format] -> [< kind] Raw.t -> unit = "ml_glTexImage2D_bc""ml_glTexImage2D" let image2d ?(proxy=false) ?(level=0) ?internal:i ?(border=false) img = let internal = match i with None -> format_size (format img) | Some i -> i in let border = if border then 1 else 0 in if not (check_pow2 (width img - 2 * border)) then raise (GLerror "Gl.image2d : bad width"); if not (check_pow2 (height img - 2 * border)) then raise (GLerror "Gl.image2d : bad height"); image2d ~proxy ~level ~internal ~border ~width:(width img) ~height:(height img) ~format:(format img) (to_raw img) type filter = [ `nearest | `linear | `nearest_mipmap_nearest | `linear_mipmap_nearest | `nearest_mipmap_linear | `linear_mipmap_linear ] type wrap = [`clamp|`repeat] type parameter = [ `min_filter of filter | `mag_filter of [`nearest|`linear] | `wrap_s of wrap | `wrap_t of wrap | `border_color of rgba | `priority of clampf | `generate_mipmap of bool ] external parameter : target:[`texture_1d|`texture_2d] -> parameter -> unit = "ml_glTexParameter" type texture_id = nativeint external _gen_textures : int -> [`uint] Raw.t -> unit = "ml_glGenTextures" let gen_textures ~len = let raw = Raw.create `uint ~len in _gen_textures len raw; let arr = Array.create len Nativeint.zero in for i = 0 to len - 1 do arr.(i) <- Raw.get_long raw ~pos:i done; arr let gen_texture () = (gen_textures 1).(0) external bind_texture : target:[`texture_1d|`texture_2d] -> texture_id -> unit = "ml_glBindTexture" external delete_texture : texture_id -> unit = "ml_glDeleteTexture" let delete_textures a = Array.iter (fun id -> delete_texture id) a lablgl-1.05/src/glTex.mli000644 000765 000024 00000003152 12217024174 016222 0ustar00garriguestaff000000 000000 (* $Id: glTex.mli,v 1.8 2012-03-06 03:31:02 garrigue Exp $ *) open Gl val coord : s:float -> ?t:float -> ?r:float -> ?q:float -> unit -> unit val coord2 : float * float -> unit val coord3 : float * float * float -> unit val coord4 : float * float * float * float -> unit type env_param = [ `mode of [`modulate|`decal|`blend|`replace] | `color of rgba] val env : env_param -> unit type coord = [`s|`t|`r|`q] type gen_param = [ `mode of [`object_linear|`eye_linear|`sphere_map] | `object_plane of point4 | `eye_plane of point4 ] val gen : coord:coord -> gen_param -> unit type format = [`color_index|`red|`green|`blue|`alpha|`rgb|`bgr|`rgba|`bgra |`luminance|`luminance_alpha] val image1d : ?proxy:bool -> ?level:int -> ?internal:int -> ?border:bool -> ([< format], [< kind]) GlPix.t -> unit val image2d : ?proxy:bool -> ?level:int -> ?internal:int -> ?border:bool -> ([< format], [< kind]) GlPix.t -> unit type filter = [`nearest|`linear|`nearest_mipmap_nearest|`linear_mipmap_nearest |`nearest_mipmap_linear|`linear_mipmap_linear] type wrap = [`clamp|`repeat] type parameter = [ `min_filter of filter | `mag_filter of [`nearest|`linear] | `wrap_s of wrap | `wrap_t of wrap | `border_color of rgba | `priority of clampf | `generate_mipmap of bool ] val parameter : target:[`texture_1d|`texture_2d] -> parameter -> unit type texture_id val gen_texture : unit -> texture_id val gen_textures : len:int -> texture_id array val bind_texture : target:[`texture_1d|`texture_2d] -> texture_id -> unit val delete_texture : texture_id -> unit val delete_textures : texture_id array -> unit lablgl-1.05/src/glu_tags.var000644 000765 000024 00000001615 12217024174 016755 0ustar00garriguestaff000000 000000 (* $Id: glu_tags.var,v 1.5 2002-05-01 03:35:00 garrigue Exp $: tags for GLU library *) (* gluGetString *) version extensions (* gluNextContour *) exterior interior unknown ccw cw (* gluNurbsProperty *) sampling_method path_length parametric_error domain_distance sampling_tolerance parametric_tolerance u_step v_step display_mode fill culling auto_load_matrix polygon -> GLU_OUTLINE_POLYGON patch -> GLU_OUTLINE_PATCH (* gluQuadricDrawStyle *) line silhouette point (* gluQuadricNormals *) none flat smooth (* gluQuadricOrientation *) inside outside (* gluTessProperty *) winding_rule -> GLU_TESS_WINDING_RULE odd -> GLU_TESS_WINDING_ODD nonzero -> GLU_TESS_WINDING_NONZERO positive -> GLU_TESS_WINDING_POSITIVE negative -> GLU_TESS_WINDING_NEGATIVE abs_geq_two -> GLU_TESS_WINDING_ABS_GEQ_TWO boundary_only -> GLU_TESS_BOUNDARY_ONLY tolerance -> GLU_TESS_TOLERANCE $$ (* gluNurbsCurve *) trim_2 trim_3 lablgl-1.05/src/gluMat.ml000644 000765 000024 00000001516 12217024174 016221 0ustar00garriguestaff000000 000000 (* $Id: gluMat.ml,v 1.2 2000-04-12 07:40:25 garrigue Exp $ *) open Gl external look_at : eye:(float * float * float) -> center:(float * float * float) -> up:(float * float * float) -> unit = "ml_gluLookAt" external ortho2d : left:float -> right:float -> bottom:float -> top:float -> unit = "ml_gluOrtho2D" let ortho2d ~x:(left,right) ~y:(bottom,top) = ortho2d ~left ~right ~bottom ~top external perspective : fovy:float -> aspect:float -> znear:float -> zfar:float -> unit = "ml_gluPerspective" let perspective ~fovy ~aspect ~z:(znear,zfar) = perspective ~fovy ~aspect ~znear ~zfar external pick_matrix : x:float -> y:float -> width:float -> height:float -> unit = "ml_gluPickMatrix" external project : point3 -> point3 = "ml_gluProject" external unproject : point3 -> point3 = "ml_gluUnProject" lablgl-1.05/src/gluMat.mli000644 000765 000024 00000000634 12217024174 016372 0ustar00garriguestaff000000 000000 (* $Id: gluMat.mli,v 1.1 1998-01-29 11:46:06 garrigue Exp $ *) open Gl val look_at : eye:point3 -> center:point3 -> up:vect3 -> unit val ortho2d : x:float * float -> y:float * float -> unit val perspective : fovy:float -> aspect:float -> z:float * float -> unit val pick_matrix : x:float -> y:float -> width:float -> height:float -> unit val project : point3 -> point3 val unproject : point3 -> point3 lablgl-1.05/src/gluMisc.ml000644 000765 000024 00000002672 12217024174 016377 0ustar00garriguestaff000000 000000 (* $Id: gluMisc.ml,v 1.6 2003-02-06 18:19:12 furuse Exp $ *) open Gl open GlPix external build_1d_mipmaps : internal:int -> width:int -> format:[< GlTex.format] -> [< kind] Raw.t -> unit = "ml_gluBuild1DMipmaps" let build_1d_mipmaps ?internal:i img = let internal = match i with None -> format_size (format img) | Some i -> i in if height img < 1 then raise (GLerror "GluMisc.build_1d_mipmaps : bad height"); build_1d_mipmaps ~internal ~width:(width img) ~format:(format img) (to_raw img) external build_2d_mipmaps : internal:int -> width:int -> height:int -> format:[< GlTex.format] -> [< kind] Raw.t -> unit = "ml_gluBuild2DMipmaps" let build_2d_mipmaps ?internal:i img = let internal = match i with None -> format_size (format img) | Some i -> i in build_2d_mipmaps ~internal ~width:(width img) ~height:(height img) ~format:(format img) (to_raw img) external get_string : [`version|`extensions] -> string = "ml_gluGetString" external scale_image : format:[< Gl.format] -> w:int -> h:int -> data:[< kind] Raw.t -> w:int -> h:int -> data:[< kind] Raw.t -> unit = "ml_gluScaleImage_bc" "ml_gluScaleImage" let scale_image ~width ~height img = let k = Raw.kind (to_raw img) and format = format img in let new_img = GlPix.create k ~format ~height ~width in scale_image ~format ~w:(GlPix.width img) ~h:(GlPix.height img) ~data:(to_raw img) ~w:width ~h:height ~data:(to_raw new_img); new_img lablgl-1.05/src/gluMisc.mli000644 000765 000024 00000000635 12217024174 016545 0ustar00garriguestaff000000 000000 (* $Id: gluMisc.mli,v 1.3 2001-10-01 02:59:13 garrigue Exp $ *) open Gl val get_string : [`extensions|`version] -> string val build_1d_mipmaps : ?internal:int -> ([< GlTex.format], [< kind]) GlPix.t -> unit val build_2d_mipmaps : ?internal:int -> ([< GlTex.format], [< kind]) GlPix.t -> unit val scale_image : width:int -> height:int -> ([< format] as 'a, [< kind] as 'b) GlPix.t -> ('a, 'b) GlPix.t lablgl-1.05/src/gluNurbs.ml000644 000765 000024 00000005456 12217024174 016600 0ustar00garriguestaff000000 000000 (* $Id: gluNurbs.ml,v 1.6 2001-10-01 02:59:13 garrigue Exp $ *) open Gl type t external begin_curve : t -> unit = "ml_gluBeginCurve" external begin_surface : t -> unit = "ml_gluBeginSurface" external begin_trim : t -> unit = "ml_gluBeginTrim" external end_curve : t -> unit = "ml_gluEndCurve" external end_surface : t -> unit = "ml_gluEndSurface" external end_trim : t -> unit = "ml_gluEndTrim" external load_sampling_matrices : t -> model:[`float] Raw.t -> persp:[`float] Raw.t -> view:[`int] Raw.t -> unit = "ml_gluLoadSamplingMatrices" external create : unit -> t = "ml_gluNewNurbsRenderer" external curve : t -> knots:[`float] Raw.t -> control:[`float] Raw.t -> order:int -> kind:[< GlMap.target] -> unit = "ml_gluNurbsCurve" let curve nurb ~knots ~control ~order ~kind:t = let arity = target_size t in if (Array.length knots - order) * arity <> Array.length control then invalid_arg "GluNurbs.curve"; let knots = Raw.of_float_array ~kind:`float knots and control = Raw.of_float_array ~kind:`float control in curve nurb ~knots ~control ~order ~kind:t type property = [ `sampling_method of [`path_length|`parametric_error|`domain_distance] | `sampling_tolerance of int | `parametric_tolerance of float | `u_step of int | `v_step of int | `display_mode of [`fill|`polygon|`patch] | `culling of bool | `auto_load_matrix of bool ] external property : t -> property -> unit = "ml_gluNurbsProperty" external surface : t -> sknots:[`float] Raw.t -> tknots:[`float] Raw.t -> tstride:int -> control:[`float] Raw.t -> sorder:int -> torder:int -> target:[< target] -> unit = "ml_gluNurbsSurface_bc" "ml_gluNurbsSurface" let surface t ~sknots ~tknots ~control ~sorder ~torder ~target = let cl = Array.length control in if cl = 0 then invalid_arg "GluNurb.curve"; let tstride = Array.length control.(0) in let sl = Array.length sknots and tl = Array.length tknots in if tl <> cl + torder or (sl - sorder) * target_size target <> tstride then invalid_arg "GluNurb.curve"; let sknots = Raw.of_float_array ~kind:`float sknots in let tknots = Raw.of_float_array ~kind:`float tknots in let co = Raw.create `float ~len:(cl * tstride) in for i = 0 to cl - 1 do if Array.length control.(i) <> tstride then invalid_arg "GluNurb.curve"; Raw.sets_float co ~pos:(i*tstride) control.(i) done; surface t ~sknots ~tknots ~tstride ~control:co ~sorder ~torder ~target external pwl_curve : t -> count:int -> [`float] Raw.t -> kind:[`trim_2|`trim_3] -> unit = "ml_gluPwlCurve" let pwl_curve nurb ~kind:t data = let len = Array.length data and raw = Raw.of_float_array ~kind:`float data and stride = match t with `trim_2 -> 2 | `trim_3 -> 3 in if len mod stride <> 0 then invalid_arg "GluNurb.pwl_curve"; pwl_curve nurb ~count:(len/stride) raw ~kind:t lablgl-1.05/src/gluNurbs.mli000644 000765 000024 00000002025 12217024174 016736 0ustar00garriguestaff000000 000000 (* $Id: gluNurbs.mli,v 1.5 2001-10-01 02:59:13 garrigue Exp $ *) type t val create : unit -> t val begin_curve : t -> unit val begin_surface : t -> unit val begin_trim : t -> unit val end_curve : t -> unit val end_surface : t -> unit val end_trim : t -> unit val load_sampling_matrices : t -> model:[`float] Raw.t -> persp:[`float] Raw.t -> view:[`int] Raw.t -> unit val curve : t -> knots:float array -> control:float array -> order:int -> kind:[< GlMap.target] -> unit val pwl_curve : t -> kind:[`trim_2|`trim_3] -> float array -> unit val surface : t -> sknots:float array -> tknots:float array -> control:float array array -> sorder:int -> torder:int -> target:[< Gl.target] -> unit type property = [ `sampling_method of [`path_length|`parametric_error|`domain_distance] | `sampling_tolerance of int | `parametric_tolerance of float | `u_step of int | `v_step of int | `display_mode of [`fill|`polygon|`patch] | `culling of bool | `auto_load_matrix of bool ] val property : t -> property -> unit lablgl-1.05/src/gluQuadric.ml000644 000765 000024 00000002700 12217024174 017064 0ustar00garriguestaff000000 000000 (* $Id: gluQuadric.ml,v 1.5 2000-04-12 07:40:26 garrigue Exp $ *) type t external create : unit -> t = "ml_gluNewQuadric" external cylinder : t -> base:float -> top:float -> height:float -> slices:int -> stacks:int -> unit = "ml_gluCylinder_bc" "ml_gluCylinder" let cylinder ~base ~top ~height ~slices ~stacks ?(quad = create ()) () = cylinder ~base ~top ~height ~slices ~stacks quad external disk : t -> inner:float -> outer:float -> slices:int -> loops:int -> unit = "ml_gluDisk" let disk ~inner ~outer ~slices ~loops ?(quad = create ()) () = disk ~inner ~outer ~slices ~loops quad external partial_disk : t -> inner:float -> outer:float -> slices:int -> loops:int -> start:float -> sweep:float -> unit = "ml_gluPartialDisk_bc" "ml_gluPartialDisk" let partial_disk ~inner ~outer ~slices ~loops ~start ~sweep ?(quad = create ()) () = partial_disk ~inner ~outer ~slices ~loops ~start ~sweep quad external draw_style : t -> [`fill|`line|`silhouette|`point] -> unit = "ml_gluQuadricDrawStyle" external normals : t -> [`none|`flat|`smooth] -> unit = "ml_gluQuadricNormals" external orientation : t -> [`inside|`outside] -> unit = "ml_gluQuadricOrientation" external texture : t -> bool -> unit = "ml_gluQuadricTexture" external sphere : t -> radius:float -> slices:int -> stacks:int -> unit = "ml_gluSphere" let sphere ~radius ~slices ~stacks ?(quad = create ()) () = sphere ~radius ~slices ~stacks quad lablgl-1.05/src/gluQuadric.mli000644 000765 000024 00000001424 12217024174 017237 0ustar00garriguestaff000000 000000 (* $Id: gluQuadric.mli,v 1.2 1999-11-15 14:32:14 garrigue Exp $ *) type t val create : unit -> t (* If you omit the quadric, a new one will be created *) val cylinder : base:float -> top:float -> height:float -> slices:int -> stacks:int -> ?quad:t -> unit -> unit val disk : inner:float -> outer:float -> slices:int -> loops:int -> ?quad:t -> unit -> unit val partial_disk : inner:float -> outer:float -> slices:int -> loops:int -> start:float -> sweep:float -> ?quad:t -> unit -> unit val sphere : radius:float -> slices:int -> stacks:int -> ?quad:t -> unit -> unit val draw_style : t -> [`fill|`line|`point|`silhouette] -> unit val normals : t -> [`flat|`none|`smooth] -> unit val orientation : t -> [`inside|`outside] -> unit val texture : t -> bool -> unit lablgl-1.05/src/gluTess.ml000644 000765 000024 00000001126 12217024174 016413 0ustar00garriguestaff000000 000000 (* $Id: gluTess.ml,v 1.7 2004-07-13 07:55:18 garrigue Exp $ *) (* Code contributed by Jon Harrop *) type winding_rule = [`odd|`nonzero|`positive|`negative|`abs_geq_two] type vertices = (float * float * float) list external tesselate : ?winding:winding_rule -> ?boundary_only:bool -> ?tolerance:float -> vertices list -> unit = "ml_gluTesselate" type triangles = { singles: vertices list; strips: vertices list; fans: vertices list } external tesselate_and_return : ?winding:winding_rule -> ?tolerance:float -> vertices list -> triangles = "ml_gluTesselateAndReturn" lablgl-1.05/src/gluTess.mli000644 000765 000024 00000001341 12217024174 016563 0ustar00garriguestaff000000 000000 (* $Id: gluTess.mli,v 1.8 2004-07-13 09:44:03 garrigue Exp $ *) (* Code contributed by Jon Harrop *) type winding_rule = [`odd|`nonzero|`positive|`negative|`abs_geq_two] type vertices = (float * float * float) list val tesselate : ?winding:winding_rule -> ?boundary_only:bool -> ?tolerance:float -> vertices list -> unit (** Render directly to current screen. Each [vertices] in the input is a contour in the single polygon represented by [vertices list]. *) type triangles = { singles: vertices list; strips: vertices list; fans: vertices list } val tesselate_and_return : ?winding:winding_rule -> ?tolerance:float -> vertices list -> triangles (** Return 3 lists of triangles instead of rendering directly *) lablgl-1.05/src/Makefile000644 000765 000024 00000005530 12217024174 016076 0ustar00garriguestaff000000 000000 # Include shared parts TOPDIR = .. include ../Makefile.common # Composite options INCLUDES = $(GLINCLUDES) $(XINCLUDES) LIBS = $(GLLIBS) $(XLIBS) LIBDIRS = OCAMLINC=-I +labltk # Files LIBOBJS = raw.cmo \ gl.cmo glLight.cmo glList.cmo glMap.cmo \ glMat.cmo glMisc.cmo glPix.cmo glClear.cmo \ glTex.cmo glDraw.cmo glFunc.cmo gluMisc.cmo \ gluNurbs.cmo gluQuadric.cmo gluTess.cmo gluMat.cmo \ glArray.cmo glShader.cmo MLOBJS = $(LIBOBJS) togl.cmo OPTOBJS = $(LIBOBJS:.cmo=.cmx) COBJS = ml_gl$(XO) ml_glu$(XO) ml_raw$(XO) ml_glarray$(XO) \ ml_glutess$(XO) ml_shader$(XO) TOGLOBJS = ml_togl$(XO) $(TOGLDIR)/togl$(XO) all: tools $(MAKE) lablgl.cma opt: lablgl.cmxa tools: var2def$(XE) var2switch$(XE) var2def$(XE): var2def.ml $(LINKER) -pp camlp4o var2def.ml -o $@ var2switch$(XE): var2switch.ml $(LINKER) -pp camlp4o var2switch.ml -o $@ ifeq ($(TOOLCHAIN), msvc) liblablgl$(XA): $(COBJS) $(MKLIB)$@ $(COBJS) dlllablgl.dll: $(COBJS:$(XO)=.d$(XO)) $(MKDLL)$@ $(COBJS:$(XO)=.d$(XO)) $(GLLIBS) $(OCAMLDLL) lablgl.cma: liblablgl$(XA) dlllablgl.dll $(LIBOBJS) $(CONFIG) $(LINKER) -a -o $@ $(LIBOBJS) \ -cclib -llablgl -dllib -llablgl \ -cclib "$(GLLIBS)" lablgl.cmxa: liblablgl$(XA) $(OPTOBJS) $(CONFIG) $(OPTLINK) -a -o $@ $(OPTOBJS) -cclib -llablgl \ -cclib "$(GLLIBS)" else liblablgl$(XA): lablgl.cma lablgl.cma: $(COBJS) $(LIBOBJS) $(CONFIG) $(LIBRARIAN) -o lablgl $(COBJS) $(LIBOBJS) $(GLLIBS) $(XLIBS) lablgl.cmxa: $(COBJS) $(OPTOBJS) $(CONFIG) $(LIBRARIAN) -o lablgl $(COBJS) $(OPTOBJS) $(GLLIBS) $(XLIBS) endif gl_tags.c: gl_tags.var $(VAR2SWITCH) -table GL_ < gl_tags.var > $@ glu_tags.c: glu_tags.var $(VAR2SWITCH) GLU_ < glu_tags.var > $@ build.ml: build.ml.in ../Makefile.config sed -e "s|@LABLGL_MLS@|$(LIBOBJS:.cmo=)|" \ -e "s|@TOGL_MLS@|togl|" \ -e "s|@GLUT_MLS@|glut|" \ -e "s|@GLLIBS@|$(GLLIBS0)|" \ -e "s|@TKLIBS@|$(TKLIBS0)|" \ -e "s|@GLUTLIBS@|$(GLUTLIBS0)|" < build.ml.in > $@ preinstall: build.ml if test -d "$(INSTALLDIR)"; then : ; else mkdir -p "$(INSTALLDIR)"; fi cp build.ml $(LIBOBJS:.cmo=.ml) $(LIBOBJS:.cmo=.mli) "$(INSTALLDIR)" cp liblablgl$(XA) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) liblablgl$(XA) if test -f dlllablgl$(XS); then cp dlllablgl$(XS) "$(DLLDIR)"; fi install: preinstall cp $(LIBOBJS:.cmo=.cmi) lablgl.cma "$(INSTALLDIR)" @if test -f lablgl.cmxa; then $(MAKE) installopt; fi installopt: cp lablgl.cmxa lablgl$(XA) $(LIBOBJS:.cmo=.cmx) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) lablgl$(XA) clean: rm -f *.cm* *.a *.o *.so *.lib *.obj *.exe *.opt *_tags.c *_tags.h *~ \ *.dll var2def$(XE) var2switch$(XE) lablgltop$(XE) lablgl$(XB) depend: ocamldep -pp camlp4o *.ml *.mli > .depend #dependencies ml_gl$(XO): ml_gl.h gl_tags.h gl_tags.c ml_raw.h ml_glu$(XO) ml_glutess$(XO) : ml_gl.h ml_glu.h glu_tags.h glu_tags.c ml_raw$(XO): raw_tags.h ml_raw.h include .depend lablgl-1.05/src/ml_gl.c000644 000765 000024 00000047442 12217024174 015704 0ustar00garriguestaff000000 000000 /* $Id: ml_gl.c,v 1.51 2007-04-13 02:48:43 garrigue Exp $ */ #ifdef _WIN32 #include #endif #include #ifdef __APPLE__ #include #else #include #endif #ifdef HAS_GLEXT_H #include #undef GL_VERSION_1_3 #endif #include #include #include #include #include #include #include "ml_raw.h" #include "gl_tags.h" #include "ml_gl.h" #if !defined(GL_VERSION_1_4) #define GL_GENERATE_MIPMAP 0x8191 #endif /* #include */ void ml_raise_gl(const char *errmsg) { static value * gl_exn = NULL; if (gl_exn == NULL) gl_exn = caml_named_value("glerror"); raise_with_string(*gl_exn, (char*)errmsg); } value copy_string_check (const char *str) { if (!str) ml_raise_gl("Null string"); return copy_string ((char*) str); } struct record { value key; GLenum data; }; static struct record input_table[] = { #include "gl_tags.c" }; static struct record *tag_table = NULL; #define TABLE_SIZE (TAG_NUMBER*2+1) CAMLprim value ml_gl_make_table (value unit) { int i; unsigned int hash; tag_table = stat_alloc (TABLE_SIZE * sizeof(struct record)); memset ((char *) tag_table, 0, TABLE_SIZE * sizeof(struct record)); for (i = 0; i < TAG_NUMBER; i++) { hash = (unsigned long) input_table[i].key % TABLE_SIZE; while (tag_table[hash].key != 0) { hash ++; if (hash == TABLE_SIZE) hash = 0; } tag_table[hash].key = input_table[i].key; tag_table[hash].data = input_table[i].data; } return Val_unit; } GLenum GLenum_val(value tag) { unsigned int hash = (unsigned long) tag % TABLE_SIZE; if (!tag_table) ml_gl_make_table (Val_unit); while (tag_table[hash].key != tag) { if (tag_table[hash].key == 0) ml_raise_gl ("Unknown tag"); hash++; if (hash == TABLE_SIZE) hash = 0; } /* fprintf(stderr, "Converted %ld to %d", Int_val(tag), tag_table[hash].data); */ return tag_table[hash].data; } /* GLenum GLenum_val(value tag) { switch(tag) { #include "gl_tags.c" } ml_raise_gl("Unknown tag"); } */ ML_2 (glAccum, GLenum_val, Float_val) ML_2 (glAlphaFunc, GLenum_val, Float_val) ML_1 (glBegin, GLenum_val) ML_5 (glBitmap, Int_val, Int_val, Pair(arg3,Float_val,Float_val), Pair(arg4,Float_val,Float_val), Void_raw) ML_2 (glBlendFunc, GLenum_val, GLenum_val) CAMLprim value ml_glClipPlane(value plane, value equation) /* ML */ { double eq[4]; int i; for (i = 0; i < 4; i++) eq[i] = Double_val (Field(equation,i)); glClipPlane (GL_CLIP_PLANE0 + Int_val(plane), eq); return Val_unit; } CAMLprim value ml_glClear(value bit_list) /* ML */ { GLbitfield accu = 0; while (bit_list != Val_int(0)) { switch (Field (bit_list, 0)) { case MLTAG_color: accu |= GL_COLOR_BUFFER_BIT; break; case MLTAG_depth: accu |= GL_DEPTH_BUFFER_BIT; break; case MLTAG_accum: accu |= GL_ACCUM_BUFFER_BIT; break; case MLTAG_stencil: accu |= GL_STENCIL_BUFFER_BIT; break; } bit_list = Field (bit_list, 1); } glClear (accu); return Val_unit; } ML_4 (glClearAccum, Float_val, Float_val, Float_val, Float_val) ML_4 (glClearColor, Double_val, Double_val, Double_val, Double_val) ML_1 (glClearDepth, Double_val) ML_1 (glClearIndex, Float_val) ML_1 (glClearStencil, Int_val) ML_4 (glColor4d, Double_val, Double_val, Double_val, Double_val) ML_4 (glColorMask, Int_val, Int_val, Int_val, Int_val) ML_2 (glColorMaterial, GLenum_val, GLenum_val) ML_5 (glCopyPixels, Int_val, Int_val, Int_val, Int_val, GLenum_val) ML_1 (glCullFace, GLenum_val) ML_1 (glDisable, GLenum_val) ML_1 (glDepthFunc, GLenum_val) ML_1 (glDepthMask, Int_val) ML_2 (glDepthRange, Double_val, Double_val) CAMLprim value ml_glDrawBuffer (value buffer) { if (Is_block(buffer)) { int n = Int_val (Field(buffer,1)); if (n >= GL_AUX_BUFFERS) ml_raise_gl ("GlFunc.draw_buffer : no such auxiliary buffer"); glDrawBuffer (GL_AUX0 + n); } else glDrawBuffer (GLenum_val(buffer)); return Val_unit; } ML_4 (glDrawPixels, Int_val, Int_val, GLenum_val, Type_void_raw) ML_1 (glEdgeFlag, Int_val) ML_1 (glEnable, GLenum_val) ML_0 (glEnd) ML_1 (glEvalCoord1d, Double_val) ML_2 (glEvalCoord2d, Double_val, Double_val) ML_3 (glEvalMesh1, GLenum_val, Int_val, Int_val) ML_5 (glEvalMesh2, GLenum_val, Int_val, Int_val, Int_val, Int_val) ML_1 (glEvalPoint1, Int_val) ML_2 (glEvalPoint2, Int_val, Int_val) ML_3 (glFeedbackBuffer, Int_val, GLenum_val, (GLfloat*)Addr_raw) CAMLprim value ml_glFog (value param) /* ML */ { float params[4]; int i; switch (Field(param,0)) { case MLTAG_mode: glFogi(GL_FOG_MODE, GLenum_val(Field(param,1))); break; case MLTAG_density: glFogf(GL_FOG_DENSITY, Float_val(Field(param,1))); break; case MLTAG_start: glFogf(GL_FOG_START, Float_val(Field(param,1))); break; case MLTAG_End: glFogf(GL_FOG_END, Float_val(Field(param,1))); break; case MLTAG_index: glFogf(GL_FOG_INDEX, Float_val(Field(param,1))); break; case MLTAG_color: for (i = 0; i < 4; i++) params[i] = Float_val(Field(Field(param,1),i)); glFogfv(GL_FOG_COLOR, params); break; } return Val_unit; } ML_0 (glFlush) ML_0 (glFinish) ML_1 (glFrontFace, GLenum_val) ML_3 (glFrustum, Pair(arg1,Double_val,Double_val), Pair(arg2,Double_val,Double_val), Pair(arg3,Double_val,Double_val)) ML_1_ (glGetString, GLenum_val, copy_string_check) ML_2 (glGetDoublev, GLenum_val, Double_raw) CAMLprim value ml_glGetError(value unit) { switch (glGetError()) { case GL_NO_ERROR: return MLTAG_no_error; case GL_INVALID_ENUM: return MLTAG_invalid_enum; case GL_INVALID_VALUE: return MLTAG_invalid_value; case GL_INVALID_OPERATION: return MLTAG_invalid_operation; case GL_STACK_OVERFLOW: return MLTAG_stack_overflow; case GL_STACK_UNDERFLOW: return MLTAG_stack_underflow; case GL_OUT_OF_MEMORY: return MLTAG_out_of_memory; #if defined(GL_VERSION_1_2) || defined(GL_TABLE_TOO_LARGE) case GL_TABLE_TOO_LARGE: return MLTAG_table_too_large; #endif default: ml_raise_gl("glGetError: unknown error"); } } CAMLprim value ml_glHint (value target, value hint) { GLenum targ = 0U; switch (target) { case MLTAG_fog: targ = GL_FOG_HINT; break; case MLTAG_line_smooth: targ = GL_LINE_SMOOTH_HINT; break; case MLTAG_perspective_correction: targ = GL_PERSPECTIVE_CORRECTION_HINT; break; case MLTAG_point_smooth: targ = GL_POINT_SMOOTH_HINT; break; case MLTAG_polygon_smooth: targ = GL_POLYGON_SMOOTH_HINT; break; } glHint (targ, GLenum_val(hint)); return Val_unit; } ML_1 (glIndexMask, Int_val) ML_1 (glIndexd, Double_val) ML_0 (glInitNames) ML_1_ (glIsEnabled, GLenum_val, Val_int) CAMLprim value ml_glLight (value n, value param) /* ML */ { float params[4]; int i; if (Int_val(n) >= GL_MAX_LIGHTS) invalid_argument ("Gl.light"); switch (Field(param,0)) { case MLTAG_ambient: case MLTAG_diffuse: case MLTAG_specular: case MLTAG_position: for (i = 0; i < 4; i++) params[i] = Float_val (Field(Field(param, 1), i)); break; case MLTAG_spot_direction: for (i = 0; i < 3; i++) params[i] = Float_val (Field(Field(param, 1), i)); break; default: params[0] = Float_val (Field(param, 1)); } glLightfv (GL_LIGHT0 + Int_val(n), GLenum_val(Field(param,0)), params); return Val_unit; } CAMLprim value ml_glLightModel (value param) /* ML */ { float params[4]; int i; switch (Field(param,0)) { case MLTAG_ambient: for (i = 0; i < 4; i++) params[i] = Float_val (Field(Field(param,1),i)); glLightModelfv (GL_LIGHT_MODEL_AMBIENT, params); break; case MLTAG_local_viewer: glLightModelf (GL_LIGHT_MODEL_LOCAL_VIEWER, Int_val(Field(param,1))); break; case MLTAG_two_side: glLightModeli (GL_LIGHT_MODEL_TWO_SIDE, Int_val(Field(param,1))); break; case MLTAG_color_control: #ifdef GL_VERSION_1_2 switch (Field(param,1)) { case MLTAG_separate_specular_color: glLightModeli (GL_LIGHT_MODEL_COLOR_CONTROL, GL_SEPARATE_SPECULAR_COLOR); break; case MLTAG_single_color: glLightModeli (GL_LIGHT_MODEL_COLOR_CONTROL, GL_SINGLE_COLOR); break; } #else ml_raise_gl ("Parameter: GL_LIGHT_MODEL_COLOR_CONTROL not available"); #endif break; } return Val_unit; } ML_1 (glLineWidth, Float_val) ML_2 (glLineStipple, Int_val, Int_val) ML_1 (glLoadName, Int_val) ML_0 (glLoadIdentity) ML_1 (glLoadMatrixd, Double_raw) #ifdef GL_VERSION_1_3 ML_1 (glLoadTransposeMatrixd, Double_raw) #else CAMLprim void ml_glLoadTransposeMatrixd (value raw) { ml_raise_gl ("Function: glLoadTransposeMatrixd not available"); } #endif ML_1 (glLogicOp, GLenum_val) CAMLprim value ml_glMap1d (value target, value *u, value order, value raw) { int ustride = 0; GLenum targ = 0U; switch (target) { case MLTAG_vertex_3: targ = GL_MAP1_VERTEX_3; ustride = 3; break; case MLTAG_vertex_4: targ = GL_MAP1_VERTEX_4; ustride = 4; break; case MLTAG_index: targ = GL_MAP1_INDEX; ustride = 1; break; case MLTAG_color_4: targ = GL_MAP1_COLOR_4; ustride = 4; break; case MLTAG_normal: targ = GL_MAP1_NORMAL; ustride = 3; break; case MLTAG_texture_coord_1: targ = GL_MAP1_TEXTURE_COORD_1; ustride = 1; break; case MLTAG_texture_coord_2: targ = GL_MAP1_TEXTURE_COORD_2; ustride = 2; break; case MLTAG_texture_coord_3: targ = GL_MAP1_TEXTURE_COORD_3; ustride = 3; break; case MLTAG_texture_coord_4: targ = GL_MAP1_TEXTURE_COORD_4; ustride = 4; break; } glMap1d (targ, Double_val(u[0]), Double_val(u[1]), ustride, Int_val(order), Double_raw(raw)); return Val_unit; } CAMLprim value ml_glMap2d (value target, value u, value uorder, value v, value vorder, value raw) { int ustride = 0; GLenum targ = 0U; switch (target) { case MLTAG_vertex_3: targ = GL_MAP2_VERTEX_3; ustride = 3; break; case MLTAG_vertex_4: targ = GL_MAP2_VERTEX_4; ustride = 4; break; case MLTAG_index: targ = GL_MAP2_INDEX; ustride = 1; break; case MLTAG_color_4: targ = GL_MAP2_COLOR_4; ustride = 4; break; case MLTAG_normal: targ = GL_MAP2_NORMAL; ustride = 3; break; case MLTAG_texture_coord_1: targ = GL_MAP2_TEXTURE_COORD_1; ustride = 1; break; case MLTAG_texture_coord_2: targ = GL_MAP2_TEXTURE_COORD_2; ustride = 2; break; case MLTAG_texture_coord_3: targ = GL_MAP2_TEXTURE_COORD_3; ustride = 3; break; case MLTAG_texture_coord_4: targ = GL_MAP2_TEXTURE_COORD_4; ustride = 4; break; } glMap2d (targ, Double_val(Field(u,0)), Double_val(Field(u,1)), ustride, Int_val(uorder), Double_val(Field(v,0)), Double_val(Field(v,1)), Int_val(uorder)*ustride, Int_val(vorder), Double_raw(raw)); return Val_unit; } ML_bc6 (ml_glMap2d) ML_2 (glMapGrid1d, Int_val, Pair(arg2,Double_val,Double_val)) ML_4 (glMapGrid2d, Int_val, Pair(arg2,Double_val,Double_val), Int_val, Pair(arg4,Double_val,Double_val)) CAMLprim value ml_glMaterial (value face, value param) /* ML */ { float params[4]; int i; switch (Field(param,0)) { case MLTAG_shininess: params[0] = Float_val (Field(param, 1)); break; case MLTAG_color_indexes: for (i = 0; i < 3; i++) params[i] = Float_val (Field(Field(param, 1), i)); break; default: for (i = 0; i < 4; i++) params[i] = Float_val (Field(Field(param, 1), i)); break; } glMaterialfv (GLenum_val(face), GLenum_val(Field(param,0)), params); return Val_unit; } ML_1 (glMatrixMode, GLenum_val) ML_1 (glMultMatrixd, Double_raw) #ifdef GL_VERSION_1_3 ML_1 (glMultTransposeMatrixd, Double_raw) #else CAMLprim void ml_glMultTransposeMatrixd (value raw) { ml_raise_gl ("Function: glMultTransposeMatrixd not available"); } #endif ML_3 (glNormal3d, Double_val, Double_val, Double_val) ML_1 (glPassThrough, Float_val) CAMLprim value ml_glPixelMapfv (value map, value raw) { glPixelMapfv (GLenum_val(map), Int_val(Size_raw(raw))/sizeof(GLfloat), Float_raw(raw)); return Val_unit; } ML_3 (glOrtho, Pair(arg1,Double_val,Double_val), Pair(arg2,Double_val,Double_val), Pair(arg3,Double_val,Double_val)) ML_1 (glPixelStorei, Pair(arg1,GLenum_val,Int_val)) CAMLprim value ml_glPixelTransfer (value param) { GLenum pname = GLenum_val (Field(param,0)); switch (pname) { case GL_MAP_COLOR: case GL_MAP_STENCIL: case GL_INDEX_SHIFT: case GL_INDEX_OFFSET: glPixelTransferi (pname, Int_val (Field(param,1))); break; default: glPixelTransferf (pname, Float_val (Field(param,1))); } return Val_unit; } ML_2 (glPixelZoom, Float_val, Float_val) ML_1 (glPointSize, Float_val) ML_2 (glPolygonOffset, Float_val, Float_val) ML_2 (glPolygonMode, GLenum_val, GLenum_val) ML_1 (glPolygonStipple, (unsigned char *)Byte_raw) ML_0 (glPopAttrib) ML_0 (glPopMatrix) ML_0 (glPopName) CAMLprim value ml_glPushAttrib (value list) { GLbitfield mask = 0; while (list != Val_int(0)) { switch (Field(list,0)) { case MLTAG_accum_buffer:mask |= GL_ACCUM_BUFFER_BIT; break; case MLTAG_color_buffer:mask |= GL_COLOR_BUFFER_BIT; break; case MLTAG_current: mask |= GL_CURRENT_BIT; break; case MLTAG_depth_buffer:mask |= GL_DEPTH_BUFFER_BIT; break; case MLTAG_enable: mask |= GL_ENABLE_BIT; break; case MLTAG_eval: mask |= GL_EVAL_BIT; break; case MLTAG_fog: mask |= GL_FOG_BIT; break; case MLTAG_hint: mask |= GL_HINT_BIT; break; case MLTAG_lighting: mask |= GL_LIGHTING_BIT; break; case MLTAG_line: mask |= GL_LINE_BIT; break; case MLTAG_list: mask |= GL_LIST_BIT; break; case MLTAG_pixel_mode: mask |= GL_PIXEL_MODE_BIT; break; case MLTAG_point: mask |= GL_POINT_BIT; break; case MLTAG_polygon: mask |= GL_POLYGON_BIT; break; case MLTAG_polygon_stipple:mask |= GL_POLYGON_STIPPLE_BIT; break; case MLTAG_scissor: mask |= GL_SCISSOR_BIT; break; case MLTAG_stencil_buffer:mask |= GL_STENCIL_BUFFER_BIT; break; case MLTAG_texture: mask |= GL_TEXTURE_BIT; break; case MLTAG_transform: mask |= GL_TRANSFORM_BIT; break; case MLTAG_viewport: mask |= GL_VIEWPORT_BIT; break; } list = Field(list,1); } glPushAttrib (mask); return Val_unit; } ML_0 (glPushMatrix) ML_1 (glPushName, Int_val) CAMLprim value ml_glRasterPos(value x, value y, value z, value w) /* ML */ { if (z == Val_int(0)) glRasterPos2d (Double_val(x), Double_val(y)); else if (w == Val_int(0)) glRasterPos3d (Double_val(x), Double_val(y), Double_val(Field(z, 0))); else glRasterPos4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)), Double_val(Field(w, 0))); return Val_unit; } CAMLprim value ml_glReadBuffer (value buffer) { if (Is_block(buffer)) { int n = Int_val (Field(buffer,1)); if (n >= GL_AUX_BUFFERS) ml_raise_gl ("GlFunc.read_buffer : no such auxiliary buffer"); glReadBuffer (GL_AUX0 + n); } else glReadBuffer (GLenum_val(buffer)); return Val_unit; } CAMLprim value ml_glReadPixels(value x, value y, value w, value h, value format , value raw) /* ML */ { glPixelStorei(GL_PACK_SWAP_BYTES, 0); glPixelStorei(GL_PACK_ALIGNMENT, 1); glReadPixels(Int_val(x),Int_val(y),Int_val(w),Int_val(h),GLenum_val(format), Type_void_raw(raw)); return Val_unit; } ML_bc6 (ml_glReadPixels) ML_2 (glRectd, Pair(arg1,Double_val,Double_val), Pair(arg2,Double_val,Double_val)) ML_1_ (glRenderMode, GLenum_val, Val_int) ML_4 (glRotated, Double_val, Double_val, Double_val, Double_val) ML_3 (glScaled, Double_val, Double_val, Double_val) ML_4 (glScissor, Int_val, Int_val, Int_val, Int_val) ML_2 (glSelectBuffer, Int_val, (GLuint*)Addr_raw) ML_1 (glShadeModel, GLenum_val) ML_3 (glStencilFunc, GLenum_val, Int_val, Int_val) ML_1 (glStencilMask, Int_val) ML_3 (glStencilOp, GLenum_val, GLenum_val, GLenum_val) ML_1 (glTexCoord1d, Double_val) ML_2 (glTexCoord2d, Double_val, Double_val) ML_3 (glTexCoord3d, Double_val, Double_val, Double_val) ML_4 (glTexCoord4d, Double_val, Double_val, Double_val, Double_val) CAMLprim value ml_glTexEnv (value param) { value params = Field(param,1); GLfloat color[4]; int i; switch (Field(param,0)) { case MLTAG_mode: glTexEnvi (GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GLenum_val(params)); break; case MLTAG_color: for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i)); glTexEnvfv (GL_TEXTURE_ENV, GL_TEXTURE_ENV_COLOR, color); break; } return Val_unit; } CAMLprim value ml_glTexGen (value coord, value param) { value params = Field(param,1); GLdouble point[4]; int i; if (Field(param,0) == MLTAG_mode) glTexGeni (GLenum_val(coord), GL_TEXTURE_GEN_MODE, GLenum_val(params)); else { for (i = 0; i < 4; i++) point[i] = Double_val(Field(params,i)); glTexGendv (GLenum_val(coord), GLenum_val(Field(param,0)), point); } return Val_unit; } CAMLprim value ml_glTexImage1D (value proxy, value level, value internal, value width, value border, value format, value data) { glTexImage1D (proxy == Val_int(1) ? GL_PROXY_TEXTURE_1D : GL_TEXTURE_1D, Int_val(level), Int_val(internal), Int_val(width), Int_val(border), GLenum_val(format), Type_raw(data), Void_raw(data)); return Val_unit; } ML_bc7 (ml_glTexImage1D) CAMLprim value ml_glTexImage2D (value proxy, value level, value internal, value width, value height, value border, value format, value data) { /* printf("p=%x,l=%d,i=%d,w=%d,h=%d,b=%d,f=%x,t=%x,d=%x\n", */ glTexImage2D (proxy == Val_int(1) ? GL_PROXY_TEXTURE_2D : GL_TEXTURE_2D, Int_val(level), Int_val(internal), Int_val(width), Int_val(height), Int_val(border), GLenum_val(format), Type_raw(data), Void_raw(data)); /* flush(stdout); */ return Val_unit; } ML_bc8 (ml_glTexImage2D) CAMLprim value ml_glTexParameter (value target, value param) { GLenum targ = GLenum_val(target); GLenum pname = GLenum_val(Field(param,0)); value params = Field(param,1); GLfloat color[4]; int i; switch (pname) { case GL_TEXTURE_BORDER_COLOR: for (i = 0; i < 4; i++) color[i] = Float_val(Field(params,i)); glTexParameterfv (targ, pname, color); break; case GL_TEXTURE_PRIORITY: glTexParameterf (targ, pname, Float_val(params)); break; case GL_GENERATE_MIPMAP: #ifdef GL_VERSION_1_4 glTexParameteri (targ, pname, Int_val(params)); #else ml_raise_gl ("Parameter: GL_GENERATE_MIPMAP not available"); #endif break; default: glTexParameteri (targ, pname, GLenum_val(params)); break; } return Val_unit; } ML_2 (glGenTextures, Int_val, Int_raw) ML_2 (glBindTexture, GLenum_val, Nativeint_val) CAMLprim value ml_glDeleteTexture (value texture_id) { GLuint id = Nativeint_val(texture_id); glDeleteTextures(1,&id); return Val_unit; } ML_3 (glTranslated, Double_val, Double_val, Double_val) CAMLprim value ml_glVertex(value x, value y, value z, value w) /* ML */ { if (z == Val_int(0)) glVertex2d (Double_val(x), Double_val(y)); else if (w == Val_int(0)) glVertex3d (Double_val(x), Double_val(y), Double_val(Field(z, 0))); else glVertex4d (Double_val(x), Double_val(y), Double_val(Field(z, 0)), Double_val(Field(w, 0))); return Val_unit; } ML_4 (glViewport, Int_val, Int_val, Int_val, Int_val) /* List functions */ ML_1_ (glIsList, Int_val, Val_int) ML_2 (glDeleteLists, Int_val, Int_val) ML_1_ (glGenLists, Int_val, Val_int) ML_2 (glNewList, Int_val, GLenum_val) ML_0 (glEndList) ML_1 (glCallList, Int_val) ML_1 (glListBase, Int_val) CAMLprim value ml_glCallLists (value indexes) /* ML */ { int len,i; int * table; switch (Field(indexes,0)) { case MLTAG_byte: glCallLists (string_length(Field(indexes,1)), GL_UNSIGNED_BYTE, String_val(Field(indexes,1))); break; case MLTAG_int: len = Wosize_val (indexes); table = calloc (len, sizeof (GLint)); for (i = 0; i < len; i++) table[i] = Int_val (Field(indexes,i)); glCallLists (len, GL_INT, table); free (table); break; } return Val_unit; } lablgl-1.05/src/ml_gl.h000644 000765 000024 00000013632 12217024174 015703 0ustar00garriguestaff000000 000000 /* $Id: ml_gl.h,v 1.21 2003-10-03 04:27:19 garrigue Exp $ */ #ifndef _ml_gl_ #define _ml_gl_ #include "ml_raw.h" void ml_raise_gl (const char *errmsg) Noreturn; #define copy_string_check lablgl_copy_string_check value copy_string_check (const char *str); GLenum GLenum_val (value); #define Float_val(dbl) ((GLfloat) Double_val(dbl)) #define Addr_val(addr) ((GLvoid *) addr) #define Val_addr(addr) ((value) addr) #define Type_raw(raw) (GLenum_val(Kind_raw(raw))) #define Type_void_raw(raw) Type_raw(raw), Void_raw(raw) #define ML_0(cname) \ CAMLprim value ml_##cname (value unit) \ { cname (); return Val_unit; } #define ML_1(cname, conv1) \ CAMLprim value ml_##cname (value arg1) \ { cname (conv1(arg1)); return Val_unit; } #define ML_2(cname, conv1, conv2) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { cname (conv1(arg1), conv2(arg2)); return Val_unit; } #define ML_3(cname, conv1, conv2, conv3) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3)); return Val_unit; } #define ML_4(cname, conv1, conv2, conv3, conv4) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4)); \ return Val_unit; } #define ML_5(cname, conv1, conv2, conv3, conv4, conv5) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5)); \ return Val_unit; } #define ML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6)); \ return Val_unit; } #define ML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6), conv7(arg7)); \ return Val_unit; } #define ML_8(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6), conv7(arg7), conv8(arg8)); \ return Val_unit; } #define ML_0_(cname, conv) \ CAMLprim value ml_##cname (value unit) \ { return conv (cname ()); } #define ML_1_(cname, conv1, conv) \ CAMLprim value ml_##cname (value arg1) \ { return conv (cname (conv1(arg1))); } #define ML_2_(cname, conv1, conv2, conv) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { return conv (cname (conv1(arg1), conv2(arg2))); } #define ML_3_(cname, conv1, conv2, conv3, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } #define ML_4_(cname, conv1, conv2, conv3, conv4, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } #define ML_5_(cname, conv1, conv2, conv3, conv4, conv5, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5))); } #define ML_6_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6))); } #define ML_7_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7))); } #define ML_8_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8))); } /* Use with care: needs the argument index */ #define Ignore(x) #define Split(x,f,g) f(x), g(x) Ignore #define Split3(x,f,g,h) f(x), g(x), h(x) Ignore #define Pair(x,f,g) f(Field(x,0)), g(Field(x,1)) Ignore #define Triple(x,f,g,h) f(Field(x,0)), g(Field(x,1)), h(Field(x,2)) Ignore /* For more than 5 arguments */ #define ML_bc6(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } #define ML_bc7(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); } #define ML_bc8(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7]); } /* subtleties of openGL 1.1 vs 1.2 */ #if !defined(GL_DOUBLE) && defined(GL_DOUBLE_EXT) #define GL_DOUBLE GL_DOUBLE_EXT #endif #if !defined(GL_TEXTURE_PRIORITY) && defined(GL_TEXTURE_PRIORITY_EXT) #define GL_TEXTURE_PRIORITY GL_TEXTURE_PRIORITY_EXT #endif #if !defined(GL_PROXY_TEXTURE_1D) && defined(GL_PROXY_TEXTURE_1D_EXT) #define GL_PROXY_TEXTURE_1D GL_PROXY_TEXTURE_1D_EXT #endif #if !defined(GL_PROXY_TEXTURE_2D) && defined(GL_PROXY_TEXTURE_2D_EXT) #define GL_PROXY_TEXTURE_2D GL_PROXY_TEXTURE_2D_EXT #endif #endif lablgl-1.05/src/ml_glarray.c000644 000765 000024 00000005411 12217024174 016731 0ustar00garriguestaff000000 000000 #ifdef _WIN32 #include #endif #include #include #include #include #include #include #ifdef __APPLE__ #include #else #include #endif #include "ml_gl.h" #include "gl_tags.h" #include "raw_tags.h" #include "ml_raw.h" int ml_glSizeOfValue(value v) { switch(v) { case MLTAG_one: return(1); case MLTAG_two: return(2); case MLTAG_three: return(3); case MLTAG_four: return(4); default: ml_raise_gl("ml_glSizeOfValue: invalid size"); } } CAMLprim value ml_glEdgeFlagPointer(value raw) { glEdgeFlagPointer(0, (GLboolean*)Addr_raw(raw)); return Val_unit; } CAMLprim value ml_glTexCoordPointer(value size, value raw) { glTexCoordPointer (ml_glSizeOfValue(size), GLenum_val(Kind_raw(raw)), 0, Void_raw(raw)); return Val_unit; } CAMLprim value ml_glColorPointer(value size, value raw) { glColorPointer (ml_glSizeOfValue(size), GLenum_val(Kind_raw(raw)), 0, Void_raw(raw)); return Val_unit; } CAMLprim value ml_glIndexPointer(value raw) { glIndexPointer (GLenum_val(Kind_raw(raw)), 0, Void_raw(raw)); return Val_unit; } CAMLprim value ml_glNormalPointer(value raw) { glNormalPointer (GLenum_val(Kind_raw(raw)), 0, Void_raw(raw)); return Val_unit; } CAMLprim value ml_glVertexPointer(value size, value raw) { glVertexPointer (ml_glSizeOfValue(size), GLenum_val(Kind_raw(raw)), 0, Void_raw(raw)); return Val_unit; } CAMLprim value ml_glEnableClientState(value kl) { GLenum a; switch(kl) { case MLTAG_edge_flag: a = GL_EDGE_FLAG_ARRAY; break; case MLTAG_texture_coord: a = GL_TEXTURE_COORD_ARRAY; break; case MLTAG_color: a = GL_COLOR_ARRAY; break; case MLTAG_index: a = GL_INDEX_ARRAY; break; case MLTAG_normal: a = GL_NORMAL_ARRAY; break; case MLTAG_vertex: a = GL_VERTEX_ARRAY; break; default: ml_raise_gl("ml_glEnableClientState: invalid array"); } glEnableClientState(a); return Val_unit; } CAMLprim value ml_glDisableClientState(value kl) { GLenum a; switch(kl) { case MLTAG_edge_flag: a = GL_EDGE_FLAG_ARRAY; break; case MLTAG_texture_coord: a = GL_TEXTURE_COORD_ARRAY; break; case MLTAG_color: a = GL_COLOR_ARRAY; break; case MLTAG_index: a = GL_INDEX_ARRAY; break; case MLTAG_normal: a = GL_NORMAL_ARRAY; break; case MLTAG_vertex: a = GL_VERTEX_ARRAY; break; default: ml_raise_gl("ml_glDisableClientState: invalid array"); } glDisableClientState(a); return Val_unit; } ML_1 (glArrayElement, Int_val); ML_3 (glDrawArrays, GLenum_val, Int_val, Int_val); CAMLprim value ml_glDrawElements(value mode, value count, value raw) { glDrawElements (GLenum_val(mode), Int_val(count), GLenum_val(Kind_raw(raw)), Void_raw(raw)); return Val_unit; } lablgl-1.05/src/ml_glu.c000644 000765 000024 00000021124 12217024174 016056 0ustar00garriguestaff000000 000000 /* $Id: ml_glu.c,v 1.28 2004-11-02 07:03:34 garrigue Exp $ */ #ifdef _WIN32 #include #endif #ifdef __APPLE__ #include #include #else #include #include #endif #include #include #include #include #include "gl_tags.h" #include "glu_tags.h" #include "ml_gl.h" #include "ml_glu.h" GLenum GLUenum_val(value tag) { switch(tag) { #include "glu_tags.c" } ml_raise_gl ("Unknown GLU tag"); } /* Does not register the structure with Caml ! static value Val_addr (void *addr) { value wrapper; if (!addr) ml_raise_gl ("Bad address"); wrapper = alloc(1,No_scan_tag); Field(wrapper,0) = (value) addr; return wrapper; } */ #define Nurb_val(struc) ((GLUnurbsObj *) Field(struc,1)) #define Quad_val(struc) ((GLUquadricObj *) Field(struc,1)) #define Store_addr(struc, addr) Field(struc,1) = (value) addr #define ML_final(cname) \ static void ml_##cname (value struc) \ { cname ((GLvoid *) Field(struc,1)); } ML_final (gluDeleteNurbsRenderer) ML_final (gluDeleteQuadric) /* Called from ML */ ML_1 (gluBeginCurve, Nurb_val) ML_1 (gluBeginSurface, Nurb_val) ML_1 (gluBeginTrim, Nurb_val) CAMLprim value ml_gluBuild1DMipmaps (value internal, value width, value format, value data) { GLenum error; error = gluBuild1DMipmaps (GL_TEXTURE_1D, Int_val(internal), Int_val(width), GLenum_val(format), Type_raw(data), Void_raw(data)); if (error) ml_raise_gl((char*)gluErrorString(error)); return Val_unit; } CAMLprim value ml_gluBuild2DMipmaps (value internal, value width, value height, value format, value data) { GLint error; error = gluBuild2DMipmaps (GL_TEXTURE_2D, Int_val(internal), Int_val(width), Int_val(height), GLenum_val(format), Type_raw(data), Void_raw(data)); if (error) ml_raise_gl((char*)gluErrorString(error)); return Val_unit; } ML_6 (gluCylinder, Quad_val, Double_val, Double_val, Double_val, Int_val, Int_val) ML_bc6 (ml_gluCylinder) ML_5 (gluDisk, Quad_val, Double_val, Double_val, Int_val, Int_val) ML_1 (gluEndCurve, Nurb_val) ML_1 (gluEndSurface, Nurb_val) ML_1 (gluEndTrim, Nurb_val) ML_1_ (gluGetString, GLUenum_val, copy_string_check) ML_4 (gluLoadSamplingMatrices, Nurb_val, Float_raw, Float_raw, (GLint*)Int_raw) ML_3 (gluLookAt, Triple(arg1,Double_val,Double_val,Double_val), Triple(arg2,Double_val,Double_val,Double_val), Triple(arg3,Double_val,Double_val,Double_val)) CAMLprim value ml_gluNewNurbsRenderer (void) { value struc = alloc_final (2, ml_gluDeleteNurbsRenderer, 1, 32); Store_addr(struc, gluNewNurbsRenderer()); return struc; } CAMLprim value ml_gluNewQuadric (void) { value struc = alloc_final (2, ml_gluDeleteQuadric, 1, 32); Store_addr(struc, gluNewQuadric()); return struc; } #define Fsize_raw(raw) (Int_val(Size_raw(raw))/sizeof(GLfloat)) CAMLprim value ml_gluNurbsCurve (value nurb, value knots, value control, value order, value type) { GLenum targ = 0U; int ustride = 0; switch (type) { case MLTAG_vertex_3: targ = GL_MAP1_VERTEX_3; ustride = 3; break; case MLTAG_vertex_4: targ = GL_MAP1_VERTEX_4; ustride = 4; break; case MLTAG_index: targ = GL_MAP1_INDEX; ustride = 1; break; case MLTAG_color_4: targ = GL_MAP1_COLOR_4; ustride = 4; break; case MLTAG_normal: targ = GL_MAP1_NORMAL; ustride = 3; break; case MLTAG_texture_coord_1: targ = GL_MAP1_TEXTURE_COORD_1; ustride = 1; break; case MLTAG_texture_coord_2: targ = GL_MAP1_TEXTURE_COORD_2; ustride = 2; break; case MLTAG_texture_coord_3: targ = GL_MAP1_TEXTURE_COORD_3; ustride = 3; break; case MLTAG_texture_coord_4: targ = GL_MAP1_TEXTURE_COORD_4; ustride = 4; break; case MLTAG_trim_2: targ = GLU_MAP1_TRIM_2; ustride = 2; break; case MLTAG_trim_3: targ = GLU_MAP1_TRIM_3; ustride = 3; break; } gluNurbsCurve (Nurb_val(nurb), Fsize_raw(knots), Float_raw(knots), ustride, Float_raw(control), Int_val(order), targ); return Val_unit; } CAMLprim value ml_gluNurbsProperty (value nurb, value prop) { GLfloat val; GLenum property = GLUenum_val (Field(prop,0)); switch (property) { case GLU_SAMPLING_METHOD: case GLU_DISPLAY_MODE: val = GLUenum_val (Field(prop,1)); break; case GLU_PARAMETRIC_TOLERANCE: val = Float_val (Field(prop,1)); break; default: val = Int_val (Field(prop,1)); break; } gluNurbsProperty (Nurb_val(nurb), property, val); return Val_unit; } CAMLprim value ml_gluNurbsSurface (value nurb, value sKnots, value tKnots, value tStride, value control, value sOrder, value tOrder, value tag) { GLenum type = 0U; GLint sStride = 0; switch (tag) { case MLTAG_vertex_3: type = GL_MAP2_VERTEX_3; sStride = 3; break; case MLTAG_vertex_4: type = GL_MAP2_VERTEX_4; sStride = 4; break; case MLTAG_index: type = GL_MAP2_INDEX; sStride = 1; break; case MLTAG_color_4: type = GL_MAP2_COLOR_4; sStride = 4; break; case MLTAG_normal: type = GL_MAP2_NORMAL; sStride = 3; break; case MLTAG_texture_coord_1: type = GL_MAP2_TEXTURE_COORD_1; sStride = 1; break; case MLTAG_texture_coord_2: type = GL_MAP2_TEXTURE_COORD_2; sStride = 2; break; case MLTAG_texture_coord_3: type = GL_MAP2_TEXTURE_COORD_3; sStride = 3; break; case MLTAG_texture_coord_4: type = GL_MAP2_TEXTURE_COORD_4; sStride = 4; break; } gluNurbsSurface (Nurb_val(nurb), Fsize_raw(sKnots), Float_raw(sKnots), Fsize_raw(tKnots), Float_raw(tKnots), sStride, Int_val(tStride), Float_raw(control), Int_val(sOrder), Int_val(tOrder), type); return Val_unit; } ML_bc8 (ml_gluNurbsSurface) ML_4 (gluOrtho2D, Double_val, Double_val, Double_val, Double_val) ML_7 (gluPartialDisk, Quad_val, Double_val, Double_val, Int_val, Int_val, Double_val, Double_val) ML_bc7 (ml_gluPartialDisk) ML_4 (gluPerspective, Double_val, Double_val, Double_val, Double_val) CAMLprim value ml_gluPickMatrix (value x, value y, value delX, value delY) { GLint viewport[4]; glGetIntegerv (GL_VIEWPORT, viewport); gluPickMatrix (Double_val(x), Double_val(y), Double_val(delX), Double_val(delY), viewport); return Val_unit; } CAMLprim value ml_gluProject (value object) { CAMLparam0(); GLdouble model[16]; GLdouble proj[16]; GLint viewport[4]; GLdouble winX, winY, winZ; CAMLlocal3(win0, win1, win2); value win; glGetDoublev (GL_MODELVIEW_MATRIX, model); glGetDoublev (GL_PROJECTION_MATRIX, proj); glGetIntegerv (GL_VIEWPORT, viewport); gluProject (Double_val(Field(object,0)), Double_val(Field(object,1)), Double_val(Field(object,2)), model, proj, viewport, &winX, &winY, &winZ); win0 = copy_double(winX); win1 = copy_double(winY); win2 = copy_double(winZ); win = alloc_small(3, 0); Field(win,0) = win0; Field(win,1) = win1; Field(win,2) = win2; CAMLreturn(win); } CAMLprim value ml_gluPwlCurve (value nurbs, value count, value data, value tag) { GLenum type = 0U; GLint stride = 0; switch (tag) { case MLTAG_trim_2: type = GLU_MAP1_TRIM_2; stride = 2; break; case MLTAG_trim_3: type = GLU_MAP1_TRIM_3; stride = 3; break; } gluPwlCurve (Nurb_val(nurbs), Int_val(count), Float_raw(data), stride, type); return Val_unit; } ML_2 (gluQuadricDrawStyle, Quad_val, GLUenum_val) ML_2 (gluQuadricNormals, Quad_val, GLUenum_val) ML_2 (gluQuadricOrientation, Quad_val, GLUenum_val) ML_2 (gluQuadricTexture, Quad_val, Int_val) ML_7 (gluScaleImage, GLenum_val, Int_val, Int_val, Split(arg4,Type_raw,Void_raw), Int_val, Int_val, Split(arg7,Type_raw,Void_raw)) ML_bc7 (ml_gluScaleImage) ML_4 (gluSphere, Quad_val, Double_val, Int_val, Int_val) CAMLprim value ml_gluUnProject (value win) { CAMLparam0(); GLdouble model[16]; GLdouble proj[16]; GLint viewport[4]; GLdouble objX, objY, objZ; GLint ok; CAMLlocal3(obj0,obj1,obj2); value obj; glGetDoublev (GL_MODELVIEW_MATRIX, model); glGetDoublev (GL_PROJECTION_MATRIX, proj); glGetIntegerv (GL_VIEWPORT, viewport); ok = gluUnProject (Double_val(Field(win,0)), Double_val(Field(win,1)), Double_val(Field(win,2)), model, proj, viewport, &objX, &objY, &objZ); if (!ok) ml_raise_gl ("Glu.unproject : point out of window"); obj0 = copy_double(objX); obj1 = copy_double(objY); obj2 = copy_double(objZ); obj = alloc_small (3, 0); Field(obj,0) = obj0; Field(obj,1) = obj1; Field(obj,2) = obj2; CAMLreturn(obj); } lablgl-1.05/src/ml_glu.h000644 000765 000024 00000000622 12217024174 016063 0ustar00garriguestaff000000 000000 #ifndef _ml_glu_ #define _ml_glu_ GLenum GLUenum_val(value tag); #if !defined(GLU_VERSION_1_2) && !defined(GLU_TESS_WINDING_RULE) #define GLU_TESS_WINDING_RULE #define GLU_TESS_WINDING_ODD #define GLU_TESS_WINDING_NONZERO #define GLU_TESS_WINDING_POSITIVE #define GLU_TESS_WINDING_NEGATIVE #define GLU_TESS_WINDING_ABS_GEQ_TWO #define GLU_TESS_BOUNDARY_ONLY #define GLU_TESS_TOLERANCE #endif #endif lablgl-1.05/src/ml_glutess.c000644 000765 000024 00000013067 12217024174 016764 0ustar00garriguestaff000000 000000 /* $Id: ml_glutess.c,v 1.7 2008-02-25 01:52:20 garrigue Exp $ */ /* Code contributed by Jon Harrop */ #include #include #ifdef _WIN32 #include #endif #ifdef __APPLE__ #include #include #else #include #include #endif #include #include #include #include #include "gl_tags.h" #include "glu_tags.h" #include "ml_gl.h" #include "ml_glu.h" #ifndef GLU_VERSION_1_2 #define ML_fail(cname) \ CAMLprim value ml_##cname (value any) \ { ml_raise_gl ("Function not available: "#cname); } ML_fail (gluTesselate) ML_fail (gluTesselateAndReturn) #else /* Apparently this is used under Windows, according to the Red Book. */ #ifndef CALLBACK #define CALLBACK #endif #define AS_CB (GLvoid(CALLBACK *)()) static void CALLBACK errorCallback(GLenum error) { ml_raise_gl((char*)gluErrorString(error)); } typedef struct chunklist { struct chunklist *next; int current; int size; GLdouble data[32][3]; } chunklist; static chunklist *rootchunk=NULL; static GLdouble *new_vertex(GLdouble x, GLdouble y, GLdouble z) { GLdouble *vert; if (rootchunk == NULL || rootchunk->current >= rootchunk->size) { chunklist *tmp = rootchunk; rootchunk = (chunklist*)malloc(sizeof(chunklist)); rootchunk->next = tmp; rootchunk->current = 0; rootchunk->size = 32; } vert = rootchunk->data[rootchunk->current++]; vert[0] = x; vert[1] = y; vert[2] = z; return vert; } static void free_chunks() { while (rootchunk != NULL) { chunklist *next = rootchunk->next; free(rootchunk); rootchunk = next; } } static void CALLBACK combineCallback(GLdouble coords[3], GLdouble *vertex_data[4], GLfloat weight[4], GLdouble **data) { *data = new_vertex(coords[0],coords[1],coords[2]); } /* prim is only valid during callbacks */ static value *prim; static int kind = 0; static void push_vert(value root, double x, double y, double z) { CAMLparam1(root); CAMLlocal4(vert, xx, yy, zz); value cons; xx = copy_double(x); yy = copy_double(y); zz = copy_double(z); vert = alloc_tuple(3); Field(vert,0) = xx; Field(vert,1) = yy; Field(vert,2) = zz; cons = alloc_tuple(2); Field(cons, 0) = vert; Field(cons, 1) = Field(root,0); modify(&Field(root,0), cons); CAMLreturn0; } static void push_list() { value cons = alloc_tuple(2); Field(cons,0) = Val_unit; Field(cons,1) = Field(*prim,kind); modify(&Field(*prim,kind), cons); } static void CALLBACK beginCallback(GLenum type) { switch (type) { case GL_TRIANGLES : kind = 0; break; case GL_TRIANGLE_FAN : kind = 1; break; case GL_TRIANGLE_STRIP : kind = 2; break; default: { char msg[80]; sprintf(msg, "Unknown primitive format %d in tesselation.\n", (int)type); ml_raise_gl(msg); } } push_list(); } static void CALLBACK vertexCallback(void *vertex_data) { GLdouble *verts=(GLdouble *)vertex_data; push_vert(Field(*prim,kind), verts[0], verts[1], verts[2]); } static void CALLBACK endCallback() { kind = 0; } static GLUtesselator *tobj=NULL; static void iniTesselator(value winding, value by_only, value tolerance) { if (!tobj) { tobj=gluNewTess(); if (!tobj) ml_raise_gl("Failed to initialise the GLU tesselator."); } gluTessNormal(tobj, 0.0, 0.0, 1.0); gluTessProperty(tobj, GLU_TESS_WINDING_RULE, (winding != Val_unit ? GLUenum_val(Field(winding,0)) : GLU_TESS_WINDING_ODD)); gluTessProperty(tobj, GLU_TESS_BOUNDARY_ONLY, (by_only != Val_unit && Field(by_only,0) != Val_unit)); gluTessProperty(tobj, GLU_TESS_TOLERANCE, (tolerance != Val_unit ? Float_val(Field(by_only,0)) : 0)); } static void runTesselator(value contours) { CAMLparam1(contours); gluTessBeginPolygon(tobj, NULL); while (contours != Val_int(0)) { value contour=Field(contours, 0); gluTessBeginContour(tobj); while (contour != Val_int(0)) { value v=Field(contour, 0); GLdouble *r = new_vertex(Double_val(Field(v, 0)), Double_val(Field(v, 1)), Double_val(Field(v, 2))); gluTessVertex(tobj, r, (void *)r); contour = Field(contour, 1); } contours = Field(contours, 1); gluTessEndContour(tobj); } gluTessEndPolygon(tobj); gluDeleteTess(tobj); tobj = NULL; free_chunks(); CAMLreturn0; } CAMLprim value ml_gluTesselateAndReturn(value winding, value tolerance, value contours) { CAMLparam1(contours); CAMLlocal1(res); res = alloc_tuple(3); Field(res,0) = Field(res,1) = Field(res,2) = Val_unit; prim = &res; iniTesselator(winding, Val_unit, tolerance); gluTessCallback(tobj, GLU_TESS_BEGIN, AS_CB beginCallback); gluTessCallback(tobj, GLU_TESS_VERTEX, AS_CB vertexCallback); gluTessCallback(tobj, GLU_TESS_END, AS_CB endCallback); gluTessCallback(tobj, GLU_TESS_ERROR, AS_CB errorCallback); gluTessCallback(tobj, GLU_TESS_COMBINE, AS_CB combineCallback); runTesselator(contours); CAMLreturn (res); } CAMLprim value ml_gluTesselate (value winding, value by_only, value tolerance, value contours) { iniTesselator(winding, by_only, tolerance); gluTessCallback(tobj, GLU_TESS_BEGIN, AS_CB glBegin); gluTessCallback(tobj, GLU_TESS_VERTEX, AS_CB glVertex3dv); gluTessCallback(tobj, GLU_TESS_END, AS_CB glEnd); gluTessCallback(tobj, GLU_TESS_ERROR, AS_CB errorCallback); gluTessCallback(tobj, GLU_TESS_COMBINE, AS_CB combineCallback); runTesselator(contours); return Val_unit; } #endif lablgl-1.05/src/ml_raw.c000644 000765 000024 00000030162 12217024174 016062 0ustar00garriguestaff000000 000000 /* $Id: ml_raw.c,v 1.16 2007-04-13 02:48:43 garrigue Exp $ */ #include #include #include #include #include #include #include "raw_tags.h" #include "ml_raw.h" #define SIZE_BYTE sizeof(char) #define SIZE_SHORT sizeof(short) #define SIZE_INT sizeof(int) #define SIZE_LONG sizeof(long) #define SIZE_FLOAT sizeof(float) #define SIZE_DOUBLE sizeof(double) extern void invalid_argument (char *) Noreturn; extern void raise_out_of_memory (void) Noreturn; static int raw_sizeof (value kind) { switch (kind) { case MLTAG_bitmap: case MLTAG_byte: case MLTAG_ubyte: return SIZE_BYTE; case MLTAG_short: case MLTAG_ushort: return SIZE_SHORT; case MLTAG_int: case MLTAG_uint: return SIZE_INT; case MLTAG_long: case MLTAG_ulong: return SIZE_LONG; case MLTAG_float: return SIZE_FLOAT; case MLTAG_double: return SIZE_DOUBLE; } return 0; } CAMLprim value ml_raw_sizeof (value kind) /* ML */ { return Val_int(raw_sizeof(kind)); } static void check_size (value raw, long pos, char *msg) { if (pos < 0 || (pos+1) * raw_sizeof(Kind_raw(raw)) > Int_val(Size_raw(raw))) invalid_argument (msg); } CAMLprim value ml_raw_get (value raw, value pos) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.get"); switch (Kind_raw(raw)) { case MLTAG_bitmap: case MLTAG_ubyte: return Val_long ((unsigned char) Byte_raw(raw)[i]); case MLTAG_byte: return Val_long (Byte_raw(raw)[i]); case MLTAG_short: return Val_long (Short_raw(raw)[i]); case MLTAG_ushort: return Val_long ((unsigned short) Short_raw(raw)[i]); case MLTAG_int: return Val_long (Int_raw(raw)[i]); case MLTAG_uint: return Val_long ((unsigned int) Int_raw(raw)[i]); case MLTAG_long: return Val_long (Long_raw(raw)[i]); case MLTAG_ulong: return Val_long ((unsigned long) Long_raw(raw)[i]); } return Val_unit; } CAMLprim value ml_raw_read (value raw, value pos, value len) /* ML */ { int s = Int_val(pos); int i, l = Int_val(len); value ret; check_size (raw,s+l-1,"Raw.read"); if (l<0 || s<0) invalid_argument("Raw.read"); ret = alloc_shr (l, 0); switch (Kind_raw(raw)) { case MLTAG_bitmap: case MLTAG_ubyte: { unsigned char *byte_raw = (unsigned char *)Byte_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*byte_raw++); break; } case MLTAG_byte: { char *byte_raw = Byte_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*byte_raw++); break; } case MLTAG_short: { short *short_raw = Short_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*short_raw++); break; } case MLTAG_ushort: { unsigned short *short_raw = (unsigned short *)Short_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*short_raw++); break; } case MLTAG_int: { int *int_raw = Int_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*int_raw++); break; } case MLTAG_uint: { unsigned int *int_raw = (unsigned int *)Int_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*int_raw++); break; } case MLTAG_long: { long *long_raw = Long_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*long_raw++); break; } case MLTAG_ulong: { unsigned long *long_raw = (unsigned long *)Long_raw(raw)+s; for (i = 0; i < l; i++) Field(ret,i) = Val_long (*long_raw++); break; } } return ret; } CAMLprim value ml_raw_read_string (value raw, value pos, value len) /* ML */ { CAMLparam1(raw); int s = Int_val(pos); int l = Int_val(len); value ret; if (l<0 || s<0 || s+l > Int_val(Size_raw(raw))) invalid_argument("Raw.read_string"); ret = alloc_string (l); memcpy (String_val(ret), Bp_val(Addr_raw(raw))+s, l); CAMLreturn(ret); } CAMLprim value ml_raw_write_string (value raw, value pos, value data) /* ML */ { int s = Int_val(pos); int l = string_length(data); if (s<0 || s+l > Int_val(Size_raw(raw))) invalid_argument("Raw.write_string"); memcpy (Bp_val(Addr_raw(raw))+s, String_val(data), l); return Val_unit; } CAMLprim value ml_raw_set (value raw, value pos, value data) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.set"); switch (Kind_raw(raw)) { case MLTAG_bitmap: case MLTAG_ubyte: case MLTAG_byte: Byte_raw(raw)[i] = Long_val(data); break; case MLTAG_short: case MLTAG_ushort: Short_raw(raw)[i] = Long_val(data); break; case MLTAG_int: Int_raw(raw)[i] = Long_val(data); break; case MLTAG_uint: Int_raw(raw)[i] = Long_val((unsigned long) data); break; case MLTAG_long: Long_raw(raw)[i] = Long_val(data); break; case MLTAG_ulong: Long_raw(raw)[i] = Long_val((unsigned long) data); break; } return Val_unit; } CAMLprim value ml_raw_write (value raw, value pos, value data) /* ML */ { int s = Int_val(pos); int i, l = Wosize_val(data); check_size (raw,s+l-1,"Raw.write"); if (s<0) invalid_argument("Raw.write"); switch (Kind_raw(raw)) { case MLTAG_bitmap: case MLTAG_ubyte: case MLTAG_byte: { char *byte_raw = Byte_raw(raw)+s; for (i = 0; i < l; i++) *byte_raw++ = Long_val(Field(data,i)); break; } case MLTAG_short: case MLTAG_ushort: { short *short_raw = Short_raw(raw)+s; for (i = 0; i < l; i++) *short_raw++ = Long_val(Field(data,i)); break; } case MLTAG_int: { int *int_raw = Int_raw(raw)+s; for (i = 0; i < l; i++) *int_raw++ = Long_val(Field(data,i)); break; } case MLTAG_uint: { int *int_raw = Int_raw(raw)+s; for (i = 0; i < l; i++) *int_raw++ = Long_val((unsigned long) Field(data,i)); break; } case MLTAG_long: { long *long_raw = Long_raw(raw)+s; for (i = 0; i < l; i++) *long_raw++ = Long_val(Field(data,i)); break; } case MLTAG_ulong: { long *long_raw = Long_raw(raw)+s; for (i = 0; i < l; i++) *long_raw++ = Long_val((unsigned long) Field(data,i)); break; } } return Val_unit; } CAMLprim value ml_raw_get_float (value raw, value pos) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.get_float"); if (Kind_raw(raw) == MLTAG_float) return copy_double ((double) Float_raw(raw)[i]); else return copy_double (Double_raw(raw)[i]); } CAMLprim value ml_raw_read_float (value raw, value pos, value len) /* ML */ { int s = Int_val(pos); int i, l = Int_val(len); value ret = Val_unit; check_size (raw,s+l-1,"Raw.read_float"); if (l<0 || s<0) invalid_argument("Raw.read_float"); ret = alloc_shr (l*sizeof(double)/sizeof(value), Double_array_tag); if (Kind_raw(raw) == MLTAG_float) { float *float_raw = Float_raw(raw)+s; for (i = 0; i < l; i++) Store_double_field(ret, i, (double) *float_raw++); } else { double *double_raw = Double_raw(raw)+s; for (i = 0; i < l; i++) Store_double_field(ret, i, *double_raw++); } return ret; } CAMLprim value ml_raw_set_float (value raw, value pos, value data) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.set_float"); if (Kind_raw(raw) == MLTAG_float) Float_raw(raw)[i] = (float) Double_val(data); else Double_raw(raw)[i] = Double_val(data); return Val_unit; } CAMLprim value ml_raw_write_float (value raw, value pos, value data) /* ML */ { int s = Int_val(pos); int i, l = Wosize_val(data)*sizeof(value)/sizeof(double); check_size (raw,s+l-1,"Raw.write_float"); if (s<0) invalid_argument("Raw.write_float"); if (Kind_raw(raw) == MLTAG_float) { float *float_raw = Float_raw(raw)+s; for (i = 0; i < l; i++) *float_raw++ = (float) Double_field(data,i); } else { double *double_raw = Double_raw(raw)+s; for (i = 0; i < l; i++) *double_raw++ = Double_field(data,i); } return Val_unit; } #ifdef ARCH_BIG_ENDIAN #define HI_OFFSET 1 #define LO_OFFSET 0 #else #define HI_OFFSET 0 #define LO_OFFSET 1 #endif /* Here we suppose that: * sizeof(int) == 2*sizeof(short) * sizeof(long) == 2*sizeof(int) (64-bit architectures) * sizeof(long) == 2*sizeof(short) (otherwise) */ #define Hint_raw(raw) ((unsigned short *) Short_raw(raw)) #ifdef ARCH_SIXTYFOUR #define Hlong_raw(raw) ((unsigned int *) Int_raw(raw)) #else #define Hlong_raw(raw) ((unsigned short *) Short_raw(raw)) #endif CAMLprim value ml_raw_get_hi (value raw, value pos) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.get_hi"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: return Val_long (Hint_raw(raw)[2*i+HI_OFFSET]); case MLTAG_long: case MLTAG_ulong: return Val_long (Hlong_raw(raw)[2*i+HI_OFFSET]); } return Val_unit; } CAMLprim value ml_raw_get_lo (value raw, value pos) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.get_lo"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: return Val_long ((unsigned long) Hint_raw(raw)[2*i+LO_OFFSET]); case MLTAG_long: case MLTAG_ulong: return Val_long ((unsigned long) Hlong_raw(raw)[2*i+LO_OFFSET]); } return Val_unit; } CAMLprim value ml_raw_set_hi (value raw, value pos, value data) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.set_hi"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: Hint_raw(raw)[2*i+HI_OFFSET] = Long_val(data); break; case MLTAG_long: case MLTAG_ulong: Hlong_raw(raw)[2*i+HI_OFFSET] = Long_val(data); break; } return Val_unit; } CAMLprim value ml_raw_set_lo (value raw, value pos, value data) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.set_lo"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: Hint_raw(raw)[2*i+LO_OFFSET] = Long_val(data); break; case MLTAG_long: case MLTAG_ulong: Hlong_raw(raw)[2*i+LO_OFFSET] = Long_val(data); break; } return Val_unit; } CAMLprim value ml_raw_get_long (value raw, value pos) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.get_long"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: return copy_nativeint (Int_raw(raw)[i]); case MLTAG_long: case MLTAG_ulong: return copy_nativeint (Long_raw(raw)[i]); } return Val_unit; } CAMLprim value ml_raw_set_long (value raw, value pos, value data) /* ML */ { long i = Long_val(pos); check_size (raw,i,"Raw.set_long"); switch (Kind_raw(raw)) { case MLTAG_int: case MLTAG_uint: Int_raw(raw)[i] = Nativeint_val(data); break; case MLTAG_long: case MLTAG_ulong: Long_raw(raw)[i] = Nativeint_val(data); break; } return Val_unit; } CAMLprim value ml_raw_alloc (value kind, value len) /* ML */ { CAMLparam0(); CAMLlocal1(data); value raw; int size = raw_sizeof(kind) * Int_val(len); int offset = 0; if (kind == MLTAG_double && sizeof(double) > sizeof(value)) { data = alloc_shr ((size-1)/sizeof(value)+2, Abstract_tag); offset = (data % sizeof(double) ? sizeof(value) : 0); } else data = alloc_shr ((size-1)/sizeof(value)+1, Abstract_tag); raw = alloc_small (SIZE_RAW,0); Kind_raw(raw) = kind; Size_raw(raw) = Val_int(size); Base_raw(raw) = data; Offset_raw(raw) = Val_int(offset); Static_raw(raw) = Val_false; CAMLreturn(raw); } CAMLprim value ml_raw_alloc_static (value kind, value len) /* ML */ { value raw; void *data; int size = raw_sizeof(kind) * Int_val(len); int offset = 0; if (kind == MLTAG_double && sizeof(double) > sizeof(long)) { data = stat_alloc (size+sizeof(long)); offset = ((long)data % sizeof(double) ? sizeof(value) : 0); } else data = stat_alloc (size); raw = alloc_small (SIZE_RAW, 0); Kind_raw(raw) = kind; Size_raw(raw) = Val_int(size); Base_raw(raw) = (value) data; Offset_raw(raw) = Val_int(offset); Static_raw(raw) = Val_true; return raw; } CAMLprim value ml_raw_free_static (value raw) /* ML */ { if (Static_raw(raw) != Val_int(1)) invalid_argument ("Raw.free_static"); stat_free (Void_raw(raw)); Base_raw(raw) = Val_unit; Size_raw(raw) = Val_unit; Offset_raw(raw) = Val_unit; Static_raw(raw) = Val_false; return Val_unit; } lablgl-1.05/src/ml_raw.h000644 000765 000024 00000001312 12217024174 016062 0ustar00garriguestaff000000 000000 /* $Id: ml_raw.h,v 1.3 1999-04-14 14:05:52 garrigue Exp $ */ #ifndef _ml_raw_ #define _ml_raw_ #define SIZE_RAW 5 #define Kind_raw(raw) (Field(raw,0)) #define Base_raw(raw) (Field(raw,1)) #define Offset_raw(raw) (Field(raw,2)) #define Size_raw(raw) (Field(raw,3)) #define Static_raw(raw) (Field(raw,4)) #define Addr_raw(raw) (Base_raw(raw)+Long_val(Offset_raw(raw))) #define Void_raw(raw) ((void *) Addr_raw(raw)) #define Byte_raw(raw) ((char *) Addr_raw(raw)) #define Short_raw(raw) ((short *) Addr_raw(raw)) #define Int_raw(raw) ((int *) Addr_raw(raw)) #define Long_raw(raw) ((long *) Addr_raw(raw)) #define Float_raw(raw) ((float *) Addr_raw(raw)) #define Double_raw(raw) ((double *) Addr_raw(raw)) #endif lablgl-1.05/src/ml_shader.c000644 000765 000024 00000126352 12217024174 016546 0ustar00garriguestaff000000 000000 /* $Id: ml_shader.c,v 1.1 2010-03-11 08:30:02 garrigue Exp $ */ /* Code contributed by Florent Monnier */ #define GL_GLEXT_PROTOTYPES #ifdef _WIN32 #include #endif #include #ifdef __APPLE__ #include #include #else #include #include #endif #include #include #include #include #include #include #include "gl_tags.h" #include "ml_gl.h" #ifdef _WIN32 #include // if the PFNGL*PROC types are not defined in gl.h or glext.h add these lines: #if 0 typedef GLuint (APIENTRYP PFNGLCREATESHADERPROC) (GLenum type); typedef void (APIENTRYP PFNGLDELETESHADERPROC) (GLuint shader); typedef GLboolean (APIENTRYP PFNGLISSHADERPROC) (GLuint shader); typedef void (APIENTRYP PFNGLSHADERSOURCEPROC) (GLuint shader, GLsizei count, const GLchar* *string, const GLint *length); typedef void (APIENTRYP PFNGLCOMPILESHADERPROC) (GLuint shader); typedef void (APIENTRYP PFNGLGETSHADERIVPROC) (GLuint shader, GLenum pname, GLint *params); typedef GLuint (APIENTRYP PFNGLCREATEPROGRAMPROC) (void); typedef void (APIENTRYP PFNGLDELETEPROGRAMPROC) (GLuint program); typedef GLboolean (APIENTRYP PFNGLISPROGRAMPROC) (GLuint program); typedef void (APIENTRYP PFNGLUSEPROGRAMPROC) (GLuint program); typedef void (APIENTRYP PFNGLATTACHSHADERPROC) (GLuint program, GLuint shader); typedef void (APIENTRYP PFNGLDETACHSHADERPROC) (GLuint program, GLuint shader); typedef void (APIENTRYP PFNGLLINKPROGRAMPROC) (GLuint program); typedef void (APIENTRYP PFNGLGETPROGRAMIVPROC) (GLuint program, GLenum pname, GLint *params); typedef void (APIENTRYP PFNGLGETPROGRAMINFOLOGPROC) (GLuint program, GLsizei bufSize, GLsizei *length, GLchar *infoLog); typedef void (APIENTRYP PFNGLGETSHADERINFOLOGPROC) (GLuint shader, GLsizei bufSize, GLsizei *length, GLchar *infoLog); typedef GLint (APIENTRYP PFNGLGETUNIFORMLOCATIONPROC) (GLuint program, const GLchar *name); typedef void (APIENTRYP PFNGLUNIFORM1IPROC) (GLint location, GLint v0); typedef void (APIENTRYP PFNGLUNIFORM2IPROC) (GLint location, GLint v0, GLint v1); typedef void (APIENTRYP PFNGLUNIFORM3IPROC) (GLint location, GLint v0, GLint v1, GLint v2); typedef void (APIENTRYP PFNGLUNIFORM4IPROC) (GLint location, GLint v0, GLint v1, GLint v2, GLint v3); typedef void (APIENTRYP PFNGLUNIFORM1IVPROC) (GLint location, GLsizei count, const GLint *value); typedef void (APIENTRYP PFNGLUNIFORM2IVPROC) (GLint location, GLsizei count, const GLint *value); typedef void (APIENTRYP PFNGLUNIFORM3IVPROC) (GLint location, GLsizei count, const GLint *value); typedef void (APIENTRYP PFNGLUNIFORM4IVPROC) (GLint location, GLsizei count, const GLint *value); typedef void (APIENTRYP PFNGLUNIFORM1FPROC) (GLint location, GLfloat v0); typedef void (APIENTRYP PFNGLUNIFORM2FPROC) (GLint location, GLfloat v0, GLfloat v1); typedef void (APIENTRYP PFNGLUNIFORM3FPROC) (GLint location, GLfloat v0, GLfloat v1, GLfloat v2); typedef void (APIENTRYP PFNGLUNIFORM4FPROC) (GLint location, GLfloat v0, GLfloat v1, GLfloat v2, GLfloat v3); typedef void (APIENTRYP PFNGLUNIFORM1FVPROC) (GLint location, GLsizei count, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORM2FVPROC) (GLint location, GLsizei count, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORM3FVPROC) (GLint location, GLsizei count, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORM4FVPROC) (GLint location, GLsizei count, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX2FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX3FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX4FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX2X3FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX3X2FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX2X4FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX4X2FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX3X4FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef void (APIENTRYP PFNGLUNIFORMMATRIX4X3FVPROC) (GLint location, GLsizei count, GLboolean transpose, const GLfloat *value); typedef GLint (APIENTRYP PFNGLGETATTRIBLOCATIONPROC) (GLuint program, const GLchar *name); typedef void (APIENTRYP PFNGLVERTEXATTRIB1SPROC) (GLuint index, GLshort x); typedef void (APIENTRYP PFNGLVERTEXATTRIB1DPROC) (GLuint index, GLdouble x); typedef void (APIENTRYP PFNGLVERTEXATTRIB2SPROC) (GLuint index, GLshort x, GLshort y); typedef void (APIENTRYP PFNGLVERTEXATTRIB2DPROC) (GLuint index, GLdouble x, GLdouble y); typedef void (APIENTRYP PFNGLVERTEXATTRIB3SPROC) (GLuint index, GLshort x, GLshort y, GLshort z); typedef void (APIENTRYP PFNGLVERTEXATTRIB3DPROC) (GLuint index, GLdouble x, GLdouble y, GLdouble z); typedef void (APIENTRYP PFNGLVERTEXATTRIB4SPROC) (GLuint index, GLshort x, GLshort y, GLshort z, GLshort w); typedef void (APIENTRYP PFNGLVERTEXATTRIB4DPROC) (GLuint index, GLdouble x, GLdouble y, GLdouble z, GLdouble w); typedef void (APIENTRYP PFNGLBINDATTRIBLOCATIONPROC) (GLuint program, GLuint index, const GLchar *name); #endif #define LOAD_FUNC(func, f_type) \ static f_type func = NULL; \ static unsigned int func##_is_loaded = 0; \ if (!func##_is_loaded) { \ func = (f_type) wglGetProcAddress(#func); \ if (func == NULL) caml_failwith("Unable to load " #func); \ else func##_is_loaded = 1; \ } #else #define LOAD_FUNC(func, f_type) #endif /* end of ifdef _WIN32 */ /* GLSL Shaders */ #ifdef GL_VERSION_2_0 /* wrap as abstract */ //define Val_shader_object(v) ((value)(v)) //define Shader_object_val(v) ((GLuint)(v)) //define Val_shader_program(v) ((value)(v)) //define Shader_program_val(v) ((GLuint)(v)) /* wrap as ints */ #define Val_shader_object Val_long #define Shader_object_val Long_val #define Val_shader_program Val_long #define Shader_program_val Long_val CAMLprim value ml_glcreateshader( value shaderType ) { GLuint s = 0; LOAD_FUNC(glCreateShader, PFNGLCREATESHADERPROC) switch (shaderType) { case MLTAG_vertex_shader: s = glCreateShader(GL_VERTEX_SHADER); break; case MLTAG_fragment_shader: s = glCreateShader(GL_FRAGMENT_SHADER); break; default: caml_failwith("glShader.create"); } if (s == 0) caml_failwith("glShader.create"); return Val_shader_object(s); } CAMLprim value ml_gldeleteshader( value shader ) { LOAD_FUNC(glDeleteShader, PFNGLDELETESHADERPROC) glDeleteShader( Shader_object_val(shader) ); return Val_unit; } CAMLprim value ml_glisshader( value shader ) { LOAD_FUNC(glIsShader, PFNGLISSHADERPROC) return (glIsShader( Shader_object_val(shader) ) == GL_TRUE ? Val_true : Val_false); } CAMLprim value ml_glshadersource( value shader, value str ) { const char * vp = String_val(str); LOAD_FUNC(glShaderSource, PFNGLSHADERSOURCEPROC) glShaderSource(Shader_object_val(shader), 1, &vp, NULL); return Val_unit; } CAMLprim value ml_glcompileshader( value shader ) { LOAD_FUNC(glCompileShader, PFNGLCOMPILESHADERPROC) glCompileShader( Shader_object_val(shader) ); return Val_unit; } CAMLprim value ml_glcreateprogram( value unit ) { LOAD_FUNC(glCreateProgram, PFNGLCREATEPROGRAMPROC) GLuint p = glCreateProgram(); if (p == 0) caml_failwith("glShader.create_program"); return Val_shader_program(p); } CAMLprim value ml_gldeleteprogram( value program ) { LOAD_FUNC(glDeleteProgram, PFNGLDELETEPROGRAMPROC) glDeleteProgram( Shader_program_val(program) ); return Val_unit; } CAMLprim value ml_glattachshader( value program, value shader ) { LOAD_FUNC(glAttachShader, PFNGLATTACHSHADERPROC) glAttachShader( Shader_program_val(program), Shader_object_val(shader) ); return Val_unit; } CAMLprim value ml_gldetachshader( value program, value shader ) { LOAD_FUNC(glDetachShader, PFNGLDETACHSHADERPROC) glDetachShader( Shader_program_val(program), Shader_object_val(shader) ); return Val_unit; } CAMLprim value ml_gllinkprogram( value program ) { LOAD_FUNC(glLinkProgram, PFNGLLINKPROGRAMPROC) glLinkProgram( Shader_program_val(program) ); return Val_unit; } CAMLprim value ml_gluseprogram( value program ) { LOAD_FUNC(glUseProgram, PFNGLUSEPROGRAMPROC) glUseProgram( Shader_program_val(program) ); return Val_unit; } CAMLprim value ml_glunuseprogram( value unit ) { /* desactivate */ LOAD_FUNC(glUseProgram, PFNGLUSEPROGRAMPROC) glUseProgram(0); return Val_unit; } CAMLprim value ml_glgetshadercompilestatus( value shader ) { GLint error; LOAD_FUNC(glGetShaderiv, PFNGLGETSHADERIVPROC) glGetShaderiv( Shader_object_val(shader), GL_COMPILE_STATUS, &error); if (error == GL_TRUE) return Val_true; else return Val_false; } CAMLprim value ml_glgetshadercompilestatus_exn( value shader ) { GLint error; LOAD_FUNC(glGetShaderiv, PFNGLGETSHADERIVPROC) glGetShaderiv( Shader_object_val(shader), GL_COMPILE_STATUS, &error); if (error != GL_TRUE) caml_failwith("Shader compile status: error"); return Val_unit; } CAMLprim value ml_glgetuniformlocation( value program, value name ) { LOAD_FUNC(glGetUniformLocation, PFNGLGETUNIFORMLOCATIONPROC) return Val_int( glGetUniformLocation( Shader_program_val(program), String_val(name) )); } #else CAMLprim value ml_glcreateshader( value shaderType ) { caml_failwith("glCreateShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gldeleteshader( value shader ) { caml_failwith("glDeleteShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glisshader( value shader ) { caml_failwith("glIsShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glshadersource( value shader, value str ) { caml_failwith("glShaderSource function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glcompileshader( value shader ) { caml_failwith("glCompileShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glcreateprogram( value unit ) { caml_failwith("glCreateProgram function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gldeleteprogram( value program ) { caml_failwith("glDeleteProgram function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glattachshader( value program, value shader ) { caml_failwith("glAttachShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gldetachshader( value program, value shader ) { caml_failwith("glDetachShader function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gllinkprogram( value program ) { caml_failwith("glLinkProgram function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluseprogram( value program ) { caml_failwith("glUseProgram function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glunuseprogram( value unit ) { caml_failwith("glUseProgram function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_glgetuniformlocation( value program, value name ) { caml_failwith("glGetUniformLocation function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } #endif #ifdef GL_VERSION_2_0 CAMLprim value ml_gluniform1f( value location, value v0) { LOAD_FUNC(glUniform1f, PFNGLUNIFORM1FPROC) glUniform1f( Int_val(location), Double_val(v0)); return Val_unit; } CAMLprim value ml_gluniform2f( value location, value v0, value v1) { LOAD_FUNC(glUniform2f, PFNGLUNIFORM2FPROC) glUniform2f( Int_val(location), Double_val(v0), Double_val(v1)); return Val_unit; } CAMLprim value ml_gluniform3f( value location, value v0, value v1, value v2) { LOAD_FUNC(glUniform3f, PFNGLUNIFORM3FPROC) glUniform3f( Int_val(location), Double_val(v0), Double_val(v1), Double_val(v2)); return Val_unit; } CAMLprim value ml_gluniform4f( value location, value v0, value v1, value v2, value v3) { LOAD_FUNC(glUniform4f, PFNGLUNIFORM4FPROC) glUniform4f( Int_val(location), Double_val(v0), Double_val(v1), Double_val(v2), Double_val(v3)); return Val_unit; } CAMLprim value ml_gluniform1i( value location, value v0) { LOAD_FUNC(glUniform1i, PFNGLUNIFORM1IPROC) glUniform1i( Int_val(location), Int_val(v0)); return Val_unit; } CAMLprim value ml_gluniform2i( value location, value v0, value v1) { LOAD_FUNC(glUniform2i, PFNGLUNIFORM2IPROC) glUniform2i( Int_val(location), Int_val(v0), Int_val(v1)); return Val_unit; } CAMLprim value ml_gluniform3i( value location, value v0, value v1, value v2) { LOAD_FUNC(glUniform3i, PFNGLUNIFORM3IPROC) glUniform3i( Int_val(location), Int_val(v0), Int_val(v1), Int_val(v2)); return Val_unit; } CAMLprim value ml_gluniform4i( value location, value v0, value v1, value v2, value v3) { LOAD_FUNC(glUniform4i, PFNGLUNIFORM4IPROC) glUniform4i( Int_val(location), Int_val(v0), Int_val(v1), Int_val(v2), Int_val(v3)); return Val_unit; } #else CAMLprim value ml_gluniform1f( value location, value v0) { caml_failwith("glUniform1f function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform2f( value location, value v0, value v1) { caml_failwith("glUniform2f function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform3f( value location, value v0, value v1, value v2) { caml_failwith("glUniform3f function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform4f( value location, value v0, value v1, value v2, value v3) { caml_failwith("glUniform4f function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform1i( value location, value v0) { caml_failwith("glUniform1i function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform2i( value location, value v0, value v1) { caml_failwith("glUniform2i function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform3i( value location, value v0, value v1, value v2) { caml_failwith("glUniform3i function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } CAMLprim value ml_gluniform4i( value location, value v0, value v1, value v2, value v3) { caml_failwith("glUniform4i function is available only if the OpenGL version is 2.0 or greater"); return Val_unit; } #endif #ifdef GL_VERSION_2_0 CAMLprim value ml_gluniform1fv( value location, value vars ) { int i, len = Wosize_val(vars) / Double_wosize; GLfloat val[len]; for (i=0; i 0) { LOAD_FUNC(glGetShaderInfoLog, PFNGLGETSHADERINFOLOGPROC) value infoLog = caml_alloc_string(infologLength); glGetShaderInfoLog(Shader_object_val(shader), infologLength, &charsWritten, String_val(infoLog)); return infoLog; } else { return caml_copy_string(""); } #else caml_failwith("glGetShaderInfoLog is available only if the OpenGL version is 2.0 or greater"); return Val_unit; #endif } CAMLprim value ml_glgetprograminfolog(value program) { #ifdef GL_VERSION_2_0 int infologLength = 0; int charsWritten = 0; LOAD_FUNC(glGetProgramiv, PFNGLGETPROGRAMIVPROC) glGetProgramiv( Shader_program_val(program), GL_INFO_LOG_LENGTH, &infologLength); if (infologLength > 0) { LOAD_FUNC(glGetProgramInfoLog, PFNGLGETPROGRAMINFOLOGPROC) value infoLog = caml_alloc_string(infologLength); glGetProgramInfoLog(Shader_program_val(program), infologLength, &charsWritten, String_val(infoLog)); return infoLog; } else { return caml_copy_string(""); } #else caml_failwith("glGetProgramInfoLog is available only if the OpenGL version is 2.0 or greater"); return Val_unit; #endif } lablgl-1.05/src/raw.ml000644 000765 000024 00000006153 12217024174 015563 0ustar00garriguestaff000000 000000 (* $Id: raw.ml,v 1.9 2007-04-13 02:48:43 garrigue Exp $ *) type addr type kind = [`bitmap|`byte|`double|`float|`int|`long|`short |`ubyte|`uint|`ulong|`ushort] type fkind = [`double|`float] type ikind = [`bitmap|`byte|`int|`long|`short|`ubyte|`uint|`ulong|`ushort] type lkind = [`int|`long|`uint|`ulong] type 'a t = { kind: 'a; base: addr; offset: int; size: int; static: bool} let kind raw = raw.kind let byte_size raw = raw.size let static raw = raw.static let cast raw ~kind = { kind = kind; size = raw.size; base = raw.base; offset = raw.offset; static = raw.static } external sizeof : [< kind] -> int = "ml_raw_sizeof" let length raw = raw.size / sizeof raw.kind let sub raw ~pos ~len = let size = sizeof raw.kind in if pos < 0 or (pos+len) * size > raw.size then invalid_arg "Raw.sub"; { raw with offset = raw.offset + pos * size; size = len * size } external get : [< ikind] t -> pos:int -> int = "ml_raw_get" external set : [< ikind] t -> pos:int -> int -> unit = "ml_raw_set" external get_float : [< fkind] t -> pos:int -> float = "ml_raw_get_float" external set_float : [< fkind] t -> pos:int -> float -> unit = "ml_raw_set_float" external get_hi : [< lkind] t -> pos:int -> int = "ml_raw_get_hi" external set_hi : [< lkind] t -> pos:int -> int -> unit = "ml_raw_set_hi" external get_lo : [< lkind] t -> pos:int -> int = "ml_raw_get_lo" external set_lo : [< lkind] t -> pos:int -> int -> unit = "ml_raw_set_lo" external get_long : [< lkind] t -> pos:int -> nativeint = "ml_raw_get_long" external set_long : [< lkind] t -> pos:int -> nativeint -> unit = "ml_raw_set_long" external gets : [< ikind] t -> pos:int -> len:int -> int array = "ml_raw_read" external gets_string : 'a t -> pos:int -> len:int -> string = "ml_raw_read_string" external gets_float : [< fkind] t -> pos:int -> len:int -> float array = "ml_raw_read_float" external sets : [< ikind] t -> pos:int -> int array -> unit = "ml_raw_write" external sets_string : 'a t -> pos:int -> string -> unit = "ml_raw_write_string" external sets_float : [< fkind] t -> pos:int -> float array -> unit = "ml_raw_write_float" (* external fill : [< ikind] t -> pos:int -> len:int -> unit = "ml_raw_fill" external fill_float : [< fkind] t -> pos:int -> len:int -> unit = "ml_raw_fill_float" *) external create : ([< kind] as 'a) -> len:int -> 'a t = "ml_raw_alloc" external create_static : ([< kind] as 'a) -> len:int -> 'a t = "ml_raw_alloc_static" external free_static : 'a t -> unit = "ml_raw_free_static" let of_array arr ~kind = let raw = create kind ~len:(Array.length arr) in sets raw ~pos:0 arr; raw let of_float_array arr ~kind = let raw = create kind ~len:(Array.length arr) in sets_float raw ~pos:0 arr; raw let of_string s ~kind = let raw = create kind ~len:(String.length s) in sets_string raw ~pos:0 s; raw let of_matrix mat ~kind = let h = Array.length mat in if h = 0 then invalid_arg "Raw.of_matrix"; let w = Array.length mat.(0) in let raw = create kind ~len:(h*w) in for i = 0 to h - 1 do if Array.length mat.(i) <> w then invalid_arg "Raw.of_matrix"; sets_float raw ~pos:(i*w) mat.(i) done; raw lablgl-1.05/src/raw.mli000644 000765 000024 00000007204 12217024174 015732 0ustar00garriguestaff000000 000000 (* $Id: raw.mli,v 1.10 2007-04-13 02:48:43 garrigue Exp $ *) (* This module provides a direct way to access C arrays of basic types. This is particularly useful when one wants to avoid costly conversions between ML and C representations. *) type (+'a) t type kind = [`bitmap|`byte|`double|`float|`int|`long|`short |`ubyte|`uint|`ulong|`ushort] (* Supported element types. [bitmap] is equivalent to [ubyte] but allows user modules to distinguish between them *) type fkind = [`double|`float] type ikind = [`bitmap|`byte|`int|`long|`short|`ubyte|`uint|`ulong|`ushort] type lkind = [`int|`long|`uint|`ulong] val create : ([< kind] as 'a) -> len:int -> 'a t (* [create t :len] returns a new raw array of C type t and length len. This array is managed by the GC *) val create_static : ([< kind] as 'a) -> len:int -> 'a t (* [create_static t :len] returns a new raw array of C type t and length len. This array is created through malloc. You must free it explicitely *) val free_static : 'a t -> unit (* Free a raw array created through create_static *) val kind : 'a t -> 'a (* Returns the type of a free array. Beware of the influence on the type system: you probably want to write [(kind raw :> kind)] *) val byte_size : 'a t -> int (* The size of the array in bytes. That is (sizeof t * len) where t and len are the parameters to create *) val static : 'a t -> bool (* Wether this array was statically allocated or not *) val cast : 'a t -> kind:([< kind] as 'b) -> 'b t (* Change the type of a raw array *) external sizeof : [< kind] -> int = "ml_raw_sizeof" (* [sizeof t] returns the physical size of t in bytes *) val length : [< kind] t -> int (* [length raw] returns the length of raw array according to its contents type *) val sub : ([< kind] t as 'a) -> pos:int -> len:int -> 'a (* returns the slice of length len starting at position pos *) (* The following functions access raw arrays in the intuitive way. They raise [Invalid_argument] when access is attempted out of bounds *) external get : [< ikind] t -> pos:int -> int = "ml_raw_get" external set : [< ikind] t -> pos:int -> int -> unit = "ml_raw_set" external get_float : [< fkind] t -> pos:int -> float = "ml_raw_get_float" external set_float : [< fkind] t -> pos:int -> float -> unit = "ml_raw_set_float" external get_hi : [< lkind] t -> pos:int -> int = "ml_raw_get_hi" external set_hi : [< lkind] t -> pos:int -> int -> unit = "ml_raw_set_hi" external get_lo : [< lkind] t -> pos:int -> int = "ml_raw_get_lo" external set_lo : [< lkind] t -> pos:int -> int -> unit = "ml_raw_set_lo" external get_long : [< lkind] t -> pos:int -> nativeint = "ml_raw_get_long" external set_long : [< lkind] t -> pos:int -> nativeint -> unit = "ml_raw_set_long" (* Simultaneous access versions are much more efficient than individual access, the overhead being paid only once *) val gets : [< ikind] t -> pos:int -> len:int -> int array val sets : [< ikind] t -> pos:int -> int array -> unit val gets_float : [< fkind] t -> pos:int -> len:int -> float array val sets_float : [< fkind] t -> pos:int -> float array -> unit (* Fastest version: simply copy the contents of the array to and from a string *) val gets_string : 'a t -> pos:int -> len:int -> string val sets_string : 'a t -> pos:int -> string -> unit (* Abbreviations to create raw arrays from ML arrays and strings *) val of_array : int array -> kind:([< ikind] as 'a) -> 'a t val of_float_array : float array -> kind:([< fkind] as 'a) -> 'a t val of_string : string -> kind:([< kind] as 'a) -> 'a t val of_matrix : float array array -> kind:([< fkind] as 'a) -> 'a t lablgl-1.05/src/raw_tags.var000644 000765 000024 00000000102 12217024174 016745 0ustar00garriguestaff000000 000000 $$ bitmap byte ubyte short ushort int uint long ulong float doublelablgl-1.05/src/var2def.ml000644 000765 000024 00000002207 12217024174 016317 0ustar00garriguestaff000000 000000 (* $Id: var2def.ml,v 1.9 2001-09-06 08:27:02 garrigue Exp $ *) open StdLabels (* Compile a list of variant tags into CPP defines *) (* hash_variant, from ctype.ml *) let hash_variant s = let accu = ref 0 in for i = 0 to String.length s - 1 do accu := 223 * !accu + Char.code s.[i] done; (* reduce to 31 bits *) accu := !accu land (1 lsl 31 - 1); (* make it signed for 64 bits architectures *) if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu open Genlex let lexer = make_lexer ["->"; "$$"] let main () = let s = lexer (Stream.of_channel stdin) in let tags = Hashtbl.create 57 in try while true do match s with parser [< ' Ident tag >] -> print_string "#define MLTAG_"; print_string tag; print_string "\tVal_int("; let hash = hash_variant tag in begin try failwith (String.concat ~sep:" " ["Doublon ~tag:";tag;"and";Hashtbl.find tags hash]) with Not_found -> Hashtbl.add tags hash tag end; print_int hash; print_string ")\n" | [< ' Kwd "->"; ' Ident _ >] -> () | [< ' Kwd "$$" >] -> () | [< >] -> raise End_of_file done with End_of_file -> () let _ = Printexc.print main () lablgl-1.05/src/var2switch.ml000644 000765 000024 00000002010 12217024174 017052 0ustar00garriguestaff000000 000000 (* $Id: var2switch.ml,v 1.5 2001-05-08 01:58:25 garrigue Exp $ *) (* Build a switch statement translating variants to C tags *) open Genlex let lexer = make_lexer ["->"; "$$"] let main () = let table = ref false and prefix = ref "" and tag_number = ref 0 in Arg.parse ["-table", Arg.Set table, " Produce table output"] (fun s -> prefix := s) ""; let s = lexer (Stream.of_channel stdin) in try while true do match s with parser [< ' Ident tag >] -> incr tag_number; print_string (if !table then " {MLTAG_" else " case MLTAG_"); print_string tag; print_string (if !table then ", " else ":\treturn "); let name = match s with parser [< ' Kwd "->" ; ' Ident name >] -> name | [< >] -> !prefix ^ String.uppercase tag in print_string name; print_string (if !table then "},\n" else ";\n") | [< ' Kwd "$$" >] -> raise End_of_file | [< >] -> raise End_of_file done with End_of_file -> Printf.printf "#define TAG_NUMBER %d\n" !tag_number let _ = Printexc.print main () lablgl-1.05/LablGlut/ChangeLog000644 000765 000024 00000014201 12217024174 017122 0ustar00garriguestaff000000 000000 2002-09-11 Issac Trotts * examples/glut3.7/test/joy_test.ml, examples/glut3.7/test/test10.ml, examples/glut3.7/test/test2.ml, examples/glut3.7/test/test26.ml, examples/glut3.7/test/test4.ml, examples/glut3.7/test/test8.ml: updated calls to Glut.idleFunc * lablGL-0.98/gl_tags.var, lablGL-0.98/gluMat.ml, lablGL-0.98/gluMat.mli, lablGL-0.98/gluMisc.ml, lablGL-0.98/gluMisc.mli, lablGL-0.98/gluNurbs.ml, lablGL-0.98/gluNurbs.mli, lablGL-0.98/gluQuadric.ml, lablGL-0.98/gluQuadric.mli, lablGL-0.98/gluTess.ml, lablGL-0.98/gluTess.mli, lablGL-0.98/glu_tags.var, lablGL-0.98/lablGL.spec, lablGL-0.98/lablgl.bat, lablGL-0.98/lablgl.in, lablGL-0.98/ml_gl.c, lablGL-0.98/ml_gl.h, lablGL-0.98/ml_glu.c, lablGL-0.98/ml_raw.c, lablGL-0.98/ml_raw.h, lablGL-0.98/raw.ml, lablGL-0.98/raw.mli, lablGL-0.98/raw_tags.var, lablGL-0.98/var2def.ml, lablGL-0.98/var2switch.ml, lablGL-0.98/.cvsignore, lablGL-0.98/.depend, lablGL-0.98/CHANGES, lablGL-0.98/COPYRIGHT, lablGL-0.98/Makefile, lablGL-0.98/Makefile.config, lablGL-0.98/Makefile.config.ex, lablGL-0.98/README, lablGL-0.98/gl.ml, lablGL-0.98/gl.mli, lablGL-0.98/glClear.ml, lablGL-0.98/glClear.mli, lablGL-0.98/glDraw.ml, lablGL-0.98/glDraw.mli, lablGL-0.98/glFunc.ml, lablGL-0.98/glFunc.mli, lablGL-0.98/glLight.ml, lablGL-0.98/glLight.mli, lablGL-0.98/glList.ml, lablGL-0.98/glList.mli, lablGL-0.98/glMap.ml, lablGL-0.98/glMap.mli, lablGL-0.98/glMat.ml, lablGL-0.98/glMat.mli, lablGL-0.98/glMisc.ml, lablGL-0.98/glMisc.mli, lablGL-0.98/glPix.ml, lablGL-0.98/glPix.mli, lablGL-0.98/glTex.ml, lablGL-0.98/glTex.mli, examples/glut3.7/trackball/Makefile, examples/glut3.7/trackball/teaspin.ml, examples/glut3.7/test/joy_test.ml, examples/glut3.7/test/keyup_test.ml, examples/glut3.7/test/menu_test.ml, examples/glut3.7/test/shape_test.ml, examples/glut3.7/test/test1.ml, examples/glut3.7/test/test10.ml, examples/glut3.7/test/test11.ml, examples/glut3.7/test/test12.ml, examples/glut3.7/test/test13.ml, examples/glut3.7/test/test14.ml, examples/glut3.7/test/test15.ml, examples/glut3.7/test/test16.ml, examples/glut3.7/test/test17.ml, examples/glut3.7/test/test18.ml, examples/glut3.7/test/test19.ml, examples/glut3.7/test/test2.ml, examples/glut3.7/test/test20.ml, examples/glut3.7/test/test21.ml, examples/glut3.7/test/test22.ml, examples/glut3.7/test/test23.ml, examples/glut3.7/test/test24.ml, examples/glut3.7/test/test25.ml, examples/glut3.7/test/test26.ml, examples/glut3.7/test/test27.ml, examples/glut3.7/test/test28.ml, examples/glut3.7/test/test3.ml, examples/glut3.7/test/test4.ml, examples/glut3.7/test/test7.ml, examples/glut3.7/test/test8.ml, examples/glut3.7/test/test9.ml, examples/glut3.7/test/timer_test.ml, examples/glut3.7/test/cursor_test.ml, examples/nehe/lesson2.ml, examples/nehe/lesson3.ml, examples/nehe/lesson4.ml, examples/nehe/lesson5.ml, examples/etc/draw2d.ml, examples/lablGL/README, examples/lablGL/checker.ml, examples/lablGL/gears, examples/lablGL/gears.ml, examples/lablGL/morph3d.ml, examples/lablGL/planet.ml, examples/lablGL/scene.ml, examples/lablGL/simple.ml, examples/lablGL/texturesurf.ml, examples/checker.ml, examples/gears.ml, examples/morph3d.ml, examples/planet.ml, examples/scene.ml, examples/simple.ml, examples/texturesurf.ml: . * src_lablglut/ml_glut.h, src_lablglut/ml_raw.h: changed glutIdleFunc to take a function option so we can have a null idle function and not burn up the cpu * src_lablglut/ezgl.mli, src_lablglut/ezglut, src_lablglut/ezgl.ml: . 2002-09-02 Issac Trotts * examples/glut3.7/trackball/Makefile, examples/glut3.7/trackball/teaspin.ml, examples/glut3.7/trackball/trackball.ml, examples/glut3.7/trackball/trackball.mli: . * examples/glut3.7/not_yet_ported/Makefile, examples/glut3.7/not_yet_ported/teaspin.ml, examples/glut3.7/not_yet_ported/trackball.c, examples/glut3.7/not_yet_ported/trackball.h, examples/glut3.7/not_yet_ported/trackball.ml, examples/glut3.7/not_yet_ported/trackball.mli: removed some files * examples/glut3.7/not_yet_ported/teaspin.ml: - colored lights - "Spin me" * examples/glut3.7/not_yet_ported/teaspin.ml: - disabled back-face culling, so now the teapot renders correctly * examples/glut3.7/not_yet_ported/Makefile, examples/glut3.7/not_yet_ported/teaspin.ml: Got teaspin to work, though it's still rough around the edges. * examples/glut3.7/not_yet_ported/Makefile, examples/glut3.7/not_yet_ported/dinospin.c, examples/glut3.7/not_yet_ported/dinospin.ml, examples/glut3.7/not_yet_ported/scube.c, examples/glut3.7/not_yet_ported/scube.ml, examples/glut3.7/not_yet_ported/splatlogo.c, examples/glut3.7/not_yet_ported/splatlogo.ml, examples/glut3.7/not_yet_ported/spots.c, examples/glut3.7/not_yet_ported/spots.ml, examples/glut3.7/not_yet_ported/stars.c, examples/glut3.7/not_yet_ported/stars.ml, examples/glut3.7/not_yet_ported/teaspin.ml, examples/glut3.7/not_yet_ported/trackball.c, examples/glut3.7/not_yet_ported/trackball.h, examples/glut3.7/not_yet_ported/trackball.ml, examples/glut3.7/not_yet_ported/trackball.mli: . 2002-09-01 Issac Trotts * THANKS, lgcompile, lgport.py: . 2002-07-26 Issac Trotts * examples/README, examples/checker.ml, examples/gears.ml, examples/morph3d.ml, examples/planet.ml, examples/scene.ml, examples/simple.ml, examples/texturesurf.ml: New file. * examples/README, examples/checker.ml, examples/gears.ml, examples/morph3d.ml, examples/planet.ml, examples/scene.ml, examples/simple.ml, examples/texturesurf.ml: just getting started. * CHANGES, COPYRIGHT, README, TODO, build, src_lablglut/Makefile, src_lablglut/OCamlMakefile, src_lablglut/ezgl.ml, src_lablglut/ezgl.mli, src_lablglut/ezglut, src_lablglut/glut.ml, src_lablglut/glut.mli, src_lablglut/wrap_gl.c, src_lablglut/wrap_glut.c, toplevel_lablglut/Makefile, toplevel_lablglut/OCamlMakefile, toplevel_lablglut/lablglut: New file. * CHANGES, COPYRIGHT, README, TODO, build, src_lablglut/Makefile, src_lablglut/OCamlMakefile, src_lablglut/ezgl.ml, src_lablglut/ezgl.mli, src_lablglut/ezglut, src_lablglut/glut.ml, src_lablglut/glut.mli, src_lablglut/wrap_gl.c, src_lablglut/wrap_glut.c, toplevel_lablglut/Makefile, toplevel_lablglut/OCamlMakefile, toplevel_lablglut/lablglut: just getting started. lablgl-1.05/LablGlut/COPYRIGHT000644 000765 000024 00000003325 12217024174 016650 0ustar00garriguestaff000000 000000 LablGLUT, copyright (c) 2003 Issac Trotts. All rights reserved. This copyright does not apply to any of the bundled demos by Mike Kilgard or others, nor to the (modified) code by Hugues Casse contained in the c2ml directory, nor to the (modified) code by Xavier Leroy contained in the camlidl directory. Many of the demos are derived from original C sources in Mark Kilgard's GLUT distribution. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. The name of the author may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lablgl-1.05/LablGlut/examples/000755 000765 000024 00000000000 12217024342 017165 5ustar00garriguestaff000000 000000 lablgl-1.05/LablGlut/lgcompile000755 000765 000024 00000000712 12217024174 017253 0ustar00garriguestaff000000 000000 #!/usr/bin/env perl # compile a single-file lablglut demo sub sys { $cmd = @_[0]; print "$cmd\n"; system $cmd; } $bname = shift @ARGV; $bname =~ s/\.ml$//; $OCAML = $ENV{OCAML}; sys("ocamlc -I $OCAML/lablglut -I $OCAML/lablGL -g -c $bname.ml") or sys("ocamlc -I $OCAML/lablglut -I $OCAML/lablGL -g -o $bname " . "$OCAML/lablglut/lablglut.cma $OCAML/lablGL/lablgl.cma $bname.cmo") or sys("rm $bname.{cmi,cmo}") or # sys("ocamldebug $bname"); lablgl-1.05/LablGlut/README000644 000765 000024 00000001642 12217024174 016235 0ustar00garriguestaff000000 000000 *LablGLUT* A GLUT Binding for OCaml Last change: 2003 Oct 22 LablGLUT Issac Trotts ijtrotts@ucdavis.edu with nehe demo ports by Jeffrey Palmer Introduction ============ The LablGLUT library is an OCaml binding for GLUT version 3.7. GLUT (GL Utility Toolkit) is a portable windowing library for OpenGL, written by Mark Kilgard. GLUT tends to be easier to install and use than other OpenGL windowing alternatives. It is very portable, depending only on libraries for OpenGL and the underlying window system. Installation ============ The easy way is to become root and say ./build all opt install clean test Otherwise it's necessary to modify installation targets in the Makefiles. License ======= LablGLUT is under a BSD-style license. lablgl-1.05/LablGlut/src/000755 000765 000024 00000000000 12217024174 016141 5ustar00garriguestaff000000 000000 lablgl-1.05/LablGlut/THANKS000644 000765 000024 00000001266 12217024174 016272 0ustar00garriguestaff000000 000000 THANKS TO - Jeffrey Palmer for contributing the nehe demo ports - Mark Kilgard for creating GLUT - Jacques Garrigue for writing LablGL - Markus Mottl for writing OCamlMakefile - Hugues Casse for writing FrontC, the basis for the program c2ml included with LablGLUT. This program was very helpful in porting the original GLUT demos written in C. - Xavier Leroy for writing Camlidl, a wrapper generator for OCaml. LablGLUT comes with a modified version of Camlidl that can handle [bigarray,in] void* arguments, as well as arrays of GLdoubles and GLfloats. Camlidl was used to write LablGLUT's simplified bindings for GL and GLU. - The OCaml team lablgl-1.05/LablGlut/TODO000644 000765 000024 00000000062 12217024174 016040 0ustar00garriguestaff000000 000000 - port lots of demos - add reading of .pnm files lablgl-1.05/LablGlut/src/.cvsignore000644 000765 000024 00000000041 12217024174 020134 0ustar00garriguestaff000000 000000 lablglut lablgluttop* dll* *.lib lablgl-1.05/LablGlut/src/.depend000644 000765 000024 00000000572 12217024174 017405 0ustar00garriguestaff000000 000000 gl_constants.cmo: gl_constants.cmi gl_constants.cmx: gl_constants.cmi glocaml.cmo: glutcaml.cmi glocaml.cmx: glutcaml.cmx glu_constants.cmo: glu_constants.cmi glu_constants.cmx: glu_constants.cmi glut.cmo: glut.cmi glut.cmx: glut.cmi glut_constants.cmo: glut_constants.cmi glut_constants.cmx: glut_constants.cmi glutcaml.cmo: glutcaml.cmi glutcaml.cmx: glutcaml.cmi lablgl-1.05/LablGlut/src/glut.ml000644 000765 000024 00000066311 12217024174 017455 0ustar00garriguestaff000000 000000 (* ==== types ==== *) type button_t = | LEFT_BUTTON | MIDDLE_BUTTON | RIGHT_BUTTON | OTHER_BUTTON of int type mouse_button_state_t = | DOWN | UP type special_key_t = | KEY_F1 | KEY_F2 | KEY_F3 | KEY_F4 | KEY_F5 | KEY_F6 | KEY_F7 | KEY_F8 | KEY_F9 | KEY_F10 | KEY_F11 | KEY_F12 (* directional keys *) | KEY_LEFT | KEY_UP | KEY_RIGHT | KEY_DOWN | KEY_PAGE_UP | KEY_PAGE_DOWN | KEY_HOME | KEY_END | KEY_INSERT (* for undefined keys *) | KEY_OTHER of int type entry_exit_state_t = | LEFT | ENTERED type menu_state_t = | MENU_NOT_IN_USE | MENU_IN_USE type visibility_state_t = | NOT_VISIBLE | VISIBLE type window_status_t = | HIDDEN | FULLY_RETAINED | PARTIALLY_RETAINED | FULLY_COVERED type color_index_component_t = | RED | GREEN | BLUE type layer_t = | NORMAL | OVERLAY type font_t = | STROKE_ROMAN | STROKE_MONO_ROMAN | BITMAP_9_BY_15 | BITMAP_8_BY_13 | BITMAP_TIMES_ROMAN_10 | BITMAP_TIMES_ROMAN_24 | BITMAP_HELVETICA_10 | BITMAP_HELVETICA_12 | BITMAP_HELVETICA_18 type glut_get_t = | WINDOW_X | WINDOW_Y | WINDOW_WIDTH | WINDOW_HEIGHT | WINDOW_BUFFER_SIZE | WINDOW_STENCIL_SIZE | WINDOW_DEPTH_SIZE | WINDOW_RED_SIZE | WINDOW_GREEN_SIZE | WINDOW_BLUE_SIZE | WINDOW_ALPHA_SIZE | WINDOW_ACCUM_RED_SIZE | WINDOW_ACCUM_GREEN_SIZE | WINDOW_ACCUM_BLUE_SIZE | WINDOW_ACCUM_ALPHA_SIZE | WINDOW_DOUBLEBUFFER | WINDOW_RGBA | WINDOW_PARENT | WINDOW_NUM_CHILDREN | WINDOW_COLORMAP_SIZE | WINDOW_NUM_SAMPLES | WINDOW_STEREO | WINDOW_CURSOR | SCREEN_WIDTH | SCREEN_HEIGHT | SCREEN_WIDTH_MM | SCREEN_HEIGHT_MM | MENU_NUM_ITEMS (* | DISPLAY_MODE_POSSIBLE : use getBool *) | INIT_WINDOW_X | INIT_WINDOW_Y | INIT_WINDOW_WIDTH | INIT_WINDOW_HEIGHT | INIT_DISPLAY_MODE | ELAPSED_TIME | WINDOW_FORMAT_ID type glut_get_bool_t = | DISPLAY_MODE_POSSIBLE let rgb = 0;; let rgba = rgb;; (* same as in glut.h *) let index = 1;; let single = 0;; let double = 2;; let accum = 4;; let alpha = 8;; let depth = 16;; let stencil = 32;; let multisample = 128;; let stereo = 256;; let luminance = 512;; type device_get_t = | HAS_KEYBOARD | HAS_MOUSE | HAS_SPACEBALL | HAS_DIAL_AND_BUTTON_BOX | HAS_TABLET | NUM_MOUSE_BUTTONS | NUM_SPACEBALL_BUTTONS | NUM_BUTTON_BOX_BUTTONS | NUM_DIALS | NUM_TABLET_BUTTONS | DEVICE_IGNORE_KEY_REPEAT | DEVICE_KEY_REPEAT | HAS_JOYSTICK | OWNS_JOYSTICK | JOYSTICK_BUTTONS | JOYSTICK_AXES | JOYSTICK_POLL_RATE type layerget_t = | OVERLAY_POSSIBLE (* | LAYER_IN_USE : use layerGetInUse *) | HAS_OVERLAY (* | TRANSPARENT_INDEX : use layerGetTransparentIndex *) | NORMAL_DAMAGED | OVERLAY_DAMAGED type video_resize_t = | VIDEO_RESIZE_POSSIBLE | VIDEO_RESIZE_IN_USE | VIDEO_RESIZE_X_DELTA | VIDEO_RESIZE_Y_DELTA | VIDEO_RESIZE_WIDTH_DELTA | VIDEO_RESIZE_HEIGHT_DELTA | VIDEO_RESIZE_X | VIDEO_RESIZE_Y | VIDEO_RESIZE_WIDTH | VIDEO_RESIZE_HEIGHT type get_modifiers_t = | ACTIVE_SHIFT | ACTIVE_CTRL | ACTIVE_ALT let active_shift = 1 let active_ctrl = 2 let active_alt = 4 type cursor_t = (* Basic arrows. *) | CURSOR_RIGHT_ARROW | CURSOR_LEFT_ARROW (* Symbolic cursor shapes. *) | CURSOR_INFO | CURSOR_DESTROY | CURSOR_HELP | CURSOR_CYCLE | CURSOR_SPRAY | CURSOR_WAIT | CURSOR_TEXT | CURSOR_CROSSHAIR (* Directional cursors. *) | CURSOR_UP_DOWN | CURSOR_LEFT_RIGHT (* Sizing cursors. *) | CURSOR_TOP_SIDE | CURSOR_BOTTOM_SIDE | CURSOR_LEFT_SIDE | CURSOR_RIGHT_SIDE | CURSOR_TOP_LEFT_CORNER | CURSOR_TOP_RIGHT_CORNER | CURSOR_BOTTOM_RIGHT_CORNER | CURSOR_BOTTOM_LEFT_CORNER | CURSOR_INHERIT (* inherit cursor from parent window *) | CURSOR_NONE (* blank cursor *) | CURSOR_FULL_CROSSHAIR (* full-screen crosshair : if available *) type game_mode_t = | GAME_MODE_ACTIVE | GAME_MODE_POSSIBLE | GAME_MODE_WIDTH | GAME_MODE_HEIGHT | GAME_MODE_PIXEL_DEPTH | GAME_MODE_REFRESH_RATE | GAME_MODE_DISPLAY_CHANGED type key_repeat_t = | KEY_REPEAT_OFF | KEY_REPEAT_ON | KEY_REPEAT_DEFAULT exception BadEnum of string exception InvalidState of string exception OverlayNotInUse of string open Printf;; (* ==== file-local variables ==== *) let is_init = ref false;; let is_displayModeInit = ref false;; let is_windowSizeInit = ref false;; let is_windowPositionInit = ref false;; let has_createdWindow = ref false;; (* === GLUT initialization sub-API. === *) external _glutInit : int -> string array -> int = "ml_glutInit" let init ~argv = if !is_init then argv else begin is_init := true; let argc = Array.length argv in let argv = Array.append argv [|""|] in let argc = _glutInit argc argv in Array.sub argv 0 argc end external _glutInitDisplayMode : double_buffer:bool -> index:bool -> accum:bool -> alpha:bool -> depth:bool -> stencil:bool -> multisample:bool -> stereo:bool -> luminance:bool -> unit = "bytecode_glutInitDisplayMode" "native_glutInitDisplayMode" let initDisplayMode ?(double_buffer=false) ?(index=false) ?(accum=false) ?(alpha=false) ?(depth=false) ?(stencil=false) ?(multisample=false) ?(stereo=false) ?(luminance=false) dummy_unit = is_displayModeInit := true; _glutInitDisplayMode double_buffer index accum alpha depth stencil multisample stereo luminance ;; external _glutInitWindowSize : int->int->unit = "ml_glutInitWindowSize" external _glutInitWindowPosition : int->int->unit = "ml_glutInitWindowPosition" let initWindowPosition ~x ~y = is_windowPositionInit := true; _glutInitWindowPosition x y;; let initWindowSize ~w ~h = is_windowSizeInit := true; _glutInitWindowSize w h;; external mainLoop : unit->unit = "ml_glutMainLoop" (* === GLUT window sub-API. === *) external _glutCreateWindow : string->int = "ml_glutCreateWindow" let createWindow ~title = has_createdWindow := true; let winid = _glutCreateWindow title in winid;; external postRedisplay : unit->unit = "ml_glutPostRedisplay" external swapBuffers : unit->unit = "ml_glutSwapBuffers" external createSubWindow: win:int->x:int->y:int->w:int->h:int->int = "ml_glutCreateSubWindow" external destroyWindow: win:int -> unit = "ml_glutDestroyWindow" external setWindow: win:int -> unit = "ml_glutSetWindow" external getWindow: unit -> int = "ml_glutGetWindow" external setWindowTitle: title:string -> unit = "ml_glutSetWindowTitle" external setIconTitle: title:string -> unit = "ml_glutSetIconTitle" external positionWindow: x:int -> y:int -> unit = "ml_glutPositionWindow" external reshapeWindow: w:int -> h:int -> unit = "ml_glutReshapeWindow" external popWindow: unit -> unit = "ml_glutPopWindow" external pushWindow: unit -> unit = "ml_glutPushWindow" external iconifyWindow: unit -> unit = "ml_glutIconifyWindow" external showWindow: unit -> unit = "ml_glutShowWindow" external hideWindow: unit -> unit = "ml_glutHideWindow" external fullScreen: unit -> unit = "ml_glutFullScreen" external _setCursor: c:int -> unit = "ml_glutSetCursor" let setCursor c = let ic = match c with (* Basic arrows. *) | CURSOR_RIGHT_ARROW -> 0 (* values from glut.h *) | CURSOR_LEFT_ARROW -> 1 (* Symbolic cursor shapes. *) | CURSOR_INFO -> 2 | CURSOR_DESTROY -> 3 | CURSOR_HELP -> 4 | CURSOR_CYCLE -> 5 | CURSOR_SPRAY -> 6 | CURSOR_WAIT -> 7 | CURSOR_TEXT -> 8 | CURSOR_CROSSHAIR -> 9 (* Directional cursors. *) | CURSOR_UP_DOWN -> 10 | CURSOR_LEFT_RIGHT -> 11 (* Sizing cursors. *) | CURSOR_TOP_SIDE -> 12 | CURSOR_BOTTOM_SIDE -> 13 | CURSOR_LEFT_SIDE -> 14 | CURSOR_RIGHT_SIDE -> 15 | CURSOR_TOP_LEFT_CORNER -> 16 | CURSOR_TOP_RIGHT_CORNER -> 17 | CURSOR_BOTTOM_RIGHT_CORNER -> 18 | CURSOR_BOTTOM_LEFT_CORNER -> 19 | CURSOR_INHERIT -> 100 | CURSOR_NONE -> 101 | CURSOR_FULL_CROSSHAIR -> 102 in _setCursor ic ;; (* === GLUT overlay sub-API. === *) external establishOverlay: unit->unit = "ml_glutEstablishOverlay" external removeOverlay: unit->unit = "ml_glutRemoveOverlay" external postOverlayRedisplay: unit->unit = "ml_glutPostOverlayRedisplay" external showOverlay: unit->unit = "ml_glutShowOverlay" external hideOverlay: unit->unit = "ml_glutHideOverlay" external _useLayer: int -> unit = "ml_glutUseLayer" let useLayer layer = _useLayer (match layer with NORMAL -> 0 | OVERLAY -> 1) (* === GLUT menu sub-API. === *) external createMenu: cb:(value:int -> unit) ->int = "ml_glutCreateMenu" external destroyMenu: menu:int->unit = "ml_glutDestroyMenu" external getMenu: unit->int = "ml_glutGetMenu" external setMenu: menu:int->unit = "ml_glutSetMenu" external addMenuEntry: label:string->value:int->unit = "ml_glutAddMenuEntry" external addSubMenu: label:string->submenu:int->unit = "ml_glutAddSubMenu" external changeToMenuEntry: item:int->label:string->value:int->unit = "ml_glutChangeToMenuEntry" external changeToSubMenu: item:int->label:string->submenu:int->unit = "ml_glutChangeToSubMenu" external removeMenuItem: item:int->unit= "ml_glutRemoveMenuItem" let int_of_button b = match b with | LEFT_BUTTON -> 0 | MIDDLE_BUTTON -> 1 | RIGHT_BUTTON -> 2 | OTHER_BUTTON n -> n let b2i b = int_of_button b;; external _attachMenu: button:int->unit= "ml_glutAttachMenu" let attachMenu ~button = _attachMenu (b2i button);; external _detachMenu: button:int->unit= "ml_glutDetachMenu" let detachMenu ~button = _detachMenu (b2i button);; (* === GLUT window callback sub-API. === *) let window_wrapper cbFunc wr = let table = Hashtbl.create 3 in fun ~cb -> Hashtbl.add table (getWindow()) cb; cbFunc ~cb:(wr (fun () -> Hashtbl.find table (getWindow()))) external _displayFunc : cb:(unit->unit)->unit = "ml_glutDisplayFunc" let displayFunc = window_wrapper _displayFunc (fun cb () -> cb () ()) external _reshapeFunc : cb:(w:int->h:int->unit)->unit = "ml_glutReshapeFunc" let reshapeFunc = window_wrapper _reshapeFunc (fun cb ~w -> cb () ~w) external _keyboardFunc : cb:(key:int->x:int->y:int->unit)->unit = "ml_glutKeyboardFunc" let keyboardFunc = window_wrapper _keyboardFunc (fun cb ~key -> cb () ~key) external _glutMouseFunc : cb:(int -> int -> int -> int -> unit)->unit = "ml_glutMouseFunc" let mouse_cb_wrapper user_func ibutton istate x y = let b = match ibutton with | 0 -> LEFT_BUTTON | 1 -> MIDDLE_BUTTON | 2 -> RIGHT_BUTTON | n -> OTHER_BUTTON n in let s = match istate with | 0 -> DOWN | 1 -> UP | _ -> raise (BadEnum "istate in mouse_cb_wrapper") in user_func () ~button:b ~state:s ~x ~y;; let mouseFunc = window_wrapper _glutMouseFunc mouse_cb_wrapper let eta_x cb ~x = cb () ~x external _motionFunc : cb:(x:int->y:int->unit)->unit = "ml_glutMotionFunc" let motionFunc = window_wrapper _motionFunc eta_x external _passiveMotionFunc : cb:(x:int->y:int->unit)->unit = "ml_glutPassiveMotionFunc" let passiveMotionFunc = window_wrapper _passiveMotionFunc eta_x let eta_state cb ~state = cb () ~state external _entryFunc : cb:(state:entry_exit_state_t->unit)->unit = "ml_glutEntryFunc" let entryFunc = window_wrapper _entryFunc eta_state external _visibilityFunc : cb:(state:visibility_state_t->unit)->unit = "ml_glutVisibilityFunc" let visibilityFunc = window_wrapper _visibilityFunc eta_state (* idleFunc is for the entire program, not just a single window, so its name does not depend on the window id *) external _glutIdleFunc:(unit->unit)->unit="ml_glutIdleFunc" external _setIdleFuncToNull:unit->unit="ml_glutSetIdleFuncToNull" let idleFunc ~cb = match cb with | None -> _setIdleFuncToNull(); | Some cb -> begin _glutIdleFunc cb; end ;; (* timerFunc is non-window-dependent *) external _timerFunc : int -> int -> unit = "ml_glutTimerFunc" external init_timerFunc : (int -> unit) -> unit = "init_glutTimerFunc_cb" let timer_hashtbl = Hashtbl.create 101 let real_call_back i = Hashtbl.find timer_hashtbl i () let _ = init_timerFunc real_call_back let timer_count = ref 0 let timerFunc ~ms ~cb:(cb:(value:'a -> unit)) ~value = let i = !timer_count in incr timer_count; Hashtbl.add timer_hashtbl i (fun () -> Hashtbl.remove timer_hashtbl i; cb value); _timerFunc ms i let special_of_int = function | 1 -> KEY_F1 (* values from glut.h *) | 2 -> KEY_F2 | 3 -> KEY_F3 | 4 -> KEY_F4 | 5 -> KEY_F5 | 6 -> KEY_F6 | 7 -> KEY_F7 | 8 -> KEY_F8 | 9 -> KEY_F9 | 10 -> KEY_F10 | 11 -> KEY_F11 | 12 -> KEY_F12 | 100 -> KEY_LEFT | 101 -> KEY_UP | 102 -> KEY_RIGHT | 103 -> KEY_DOWN | 104 -> KEY_PAGE_UP | 105 -> KEY_PAGE_DOWN | 106 -> KEY_HOME | 107 -> KEY_END | 108 -> KEY_INSERT | i -> KEY_OTHER i external _glutSpecialFunc : cb:(key:int->x:int->y:int->unit)->unit = "ml_glutSpecialFunc" let specialFunc = window_wrapper _glutSpecialFunc (fun cb ~key -> cb () ~key:(special_of_int key)) external _spaceballMotionFunc: cb:(x:int->y:int->z:int->unit)->unit = "ml_glutSpaceballMotionFunc" let spaceballMotionFunc = window_wrapper _spaceballMotionFunc eta_x external _spaceballRotateFunc: cb:(x:int->y:int->z:int->unit)->unit = "ml_glutSpaceballRotateFunc" let spaceballRotateFunc = window_wrapper _spaceballRotateFunc eta_x let eta_button cb ~button = cb () ~button external _spaceballButtonFunc: cb:(button:int->state:int->unit)->unit = "ml_glutSpaceballButtonFunc" let spaceballButtonFunc = window_wrapper _spaceballButtonFunc eta_button external _buttonBoxFunc: cb:(button:int->state:int->unit)->unit = "ml_glutButtonBoxFunc" let buttonBoxFunc = window_wrapper _buttonBoxFunc eta_button external _dialsFunc: cb:(dial:int->value:int->unit)->unit = "ml_glutDialsFunc" let dialsFunc = window_wrapper _dialsFunc (fun cb ~dial -> cb () ~dial) external _tabletMotionFunc: cb:(x:int->y:int->unit)->unit = "ml_glutTabletMotionFunc" let tabletMotionFunc = window_wrapper _tabletMotionFunc eta_x external _tabletButtonFunc: cb:(button:int->state:int->x:int->y:int->unit)->unit = "ml_glutTabletButtonFunc" let tabletButtonFunc = window_wrapper _tabletButtonFunc eta_button external menuStatusFunc: cb:(status:menu_state_t->x:int->y:int->unit)->unit = "ml_glutMenuStatusFunc" external _overlayDisplayFunc: cb:(unit->unit)->unit = "ml_glutOverlayDisplayFunc" let overlayDisplayFunc = window_wrapper _overlayDisplayFunc (fun cb () -> cb () ()) (* === GLUT color index sub-API. === === *) external setColor: cell:int->red:float->green:float->blue:float->unit = "ml_glutSetColor" external getColor: index:int->component:int->float = "ml_glutGetColor" external copyColormap: win:int->unit = "ml_glutCopyColormap" (* === GLUT state retrieval sub-API. === *) external _get: igtype:int->int = "ml_glutGet" let get ~gtype = let igtype = match gtype with | WINDOW_X -> 100 | WINDOW_Y -> 101 | WINDOW_WIDTH -> 102 | WINDOW_HEIGHT -> 103 | WINDOW_BUFFER_SIZE -> 104 | WINDOW_STENCIL_SIZE -> 105 | WINDOW_DEPTH_SIZE -> 106 | WINDOW_RED_SIZE -> 107 | WINDOW_GREEN_SIZE -> 108 | WINDOW_BLUE_SIZE -> 109 | WINDOW_ALPHA_SIZE -> 110 | WINDOW_ACCUM_RED_SIZE -> 111 | WINDOW_ACCUM_GREEN_SIZE -> 112 | WINDOW_ACCUM_BLUE_SIZE -> 113 | WINDOW_ACCUM_ALPHA_SIZE -> 114 | WINDOW_DOUBLEBUFFER -> 115 | WINDOW_RGBA -> 116 | WINDOW_PARENT -> 117 | WINDOW_NUM_CHILDREN -> 118 | WINDOW_COLORMAP_SIZE -> 119 | WINDOW_NUM_SAMPLES -> 120 | WINDOW_STEREO -> 121 | WINDOW_CURSOR -> 122 | SCREEN_WIDTH -> 200 | SCREEN_HEIGHT -> 201 | SCREEN_WIDTH_MM -> 202 | SCREEN_HEIGHT_MM -> 203 | MENU_NUM_ITEMS -> 300 (* | DISPLAY_MODE_POSSIBLE -> 400 *) | INIT_WINDOW_X -> 500 | INIT_WINDOW_Y -> 501 | INIT_WINDOW_WIDTH -> 502 | INIT_WINDOW_HEIGHT -> 503 | INIT_DISPLAY_MODE -> 504 | ELAPSED_TIME -> 700 | WINDOW_FORMAT_ID -> 123 in _get igtype ;; let getBool ~gtype = _get (match gtype with DISPLAY_MODE_POSSIBLE -> 400) <> 0 external _deviceGet: idgtype:int->int = "ml_glutDeviceGet" let deviceGet ~dgtype = let idgtype = match dgtype with | HAS_KEYBOARD -> 600 | HAS_MOUSE -> 601 | HAS_SPACEBALL -> 602 | HAS_DIAL_AND_BUTTON_BOX -> 603 | HAS_TABLET -> 604 | NUM_MOUSE_BUTTONS -> 605 | NUM_SPACEBALL_BUTTONS -> 606 | NUM_BUTTON_BOX_BUTTONS -> 607 | NUM_DIALS -> 608 | NUM_TABLET_BUTTONS -> 609 | DEVICE_IGNORE_KEY_REPEAT -> 610 | DEVICE_KEY_REPEAT -> 611 | HAS_JOYSTICK -> 612 | OWNS_JOYSTICK -> 613 | JOYSTICK_BUTTONS -> 614 | JOYSTICK_AXES -> 615 | JOYSTICK_POLL_RATE -> 616 in _deviceGet idgtype;; (* === GLUT extension support sub-API === *) external extensionSupported: name:string->bool = "ml_glutExtensionSupported" external getModifiers: unit->int = "ml_glutGetModifiers" (* let getModifiers () = let m = _getModifiers() in if m land 1 <> 0 then [ACTIVE_SHIFT] else [] @ if m land 2 <> 0 then [ACTIVE_CTRL] else [] @ if m land 4 <> 0 then [ACTIVE_ALT] else [];; *) let int_of_modifiers m = let ret = ref 0 in let rec f = function | [] -> () | h::t -> begin ret := (!ret lor (match h with | ACTIVE_SHIFT -> 1 | ACTIVE_CTRL -> 2 | ACTIVE_ALT -> 4)); f t end in f m; !ret;; external _layerGet: int->int = "ml_glutLayerGet" let layerGet ~lgtype = let ilgtype = match lgtype with | OVERLAY_POSSIBLE -> 800 | HAS_OVERLAY -> 802 | NORMAL_DAMAGED -> 804 | OVERLAY_DAMAGED -> 805 in let ret = _layerGet ilgtype in if lgtype = OVERLAY_DAMAGED && ret = -1 then raise (OverlayNotInUse "in layerGet OVERLAY_DAMAGED") else ret <> 0 ;; let layerGetTransparentIndex() = _layerGet 803 ;; (* from glut.h *) let layerGetInUse () = match _layerGet 801 with | 0 -> NORMAL | 1 -> OVERLAY | _ -> failwith "unexpected value in layerGetInUse" (* === GLUT font sub-API === *) (* convert font to integer value from glut.h *) let f2i font = match font with | STROKE_ROMAN -> 0 | STROKE_MONO_ROMAN -> 1 | BITMAP_9_BY_15 -> 2 | BITMAP_8_BY_13 -> 3 | BITMAP_TIMES_ROMAN_10 -> 4 | BITMAP_TIMES_ROMAN_24 -> 5 | BITMAP_HELVETICA_10 -> 6 | BITMAP_HELVETICA_12 -> 7 | BITMAP_HELVETICA_18 -> 8;; external _bitmapCharacter: font:int->c:int->unit = "ml_glutBitmapCharacter" let bitmapCharacter ~font ~c = _bitmapCharacter (f2i font) c;; external _bitmapWidth: font:int->c:int->int = "ml_glutBitmapWidth" let bitmapWidth ~font ~c = _bitmapWidth (f2i font) c;; external _strokeCharacter: font:int->c:int->unit = "ml_glutStrokeCharacter" let strokeCharacter ~font ~c = _strokeCharacter (f2i font) c;; external _strokeWidth: font:int->c:int->int = "ml_glutStrokeWidth" let strokeWidth ~font ~c = _strokeWidth (f2i font) c;; (* === GLUT pre-built models sub-API === *) external wireSphere: radius:float->slices:int->stacks:int->unit = "ml_glutWireSphere" external solidSphere: radius:float->slices:int->stacks:int->unit = "ml_glutSolidSphere" external wireCone: base:float->height:float->slices:int->stacks:int->unit = "ml_glutWireCone" external solidCone: base:float->height:float->slices:int->stacks:int->unit = "ml_glutSolidCone" external wireCube: size:float->unit = "ml_glutWireCube" external solidCube: size:float->unit = "ml_glutSolidCube" external wireTorus: innerRadius:float->outerRadius:float->sides:int->rings:int ->unit = "ml_glutWireTorus" external solidTorus: innerRadius:float->outerRadius:float->sides:int->rings:int ->unit = "ml_glutSolidTorus" external wireDodecahedron: unit->unit = "ml_glutWireDodecahedron" external solidDodecahedron: unit->unit = "ml_glutSolidDodecahedron" external wireTeapot: size:float->unit = "ml_glutWireTeapot" external solidTeapot: size:float->unit = "ml_glutSolidTeapot" external wireOctahedron: unit->unit = "ml_glutWireOctahedron" external solidOctahedron: unit->unit = "ml_glutSolidOctahedron" external wireTetrahedron: unit->unit = "ml_glutWireTetrahedron" external solidTetrahedron: unit->unit = "ml_glutSolidTetrahedron" external wireIcosahedron: unit->unit = "ml_glutWireIcosahedron" external solidIcosahedron: unit->unit = "ml_glutSolidIcosahedron" (* GLUT version 4 functions included in the GLUT 3.7 distribution *) external initDisplayString: str:string->unit = "ml_glutInitDisplayString" external warpPointer: x:int->y:int->unit = "ml_glutWarpPointer" external _bitmapLength: font:int->str:string->int = "ml_glutBitmapLength" let bitmapLength ~font ~str = _bitmapLength (f2i font) str;; external _strokeLength: font:int->str:string->int = "ml_glutStrokeLength" let strokeLength ~font ~str = _strokeLength (f2i font) str;; external _windowStatusFunc: (int->unit)->unit = "ml_glutWindowStatusFunc" let windowStatusFunc ~cb = _windowStatusFunc (fun s -> cb ~state:(match s with | 0 -> HIDDEN | 1 -> FULLY_RETAINED | 2 -> PARTIALLY_RETAINED | 3 -> FULLY_COVERED | _ -> failwith "invalid value in glutWindowStatus ocaml callback")) ;; external postWindowRedisplay: win:int->unit = "ml_glutPostWindowRedisplay" external postWindowOverlayRedisplay: win:int->unit = "ml_glutPostWindowOverlayRedisplay" external keyboardUpFunc: cb:(key:int->x:int->y:int->unit)->unit = "ml_glutKeyboardUpFunc" external _glutSpecialUpFunc : (key:int->x:int->y:int->unit)->unit = "ml_glutSpecialUpFunc" let specialUpFunc ~cb = _glutSpecialUpFunc (fun ~key ->cb ~key:(special_of_int key));; external _ignoreKeyRepeat: ignore:int->unit = "ml_glutIgnoreKeyRepeat" let ignoreKeyRepeat ~ignore = _ignoreKeyRepeat (if ignore = true then 1 else 0) external _setKeyRepeat: mode:int->unit = "ml_glutSetKeyRepeat" let setKeyRepeat ~mode = _setKeyRepeat (match mode with | KEY_REPEAT_OFF -> 0 | KEY_REPEAT_ON -> 1 | KEY_REPEAT_DEFAULT -> 2 );; external joystickFunc: cb:(buttonMask:int->x:int->y:int->z:int->unit)-> pollInterval:int->unit = "ml_glutJoystickFunc" external forceJoystickFunc: unit->unit = "ml_glutForceJoystickFunc" (* GLUT video resize sub-API. *) external _videoResizeGet: int->int = "ml_glutVideoResizeGet" let videoResizeGet which = let i = match which with | VIDEO_RESIZE_POSSIBLE -> 900 | VIDEO_RESIZE_IN_USE -> 901 | VIDEO_RESIZE_X_DELTA -> 902 | VIDEO_RESIZE_Y_DELTA -> 903 | VIDEO_RESIZE_WIDTH_DELTA -> 904 | VIDEO_RESIZE_HEIGHT_DELTA -> 905 | VIDEO_RESIZE_X -> 906 | VIDEO_RESIZE_Y -> 907 | VIDEO_RESIZE_WIDTH -> 908 | VIDEO_RESIZE_HEIGHT -> 909 in _videoResizeGet i ;; external setupVideoResizing: unit->unit = "ml_glutSetupVideoResizing" external stopVideoResizing: unit->unit = "ml_glutStopVideoResizing" external videoResize: x:int->y:int->width:int->height:int->unit = "ml_glutVideoResize" external videoPan: x:int->y:int->width:int->height:int->unit = "ml_glutVideoPan" (* GLUT debugging sub-API. *) external reportErrors: unit->unit = "ml_glutReportErrors" (* GLUT game mode sub-API *) external gameModeString: str:string->unit = "ml_glutGameModeString" external enterGameMode: unit->unit = "ml_glutEnterGameMode" external leaveGameMode: unit->unit = "ml_glutLeaveGameMode" external _gameModeGet: mode:int->int = "ml_glutGameModeGet" let gameModeGet ~mode = let imode = match mode with | GAME_MODE_ACTIVE -> 0 | GAME_MODE_POSSIBLE -> 1 | GAME_MODE_WIDTH -> 2 | GAME_MODE_HEIGHT -> 3 | GAME_MODE_PIXEL_DEPTH -> 4 | GAME_MODE_REFRESH_RATE -> 5 | GAME_MODE_DISPLAY_CHANGED -> 6 in _gameModeGet imode;; (* ocaml specific *) let string_of_special key = match key with | KEY_F1 -> "KEY_F1" | KEY_F2 -> "KEY_F2" | KEY_F3 -> "KEY_F3" | KEY_F4 -> "KEY_F4" | KEY_F5 -> "KEY_F5" | KEY_F6 -> "KEY_F6" | KEY_F7 -> "KEY_F7" | KEY_F8 -> "KEY_F8" | KEY_F9 -> "KEY_F9" | KEY_F10 -> "KEY_F10" | KEY_F11 -> "KEY_F11" | KEY_F12 -> "KEY_F12" | KEY_LEFT -> "KEY_LEFT" | KEY_UP -> "KEY_UP" | KEY_RIGHT -> "KEY_RIGHT" | KEY_DOWN -> "KEY_DOWN" | KEY_PAGE_UP -> "KEY_PAGE_UP" | KEY_PAGE_DOWN -> "KEY_PAGE_DOWN" | KEY_HOME -> "KEY_HOME" | KEY_END -> "KEY_END" | KEY_INSERT -> "KEY_INSERT" | KEY_OTHER i -> "KEY_OTHER " ^ string_of_int i let int_of_cursor c = match c with | CURSOR_RIGHT_ARROW -> 0 | CURSOR_LEFT_ARROW -> 1 | CURSOR_INFO -> 2 | CURSOR_DESTROY -> 3 | CURSOR_HELP -> 4 | CURSOR_CYCLE -> 5 | CURSOR_SPRAY -> 6 | CURSOR_WAIT -> 7 | CURSOR_TEXT -> 8 | CURSOR_CROSSHAIR -> 9 | CURSOR_UP_DOWN -> 10 | CURSOR_LEFT_RIGHT -> 11 | CURSOR_TOP_SIDE -> 12 | CURSOR_BOTTOM_SIDE -> 13 | CURSOR_LEFT_SIDE -> 14 | CURSOR_RIGHT_SIDE -> 15 | CURSOR_TOP_LEFT_CORNER -> 16 | CURSOR_TOP_RIGHT_CORNER -> 17 | CURSOR_BOTTOM_RIGHT_CORNER -> 18 | CURSOR_BOTTOM_LEFT_CORNER -> 19 | CURSOR_INHERIT -> 100 | CURSOR_NONE -> 101 | CURSOR_FULL_CROSSHAIR -> 102 let string_of_cursor c = match c with | CURSOR_RIGHT_ARROW -> "CURSOR_RIGHT_ARROW" | CURSOR_LEFT_ARROW -> "CURSOR_LEFT_ARROW" | CURSOR_INFO -> "CURSOR_INFO" | CURSOR_DESTROY -> "CURSOR_DESTROY" | CURSOR_HELP -> "CURSOR_HELP" | CURSOR_CYCLE -> "CURSOR_CYCLE" | CURSOR_SPRAY -> "CURSOR_SPRAY" | CURSOR_WAIT -> "CURSOR_WAIT" | CURSOR_TEXT -> "CURSOR_TEXT" | CURSOR_CROSSHAIR -> "CURSOR_CROSSHAIR" | CURSOR_UP_DOWN -> "CURSOR_UP_DOWN" | CURSOR_LEFT_RIGHT -> "CURSOR_LEFT_RIGHT" | CURSOR_TOP_SIDE -> "CURSOR_TOP_SIDE" | CURSOR_BOTTOM_SIDE -> "CURSOR_BOTTOM_SIDE" | CURSOR_LEFT_SIDE -> "CURSOR_LEFT_SIDE" | CURSOR_RIGHT_SIDE -> "CURSOR_RIGHT_SIDE" | CURSOR_TOP_LEFT_CORNER -> "CURSOR_TOP_LEFT_CORNER" | CURSOR_TOP_RIGHT_CORNER -> "CURSOR_TOP_RIGHT_CORNER" | CURSOR_BOTTOM_RIGHT_CORNER -> "CURSOR_BOTTOM_RIGHT_CORNER" | CURSOR_BOTTOM_LEFT_CORNER -> "CURSOR_BOTTOM_LEFT_CORNER" | CURSOR_INHERIT -> "CURSOR_INHERIT" | CURSOR_NONE -> "CURSOR_NONE" | CURSOR_FULL_CROSSHAIR -> "CURSOR_FULL_CROSSHAIR" ;; let int_of_modifier m = match m with | ACTIVE_SHIFT -> 1 | ACTIVE_CTRL -> 2 | ACTIVE_ALT -> 4 ;; (* let int_of_modifiers ms = List.fold_left (lor) 0 (List.map int_of_modifier ms);; *) let string_of_button b = match b with | LEFT_BUTTON -> "LEFT_BUTTON" | MIDDLE_BUTTON -> "MIDDLE_BUTTON" | RIGHT_BUTTON -> "RIGHT_BUTTON" | OTHER_BUTTON n -> "OTHER_BUTTON" ^ string_of_int n ;; let string_of_button_state s = match s with | DOWN -> "DOWN" | UP -> "UP" ;; let string_of_modifier m = match m with | ACTIVE_SHIFT -> "ACTIVE_SHIFT" | ACTIVE_CTRL -> "ACTIVE_CTRL" | ACTIVE_ALT -> "ACTIVE_ALT" ;; (* convert a list of strings to a single string *) let string_of_strings l = let rec _string_of_list l = match l with | [] -> "" | h::t -> h^(if t=[] then "" else ", "^(_string_of_list t)) in "[ " ^ (_string_of_list l) ^ " ]";; let string_of_modifiers ml = string_of_strings (List.map string_of_modifier ml);; let string_of_window_status status = match status with | HIDDEN -> "HIDDEN" | FULLY_RETAINED -> "FULLY_RETAINED" | PARTIALLY_RETAINED -> "PARTIALLY_RETAINED" | FULLY_COVERED -> "FULLY_COVERED" ;; let string_of_vis_state vis = match vis with | NOT_VISIBLE -> "NOT_VISIBLE" | VISIBLE -> "VISIBLE" ;; lablgl-1.05/LablGlut/src/glut.mli000644 000765 000024 00000024343 12217024174 017625 0ustar00garriguestaff000000 000000 (* glut.mli: interface for the lablglut GLUT binding. *) type button_t = | LEFT_BUTTON | MIDDLE_BUTTON | RIGHT_BUTTON | OTHER_BUTTON of int type mouse_button_state_t = | DOWN | UP type special_key_t = | KEY_F1 | KEY_F2 | KEY_F3 | KEY_F4 | KEY_F5 | KEY_F6 | KEY_F7 | KEY_F8 | KEY_F9 | KEY_F10 | KEY_F11 | KEY_F12 (* directional keys *) | KEY_LEFT | KEY_UP | KEY_RIGHT | KEY_DOWN | KEY_PAGE_UP | KEY_PAGE_DOWN | KEY_HOME | KEY_END | KEY_INSERT (* for undefined keys *) | KEY_OTHER of int type entry_exit_state_t = | LEFT | ENTERED type menu_state_t = | MENU_NOT_IN_USE | MENU_IN_USE type visibility_state_t = | NOT_VISIBLE | VISIBLE type window_status_t = | HIDDEN | FULLY_RETAINED | PARTIALLY_RETAINED | FULLY_COVERED type color_index_component_t = | RED | GREEN | BLUE type layer_t = | NORMAL | OVERLAY type font_t = | STROKE_ROMAN | STROKE_MONO_ROMAN | BITMAP_9_BY_15 | BITMAP_8_BY_13 | BITMAP_TIMES_ROMAN_10 | BITMAP_TIMES_ROMAN_24 | BITMAP_HELVETICA_10 | BITMAP_HELVETICA_12 | BITMAP_HELVETICA_18 type glut_get_t = | WINDOW_X | WINDOW_Y | WINDOW_WIDTH | WINDOW_HEIGHT | WINDOW_BUFFER_SIZE | WINDOW_STENCIL_SIZE | WINDOW_DEPTH_SIZE | WINDOW_RED_SIZE | WINDOW_GREEN_SIZE | WINDOW_BLUE_SIZE | WINDOW_ALPHA_SIZE | WINDOW_ACCUM_RED_SIZE | WINDOW_ACCUM_GREEN_SIZE | WINDOW_ACCUM_BLUE_SIZE | WINDOW_ACCUM_ALPHA_SIZE | WINDOW_DOUBLEBUFFER | WINDOW_RGBA | WINDOW_PARENT | WINDOW_NUM_CHILDREN | WINDOW_COLORMAP_SIZE | WINDOW_NUM_SAMPLES | WINDOW_STEREO | WINDOW_CURSOR | SCREEN_WIDTH | SCREEN_HEIGHT | SCREEN_WIDTH_MM | SCREEN_HEIGHT_MM | MENU_NUM_ITEMS (* | DISPLAY_MODE_POSSIBLE : use getBool *) | INIT_WINDOW_X | INIT_WINDOW_Y | INIT_WINDOW_WIDTH | INIT_WINDOW_HEIGHT | INIT_DISPLAY_MODE | ELAPSED_TIME | WINDOW_FORMAT_ID type glut_get_bool_t = | DISPLAY_MODE_POSSIBLE (* display mode bit masks *) val rgb:int val rgba:int val index:int val single:int val double:int val accum:int val alpha:int val depth:int val stencil:int val multisample:int val stereo:int val luminance:int type device_get_t = | HAS_KEYBOARD | HAS_MOUSE | HAS_SPACEBALL | HAS_DIAL_AND_BUTTON_BOX | HAS_TABLET | NUM_MOUSE_BUTTONS | NUM_SPACEBALL_BUTTONS | NUM_BUTTON_BOX_BUTTONS | NUM_DIALS | NUM_TABLET_BUTTONS | DEVICE_IGNORE_KEY_REPEAT | DEVICE_KEY_REPEAT | HAS_JOYSTICK | OWNS_JOYSTICK | JOYSTICK_BUTTONS | JOYSTICK_AXES | JOYSTICK_POLL_RATE type layerget_t = | OVERLAY_POSSIBLE (* | LAYER_IN_USE : use layerGetInUse *) | HAS_OVERLAY (* | TRANSPARENT_INDEX : use layerGetTransparentIndex *) | NORMAL_DAMAGED | OVERLAY_DAMAGED type video_resize_t = | VIDEO_RESIZE_POSSIBLE | VIDEO_RESIZE_IN_USE | VIDEO_RESIZE_X_DELTA | VIDEO_RESIZE_Y_DELTA | VIDEO_RESIZE_WIDTH_DELTA | VIDEO_RESIZE_HEIGHT_DELTA | VIDEO_RESIZE_X | VIDEO_RESIZE_Y | VIDEO_RESIZE_WIDTH | VIDEO_RESIZE_HEIGHT (* key modifier bit masks *) val active_shift:int val active_ctrl:int val active_alt:int type cursor_t = (* Basic arrows. *) | CURSOR_RIGHT_ARROW | CURSOR_LEFT_ARROW (* Symbolic cursor shapes. *) | CURSOR_INFO | CURSOR_DESTROY | CURSOR_HELP | CURSOR_CYCLE | CURSOR_SPRAY | CURSOR_WAIT | CURSOR_TEXT | CURSOR_CROSSHAIR (* Directional cursors. *) | CURSOR_UP_DOWN | CURSOR_LEFT_RIGHT (* Sizing cursors. *) | CURSOR_TOP_SIDE | CURSOR_BOTTOM_SIDE | CURSOR_LEFT_SIDE | CURSOR_RIGHT_SIDE | CURSOR_TOP_LEFT_CORNER | CURSOR_TOP_RIGHT_CORNER | CURSOR_BOTTOM_RIGHT_CORNER | CURSOR_BOTTOM_LEFT_CORNER | CURSOR_INHERIT (* inherit cursor from parent window *) | CURSOR_NONE (* blank cursor *) | CURSOR_FULL_CROSSHAIR (* full-screen crosshair (if available) *) type game_mode_t = | GAME_MODE_ACTIVE | GAME_MODE_POSSIBLE | GAME_MODE_WIDTH | GAME_MODE_HEIGHT | GAME_MODE_PIXEL_DEPTH | GAME_MODE_REFRESH_RATE | GAME_MODE_DISPLAY_CHANGED type key_repeat_t = | KEY_REPEAT_OFF | KEY_REPEAT_ON | KEY_REPEAT_DEFAULT exception BadEnum of string exception InvalidState of string (* GLUT initialization sub-API. *) val init: argv:(string array)->string array (* returns new argv *) val initDisplayMode: (* The last argument must be () *) ?double_buffer:bool-> ?index:bool-> ?accum:bool-> ?alpha:bool-> ?depth:bool-> ?stencil:bool-> ?multisample:bool-> ?stereo:bool-> ?luminance:bool-> unit-> unit val initWindowPosition: x:int->y:int->unit val initWindowSize: w:int->h:int->unit val mainLoop: unit->unit (* GLUT window sub-API. *) val createWindow: title:string->int (* returns window id *) val postRedisplay: unit->unit val swapBuffers: unit->unit val createSubWindow: win:int->x:int->y:int->w:int->h:int->int val destroyWindow: win:int->unit val getWindow: unit->int val setWindow: win:int->unit val setWindowTitle: title:string->unit val setIconTitle: title:string->unit val positionWindow: x:int->y:int->unit val reshapeWindow: w:int->h:int->unit val popWindow: unit->unit val pushWindow: unit->unit val iconifyWindow: unit->unit val showWindow: unit->unit val hideWindow: unit->unit val fullScreen: unit->unit val setCursor: cursor_t->unit (* GLUT overlay sub-API. *) val establishOverlay: unit->unit val removeOverlay: unit->unit val useLayer: layer_t->unit val postOverlayRedisplay: unit->unit val showOverlay: unit->unit val hideOverlay: unit->unit (* GLUT menu sub-API. *) val createMenu: cb:(value:int->unit)->int val destroyMenu: menu:int->unit val getMenu: unit->int val setMenu: menu:int->unit val addMenuEntry: label:string->value:int->unit val addSubMenu: label:string->submenu:int->unit val changeToMenuEntry: item:int->label:string->value:int->unit val changeToSubMenu: item:int->label:string->submenu:int->unit val removeMenuItem: item:int->unit val attachMenu: button:button_t->unit val detachMenu: button:button_t->unit (* GLUT window callback sub-API. *) val displayFunc: cb:(unit->unit)->unit val reshapeFunc: cb:(w:int->h:int->unit)->unit val keyboardFunc: cb:(key:int->x:int->y:int->unit)->unit val mouseFunc: cb:(button:button_t->state:mouse_button_state_t-> x:int->y:int->unit)->unit val motionFunc: cb:(x:int->y:int->unit)->unit val passiveMotionFunc: cb:(x:int->y:int->unit)->unit val entryFunc: cb:(state:entry_exit_state_t->unit)->unit val visibilityFunc: cb:(state:visibility_state_t->unit)->unit val idleFunc: cb:((unit->unit) option)->unit (* you can set as many timer as you want simultanesouly *) val timerFunc: ms:int->cb:(value:'a->unit)->value:'a->unit val specialFunc: cb:(key:special_key_t->x:int->y:int->unit)->unit val spaceballMotionFunc: cb:(x:int->y:int->z:int->unit)->unit val spaceballRotateFunc: cb:(x:int->y:int->z:int->unit)->unit val spaceballButtonFunc: cb:(button:int->state:int->unit)->unit val buttonBoxFunc: cb:(button:int->state:int->unit)->unit val dialsFunc: cb:(dial:int->value:int->unit)->unit val tabletMotionFunc: cb:(x:int->y:int->unit)->unit val tabletButtonFunc: cb:(button:int->state:int->x:int->y:int->unit)->unit val menuStatusFunc: cb:(status:menu_state_t->x:int->y:int->unit)->unit val overlayDisplayFunc: cb:(unit->unit)->unit (* GLUT color index sub-API. *) val setColor: cell:int->red:float->green:float->blue:float->unit val getColor: index:int->component:int->float val copyColormap: win:int->unit (* GLUT state retrieval sub-API. *) val get: gtype:glut_get_t->int val getBool: gtype:glut_get_bool_t->bool val deviceGet: dgtype:device_get_t->int (* GLUT extension support sub-API *) val extensionSupported: name:string->bool val getModifiers: unit->int val layerGetTransparentIndex: unit->int val layerGetInUse: unit->layer_t val layerGet: lgtype:layerget_t->bool (* GLUT font sub-API *) val bitmapCharacter: font:font_t->c:int->unit val bitmapWidth: font:font_t->c:int->int val strokeCharacter: font:font_t->c:int->unit val strokeWidth: font:font_t->c:int->int (* GLUT pre-built models sub-API *) val wireSphere: radius:float->slices:int->stacks:int->unit val solidSphere: radius:float->slices:int->stacks:int->unit val wireCone: base:float->height:float->slices:int->stacks:int->unit val solidCone: base:float->height:float->slices:int->stacks:int->unit val wireCube: size:float->unit val solidCube: size:float->unit val wireTorus: innerRadius:float->outerRadius:float->sides:int->rings:int->unit val solidTorus: innerRadius:float->outerRadius:float->sides:int->rings:int->unit val wireDodecahedron: unit->unit val solidDodecahedron: unit->unit val wireTeapot: size:float->unit val solidTeapot: size:float->unit val wireOctahedron: unit->unit val solidOctahedron: unit->unit val wireTetrahedron: unit->unit val solidTetrahedron: unit->unit val wireIcosahedron: unit->unit val solidIcosahedron: unit->unit (* GLUT game mode sub-API *) val gameModeString: str:string->unit val enterGameMode: unit->unit val leaveGameMode: unit->unit val gameModeGet: mode:game_mode_t->int (* GLUT version 4 functions included in the GLUT 3.7 distribution *) val initDisplayString: str:string->unit val warpPointer: x:int->y:int->unit val bitmapLength: font:font_t->str:string->int val strokeLength: font:font_t->str:string->int val windowStatusFunc: cb:(state:window_status_t->unit)->unit val postWindowRedisplay: win:int->unit val postWindowOverlayRedisplay: win:int->unit val keyboardUpFunc: cb:(key:int->x:int->y:int->unit)->unit val specialUpFunc: cb:(key:special_key_t->x:int->y:int->unit)->unit val ignoreKeyRepeat: ignore:bool->unit val setKeyRepeat: mode:key_repeat_t->unit val joystickFunc: cb:(buttonMask:int->x:int->y:int->z:int->unit)-> pollInterval:int->unit val forceJoystickFunc: unit->unit (* GLUT video resize sub-API. *) val videoResizeGet: video_resize_t->int val setupVideoResizing: unit->unit val stopVideoResizing: unit->unit val videoResize: x:int->y:int->width:int->height:int->unit val videoPan: x:int->y:int->width:int->height:int->unit (* GLUT debugging sub-API. *) val reportErrors: unit->unit (* ocaml-specific *) val string_of_button: button_t->string val string_of_button_state: mouse_button_state_t->string val string_of_special: special_key_t->string val string_of_window_status: window_status_t->string val string_of_vis_state: visibility_state_t->string val string_of_cursor: cursor_t->string val int_of_cursor: cursor_t->int lablgl-1.05/LablGlut/src/lablglut.bat000755 000765 000024 00000000156 12217024174 020444 0ustar00garriguestaff000000 000000 @rem toplevel for lablGL with glut support ocaml -I +lablgl lablgl.cma lablglut.cma %1 %2 %3 %4 %5 %6 %7 %8 %9lablgl-1.05/LablGlut/src/Makefile000644 000765 000024 00000005324 12217024174 017605 0ustar00garriguestaff000000 000000 # Include shared parts TOPDIR = ../.. include $(TOPDIR)/Makefile.common # Composite options INCLUDES = $(GLINCLUDES) $(XINCLUDES) -I$(SRCDIR) LIBS = $(GLUTLIBS) $(GLLIBS) $(XLIBS) LIBDIRS = OCAMLINC= # Files LIBOBJS = glut.cmo OPTOBJS = $(LIBOBJS:.cmo=.cmx) COBJS = wrap_glut$(XO) all: lib lablgluttop$(XE) lablglut$(XB) opt: libopt lib: lablglut.cma libopt: lablglut.cmxa ifeq ($(TOOLCHAIN), msvc) liblablglut$(XA): $(COBJS) $(MKLIB)$@ $(COBJS) dlllablglut.dll: $(COBJS:$(XO)=.d$(XO)) $(MKDLL)$@ $(COBJS:$(XO)=.d$(XO)) $(GLUTLIBS) $(GLLIBS) $(OCAMLDLL) lablglut.cma: liblablglut$(XA) dlllablglut.dll $(LIBOBJS) ../../Makefile.config $(LINKER) -a -o $@ $(LIBOBJS) \ -cclib -llablglut -dllib -llablglut \ -cclib "$(GLLIBS)" -cclib "$(GLUTLIBS)" lablglut.cmxa: liblablglut$(XA) $(OPTOBJS) ../../Makefile.config $(OPTLINK) -a -o $@ $(OPTOBJS) -cclib -llablglut \ -cclib "$(GLLIBS)" -cclib "$(GLUTLIBS)" else liblablglut$(XA): lablglut.cma lablglut.cma: $(COBJS) $(LIBOBJS) ../../Makefile.config $(LIBRARIAN) -o lablglut $(COBJS) $(LIBOBJS) $(GLUTLIBS) $(GLLIBS) $(XLIBS) lablglut.cmxa: $(COBJS) $(OPTOBJS) ../../Makefile.config $(LIBRARIAN) -o lablglut $(COBJS) $(OPTOBJS) $(GLUTLIBS) $(GLLIBS) $(XLIBS) endif lablgluttop$(XE): lablglut.cma ocamlmktop $(CUSTOMTOP) -I . -I $(SRCDIR) $(OCAMLINC) -o $@ \ lablglut.cma lablgl.cma lablglut: $(CONFIG) Makefile liblablglut$(XA) $(MAKE) INSTALLDIR="$(INSTALLDIR)" real-$@ real-lablglut: @echo generate lablglut echo "#!/bin/sh" > lablglut echo "# toplevel with lablGL and LablGlut" >> lablglut if test -f dlllablglut$(XS); then \ echo 'exec ocaml -I "$(INSTALLDIR)" lablgl.cma lablglut.cma $$*' >> lablglut; \ else echo 'exec "$(INSTALLDIR)/lablgluttop" -I "$(INSTALLDIR)" $$*' >> lablglut; fi chmod 755 lablglut install: @if test -f lablglut.cma; then $(MAKE) real-install; fi preinstall: if test -d "$(INSTALLDIR)"; then : ; else mkdir -p "$(INSTALLDIR)"; fi cp $(LIBOBJS:.cmo=.ml) $(LIBOBJS:.cmo=.mli) "$(INSTALLDIR)" cp liblablglut$(XA) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) liblablglut$(XA) @if test -f dlllablglut$(XS); then $(MAKE) installdll; \ else $(MAKE) installtop; fi cp lablglut$(XB) "$(BINDIR)" real-install: preinstall cp $(LIBOBJS:.cmo=.cmi) lablglut.cma "$(INSTALLDIR)" @if test -f lablglut.cmxa; then $(MAKE) installopt; fi installdll: cp dlllablglut$(XS) "$(DLLDIR)" installtop: cp lablgluttop$(XE) "$(INSTALLDIR)" installopt: cp lablglut.cmxa lablglut$(XA) $(LIBOBJS:.cmo=.cmx) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) lablglut$(XA) clean: rm -f *.cm* *.o *.obj *.a lib*.lib *.so *.dll *.exe *.opt \ *_tags.c *_tags.h *~ lablgluttop$(EX) lablglut depend: ocamldep -pp camlp4o *.ml *.mli > .depend include .depend lablgl-1.05/LablGlut/src/ml_gl.h000644 000765 000024 00000013706 12217024174 017413 0ustar00garriguestaff000000 000000 /* $Id: ml_gl.h,v 1.2 2003-10-28 05:16:37 ijtrotts Exp $ */ /* This file was copied (gratefully) from J. Garrigue's LablGL */ #ifndef _ml_gl_ #define _ml_gl_ void ml_raise_gl (const char *errmsg) Noreturn; #define copy_string_check lablgl_copy_string_check value copy_string_check (const char *str); GLenum GLenum_val (value); #define Float_val(dbl) ((GLfloat) Double_val(dbl)) #define Addr_val(addr) ((GLvoid *) addr) #define Val_addr(addr) ((value) addr) #define Type_raw(raw) (GLenum_val(Kind_raw(raw))) #define Type_void_raw(raw) Type_raw(raw), Void_raw(raw) #define ML_0(cname) \ CAMLprim value ml_##cname (value unit) \ { cname (); return Val_unit; } #define ML_1(cname, conv1) \ CAMLprim value ml_##cname (value arg1) \ { cname (conv1(arg1)); return Val_unit; } #define ML_2(cname, conv1, conv2) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { cname (conv1(arg1), conv2(arg2)); return Val_unit; } #define ML_3(cname, conv1, conv2, conv3) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3)); return Val_unit; } #define ML_4(cname, conv1, conv2, conv3, conv4) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4)); \ return Val_unit; } #define ML_5(cname, conv1, conv2, conv3, conv4, conv5) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5)); \ return Val_unit; } #define ML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6)); \ return Val_unit; } #define ML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6), conv7(arg7)); \ return Val_unit; } #define ML_8(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8) \ { cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), conv5(arg5), \ conv6(arg6), conv7(arg7), conv8(arg8)); \ return Val_unit; } #define ML_0_(cname, conv) \ CAMLprim value ml_##cname (value unit) \ { return conv (cname ()); } #define ML_1_(cname, conv1, conv) \ CAMLprim value ml_##cname (value arg1) \ { return conv (cname (conv1(arg1))); } #define ML_2_(cname, conv1, conv2, conv) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { return conv (cname (conv1(arg1), conv2(arg2))); } #define ML_3_(cname, conv1, conv2, conv3, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } #define ML_4_(cname, conv1, conv2, conv3, conv4, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } #define ML_5_(cname, conv1, conv2, conv3, conv4, conv5, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5))); } #define ML_6_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6))); } #define ML_7_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7))); } #define ML_8_(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8))); } /* Use with care: needs the argument index */ #define Ignore(x) #define Split(x,f,g) f(x), g(x) Ignore #define Split3(x,f,g,h) f(x), g(x), h(x) Ignore #define Pair(x,f,g) f(Field(x,0)), g(Field(x,1)) Ignore #define Triple(x,f,g,h) f(Field(x,0)), g(Field(x,1)), h(Field(x,2)) Ignore /* For more than 5 arguments */ #define ML_bc6(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } #define ML_bc7(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); } #define ML_bc8(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7]); } /* subtleties of openGL 1.1 vs 1.2 */ #if !defined(GL_DOUBLE) && defined(GL_DOUBLE_EXT) #define GL_DOUBLE GL_DOUBLE_EXT #endif #if !defined(GL_TEXTURE_PRIORITY) && defined(GL_TEXTURE_PRIORITY_EXT) #define GL_TEXTURE_PRIORITY GL_TEXTURE_PRIORITY_EXT #endif #if !defined(GL_PROXY_TEXTURE_1D) && defined(GL_PROXY_TEXTURE_1D_EXT) #define GL_PROXY_TEXTURE_1D GL_PROXY_TEXTURE_1D_EXT #endif #if !defined(GL_PROXY_TEXTURE_2D) && defined(GL_PROXY_TEXTURE_2D_EXT) #define GL_PROXY_TEXTURE_2D GL_PROXY_TEXTURE_2D_EXT #endif #endif lablgl-1.05/LablGlut/src/wrap_gl.c000644 000765 000024 00000007064 12217024174 017747 0ustar00garriguestaff000000 000000 #ifdef __APPLE__ #include #else #include #endif #include #include #include #include static void ocaml_gl_warning(const char msg[]) { fprintf(stderr, "OCaml Open GL warning : %s", msg); fflush(stderr); } value ocaml_glClear ( value will_clear_color_buffer, value will_clear_depth_buffer) { GLbitfield mask = 0; mask |= (Bool_val(will_clear_color_buffer) ? GL_COLOR_BUFFER_BIT : 0); mask |= (Bool_val(will_clear_depth_buffer) ? GL_DEPTH_BUFFER_BIT : 0); glClear(mask); return Val_unit; } value ocaml_glClearColor (value r, value g, value b, value a) { glClearColor(Double_val(r), Double_val(g), Double_val(b), Double_val(a)); return Val_unit; } value ocaml_glBegin (value primitive_type) { switch( Int_val(primitive_type) ) { case 0: glBegin(GL_POINTS); break; case 1: glBegin(GL_LINES); break; case 2: glBegin(GL_LINE_LOOP); break; case 3: glBegin(GL_LINE_STRIP); break; case 4: glBegin(GL_TRIANGLES); break; case 5: glBegin(GL_TRIANGLE_STRIP); break; case 6: glBegin(GL_TRIANGLE_FAN); break; case 7: glBegin(GL_QUADS); break; case 8: glBegin(GL_QUAD_STRIP); break; case 9: glBegin(GL_POLYGON); break; default: ocaml_gl_warning("Unrecognized primitive type in ocaml_glBegin()\n"); } return Val_unit; } value ocaml_glVertex3d (value vx, value vy, value vz) { double x,y,z; x = Double_val(vx); y = Double_val(vy); z = Double_val(vz); glVertex3d(x,y,z); return Val_unit; } value ocaml_glVertex2d (value vx, value vy) { double x,y; x = Double_val(vx); y = Double_val(vy); glVertex2d(x,y); return Val_unit; } value ocaml_glColor3d (value r, value g, value b) { glColor3d(Double_val(r), Double_val(g), Double_val(b)); return Val_unit; } // TexCoord // Normal value ocaml_glEnd () { glEnd(); return Val_unit; } value ocaml_glFlush () { glFlush(); return Val_unit; } value ocaml_glViewport (value vx, value vy, value vwidth, value vheight) { int x,y,w,h; x=Int_val(vx); y=Int_val(vy); w=Int_val(vwidth); h=Int_val(vheight); glViewport(x, y, w, h); return Val_unit; } value ocaml_glMatrixMode (value mode) { int imode = Int_val(mode); switch(imode) { case 0: glMatrixMode(GL_MODELVIEW); break; case 1: glMatrixMode(GL_PROJECTION); break; case 2: glMatrixMode(GL_TEXTURE); break; default: ocaml_gl_warning("Unrecognized mode in ocaml_glMatrixMode()\n"); } return Val_unit; } value ocaml_glLoadIdentity () { glLoadIdentity(); return Val_unit; } value ocaml_glShadeModel (value model) { switch(Int_val(model)) { case 0: glShadeModel(GL_FLAT); break; case 1: glShadeModel(GL_SMOOTH); break; default: ocaml_gl_warning("Unrecognized mode in ocaml_glShadeModel()\n"); } return Val_unit; } value native_ocaml_glOrtho( value left, value right, value bot, value top, value znear, value zfar) { glOrtho(Double_val(left), Double_val(right), Double_val(bot), Double_val(top), Double_val(znear), Double_val(zfar)); return Val_unit; } value bytecode_ocaml_glOrtho(value * args, int num_args) { native_ocaml_glOrtho(args[0], args[1], args[2], args[3], args[4], args[5]); return Val_unit; } lablgl-1.05/LablGlut/src/wrap_glut.c000644 000765 000024 00000034166 12217024174 020323 0ustar00garriguestaff000000 000000 /* * wrap_glut.c * * an OCaml wrapper for a subset of Mark Kilgard's GLUT * * written by ijt * */ #ifdef _WIN32 #define GLUT_DISABLE_ATEXIT_HACK #include #endif #ifdef __APPLE__ #include #else #include #endif #include #include #include #include #include #include #include #include #include #include #include "ml_gl.h" #define VoidPtr_val(x) ((void*) Int_val(x)) /* ML_0(glutMainLoop) */ CAMLprim value ml_glutMainLoop (value unit) \ { enter_blocking_section (); glutMainLoop (); leave_blocking_section (); return Val_unit; } ML_0(glutSwapBuffers) /* makes a function called ml_glutSwapBuffers() */ ML_0(glutPostRedisplay) ML_2(glutInitWindowSize, Int_val, Int_val) ML_2(glutInitWindowPosition, Int_val, Int_val) ML_1_(glutCreateWindow, String_val, Val_int) ML_5_(glutCreateSubWindow, Int_val, Int_val, Int_val, Int_val, Int_val, Val_int) ML_1(glutDestroyWindow, Int_val) ML_0_(glutGetWindow, Val_int) /* return win id */ ML_1(glutSetWindow, Int_val) ML_1(glutSetWindowTitle, String_val) ML_1(glutSetIconTitle, String_val) ML_2(glutPositionWindow, Int_val, Int_val) ML_2(glutReshapeWindow, Int_val, Int_val) ML_0(glutPopWindow) ML_0(glutPushWindow) ML_0(glutIconifyWindow) ML_0(glutShowWindow) ML_0(glutHideWindow) ML_0(glutFullScreen) ML_1(glutSetCursor, Int_val) ML_0(glutEstablishOverlay) ML_0(glutRemoveOverlay) ML_1(glutUseLayer, Int_val) ML_0(glutPostOverlayRedisplay) ML_0(glutShowOverlay) ML_0(glutHideOverlay) ML_1(glutDestroyMenu, Int_val) ML_0_(glutGetMenu, Val_int) ML_1(glutSetMenu, Int_val) ML_2(glutAddMenuEntry, String_val, Int_val) ML_2(glutAddSubMenu, String_val, Int_val) ML_3(glutChangeToMenuEntry, Int_val, String_val, Int_val) ML_3(glutChangeToSubMenu, Int_val, String_val, Int_val) ML_1(glutRemoveMenuItem, Int_val) ML_1(glutAttachMenu, Int_val) ML_1(glutDetachMenu, Int_val) ML_4(glutSetColor, Int_val, Float_val, Float_val, Float_val) ML_2_(glutGetColor, Int_val, Int_val, copy_double) ML_1(glutCopyColormap, Int_val) ML_1_(glutGet, Int_val, Val_int) ML_1_(glutDeviceGet, Int_val, Val_int) ML_1_(glutExtensionSupported, String_val, Val_bool) ML_0_(glutGetModifiers, Val_int) ML_1_(glutLayerGet, Int_val, Val_int) ML_1_(glutVideoResizeGet, Int_val, Val_int) ML_0(glutSetupVideoResizing) ML_0(glutStopVideoResizing) ML_4(glutVideoResize, Int_val, Int_val, Int_val, Int_val) ML_4(glutVideoPan, Int_val, Int_val, Int_val, Int_val) ML_0(glutReportErrors) ML_3(glutWireSphere, Float_val, Int_val, Int_val) ML_3(glutSolidSphere, Float_val, Int_val, Int_val) ML_4(glutWireCone, Float_val, Float_val, Int_val, Int_val) ML_4(glutSolidCone, Float_val, Float_val, Int_val, Int_val) ML_1(glutWireCube, Float_val) ML_1(glutSolidCube, Float_val) ML_4(glutWireTorus, Float_val, Float_val, Int_val, Int_val) ML_4(glutSolidTorus, Float_val, Float_val, Int_val, Int_val) ML_0(glutWireDodecahedron) ML_0(glutSolidDodecahedron) ML_1(glutWireTeapot, Float_val) ML_1(glutSolidTeapot, Float_val) ML_0(glutWireOctahedron) ML_0(glutSolidOctahedron) ML_0(glutWireTetrahedron) ML_0(glutSolidTetrahedron) ML_0(glutWireIcosahedron) ML_0(glutSolidIcosahedron) ML_1(glutGameModeString, String_val) ML_0(glutEnterGameMode) ML_0(glutLeaveGameMode) ML_1_(glutGameModeGet, Int_val, Val_int) CAMLprim value ml_glutInit( value v_argc, char **argv ) { int argc = Int_val(v_argc); /* The input array must have one more element */ argv[argc] = NULL; glutInit(&argc, argv); /* Safe: no callback */ return Val_int(argc); } CAMLprim value native_glutInitDisplayMode( value double_buffer, value index, value accum, value alpha, value depth, value stencil, value multisample, value stereo, value luminance) { unsigned int acc = 0; acc |= Bool_val(double_buffer) ? GLUT_DOUBLE : 0; acc |= Bool_val(index) ? GLUT_INDEX : 0; acc |= Bool_val(accum) ? GLUT_ACCUM : 0; acc |= Bool_val(alpha) ? GLUT_RGBA : 0; acc |= Bool_val(depth) ? GLUT_DEPTH : 0; acc |= Bool_val(stencil) ? GLUT_STENCIL : 0; acc |= Bool_val(multisample) ? GLUT_MULTISAMPLE : 0; acc |= Bool_val(stereo) ? GLUT_STEREO : 0; acc |= Bool_val(luminance) ? GLUT_LUMINANCE : 0; glutInitDisplayMode(acc); return Val_unit; } CAMLprim value bytecode_glutInitDisplayMode ( value * args, int num_args) { assert(num_args == 9); native_glutInitDisplayMode( args[0],/*double_buffer*/ args[1],/*index*/ args[2],/*accum*/ args[3],/*alpha*/ args[4],/*depth*/ args[5],/*stencil*/ args[6],/*multisample*/ args[7],/*stereo*/ args[8] /*luminance*/ ); return Val_unit; } /* associations between callback functions and window ids are made on the OCaml side. */ /* TODO: make these easier to read. gcc was complaining about backslashes, for reasons that aren't clear to me. */ #define REGISTER_CB(glut_func) \ CAMLprim value ml_##glut_func(value cb) { \ glut_func(glut_func##_cb ); \ if (glut_func##_value) { \ if (glut_func##_value == cb) return Val_unit; \ caml_remove_global_root(&glut_func##_value); \ } \ glut_func##_value = cb; \ caml_register_global_root(&glut_func##_value); \ return Val_unit; \ } // for callback with return value for the hooking function #define REGISTER_CB_(glut_func, conv) \ CAMLprim value ml_##glut_func(value cb) { \ value r = conv(glut_func(glut_func##_cb )); \ if (glut_func##_value) { \ if (glut_func##_value == cb) return r; \ caml_remove_global_root(&glut_func##_value); \ } \ glut_func##_value = cb; \ caml_register_global_root(&glut_func##_value); \ return r; \ } // for callback with one extra argument for the hooking function #define REGISTER__CB(glut_func, conv) \ CAMLprim value ml_##glut_func(value cb, value arg) { \ glut_func(glut_func##_cb, conv(arg) ); \ if (glut_func##_value) { \ if (glut_func##_value == cb) return Val_unit; \ caml_remove_global_root(&glut_func##_value); \ } \ glut_func##_value = cb; \ caml_register_global_root(&glut_func##_value); \ return Val_unit; \ } #define CB_0(glut_func) \ value glut_func##_value = 0; \ static void glut_func##_cb( void ) { \ leave_blocking_section (); \ callback(glut_func##_value, Val_unit); \ enter_blocking_section (); \ } \ REGISTER_CB(glut_func) #define CB_1(glut_func, type1, conv1) \ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1 ) { \ leave_blocking_section (); \ callback(glut_func##_value, conv1(arg1)); \ enter_blocking_section (); \ } \ REGISTER_CB(glut_func) // for callback with return value for the hooking function #define CB_1_(glut_func, type1, conv1, conv) \ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1 ) { \ leave_blocking_section (); \ callback(glut_func##_value, conv1(arg1)); \ enter_blocking_section (); \ } \ REGISTER_CB_(glut_func, conv) #define CB_2(glut_func, type1, conv1, type2, conv2) \ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1, type2 arg2 ) { \ leave_blocking_section (); \ callback2(glut_func##_value, conv1(arg1), conv2(arg2)); \ enter_blocking_section (); \ } \ REGISTER_CB(glut_func) #define CB_3(glut_func, type1, conv1, type2, conv2, type3, conv3) \ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3 ) { \ leave_blocking_section (); \ callback3(glut_func##_value, conv1(arg1), conv2(arg2), conv3(arg3)); \ enter_blocking_section (); \ } \ REGISTER_CB(glut_func) #define CB_4(glut_func, type1, conv1, type2, conv2, type3, conv3, type4, conv4)\ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\ { \ value args[4]; \ leave_blocking_section (); \ args[0] = conv1(arg1); \ args[1] = conv2(arg2); \ args[2] = conv3(arg3); \ args[3] = conv4(arg4); \ callbackN (glut_func##_value, 4, args); \ enter_blocking_section (); \ } \ REGISTER_CB(glut_func) // for callback with one extra argument for the hooking function #define CB__4(glut_func, type1, conv1, type2, conv2, type3, conv3, type4, conv4, conv) \ value glut_func##_value = 0; \ static void glut_func##_cb( type1 arg1, type2 arg2, type3 arg3, type4 arg4 )\ { \ value args[4]; \ leave_blocking_section (); \ args[0] = conv1(arg1); \ args[1] = conv2(arg2); \ args[2] = conv3(arg3); \ args[3] = conv4(arg4); \ callbackN (glut_func##_value, 4, args); \ enter_blocking_section (); \ } \ REGISTER__CB(glut_func, conv) CB_0(glutDisplayFunc) CB_1(glutVisibilityFunc, int, Val_int) CB_1_(glutCreateMenu,int, Val_int, Val_int) CB_2(glutReshapeFunc, int, Val_int, int, Val_int) CB_3(glutKeyboardFunc, unsigned char, Val_int, int, Val_int, int, Val_int) CB_2(glutMotionFunc, int, Val_int, int, Val_int) CB_3(glutSpecialFunc, int, Val_int, int, Val_int, int, Val_int) CB_2(glutPassiveMotionFunc, int, Val_int, int, Val_int) CB_1(glutEntryFunc, int, Val_int) CB_3(glutSpaceballMotionFunc, int, Val_int, int, Val_int, int, Val_int) CB_3(glutSpaceballRotateFunc, int, Val_int, int, Val_int, int, Val_int) CB_2(glutSpaceballButtonFunc, int, Val_int, int, Val_int) CB_2(glutButtonBoxFunc, int, Val_int, int, Val_int) CB_2(glutDialsFunc, int, Val_int, int, Val_int) CB_2(glutTabletMotionFunc, int, Val_int, int, Val_int) CB_4(glutTabletButtonFunc, int, Val_int, int, Val_int, int, Val_int, int, Val_int) CB_3(glutMenuStatusFunc, int, Val_int, int, Val_int, int, Val_int) CB_0(glutOverlayDisplayFunc) CB_4(glutMouseFunc, int, Val_int, int, Val_int, int, Val_int, int, Val_int) CB_0(glutIdleFunc) CAMLprim value ml_glutSetIdleFuncToNull( value unit ) { glutIdleFunc(NULL); if (glutIdleFunc_value) { caml_remove_global_root(&glutIdleFunc_value); glutIdleFunc_value = 0; } return Val_unit; } static value caml_glutTimerFunc_cb = 0; CAMLprim void init_glutTimerFunc_cb(value v) { caml_glutTimerFunc_cb = v; caml_register_global_root(&caml_glutTimerFunc_cb); } static void glutTimerFunc_cb(int val) { leave_blocking_section (); callback (caml_glutTimerFunc_cb, (value) val); enter_blocking_section (); } CAMLprim value ml_glutTimerFunc(value millis, value timer_count) // set Timer callback { glutTimerFunc(Int_val(millis), &glutTimerFunc_cb, (int) timer_count); // register with GLUT return Val_unit; } /* font stuff */ /* integer code to font */ static void* i2font(int i) { switch(i) { case 0: return GLUT_STROKE_ROMAN; case 1: return GLUT_STROKE_MONO_ROMAN; case 2: return GLUT_BITMAP_9_BY_15; case 3: return GLUT_BITMAP_8_BY_13; case 4: return GLUT_BITMAP_TIMES_ROMAN_10; case 5: return GLUT_BITMAP_TIMES_ROMAN_24; case 6: return GLUT_BITMAP_HELVETICA_10; case 7: return GLUT_BITMAP_HELVETICA_12; case 8: return GLUT_BITMAP_HELVETICA_18; default: caml_failwith("wrap_glut.c: unrecognized font. impossible...\n"); } } CAMLprim value ml_glutBitmapCharacter(value font, value c) { glutBitmapCharacter(i2font(Int_val(font)), Int_val(c)); return Val_unit; } CAMLprim value ml_glutBitmapWidth(value font, value c) { return Val_int(glutBitmapWidth(i2font(Int_val(font)), Int_val(c))); } CAMLprim value ml_glutStrokeCharacter(value font, value c) { glutStrokeCharacter(i2font(Int_val(font)), Int_val(c)); return Val_unit; } CAMLprim value ml_glutStrokeWidth(value font, value c) { return Val_int(glutStrokeWidth(i2font(Int_val(font)), Int_val(c))); } /* GLUT 4 functions included with GLUT 3.7 */ ML_1(glutInitDisplayString, String_val) ML_2(glutWarpPointer, Int_val, Int_val) CAMLprim value ml_glutBitmapLength(value font, value str) { /* need to do something about the unsignedness of the chars expected? */ return Val_int(glutBitmapLength(i2font(Int_val(font)), String_val(str))); } CAMLprim value ml_glutStrokeLength(value font, value str) { /* need to do something about the unsignedness of the chars expected? */ return Val_int(glutStrokeLength(i2font(Int_val(font)), String_val(str))); } CB_1(glutWindowStatusFunc, int, Val_int) ML_1(glutPostWindowRedisplay, Int_val) ML_1(glutPostWindowOverlayRedisplay, Val_int) CB_3(glutKeyboardUpFunc, unsigned char, Val_int, int, Val_int, int, Val_int) CB_3(glutSpecialUpFunc, int, Val_int, int, Val_int, int, Val_int) ML_1(glutIgnoreKeyRepeat, Int_val) ML_1(glutSetKeyRepeat, Int_val) CB__4(glutJoystickFunc, unsigned int, Val_int, int, Val_int, int, Val_int, int, Val_int, Int_val) ML_0(glutForceJoystickFunc) lablgl-1.05/LablGlut/examples/caml-images/000755 000765 000024 00000000000 12217024174 021347 5ustar00garriguestaff000000 000000 lablgl-1.05/LablGlut/examples/lablGL/000755 000765 000024 00000000000 12217024174 020325 5ustar00garriguestaff000000 000000 lablgl-1.05/LablGlut/examples/nehe/000755 000765 000024 00000000000 12217024174 020107 5ustar00garriguestaff000000 000000 lablgl-1.05/LablGlut/examples/README000644 000765 000024 00000000132 12217024174 020044 0ustar00garriguestaff000000 000000 $Id: README,v 1.2 2003-09-26 08:25:07 garrigue Exp $ Here are a few examples for LablGL. lablgl-1.05/LablGlut/examples/nehe/lesson2.ml000644 000765 000024 00000003744 12217024174 022036 0ustar00garriguestaff000000 000000 (* * This code was created by Jeff Molofee '99 * If you've found this code useful, please let me know. * * Visit Jeff at http://nehe.gamedev.net/ * * Ported to O'Caml/lablglut by Jeffrey Palmer 8/02 * For port-specific issues, comments, etc., please * contact jeffrey.palmer@acm.org *) let init_gl width height = GlDraw.shade_model `smooth; GlClear.color (0.0, 0.0, 0.0); GlClear.depth 1.0; GlClear.clear [`color; `depth]; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let draw_gl_scene () = GlClear.clear [`color; `depth]; GlMat.load_identity (); (* Draw the triangle *) GlMat.translate3 (-1.5, 0.0, -6.0); GlDraw.color (1.0, 1.0, 1.0); GlDraw.begins `triangles; GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.ends (); (* Draw the square *) GlMat.translate3 (3.0, 0.0, 0.0); GlDraw.begins `quads; GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); Glut.swapBuffers () (* Handle window reshape events *) let reshape_cb ~w ~h = let ratio = (float_of_int w) /. (float_of_int h) in GlDraw.viewport 0 0 w h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective 45.0 ratio (0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () (* Handle keyboard events *) let keyboard_cb ~key ~x ~y = match key with | 27 (* ESC *) -> exit 0 | _ -> () let main () = let width = 640 and height = 480 in ignore (Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true (); Glut.initWindowSize width height; ignore (Glut.createWindow "O'Caml OpenGL Lesson 2"); Glut.displayFunc draw_gl_scene; Glut.keyboardFunc keyboard_cb; Glut.reshapeFunc reshape_cb; init_gl width height; Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/nehe/lesson3.ml000644 000765 000024 00000004123 12217024174 022027 0ustar00garriguestaff000000 000000 (* * This code was created by Jeff Molofee '99 * If you've found this code useful, please let me know. * * Visit Jeff at http://nehe.gamedev.net/ * * Ported to O'Caml/lablglut by Jeffrey Palmer 8/02 * For port-specific issues, comments, etc., please * contact jeffrey.palmer@acm.org *) let init_gl width height = GlDraw.shade_model `smooth; GlClear.color (0.0, 0.0, 0.0); GlClear.depth 1.0; GlClear.clear [`color; `depth]; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let draw_gl_scene () = GlClear.clear [`color; `depth]; GlMat.load_identity (); (* Draw the triangle *) GlMat.translate3 (-1.5, 0.0, -6.0); GlDraw.begins `triangles; GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.ends (); (* Draw the square *) GlMat.translate3 (3.0, 0.0, 0.0); GlDraw.begins `quads; GlDraw.color ( 0.5, 0.5, 1.0); GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); Glut.swapBuffers () (* Handle window reshape events *) let reshape_cb ~w ~h = let ratio = (float_of_int w) /. (float_of_int h) in GlDraw.viewport 0 0 w h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective 45.0 ratio (0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () (* Handle keyboard events *) let keyboard_cb ~key ~x ~y = match key with | 27 (* ESC *) -> exit 0 | _ -> () let main () = let width = 640 and height = 480 in ignore (Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true (); Glut.initWindowSize width height; ignore (Glut.createWindow "O'Caml OpenGL Lesson 3"); Glut.displayFunc draw_gl_scene; Glut.keyboardFunc keyboard_cb; Glut.reshapeFunc reshape_cb; init_gl width height; Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/nehe/lesson4.ml000644 000765 000024 00000004577 12217024174 022045 0ustar00garriguestaff000000 000000 (* * This code was created by Jeff Molofee '99 * If you've found this code useful, please let me know. * * Visit Jeff at http://nehe.gamedev.net/ * * Ported to O'Caml/lablglut by Jeffrey Palmer 8/02 * For port-specific issues, comments, etc., please * contact jeffrey.palmer@acm.org *) let rtri = ref 0.0 let rquad = ref 0.0 let init_gl width height = GlDraw.shade_model `smooth; GlClear.color (0.0, 0.0, 0.0); GlClear.depth 1.0; GlClear.clear [`color; `depth]; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let draw_gl_scene () = GlClear.clear [`color; `depth]; GlMat.load_identity (); (* Draw the triangle *) GlMat.translate3 (-1.5, 0.0, -6.0); GlMat.rotate3 !rtri (0.0, 1.0, 0.0); GlDraw.begins `triangles; GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.ends (); (* Draw the square *) GlMat.load_identity (); GlMat.translate3 (1.5, 0.0, -6.0); GlMat.rotate3 !rquad (1.0, 0.0, 0.0); GlDraw.begins `quads; GlDraw.color ( 0.5, 0.5, 1.0); GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); Glut.swapBuffers (); rtri := !rtri +. 0.2; rquad := !rquad -. 0.15 (* Handle window reshape events *) let reshape_cb ~w ~h = let ratio = (float_of_int w) /. (float_of_int h) in GlDraw.viewport 0 0 w h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective 45.0 ratio (0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () (* Handle keyboard events *) let keyboard_cb ~key ~x ~y = match key with | 27 (* ESC *) -> exit 0 | _ -> () (* Draw the scene whever idle *) let idle_cb () = draw_gl_scene () let main () = let width = 640 and height = 480 in ignore (Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true (); Glut.initWindowSize width height; ignore (Glut.createWindow "O'Caml OpenGL Lesson 4"); Glut.displayFunc draw_gl_scene; Glut.keyboardFunc keyboard_cb; Glut.reshapeFunc reshape_cb; Glut.idleFunc(Some idle_cb); init_gl width height; Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/nehe/lesson5.ml000644 000765 000024 00000010167 12217024174 022036 0ustar00garriguestaff000000 000000 (* * This code was created by Jeff Molofee '99 * If you've found this code useful, please let me know. * * Visit Jeff at http://nehe.gamedev.net/ * * Ported to O'Caml/lablglut by Jeffrey Palmer 8/02 * For port-specific issues, comments, etc., please * contact jeffrey.palmer@acm.org *) let rtri = ref 0.0 let rquad = ref 0.0 let init_gl width height = GlDraw.shade_model `smooth; GlClear.color (0.0, 0.0, 0.0); GlClear.depth 1.0; GlClear.clear [`color; `depth]; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let draw_gl_scene () = GlClear.clear [`color; `depth]; GlMat.load_identity (); (* Draw the pyramid *) GlMat.translate3 (-1.5, 0.0, -6.0); GlMat.rotate3 !rtri (0.0, 1.0, 0.0); GlDraw.begins `triangles; GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0,-1.0, 1.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 ( 1.0,-1.0, 1.0); GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 ( 1.0,-1.0, 1.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0,-1.0,-1.0); GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 ( 1.0,-1.0,-1.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 (-1.0,-1.0,-1.0); GlDraw.color ( 1.0, 0.0, 0.0); GlDraw.vertex3 ( 0.0, 1.0, 0.0); GlDraw.color ( 0.0, 0.0, 1.0); GlDraw.vertex3 (-1.0,-1.0,-1.0); GlDraw.color ( 0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0,-1.0, 1.0); GlDraw.ends (); (* Draw the square *) GlMat.load_identity (); GlMat.translate3 (1.5, 0.0, -7.0); GlMat.rotate3 !rquad (1.0, 1.0, 1.0); GlDraw.begins `quads; GlDraw.color (0.0,1.0,0.0); GlDraw.vertex3 ( 1.0, 1.0,-1.0); GlDraw.vertex3 (-1.0, 1.0,-1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 ( 1.0, 1.0, 1.0); GlDraw.color (1.0,0.5,0.0); GlDraw.vertex3 ( 1.0,-1.0, 1.0); GlDraw.vertex3 (-1.0,-1.0, 1.0); GlDraw.vertex3 (-1.0,-1.0,-1.0); GlDraw.vertex3 ( 1.0,-1.0,-1.0); GlDraw.color (1.0,0.0,0.0); GlDraw.vertex3 ( 1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0,-1.0, 1.0); GlDraw.vertex3 ( 1.0,-1.0, 1.0); GlDraw.color (1.0,1.0,0.0); GlDraw.vertex3 ( 1.0,-1.0,-1.0); GlDraw.vertex3 (-1.0,-1.0,-1.0); GlDraw.vertex3 (-1.0, 1.0,-1.0); GlDraw.vertex3 ( 1.0, 1.0,-1.0); GlDraw.color (0.0,0.0,1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0, 1.0,-1.0); GlDraw.vertex3 (-1.0,-1.0,-1.0); GlDraw.vertex3 (-1.0,-1.0, 1.0); GlDraw.color (1.0,0.0,1.0); GlDraw.vertex3 ( 1.0, 1.0,-1.0); GlDraw.vertex3 ( 1.0, 1.0, 1.0); GlDraw.vertex3 ( 1.0,-1.0, 1.0); GlDraw.vertex3 ( 1.0,-1.0,-1.0); GlDraw.ends (); Glut.swapBuffers (); rtri := !rtri +. 0.2; rquad := !rquad -. 0.15 (* Handle window reshape events *) let reshape_cb ~w ~h = let ratio = (float_of_int w) /. (float_of_int h) in GlDraw.viewport 0 0 w h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective 45.0 ratio (0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () (* Handle keyboard events *) let keyboard_cb ~key ~x ~y = match key with | 27 (* ESC *) -> exit 0 | _ -> () (* Draw the scene whever idle *) let idle_cb () = draw_gl_scene () let main () = let width = 640 and height = 480 in ignore (Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true (); Glut.initWindowSize width height; ignore (Glut.createWindow "O'Caml OpenGL Lesson 5"); Glut.displayFunc draw_gl_scene; Glut.keyboardFunc keyboard_cb; Glut.reshapeFunc reshape_cb; Glut.idleFunc(Some idle_cb); init_gl width height; Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/lablGL/checker.ml000644 000765 000024 00000004054 12217024174 022266 0ustar00garriguestaff000000 000000 (* $Id: checker.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* converted by Issac Trotts. July 25, 2002 *) let image_height = 64 and image_width = 64 let make_image () = let image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in for i = 0 to image_width - 1 do for j = 0 to image_height - 1 do Raw.sets (GlPix.to_raw image) ~pos:(3*(i*image_height+j)) (if (i land 8 ) lxor (j land 8) = 0 then [|255;255;255|] else [|0;0;0|]) done done; image let myinit () = GlClear.color (0.0, 0.0, 0.0); Gl.enable `depth_test; GlFunc.depth_func `less; let image = make_image () in GlPix.store (`unpack_alignment 1); GlTex.image2d image; List.iter (GlTex.parameter ~target:`texture_2d) [ `wrap_s `clamp; `wrap_t `clamp; `mag_filter `nearest; `min_filter `nearest ]; GlTex.env (`mode `decal); Gl.enable `texture_2d; GlDraw.shade_model `flat let display () = GlClear.clear [`color;`depth]; GlDraw.begins `quads; GlTex.coord2(0.0, 0.0); GlDraw.vertex3(-2.0, -1.0, 0.0); GlTex.coord2(0.0, 1.0); GlDraw.vertex3(-2.0, 1.0, 0.0); GlTex.coord2(1.0, 1.0); GlDraw.vertex3(0.0, 1.0, 0.0); GlTex.coord2(1.0, 0.0); GlDraw.vertex3(0.0, -1.0, 0.0); GlTex.coord2(0.0, 0.0); GlDraw.vertex3(1.0, -1.0, 0.0); GlTex.coord2(0.0, 1.0); GlDraw.vertex3(1.0, 1.0, 0.0); GlTex.coord2(1.0, 1.0); GlDraw.vertex3(2.41421, 1.0, -1.41421); GlTex.coord2(1.0, 0.0); GlDraw.vertex3(2.41421, -1.0, -1.41421); GlDraw.ends (); Gl.flush () let reshape ~w ~h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:60.0 ~aspect:(1.0 *. float w /. float h) ~z:(1.0,30.0); GlMat.mode `modelview; GlMat.load_identity (); GlMat.translate ~z:(-3.6) () let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true () ; Glut.initWindowSize ~w:500 ~h:500 ; ignore(Glut.createWindow ~title:"checker"); myinit (); Glut.displayFunc ~cb:display ; Glut.reshapeFunc ~cb:reshape ; Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/lablGL/gears.ml000644 000765 000024 00000016601 12217024174 021764 0ustar00garriguestaff000000 000000 (* $Id: gears.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* * 3-D gear wheels. This program is in the public domain. * * Brian Paul * LablGL version by Jacques Garrigue * LablGLUT version by Issac Trotts *) open Printf;; let pi = acos (-1.) (* * Draw a gear wheel. You'll probably want to call this function when * building a display list since we do a lot of trig here. * * Input: inner_radius - radius of hole at center * outer_radius - radius at center of teeth * width - width of gear * teeth - number of teeth * tooth_depth - depth of tooth *) let gear ~inner ~outer ~width ~teeth ~tooth_depth = let r0 = inner and r1 = outer -. tooth_depth /. 2.0 and r2 = outer +. tooth_depth /. 2.0 in let ta = 2.0 *. pi /. float teeth in let da = ta /. 4.0 in GlDraw.shade_model `flat; GlDraw.normal ~z:1.0 (); let vertex ~r ~z ?(s=0) i = let angle = float i *. ta +. float s *. da in GlDraw.vertex ~x:(r *. cos angle) ~y:(r *. sin angle) ~z () in (* draw front face *) let z = width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r0 ~z; vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~z ~s:3; done; GlDraw.ends (); (* draw front sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r1 ~s:3 ~z; done; GlDraw.ends (); GlDraw.normal ~z:(-1.0) (); (* draw back face *) let z = -. width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r0 ~z; done; GlDraw.ends (); (* draw back sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r1 ~z; done; GlDraw.ends (); (* draw outward faces of teeth *) let z = width *. 0.5 and z' = width *. (-0.5) in GlDraw.begins `quad_strip; for i=0 to teeth - 1 do let angle = float i *. ta in vertex i ~r:r1 ~z; vertex i ~r:r1 ~z:z'; let u = r2 *. cos(angle+.da) -. r1 *. cos(angle) and v = r2 *. sin(angle+.da) -. r1 *. sin(angle) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:1 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:2 ~z:z'; let u = r1 *. cos(angle +. 3. *. da) -. r2 *. cos(angle +. 2. *. da) and v = r1 *. sin(angle +. 3. *. da) -. r2 *. sin(angle +. 2. *. da) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r1 ~s:3 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); done; vertex 0 ~r:r1 ~z; vertex 0 ~r:r1 ~z:z'; GlDraw.ends (); GlDraw.shade_model `smooth; (* draw inside radius cylinder *) GlDraw.begins `quad_strip; for i=0 to teeth do let angle = float i *. ta in GlDraw.normal ~x:(-. cos angle) ~y:(-. sin angle) (); vertex i ~r:r0 ~z:z'; vertex i ~r:r0 ~z; done; GlDraw.ends () class view ~gear1 ~gear2 ~gear3 ~limit = object (self) val mutable view_rotx = 0.0 val mutable view_roty = 0.0 val mutable view_rotz = 0.0 val mutable angle = 0.0 val mutable count = 1 method rotx a = view_rotx <- view_rotx +. a method roty a = view_roty <- view_roty +. a method draw = GlClear.clear [`color;`depth]; GlMat.push (); GlMat.rotate ~angle:view_rotx ~x:1.0 (); GlMat.rotate ~angle:view_roty ~y:1.0 (); GlMat.rotate ~angle:view_rotz ~z:1.0 (); GlMat.push (); GlMat.translate ~x:(-3.0) ~y:(-2.0) (); GlMat.rotate ~angle:angle ~z:1.0 (); (* gear inner:1.0 outer:4.0 width:1.0 teeth:20 tooth_depth:0.7; *) GlList.call gear1; GlMat.pop (); GlMat.push (); GlMat.translate ~x:3.1 ~y:(-2.0) (); GlMat.rotate ~angle:(-2.0 *. angle -. 9.0) ~z:1.0 (); (* gear inner:0.5 outer:2.0 width:2.0 teeth:10 tooth_depth:0.7; *) GlList.call gear2; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-3.1) ~y:4.2 (); GlMat.rotate ~angle:(-2.0 *. angle -. 25.0) ~z:1.0 (); (* gear inner:1.3 outer:2.0 width:0.5 teeth:10 tooth_depth:0.7; *) GlList.call gear3; GlMat.pop (); GlMat.pop (); Glut.swapBuffers(); count <- count + 1; if count =limit then exit 0 method idle = angle <- angle +. 2.0; self#draw method reshape w h = GlDraw.viewport ~x:0 ~y:0 ~w:w ~h:h; GlMat.mode `projection; GlMat.load_identity (); let r = float w /. float h in let r' = 1. /. r in if (w>h) then GlMat.frustum ~x:(-. r,r) ~y:(-1.0,1.0) ~z:(5.0,60.0) else GlMat.frustum ~x:(-1.0,1.0) ~y:(-.r',r') ~z:(5.0,60.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate ~z:(-40.0) (); GlClear.clear[`color;`depth] end let init () = let pos = 5.0, 5.0, 10.0, 0.0 and red = 0.8, 0.1, 0.0, 1.0 and green = 0.0, 0.8, 0.2, 1.0 and blue = 0.2, 0.2, 1.0, 1.0 in GlLight.light ~num:0 (`position pos); List.iter Gl.enable [`cull_face;`lighting;`light0;`depth_test;`normalize]; (* make the gears *) let make_gear ~inner ~outer ~width ~teeth ~color = let list = GlList.create `compile in GlLight.material ~face:`front (`ambient_and_diffuse color); gear ~inner ~outer ~width ~teeth ~tooth_depth:0.7; GlList.ends (); list in let gear1 = make_gear ~inner:1.0 ~outer:4.0 ~width:1.0 ~teeth:20 ~color:red and gear2 = make_gear ~inner:0.5 ~outer:2.0 ~width:2.0 ~teeth:10 ~color:green and gear3 = make_gear ~inner:1.3 ~outer:2.0 ~width:0.5 ~teeth:10 ~color:blue in (gear1, gear2, gear3) let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~double_buffer:true ~depth:true () ; Glut.initWindowSize ~w:300 ~h:300; ignore (Glut.createWindow ~title:"gears demo"); let gear1, gear2, gear3 = init() in let view = new view ~gear1 ~gear2 ~gear3 ~limit:0 in let _reshape ~w ~h = view#reshape w h in let _keyboard_callback ~key ~x ~y = match (char_of_int key) with 'q' -> exit 0; | _ -> () in let _special_key_callback ~key ~x ~y = (* let dummy = x+y in *) let delta = 5.0 in let redisp = ref true in match key with | Glut.KEY_LEFT -> view#roty (-. delta) ; | Glut.KEY_RIGHT -> view#roty delta ; | Glut.KEY_DOWN -> view#rotx (-. delta) ; | Glut.KEY_UP -> view#rotx delta ; | _ -> begin redisp := false; (); end; if !redisp then Glut.postRedisplay (); in Glut.keyboardFunc ~cb:_keyboard_callback ; Glut.reshapeFunc ~cb:_reshape ; Glut.displayFunc ~cb:(fun () -> view#draw) ; Glut.idleFunc(Some (fun () -> view#idle)); Glut.specialFunc ~cb:_special_key_callback ; Glut.mainLoop(); ;; let _ = main () lablgl-1.05/LablGlut/examples/lablGL/morph3d.ml000644 000765 000024 00000050207 12217024174 022237 0ustar00garriguestaff000000 000000 (* $Id: morph3d.ml,v 1.2 2005-10-17 11:27:04 garrigue Exp $ *) open StdLabels open Printf (*- * morph3d.c - Shows 3D morphing objects (TK Version) * * This program was inspired on a WindowsNT(R)'s screen saver. It was written * from scratch and it was not based on any other source code. * * Porting it to xlock (the final objective of this code since the moment I * decided to create it) was possible by comparing the original Mesa's gear * demo with it's ported version, so thanks for Danny Sung for his indirect * help (look at gear.c in xlock source tree). NOTE: At the moment this code * was sent to Brian Paul for package inclusion, the XLock Version was not * available. In fact, I'll wait it to appear on the next Mesa release (If you * are reading this, it means THIS release) to send it for xlock package * inclusion). It will probably there be a GLUT version too. * * Thanks goes also to Brian Paul for making it possible and inexpensive * to use OpenGL at home. * * Since I'm not a native english speaker, my apologies for any gramatical * mistake. * * My e-mail addresses are * * vianna@cat.cbpf.br * and * marcelo@venus.rdc.puc-rio.br * * Marcelo F. Vianna (Feb-13-1997) *) (* This document is VERY incomplete, but tries to describe the mathematics used in the program. At this moment it just describes how the polyhedra are generated. On futhurer versions, this document will be probabbly improved. Since I'm not a native english speaker, my apologies for any gramatical mistake. Marcelo Fernandes Vianna - Undergraduate in Computer Engeneering at Catholic Pontifical University - of Rio de Janeiro (PUC-Rio) Brasil. - e-mail: vianna@cat.cbpf.br or marcelo@venus.rdc.puc-rio.br - Feb-13-1997 POLYHEDRA GENERATION For the purpose of this program it's not sufficient to know the polyhedra vertexes coordinates. Since the morphing algorithm applies a nonlinear transformation over the surfaces (faces) of the polyhedron, each face has to be divided into smaller ones. The morphing algorithm needs to transform each vertex of these smaller faces individually. It's a very time consoming task. In order to reduce calculation overload, and since all the macro faces of the polyhedron are transformed by the same way, the generation is made by creating only one face of the polyhedron, morphing it and then rotating it around the polyhedron center. What we need to know is the face radius of the polyhedron (the radius of the inscribed sphere) and the angle between the center of two adjacent faces using the center of the sphere as the angle's vertex. The face radius of the regular polyhedra are known values which I decided to not waste my time calculating. Following is a table of face radius for the regular polyhedra with edge length = 1: TETRAHEDRON : 1/(2*sqrt(2))/sqrt(3) CUBE : 1/2 OCTAHEDRON : 1/sqrt(6) DODECAHEDRON : T^2 * sqrt((T+2)/5) / 2 -> where T=(sqrt(5)+1)/2 ICOSAHEDRON : (3*sqrt(3)+sqrt(15))/12 I've not found any reference about the mentioned angles, so I needed to calculate them, not a trivial task until I figured out how :) Curiously these angles are the same for the tetrahedron and octahedron. A way to obtain this value is inscribing the tetrahedron inside the cube by matching their vertexes. So you'll notice that the remaining unmatched vertexes are in the same straight line starting in the cube/tetrahedron center and crossing the center of each tetrahedron's face. At this point it's easy to obtain the bigger angle of the isosceles triangle formed by the center of the cube and two opposite vertexes on the same cube face. The edges of this triangle have the following lenghts: sqrt(2) for the base and sqrt(3)/2 for the other two other edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the cube this angle is obvious, but just for formality it can be easily obtained because we also know it's isosceles edge lenghts: sqrt(2)/2 for the base and 1/2 for the other two edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN((sqrt(2)/2)/1) = 90.000000000000000000 degrees | +-----------------------------------------------------------+ For the octahedron we use the same idea used for the tetrahedron, but now we inscribe the cube inside the octahedron so that all cubes's vertexes matches excatly the center of each octahedron's face. It's now clear that this angle is the same of the thetrahedron one: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the dodecahedron it's a little bit harder because it's only relationship with the cube is useless to us. So we need to solve the problem by another way. The concept of Face radius also exists on 2D polygons with the name Edge radius: Edge Radius For Pentagon (ERp) ERp = (1/2)/TAN(36 degrees) * VRp = 0.6881909602355867905 (VRp is the pentagon's vertex radio). Face Radius For Dodecahedron FRd = T^2 * sqrt((T+2)/5) / 2 = 1.1135163644116068404 Why we need ERp? Well, ERp and FRd segments forms a 90 degrees angle, completing this triangle, the lesser angle is a half of the angle we are looking for, so this angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERp/FRd) = 63.434948822922009981 degrees | +-----------------------------------------------------------+ For the icosahedron we can use the same method used for dodecahedron (well the method used for dodecahedron may be used for all regular polyhedra) Edge Radius For Triangle (this one is well known: 1/3 of the triangle height) ERt = sin(60)/3 = sqrt(3)/6 = 0.2886751345948128655 Face Radius For Icosahedron FRi= (3*sqrt(3)+sqrt(15))/12 = 0.7557613140761707538 So the angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERt/FRi) = 41.810314895778596167 degrees | +-----------------------------------------------------------+ *) let scale = 0.3 let vect_mul (x1,y1,z1) (x2,y2,z2) = (y1 *. z2 -. z1 *. y2, z1 *. x2 -. x1 *. z2, x1 *. y2 -. y1 *. x2) let sqr a = a *. a (* Increasing this values produces better image quality, the price is speed. *) (* Very low values produces erroneous/incorrect plotting *) let tetradivisions = 23 let cubedivisions = 20 let octadivisions = 21 let dodecadivisions = 10 let icodivisions = 15 let tetraangle = 109.47122063449069174 let cubeangle = 90.000000000000000000 let octaangle = 109.47122063449069174 let dodecaangle = 63.434948822922009981 let icoangle = 41.810314895778596167 let pi = acos (-1.) let sqrt2 = sqrt 2. let sqrt3 = sqrt 3. let sqrt5 = sqrt 5. let sqrt6 = sqrt 6. let sqrt15 = sqrt 15. let cossec36_2 = 0.8506508083520399322 let cosd x = cos (float x /. 180. *. pi) let sind x = sin (float x /. 180. *. pi) let cos72 = cosd 72 let sin72 = sind 72 let cos36 = cosd 36 let sin36 = sind 36 (*************************************************************************) let front_shininess = 60.0 let front_specular = 0.7, 0.7, 0.7, 1.0 let ambient = 0.0, 0.0, 0.0, 1.0 let diffuse = 1.0, 1.0, 1.0, 1.0 let position0 = 1.0, 1.0, 1.0, 0.0 let position1 = -1.0,-1.0, 1.0, 0.0 let lmodel_ambient = 0.5, 0.5, 0.5, 1.0 let lmodel_twoside = true let materialRed = 0.7, 0.0, 0.0, 1.0 let materialGreen = 0.1, 0.5, 0.2, 1.0 let materialBlue = 0.0, 0.0, 0.7, 1.0 let materialCyan = 0.2, 0.5, 0.7, 1.0 let materialYellow = 0.7, 0.7, 0.0, 1.0 let materialMagenta = 0.6, 0.2, 0.5, 1.0 let materialWhite = 0.7, 0.7, 0.7, 1.0 let materialGray = 0.2, 0.2, 0.2, 1.0 let all_gray = Array.create 20 materialGray let vertex ~xf ~yf ~zf ~ampvr2 = let xa = xf +. 0.01 and yb = yf +. 0.01 in let xf2 = sqr xf and yf2 = sqr yf in let factor = 1. -. (xf2 +. yf2) *. ampvr2 and factor1 = 1. -. (sqr xa +. yf2) *. ampvr2 and factor2 = 1. -. (xf2 +. sqr yb) *. ampvr2 in let vertx = factor *. xf and verty = factor *. yf and vertz = factor *. zf in let neiax = factor1 *. xa -. vertx and neiay = factor1 *. yf -. verty and neiaz = factor1 *. zf -. vertz and neibx = factor2 *. xf -. vertx and neiby = factor2 *. yb -. verty and neibz = factor2 *. zf -. vertz in GlDraw.normal3 (vect_mul (neiax, neiay, neiaz) (neibx, neiby, neibz)); GlDraw.vertex3 (vertx, verty, vertz) let triangle ~edge ~amp ~divisions ~z = let divi = float divisions in let vr = edge *. sqrt3 /. 3. in let ampvr2 = amp /. sqr vr and zf = edge *. z in let ax = edge *. (0.5 /. divi) and ay = edge *. (-0.5 *. sqrt3 /. divi) and bx = edge *. (-0.5 /. divi) in for ri = 1 to divisions do GlDraw.begins `triangle_strip; for ti = 0 to ri - 1 do vertex ~zf ~ampvr2 ~xf:(float (ri-ti) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti) *. ay +. float ti *. ay); vertex ~zf ~ampvr2 ~xf:(float (ri-ti-1) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti-1) *. ay +. float ti *. ay) done; vertex ~xf:(float ri *. bx) ~yf:(vr +. float ri *. ay) ~zf ~ampvr2; GlDraw.ends () done let square ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr (edge *. sqrt2 /. 2.) in for yi = 0 to divisions - 1 do let yf = edge *. (-0.5 +. float yi /. divi) in let yf2 = sqr yf in let y = yf +. 1.0 /. divi *. edge in let y2 = sqr y in GlDraw.begins `quad_strip; for xi = 0 to divisions do let xf = edge *. (-0.5 +. float xi /. divi) in vertex ~xf ~yf:y ~zf ~ampvr2; vertex ~xf ~yf ~zf ~ampvr2 done; GlDraw.ends () done let pentagon ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr(edge *. cossec36_2) in let x = Array.init 6 ~f:(fun fi -> -. cos (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) and y = Array.init 6 ~f:(fun fi -> sin (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) in for ri = 1 to divisions do for fi = 0 to 4 do GlDraw.begins `triangle_strip; for ti = 0 to ri-1 do vertex ~zf ~ampvr2 ~xf:(float(ri-ti) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti) *. y.(fi) +. float ti *. y.(fi+1)); vertex ~zf ~ampvr2 ~xf:(float(ri-ti-1) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti-1) *. y.(fi) +. float ti *. y.(fi+1)) done; vertex ~xf:(float ri *. x.(fi+1)) ~yf:(float ri *. y.(fi+1)) ~zf ~ampvr2; GlDraw.ends () done done let call_list list color = GlLight.material ~face:`both (`diffuse color); GlList.call list let draw_tetra ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(0.5 /. sqrt6); GlList.ends(); call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.tetraangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(sqrt3 /. 2.) (); call_list list color.(2); GlMat.pop(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(-.sqrt3 /. 2.) (); call_list list color.(3); GlList.delete list let draw_cube ~amp ~divisions ~color = let list = GlList.create `compile in square ~edge:2.0 ~amp ~divisions ~z:0.5; GlList.ends (); call_list list color.(0); for i = 1 to 3 do GlMat.rotate ~angle:cubeangle ~x:1.0 (); call_list list color.(i) done; GlMat.rotate ~angle:cubeangle ~y:1.0 (); call_list list color.(4); GlMat.rotate ~angle:(2.0 *. cubeangle) ~y:1.0 (); call_list list color.(5); GlList.delete list let draw_octa ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(1.0 /. sqrt6); GlList.ends (); let do_list (i,y) = GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-.octaangle) ~x:0.5 ~y (); call_list list color.(i); GlMat.pop() in call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); List.iter [2, sqrt3 /. 2.0; 3, -.sqrt3 /. 2.0] ~f:do_list; GlMat.rotate ~angle:180.0 ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(4)); GlList.call list; GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(5)); GlList.call list; GlMat.pop(); List.iter [6, sqrt3 /. 2.0; 7, -.sqrt3 /. 2.0] ~f:do_list; GlList.delete list let draw_dodeca ~amp ~divisions ~color = let tau = (sqrt5 +. 1.0) /. 2.0 in let list = GlList.create `compile in pentagon ~edge:2.0 ~amp ~divisions ~z:(sqr(tau) *. sqrt ((tau+.2.0)/.5.0) /. 2.0); GlList.ends (); let do_list (i,angle,x,y) = GlMat.push(); GlMat.rotate ~angle:angle ~x ~y (); call_list list color.(i); GlMat.pop(); in GlMat.push (); call_list list color.(0); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 1, -.dodecaangle, 1.0, 0.0; 2, -.dodecaangle, cos72, sin72; 3, -.dodecaangle, cos72, -.sin72; 4, dodecaangle, cos36, -.sin36; 5, dodecaangle, cos36, sin36 ]; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(6); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 7, -.dodecaangle, 1.0, 0.0; 8, -.dodecaangle, cos72, sin72; 9, -.dodecaangle, cos72, -.sin72; 10, dodecaangle, cos36, -.sin36 ]; GlMat.rotate ~angle:dodecaangle ~x:cos36 ~y:sin36 (); call_list list color.(11); GlList.delete list let draw_ico ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:1.5 ~amp ~divisions ~z:((3.0 *. sqrt3 +. sqrt15) /. 12.0); GlList.ends (); let do_list1 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(sqrt3/.2.0) (); call_list list color.(i) and do_list2 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(-.sqrt3/.2.0) (); call_list list color.(i) and do_list3 i = GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.icoangle) ~x:1.0 (); call_list list color.(i) in GlMat.push (); call_list list color.(0); GlMat.push (); do_list3 1; GlMat.push (); do_list1 2; GlMat.pop (); do_list2 3; GlMat.pop (); GlMat.push (); do_list1 4; GlMat.push (); do_list1 5; GlMat.pop(); do_list3 6; GlMat.pop (); do_list2 7; GlMat.push (); do_list2 8; GlMat.pop (); do_list3 9; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(10); GlMat.push (); do_list3 11; GlMat.push (); do_list1 12; GlMat.pop (); do_list2 13; GlMat.pop (); GlMat.push (); do_list1 14; GlMat.push (); do_list1 15; GlMat.pop (); do_list3 16; GlMat.pop (); do_list2 17; GlMat.push (); do_list2 18; GlMat.pop (); do_list3 19; GlList.delete list class view = object (self) val mutable smooth = true val mutable step = 0. val mutable obj = 1 val mutable draw_object = fun ~amp -> () val mutable magnitude = 0. val mutable my_width = 640 val mutable my_height = 480 method width = my_width method height = my_height method draw = let ratio = float self#height /. float self#width in GlClear.clear [`color;`depth]; GlMat.push (); GlMat.translate () ~z:(-10.0); GlMat.scale () ~x:(scale *. ratio) ~y:scale ~z:scale; GlMat.translate () ~x:(2.5 *. ratio *. sin (step *. 1.11)) ~y:(2.5 *. cos (step *. 1.25 *. 1.11)); GlMat.rotate ~angle:(step *. 100.) ~x:1.0 (); GlMat.rotate ~angle:(step *. 95.) ~y:1.0 (); GlMat.rotate ~angle:(step *. 90.) ~z:1.0 (); draw_object ~amp:((sin step +. 1.0/.3.0) *. (4.0/.5.0) *. magnitude); GlMat.pop(); Gl.flush(); Glut.swapBuffers (); step <- step +. 0.05 method reshape ~w ~h = my_width <- w; my_height <- h; GlDraw.viewport ~x:0 ~y:0 ~w:self#width ~h:self#height; GlMat.mode `projection; GlMat.load_identity(); GlMat.frustum ~x:(-1.0, 1.0) ~y:(-1.0, 1.0) ~z:(5.0, 15.0); GlMat.mode `modelview method keyboard key = begin match (char_of_int key) with | '1' -> obj <- 1 | '2' -> obj <- 2 | '3' -> obj <- 3 | '4' -> obj <- 4 | '5' -> obj <- 5 | _ -> match key with | 10(*return*) -> smooth <- not smooth | 27(*escape*) -> exit 0 | _ -> (); end; self#pinit method pinit = begin match obj with 1 -> draw_object <- draw_tetra ~divisions:tetradivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite|]; magnitude <- 2.5 | 2 -> draw_object <- draw_cube ~divisions:cubedivisions ~color:[|materialRed; materialGreen; materialCyan; materialMagenta; materialYellow; materialBlue|]; magnitude <- 2.0 | 3 -> draw_object <- draw_octa ~divisions:octadivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialMagenta; materialGray; materialYellow|]; magnitude <- 2.5 | 4 -> draw_object <- draw_dodeca ~divisions:dodecadivisions ~color:[|materialRed; materialGreen; materialCyan; materialBlue; materialMagenta; materialYellow; materialGreen; materialCyan; materialRed; materialMagenta; materialBlue; materialYellow|]; magnitude <- 2.0 | 5 -> draw_object <- draw_ico ~divisions:icodivisions ~color:[|materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialGray|]; magnitude <- 3.5 | _ -> () end; GlDraw.shade_model (if smooth then `smooth else `flat) end let main () = List.iter ~f:print_string [ "Morph 3D - Shows morphing platonic polyhedra\n"; "Author: Marcelo Fernandes Vianna (vianna@cat.cbpf.br)\n"; "Ported to LablGL by Jacques Garrigue\n"; "Ported to lablglut by Issac Trotts\n\n"; " [1] - Tetrahedron\n"; " [2] - Hexahedron (Cube)\n"; " [3] - Octahedron\n"; " [4] - Dodecahedron\n"; " [5] - Icosahedron\n"; (* "[RETURN] - Toggle smooth/flat shading\n"; *) (* not working ... ??? *) " [ESC] - Quit\n" ]; flush stdout; ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:false ~double_buffer:true ~depth:true (); Glut.initWindowSize ~w:640 ~h:480; ignore(Glut.createWindow ~title:"Morph 3D - Shows morphing platonic polyhedra"); GlClear.depth 1.0; GlClear.color (0.0, 0.0, 0.0); GlDraw.color (1.0, 1.0, 1.0); GlClear.clear [`color;`depth]; Gl.flush(); Glut.swapBuffers(); List.iter ~f:(GlLight.light ~num:0) [`ambient ambient; `diffuse diffuse; `position position0]; List.iter ~f:(GlLight.light ~num:1) [`ambient ambient; `diffuse diffuse; `position position1]; GlLight.light_model (`ambient lmodel_ambient); GlLight.light_model (`two_side lmodel_twoside); List.iter ~f:Gl.enable [`lighting;`light0;`light1;`depth_test;`normalize]; GlLight.material ~face:`both (`shininess front_shininess); GlLight.material ~face:`both (`specular front_specular); GlMisc.hint `fog `fastest; GlMisc.hint `perspective_correction `fastest; GlMisc.hint `polygon_smooth `fastest; let view = new view in view#pinit; Glut.displayFunc ~cb:(fun () -> view#draw); Glut.reshapeFunc ~cb:(fun ~w ~h -> view#reshape w h); let rec idle ~value = view#draw; Glut.timerFunc ~ms:20 ~cb:idle ~value:0 in Glut.timerFunc ~ms:20 ~cb:idle ~value:0; Glut.keyboardFunc ~cb:(fun ~key ~x ~y -> view#keyboard key); Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/lablGL/planet.ml000644 000765 000024 00000007456 12217024174 022156 0ustar00garriguestaff000000 000000 (* $Id: planet.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* converted to lablglut by Issac Trotts on July 25, 2002 *) #load"unix.cma";; class planet = object (self) val mutable year = 0.0 val mutable day = 0.0 val mutable eye = 0.0 val mutable time = 0.0 method tick new_time = if time = 0. then time <- new_time else let diff = new_time -. time in time <- new_time; day <- mod_float (day +. diff *. 200.) 360.0; year <- mod_float (year +. diff *. 20.) 360.0; method day_add = day <- mod_float (day +. 10.0) 360.0 method day_subtract = day <- mod_float (day -. 10.0) 360.0 method year_add = year <- mod_float (year +. 5.0) 360.0 method year_subtract = year <- mod_float (year -. 5.0) 360.0 method eye x = eye <- x; self#display method display = GlClear.clear [`color;`depth]; GlDraw.color (1.0, 1.0, 1.0); GlMat.push(); GlMat.rotate ~angle:eye ~x:1. (); (* draw sun *) GlLight.material ~face:`front (`specular (1.0,1.0,0.0,1.0)); GlLight.material ~face:`front (`shininess 5.0); GluQuadric.sphere ~radius:1.0 ~slices:32 ~stacks:32 (); (* draw smaller planet *) GlMat.rotate ~angle:year ~y:1.0 (); GlMat.translate () ~x:3.0; GlMat.rotate ~angle:day ~y:1.0 (); GlDraw.color (0.0, 1.0, 1.0); GlDraw.shade_model `flat; GlLight.material ~face:`front(`shininess 128.0); GluQuadric.sphere ~radius:0.2 ~slices:10 ~stacks:10 (); GlDraw.shade_model `smooth; GlMat.pop (); Gl.flush (); Glut.swapBuffers (); end let myinit () = let light_ambient = 0.5, 0.5, 0.5, 1.0 and light_diffuse = 1.0, 0.8, 0.2, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in List.iter (GlLight.light ~num:0) [ `ambient light_ambient; `diffuse light_diffuse; `specular light_specular; `position light_position ]; GlFunc.depth_func `less; List.iter Gl.enable [`lighting; `light0; `depth_test]; GlDraw.shade_model `smooth let my_reshape ~w ~h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity(); GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(1.0,20.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate () ~z:(-5.0) (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~double_buffer:true ~depth:true (); Glut.initWindowSize ~w:700 ~h:500; ignore(Glut.createWindow "Planet"); myinit (); let planet = new planet in (* let scale = Scale.create top ~min:(-45.) ~max:45. ~orient:`Vertical ~command:(planet#eye) ~showvalue:false ~highlightbackground:`Black in *) (* bind togl ~events:[`Enter] ~action:(fun _ -> Focus.set togl); bind scale ~events:[`Enter] ~action:(fun _ -> Focus.set scale); bind togl ~events:[`KeyPress] ~fields:[`KeySymString] *) Glut.specialFunc ~cb:(fun ~key ~x ~y -> match key with | Glut.KEY_LEFT -> planet#year_subtract | Glut.KEY_RIGHT -> planet#year_add | Glut.KEY_UP -> planet#day_add | Glut.KEY_DOWN -> planet#day_subtract | _ -> (); planet#display); Glut.keyboardFunc ~cb:(fun ~key ~x ~y -> match key with | 27(*esc*) -> exit 0 | _ -> ()); (*Glut.timerFunc ~ms:20 ~cb:(fun ~value -> planet#tick (Unix.gettimeofday()); planet#display) ~value:0;*) let rec _timedUpdate ~value = planet#tick (Unix.gettimeofday()); Glut.postRedisplay(); Glut.timerFunc ~ms:20 ~cb:_timedUpdate ~value:0 in Glut.timerFunc ~ms:20 ~cb:_timedUpdate ~value:0; Glut.displayFunc ~cb:(fun () -> planet#display); Glut.reshapeFunc ~cb:my_reshape; my_reshape ~w:700 ~h:500; Glut.mainLoop () let _ = Printexc.print main () lablgl-1.05/LablGlut/examples/lablGL/README000644 000765 000024 00000000166 12217024174 021210 0ustar00garriguestaff000000 000000 Here are a few examples for LablGL. They can be run with the lablglut toplevel. For example: lablglut gears.ml lablgl-1.05/LablGlut/examples/lablGL/scene.ml000644 000765 000024 00000005706 12217024174 021764 0ustar00garriguestaff000000 000000 (* $Id: scene.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* converted to lablglut by Issac Trotts on July 25, 2002 *) (* Initialize material property and light source. *) let myinit () = let light_ambient = 0.0, 0.0, 0.0, 1.0 and light_diffuse = 1.0, 1.0, 1.0, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in GlLight.light ~num:0 (`ambient light_ambient); GlLight.light ~num:0 (`diffuse light_diffuse); GlLight.light ~num:0 (`specular light_specular); GlLight.light ~num:0 (`position light_position); GlFunc.depth_func `less; List.iter Gl.enable [`lighting; `light0; `depth_test] let pi = acos (-1.) let solid_torus ~inner ~outer = let slices = 32 and faces = 16 in let slice_angle = 2.0 *. pi /. float slices and face_angle = 2.0 *. pi /. float faces in let vertex ~i ~j = let angle1 = slice_angle *. float i and angle2 = face_angle *. float j in GlDraw.normal3 (cos angle1 *. cos angle2, -. sin angle1 *. cos angle2, sin angle2); GlDraw.vertex3 ((outer +. inner *. cos angle2) *. cos angle1, -. (outer +. inner *. cos angle2) *. sin angle1, inner *. sin angle2) in GlDraw.begins `quads; for i = 0 to slices - 1 do for j = 0 to faces - 1 do vertex ~i ~j; vertex ~i:(i+1) ~j; vertex ~i:(i+1) ~j:(j+1); vertex ~i ~j:(j+1); done done; GlDraw.ends () let solid_cone ~radius ~height = GluQuadric.cylinder ~base:radius ~top:0. ~height ~slices:15 ~stacks:10 () let solid_sphere ~radius = GluQuadric.sphere ~radius ~slices:32 ~stacks:32 () let display () = GlClear.clear [`color; `depth]; GlMat.push (); GlMat.rotate ~angle:20.0 ~x:1.0 (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:0.5 (); GlMat.rotate ~angle:90.0 ~x:1.0 (); solid_torus ~inner:0.275 ~outer:0.85; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:(-0.5) (); GlMat.rotate ~angle:270.0 ~x:1.0 (); solid_cone ~radius:1.0 ~height:2.0; GlMat.pop (); GlMat.push (); GlMat.translate ~x:0.75 ~z:(-1.0) (); solid_sphere ~radius:1.0; GlMat.pop (); GlMat.pop (); Gl.flush () let my_reshape ~w ~h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); if w <= h then GlMat.ortho ~x:(-2.5,2.5) ~z:(-10.0,10.0) ~y:(-2.5 *. float h /. float w, 2.5 *. float h /. float w) else GlMat.ortho ~y:(-2.5,2.5) ~z:(-10.0,10.0) ~x:(-2.5 *. float w /. float h, 2.5 *. float w /. float h); GlMat.mode `modelview (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true () ; Glut.initWindowSize ~w:500 ~h:500 ; ignore(Glut.createWindow "Scene"); myinit (); Glut.reshapeFunc ~cb:my_reshape ; Glut.displayFunc ~cb:display ; Glut.mainLoop () let _ = Printexc.print main () lablgl-1.05/LablGlut/examples/lablGL/simple.ml000644 000765 000024 00000001630 12217024174 022150 0ustar00garriguestaff000000 000000 (* $Id: simple.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* open Tk *) let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true () ; Glut.initWindowSize ~w:500 ~h:500 ; ignore(Glut.createWindow ~title:"lablglut & LablGL"); Glut.displayFunc ~cb: begin fun () -> (* display callback *) GlClear.color (0.0, 0.0, 0.0); GlClear.clear [`color]; GlDraw.color (1.0, 1.0, 1.0); GlMat.mode `projection; GlMat.load_identity (); GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0); GlDraw.begins `polygon; GlDraw.vertex ~x:(-0.5) ~y:(-0.5) (); GlDraw.vertex ~x:(-0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(-0.5) (); GlDraw.ends (); Gl.flush () end; (* ignore (Timer.add ~ms:10000 ~callback:(fun () -> exit 0)); *) Glut.mainLoop(); ;; let _ = main () lablgl-1.05/LablGlut/examples/lablGL/test_glsl.ml000644 000765 000024 00000005574 12217024174 022672 0ustar00garriguestaff000000 000000 (* Simple Demo for GLSL *) (* This demo comes from this tutorial: *) (* http://www.lighthouse3d.com/opengl/glsl/ *) (* The tutorial and this demo was made by António Ramires Fernandes. *) (* No restrictions apply to the use of this program. *) (* Converted from C to OCaml by Florent Monnier. *) let changeSize ~w ~h = (* Prevent a divide by zero, when window is too short (you cant make a window of zero width). *) let h = if h = 0 then 1 else h in let ratio = 1.0 *. float w /. float h in (* Reset the coordinate system before modifying *) GlMat.mode `projection; GlMat.load_identity(); (* Set the viewport to be the entire window *) GlDraw.viewport 0 0 w h; (* Set the correct perspective. *) GluMat.perspective 45.0 ratio (1.0, 1000.0); GlMat.mode `modelview; ;; let renderScene() = GlClear.clear [`color; `depth]; GlMat.load_identity(); GluMat.look_at (0.0, 0.0, 5.0) (0.0, 0.0, -1.0) (0.0, 1.0, 0.0); let lpos = (1.0, 0.5, 1.0, 0.0) in GlLight.light 0 (`position lpos); Glut.solidTeapot 1.0; Glut.swapBuffers(); ;; let processNormalKeys ~key ~x ~y = if key = 27 then exit 0; ;; let toon_frag = " // simple toon fragment shader varying vec3 normal, lightDir; vec4 toonify(in float intensity) { vec4 color; if (intensity > 0.98) color = vec4(0.9,0.9,0.9,1.0); else if (intensity > 0.5) color = vec4(0.4,0.4,0.8,1.0); else if (intensity > 0.25) color = vec4(0.3,0.3,0.5,1.0); else color = vec4(0.1,0.1,0.1,1.0); return(color); } void main() { float intensity; vec3 norm; norm = normalize(normal); intensity = max(dot(lightDir,norm),0.0); gl_FragColor = toonify(intensity); // or use this line to get a classic lighting: //gl_FragColor = intensity * vec4(0.9,0.2,0.0,1.0); } " let toon_vert = " // simple toon vertex shader varying vec3 normal, lightDir; void main() { lightDir = normalize(vec3(gl_LightSource[0].position)); normal = normalize(gl_NormalMatrix * gl_Normal); gl_Position = ftransform(); } " let setShaders() = let v = GlShader.create `vertex_shader and f = GlShader.create `fragment_shader in GlShader.source v toon_vert; GlShader.source f toon_frag; GlShader.compile v; GlShader.compile f; let p = GlShader.create_program() in GlShader.attach p f; GlShader.attach p v; GlShader.link_program p; GlShader.use_program p; ;; (* main *) let () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~double_buffer:true ~depth:true (); Glut.initWindowPosition 100 100; Glut.initWindowSize 320 320; ignore(Glut.createWindow "simple GLSL demo"); Glut.displayFunc renderScene; Glut.reshapeFunc changeSize; Glut.keyboardFunc processNormalKeys; Glut.idleFunc (Some renderScene); Gl.enable `depth_test; GlClear.color (1.0, 1.0, 1.0); setShaders(); Glut.mainLoop(); ;; lablgl-1.05/LablGlut/examples/lablGL/texturesurf.ml000644 000765 000024 00000006356 12217024174 023271 0ustar00garriguestaff000000 000000 (* $Id: texturesurf.ml,v 1.1 2003-09-25 13:54:10 raffalli Exp $ *) (* Converted to lablglut by Issac Trotts on July 25, 2002 *) open StdLabels let texpts = [|[|0.0; 0.0; 0.0; 1.0|]; [|1.0; 0.0; 1.0; 1.0|]|] let ctrlpoints = [|[|-1.5; -1.5; 4.9; -0.5; -1.5; 2.0; 0.5; -1.5; -1.0; 1.5; -1.5; 2.0|]; [|-1.5; -0.5; 1.0; -0.5; -0.5; 3.0; 0.5; -0.5; 0.0; 1.5; -0.5; -1.0|]; [|-1.5; 0.5; 4.0; -0.5; 0.5; 0.0; 0.5; 0.5; 3.0; 1.5; 0.5; 4.0|]; [|-1.5; 1.5; -2.0; -0.5; 1.5; -2.0; 0.5; 1.5; 0.0; 1.5; 1.5; -1.0|]|] let image_width = 64 and image_height = 64 let pi = acos (-1.0) let display () = GlClear.clear [`color;`depth]; GlDraw.color (1.0,1.0,1.0); GlMap.eval_mesh2 ~mode:`fill ~range1:(0,20) ~range2:(0,20); Gl.flush (); Glut.swapBuffers () let make_image () = let image = GlPix.create `ubyte ~height:image_height ~width:image_width ~format:`rgb in let raw = GlPix.to_raw image and pos = GlPix.raw_pos image in for i = 0 to image_width - 1 do let ti = 2.0 *. pi *. float i /. float image_width in for j = 0 to image_height - 1 do let tj = 2.0 *. pi *. float j /. float image_height in Raw.sets raw ~pos:(pos ~x:j ~y:i) (Array.map ~f:(fun x -> truncate (127.0 *. (1.0 +. x))) [|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]); done; done; image let myinit () = let ctrlpoints = Raw.of_matrix ~kind:`double ctrlpoints and texpts = Raw.of_matrix ~kind:`double texpts in GlMap.map2 ~target:`vertex_3 (0.0, 1.0) ~order:4 (0.0, 1.0) ~order:4 ctrlpoints; GlMap.map2 ~target:`texture_coord_2 (0.0,1.0) ~order:2 (0.0,1.0) ~order:2 texpts; Gl.enable `map2_texture_coord_2; Gl.enable `map2_vertex_3; GlMap.grid2 ~n1:20 ~range1:(0.0,1.0) ~n2:20 ~range2:(0.0,1.0); let image = make_image () in GlTex.env (`mode `decal); List.iter ~f:(GlTex.parameter ~target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; GlTex.image2d image; List.iter ~f:Gl.enable [`texture_2d;`depth_test;`normalize]; GlDraw.shade_model `flat let my_reshape ~w ~h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); let r = float h /. float w in if w <= h then GlMat.ortho ~x:(-4.0, 4.0) ~y:(-4.0 *. r, 4.0 *. r) ~z:(-4.0, 4.0) else GlMat.ortho ~x:(-4.0 /. r, 4.0 /. r) ~y:(-4.0, 4.0) ~z:(-4.0, 4.0); GlMat.mode `modelview; GlMat.load_identity (); GlMat.rotate ~angle:85. ~x:1. ~y:1. ~z:1. () let main () = ignore(Glut.init Sys.argv); Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true () ; Glut.initWindowSize ~w:300 ~h:300 ; ignore(Glut.createWindow ~title:"Texture Surf"); myinit (); Glut.reshapeFunc ~cb:my_reshape ; Glut.displayFunc ~cb:display ; Glut.specialFunc ~cb:(fun ~key ~x ~y -> match key with | Glut.KEY_UP -> GlMat.rotate ~angle:(-5.) ~z:1.0 (); display () | Glut.KEY_DOWN -> GlMat.rotate ~angle:(5.) ~z:1.0 (); display () | Glut.KEY_LEFT -> GlMat.rotate ~angle:(5.) ~x:1.0 (); display () | Glut.KEY_RIGHT -> GlMat.rotate ~angle:(-5.) ~x:1.0 (); display () | _ -> ()); Glut.keyboardFunc ~cb:(fun ~key ~x ~y -> match key with | 27 (*esc*) -> exit 0 | _ -> ()); Glut.mainLoop () let _ = main () lablgl-1.05/LablGlut/examples/caml-images/ChangeLog000644 000765 000024 00000001337 12217024174 023125 0ustar00garriguestaff000000 000000 2002-09-20 Issac Trotts * main.ml: Added a check so we don't do the expensive rescale unless we have to. * main.ml: Fixed up the aspect ratio. * main.ml: Added rescaling to next highest power of two along each axis. Changed texture coordinates so the image no longer appears rotated by 90 deg. * main.ml: Added conversion from camlimages to lablGL's preferred raw format. In order to make the image a power of two, I truncate the image. This needs to be replaced with scaling up to the next largest power of two and rescaling the square to have the proper aspect ratio. * .Makefile.swp: . * .Makefile.swp, Makefile, OCamlMakefile, main.ml: Just displays a checkerboard at the moment. lablgl-1.05/LablGlut/examples/caml-images/main.ml000644 000765 000024 00000007544 12217024174 022637 0ustar00garriguestaff000000 000000 (* ciglut : a demo of using caml-images, glut, and opengl to draw a textured rectangle. Copyright (c) 2002 Issac J. Trotts. LGPL *) open Image open OImage open Info open Printf let width = ref 1 and height = ref 1;; let endl = print_newline;; let pow2floor x = let y = ref x in let i = ref 31 in while !i >= 0 && (!y land (1 lsl !i)) == 0 do i := !i - 1; done; 1 lsl !i; ;; let pow2ceil x = let p2f = pow2floor x in if p2f = x then x else (pow2floor x) lsl 1;; let i2f i = float_of_int i;; let f2i f = int_of_float f;; let raw_of_camlimg cimg = let w = cimg#width and h = cimg#height in let image = GlPix.create `ubyte ~format:`rgb ~width:w ~height:h in for i = 0 to w - 1 do for j = 0 to h - 1 do let pixel = cimg#get i j in (* pixel is a Color.rgb *) Raw.sets (GlPix.to_raw image) ~pos:(3*(i*h+j)) [| pixel.r; pixel.g; pixel.b |]; done done; image ;; (* scale the image up so it's a power of two along each axis. (IMPROVEME: this takes too long) *) let rescale img = let newimg = img#resize None (pow2ceil img#width) (pow2ceil img#height) in img#destroy; newimg;; let initialize ci_img = printf "initializing..."; endl(); GlClear.color (0.0, 0.0, 0.0); (* save the original width and height *) let w = ci_img#width and h = ci_img#height in width := w; height := h; let ci_img = if pow2floor w <> w || pow2floor h <> h then rescale ci_img else ci_img in let gl_image = raw_of_camlimg ci_img in GlPix.store (`unpack_alignment 1); GlTex.image2d gl_image; List.iter (GlTex.parameter ~target:`texture_2d) [ `wrap_s `clamp; `wrap_t `clamp; `mag_filter `linear; `min_filter `linear ]; GlTex.env (`mode `decal); Gl.enable `texture_2d; GlDraw.shade_model `flat; printf "done"; endl(); ;; (* -- ui callbacks -- *) let disp_called = ref false let display () = if not(!disp_called) then begin Glut.reshapeWindow !width !height; GluMat.ortho2d ~x:(0.0, i2f !width) ~y:(0.0, i2f !height); disp_called := true end; GlClear.clear [`color]; GlDraw.begins `quads; let w = i2f !width and h = i2f !height in GlTex.coord2(1.0, 0.0); GlDraw.vertex3(0.0, 0.0, 0.0); GlTex.coord2(1.0, 1.0); GlDraw.vertex3(w, 0.0, 0.0); GlTex.coord2(0.0, 1.0); GlDraw.vertex3(w, h, 0.0); GlTex.coord2(0.0, 0.0); GlDraw.vertex3(0.0, h, 0.0); GlDraw.ends(); GlDraw.begins `lines; GlDraw.color(1.0, 0.0, 0.0); GlDraw.vertex2(0.0, 0.0); GlDraw.vertex2(1.0, 0.0); GlDraw.color(0.0, 1.0, 0.0); GlDraw.vertex2(0.0, 0.0); GlDraw.vertex2(0.0, 1.0); GlDraw.ends(); Gl.flush (); ;; let on_keyboard ~key ~x ~y = match key with | 27 -> exit 0; | _ -> (); ;; let view_with_glut img = (* open a couple of Glut windows and display the file directly and via texture on a square *) ignore(Glut.init Sys.argv); Glut.initDisplayMode ~double_buffer:false ~depth:false (); Glut.initWindowSize 256 256; ignore(Glut.createWindow "ocimgview"); GlDraw.shade_model `flat; GlClear.color(0.0,0.0,0.0); (* GluMat.ortho2d ~x:(0.0,1.0) ~y:(0.0,1.0); *) initialize img; Glut.displayFunc (fun () -> display()); Glut.keyboardFunc (fun ~key ~x ~y -> on_keyboard ~key ~x ~y); Glut.postRedisplay(); Glut.mainLoop(); ;; let _ = Bitmap.maximum_live := 15000000; (* 60MB *) Bitmap.maximum_block_size := !Bitmap.maximum_live / 16; let r = Gc.get () in r.Gc.max_overhead <- 30; Gc.set r ;; let _ = let filename = ref None in let argfmt = [ (* "-scale", Arg.Float (fun sc -> scale := sc), "scale"; *) ] in Arg.parse argfmt (fun s -> filename := Some s) "ocimgview file"; let filename = match !filename with | None -> Arg.usage argfmt "ocimgview file"; exit(-1); | Some s -> s in printf "Reading in %s" filename; endl(); let img = OImage.load filename [] in let img = OImage.rgb24 img in view_with_glut img; ;; lablgl-1.05/LablGlut/examples/caml-images/Makefile000644 000765 000024 00000000507 12217024174 023011 0ustar00garriguestaff000000 000000 include $(OCAML)/camlimages/Makefile.config all: dc RESULT=ciglut SOURCES=main.ml LIBS=lablgl lablglut INCDIRS=+camlimages +lablGL +lablglut OCAMLFLAGS=$(COMPFLAGS_CAMLIMAGES) #OCAMLLDFLAGS=$(COMPFLAGS_CAMLIMAGES) $(LINKFLAGS_CAMLIMAGES) OCAMLLDFLAGS=$(COMPFLAGS_CAMLIMAGES) $(LINKFLAGS_CAMLIMAGES) include ./OCamlMakefile lablgl-1.05/LablGlut/examples/caml-images/OCamlMakefile000644 000765 000024 00000045272 12217024174 023735 0ustar00garriguestaff000000 000000 ########################################################################### # OCamlMakefile # Copyright (C) 1999-2002 Markus Mottl # # For updates see: # http://www.oefai.at/~markus/ocaml_sources # # $Id: OCamlMakefile,v 1.1 2003-09-25 13:54:01 raffalli Exp $ # ########################################################################### # Set these variables to the names of the sources to be processed and # the result variable. Order matters during linkage! ifndef SOURCES SOURCES := foo.ml endif export SOURCES ifndef RES_CLIB_SUF RES_CLIB_SUF := _stubs endif export RES_CLIB_SUF ifndef RESULT RESULT := foo endif export RESULT ifndef DOC_FILES DOC_FILES := $(filter %.mli, $(SOURCES)) endif export DOC_FILES export BCSUFFIX export NCSUFFIX ifndef TOPSUFFIX TOPSUFFIX := .top endif export TOPSUFFIX # Eventually set include- and library-paths, libraries to link, # additional compilation-, link- and ocamlyacc-flags # Path- and library information needs not be written with "-I" and such... # Define THREADS if you need it, otherwise leave it unset (same for # USE_CAMLP4)! export THREADS export USE_CAMLP4 export INCDIRS export LIBDIRS export OCAML_DEFAULT_DIRS export OCAML_LIB_INSTALL export LIBS export CLIBS export OCAMLFLAGS export OCAMLNCFLAGS export OCAMLBCFLAGS export OCAMLLDFLAGS export OCAMLNLDFLAGS export OCAMLBLDFLAGS ifndef OCAMLCPFLAGS OCAMLCPFLAGS := a endif export OCAMLCPFLAGS export YFLAGS export IDLFLAGS export OCAMLDOCFLAGS export DVIPSFLAGS export STATIC # Add a list of optional trash files that should be deleted by "make clean" export TRASH #################### variables depending on your OCaml-installation ifdef MINGW export MINGW WIN32 := 1 endif ifdef MSVC export MSVC WIN32 := 1 EXT_OBJ := obj EXT_LIB := lib ifeq ($(CC),gcc) # work around GNU Make default value CC := cl endif ifeq ($(CXX),g++) # work around GNU Make default value CXX := cl endif CFLAG_O := -Fo endif ifdef WIN32 EXT_CXX := cpp EXE := .exe endif ifndef EXT_OBJ EXT_OBJ := o endif ifndef EXT_LIB EXT_LIB := a endif ifndef EXT_CXX EXT_CXX := cc endif ifndef EXE EXE := # empty endif ifndef CFLAG_O CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)! endif export CC export CXX export CFLAGS export CXXFLAGS export LDFLAGS BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT)) NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT)) TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT)) ifndef OCAMLC OCAMLC := ocamlc endif export OCAMLC ifndef OCAMLOPT OCAMLOPT := ocamlopt endif export OCAMLOPT ifndef OCAMLMKTOP OCAMLMKTOP := ocamlmktop endif export OCAMLMKTOP ifndef OCAMLCP OCAMLCP := ocamlcp endif export OCAMLCP ifndef OCAMLDEP OCAMLDEP := ocamldep endif export OCAMLDEP ifndef OCAMLLEX OCAMLLEX := ocamllex endif export OCAMLLEX ifndef OCAMLYACC OCAMLYACC := ocamlyacc endif export OCAMLYACC ifndef CAMLIDL CAMLIDL := camlidl endif export CAMLIDL ifndef CAMLIDLDLL CAMLIDLDLL := camlidldll endif export CAMLIDLDLL ifndef NOIDLHEADER MAYBE_IDL_HEADER := -header endif export NOIDLHEADER ifndef CAMLP4 CAMLP4 := camlp4 endif export CAMLP4 ifndef OCAMLDOC OCAMLDOC := ocamldoc endif export OCAMLDOC ifndef LATEX LATEX := latex endif export LATEX ifndef DVIPS DVIPS := dvips endif export DVIPS ifndef PS2PDF PS2PDF := ps2pdf endif export PS2PDF ifndef OCAMLMAKEFILE OCAMLMAKEFILE := OCamlMakefile endif export OCAMLMAKEFILE ifndef OCAMLLIBPATH OCAMLLIBPATH := \ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml) endif export OCAMLLIBPATH ifndef OCAML_LIB_INSTALL OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib endif export OCAML_LIB_INSTALL ########################################################################### #################### change following sections only if #################### you know what you are doing! # for pedants using "--warn-undefined-variables" export MAYBE_IDL export REAL_RESULT export CAMLIDLFLAGS export THREAD_FLAG export RES_CLIB export MAKEDLL SHELL := /bin/sh MLDEPDIR := ._d BCDIDIR := ._bcdi NCDIDIR := ._ncdi FILTERED := $(filter %.mli %.ml %.mll %.mly %.idl %.c %.$(EXT_CXX), \ $(SOURCES)) SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED)))) FILTERED_ML := $(filter %.ml, $(FILTERED)) DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d) FILTERED_MLI := $(filter %.mli, $(FILTERED)) DEP_MLI := $(FILTERED_MLI:.mli=.di) FILTERED_MLL := $(filter %.mll, $(FILTERED)) DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d) AUTO_MLL := $(FILTERED_MLL:.mll=.ml) FILTERED_MLY := $(filter %.mly, $(FILTERED)) DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di) AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml) FILTERED_IDL := $(filter %.idl, $(FILTERED)) DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di) C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c) $(FILTERED_IDL:.idl=.h) OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ)) AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL) FILTERED_C_CXX := $(filter %.c %.$(EXT_CXX), $(FILTERED)) OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ)) OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ)) PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) MLDEPS := $(filter %.d, $(ALL_DEPS)) MLIDEPS := $(filter %.di, $(ALL_DEPS)) BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di) NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di) ALLML := $(filter %.mli %.ml %.mll %.mly %.idl, $(FILTERED)) IMPLO_INTF := $(ALLML:%.mli=%.mli.__) IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \ $(basename $(file)).cmi $(basename $(file)).cmo) IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF)) IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi) IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx) INTF := $(filter %.cmi, $(IMPLO_INTF)) IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF)) IMPL_CMX := $(IMPL_CMO:.cmo=.cmx) OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX) OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK) EXECS := $(addsuffix $(EXE), \ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT))) ifdef WIN32 EXECS += $(BCRESULT).dll $(NCRESULT).dll endif CLIB_BASE := $(RESULT)$(RES_CLIB_SUF) ifneq ($(strip $(OBJ_LINK)),) RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB) endif DLLSONAME := dll$(CLIB_BASE).so NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(OBJ_FILES) $(PRE_TARGETS) \ $(BCRESULT).cma $(NCRESULT).cmxa $(NCRESULT).$(EXT_LIB) \ $(RES_CLIB) $(DLLSONAME) ifndef LIBINSTALL_FILES LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \ $(RESULT).cmxa $(RESULT).a $(RES_CLIB) $(DLLSONAME) endif export LIBINSTALL_FILES ifdef WIN32 # some extra stuff is created while linking DLLs NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp endif TARGETS := $(EXECS) $(NONEXECS) # If there are IDL-files ifneq ($(strip $(FILTERED_IDL)),) MAYBE_IDL := -cclib -lcamlidl endif ifdef USE_CAMLP4 CAMLP4PATH := \ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4) INCFLAGS := -I $(CAMLP4PATH) CINCFLAGS := -I$(CAMLP4PATH) endif INCFLAGS += $(SOURCE_DIRS:%=-I %) $(INCDIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %) CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%) CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%) ifndef PROFILING INTF_OCAMLC := $(OCAMLC) else ifndef THREADS INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS) else # OCaml does not support profiling byte code # with threads (yet), therefore we force an error. ifndef REAL_OCAMLC $(error Profiling of multithreaded byte code not yet supported by OCaml) endif endif endif ifndef MSVC COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \ $(LIBDIRS:%=-ccopt -L%) $(OCAML_DEFAULT_DIRS:%=-ccopt -L%) else # currenly MSVC-build ocamlc/ocamlopt cannot pass any option to C linker :-( COMMON_LDFLAGS := endif ifndef MSVC CLIBS_OPTS := $(CLIBS:%=-cclib -l%) else # MSVC libraries do not have 'lib' prefix CLIBS_OPTS := $(CLIBS:%=-ccopt %) endif ifneq ($(strip $(OBJ_LINK)),) ifdef CREATE_LIB OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL) else OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL) endif else OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL) endif # If we have to make byte-code ifndef REAL_OCAMLC SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS) REAL_OCAMLC := $(INTF_OCAMLC) REAL_IMPL := $(IMPL_CMO) REAL_IMPL_INTF := $(IMPLO_INTF) IMPL_SUF := .cmo DEPFLAGS := MAKE_DEPS := $(MLDEPS) $(BCDEPIS) ifdef CREATE_LIB ifndef STATIC ifneq ($(strip $(OBJ_LINK)),) MAKEDLL := $(DLLSONAME) ALL_LDFLAGS := -dllib $(DLLSONAME) endif endif endif ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS))" "" ALL_LDFLAGS += -custom endif ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \ $(COMMON_LDFLAGS) $(LIBS:%=%.cma) CAMLIDLDLLFLAGS := ifdef THREADS ALL_LDFLAGS += -thread unix.cma threads.cma THREAD_FLAG := -thread endif # we have to make native-code else ifndef PROFILING SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS) PLDFLAGS := else SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS) PLDFLAGS := -p endif REAL_IMPL := $(IMPL_CMX) REAL_IMPL_INTF := $(IMPLX_INTF) IMPL_SUF := .cmx CFLAGS := -DNATIVE_CODE $(CFLAGS) DEPFLAGS := -native MAKE_DEPS := $(MLDEPS) $(NCDEPIS) ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS) CAMLIDLDLLFLAGS := -opt ifndef CREATE_LIB ALL_LDFLAGS += $(LIBS:%=%.cmxa) endif ifdef THREADS ALL_LDFLAGS := -thread $(ALL_LDFLAGS) ifndef CREATE_LIB ALL_LDFLAGS += unix.cmxa threads.cmxa endif THREAD_FLAG := -thread endif endif ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(OCAMLFLAGS) \ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS) ifdef make_deps -include $(MAKE_DEPS) PRE_TARGETS := endif ########################################################################### # USER RULES # generates byte-code (default) byte-code: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes bc: byte-code byte-code-nolink: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(BCRESULT)" make_deps=yes bcnl: byte-code-nolink top: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes # generates native-code native-code: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes nc: native-code native-code-nolink: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncnl: native-code-nolink # generates byte-code libraries byte-code-library: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" \ CREATE_LIB=yes \ make_deps=yes bcl: byte-code-library # generates native-code libraries native-code-library: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes ncl: native-code-library ifdef WIN32 # generates byte-code dll byte-code-dll: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).dll \ REAL_RESULT="$(BCRESULT)" \ make_deps=yes bcd: byte-code-dll # generates native-code dll native-code-dll: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).dll \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ make_deps=yes ncd: native-code-dll endif # generates byte-code with debugging information debug-code: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dc: debug-code # generates byte-code libraries with debugging information debug-code-library: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" make_deps=yes \ CREATE_LIB=yes \ OCAMLFLAGS="-g $(OCAMLFLAGS)" \ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)" dcl: debug-code-library # generates byte-code for profiling profiling-byte-code: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ make_deps=yes pbc: profiling-byte-code # generates native-code profiling-native-code: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \ REAL_RESULT="$(NCRESULT)" \ REAL_OCAMLC="$(OCAMLOPT)" \ PROFILING="y" \ make_deps=yes pnc: profiling-native-code # generates byte-code libraries profiling-byte-code-library: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(BCRESULT).cma \ REAL_RESULT="$(BCRESULT)" PROFILING="y" \ CREATE_LIB=yes \ make_deps=yes pbcl: profiling-byte-code-library # generates native-code libraries profiling-native-code-library: $(PRE_TARGETS) @$(MAKE) -r -f $(OCAMLMAKEFILE) \ $(RES_CLIB) $(NCRESULT).cmxa \ REAL_RESULT="$(NCRESULT)" PROFILING="y" \ REAL_OCAMLC="$(OCAMLOPT)" \ CREATE_LIB=yes \ make_deps=yes pncl: profiling-native-code-library # generates HTML-documentation htdoc: doc/html # generates Latex-documentation ladoc: doc/latex # generates PostScript-documentation psdoc: doc/latex/doc.ps # generates PDF-documentation pdfdoc: doc/latex/doc.pdf # generates all supported forms of documentation doc: htdoc ladoc psdoc pdfdoc ########################################################################### # LOW LEVEL RULES $(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(REAL_OCAMLC) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) ifdef MSVC # work around the bug in ocamlc -- it should delete this file itself rm -f camlprim?.$(EXT_OBJ) endif nolink: $(REAL_IMPL_INTF) $(OBJ_LINK) ifdef WIN32 $(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK) $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \ -o $@ $(REAL_IMPL) endif %$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(OCAMLMKTOP) $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \ $(REAL_IMPL) ifdef MSVC # work around the bug in ocamltop -- it should delete this file itself rm -f camlprim?.$(EXT_OBJ) endif .SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \ .mly .di .d .$(EXT_LIB) .idl .c .$(EXT_CXX) .h .so $(DLLSONAME): $(OBJ_LINK) $(CC) -shared $(CINCFLAGS) $(CLIBFLAGS) \ -o $@ $(OBJ_LINK) $(CLIBS:%=-l%) $(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) \ $(OBJS_LIBS) -o $@ $(OCAMLBLDFLAGS) $(REAL_IMPL) $(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) \ $(OCAMLNLDFLAGS) -o $@ $(REAL_IMPL) $(RES_CLIB): $(OBJ_LINK) ifndef MSVC ifneq ($(strip $(OBJ_LINK)),) ar rc $@ $(OBJ_LINK) ranlib $@ endif else ifneq ($(strip $(OBJ_LINK)),) lib /nologo /debugtype:cv /out:$(RES_CLIB) $(OBJ_LINK) endif endif .mli.cmi: @pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(INTF_OCAMLC) -c $(THREAD_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(INTF_OCAMLC) -c $(THREAD_FLAG) $(OCAMLFLAGS) \ $(INCFLAGS) $<; \ else \ echo $(INTF_OCAMLC) -c -pp \"$$pp\" $(THREAD_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ $(INTF_OCAMLC) -c -pp "$$pp" $(THREAD_FLAG) \ $(OCAMLFLAGS) $(INCFLAGS) $<; \ fi .ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: @pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ echo $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLC) -c $(ALL_OCAMLCFLAGS) $<; \ else \ echo $(REAL_OCAMLC) -c -pp \"$$pp\" \ $(ALL_OCAMLCFLAGS) $<; \ $(REAL_OCAMLC) -c -pp "$$pp" $(ALL_OCAMLCFLAGS) $<; \ fi .PRECIOUS: %.ml %.ml: %.mll $(OCAMLLEX) $< .PRECIOUS: %.ml %.mli %.ml %.mli: %.mly $(OCAMLYACC) $(YFLAGS) $< .PRECIOUS: %.ml %.mli %_stubs.c %.h %.ml %.mli %_stubs.c %.h: %.idl $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \ $(CAMLIDLFLAGS) $< @if [ $(NOIDLHEADER) ]; then touch $*.h; fi .c.$(EXT_OBJ): $(CC) -c $(CFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ $< $(CFLAG_O)$@ .$(EXT_CXX).$(EXT_OBJ): $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) -I$(OCAMLLIBPATH) \ $< $(CFLAG_O)$@ $(MLDEPDIR)/%.d: %.ml @echo making $@ from $< @if [ ! -d $(@D) ]; then mkdir -p $(@D); fi @pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ $(OCAMLDEP) $(INCFLAGS) $< > $@; \ else \ $(OCAMLDEP) -pp "$$pp" $(INCFLAGS) $< > $@; \ fi $(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli @echo making $@ from $< @if [ ! -d $(@D) ]; then mkdir -p $(@D); fi @pp=`sed -n -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \ if [ -z "$$pp" ]; then \ $(OCAMLDEP) $(DEPFLAGS) $(INCFLAGS) $< > $@; \ else \ $(OCAMLDEP) $(DEPFLAGS) \ -pp "$$pp" $(INCFLAGS) $< > $@; \ fi doc/html: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(OCAMLDOC) -html -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) doc/latex: $(DOC_FILES) rm -rf $@ mkdir -p $@ $(OCAMLDOC) -latex -d $@ $(OCAMLDOCFLAGS) $(DOC_FILES) -o doc.tex doc/latex/doc.ps: doc/latex cd doc/latex && \ $(LATEX) doc.tex && \ $(LATEX) doc.tex && \ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F) doc/latex/doc.pdf: doc/latex/doc.ps cd doc/latex && $(PS2PDF) $(+>+>-E2@.B0@.@.B0B0B0@.E2B0K8B0C0C0I5D0F3J5D0D0A.>+@.@.>+>+@.C/E3@.@.D0F3A.A.H5A.D0E3A.C0B0D0G3J6J6J6J6G3G3M8M8J6J6J6J6J6D0>+J6L8>+@-G2G2J6C.E1C.C.C.C.C.C.C.C.C.C.@-C.C.C.C.C.@-@-C.@-9(C.C.9(9(9(C.>+>+9(9(G39(9(@-@-9(9(G2A.G3M8M8M8M8M8S=M8A.A.A.M8G3A.M8M8G3M8M8S=M8J8P9P9O8S=P9J8G4J8C1G4P:XCRiJ\Bܥڤݫߩߧ߫߫ߩ߫ϞaF[BWAQ:SSU?SX@WAS<[BWAU?SU?Q:S/D=*JE1z^{cyשĖȘƖȘȘ̜ȘŒŒŔŔŐĔŒŒŔŔȘ̜̜ʚƖĘʚ̜ʚʚ̜ƖŔĖŔ”Ξ}_؟٣١١ڤڤܧڨ⭋nެ”Ė’ĖÖƘÔǓĔȘØՒƘƖȜȚƒƒʚۭ{nr[D--&زĔȖƔҭBB?٩ƔР沇ƞvmQw]FpmXí˗ǜȖĒƖĔƔƖΛƘȘȘȚȔʜƖƖĚƖαƔʗϜ՘w_ĘĔ”ǕuȬ{ĘÖĖ”–’ѵ~ѯn`EnQsrfrØĖĘѴ䯈mݶqΤ~b–ݯv’’ŔŒƖŒŽŔŔƖ”ŒŔȘŔƖŔŔŔĔĖՔՒŌŔ̸̛laF0.PN?*+" #BB6`ZFc_HJG2HJ8ocOgbJf`IgbJb\GCB*B?2b[E:9'=<,TT=-[P>}\ƘŔƖĖƘȘȘŔŔƖȘŔŔŔ”ŔĖƖŔȘʚƖŒŔʚ͜f߫۬߫߫벘hѥʖƖŔȘȘƖĖȜƘĖŔƖƖĔĔÔȘʚƔȻf͙é}jTtjUaԥ’Șƚ–Ŕ˗qͷĔ”’ȘȘƔƔƒƔȘƖʚȚƖŔʘŔȘƖĘĔpcUРm’–֜rə꿑`թ͛mcK٥’Ėޱע|_ܭØĔƘ绍֦٥yrbwfدqft͢mVѬva߻Ǟ̢AJ<қƑ岈뽑住Τ{’”ŔŔŐŔŔŔĖŔŔŔŔŔ”ƖƘ٩jybxaowxv}}]woUvsV{u]|^hfeigggegg}bx^{w\zt[}s\y`{w\{w\tkWqlQgbJidIf`I]U@VQ<<=.D@.ؾ”ĖĖŔƖŔŎŔŔŔŔŔŔȘƖŔƖƖȚ”ŒƖȘzݩڨ嫱tʚĖ’ȚĔƖĘĔƖƘȘŔĘȚƗ“ȖդSJ;ީĒϜԟ՟ƖȖȚŖ’Ɩ̰•幑߯ײgG2˫ʖĔȗĔĔƖƔŔǘʗƘƙŔƘȚʚƚƔŔƖƖĔĒ’~ޫä~ƕƒƖɜ֨pT˚~nĒ۴’ƔȜc{jѿh̞ƔƔͼJH;췍ͻlwd뻋wѪ縌xӨs٫ĒȘe~Z]Ңu’’””ŔŔŔ”Ŕ”ŔՒ’–ȟ~|nT ~dhh72!w_pzxuh{_kwwqmqqoojkjmjkj{`{`~u]x^vq[tkWtnTmhMmiPf`Ie]I('wע’ŒŐŽŔŔƖŔʚŔʚƘĖȚĘĖ̜ʚƖȘ̜ʚϞp߫߫ݩ߫寱t͙”ŔƘĔÔĖƖŔʒʜĔ˜”ԤƖƚȖĖ’ƖƘ̱z\eeKlʔԪPC3{ehfɚĔԔĒƔŽƒƔĖ–ƖĖŐ˞ƔĔĖۮ~kSȘĔ–ƚѝmîÖϤvٮvbk꾚ƔȚ”ŔȚ›ѩɞmŚ̢jhWɚxֻΟ}ƣv^Ŧw̫Țqi’Ė”””ŔŔŔŔŔ’ŒŔ”Œ”ŔĖգeX?  q}q><2yZkpDZ©}zt{zyvvvvtslsrmij}az_w_vpXvpXojMfcIb]JXT.s]ۦĖƘʚ̜̜̜̜Ŕ̜˞ʜȘƖȘƘȘq؟٣ܧڨڨݩާڤ婿ĔĘĖƚ’Ɩ”ƖƖƘĔƖĖĖƖ￐߯tJ{ƖĖƚƕƚܸɚȖƔɓȚ˜ȜЛ̚˞˚ĖŔ’Ĕ””ƒƒƔĖƘʚȚȘĘԢp`Mʙ̛خtYk϶ҼצƖĘȚÔءRD;aM;ĕΛ߭ΤiVا˗æݿbPÐoేđžíbe쫈oץʤװ’ŒĖu  >:'xbKÝ̬ŐĒȖ|RM:ŚtZ7:.`VD˝jdK7-'FB4͟ėukU'!}pXtԷzؽVO>zyDZîêêDZDZDZ|yytqmlg}e~u]umWumWqiTjdMgbJgbJf`I`\Af`Ih_KFA2;5(໔ТƖȘƖƖʚ̜ʜ̜̜̜ȘȘʚҝaڦڨ߫ڨڪڨڨݩڨڦߧ஬rөƒŒƚĔĔĘƖƖƔŔ’ǔgGEAʣǕĘŔʜ”ƕ~͗ĒŒēƖĔ””ȔŔŒĖŔĖ’ŔŔĐ”ƖĔʘȖʚȘЙ}ǡȖ٫mFŢeϼ䥿اtO<ȩđȘ’ŐÔiSǠ͞ËơmٰIJĠi֠Ԟ㸉y`s{[h٪uΡ{jQ7nĔĖĒĖƖƚПΚϜ HC984%-,$5-#ܬ֛ҟա֢Țm~ᱞ|znfJQN@ytZϻC?5̞ŜӺ̥ʜ©ҹպ{Ժ̵̵Ū|^riDZɳDZDZDZ|zwyqomlg{`}s\soUtkWnhPleKkgPe[Ge]H^YFfXCVP=:7+vXެʚȚ̜̜ʚʚ̜ĘƖ̜̜ƘϞ`ߧߧڤڨߩܥܧڨݩݩ㬐j٪Œ”ƖĖŒȚƒ’ĖƖŔȚƖĖÖ峮wrgď”ǘҝY?)dzƖĖƖȖȘ’ɕĖȖ”ĔĖ”ĖՔĔÔĔƘ”ƖȖƖȔŒɗțǜqTԤĖz٨ilxܸŏlܯɜƖȘĒȜ{lTзŔ”’ɛoēϸɪhJϡndD}ƙu~Ӥ{n⹌j{eѡŔȖĖƘĔĖƘƘ””ɜrTQE8OG9YK;m_J\Q=l?7,95'PF3_XBZN7ZK7UL7A8(ZR@F@.QK>SL>'k֦Ț̜̜̜Ӡћ̜ƖĘ̛zڤڨ٥؟؟؟٣ڪrv`ا֒ȘƖĔƖƖĔƖƘĔƚȘƘĒȘӠzřsœĔĒĖȚȚȖseK֤ԝ˗ʚŔŒʚĖŔɑĔ’ƔʜȖȖƖĖƔĖƔʚĘÖ˜Ș͜ƖʚƘȚƘџZXPòƚڱmudƔ‘ܥiaN֡g]QrǘݵŖĖОnȳzby`p`Yofk鶐?*no}ٵ{ѰÚŔ’’ĖŔ”ŔĖ–Ön[D           -) 44)77,47(11#') +0 76'<<214$%((()-"  -)צØɛԴxݽܿݽzȥؾڼҸ~ԺҹϷëhsxwythee}vZ{w\uqUrlPpjPqiTjgJjhMe`Ee[G`[CFH7[O:Ϥ͠ƜȘ̜̜ʚƚŔʙrڤ١١ڤ٣١ڨڤur[ܪ’–ĖŒ’ĘƖʘȖʘƖ’ĔȘTTMӯΝȘĒʚȚ̛ˠŚƼΞʚȚȘȘ–ĖƔ’ÓĔ̚ʚŒƖŒƔŔȚʚʚΛȘʚŖȘ̛ƖƘʜʚȚȘŖڿĘϤhѺzȱŒ}̛yંveПƔרqiUƚoǨ{{]ެz{a˜rӪ~hcҫçurö}g̐Ŕ’ŒŔŔŒŔƖƚƘŔŔŔĚ˞RM;         !!+-;B0KK;KKAKSBHK= #     rܯtX˝ǚּƙӸƙØݾ}ɮҷڻҹŬɳîǭîz{zwrkhge{w\vpXliJleKjgJheKf`Ie]H_Z@^XC43%ӤƚȘȘƘȜƖ̙w؟ڦڨڤڤڦڦܧu{fڬ”’Ĕ–””Ø–“ĔƘȚȚƔƖŔϢԜĞŖښȘʗΛƘƚٮh]H@rȘĒĖŐƖȘƚƘŔƖŔĖƘŒÖƖĘŔŐĔƖ”ȘĔƔƘȚǜʚƖʚ˞޷aTE١ў|b޵̳ӟ^wѱ|nץʛyߺǽweQ֛⻝p|u޸ۭkʵcɰ}bQݲcvusS͖ʔ”ŒŐƖ’Ɩʚ̜ŔŔ’ĖĖʠcR>                   i̞ƜҡƯyaʞƙƙƙƙƙƙ߿߿׻ҹϷ̵DZϷϷ̵DZî|~|wqe}dxbzqYqiRpfQjdMf`Ic_H^XCVU=ZWC8:(}c̠ĘƘ̜ʚʚӠrߧڨ٣ڤ٣ڦڦڪڪt|bݮ’”Ő’ƔĘŜŐƚƘʜȚʚϜd3'H8"đӠĖȘڦsOWRCͯƠȚɑ̜ԝ̜̜̜˜Ė”ĖĖĖ–Ș”ÔĖƘŐĖ’ȘȘĔĘŐƖĘƔ—oβ֞ک^\Oⲅа^幐fJ~kƓ›w஄⽋۞|cǙmҨhN콖g̠|q_ЦЫ szaLǜʒ”ŒŔŔŔ”˜ͣp                          q;;.ӥǚˣƜǖƙƜƙƙØØØ߿ݽݼ׻Ժ׻ҹϷɳDZê|yyvofedu\xpXumWkfNgbJe[GZWCWWCZWCSS?I=3ؾʘĖƖȘўjݫݫڤڤڦأڨڦݨڪܧu{fƖ”’ĔĒƖʘĔȖĖȘȚɓȘƖɕ/"뻍\@XFI6u`٤̘̘صwpYmbIРȘ̙Ő̚ƘƚŒƔ–”ƔƘŔĖÖƔƚɕĒĔɞ͜ȖȘȘđִ{npXɤʚ௓sR丐|isu绌wb|ްǖɜƧzƖНӺԲԷơUIBȺݶSTOV`UwaMͳ{`ƹwթĖŒŔŔŔŔŔŔĖŔŒѧp                              snXu\uݿj?7%phTץӢܿƖƙØØؚ߿ݼ׻ҹ̵DZDZ|~{zyvrjfg}bsoUmhMe[Ge[GheK^YFaZFYS=`[CGC1t֧Ɩ̜Ϟs۬ݫڪڤڦڦڤڨڪڦڨwyeܪŐĖĖ’ŽŔĖƔȚŔƚɞʚʚҤ@-eLwI5x[=+ǜƥ|~g̥A/աƖǘŖ͞ƖĖȚ֔’Ɣ–””ȚȚΛƘȜ”ŒȚƖ”–ά|{gŕ{ћТuɞڸalSģšfvЛⷊxӥ˭ͤϟbK:ۻѴȯnԯȠdm_ŵF?4^[L彈’ĖÖĖ’–ͥyc                                  QO<رҟէdj:0#ѧXM=ʹϞӨԡǗƙƙƙØƙØ׺ҸDZDZî{ytmljey`tnSpfQkfNheKheKecFc[CZV@d^DJ@0wtVۭ̜ћyܧ߫߫أأܧܪݪ߫߫ߩe‘”’’Ɣ”ȘŔƘĖƔƖȚȘƘĖܧ@/O;pZ@-=+ԡĒԦhfYPSBC;.ϡĖ’ŒŐƘ’˜ƘĖƚƘŔ–ĔĖ˜ʚȘȚĖĖƚ”ÖĒƘĒƖ”˚z竳vӛ뼏qĝըstН~{pfѾoX|Yz”ɞػ:5)ƚЭÜŧØ亓knxo`qgZฤpɜ–”ĔȘÖv                                  (( ЮpdLɚ֦תoTΡ˜Λɖƙƙƙƙྒ߿߿ڼϷ̵DZDZîêǭ{tqiiecvpWmiPmhMheKjgJgbJ[XFb\G_\JQO;b\Bۦ͞wڤߩڨݩݬ߫ߩ}b’ĔƖĔĔƗƖȘȘȖĔȜ˗Œة4&>)݋jt8(פĔʜʘȘ̩ϥЛȘȚʚÖƘƖĔŖ’ÔƘ’ē”’ŔƔŒ’ɘ̖ȘȖv}עg벇޳êϙl{e{g՜͠{Y̵֪̱d{dyv͡ůuȖ|ط.(!:5-ԭmP٦–ȚƖ”šr                                        ֩ԡəԢաۭJ>(КʘΛ̛˙ƜƙØØݽ׻ڻԺҹҹDZ|ywtmfez`~u]wt\rmWf`IhfMf`I^XC]ZCXXFTS>gYC֧yߧ۬ܧ۬ڨ۬ڬݬ߫߫^Ɣ””͜Ĕ”Ė’ƔÔĒĘȘƖƖĘĒŘĔÔު0"څfbHeaJ=,ΙĔ˜ƖƯ̏Ț’ȘȚƒǘŒĖŔĒƘ–ƘƖÚĒƔėĒ”’ĔÖĖĒȘȘȘƔÖʖܮtĒŖxfjW<岺eǞkWƘпʜkțpƙ~jeOںv]ԲuXnN֯zƖŐĔȖŒǜt                                             eXBt֞עѡӢԡԡԡԡԡ͠˙ɖƙƕڼչҶ̵̵î~yyqqc}de{cvpXnhQkfNkgPhgPe]HaZF^XCd^DUQf`Irܧ߫ݫݫڤܧܥ߫ஜq߫ĔŔ”Œ’ĔȘĔĖĖƖǘŔƖȚ”ȘƖȚݪC0=,{~WB:)ÒĔĖŒĖƔŔƒ͜Ė̛ŒŔΛ’Ɩ’’Ɩ”ĖŒ”ĖŔŒÖȘƘƖƖƔНɓgխҨ}dHխzŤynج«ƞ}bاĕܹа  ̣Ӹnɚsⷭx×sZq䴨ɘĖƖƚƖ̜–Ŕɛq                                           :=,ܱա֛ڦ١ޥԡҜסҝКɔҝɘØØØƙØݺںԺ̵DZDZ}zwsskj{`|qZskSmhMe[Gb\G^ZBaZFt߫ڨڨܪܥߩ߫ݩ寪sإŒŔŐƘĘĐĖƖĖƘՒʙƖƘƘĔȘƘĖݪ<+뭉D7XDdK=+”ȖÔƔȘȘ̜ʚȚĔƚŒƔĔ’”’’’ŔƔƖŔĔŒŒƘŒĔȘĘŐפbբ⸉nɛXʟvX͞ԡ}_ėƕۣzʙlѸVQ@}xb}v_w`rn٨wx\JΗܿ͜’–Ƙ˜’”–”Ϟ~                              &#ԯסڤ١՜סעԡКККɖ˙ɛƙØØØØƙݽݽ׻ҹɳɳDZ~{vqllc{bxvZpjPkfIkgPe]Hf`Itݫ߫ݫ߫ڨߩڦߩڦݫܥߩషyșĔŔƖƔƔŔƖʘƔ”ĔĔŒ””’ŖŔĔݮQ16(r<,=+Ə–șƕʚ̙ĖƖŒĒĔ’ƒĒĔȘĖ–’”Ė””ŔŔƖĔƚȘĖƖĜОcכuubHu|ĪǘhKػwTmϒϪ~ͩڦztש~[ɣ%ׯdҤA:0⼖F;.ft˥ȕӛƘ–ȚĔ˜Ȝ–”–”ț                            ƹڤڤ֠؟֠ԡԡաأҟԡΖƙƙƙƙʞ߿ҹҹҸɳ{yrofcy`unZskSkhSkgPf`Ioߧ߫ܥ߫ܧڨ٣٥أݩڪݩڨ߫|Ɩ”ĒЖʚȖƖĖ”ĔĔȘ’’ĔۥV9lQufNM=7&Ė˜ȘȚƚĔƔȖȘƖĖĖ”Ĕ’–Ĕ’ŒƘƖ”’ƚƖƘÑƘĖÖȘƖϟM:$ͲϨͥϙݼ|Ô^l鵌‘߹t͚㰀ݯ--&ɢrpU<1ȹĒo}͠v^JⱅƖĖŔ–ĖŔƘ                       ݦءס؟أ֞ס١إӠԡКԡŗƙƙØƙƙØƙ߿ݽڼҹ̵ɳ|}rqmcy`}tZvpXojMlfLvݩ؟ڤ٥ݩڨڨڤڨߩŷ㿌ʚƖƖɓƔĔƖƔȖȘÖĔ’’–ȗߏhdIkfQ{])’ʚȚȚƖȘĔĒđʘĒ””’Ĕ”ĔƘ’ƘȚĖ–ƘƔ’”ƖƘĖƘ̙ÖĖĖƘƖĖʚ~fЮJC,n[迕Ĺnge\߹rZ~UѢəʗqVőΛlSzaǨkbUmv#&!ǭ~ỐϜcңŔƔ–ŔĔ$# !             }ڦ؟סڤעڤ֠Ҟԡԡҝ͝͝ԡȚƙƙØØØ߿ݿ׻϶ɳî|zysm}dx^vpXwsYrlTm֛٣٣٣ڦݬݩڨ̚ŒʚʚƔƖʚƚƔĖ’ŔƔȖ”’”ѤgI=.--}٩ȘĘŖ’’ʚ̜˜ʚȘʘƔĖƘ’ƖØȖŒȘȖʜĖĘÖƘȘ–Ė֔ĒƚĖĒĖȚƘĖƘƖĖʜʖvWmvaܫx\ֹƙ{vݦloŚaڱrU֣uЛŕ-#ذ:0!q̾"9ճyrafraʧ}ĘĖƚƖ #%   !#     ]]I߭ڦڦܥܧڦڦأأաԡԡҝ͘˜ŗǗƙƙƙƙØݽҸ׻̵®zxqmg{a~u]xrWx؟١؟٦ڪۥݪߩݩĘּʚŒŐĖ’Ĕ–ŒŔ’Ž’Řׯ˟”ƖĖĔ’ŔȖƖǘ̜’’Ē’Ė’Ė”ƔƘĖ””ĖƖĖĖŖ”””ĔĖĖƖ˚ɴyvpٴǘınPȠhUBѷĖə{Øͥ}դɻޣȝΤǥ͵! fZDrѯƢڿs“ĖĘÕ­! $"'%))""!#! # &"$"$"!   ""$#$#$"$"#"   # &#$#=8-ڦݫڪܥ՟ОԡԡԡԡϞԡϞɔɛƙƙƙƙݽڼݽ׻ɳDZ}{wqmg{b~u]wћם٣ڨڨڨڦܧ’عĔĔ’”ȘŒƘŜĘƖ’ŔƖ’’–ŔŒƘē˜Ŕ’ƔʚȘĖȚʚʚȘȘ’’ʜĔĘ–ȘĖƘŔȘ”ĖĔƘƖ̜ƖƚƔȘƖƖդ?4yОƥ}_Ẏy|ϣ֤꿑Önצگ˜᫊qUTO>RP<{ޱkpbO{qRs켓ﶉ¦ª}ȚĖ”͖è &#$&#%(')))* ,*!)),*))))))'%'%%&('$"))('&#'%!('%$&"&#  '%(')))0")*"))('..&'%('&#$## ('$#$#$&$#('))$#""%%! #!94*ڦݫڦڤڤڤߩޣܥդҢООբբբТɝƙݾԺɳɳwxtlhjx֛߫١ڪڤڤڦڨڨߧ¹Ҿ”ŐŐƖĚȘ”Ɩ”ĔƖĒĒŔŎ–ĖĖƖĖĖŔʚ”ƘȘĘĔƖƖƔȘƔ”Ė”ŎĔĔƔȚʚƖȘƘƘ’Œ”Ē”Ɩ’ĘŒŔƘĒ’ȘȘݦXE7ʪ|}届ɖskTpÛqtŘբuYǗk|t mêԶʓj89+ukWᮇƒtՠĖ–ȘŔÕt '%'%,)++,*!/*)),+/*,+63"))&#(''%))%(('(''%,,))(''%'%$#'%$#(' &('('%&/*('('+',))))))))))))),)))'%$#))))'%)))) #!))))'%,)'%('('%% " ! !(),?:-ܲަڤ۬ڦݪfJJ854&URHUSAWPA[T?ebKtjTpfPYS@f^M_ZEojRtpUkfOݾڼ̵DZDZ~yyqnizأڨܥڪڨܥۥڨ᩺’Ö”˜Ô””Ɣ’Ĕ”’Ĕ֒ƔĔĔƘ”ȗƘƖŒȚƕĘǚŞĖȘƚĖ’Ȗ֔ÔȚȘĖʚƖƘȚĒ’’Ĕ’ƘĘĖƘŒ”ĒƚƖΙsschGŸ~^kﷅ뽎lʸ͗Ʈok̶ȚͦyV:˯ҰE=3ټⶇﻉ׵98.u]Iv÷ֻ”ƘĖƘ̰,*,*)*",),*00!-3$3.!0/,,,)/*,)('0- ))('/+))--",*00!),('$#))))('('('(')))))-"))00!30",,35#0- ),,*!0/0-!))))0-#,*,*,))))),)()%% 0- 36#,- 40")-"))(',,)*")* ,,)*",+,,)/ %%,.(+*'ϥڦڤJC9(% 12#98)?>0JGOM5?I5,+"ʞڼԺɳDZî~ytnoڨݬݩܥ߫Ŭ齐ƘĘŐ’ÏÖĖؒĚȑ–ŚĒƘĔĖƚ”ŽƖĔ˜ĐĖĔɐƚƖƘĒؔÔʚȘƖƕ˜ȘȘŘƓʜƖĖ’ŔĖƒ˜ĒĘÔĖ’ƖĔƚƖۭؔƖȘtwa֜ɞlҼ—6- ƒʢhTֲПڨlқ˛y˜qݲ ̝ϭ46*4(ͩz̮鴌ĔĔÖƔỌ̈23$3.!00!-0!,/02!33"74$63"63"87'3-!33"3+ 0-#0/0- ))0- 33#71#3-!87'30"--"00"))+(0+",*/*00 ,*,+)* -.$58*87'63"74$27(98)02!87'74$/-33#57'27(40"44%54(6- 0/33#87' 43#98)98)68*98,10#30"22(52'74$57'22(98)16%:=174&87':9,33#%"أVN;43+68,10(83(52)76*64';;,88)FF6ZSCVR@RR=SO=_\GPI3ŜݽԺϷDZî}zyt߫ڤ٣ߩ⭼|ǐ”’ĔȖƖȘŐŔ’Ô’ŖŖƖ”Ƙ”ĖĔĒĖĒĖȘƖȖƚ˗̚ĖƘĔŚŔĘĘ̗ĔʙؖƘȚʚŔŒƒĒƘĖȘƔʚƘȚʚÖĖƖʘȘȘ٬7,ӥĔƘĖŜ_^U~b̙Ƙ׷ӰP\Qɛ~ݫݳְ~hMѯͷL4#˽ѳb^I⼓pŗƞŝvߴƒ̜ĔРuo\*)68,76%74$74$%$00!44%3.!98)98)87'98)76%76#76#3-:6&84&40"74$54&6+63"60!0+"/*0-!),3+ 30"3-60!6- 71#3-!30 63":9,:9,54(84&?<+98)98)57'76%:9,98)87'87'98)87'D@->;)98)<:+>=-,.:9.98)98):9.<;.?=-?=-;:)?8+;9'<:+;9'><+;:+?>2<:+57'98):9,98) ⯃j770CC6HG8JI:FE6EG8KK>JI:LL9LLb[Eb]JIE5ȵڼԺϷDZDZǩ{z¬ߩŭȗŔƖŒʚ”ĖƖŔĔƖŔĖƖƘŔŒȘʔ”ŔƖȕĔŖȘȘϞ̚˗’ȘʘĔÖĔŔȖƔŔʜʚƖĔƖƖĔȘƔ””ȘƘƖƖȘȚפlrcRɚŔƖƖʜ٨gּǥMJ>ŜʫvիݴdX?ഓzi[>۵͚{jP仒Է޸MI2њ‹|nլȒƔƖϤngN&'&(79'87';:+?=-;:+:9,54%<>/<:+DB1<:+;9'?<+?=-A?-?>0A?-FD1AC1>;)87':9,63"98);:)87'76%76#87'98)87'98)98)?=-A@2<;.?>0>;)A>+?>0<:+DC4A?/DB1HG8<;.CB176*DB1A@2FC/A?-A@2HG5DC4FE6JG:JG:87(?A/CB1CB4DC4FD3FE6FE6HG8JG7OOD1EE8JI:HG8JG:LIXUCUUC]^J_\GhfMgdO670ÜØݽԺԺԺɳ}۬䭾{ʝŔȘĖȖƒĔ’Ē”Œ’ƖŒ’”ŔƘĖȖ”ĖƖƚƖʘƖ˜Ŕ”ȔɜʙƖ̛ĖƘȘȘƔ’”ĖȘȘŒƖƔŘƘȚȘŒĘĔƖ–ĔŔĖƘȘĖȚΛȖĖܮB6#ŔȘݮE;+ŕsUƙӸ{x[mkݼСGKDűթz\ԩ㬆CE6QMC voZў{봋uѠѦҾqdN+.%d`L2/!VR:A>+FH3JG7HE8D@-AB.CB1=:+@<.=;'==-?>+LG6FE3HE8FC3JG7JI7HE3FB1CB/A>+A?-?<+?=-?=-?=0AB.D@-FC3FB1A?-A?-AC3HE5FB1HE3JI5FC3FD1JG7HG8JI7OO>NN;LK9LI7:8'EA/NN;QP9LK7MI7JG:NN9NL;QQ>QP;OM?72'LIUUCVQE[XFWWCWWC`^HaZFYX@\XGWV@[XFTQCQN@SXJ-2&8;+GJ9JG;GJ8CE4FE6EG8NRAPM=TQCUUCZWCXXF[YDYXDUUCXXF_]J_\GQQ>21(ÛØ߿Ժ׻̵̵î˱߫yϠȘƘŔȘŔŔŒĖŒŒĖŐƖŔƚʚƖȘƖĖŒƘƖƘŔĒȘȖƖ”ʚƖʚƖȖȘƘȘƔĖʜƖƔȘŒƘȖȘȚŽĖŔŔƖȚʚ˗ȜqnɚĘĔĔĖҢ`M:Ř֬r\K巾aTHv굌èwPZQA뾐ԲFE4ĔŚݵ#"kg\|m`گ}Ѿwa1/"NF5wo\fbN8+!UPBWV@C@+LK9JI:LI7JI:HF1JG5QI6JI7JH5OL6OK7SP:JG:JI7LK9QQLLUUCNN9QQQN8NK;WWCUUCVU=UQ=WTE92+Ҿ˜ڼ׻Ժɳ̵ǭ͵ߩ߫ߩ߫yȘʘƖŔĔ”ŔŔŔĖŔŒŽĔŐƖƖƖ”ŔȘȘŒĖŔŖƘȘȘʚȘȘɜƘȘȘ”̜ȘŖƖ’ƖŽʘʔ’’ĔʚƔĖƔĖ>9(ݳšȚȘƘȜȔ^eۮ ݵiڻΤɦTK?yOL@ӟѸ&(ȡ–ΞscOeWG_PAiI?,TE1DG8dX:a^Gb_G/, b\I=;)WWCOO>SR=]WAY[ITT@HC5UUCKE6JH3SR;ON:RPAWV@FD2JJ;TS>TS>WWCUUCQP;NN9QP;QP;VU=SR;QP;VR@VR@VU=WWCSR;TT@VT;TT@^XCWWC^XCWV@TT@VU=WV@XXFWWC]^JHD3\[I\XGCB2HE8\YJaZF[XF[XF\[IXXFWWC[ZDb\GgbJUP:gdO_^H_\Jc`Kf`IkiVkhSkhSniSqjVqjVqjVhiVnjVc`NNJ8]V>olWhgPjeOfaKjfRgeRTVD21!EE6IILLTQ=[ZDWV@TT@XXFWWCTT@WTEZWCGF3ݾ׺ݽɳʯеߩ⯱vȗȚʜƒɜȘƖȘƘ”ŔƘȘĘĖĘŒƖƘ’”ĘĒĖƘŔ̜ɚȚƓ”ǚĘƘǜĒƘƘÔŐƚÔƔȘŜƚŒ–Œ’Ŗ’ƘƖȘȚɓ̞љ~fǓȘĖƚŒŔĔ{QK8ɶ gџ䲆ŕԸv ֣㯀sطȲøÜvիua?ѼgdTrr`+%zpVBD&ZZCroRnfQH@)hdIf`IiaKe]Hb[ESO8f`I_WBgbJaZFRM=ZWBJE2jdOON:SQ?ddQLK:_\GVU=JF2gbJ`_K_Z@XXF^XCWV@]WA^XC[XFXXFWWCWV@[XF^XC[XFZWC^XC^YFf`Ie[Ge]HjdOb]Je]HhfMf`IkgPNN;c_HieL/.!WS@lfLidIkfNhgPhgPhfMgbJSP;njVhiV]ZDa[FniSniSkhSnjVqjVtkWniStkWvpXwt\xvZsoUxw\HM>GD5cfPtkWvq[xw\wt\vpXrmWqjVmiS;;.VXGJI7GE:HF5DC4KN;RRALLXXFXXFXXF``NnjU˛ɛƙڼҹ׻̶߫ݫڪڤ٣ܥߧݩݫ߫ƲŚȖȘŘȘƘƖʙƖƖĖ’ŘÖĔĔȚƘƘƔȚÔÖƖ˜ĘŔȘƕĖƚĘœƖ––ȜƔȘĖĔ’ĔĔǔǜ̞̞Ŗ̛˞Ƙ˜ϠƖȖƘΘ͚Иʚ#ΩŖĒƘĔƘƘ–BB?ͼ͞}sbK䷒ΟƬʞդ{\ŞxgRƚy`dzes2=1sdW&)mfLrfUIC/f`U;5-_VCt`HE;~w__[FrlTFB0ijSjdMg_JspXrmWniS^[FjlTmgSQQ>miPgeR\ZHjeOabNYUCdbLedMgcLgdOedSb^FheKf`Id_Lc_HgcLgbRNJ:ON<_]EfbNkiVhhShfMkgPhgPhfMgbJniSpgTkfNniSjiPtoW''cZGojQYWE1)qpYrmWqmTtnTskSqnWZXJgbNrpUqjVc`Jg`GvpXvq[zt[umWspXumWzr`~zay`zcx^}z^|yab`JOP=khR}dzby`}c|e~{cxybwsY|fHF4NN;OO@=/QUCKN;LL9TT@XXFQS>PM?VS=b\GlkTZO<үɱ›ݽڼ˰ߩ߫۬ߩݩߩڪߧ֛٣ܧߩߩڦ紮tɜĘʚ˞ŒƖƔĔƖƖƖȖɚĖƖȘɞʜŘȚ”–Ɩ’ƘȘƘĖ˗Ĕ’Ɩ’ŒĘĔ”ǘɕǞƖʘƔʙƖĖŖŘĘʜɚНƘȖǚƘΛȗʙѢvgoԝƘȘĔƖȘȚ̜ج7:8̣ԛkzwdueѣů߳ƓǔŸ|ݼcVHgB}Ҿxo^͞nj[zxdOO4?C4)ba\D<-HG8JJ@?-?<,GJ8NK;PM=QP9WTEQS>UUC\[Ib\GiaM_\GFH8߿ݽڽȱ߫ܧڪݩݩ߫ї٣ڦܥڦݫܧܧ᪟v߭ȘȘŖĖĖŔĔȘ–ʚ̜ȚƖʚȚƘĔȘ”ĖÖĒƔĖƖȘ–Ž””ĔƔ’ȖƒĒɕƘĒƘƖŔŔ’ĔƔ”ȘĒ”ĖȖȗȖʚȘˠ%)(ƘΛȘʖȖȘʚȔڲXXCf{tJ8孋عϣ̖ӭ˗_XI{{n[adLG>:$$dYI^\HOI7DG8BB?wmXmcMt\_[KiaFvu^G=-~kxs[~}fe|by>=/jslXjfMqnTzb~fxybwt\xvZvpXxybwt\rnZvpXxw\wt\wsYxw\{x^unZvpXxvZ{zaxx_mfRxybumWunZ_]Eyt`y`xvZxvZ{za}s\~u]{cxx_}by`y`gy`|ewp]a`MjybPM;li{bii\YKGE1jYVE[Q>zaxbnlljlpjgjnkSfdKllldOdaR~crpplrqlmmjrVUBML:XXFGD8JI7HG898,ED4OL>QO@JH5b]JWWCXXFXXF\[GddQ_^HWT@RPURAON:LK9KJ:Z\K_XCΟé߫՝ڨڨڨћםܧڨߧߧߩ버}\ȘʚƘʚȘʚƒ”ȘŒĔʚĖŒĘ’’ȘƘĒƘ”ĔŒĒƖĖƘƘȚƖĖŒ”̘ƖȚȚ̜ȚĘƘĔĔƘ–ĘȘȕŔƘŔ”ĖĘ̙ʜʘȘƚ$֧ÖĖĔƖĖȔƖŒĘÕzLH=s ҬΥlmɓѹǨqVAbV7~y`#JH7RI3C@(:@2_SHUM6[bQ g_HMH4kmgU_R,xoyrrtsyopxtmkUnfR}|eB<.^XEneQxruxvqsppwyxmcQ33&?;*LI>A>1HG8EE8LJ<20!87(PRCRRAWWCSR;MN===-=;+?>-[XFBE4cZGҧƮڦݩڨڨ֛ܧݩڪڦߧܧڨyb̜ƖȚŔƖʚƖƖʚƔƖĖŒĖŔĔÚƖŔ”Ș”ĖƔŔƖ””ĔƖĔ–ȘՔ’ƖŖƔȘŖĖƖƖĘŔƘƔƔȚȚȚʜʚȚƒʜƖȚĔbbWȖ”ƜĘĔĘگ*&" ͤiCɱu[L?[VBecXh^Gj<9*#BD;A;3Ũ#!IC1pZSCo.&y^rpeTkcIr}eq~k}e}lYN1u|u`ZEuoml|eoojRh{donUljniSoolp|fhpv|s]oyerottzrruwqwulvxwtwkx;7(}|\[A]YJqlUgqRQ>njUoyw]GE4zlVQ;s|wmrrZND3nurON;vYw{cRQEur`{uutuzsqvw{agnuxc,)KJ8CB154%CC6ED6HE8HG8JI:WWCSR;LK9UUCB>.CB4NM=OOAQP;B:*kĮݩ۬ڪܧߧۣݩߩۣܧ߫|^ȘŒĔȖȘŒƖ’˕̙”ȚՔ”–ĘƖ’Ę”Ė”ŽǘƖ̙ȘȘƘƘƖƖʚŐĖƔƘ’ĖĔĖŽĖ”ĔƔŔ”$أ–’’ƒ۵УرȬúwdwn]-'|n^xoV:5#{WQA[ZCs# 87,heJw[,-! ZTCriTmb]G}sa^\FWUAc[EqpgRmpmmgQpkQi|xdjeOkppnm~{cmt{xclgjmoktpprrqWw}itr]vytbkun\vnnntoqptpqrnyb`Pzg_^HXXJ~uaRN:dbJnhRwkfOqnQskVswHH8d|ldR|az`yySQ?{ugmuxNP=~fxvq\7;0VSAwwXR>zu_vzq{vZvoZ{D?+wq[xt`r|jOP@JI:@?/QUCGG:II888'NKB?<-ML:QN;RRAMN=>;-A?/JG:JI7XUCOL8zߧڪڨڪڪڪ۬ڨߩlʜ̜̚̚Ș̛ĔĘ̞ƘʘʖĘȘƖ–ĘȚŔĖŒĔƖƖƖĔƖĖĔŽĖĘʚƚƘƔȜÖƖƖĖŐȘƚĔƖԠȘ”’Ôʘ׭qphP˙”ҫ˫\OA87,UPDŬ͢Ӣפ̨73)roY^T-}y]rmeMru_jihi}d}eo}y]oljipnvplnnislsoWkpieIenxfdQrpniqgeR~hhyu_|wclllrnnlijprk|i\YFxub41$46%my|ybxv_qmQnjNZUAu^xq{[\F}zf_\ILJ5nx`ZG@C6ifQjoURB=<)96)^\GptjhQrkRzrS|cwtahdPUQ?~u_H@,xvuxvuh<<1,- HG8DG8EE7EE88;+1/CB6BB4LL<=<+54(=<0HE:98)TOCXUAuߩڤܧܧܥݩݩߩڨڦأݫ߫粗mƘĒĖ̚ʚƖÖʗʙȘĔʒĒĔ–Ŕđ’Ĕ’”ȘÑ“ē˞–ĘƘĚȘǚĖĖŒƚʚʚޭ٭^H6ެǘǜ+۱Ôɗ޻óf`M=>0VWCYWC\YE?>/xoXo|bKG5wiPynT qiOolSYU>NL7g\B:7'xrYh^JZTQecWMK=SN> KK:FK@lfRq~}dh_E~eqn{e{pxlXoox{enne^Jtb}holWk{derljkijtqvkv\sulaIwjpsss}e~xdprqsnllpr~~jCC-tpZrmV;8.D?/"$xydCB2sm]}f|BA4|fypY|oXikkV|v]je~akkkVt|eprYwkU_cR\[IstrZ`aKKN7edQk{hTTDqiXh_R3/$b[EwoZYQ.<<.,//.!GG:?>/BD4GG;9,zߩܧڨڪۥݦ߫ܥڨܧ߫ߩߧ嫣rݧȖĖƖΛʘĖēȚƘȖĖȖĔĔʜ‘Ė”ŒŒƖŽ’ÖƖŖĖʚƘƔØĔ”ŒƘȚʜ˞߰ݱsi^**$JE5\WE7A0/0$~fĖԣӢ֦^("hB:89=3a[ETZDOH8AB4YS@WO0xg??,yd`PitTWCKM0CC6PNE:7(@?/SQ?vڦڤڤ۬߫ߩߩߩ߫鱣wڭƚŐʚŔƘÖȚȘĒ”˜ƘƚŔƖƚʐǓɓŽŔ”Ē’ŔĖȘƖƖĘƘĖŔĒĔ٫ݧ{-,$FG9OF:XUDII=-77.<;.:9.,+ -.&87';:+>=066'RRA_\Jvߩߩߩܥڨߩڨߩݫ⮒fΛƔĔʚĘȚȘƖƘĒƔĔĘĖÖȗ߰ʣuhPx_ϝ߫ԠաўŔĖƖȘƘʚƚТݮĺYK?*+67'LI9HD1LI;-LIML:KJ8LG6JG9ND8JI;wbO& NL=[YD74$GD3kiUebPxq[xu`qnQxu]MF0nWh~\ifxoa()$sϾ-+!pD=/~dzMF4KL=vukPtokOtsp[rwjz]ttjhbJzdvnW}e~hlnyw`qlyqhpttzbkpruoYvt_mjUcu{cqdynpmisrpux\lnroWkeMpkxxr}eIG1b_KXZInhUb`Qy87(B@/GF3=9,}i{b{awv`spX~hfeRa`K<9*|ydTU?vpUoNM>ZUDE=*RL;`[FSP=tq\erKI8toZneHcbKqjSvunryxxiuxv`n{wup}{_zp]rf>:/;;.00!NM=@?/BD199)::.76)22(10#63$SNBUQ<߫ڨ歅fh^ɽ̘ݨؔ”ǜ̙ݩőSJ;92$##==2@@2//'(( #/+96,9:*+"&3,"kWIմܨΙաӣѠߨ̩vYHD4&%/6+MPBJI:MK@KI;EE3?B3MG7CB6A@2LK9LI7PP?DD4oaC۶~ÐauhzfJ9:+;5'A@4LE0EF5f\GZO;qqUybybkkmrgU>ry[WA |[R9hdQZXPŷzczzdoxiXVE}egozfIK<}n~sy{rj|wu^wgzrytlptrm}dlrpsrpt}hn|v_{bnmkpjus}yapuurreppj[U>WO0zx`*0[YGWVFnp]e`NfdMjwxcc`KD@,21$sp_^XCTR>~eVVI~xguoYuleQlkT{wa~|d41$PP>g\Hi##skWokToqyy`mcJqqlyuY|c~|iiieQrlX|rpxqorKK563";:+;:.55'@>4>>465%MM=87*GF7NN;KJ:{؟ڨݩ߫ߩߩߧܥߩmzthlpa|nS|mSvҠ޵޷ЧwzcOH9 /.&690HM8JI7JG:NI>JG:ED8C@1GE8A>4BA/EE8<:+@=-?>0<<4$$/-wjSx]xwXp{lW2-!,+EC:RRAPPGJH7HG8PI@LK9MJ:II>HH4PH8-<6eaL50!FE;ROA=?2ܭ}Ωjάq|`QgXN=oua}w_x\n}^]U?~tYwiTj}b~eq~l{_vkSrȼmXUGfv~d}d`NKK?DJ:Ƽ}`zx^zdx~twxxsmJK9tlwu`}zatieO{yoXljQlxfzw^nopom]~yb}f|jp{elosmtk{{waspjtxz_p|cn{v`jyVPAh{ritpw~ya@C1?>0UVB%$!v.-pTQ@^ZG``LgfSOG8tp[tr]e_HPO?AA2yw`VT@{xcDE6OS@lkW{|g><)KI6miVo1/!jfTwslU~euqurWkyu]m}crv}zb{qc`K~cfxrY~a}zc~u_vr^zwdEC4==2:9.1/$87'AB.HG8@?/<:+;;.UMAOOAu՞ڨߧܧߩݩݪߧ஑i{qp{xq{efNYXIRM;5E5EG6HQ>NL>HD3GH:A>0EF4HE8EE6FE6NTBIG9IH9EE8GH:FE6DC4E?1EB6CD4JK:E=3AC3>=-=<0@C7;:+OG9TQ>RP?PO@LOFB3HE8GH;FG;IL9NJ;&+㬈g}SF<.0&OP>fD{фG83xak^M:rikktyvxxttgJF8Ǣ`me[Mhv|41"~a`VEy}x{aign|waysYyqYxbipiwf`I~jslV|g}rmybrqWwx`t`]Fxu^yfpkU|s]tmRtoXecP|fvrtvtp~u\vsroS]ZA~zaLG2}zaovrVpkWzfeyze}y^j{ekeOhcMewymroW86*X\HBC/LI;aeR{ybKF9VO;fcLcdP[YHKJ8gcLUTA]XD{yd<<.cbNus\OM9hfRhhPb^DqMG5UR]ZD^[Lha^Lxu`XT@LD4xkojTmdRov_zu^eaKf`KnjUllWZTByt_xgw`^FyjzwaqkZheW('.-":9.$ LP?;=+=9*JI:96%QN>;;,rћڨܧߩߥܪ৉f}kspuulu|vifjW)#,-%@>65B5DF4FD5@C4NH>QSCHE8NM>HM>IIIC9EE6DC3IG>NK;CF8JG:BF8JM=0IJ=ILC@6TT@IG9LIB=+(,!:8+zgшdzqVy]]?tA1*~V|_nYkQcMJ-}bi]E³e~u pd=8-zc~_fbUϷ}eX_N[SHuhxvd}lzyuixvrYpxis}|d^VprkqsoWumr}h|s{ytullvry|is|dyu~gxpdppxrZ{ewoW}z`nh}zfyw]ZVDGD2\YEKE4tur^:9*IH5TQBvq\vtcnkX'"YZEURBIH:JM9F@/g97%niSpiSOM:PO>]XClm^daLvo]ktq\nd]Jrya^_RXZEYXF<70kiR|ucgdUEG/|TP=c`O77&65%(+88,A>/DH6MRC55%E@3EF554%JK<|؟ޥܧߩ߫ߩߩڨ஋j~smmyumsryuryxs]GJ=42%IC7JH8GH:GG:LIRQ>KJ1"reUIXR6MU8>="#"oV>{^tV~jnnfL|peJ}}pUeo|]^urZ~f~|ҽ(+! 94*ȨJQFȭ^\Qgz]?<2ָ~qVdxp[PG3}rW~dzuZf|hyr[rtZDF>}usYxo\~{dzedl|y_qkvq[okTf~uaozw^{d}w`j`[Gxt\wt\hcMWQ;xt]vnY~z_~ewV}xag|_igP`Z/,/ [[IkjU\YGLJ5JH6olTtw]00 xb`Lsr_XVB87,}kzr^QP2A<,65%/)C=,MJ<89'00%?>/CC456'?>-<:,@=246'=?042&??4//$<;.99.JM<~֛םڤڪݩڦڦڤஅhuustuwo|vqursrss]XJ?>+B?4EE8FC6ED6EC6EC8JI:LLCE1MOCF5kkqt~vakQpQ 0 8BA6Zc=4 :CB08,$*0n\Dr_uUtW}{|İdzwî˳˻98/A<-Ź|ʷfQK;ƥyufu_`Pj}ixv_ozfn}ejk}bpyvcyclu{xb~gpnWho}hlo}ezu]upj|a{{ah~ciybil~yb|\~y_i|f~ay`jgfrtyl{{dlh}zfvrZhigjSJ5VUDpr]\WE{zg}kII=DC2AC3ejZ79(MJA@2VUBomWLL62&LO=HF5egO}eocSxo}eqwq[y~h{d{foo[YR?>=0:=/;;.88,87)--!68,44(>@087)==.vћ١ڤڤߩݩڦڦଈezuwxoqxw}sxq{tqttznpW46'70)ED6II;IJ9FDFNU798(;6J;01D9:83n^CmTlRs¬tɺƬɳîϷɲĚ>>-ffWxcsc|! wwal~hzmeQb]Lyt_d_Jqsazt`OP>d`JY]EbZJGA;|lddQicSwtbVVGkhUMO<{dzytZkhgRvs\{y_~{gldO\ZIrlTWWCkq_^`Oxuawt[pmWa^K{v_pmj~}frmW}Ywu^LL:tlXts[vt_umVkgOzbx_}i}fspXvqZrmT~ycgkiVhaPFE4@?/?C4@A-]cNON:b`RPO?GEGC3@<,EB1gcQ;9*]_MhhURP>KJ8|?>.TUCVX@QJ8EG5ML@4yk~vuvyx~|zxtneih$07K3,CUYO-/HJC<-SF=?>;xWgMtccUlv_kʽyϺ~ͷǣѺϳ̠FC7><3crĻvtb{}`ɻ̵}|u\*'$CC3@=(E@1GA5:<+76'FE6;:)1.';7(A;+HB0G?4JH5EE4SN;[SA\ZEED1CB2CB2>=295(;:)<:'<>+?>/44(DB1A?-CB4FC6FA1CB2m]EتԫΣxYIE7CB4HF3QM>JL7GE5HE5@=/MK5DD3ON=+DB1JH8>9*FC1GD4DB1CB48:+63$56)IH5?<,JM9ML7JG:CE5OO?|{g?>+CB/HE8@@4POڨܧ߭ߧܧڦڦܧڪݫڨ᫅zc{{rvopqsvwsqvwtssx|qqwzykjUQ[H]hSsrpiz^~HSE{k:E:jmZbeJ{pr|wzyyumq+89_g+/-%=E=?5D=:LJH55$htbOԼʴx˜nǭ`wtwZ|bGK= ŝpfҮd`NNH-θǻ|xe}caPKG-/+44 A510,(8-"+$#>=1++%KD:AG<99.-0!36$D=/!'";8.@>5#(#(#(#.'79'76'7>,11&+/'߫řo_Y?>=0>:,880;:.EB6?@279,;>/CB4HH:8;0<<-7:,;=*DF5BB1EG3C@1?>2;:+88,00!66%/+ BA/ED3?>032!>2KH@/A@6;8*58*-,OL<74(ON@;:+71#JF7DC1<;.<<-@?/DB3HE6_\M^_La`LPOIK<:<-12%/*0.43(00&55*$#??3LJ7igO{dqlXusZ_^L~xcfrqy{wiiheR FA.@;,X[G--"47+#"0/!CC6AA1?=-?>2xߧߩݩڤڦܧڨܧܧߩܧڦݩڤާt^}orougispppputmsyrm}pqnwptszu~k}{hllm[YjUwsxrxtm}rv^|rz`RY=s|blt^xEE;mi_kmWjV@iXGEG6EE7($7T]+GJTE@/6:rƇڋSS?Ƿ}ʴDZưӼȴͶijͶʴкӪVQDED2vѲªŧ$ m_ZKncNklw}u\wq¥~elɣ[NA`JN3nmiU[ZHzwpPŦqU\T1^ha_WaFA&CC6{jFqMiվvn\ɝ`/#uvpusf^HygeI}eicqkVc<*JK9JG0?@/DB1EG756'@>2CB6@C4AC4;:+57'HG8A=/JD5FE696+;:+;;.87)55')- ><,rr^sn[|gx`xw_|`{r[k}w_zkq}wwqX32#:=-A?-+(?D/14%,/!-.$HJ:,,EB3>C0BC6}ߧڨڨߩܧڦڦܧ٣ݫڪڨ߫n|uwxtotlpstjopmni~ertxormpmrxoqupwppxzzcimVjwbdt\o}ay|x}~w{mvfhQzyo`S1<.EC:>A/HL:+;B3QPM=2@;4dbLԔŀgitxMM<ƼwvcƼŹѩ TRFŝȴܺkqgU|;4*PL=~`cWӨŲ|`ạ̇̄˸ tx\?+B.{/rFvNkbKĔqVI;&tsuvroecDz`~PXfXV7miSFC5NK;HG8HE879&>=0CB4FD3BE6==0CE1HE:RPA>@/GG8CC6DH8$%21#0-<<0?>298,:9.A@4;:+EF:RN>C@3MN>?>0BA/JC4)/::0?>-DC4<9*VJ7HF38:-/+/-@>+60%_^JwqZd\Ixyf`_MJG6w~hfcOujmVvw^RN=xq98)FE6+(CB1><-:9,A>4#"10#'&HH8,+BA4>=-76'{ڤݩܧݫڨڦڤڤ١஦|uxrsutrtqoourpsizrwv|ppprqrrpsxnrpsxqr{tsbHT?PdQIXD]cPZdWkz_zs~rv|uzuyymUO@DD6FC8BB8\XG#);GH=C;399)GF4>:+03&87,=;+HD3DD1H@-E;,51#44'JI7JI7pjUyGD3UVIXUBWQ@kVSAvt][YCmyJM<_ZCxnlT;:+HE8FD3FE6CB146%<;.%((-?>-@?475'EA3AA1A@2uڨݩݩڨڤڦڤڤڤڨܥڦݩଥzqvsutytrsysv}mpnv]HF4K>+vg^Jnttupstsswswuxoruoorqyb\gR\o\LVCZlUY[SU^IUbK;E4zt`nWhvYukvuJG<||FJ;LH;DD:IL>+.0PSFE6DDDiuhfWySmĴ &$riVڤdl[lmZɡ|qo\r\caPվhZNҿѤvq\bYH—u ϠoEgZHĦr۵ztpDlYsfDhnczqOUbTO<l@.JI3;8*ED6AA/88,:9.9<052'11&22(84&>3&40">A1@:,85(A?1+%:=.65*76'16%0-43&98)%$1.%88,?;(QQ=FC4:=-?6)CA/CB1FH7LL9cZDLF1>@0:7(EE6FE3ZWEmqZ.3"b]J>=+op[;6'skgPONN]I?T>et]LTF{VT?mst20$JKB6<8\g0IPB?8\6*VX@rjbryd.-&ݺGD3ʯþTQ@}v\E>4\YKxzh{dʚ浀sǺwƾ~vpYxЖ~kF۟r\;ϭqwT$f`xVjÜi_zTRc[UD,-lB٩ѯөo~fAKOA((vtxrws\orXuqUeqG`^kMoqSmkJ0 QS;:/!mOzZ_b_kkgasP5z^sgbVd`EXE4UO<6<*<>/<9+/+99.;;.8:,3.!@<.KJ:ZH2MD2PM=14%CD/IG6A@18<1nWEZM6+*.-ED4TXID>/99'QN>LN?>=-58*@E/v{iYYG]]KUQDhgR_[Hup\GF4EE6FE6JI:@>-LI:33%^P>39(BB1C@4RJ8FA14/":7'JI5E?0}ڨߩܥݩஙjtxvqurkvpjjlms|rnZ!d^QA8(z|uwzvyr|oqup{vqvrtqlt|rquOYBR]Ihjdwbqh|cn^m~fqkKRAhvj`lYqi{ +,+0OW&;C1]i:fsUb[jt]MMEBI9r{g|xش ßML9RU<+\]MNPBNK9;8-;9'>:,GG8>=-II8HD3RQ:(gfSHI8VQ><;.=?0JI:CB4,,@?-44%B>,43#1.F<-ZRA74$65'HB3CA/?>-rڨڪݩݬ䭤qrqqvrmwvrsvroofyZU@mr\** ppqvmp{wnxruyssv|xwspv|t}FS>NeN/7+5G?UeRPRBomomvpponk}tWaTAB2:2$mC!'*W`Kytah[bl[SV@goX?G:;E4igYafU~pt~w|{l 50"_dMRW>޷_YBkkTmjWyilfN}sc|lܯx¸47/WQEkwŜfhGq~mcdaz_ЬpͣxNc\xOhbN,,F>.zolWЧSuDD5rwvtkgR\]IvoWs`LwrMǠnQ^FoMr}`O:WVCI>&岬~بckץ뭗mf[F1(50 D2(/+85(54%76*-/"KF902!=9)bM:.."32#MM=DD2[R=cZF88,84&::+11%?>0SS?AA1<:+FE6:7,?>043%B?0FD4hf[30'@@0DC3@?/76'=<-02#13#SN?<;+DH8^VCSE2YK-DH8<:+x߫᩾nxom{ttwxutrqotlvavUWKrknoosisxwqrtyyyopy~pspoimt{|{d[cSf{`nwcFUA^kX00"c{bow`Ysb??2ieKܫdX>79-mjsqxw|wUdQvvneo_ogGUE9@4|nrnrVuoȬb[Ma[K\YHzxc|yri}fvp\"&ľѳ}ztĜehOʴҢqapLyzdenagdˤjƦvmCZjJ>:%32(0/!teKƔjv>>.oqvtoVG1wuYTWDvKepoRlIdpYqE6IL9F8$VM:zrWҾrɓݪƕcQCE?,D<-:9,@=/@<+EA354%33(?>0NI:((((51$QG9MC0??0#%II<87''%@087'ydLyiQ]SBNA/CB4>:,?D220:9,@>203&uƘox}totuxsvthsllt~QPDwA?5xprjqpk|uptsrout|wyuw}uiqlplqEUBaxdjsfmwwT]FGX@_dNsrxdQ>G?t\J[UA44+fmjnnlsxpjjiporqlistwvxu}x~x}zugn^zd||hnwpvo`vzmiOekZӧϫԛrgSqi{|~a{_]LŴmD促kcV@]}oJРf[*$͞gǥilͪqwS67)>B4fWCveaR# ʿ?>/umR~Òix52!~xdrwwqsjSxwbIS:[|R`qRc{eql[PK?E5"ߩ߫ɿwPB3ϲm䭿w{`IE?,HG5B<,:3%B<,LL<.,87);:+11&JC574&GD2N@/xgK=@/55'21!98,JPAQQ@AA2?>/A@2?:/96+43%/.>400#@?/67,;;0ED4<>,87*LJ>IB2')dYDE=133%8:(77)?>-FE6EC8A@/|aӮp|wtsnsmsipnvlpstww|tmsqugvsrntwowqlqvtypospqsuqturhQE6K6%߫Ӥܫװ{ɿfܡߧ}]~^FJI7CC4?>0LG9OL9OC,oUBH?.EA/<=4>6(+*97'dP;<;)UUC3/ TSFSQCDI6,,::+00 G@1J@0,+:4'GE/C@182%'#8:,*-"EC/ED1GI7OL>FE6OM>A>+OF67<(A?/hXD8;-UO>>=-CD/URIA=-LL9<:+oߧخj{nvrtmnuuovrrnqrhbVd`K}ybwstwupryolprpsxopqnulprlvqztsusrpmUsp[=@0AOJ{㣇:*/4/:=,LZF{xmoe}ghi\nYK]M-:,EV?xrOcOc}b\mUZpZ3@,O]H6D3UfRc}em|`~sdz[voR[Lwlyj{}q_Hxu~c|ͺ{pshmXqj!'AFBȗZѪpqݯnfufğd22*26'_^Knvsuuusc`PYYFڦ͙epy~KE3ljXxxvseZEuu]IyUx`7|UhYtce{hBF4;6&ءshaMͼ|^ӿw֡eOGG:FE3JI5JG7?B5MG7v_CZG3*@<+@?/41$42%;6(]J8:9,HG5AA1FB0C?/HD340"74)EF4OI9]Q@87)LL.@?/C=,%+:8'JL:KG8DB1LI7JJ7=;)IH8PK66<,98%n[N88'JM;GI5OL>CB4EE6LLH4puliljikmocyghjljhi`w`xrPbLw{[oXro}t}q~{oiupl~dl}bnz\mvn~ybÛwϪàz{|q^eP]dT "oeQSαyYɯveqQzPYi>?1fururouwzsn\i٪Ö˺gvvKH5leUtuvvL<-_P@1FE6A@4@?/JD5JM:LA-V?.]F3/*9;+NQ@IH8A@-^I7:9)FC/EE6>9*>:+DD2BA176')(M>.hU@FI7A;,CB4;:078%B>043#47*>=-B@-IA6?>+=9*A?/?=-aWDA>/PH5PG4==,EE6JH3EB3FD3DC1QP9YRE~ڤڦߩݮrzvs\qx^xgxy^w|^tz_hpWbjUdlWglWkt^goZdnQ19.[`J86/ fbUcdOcjSku^hiUagPbaKdbOdgSmv]]gTlvXuo~izrqyqzrowlqmoysrrprsrnpjp׃fv[Dˇg^cQEH; [u_K_L5E7LYDRgRGSIhxdFVHhjejbhoqfjimbz`XfSXdNObO`mWjxgojSfx`ytf~bp}j}yzw^shm^>ѱ_mQ\m[UdV'0/'\R@练|Qn|YĠmѦpm͝gÛm<<0zy_rvwppvuxicQƦԧpɩyz[bfcNrnVMM@d^KqsvuveO|L@$rf\UpZy~NN>?+洨q˹ۥə}_~aytY?>2?=0>=-?>0FE6EE6fO,+C>.20A;)OC114'>=-ED3LK9IH9@?/;7(JH5OK0lYEYL9KJ6HB0kYCaK94"WF:LG4JJ:AA1=<+HG8<9+\\JB@-DB1;9)?>0$"F@,WV@A9-D<,:4'ZH67=.DD3HH8KJ:A;+LI7QO==9(WM:JF5OJ9lWKP9JI7DA/?>0HG8A?/A@-EG3BA/rY߫߫߫߫ݪߩܧ٣ܥ֪p}qxvwoxomimnprj};60XWHjigtrorlptwwurvrnpptswmrulr|utnuqnrsrpqnvgzu[ʌg}pujq~ixu_v|gZmZ_gU()E\H=K:P`Ptyj{fYn],3"/>0Ys^b|govJ[Huw[YK293awdUiZVnYBJ5zekjV|QeTMTB]g[]fUXbSq}h.)NO;ڱumAvg`P_XDZdשm֨uD?7^_Fc͆f}]ctuknwޱccGģoKdI=$ƽdJNA~cevUzdP9irnTu[FwZrcS_p^jzfS[J6+亯}ƕ{\ﻴƘ{ʥqV?=-=<+87'>=-HE5FD1`K8^T?LP:JH7BD/]SBkSxZGD<.>;-?:,DA/;8*?;(94&G?0BD1@B.EG6CD1CE1SSBPO<--$KD2^R?LI9GF1CB2DC296+ML:44#_^KjYHC@/<7&r\@69(>@0:+oVeO?@2MH8ROAED2DD3*&B<,>>/EB3OO>A@/FE6EB6NM==@/=<+ID0nT@)%PQ>DA266%GH1OL9m^HmWpUXL<:9+EB1@?/ML<;:.54(2+45,44%44%pfPܧݩߩءڦءݩڤڨڦڤx{rzwqzvsskuspnlvOI<zdbZDxvzptpnnskoqnrqrrtptilpnogovtrvlvpqpjx}crv^z[_@}txwquszropphksvxw}|e{fW[Iu{jXaObv`Xp[[mVRdQJR@zML>E<5DQ@zy9H2yGD3xb\JJG:QfTavj4<035,62+h\Aui?ຊjϒl݅i؃giQWp_vLB2pӀaӀawZ<`Q_t_tvr`sVޭjlSkg~]{]~adj^K%3DRDR3Q[p^Lbi`fggJ`VIjS@QO@) ׫hƶЯÓrSҺ믍nV;:);:+?>0CB/CA1NK9dP=bN;ZT@TQ=TT@OM7JM9jP# JL@WRCHG:<:)73$@?/;;0>=-;:)@<.TQC31!43#A>200!:5(gR@N;*;5*C?/HB26,0$w^fYBB>,96'DE6><+A;.AA241$40",-12(::0*, ][Aߩڪ۬ݩڨߧ֛٣ם՗ѝݪڦ֢nspvsuypsqmnonipm|c>7-x}hx|ckx}ef}fs~e{gt|epu^qybqzatt^noZfpZ]nU`pWXfMWbIZaG\aI|e}h~~hjtu`vw]iz{erqt[izfwxvstonyhYK;z`OpmnQwctzlsywulvtusxptopts}muqt`nRTiOIZDut`sp\QWLfkwlUYLmyWVCMK==F2Xpc`pXQbU!=9-XSEX}`gVem_mJ:䨇dJcK9kfSmy{gԂb݅ix[qTdmiuvlڳj̣ڣ\~}hx_`dg݊k8;;U]Xa\DR'IP?XZvV֋ilrMh/ ^=-kS>EH7F'ԧj_A{sVÓjJvvmdJ>C/98,;:)HF3MI5OK7dR<]J:WR?\[GWWC^YIQM;WN9eO;*'@<-NM@@?/:7(@>+,,EF697+?<+??0GF1?>+GJ9KH<.-"GD886'jPeMTG6e_CsXI?0CF7:9'65%=9*>=-CB1C@4>A1;:+DB151"21#76',, [RA߫ڦݫܥڪڨڦڦڤڪzT{YRBѰ٣՝rvmo{jssuootqkvput`xkUYcMXcLjqVhiVeiUrvbip\klYhoVfkVpr]w|cry`tv}etw}h||ml}~g~zev}ep}ee|epl}h|wbilysrpjtvxuo_Ft`LpdTvurvwpsv}xvpptpkvysyptvpyqltv{dpo\hQU8\cDQB"#wU5~eP~jbPrVoWhM~u`tt|qmdLѻkvklu[xtY]lZL#PLD/zoyL@`oP?@/A?/=;)?@-QK:RK4lQ;\H5SUBTQ>OM9XZF[XFTL2r^J60)<7)93#GC2?<,<8&),;<,>=-5:)88'DC6A@2?<+?<-=<.83&47*D:)iQx[UK=4,65#>=0;<+>=-@=-;=*MI7JJ::=-65#43#64#42%A>2-0$VT<ݫݫڪڪڤڪڪߩߧ歔lqsQov˱ТqwovtuoswppyrowrnFH220#edSuwnromvrspujsrtsrju~okqrvyzuvrvrrpvptqksf~pq|ryg{upnrsv~wttstrq~unpqmrrwz{mzdbjVMF:MK9IF6^XJVSFlPS@vust-0$72$AF>@\\-?F}.NVvq]TuYpVlTjWBjQlQj{}}N_KtXС}raȥugcçrpzy195@=-gD2A?1M=$t[Aw`DtRlPiOlQwXbcFdQ?yhK|gJjPlR~hLkO`IfQ|YB9;+@@.G:+z\GhNiPcHYJ6QP;LL9HG8WQ=UWBWO;TO4fMA7'E;*;7'79'63"41$11%?=-IH9>;-98)=9(54%;:)?<,,)<8*yhTrZC?/:6(:9,,,>=-<>/A?/JF7AF2DA/<:+>>243#?=-TTCCE5:6&)0"^YCݩܧڦڦڨ߫ݩڦڨƾmbU¹r˔Сowrvunsspvnuxlkq;=1?6,ompmuprsqvtsritmqilonmpsvpt{|svotnvrtswru|rwotuv{qsquvoolkomguyojkwgmv}kkltakiUkgYUXDBD4jfK#/!JcS`q]#&?D4GXU`rt(=B(BIctj2SWIXV~q^ozeteIP@]G}wcbly|x}r߫ۮsפnsQŁUTװn˂f1?&CN]tkCL9VZGYY>LDVW~cCjU>u\DmI6[F3v^?gK2CA1*-$:;5<=4?A3?D2EE8BF9?A2EH7NK>FE6CC6@B1A@4A@2@?/;=.?=-?>287'3/ HK5KJ863"63"qgVڨ߫ߩڨ߫ݩ؟㨧w{ɴé^ިԡispstslsxrmpoptqsp`36+ssavsupssuqnvqrstyslwptuxrtptnovursupmpppqlwtwu|ttuswspyomz^~ckm~i{^UB[U@q~bmxza{{duqYov`t`rpTlkRvsZ~v^{_}wacmuqZuo[XSA85(jmY}^zcpgQZVA<5)GM@Ld_!:G9VZ7Y^t~qBcgv|jzjrLQ?CC3/8'5-!friur|֤߫yܫxOL6bDdHbMLÀxhgOg<)mub;=.*-$==-76'41$31#42#BG78=+>=-=:/A>1A?/?A1@<.::+?>-;:+11&CB4=9*63$;8(;8)76%AA/;7(dU?RD2HE3LL7WV@[ZGWUBRL8ZUEi[Ky^GuW@E8*0,"++FE6BB1?>2;:.A>.98),*!;:+54%H=,_I7ZF57&;>.54%::054%=;+FF4<<-FD1HG8<<-ZZF22(TQCCB4@>/MO;WWC85(STBH@.߫ݫݫћס~r]ż×}צlvowtmovsvnjxnsxsiUC?;,qqvslrlko|oqsssmxovjlutsppvunrmlqzoomtxqotsyx|lxu|}VM;so[v~dypqVzw|v]gwvqk|emur]ccK]Q6mxs_cgsxwt_w]\G=:)fswqmR|3(VVB;E)JV-EDJXPbY?Gk{~wbМ|bwM]NeO`ziUjQY{ə欘mЮxRrL]~ZzY2JSKc_)JV'KURkjcpnAP9QPH_\jjVzr}jSm_]}kt?.?,<)?A-98)98,=<+<<000!31!IL>QRDDC4ED6UTDGG;DC4?>0PO+A@2JK5GI7MJ:EB/eS@\P;SV>WQ@[XF\[IVUDXSA_\GiXF\C1kSdO;P9'@<+FE699)43%.,35#,+IH9=<0(*_R?cNC@4DC144%76%;>/>?+03"LL<<:*MO>QQ>76)llV25&NN;JL:NM=HG6HG844%WUFOK<ߩݩՓԝ١ڿtvڤ١}iwolv{mu{ulsuvw`pVw`scaIr^hRxmnrprrnpllrtpslkmntprsmkolpjnlqskixutoypfgnV|ewx`ry]dlq\wwalmYwt^uv^p}ixxejrYgkQMN;)i~}f~hyrnF$DL<,5%BH(P\?GWhb{hPybx\nzovyfh~eoV\raű֢dkY:t\@lX>r[AgZ9?:5<[a)JV)JV@QT5Y`0FKxSDz6+:'p+t4 jC-xSAm>,o?-Q:BDB2nZE^I7UQ-_[G32"JJ878*NPBNN;51!uxf54'NM>LO<\XEQO;KP70/??.ZYDߩ֛ם١ڦ؟ܥڨؤr|uwusmuslilwB/]Hnmrt^xv@1xnvlrpnsnqtqrtwsltrnqsngomtmpnqstrwpwrozt~y|}{zvx}gnn{~h{{dvt`px^krYxeqq]svZjkWjzv^}}drinrrgkz{_ww_yhhs\foXSXEbhUbjS`gS8@.ugQ{v]utYztєWUHxp,Ta8=9-S^:\\-0{zzjdvgqU\nU{ameoem}f|֮zq^ęlfOdLpS=fR6{RةpaR`_]`VJc^W) J7<'9&B.lE4a9*]9*T;*R?*SB-tS54(,-BF9<<0?>098);;.HG6NNFD3;:.kgPJH5ON7OQ?c`LHE8?<*43#HF3FC/IH9;9'hT?\H3QP;LL_nd>US#GT4BTcQju\xdJ}]oyg}lcwrUL;{vVЙrT7RB2?5"\ˢjǪmԬpԱs۫qЩ|qt_bP9VMVVHc[Dh]ȝnnbFwKmK25*(+CB1?>2>>240"77*JM=LL>?>0FD1jlWSUBHD3CB1LK7JH1JI7MK:cbLLL9A@2=9(;>0FD3BA179'eS@WH4NN9HG8LG9GJ\]P`]H߫߫߫؟ڦݩߧ߫٣ڡءաݬryit{pkoxop~eY>hRvD/g~ex`pYgQZGdF0 knuprzvsjtnojjp}cmsigmhh|}dtwbvepw^rv[y{e}dd{|aijqumv}ft{dmrZfkVflWko\emVitasu\yzfu|d}{d|yc}~j}~h~hzw`uuZuzaps]v{ayydsv[bsw]c~iwx]~h}}cwjroqsswWS6lnRf]HIA5x_qxk{LyN' KOAA:%ni_06}t#&%*/,<-1!>7ZM8lr]vtc}mհuqWŢ٫ҰmP^EbEt\BrWBwY@wY@wY@s]IHMFtZvid|jTj_6NMYM=t_Gp[DhS=uZCp\DoV>hN>?/('BC6<>/EG531#02"HI9RP.@A/=?087'dV@\I8LJ7HD3OK4~rN[T9QP7IM5]T@C?+:<-[K9zP=yc;-+."-3$66)\SA{a{gSG?/<9)44%EG7NN=88)HE5JN;=<.BF/%(CC2@?/KK8NWD98(X[F46'HF3NM=yuZieRiiO[\GgfTvqZ߫ڤߧڦڤ٣ڨڦ؟؟ڧhiXulos|\lnknhStpZ~^Et\eiqUvZ{V|mRyaMp~gkhggk~bjghpjhonokkmolhcs}~h~|donlhinrmrtnrvonhwsqulqu{~ovqsn~e|iw{d}iikfxufw~gut_ewv\z~ajx\prtZXDJB8kloscz\o}ܓυ؍ޖ^kd"@?;#BN8BHz]vZq[EA0ntXDw_m}۪jÕwOvZEz[Cv[@|eOmL9u\GlR>s_JqS>xttd~k:NJ)GIu]>qZElW?lW;eP8jQ8[N3aH:<.-/#;>->=-RRA'$88)LM=-76#CB1A@4DG498)iWAeR=NK9EE3ehsLVT=EJ2]O:C?+CD4SM:v[inY1.'-4&&#ibMsXaK48:)03$$'+-98(,* 8;)KJ80CB4LL9|x^a^JnehOnlYtp]؟ڤڦ١ݬܥڤڦۣաxmrnprswmghi{^rJ6dKcK|M;up}}bku~f~sE2zqokjkkj{{d}jgictyw^oiyxalomhnj~~if|e~~iijulmqngotoplg|pnwlzlbnVScRdrYmu`kqZwlpwehpXhx]yw_svavt`zdswdls\lx]dqZct`goZZoUR`N\qU^gTSgP8K:8O>LeQGZDEG7AE6~frqUĀ{rtwфyq(--6(9@hZxUӀa|^c؃gbWI2Ĵѿ㬖sDt[JgN{bBlTwY@dKiJ5lTumTtr|Ywgm3LIXE=qYEeKy]AkTnVCkSmS9hN11#,+CC4>D3]^M--$?>+PR?^_IOO:ON<]XIHG8HG5ML:OOHF3|hE콃ÂFH6TV@ZR@A<,A@2@=-UG.icM@- EA3w]dWC! /,@D2((86%RUD<;+HG6SRDFD3][KCB1KO><>/DE7YaN17'os\DO5U\K\bLw{dho~~ileڤߩ߫ڨڦۣ١ء֞`iTcjnmfozion~}]iOnVXCM8jqfsioxhN:e}}deihgl}~ell|f~kkfjkq~}fo~~iljqqtqljkjlfmlilo}h~kh}k{{dvz^y{bmxbugwyazv`||iszc|~asy_{xdryby}i~mliskmqouvwaos[ow\ps\ljQouZgjRakW[aMhnY\fT\jS_iWBG8:=0`φ|zՑщeSH?(();ڦץϺ@>(jI}cLuYrWBdKwY@dKxWFdKnW?eH4:),+BD3A@4_eT00!AE3\bLZZI[[GTS;YTEQQ>QP;XUAYV@RR>NQ>SN?b`KLK7@?-A>+HF3CB1NL8<;._Q=YO6LH7IL7/EJ8MA(ioxmS{{dymVgQ52',);:)LP@#11$QRB65%65(Y^J:<+__KLO8#9A'KN#IF"DF(?ArYd1yiOkojO:URFYClnQmCNIׯ},6"m[BqYEnW?u\DoW@vZCdQ<~cItt[x}}$*ED1DB1ED3;:+eZEMC2HE5NL=FE6JJ3_g|qVaS=DG2?A3AC3@9(QK8llmyiNK=,,,/.A@4KO@>B6IM>54%<>+fiU;=-\`IemXW]HVYHX_LipZW^Eow`uxcqyaoybiuYov^rv^mssܧɕЛ٣ߧߩؤViX}k|flgsjfi~iz{cuvcy^zeM|/ p\CzcrvZkbJzpTWCJ6_@4qxfnrdzk{j~l}joj{kxi}mxixhx|fxfziyzer|akx^s~fx|f}gqos}c{~h~kxh}npxgyzi{~hzkx{ctxbr|azi{~hxh~~i}kzizizizk{jx|fn{j~lxh~mjjnnlpn{kzflq}~f{yeow`ps\v~dlo[w|ecjXkv]tv^EJ9GJ9G:$<5"~gJrThbgqSWȷuP\dT6ZWE6IN:5/lvfy|esYwwc_eU֞Ϡƛ௝uG ZV@^VA\S?]S@YQ=dYBnVChU@noXttt}9UGgW;_R=dQ@-17&KJ:UWFijSIF4FE6dbL``Na`ONO@STDTV@TV@`aQNP;HG6ON,HK7>=-;;)TI8EB1HG8JI:CB/KG2o[BfbthRKL7JI77<,:5$88*mhyvdxdQ77(03"2:)AK7HP@*0"9B/>H5:?-RXF\hS[gOhw[u}deuYk{_x|fsgxhs~fq|cyzerb|kvjom|ntuZܧͺգڪڤڦ߫ݩڤڡݨޥݩӟMcPu}dtbu|axhm}`~hlimunnVDpfTzkT|;*ytYk\HsmUrcPnmVx\BWDz{ejcOlv_ly_s{dm}`o`r{^vgt`uex|f{g}k{jwgq{fly`lx]rzcu{_s}ev|hr|axfqy`vy_ufly`p|bx{cp|bm~bv}czgqxhu|axfzlu~cqzbufu|au~crbs}eq{_jxdsgq~hm{^{grbzixh{jv}fjv}fxh|nu{cufzi{|gy|il{|dz~cjyzemin}gmjpt_JM:CG5iQY`O]_@pva]bJ`aP(/+99,fjXT[EGL?NJ=imYxh(JRDRIYD{|g}hxht΢ջɝȻƝV%%wll{fr}ls{es{exiuf{{dwlttt}*?B5L@v~dlzaq|blx^vy_|gjy8>-23%EM;cfPchSZZHGNZ\HikYXXFON<`aQSO;__KkgPPR=HG6KJ8OP;KN;EH7[T?UF4QXBOO>JMD1KA3*'ns?D2fU<)/:?.;E4KU?MYENV@[eR`kXZhThubcu_cs[]pWasZfubjxa^nW]oUhwbjvclw_jx_nz`nzlugwiwi}`ڪЛƙڣ߫ߩڪڪ̗֣߫٦ݩܧܥܧڦڦا=UBp|bqfqz^lu\shp|crtaufbqSiqp^kTk`Ho_@rt]uz`v{fsK8m`Iv_HvN:kP;k{g{~fjw_p|cow`s}ev|gs~fpcjxdo}eryfmv`fv_gy`hu]fr\jt]gw\|hkt^kwbx{co`oydhwas{eeu]fwapz`xilzdhu`gy`kyhk}co}eozclyal|`n{flt`jybmv_ozcq~ht|ffy\shmwahwanzbq~gt}jm{^o{ds}csgmxdt~]v}exkt}jv~es{exgu{cv{ezf{{duet}dv|dxht|ft~g{~htJK7@LL-DFpxft}jsh{|duy`mP嶨qzΟßlXZA0,'x}bo{dq{fr|hv|htlxixhnzbgyeqn}3LK*@HS=CD0]]H`kVKR>BG3[_NEM6T\H`_KJL:@@.BD4HL:GJ::<-XPkPRaMs}cv|gu|hy2@->D1T\F]mU>F1HL7V^J@L3EN8PWCFH6?A2AH5LM;@I5EQ-CE28;(}twtØg]PK7=D5ug58)#[aFXeRQWDBJ8.0EP>[aSS^HRZGfv_fr\YhOtll{fpzhs~fo{dpdlzbpdm{em{hn|`gxdfwao`q~im{hgx]}fܧӢ͜ߩ߫Ӡם؟םםܧ؟١١ء8NU>Q[DLO18:,4:&FRB[bLCE5CH5IW@C3MWCMR>:E0;D0ESJJ3wǡlc~OsRKiMNdPbt[at[^qXewb`nYgrbhxdcp^4Q=|gZsY`u^Y\HVdL`qXcu_gy`au[ooSY_Naw`^nW\oVt[K_G-3&;B6cu]\oXar[fv_eu]cu]cu]`rY]jT{Y^X[FiO3dJrZiz^n}fDM737%OXEsٱxѡqywwwwzwŤitRRF/13#A>-MQ>XbLXcLDO6XbLTXF>G4IW@CQ>6?,9B-GX>WePZjQUfOWYDEH5AD53>+K@.YFqmVar[\qY^s^au`_r[bt[cvbcvbznNNkR^pWfv_NgQ|PUp[15%>F3fvb\oX\rZZqXZpUSkSSjORbMVmSGaJC_FfbKeI\By^HZoYd4B0NcILW@LZA~UƢinẁ}ǢcRYL;14'AD3?I8@I5JF0OTG4Q[GDM8?J86>,TcLaqYbrYUeRds]XkU[[ERE3|UCu]y[qM;;TA0@I5as^ZoXXmVSlVOdLLaLJ_HC_FF]GI\GJbIFZEklKp\7Tp}aSUY\zծtk=`\=CF3AL:ESAAI9HF/GN@YiOUeQN_HZkVN`KM[DXkX^mZHP=IR?,AN5DS9NbJLaGHV?OYHIS>Q^JIT?OG7GK5]lUYjR^nUMZD^oYbo\Q\FchVS^HGR>P[GGUAV`LXiQUjTXkSNeJX_C,7&2>-BL7APN;EVBH\FM`ILYFVdLXjQLdO?T@FT?J]GIXG->*1=-;K6DWC;I5FVBK]Ffv_`s]SfNM`KXgQ".KYAJZGRdOSfOUhRYiVQbLQdLfwa\rZfwaplev\^sY^s^\r\ZpZ\r\^r[Zr\^r[ZpZat]`s[at]^qY]s`^t^^s^[p\\pZ^s^XoX\r\UjQQfTvoUϢظޥ߫ܧߧ߫ܥݧ'7-UnX]oW[qZZoUXlS[nUSjQ[mUZpWXlSWoXZmUSlS\qWSkSUkU[kTThSVmV\pWXmV\oXWoZYkUWqWXoX]u`XoV\nZ^pW]q[\r\ZoY\rZZmXUmXZmVXmXXlT_s^ZmUZpZ]oZXoXRgMVoXVlXUkXQjXOhQQjVTlTQhSSjXPgQSlXOfQOhSMgQYq\Zt^OfQWoZWl\WlZVjQZoVYp\Wq\ZpZ`r`^q\WkTZnSZmYXmU\pZUmXZpZZmWTjQ]t^\oWZpZZoW^q\_qZ\qX\nU\pZ\qY\oW\mXYmX^pW_oU_qY^r^\oV\r^cv]WnXeyb^nUes`ZpZ`tWawa\nZ_r\`s[_v^\qYiyd[r\ZoXZpZ\pZTlTZpZUjQukNUoU\qX`s[NhPnmLUkSXpVZqXZpZ^tZ\pU\r\^s^\sXQfN\r^?WCXoXSiTUlUWnWRZHNK>J[HM\J<&UQ:RT@NN6PJ8FD)MI1WUA`YG@3#F:a]Me\H]]E=?(JD,D?(PT;JG0YUBcaO`YGTZGHP;LR=HK:LG/?+B:#8)?0,)&#/+*+%,2!01 41 /-57"7:&>B-6?/'2$.;+1C3+80-80)5**;3/@33@43C52>19I?8D:0<2->2/<./@34@09>2FI8?D92C:0A20A267'=?.;?*AJ-GC(7@*37)*91FM9IR;KS=LP7UXHQ=IR=PYCGR;GR;OV>ISQ=8J8@N@@Q@EWBK\F>UCAT@DXC@W??P