├── .gitignore ├── COPYING ├── HEADER ├── Makefile ├── README ├── cl-glu.asd ├── cl-glut-examples.asd ├── cl-glut.asd ├── cl-opengl.asd ├── doc ├── Makefile ├── cl-opengl.texinfo ├── colorize-lisp-examples.lisp ├── gendocs.sh ├── gendocs_template └── style.css ├── examples ├── examples.lisp ├── mesademos │ ├── gears-raw.lisp │ └── gears.lisp ├── misc │ ├── gl-info.lisp │ ├── glut-menu.lisp │ ├── glut-teapot.lisp │ ├── molview.lisp │ ├── opengl-array.lisp │ ├── render-to-texture.lisp │ └── shader-vao.lisp └── redbook │ ├── COPYRIGHT │ ├── bezcurve.lisp │ ├── clip.lisp │ ├── cube.lisp │ ├── double.lisp │ ├── hello.lisp │ ├── lines.lisp │ ├── list.lisp │ ├── model.lisp │ ├── movelight.lisp │ ├── planet.lisp │ ├── polys.lisp │ ├── quadric.lisp │ ├── robot.lisp │ ├── smooth.lisp │ ├── stroke.lisp │ ├── tess-wind.lisp │ ├── tess.lisp │ └── varray.lisp ├── gl ├── bindings-package.lisp ├── bindings.lisp ├── constants.lisp ├── debug-output.lisp ├── dsa.lisp ├── extensions.lisp ├── framebuffer.lisp ├── funcs-gl-glcore-gles1-gles2-glsc2.lisp ├── funcs-gl-glcore-gles1-gles2.lisp ├── funcs-gl-glcore-gles2-glsc2.lisp ├── funcs-gl-glcore-gles2.lisp ├── funcs-gl-glcore.lisp ├── funcs-gl-gles1-gles2-glsc2.lisp ├── funcs-gl-gles1-gles2.lisp ├── funcs-gl-gles1.lisp ├── funcs-gl-gles2-glsc2.lisp ├── funcs-gl-gles2.lisp ├── funcs-gl.lisp ├── funcs-gles1-gles2.lisp ├── funcs-gles1.lisp ├── funcs-gles2.lisp ├── library-common.lisp ├── library-glesv2.lisp ├── library.lisp ├── opengl.lisp ├── package.lisp ├── rasterization.lisp ├── special-constants.lisp ├── special.lisp ├── state.lisp ├── thunks.lisp ├── types.lisp └── util.lisp ├── glu ├── glu.lisp ├── interface.lisp ├── library.lisp └── package.lisp ├── glut ├── callbacks.lisp ├── fonts.lisp ├── geometry.lisp ├── init.lisp ├── interface.lisp ├── library.lisp ├── main.lisp ├── menu-interface.lisp ├── menu.lisp ├── misc.lisp ├── overlay.lisp ├── package.lisp ├── state.lisp └── window.lisp ├── spec ├── github-info.json └── gl.xml └── tools ├── OSSCOPYRIGHT ├── README.md ├── generate-bindings.lisp └── special-cases.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *lx64fsl 3 | *~ 4 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | 2 | Copyright (c) 2004, Oliver Markovic 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | o Redistributions of source code must retain the above copyright notice, 9 | this list of conditions and the following disclaimer. 10 | o Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | o Neither the name of the author nor the names of the contributors may be 14 | used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 18 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 21 | LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 22 | CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 23 | SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 24 | INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 25 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 26 | ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 27 | POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /HEADER: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; file.extension --- Description. 4 | ;;; 5 | ;;; Copyright (c) 2006, Oliver Markovic 6 | ;;; Copyright (c) 2006, Luis Oliveira 7 | ;;; All rights reserved. 8 | ;;; 9 | ;;; Redistribution and use in source and binary forms, with or without 10 | ;;; modification, are permitted provided that the following conditions 11 | ;;; are met: 12 | ;;; 13 | ;;; o Redistributions of source code must retain the above copyright 14 | ;;; notice, this list of conditions and the following disclaimer. 15 | ;;; o Redistributions in binary form must reproduce the above copyright 16 | ;;; notice, this list of conditions and the following disclaimer in the 17 | ;;; documentation and/or other materials provided with the distribution. 18 | ;;; o Neither the name of the author nor the names of the contributors may 19 | ;;; be used to endorse or promote products derived from this software 20 | ;;; without specific prior written permission. 21 | ;;; 22 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 25 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 26 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 27 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 28 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 29 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 30 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 31 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 32 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 | ;;; 34 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*- 2 | 3 | note: 4 | @echo "This Makefile is only for rebuilding the low-level bindings from the" 5 | @echo "official .spec file, it isn't needed for normal use. See tools/README.md" 6 | @echo "for instructions for updating bindings." 7 | 8 | # allow overriding location of sbcl, for example 9 | # CL="~/lisp/clbuild/clbuild --implementation sbcl lisp" make funcs 10 | # CL="sbcl --load ~/quicklisp/setup" make bindings 11 | CL ?= sbcl --noinform --disable-debugger 12 | 13 | bindings: 14 | @$(CL) --no-userinit --script "tools/generate-bindings.lisp" 15 | 16 | REPO="KhronosGroup/OpenGL-Registry" 17 | BRANCH=main 18 | #REPO=3b/OpenGL-Registry 19 | #BRANCH=fix-groups 20 | # fixme: probably should grab xml file with svn instead of wget? 21 | specs: 22 | cd spec && wget -N https://raw.githubusercontent.com/$(REPO)/$(BRANCH)/xml/gl.xml 23 | cd spec && curl "https://api.github.com/repos/$(REPO)/commits/heads/$(BRANCH)" -o github-info.json 24 | 25 | clean: 26 | find . -name ".fasls" | xargs rm -rf 27 | find . \( -name "*.dfsl" -o -name "*.fasl" -o -name "*.fas" -o -name "*.lib" -o -name "*.x86f" -o -name "*.ppcf" -o -name "*.nfasl" -o -name "*.fsl" \) -exec rm {} \; 28 | 29 | .PHONY: bindings specs clean note 30 | # vim: ft=make ts=3 noet 31 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | cl-opengl is a set of bindings and utilities for accessing the OpenGL, 2 | GLU and GLUT APIs using CFFI. 3 | 4 | The examples/ directory contains a couple of examples using cl-glut, 5 | cl-opengl and cl-glu. Note, however, that you can use each of these 6 | independently. In particular, you can use a windowing toolkit other 7 | than (Free)GLUT, if you wish. 8 | 9 | 10 | build-time configuration: 11 | 12 | By default, cl-opengl checks for errors after GL calls where valid, 13 | and disables FP traps around ffi calls to match assumptions of C code 14 | in drivers. 15 | 16 | If these cause performance or other problems, they can be disabled by 17 | pushing :cl-opengl-no-check-error or :cl-opengl-no-masked-traps onto 18 | *features* before compiling cl-opengl (probably will need to clear 19 | .fasl caches or force a rebuild with asdf if cl-opengl has been loaded 20 | previously). When disabling the per-call masked fp traps in cl-opengl, 21 | you might need to do so yourself to run on some drivers. See 22 | with-float-traps-masked in the float-features library for a portable 23 | wrapper. -------------------------------------------------------------------------------- /cl-glu.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; cl-glu.asd --- ASDF system definition for cl-glu. 4 | ;;; 5 | ;;; Copyright (C) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (defsystem cl-glu 34 | :description "Common Lisp bindings to the GLU API v1.3" 35 | :author "Luis Oliveira " 36 | :version "0.1.0" 37 | :licence "BSD" 38 | :depends-on (cffi cl-opengl) 39 | :components 40 | ((:module "glu" 41 | :serial t 42 | :components 43 | ((:file "package") 44 | (:file "library") 45 | (:file "glu") 46 | (:file "interface"))))) 47 | 48 | ;; vim: ft=lisp et 49 | -------------------------------------------------------------------------------- /cl-glut-examples.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; cl-glut-examples.asd --- ASDF system definition for various examples. 4 | ;;; 5 | ;;; Copyright (c) 2006-2007, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (defsystem cl-glut-examples 34 | :description "Examples using cl-opengl, cl-glu and cl-glut." 35 | :depends-on (cffi cl-opengl cl-glu cl-glut) 36 | :components 37 | ((:module "examples" 38 | :components 39 | ((:file "examples") 40 | (:module "redbook" 41 | :depends-on ("examples") 42 | :components 43 | ((:file "hello") 44 | (:file "double") 45 | (:file "lines") 46 | (:file "polys") 47 | (:file "cube") 48 | (:file "model") 49 | (:file "clip") 50 | (:file "planet") 51 | (:file "robot") 52 | (:file "list") 53 | (:file "stroke") 54 | (:file "smooth") 55 | (:file "movelight") 56 | (:file "tess") 57 | (:file "tess-wind") 58 | (:file "quadric") 59 | (:file "bezcurve"))) 60 | (:module "mesademos" 61 | :depends-on ("examples") 62 | :components 63 | ((:file "gears-raw") 64 | #+nil(:file "bounce") 65 | #+nil(:file "gamma") 66 | (:file "gears") 67 | #+nil(:file "offset") 68 | #+nil(:file "reflect") 69 | #+nil(:file "spin") 70 | #+nil(:file "tess-demo") 71 | #+nil(:file "texobj") 72 | #+nil(:file "trdemo"))) 73 | (:module "misc" 74 | :depends-on ("examples") 75 | :components 76 | ((:file "glut-teapot") 77 | (:file "glut-menu") 78 | (:file "render-to-texture") 79 | (:file "opengl-array") 80 | (:file "shader-vao") 81 | (:file "molview") 82 | (:file "gl-info"))))))) 83 | 84 | ;;; vim: ft=lisp et 85 | -------------------------------------------------------------------------------- /cl-glut.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; cl-glut.asd --- ASDF system definition for cl-glut. 4 | ;;; 5 | ;;; Copyright (C) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (defsystem cl-glut 34 | :description "Common Lisp bindings to Freeglut." 35 | :author "Luis Oliveira " 36 | :version "0.1.0" 37 | :licence "BSD" 38 | :depends-on (alexandria cffi cl-opengl) 39 | :components 40 | ((:module "glut" 41 | :components 42 | ((:file "package") 43 | (:file "library" :depends-on ("package")) 44 | (:file "state" :depends-on ("library")) 45 | (:file "callbacks" :depends-on ("library")) 46 | (:file "menu" :depends-on ("library" "callbacks")) 47 | (:file "init" :depends-on ("library" "state" "callbacks" "menu")) 48 | (:file "main" :depends-on ("library" "init")) 49 | (:file "window" :depends-on ("library")) 50 | (:file "overlay" :depends-on ("library")) 51 | (:file "misc" :depends-on ("library")) 52 | (:file "fonts" :depends-on ("library")) 53 | (:file "geometry" :depends-on ("library")) 54 | (:file "interface" 55 | :depends-on ("init" "main" "window" "library" "callbacks")) 56 | (:file "menu-interface" :depends-on ("interface" "menu")))))) 57 | 58 | ;; vim: ft=lisp et 59 | -------------------------------------------------------------------------------- /cl-opengl.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; Copyright (c) 2004, Oliver Markovic 4 | ;;; All rights reserved. 5 | ;;; 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions are met: 8 | ;;; 9 | ;;; o Redistributions of source code must retain the above copyright notice, 10 | ;;; this list of conditions and the following disclaimer. 11 | ;;; o Redistributions in binary form must reproduce the above copyright 12 | ;;; notice, this list of conditions and the following disclaimer in the 13 | ;;; documentation and/or other materials provided with the distribution. 14 | ;;; o Neither the name of the author nor the names of the contributors may be 15 | ;;; used to endorse or promote products derived from this software without 16 | ;;; specific prior written permission. 17 | ;;; 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | ;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 22 | ;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 23 | ;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 24 | ;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 26 | ;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 27 | ;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 28 | ;;; POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (defsystem cl-opengl 31 | :description "Common Lisp bindings to OpenGL." 32 | :license "BSD" 33 | :homepage "https://cl-opengl.common-lisp.dev/" 34 | :source-control (:git "https://github.com/3b/cl-opengl.git") 35 | :bug-tracker "https://github.com/3b/cl-opengl/issues" 36 | :maintainer "Bart Botta <00003b at gmail.com>" 37 | :depends-on (cffi alexandria float-features) 38 | :components 39 | ((:module "gl" 40 | :serial t 41 | :components 42 | ((:file "bindings-package") 43 | (:file "constants") 44 | (:file "library-common") 45 | (:file "library") 46 | (:file "bindings") 47 | (:file "thunks") 48 | (:file "types") 49 | (:file "funcs-gl-glcore-gles1-gles2-glsc2") 50 | (:file "funcs-gl-glcore-gles1-gles2") 51 | (:file "funcs-gl-glcore-gles2-glsc2") 52 | (:file "funcs-gl-glcore-gles2") 53 | (:file "funcs-gl-glcore") 54 | (:file "funcs-gl-gles1-gles2-glsc2") 55 | (:file "funcs-gl-gles1-gles2") 56 | (:file "funcs-gl-gles1") 57 | (:file "funcs-gl-gles2-glsc2") 58 | (:file "funcs-gl-gles2") 59 | (:file "funcs-gl") 60 | (:file "funcs-gles1-gles2") 61 | (:file "funcs-gles1") 62 | (:file "funcs-gles2") 63 | ;; Lispifications. 64 | (:file "package") 65 | (:file "special-constants") 66 | (:file "util") 67 | (:file "opengl") 68 | (:file "rasterization") 69 | (:file "framebuffer") 70 | (:file "special") 71 | (:file "state") 72 | (:file "dsa") 73 | (:file "extensions"))))) 74 | 75 | ;;; load libGLESv2 instead of libGL, and only load es2 functioons 76 | (defsystem cl-opengl/es2 77 | :description "Common Lisp bindings to OpenGLES2/3." 78 | :license "BSD" 79 | :depends-on (cffi alexandria float-features) 80 | :components 81 | ((:module "gl" 82 | :serial t 83 | :components 84 | ((:file "bindings-package") 85 | (:file "constants") 86 | (:file "library-common") 87 | (:file "library-glesv2") 88 | (:file "bindings") 89 | (:file "thunks") 90 | (:file "types") 91 | (:file "funcs-gl-glcore-gles1-gles2-glsc2") 92 | (:file "funcs-gl-glcore-gles1-gles2") 93 | (:file "funcs-gl-glcore-gles2-glsc2") 94 | (:file "funcs-gl-glcore-gles2") 95 | (:file "funcs-gl-gles1-gles2-glsc2") 96 | (:file "funcs-gl-gles1-gles2") 97 | (:file "funcs-gl-gles2-glsc2") 98 | (:file "funcs-gl-gles2") 99 | (:file "funcs-gles1-gles2") 100 | (:file "funcs-gles2") 101 | ;; Lispifications. 102 | (:file "package") 103 | (:file "util") 104 | (:file "opengl") 105 | (:file "rasterization") 106 | (:file "framebuffer") 107 | (:file "special") 108 | (:file "state") 109 | (:file "dsa") 110 | (:file "extensions"))))) 111 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | # -*- Mode: Makefile; tab-width: 3; indent-tabs-mode: t -*- 2 | # 3 | # Makefile --- Make targets for generating the documentation. 4 | # 5 | # Copyright (c) 2006, Luis Oliveira 6 | # All rights reserved. 7 | # 8 | # Redistribution and use in source and binary forms, with or without 9 | # modification, are permitted provided that the following conditions 10 | # are met: 11 | # 12 | # o Redistributions of source code must retain the above copyright 13 | # notice, this list of conditions and the following disclaimer. 14 | # o Redistributions in binary form must reproduce the above copyright 15 | # notice, this list of conditions and the following disclaimer in the 16 | # documentation and/or other materials provided with the distribution. 17 | # o Neither the name of the author nor the names of the contributors may 18 | # be used to endorse or promote products derived from this software 19 | # without specific prior written permission. 20 | # 21 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | docs: 34 | sh gendocs.sh -o cl-opengl --html "--css-include=style.css" cl-opengl "CL-OpenGL User Manual" 35 | 36 | clean: 37 | find . \( -name "*.info" -o -name "*.aux" -o -name "*.cp" -o -name "*.fn" -o -name "*.fns" -o -name "*.ky" -o -name "*.log" -o -name "*.pg" -o -name "*.toc" -o -name "*.tp" -o -name "*.vr" \) -exec rm {} \; 38 | rm -rf cl-opengl 39 | 40 | upload-docs: 41 | rsync -av --delete -e ssh cl-opengl common-lisp.net:/project/cl-opengl/public_html/manual/ 42 | 43 | # vim: ft=make ts=3 noet 44 | -------------------------------------------------------------------------------- /doc/cl-opengl.texinfo: -------------------------------------------------------------------------------- 1 | \input texinfo @c -*-texinfo-*- 2 | @c %**start of header 3 | @setfilename cl-opengl.info 4 | @settitle CL-OpenGL User Manual 5 | @exampleindent 2 6 | 7 | @c ============================= Macros ============================= 8 | @c The following macros are used throughout this manual. Taken from 9 | @c the CFFI User Manual, most of them written by Stephen Compall. 10 | 11 | @macro Function {args} 12 | @defun \args\ 13 | @end defun 14 | @end macro 15 | 16 | @macro Macro {args} 17 | @defmac \args\ 18 | @end defmac 19 | @end macro 20 | 21 | @macro Accessor {args} 22 | @deffn {Accessor} \args\ 23 | @end deffn 24 | @end macro 25 | 26 | @macro GenericFunction {args} 27 | @deffn {Generic Function} \args\ 28 | @end deffn 29 | @end macro 30 | 31 | @macro Type {args} 32 | @deftp {Type} \args\ 33 | @end deftp 34 | @end macro 35 | 36 | @macro Variable {args} 37 | @defvr {Special Variable} \args\ 38 | @end defvr 39 | @end macro 40 | 41 | @macro Condition {args} 42 | @deftp {Condition Type} \args\ 43 | @end deftp 44 | @end macro 45 | 46 | @macro clopengl 47 | @sc{cl-opengl} 48 | @end macro 49 | 50 | @macro impnote {text} 51 | @quotation 52 | @strong{Implementor's note:} @emph{\text\} 53 | @end quotation 54 | @end macro 55 | 56 | @c Info "requires" that x-refs end in a period or comma, or ) in the 57 | @c case of @pxref. So the following implements that requirement for 58 | @c the "See also" subheadings that permeate this manual, but only in 59 | @c Info mode. 60 | @c 61 | @c Most of them are also dictionary symbols, so I use this also to 62 | @c print a pretty section name. Non-dictionary seealsos should not 63 | @c exist; refer to them inline in the descriptive text. 64 | @ifinfo 65 | @macro seealso {name} 66 | @ref{\name\}. 67 | @end macro 68 | @end ifinfo 69 | 70 | @ifnotinfo 71 | @alias seealso = ref 72 | @end ifnotinfo 73 | 74 | @c ============================= Macros ============================= 75 | 76 | 77 | @c Show types, functions, and concepts in the same index. 78 | @syncodeindex tp cp 79 | @syncodeindex fn cp 80 | 81 | @copying 82 | Copyright @copyright{} 2006, Oliver Markovic @* 83 | Copyright @copyright{} 2006, Lu@'{@dotless{i}}s Oliveira 84 | 85 | 86 | @quotation 87 | All rights reserved. 88 | 89 | Redistribution and use in source and binary forms, with or without 90 | modification, are permitted provided that the following conditions 91 | are met: 92 | 93 | @itemize @bullet 94 | @item 95 | Redistributions of source code must retain the above copyright 96 | notice, this list of conditions and the following disclaimer. 97 | 98 | @item 99 | Redistributions in binary form must reproduce the above copyright 100 | notice, this list of conditions and the following disclaimer in the 101 | documentation and/or other materials provided with the distribution. 102 | 103 | @item 104 | Neither the name of the author nor the names of the contributors may 105 | be used to endorse or promote products derived from this software 106 | without specific prior written permission. 107 | @end itemize 108 | 109 | @sc{This software is provided by the copyright holders and contributors 110 | ``as is'' and any express or implied warranties, including, but not 111 | limited to, the implied warranties of merchantability and fitness for 112 | a particular purpose are disclaimed. In no event shall the copyright 113 | owner or contributors be liable for any direct, indirect, incidental, 114 | special, exemplary, or consequential damages (including, but not 115 | limited to, procurement of substitute goods or services; loss of use, 116 | data, or profits; or business interruption) however caused and on any 117 | theory of liability, whether in contract, strict liability, or tort 118 | (including negligence or otherwise) arising in any way out of the use 119 | of this software, even if advised of the possibility of such damage.} 120 | @end quotation 121 | @end copying 122 | 123 | @titlepage 124 | @title @clopengl{} User Manual 125 | @c @subtitle Version X.X 126 | @c @author foobar 127 | 128 | @page 129 | @vskip 0pt plus 1filll 130 | @insertcopying 131 | @end titlepage 132 | 133 | @contents 134 | 135 | @ifnottex 136 | @top cl-opengl 137 | @insertcopying 138 | @end ifnottex 139 | 140 | @menu 141 | * Introduction:: 142 | * OpenGL:: 143 | * Comprehensive Index:: 144 | @end menu 145 | 146 | @c =================================================================== 147 | @node Introduction 148 | @chapter Introduction 149 | 150 | @clopengl{} is a set of @acronym{CFFI} bindings to @sc{OpenGL} 151 | 2.0. @acronym{GLU} and Free@acronym{GLUT} bindings are also 152 | included. 153 | 154 | Notice that the @acronym{GLUT} bindings are mostly provided 155 | for the purpose of supporting the examples included in the 156 | distribution and you are free to use another windowing toolkit. 157 | 158 | @c =================================================================== 159 | @node OpenGL 160 | @chapter OpenGL 161 | 162 | @c =================================================================== 163 | @node GLU 164 | @chapter GLU 165 | 166 | @c =================================================================== 167 | @node GLUT 168 | @chapter GLUT 169 | 170 | @c =================================================================== 171 | @node Comprehensive Index 172 | @unnumbered Index 173 | @printindex cp 174 | 175 | @bye 176 | -------------------------------------------------------------------------------- /doc/gendocs_template: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 13 | 14 | 15 | 16 | %%TITLE%% 17 | 18 | 19 | 20 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 |

%%TITLE%%

174 | 175 | 176 |
last updated %%DATE%%
177 | 178 | 188 | 189 |
190 | 191 |

This document is available in the following formats:

192 | 193 | 219 | 220 |

(This page was generated by the %%SCRIPTNAME%% 221 | script.)

222 | 223 |
224 |

225 | Return to cl-opengl's home page. 226 |

227 | 228 | 239 | 240 |

241 | Copyright (C) 2006 Oliver Markovic <entrox at entrox.org>
242 | Copyright (C) 2006 Luís Oliveira <loliveira at common-lisp.net> 243 | 248 |

249 | 250 |

251 | Updated: %%DATE%% 252 | 253 | 254 | 255 |

256 |
257 | 258 | 259 | 260 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | body {font-family: century schoolbook, serif; 2 | line-height: 1.3; 3 | padding-left: 5em; padding-right: 1em; 4 | padding-bottom: 1em; max-width: 60em;} 5 | table {border-collapse: collapse} 6 | span.roman { font-family: century schoolbook, serif; font-weight: normal; } 7 | h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif} 8 | /*h4 {padding-top: 0.75em;}*/ 9 | dfn {font-family: inherit; font-variant: italic; font-weight: bolder } 10 | kbd {font-family: monospace; text-decoration: underline} 11 | var {font-family: Helvetica, sans-serif; font-variant: slanted} 12 | td {padding-right: 1em; padding-left: 1em} 13 | sub {font-size: smaller} 14 | .node {padding: 0; margin: 0} 15 | 16 | .lisp { font-family: monospace; 17 | background-color: #F4F4F4; border: 1px solid #AAA; 18 | padding-top: 0.5em; padding-bottom: 0.5em; } 19 | 20 | /* coloring */ 21 | 22 | .lisp-bg { background-color: #F4F4F4 ; color: black; } 23 | .lisp-bg:hover { background-color: #F4F4F4 ; color: black; } 24 | 25 | .symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;} 26 | a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 27 | a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 28 | a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 29 | a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 30 | .special { font-weight: bold; color: #FF5000; background-color: inherit; } 31 | .keyword { font-weight: bold; color: #770000; background-color: inherit; } 32 | .comment { font-weight: normal; color: #007777; background-color: inherit; } 33 | .string { font-weight: bold; color: #777777; background-color: inherit; } 34 | .character { font-weight: bold; color: #0055AA; background-color: inherit; } 35 | .syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; } 36 | span.paren1 { font-weight: bold; color: #777777; } 37 | span.paren1:hover { color: #777777; background-color: #BAFFFF; } 38 | span.paren2 { color: #777777; } 39 | span.paren2:hover { color: #777777; background-color: #FFCACA; } 40 | span.paren3 { color: #777777; } 41 | span.paren3:hover { color: #777777; background-color: #FFFFBA; } 42 | span.paren4 { color: #777777; } 43 | span.paren4:hover { color: #777777; background-color: #CACAFF; } 44 | span.paren5 { color: #777777; } 45 | span.paren5:hover { color: #777777; background-color: #CAFFCA; } 46 | span.paren6 { color: #777777; } 47 | span.paren6:hover { color: #777777; background-color: #FFBAFF; } 48 | -------------------------------------------------------------------------------- /examples/examples.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | (defpackage #:cl-glut-examples 4 | (:use #:cl) 5 | (:export #:list-examples #:run-examples 6 | #:gl-info)) 7 | 8 | (in-package #:cl-glut-examples) 9 | 10 | (defparameter +examples+ 11 | '(("Redbook Examples" 12 | rb-double rb-hello #|rb-varray|# rb-lines rb-polys rb-cube rb-model 13 | rb-clip rb-planet rb-robot rb-list rb-stroke rb-smooth rb-movelight rb-tess rb-tess-wind rb-quadric rb-bezcurve) 14 | ("Mesa Demos" 15 | gears) 16 | ("SGI Samples") 17 | ("Other Examples" 18 | glut-teapot 19 | glut-menu 20 | render-to-texture 21 | misc-opengl-array 22 | shader-vao 23 | molview))) 24 | 25 | ;;; export symbols 26 | (dolist (section +examples+) 27 | (export (cdr section) '#:cl-glut-examples)) 28 | 29 | (defun list-examples () 30 | (format t "~&CL-GLUT-EXAMPLES contains the following examples:~%~%") 31 | (dolist (section +examples+) 32 | (format t "~&~A:~%~{~@[~<~%~:; ~:@(~A~)~>~]~}~%~%" 33 | (car section) (cdr section)))) 34 | 35 | (defun run-examples () 36 | "Run all the CL-GLUT examples." 37 | (let ((glut:*run-main-loop-after-display* nil)) 38 | (dolist (section +examples+) 39 | (mapc #'funcall (cdr section))) 40 | (glut:main-loop))) 41 | -------------------------------------------------------------------------------- /examples/misc/glut-menu.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; glut-menu.lisp --- Simple usage of glut:menu-mixin 3 | 4 | (in-package #:cl-glut-examples) 5 | 6 | 7 | (defclass glut-menu-window (glut:window) 8 | () 9 | (:default-initargs :width 512 :height 512 :title "glut-menu.lisp" 10 | :mode '(:single :rgb :depth) 11 | :left-menu '("foo!" 12 | :bar 13 | :add-right-menu 14 | (:menu sub-menu 15 | ("1" :one) 16 | "2" 17 | :3)))) 18 | 19 | (defmethod glut:display-window :before ((w glut-menu-window)) 20 | (gl:clear-color 0 0 0 0) 21 | (gl:cull-face :back) 22 | (gl:depth-func :less) 23 | (gl:disable :dither) 24 | (gl:shade-model :smooth) 25 | (gl:light-model :light-model-local-viewer 1) 26 | (gl:color-material :front :ambient-and-diffuse) 27 | (gl:enable :light0 :lighting :cull-face :depth-test)) 28 | 29 | (defmethod glut:display ((window glut-menu-window)) 30 | (gl:load-identity) 31 | (gl:translate 0 0 -5) 32 | (gl:rotate 30 1 1 0) 33 | (gl:light :light0 :position '(0 1 1 0)) 34 | (gl:light :light0 :diffuse '(0.2 0.4 0.6 0)) 35 | (gl:clear :color-buffer :depth-buffer) 36 | (gl:color 1 1 1) 37 | (gl:front-face :cw) 38 | (glut:solid-teapot 1.3) 39 | (gl:front-face :ccw) 40 | (gl:flush)) 41 | 42 | (defmethod glut:reshape ((window glut-menu-window) width height) 43 | (gl:viewport 0 0 width height) 44 | (gl:matrix-mode :projection) 45 | (gl:load-identity) 46 | (glu:perspective 50 (/ width height) 0.5 20) 47 | (gl:matrix-mode :modelview) 48 | (gl:load-identity)) 49 | 50 | (defmethod glut:keyboard ((window glut-menu-window) key x y) 51 | (declare (ignore x y)) 52 | (when (eql key #\Esc) 53 | (glut:destroy-current-window))) 54 | 55 | (defmethod glut::menu ((window glut-menu-window) menu id) 56 | (format t "~&got menu item ~s from menu ~s~%" menu id) 57 | (case id 58 | (:add-right-menu 59 | (setf (glut::right-menu window) 60 | '(("add menu to middle mouse button" :add-middle) 61 | :exit))) 62 | (:add-middle 63 | (setf (glut::middle-menu window) 64 | '(("change left menu" :change-left)))) 65 | (:exit 66 | (glut:destroy-current-window)))) 67 | 68 | ;; different way of handling menu events, method per item 69 | (defmethod glut::menu ((window glut-menu-window) (menu (eql :middle-button)) 70 | (id (eql :change-left))) 71 | (format t "~&clicked middle menu|change left!~%") 72 | (setf (glut::left-menu window) 73 | (alexandria:shuffle (copy-seq (glut::left-menu window))))) 74 | 75 | 76 | (defun glut-menu () 77 | (glut:display-window (make-instance 'glut-menu-window))) 78 | 79 | #++ 80 | (ql:quickload 'cl-glut-examples) 81 | #++ 82 | (glut-menu) 83 | #++ 84 | (glut:show-window) 85 | -------------------------------------------------------------------------------- /examples/misc/glut-teapot.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; glut-teapot.lisp --- Simple usage of glut:solid-teapot. 3 | 4 | (in-package #:cl-glut-examples) 5 | 6 | (defclass glut-teapot-window (glut:window) 7 | () 8 | (:default-initargs :width 250 :height 250 :title "glut-teapot.lisp" 9 | :mode '(:single :rgb :depth))) 10 | 11 | (defmethod glut:display-window :before ((w glut-teapot-window)) 12 | (gl:clear-color 0 0 0 0) 13 | (gl:cull-face :back) 14 | (gl:depth-func :less) 15 | (gl:disable :dither) 16 | (gl:shade-model :smooth) 17 | (gl:light-model :light-model-local-viewer 1) 18 | (gl:color-material :front :ambient-and-diffuse) 19 | (gl:enable :light0 :lighting :cull-face :depth-test)) 20 | 21 | (defmethod glut:display ((window glut-teapot-window)) 22 | (gl:load-identity) 23 | (gl:translate 0 0 -5) 24 | (gl:rotate 30 1 1 0) 25 | (gl:light :light0 :position '(0 1 1 0)) 26 | (gl:light :light0 :diffuse '(0.2 0.4 0.6 0)) 27 | (gl:clear :color-buffer :depth-buffer) 28 | (gl:color 1 1 1) 29 | (gl:front-face :cw) 30 | (glut:solid-teapot 1.3) 31 | (gl:front-face :ccw) 32 | (gl:flush)) 33 | 34 | (defmethod glut:reshape ((window glut-teapot-window) width height) 35 | (gl:viewport 0 0 width height) 36 | (gl:matrix-mode :projection) 37 | (gl:load-identity) 38 | (glu:perspective 50 (/ width height) 0.5 20) 39 | (gl:matrix-mode :modelview) 40 | (gl:load-identity)) 41 | 42 | (defmethod glut:keyboard ((window glut-teapot-window) key x y) 43 | (declare (ignore x y)) 44 | (when (eql key #\Esc) 45 | (glut:destroy-current-window))) 46 | 47 | (defun glut-teapot () 48 | (glut:display-window (make-instance 'glut-teapot-window))) -------------------------------------------------------------------------------- /examples/misc/opengl-array.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | 3 | (in-package #:cl-glut-examples) 4 | 5 | (gl:define-gl-array-format position-color 6 | (gl:vertex :type :float :components (x y)) 7 | (gl:color :type :unsigned-char :components (r g b))) 8 | 9 | (defclass opengl-array-window (glut:window) 10 | ((vertex-array :accessor vertex-array 11 | :initform (gl:alloc-gl-array 'position-color 5)) 12 | (indices-array :accessor indices-array 13 | :initform (gl:alloc-gl-array :unsigned-short 10))) 14 | (:default-initargs :title "opengl-array.lisp")) 15 | 16 | (defmethod glut:display-window :before ((w opengl-array-window)) 17 | (dotimes (i 5) 18 | (let ((phi (float (+ (/ pi 2) (* (/ i 5) (* 2 pi))) 0.0))) 19 | ;; vertices 20 | (setf (gl:glaref (vertex-array w) i 'x) (cos phi)) 21 | (setf (gl:glaref (vertex-array w) i 'y) (sin phi)) 22 | ;; indices 23 | (setf (gl:glaref (indices-array w) (* 2 i)) i) 24 | (setf (gl:glaref (indices-array w) (1+ (* 2 i))) (mod (+ i 2) 5)) 25 | ;; colors 26 | (setf (gl:glaref (vertex-array w) i 'r) 255) 27 | (setf (gl:glaref (vertex-array w) i 'g) 0) 28 | (setf (gl:glaref (vertex-array w) i 'b) 0))) 29 | (gl:clear-color 0 0 0 0)) 30 | 31 | (defmethod glut:display ((w opengl-array-window)) 32 | (gl:clear :color-buffer) 33 | (gl:enable-client-state :vertex-array) 34 | (gl:enable-client-state :color-array) 35 | (gl:bind-gl-vertex-array (vertex-array w)) 36 | (gl:draw-elements :lines (indices-array w)) 37 | (gl:flush)) 38 | 39 | (defmethod glut:close ((w opengl-array-window)) 40 | (gl:free-gl-array (vertex-array w)) 41 | (gl:free-gl-array (indices-array w))) 42 | 43 | (defun misc-opengl-array () 44 | (glut:display-window (make-instance 'opengl-array-window))) 45 | -------------------------------------------------------------------------------- /examples/misc/render-to-texture.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; render-to-texture.lisp --- Simple usage of the EXT_framebuffer_object extension 3 | 4 | (in-package #:cl-glut-examples) 5 | 6 | (defclass render-to-texture-window (glut:window) 7 | ((texture :accessor texture) 8 | (framebuffer :accessor framebuffer)) 9 | (:default-initargs :width 640 :height 480 :title "render-to-texture.lisp" 10 | :mode '(:double :rgb :depth :multisample))) 11 | 12 | ;;; Do initialization here: 13 | ;;; 14 | ;;; In order to render to a texture, we need to setup a complete framebuffer, 15 | ;;; which consists of color-buffers, a depth-buffer and a stencil-buffer. 16 | ;;; In our simple case, we setup a texture as color-buffer and add a 24-bit 17 | ;;; depth-buffer so we can render the teapot correctly. We don't attach a 18 | ;;; stencil-buffer since it isn't needed in this simple example. 19 | (defmethod glut:display-window :before ((w render-to-texture-window)) 20 | (let ((framebuffer (first (gl:gen-framebuffers-ext 1))) 21 | (depthbuffer (first (gl:gen-renderbuffers-ext 1))) 22 | (texture (first (gl:gen-textures 1)))) 23 | ;; setup framebuffer 24 | (gl:bind-framebuffer-ext :framebuffer-ext framebuffer) 25 | 26 | ;; setup texture and attach it to the framebuffer 27 | (gl:bind-texture :texture-2d texture) 28 | (gl:tex-parameter :texture-2d :texture-min-filter :linear-mipmap-linear) 29 | (gl:tex-parameter :texture-2d :texture-mag-filter :linear) 30 | (gl:tex-image-2d :texture-2d 0 :rgba 512 512 0 :rgba :unsigned-byte (cffi:null-pointer)) 31 | (gl:generate-mipmap-ext :texture-2d) 32 | (gl:bind-texture :texture-2d 0) 33 | (gl:framebuffer-texture-2d-ext :framebuffer-ext 34 | :color-attachment0-ext 35 | :texture-2d 36 | texture 37 | 0) 38 | 39 | ;; setup depth-buffer and attach it to the framebuffer 40 | (gl:bind-renderbuffer-ext :renderbuffer-ext depthbuffer) 41 | (gl:renderbuffer-storage-ext :renderbuffer-ext :depth-component24 512 512) 42 | (gl:framebuffer-renderbuffer-ext :framebuffer-ext 43 | :depth-attachment-ext 44 | :renderbuffer-ext 45 | depthbuffer) 46 | 47 | ;; validate framebuffer 48 | (let ((framebuffer-status (gl:check-framebuffer-status-ext :framebuffer-ext))) 49 | (unless (gl::enum= framebuffer-status :framebuffer-complete-ext) 50 | (error "Framebuffer not complete: ~A." framebuffer-status))) 51 | 52 | (setf (texture w) texture 53 | (framebuffer w) framebuffer)) 54 | 55 | (gl:enable :depth-test :multisample)) 56 | 57 | (defmethod glut:display ((window render-to-texture-window)) 58 | (gl:load-identity) 59 | 60 | ;; We render the teapot in the first pass. To do this, we switch to our 61 | ;; custom framebuffer, set the viewport to the texture size and render it 62 | ;; normally. 63 | (gl:bind-framebuffer-ext :framebuffer-ext (framebuffer window)) 64 | (gl:viewport 0 0 512 512) 65 | (gl:matrix-mode :projection) 66 | (gl:load-identity) 67 | (glu:perspective 50 1 0.5 20) 68 | (gl:matrix-mode :modelview) 69 | 70 | (draw-teapot) 71 | 72 | ;; Now that the texture has been updated, we can draw the spinning quad(s) in 73 | ;; the second pass. We want to render into the window, so we need to bind to 74 | ;; the default framebuffer, which always has the ID 0. 75 | (gl:bind-framebuffer-ext :framebuffer-ext 0) 76 | (gl:viewport 0 0 (glut:width window) (glut:height window)) 77 | (gl:matrix-mode :projection) 78 | (gl:load-identity) 79 | (glu:perspective 50 (/ (glut:width window) (glut:height window)) 0.5 20) 80 | (gl:matrix-mode :modelview) 81 | 82 | (draw-spinning-quad (texture window)) 83 | 84 | (glut:swap-buffers)) 85 | 86 | (defmethod glut:idle ((window render-to-texture-window)) 87 | (glut:post-redisplay)) 88 | 89 | (defmethod glut:reshape ((window render-to-texture-window) width height) 90 | (setf (glut:width window) width 91 | (glut:height window) height)) 92 | 93 | (defmethod glut:keyboard ((window render-to-texture-window) key x y) 94 | (declare (ignore x y)) 95 | (when (eql key #\Esc) 96 | (glut:destroy-current-window))) 97 | 98 | (defun render-to-texture () 99 | (glut:display-window (make-instance 'render-to-texture-window))) 100 | 101 | 102 | ;;; FIXME: the rotations are dependent on the frame rate. 103 | ;;; I'd need to calculate the frametime, but I'm too lazy right now. 104 | 105 | (defparameter *teapot-rotation-x* 0.0) 106 | (defparameter *teapot-rotation-y* 0.0) 107 | (defparameter *teapot-rotation-z* 0.0) 108 | 109 | (defun draw-teapot () 110 | (gl:clear-color 0 0.3 0.5 1.0) 111 | (gl:clear :color-buffer :depth-buffer) 112 | 113 | (gl:disable :blend :texture-2d) 114 | (gl:enable :lighting :light0 :depth-test) 115 | 116 | (gl:color-material :front :ambient-and-diffuse) 117 | 118 | (gl:light :light0 :position '(0 1 1 0)) 119 | (gl:light :light0 :diffuse '(0.2 0.4 0.6 0)) 120 | 121 | (gl:load-identity) 122 | (gl:translate 0 0 -4) 123 | (gl:rotate *teapot-rotation-x* 1 0 0) 124 | (gl:rotate *teapot-rotation-y* 0 1 0) 125 | (gl:rotate *teapot-rotation-z* 0 0 1) 126 | 127 | (gl:color 1 1 1) 128 | (glut:solid-teapot 1.3) 129 | 130 | (incf *teapot-rotation-x* 0.01) 131 | (incf *teapot-rotation-y* 0.05) 132 | (incf *teapot-rotation-z* 0.03)) 133 | 134 | 135 | (defparameter *quad-rotation* 0.0) 136 | 137 | (defun draw-spinning-quad (texture) 138 | (gl:clear-color 0 0 0 0) 139 | (gl:clear :color-buffer :depth-buffer) 140 | 141 | (gl:disable :lighting) 142 | (gl:enable :blend :texture-2d :depth-test) 143 | (gl:blend-func :src-alpha :one) 144 | 145 | (gl:load-identity) 146 | (gl:translate 0 -1 -3) 147 | (gl:rotate *quad-rotation* 0 1 0) 148 | 149 | (gl:bind-texture :texture-2d texture) 150 | 151 | ;; the teapot texture gets regenerated every frame, so we also need to 152 | ;; recalculate the mipmaps every frame since trilinear filtering is enabled. 153 | (gl:generate-mipmap-ext :texture-2d) 154 | 155 | ;; draw textured quad 156 | (gl:color 1 1 1) 157 | (gl:with-primitives :quads 158 | (gl:tex-coord 0 1) 159 | (gl:vertex -1 2) 160 | (gl:tex-coord 1 1) 161 | (gl:vertex 1 2) 162 | (gl:tex-coord 1 0) 163 | (gl:vertex 1 0) 164 | (gl:tex-coord 0 0) 165 | (gl:vertex -1 0)) 166 | 167 | ;; draw fake reflection 168 | (gl:with-primitives :quads 169 | (gl:color 1 1 1 0.7) 170 | (gl:tex-coord 0 0) 171 | (gl:vertex -1 0) 172 | (gl:tex-coord 1 0) 173 | (gl:vertex 1 0) 174 | (gl:tex-coord 1 0.5) 175 | (gl:color 1 1 1 0) 176 | (gl:vertex 1 -1) 177 | (gl:tex-coord 0 0.5) 178 | (gl:vertex -1 -1)) 179 | (incf *quad-rotation* 0.1)) 180 | -------------------------------------------------------------------------------- /examples/redbook/COPYRIGHT: -------------------------------------------------------------------------------- 1 | The original Red Book examples carry the following copyright and 2 | permission notices: 3 | 4 | Copyright (c) 1993-1997, Silicon Graphics, Inc. 5 | ALL RIGHTS RESERVED 6 | 7 | Permission to use, copy, modify, and distribute this software for any 8 | purpose and without fee is hereby granted, provided that the above 9 | copyright notice appear in all copies and that both the copyright 10 | notice and this permission notice appear in supporting documentation, 11 | and that the name of Silicon Graphics, Inc. not be used in advertising 12 | or publicity pertaining to distribution of the software without 13 | specific, written prior permission. 14 | 15 | THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS" AND 16 | WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE, INCLUDING 17 | WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR FITNESS FOR A 18 | PARTICULAR PURPOSE. IN NO EVENT SHALL SILICON GRAPHICS, INC. BE 19 | LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT, SPECIAL, INCIDENTAL, 20 | INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES 21 | WHATSOEVER, INCLUDING WITHOUT LIMITATION, LOSS OF PROFIT, LOSS OF USE, 22 | SAVINGS OR REVENUE, OR THE CLAIMS OF THIRD PARTIES, WHETHER OR NOT 23 | SILICON GRAPHICS, INC. HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 24 | LOSS, HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ARISING OUT OF OR 25 | IN CONNECTION WITH THE POSSESSION, USE OR PERFORMANCE OF THIS 26 | SOFTWARE. 27 | 28 | US Government Users Restricted Rights 29 | 30 | Use, duplication, or disclosure by the Government is subject to 31 | restrictions set forth in FAR 52.227.19(c)(2) or subparagraph 32 | (c)(1)(ii) of the Rights in Technical Data and Computer Software 33 | clause at DFARS 252.227-7013 and/or in similar or successor clauses in 34 | the FAR or the DOD or NASA FAR Supplement. Unpublished-- rights 35 | reserved under the copyright laws of the United States. 36 | Contractor/manufacturer is Silicon Graphics, Inc., 2011 N. Shoreline 37 | Blvd., Mountain View, CA 94039-7311. OpenGL(R) is a registered 38 | trademark of Silicon Graphics, Inc. -------------------------------------------------------------------------------- /examples/redbook/bezcurve.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; bezcurve.lisp --- Lisp version of bezcurve.c (Red Book examples) 3 | ;;; 4 | ;;; This program uses evaluators to draw a Bezier curve. 5 | 6 | (in-package #:cl-glut-examples) 7 | 8 | (defclass bezcurve-window (glut:window) 9 | ((control-points :accessor control-points :initform (make-array '(4 3) :initial-contents 10 | '((-4 -4 0) (-2 4 0) 11 | (2 -4 0) (4 4 0))))) 12 | (:default-initargs :width 500 :height 500 :title "bezcurve.lisp" 13 | :mode '(:single :rgb))) 14 | 15 | (defmethod glut:display-window :before ((window bezcurve-window)) 16 | (gl:clear-color 0 0 0 0) 17 | (gl:shade-model :flat) 18 | (gl:map1 :map1-vertex-3 0 1 (control-points window)) 19 | (gl:enable :map1-vertex-3)) 20 | 21 | (defmethod glut:display ((window bezcurve-window)) 22 | (gl:clear :color-buffer-bit) 23 | (gl:color 1 1 1) 24 | 25 | (gl:with-primitive :line-strip 26 | (loop for i from 0 to 30 27 | do (gl:eval-coord-1 (/ i 30)))) 28 | 29 | ;; The following code displays the control points as dots. 30 | (gl:point-size 5) 31 | (gl:color 1 1 0) 32 | 33 | (gl:with-primitive :points 34 | (loop for i from 0 below 4 35 | for l = (* 3 i) 36 | do (gl:vertex 37 | (row-major-aref (control-points window) l) 38 | (row-major-aref (control-points window) (+ 1 l)) 39 | (row-major-aref (control-points window) (+ 2 l))))) 40 | (gl:flush)) 41 | 42 | (defmethod glut:reshape ((w bezcurve-window) width height) 43 | (gl:viewport 0 0 width height) 44 | (gl:matrix-mode :projection) 45 | (gl:load-identity) 46 | 47 | (if (<= width height) 48 | (gl:ortho -5 5 (/ (* -5 height) width) 49 | (/ (* 5 height) width) -5 5) 50 | (gl:ortho (/ (* -5 width) height) (/ (* 5 width) height) 51 | -5 5 -5 5)) 52 | (gl:matrix-mode :modelview) 53 | (gl:load-identity)) 54 | 55 | (defmethod glut:keyboard ((w bezcurve-window) key x y) 56 | (declare (ignore x y)) 57 | (when (eql key #\Esc) 58 | (glut:destroy-current-window))) 59 | 60 | (defun rb-bezcurve () 61 | (glut:display-window (make-instance 'bezcurve-window))) -------------------------------------------------------------------------------- /examples/redbook/clip.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; clip.lisp --- Lisp version of clip.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates arbitrary clipping planes. 9 | 10 | (in-package #:cl-glut-examples) 11 | 12 | (defclass clip-window (glut:window) 13 | () 14 | (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 15 | :mode '(:single :rgb) :title "clip.lisp")) 16 | 17 | (defmethod glut:display-window :before ((w clip-window)) 18 | (gl:clear-color 0 0 0 0) 19 | (gl:shade-model :flat)) 20 | 21 | (defmethod glut:display ((w clip-window)) 22 | (gl:clear :color-buffer) 23 | (gl:color 1 1 1) 24 | (gl:with-pushed-matrix 25 | (gl:translate 0 0 -5) 26 | ;; clip lower half -- y < 0 27 | (gl:clip-plane :clip-plane0 '(0 1 0 0)) 28 | (gl:enable :clip-plane0) 29 | ;; clip left half -- x < 0 30 | (gl:clip-plane :clip-plane1 '(1 0 0 0)) 31 | (gl:enable :clip-plane1) 32 | ;; sphere 33 | (gl:rotate 90 1 0 0) 34 | (glut:wire-sphere 1 20 16)) 35 | (gl:flush)) 36 | 37 | (defmethod glut:reshape ((w clip-window) width height) 38 | (gl:viewport 0 0 width height) 39 | (gl:matrix-mode :projection) 40 | (gl:load-identity) 41 | (glu:perspective 60 (/ width height) 1 20) 42 | (gl:matrix-mode :modelview)) 43 | 44 | (defmethod glut:keyboard ((w clip-window) key x y) 45 | (declare (ignore x y)) 46 | (when (eql key #\Esc) 47 | (glut:destroy-current-window))) 48 | 49 | (defun rb-clip () 50 | (glut:display-window (make-instance 'clip-window))) 51 | -------------------------------------------------------------------------------- /examples/redbook/cube.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; cube.lisp --- Lisp version of cube.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates a single modeling transformation, 9 | ;;; GL:SCALE and a single viewing transformation, GLU:LOOK-AT. 10 | ;;; A wireframe cube is rendered. 11 | 12 | (in-package #:cl-glut-examples) 13 | 14 | (defclass cube-window (glut:window) 15 | () 16 | (:default-initargs :width 500 :height 500 :title "cube.lisp" 17 | :mode '(:single :rgb))) 18 | 19 | (defmethod glut:display-window :before ((w cube-window)) 20 | (gl:clear-color 0 0 0 0) 21 | (gl:shade-model :flat)) 22 | 23 | (defmethod glut:display ((w cube-window)) 24 | (gl:clear :color-buffer) 25 | (gl:color 1 1 1) 26 | (gl:load-identity) ; clear the matrix 27 | ;; viewing transformation 28 | (glu:look-at 0 0 5 0 0 0 0 1 0) 29 | ;; modeling transformation 30 | (gl:scale 1 2 1) 31 | (glut:wire-cube 1) 32 | (gl:flush)) 33 | 34 | (defmethod glut:reshape ((w cube-window) width height) 35 | (gl:viewport 0 0 width height) 36 | (gl:matrix-mode :projection) 37 | (gl:load-identity) 38 | (gl:frustum -1 1 -1 1 1.5 20) 39 | (gl:matrix-mode :modelview)) 40 | 41 | (defmethod glut:keyboard ((w cube-window) key x y) 42 | (declare (ignore x y)) 43 | (when (eql key #\Esc) 44 | (glut:destroy-current-window))) 45 | 46 | (defun rb-cube () 47 | (glut:display-window (make-instance 'cube-window))) 48 | -------------------------------------------------------------------------------- /examples/redbook/double.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; double.lisp --- Lisp version of double.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This is a simple double buffered program. 9 | ;;; Pressing the left mouse button rotates the rectangle. 10 | ;;; Pressing the middle mouse button stops the rotation. 11 | 12 | (in-package #:cl-glut-examples) 13 | 14 | (defclass double-window (glut:window) 15 | ((spin :initform 0.0)) 16 | (:default-initargs :width 250 :height 250 :pos-x 100 :pos-y 100 17 | :mode '(:double :rgb) :title "double.lisp")) 18 | 19 | (defmethod glut:display-window :before ((w double-window)) 20 | (gl:clear-color 0 0 0 0) 21 | (gl:shade-model :flat)) 22 | 23 | (defmethod glut:display ((w double-window)) 24 | (gl:clear :color-buffer) 25 | (gl:with-pushed-matrix 26 | (gl:rotate (slot-value w 'spin) 0 0 1) 27 | (gl:color 1 1 1) 28 | (gl:rect -25 -25 25 25)) 29 | (glut:swap-buffers)) 30 | 31 | (defmethod glut:idle ((w double-window)) 32 | (with-slots (spin) w 33 | (incf spin 2.0) 34 | (when (> spin 360.0) 35 | (decf spin 360.0)) 36 | (glut:post-redisplay))) 37 | 38 | (defmethod glut:reshape ((w double-window) width height) 39 | (gl:viewport 0 0 width height) 40 | (gl:matrix-mode :projection) 41 | (gl:load-identity) 42 | (gl:ortho -50 50 -50 50 -1 1) 43 | (gl:matrix-mode :modelview) 44 | (gl:load-identity)) 45 | 46 | (defmethod glut:mouse ((w double-window) button state x y) 47 | (declare (ignore x y)) 48 | (case button 49 | (:left-button 50 | (when (eq state :down) 51 | (glut:enable-event w :idle))) 52 | ((:middle-button :right-button) 53 | (when (eq state :down) 54 | (glut:disable-event w :idle))))) 55 | 56 | (defun rb-double () 57 | (glut:display-window (make-instance 'double-window))) 58 | -------------------------------------------------------------------------------- /examples/redbook/hello.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; hello.lisp --- Lisp version of hello.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This is a simple, introductory OpenGL program. 9 | 10 | ;;; Declare initial window size, position, and display mode (single 11 | ;;; buffer and RGBA). Open window with "hello" in its title bar. 12 | ;;; Call initialization routines. Register callback function to 13 | ;;; display graphics. Enter main loop and process events. 14 | 15 | (in-package #:cl-glut-examples) 16 | 17 | (defclass hello-window (glut:window) 18 | () 19 | (:default-initargs :pos-x 100 :pos-y 100 :width 250 :height 250 20 | :mode '(:single :rgb) :title "hello.lisp")) 21 | 22 | (defmethod glut:display-window :before ((w hello-window)) 23 | ;; Select clearing color. 24 | (gl:clear-color 0 0 0 0) 25 | ;; Initialize viewing values. 26 | (gl:matrix-mode :projection) 27 | (gl:load-identity) 28 | (gl:ortho 0 1 0 1 -1 1)) 29 | 30 | (defmethod glut:display ((w hello-window)) 31 | (gl:clear :color-buffer) 32 | ;; Draw white polygon (rectangle) with corners at 33 | ;; (0.25, 0.25, 0.0) and (0.75, 0.75, 0.0). 34 | (gl:color 1 1 1) 35 | (gl:with-primitive :polygon 36 | (gl:vertex 0.25 0.25 0) 37 | (gl:vertex 0.75 0.25 0) 38 | (gl:vertex 0.75 0.75 0) 39 | (gl:vertex 0.25 0.75 0)) 40 | ;; Start processing buffered OpenGL routines. 41 | (gl:flush)) 42 | 43 | (defun rb-hello () 44 | (glut:display-window (make-instance 'hello-window))) 45 | -------------------------------------------------------------------------------- /examples/redbook/lines.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; lines.lisp --- Lisp version of lines.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates geometric primitives and 9 | ;;; their attributes. 10 | 11 | (in-package #:cl-glut-examples) 12 | 13 | (defun draw-one-line (x1 y1 x2 y2) 14 | (gl:with-primitives :lines 15 | (gl:vertex x1 y1) 16 | (gl:vertex x2 y2))) 17 | 18 | (defclass lines-window (glut:window) 19 | () 20 | (:default-initargs 21 | :width 400 :height 150 :pos-x 100 :pos-y 100 22 | :mode '(:single :rgb) :title "lines.lisp")) 23 | 24 | (defmethod glut:display-window :before ((w lines-window)) 25 | (gl:clear-color 0 0 0 0) 26 | (gl:shade-model :flat)) 27 | 28 | (defmethod glut:display ((w lines-window)) 29 | (gl:clear :color-buffer) 30 | ;; Select white for all lines. 31 | (gl:color 1 1 1) 32 | ;; In 1st row, 3 lines, each with a different stipple. 33 | (gl:enable :line-stipple) 34 | (gl:line-stipple 1 #b0000000100000001) ; dotted 35 | (draw-one-line 50 125 150 125) 36 | (gl:line-stipple 1 #b0000000011111111) ; dashed 37 | (draw-one-line 150 125 250 125) 38 | (gl:line-stipple 1 #b0001110001000111) ; dash/dot/dash 39 | (draw-one-line 250 125 350 125) 40 | ;; In 2nd row, 3 wide lines, each with different stipple. 41 | (gl:line-width 5) 42 | (gl:line-stipple 1 #b0000000100000001) ; dotted 43 | (draw-one-line 50 100 150 100) 44 | (gl:line-stipple 1 #b0000000011111111) ; dashed 45 | (draw-one-line 150 100 250 100) 46 | (gl:line-stipple 1 #b0001110001000111) ; dash/dot/dash 47 | (draw-one-line 250 100 350 100) 48 | (gl:line-width 1) 49 | ;; In 3rd row, 6 lines, with dash/dot/dash stipple as part 50 | ;; of a single connected line strip. 51 | (gl:line-stipple 1 #b0001110001000111) ; dash/dot/dash 52 | (gl:with-primitives :line-strip 53 | (dotimes (i 7) 54 | (gl:vertex (+ 50 (* i 50)) 75))) 55 | ;; In 4th row, 6 independent lines with same stipple. 56 | (dotimes (i 6) 57 | (draw-one-line (+ 50 (* i 50)) 50 58 | (+ 50 (* (1+ i) 50)) 50)) 59 | ;; In 5th row, 1 line, with dash/dot/dash stipple and 60 | ;; a stipple repeat factor of 5. 61 | (gl:line-stipple 5 #b0001110001000111) ; dash/dot/dash 62 | (draw-one-line 50 25 350 25) 63 | ;; Finally, 64 | (gl:disable :line-stipple) 65 | (gl:flush)) 66 | 67 | (defmethod glut:reshape ((w lines-window) width height) 68 | (gl:viewport 0 0 width height) 69 | (gl:matrix-mode :projection) 70 | (gl:load-identity) 71 | (glu:ortho-2d 0 width 0 height)) 72 | 73 | (defmethod glut:keyboard ((w lines-window) key x y) 74 | (declare (ignore x y)) 75 | (when (eql key #\Esc) 76 | (glut:destroy-current-window))) 77 | 78 | (defun rb-lines () 79 | (glut:display-window (make-instance 'lines-window))) 80 | -------------------------------------------------------------------------------- /examples/redbook/list.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; list.lisp --- Lisp version of list.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates how to make and execute a 9 | ;;; display list. Note that attributes, such as current 10 | ;;; color and matrix, are changed. 11 | 12 | (in-package #:cl-glut-examples) 13 | 14 | (defclass list-window (glut:window) 15 | ((list-name :accessor list-name :initform nil)) 16 | (:default-initargs 17 | :width 600 :height 50 :title "list.lisp" :mode '(:single :rgb))) 18 | 19 | (defmethod glut:display-window :before ((w list-window)) 20 | (unless (list-name w) 21 | (setf (list-name w) (gl:gen-lists 1))) 22 | (gl:with-new-list ((list-name w) :compile) 23 | (gl:color 1 0 0) ; red 24 | (gl:with-primitives :triangles 25 | (gl:vertex 0 0) 26 | (gl:vertex 1 0) 27 | (gl:vertex 0 1)) 28 | (gl:translate 1.5 0 0)) ; move position 29 | (gl:shade-model :flat)) 30 | 31 | (defmethod glut:display ((w list-window)) 32 | (gl:load-identity) 33 | (gl:clear :color-buffer) 34 | (gl:color 0 1 0) ; current color green 35 | (loop repeat 10 do (gl:call-list (list-name w))) 36 | (gl:with-primitives :lines ; is this line green? NO! 37 | (gl:vertex 0 0.5) ; where is the line drawn? 38 | (gl:vertex 15 0.5)) 39 | (gl:flush)) 40 | 41 | (defmethod glut:reshape ((w list-window) width height) 42 | (gl:viewport 0 0 width height) 43 | (gl:matrix-mode :projection) 44 | (gl:load-identity) 45 | (if (<= width height) 46 | (glu:ortho-2d 0 2 (* -0.5 (/ height width)) (* 1.5 (/ height width))) 47 | (glu:ortho-2d 0 (* 2 (/ width height)) -0.5 1.5)) 48 | (gl:matrix-mode :modelview) 49 | (gl:load-identity)) 50 | 51 | (defmethod glut:keyboard ((w list-window) key x y) 52 | (declare (ignore x y)) 53 | (when (eql key #\Esc) 54 | (glut:destroy-current-window))) 55 | 56 | (defun rb-list () 57 | (glut:display-window (make-instance 'list-window))) 58 | -------------------------------------------------------------------------------- /examples/redbook/model.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; model.lisp --- Lisp version of model.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates modeling transformations 9 | 10 | (in-package #:cl-glut-examples) 11 | 12 | (defclass model-window (glut:window) 13 | () 14 | (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 15 | :mode '(:single :rgb) :title "model.lisp")) 16 | 17 | (defmethod glut:display-window :before ((w model-window)) 18 | (gl:clear-color 0 0 0 0) 19 | (gl:shade-model :flat)) 20 | 21 | (defmethod glut:display ((w model-window)) 22 | (flet ((draw-triangle () 23 | (gl:with-primitives :line-loop 24 | (gl:vertex 0 25) 25 | (gl:vertex 25 -25) 26 | (gl:vertex -25 -25)))) 27 | (gl:clear :color-buffer) 28 | (gl:color 1 1 1) 29 | ;; triangle with solid-lines 30 | (gl:load-identity) 31 | (gl:color 1 1 1) 32 | (draw-triangle) 33 | ;; triangle with dashed-lines 34 | (gl:enable :line-stipple) 35 | (gl:line-stipple 1 #xF0F0) 36 | (gl:load-identity) 37 | (gl:translate -20 0 0) 38 | (draw-triangle) 39 | ;; triangle with long dashed-lines 40 | (gl:line-stipple 1 #xF00F) 41 | (gl:load-identity) 42 | (gl:scale 1.5 0.5 1.0) 43 | (draw-triangle) 44 | ;; triangle with dotted lines 45 | (gl:line-stipple 1 #x8888) 46 | (gl:load-identity) 47 | (gl:rotate 90 0 0 1) 48 | (draw-triangle) 49 | (gl:disable :line-stipple) 50 | (gl:flush))) 51 | 52 | (defmethod glut:reshape ((w model-window) width height) 53 | (gl:viewport 0 0 width height) 54 | (gl:matrix-mode :projection) 55 | (gl:load-identity) 56 | (if (<= width height) 57 | (gl:ortho -50 50 (/ (* -50 height) width) 58 | (/ (* 50 height) width) -1 1) 59 | (gl:ortho (/ (* -50 width) height) (/ (* 50 width) height) -50 60 | 50.0 -1 1)) 61 | (gl:matrix-mode :modelview)) 62 | 63 | (defmethod glut:keyboard ((w model-window) key x y) 64 | (declare (ignore x y)) 65 | (when (eql key #\Esc) 66 | (glut:destroy-current-window))) 67 | 68 | (defun rb-model () 69 | (glut:display-window (make-instance 'model-window))) 70 | -------------------------------------------------------------------------------- /examples/redbook/movelight.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; movelight.lisp --- Lisp version of movelight.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates when to issue lighting and 9 | ;;; transformation commands to render a model with a light 10 | ;;; which is moved by a modeling transformation (rotate or 11 | ;;; translate). The light position is reset after the modeling 12 | ;;; transformation is called. The eye position does not change. 13 | ;;; 14 | ;;; A sphere is drawn using a grey material characteristic. 15 | ;;; A single light source illuminates the object. 16 | ;;; 17 | ;;; Interaction: pressing the left mouse button alters 18 | ;;; the modeling transformation (x rotation) by 30 degrees. 19 | ;;; The scene is then redrawn with the light in a new position. 20 | 21 | (in-package #:cl-glut-examples) 22 | 23 | (defclass movelight-window (glut:window) 24 | ((spin :initform 0)) 25 | (:default-initargs :width 500 :height 500 :pos-x 100 :pos-y 100 26 | :mode '(:single :rgb :depth) :title "movelight.lisp")) 27 | 28 | (defmethod glut:display-window :before ((w movelight-window)) 29 | (gl:clear-color 0 0 0 0) 30 | (gl:shade-model :smooth) 31 | (gl:enable :lighting) 32 | (gl:enable :light0) 33 | (gl:enable :depth-test)) 34 | 35 | ;;; Here is where the light position is reset after the modeling 36 | ;;; transformation (GL:ROTATE) is called. This places the 37 | ;;; light at a new position in world coordinates. The cube 38 | ;;; represents the position of the light. 39 | (defmethod glut:display ((w movelight-window)) 40 | (gl:clear :color-buffer :depth-buffer) 41 | (gl:with-pushed-matrix 42 | (glu:look-at 0 0 5 0 0 0 0 1 0) 43 | (gl:with-pushed-matrix 44 | (gl:rotate (slot-value w 'spin) 1 0 0) 45 | (gl:light :light0 :position #(0 0 1.5 1)) 46 | (gl:translate 0 0 1.5) 47 | (gl:disable :lighting) 48 | (gl:color 0 1 1) 49 | (glut:wire-cube 0.1) 50 | (gl:enable :lighting)) 51 | (glut:solid-torus 0.275 0.85 8 15)) 52 | (gl:flush)) 53 | 54 | (defmethod glut:reshape ((w movelight-window) width height) 55 | (gl:viewport 0 0 width height) 56 | (gl:matrix-mode :projection) 57 | (gl:load-identity) 58 | (glu:perspective 40 (/ width height) 1 20) 59 | (gl:matrix-mode :modelview) 60 | (gl:load-identity)) 61 | 62 | (defmethod glut:mouse ((w movelight-window) button state x y) 63 | (declare (ignore x y)) 64 | (when (and (eq button :left-button) (eq state :down)) 65 | (with-slots (spin) w 66 | (setf spin (mod (+ spin 30) 360))) 67 | (glut:post-redisplay))) 68 | 69 | (defmethod glut:keyboard ((w movelight-window) key x y) 70 | (declare (ignore x y)) 71 | (case key 72 | (#\Esc (glut:destroy-current-window)))) 73 | 74 | (defun rb-movelight () 75 | (glut:display-window (make-instance 'movelight-window))) 76 | -------------------------------------------------------------------------------- /examples/redbook/planet.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; planet.lisp --- Lisp version of planet.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program shows how to composite modeling transformations 9 | ;;; to draw translated and rotated models. 10 | ;;; Interaction: pressing the d and y keys (day and year) 11 | ;;; alters the rotation of the planet around the sun. 12 | 13 | (in-package #:cl-glut-examples) 14 | 15 | (defclass planet-window (glut:window) 16 | ((year :accessor year :initform 0) 17 | (day :accessor day :initform 0)) 18 | (:default-initargs 19 | :pos-x 100 :pos-y 100 :width 500 :height 500 20 | :mode '(:double :rgb) :title "planet.lisp")) 21 | 22 | (defmethod glut:display-window :before ((w planet-window)) 23 | (gl:clear-color 0 0 0 0) 24 | (gl:shade-model :flat)) 25 | 26 | (defmethod glut:display ((w planet-window)) 27 | (gl:clear :color-buffer) 28 | (gl:color 1 1 1) 29 | (gl:with-pushed-matrix 30 | ;; draw sun 31 | (glut:wire-sphere 1 20 16) 32 | ;; draw smaller planet 33 | (gl:rotate (year w) 0 1 0) 34 | (gl:translate 2 0 0) 35 | (gl:rotate (day w) 0 1 0) 36 | (glut:wire-sphere 0.2 10 8)) 37 | (glut:swap-buffers)) 38 | 39 | (defmethod glut:reshape ((w planet-window) width height) 40 | (gl:viewport 0 0 width height) 41 | (gl:matrix-mode :projection) 42 | (gl:load-identity) 43 | (glu:perspective 60 (/ width height) 1 20) 44 | (gl:matrix-mode :modelview) 45 | (gl:load-identity) 46 | (glu:look-at 0 0 5 0 0 0 0 1 0)) 47 | 48 | (defmethod glut:keyboard ((w planet-window) key x y) 49 | (declare (ignore x y)) 50 | (flet ((update (slot n) 51 | (setf (slot-value w slot) (mod (+ (slot-value w slot) n) 360)) 52 | (glut:post-redisplay))) 53 | (case key 54 | (#\d (update 'day 10)) 55 | (#\D (update 'day -10)) 56 | (#\y (update 'year 5)) 57 | (#\Y (update 'year -5)) 58 | (#\Esc (glut:destroy-current-window))))) 59 | 60 | (defun rb-planet () 61 | (glut:display-window (make-instance 'planet-window))) 62 | -------------------------------------------------------------------------------- /examples/redbook/polys.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; polys.lisp --- Lisp version of polys.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates polygon stippling. 9 | 10 | (in-package #:cl-glut-examples) 11 | 12 | (defclass polys-window (glut:window) 13 | () 14 | (:default-initargs :width 350 :height 150 :title "polys.lisp" 15 | :mode '(:single :rgb))) 16 | 17 | (defmethod glut:display-window :before ((w polys-window)) 18 | (gl:clear-color 0 0 0 0) 19 | (gl:shade-model :flat)) 20 | 21 | (defparameter *fly* 22 | #(#x00 #x00 #x00 #x00 #x00 #x00 #x00 #x00 23 | #x03 #x80 #x01 #xC0 #x06 #xC0 #x03 #x60 24 | #x04 #x60 #x06 #x20 #x04 #x30 #x0C #x20 25 | #x04 #x18 #x18 #x20 #x04 #x0C #x30 #x20 26 | #x04 #x06 #x60 #x20 #x44 #x03 #xC0 #x22 27 | #x44 #x01 #x80 #x22 #x44 #x01 #x80 #x22 28 | #x44 #x01 #x80 #x22 #x44 #x01 #x80 #x22 29 | #x44 #x01 #x80 #x22 #x44 #x01 #x80 #x22 30 | #x66 #x01 #x80 #x66 #x33 #x01 #x80 #xCC 31 | #x19 #x81 #x81 #x98 #x0C #xC1 #x83 #x30 32 | #x07 #xe1 #x87 #xe0 #x03 #x3f #xfc #xc0 33 | #x03 #x31 #x8c #xc0 #x03 #x33 #xcc #xc0 34 | #x06 #x64 #x26 #x60 #x0c #xcc #x33 #x30 35 | #x18 #xcc #x33 #x18 #x10 #xc4 #x23 #x08 36 | #x10 #x63 #xC6 #x08 #x10 #x30 #x0c #x08 37 | #x10 #x18 #x18 #x08 #x10 #x00 #x00 #x08)) 38 | 39 | (defparameter *halftone* 40 | #(#xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 41 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 42 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 43 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 44 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 45 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 46 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 47 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 48 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 49 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 50 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 51 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 52 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 53 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 54 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55 55 | #xAA #xAA #xAA #xAA #x55 #x55 #x55 #x55)) 56 | 57 | (defmethod glut:display ((w polys-window)) 58 | (gl:clear :color-buffer) 59 | (gl:color 1 1 1) 60 | ;; Draw one solid, unstippled rectangles then two 61 | ;; stippled rectangles. 62 | (gl:rect 25 25 125 125) 63 | (gl:enable :polygon-stipple) 64 | (gl:polygon-stipple *fly*) 65 | (gl:rect 125 25 225 125) 66 | (gl:polygon-stipple *halftone*) 67 | (gl:rect 225 25 325 125) 68 | (gl:disable :polygon-stipple) 69 | (gl:flush)) 70 | 71 | (defmethod glut:reshape ((w polys-window) width height) 72 | (gl:viewport 0 0 width height) 73 | (gl:matrix-mode :projection) 74 | (gl:load-identity) 75 | (glu:ortho-2d 0 width 0 height)) 76 | 77 | (defmethod glut:keyboard ((w polys-window) key x y) 78 | (declare (ignore x y)) 79 | (when (eql key #\Esc) 80 | (glut:destroy-current-window))) 81 | 82 | (defun rb-polys () 83 | (glut:display-window (make-instance 'polys-window))) 84 | -------------------------------------------------------------------------------- /examples/redbook/quadric.lisp: -------------------------------------------------------------------------------- 1 | 2 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 3 | ;;; quadric.lisp --- Lisp version of quadric.c (Red Book examples) 4 | ;;; 5 | 6 | (in-package #:cl-glut-examples) 7 | 8 | (defclass quadric-window (glut:window) 9 | ((start-list :accessor start-list)) 10 | (:default-initargs :width 500 :height 500 :title "quadric.lisp" 11 | :mode '(:single :rgb :depth))) 12 | 13 | (defmethod glut:display-window :before ((window quadric-window)) 14 | (let ((quadric-obj) 15 | (mat-ambient '(0.5 0.5 0.5 1.0)) 16 | (mat-specular '(1.0 1.0 1.0 1.0)) 17 | (mat-shininess 50) 18 | (light-position '(1.0 1.0 1.0 0.0)) 19 | (model-ambient '(0.5 0.5 0.5 1.0))) 20 | (gl:clear-color 0 0 0 0) 21 | (gl:material :front :ambient mat-ambient) 22 | (gl:material :front :specular mat-specular) 23 | (gl:material :front :shininess mat-shininess) 24 | (gl:light :light0 :position light-position) 25 | (gl:light-model :light-model-ambient model-ambient) 26 | (gl:enable :lighting) 27 | (gl:enable :light0) 28 | (gl:enable :depth-test) 29 | 30 | ;; Create 4 display lists, each with a different quadric object. 31 | ;; Different drawing styles and surface normal specifications 32 | ;; are demonstrated. 33 | 34 | (setf (start-list window) (gl:gen-lists 4)) 35 | (setf quadric-obj (glu:new-quadric)) 36 | 37 | ;;todo 38 | ;; gluQuadricCallback(qobj, GLU_ERROR, 39 | ;; (GLvoid (CALLBACK*) ()) errorCallback); 40 | 41 | (glu:quadric-draw-style quadric-obj :fill) ;;smooth shaded 42 | (glu:quadric-normals quadric-obj :smooth) 43 | (gl:with-new-list ((start-list window) :compile) 44 | (glu:sphere quadric-obj 0.75 15 10)) 45 | 46 | (glu:quadric-draw-style quadric-obj :fill) ;;flat shaded 47 | (glu:quadric-normals quadric-obj :flat) 48 | (gl:with-new-list ((1+ (start-list window)) :compile) 49 | (glu:cylinder quadric-obj 0.5 0.3 1 15 5)) 50 | 51 | (glu:quadric-draw-style quadric-obj :line) ;;all polygons wireframe 52 | (glu:quadric-normals quadric-obj :none) 53 | (gl:with-new-list ((+ 2 (start-list window)) :compile) 54 | (glu:disk quadric-obj 0.25 1 20 4)) 55 | 56 | (glu:quadric-draw-style quadric-obj :silhouette) ;;boundary only 57 | (glu:quadric-normals quadric-obj :none) 58 | (gl:with-new-list ((+ 3 (start-list window)) :compile) 59 | (glu:partial-disk quadric-obj 0 1 20 4 0 225)) 60 | 61 | (glu:delete-quadric quadric-obj))) 62 | 63 | (defmethod glut:display ((window quadric-window)) 64 | (gl:clear :color-buffer :depth-buffer-bit) 65 | (gl:with-pushed-matrix 66 | (gl:enable :lighting) 67 | (gl:shade-model :smooth) 68 | (gl:translate -1.0 -1.0 0.0) 69 | (gl:call-list (start-list window)) 70 | (gl:shade-model :flat) 71 | (gl:translate 0.0 2.0 0.0) 72 | (gl:with-pushed-matrix 73 | (gl:rotate 300.0 1.0 0.0 0.0) 74 | (gl:call-list (1+ (start-list window)))) 75 | (gl:disable :lighting) 76 | (gl:color 0.0 1.0 1.0) 77 | (gl:translate 2.0 -2.0 0.0) 78 | (gl:call-list (+ 2 (start-list window))) 79 | (gl:color 1.0 1.0 0.0) 80 | (gl:translate 0.0 2.0 0.0) 81 | (gl:call-list (+ 3 (start-list window)))) 82 | (gl:flush)) 83 | 84 | (defmethod glut:reshape ((w quadric-window) width height) 85 | (gl:viewport 0 0 width height) 86 | (gl:matrix-mode :projection) 87 | (gl:load-identity) 88 | 89 | (if (<= width height) 90 | (gl:ortho -2.5 2.5 (/ (* -2.5 height) width) 91 | (/ (* 2.5 height) width) -10.0 10.0) 92 | (gl:ortho (/ (* -2.5 width) height) (/ (* 2.5 width) height) 93 | -2.5 2.5 -10 10)) 94 | (gl:matrix-mode :modelview) 95 | (gl:load-identity)) 96 | 97 | (defmethod glut:keyboard ((w quadric-window) key x y) 98 | (declare (ignore x y)) 99 | (when (eql key #\Esc) 100 | (glut:destroy-current-window))) 101 | 102 | (defun rb-quadric () 103 | (glut:display-window (make-instance 'quadric-window))) -------------------------------------------------------------------------------- /examples/redbook/robot.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; robot.lisp --- Lisp version of robot.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program shows how to composite modeling transformations 9 | ;;; to draw translated and rotated hierarchical models. 10 | ;;; Interaction: pressing the s and e keys (shoulder and elbow) 11 | ;;; alters the rotation of the robot arm. 12 | 13 | (in-package #:cl-glut-examples) 14 | 15 | (defclass robot-window (glut:window) 16 | ((shoulder :accessor shoulder :initform 0) 17 | (elbow :accessor elbow :initform 0)) 18 | (:default-initargs 19 | :pos-x 100 :pos-y 100 :width 500 :height 500 20 | :mode '(:double :rgb) :title "robot.lisp")) 21 | 22 | (defmethod glut:display-window :before ((w robot-window)) 23 | (gl:clear-color 0 0 0 0) 24 | (gl:shade-model :flat)) 25 | 26 | (defmethod glut:display ((w robot-window)) 27 | (gl:clear :color-buffer) 28 | (gl:with-pushed-matrix 29 | ;; first cube 30 | (gl:translate -1 0 0) 31 | (gl:rotate (shoulder w) 0 0 1) 32 | (gl:translate 1 0 0) 33 | (gl:with-pushed-matrix 34 | (gl:scale 2 0.4 1) 35 | (glut:wire-cube 1)) 36 | ;; second cube 37 | (gl:translate 1 0 0) 38 | (gl:rotate (elbow w) 0 0 1) 39 | (gl:translate 1 0 0) 40 | (gl:with-pushed-matrix 41 | (gl:scale 2 0.4 1) 42 | (glut:wire-cube 1))) 43 | (glut:swap-buffers)) 44 | 45 | (defmethod glut:reshape ((w robot-window) width height) 46 | (gl:viewport 0 0 width height) 47 | (gl:matrix-mode :projection) 48 | (gl:load-identity) 49 | (glu:perspective 65 (/ width height) 1 20) 50 | (gl:matrix-mode :modelview) 51 | (gl:load-identity) 52 | (gl:translate 0 0 -5)) 53 | 54 | (defmethod glut:keyboard ((w robot-window) key x y) 55 | (declare (ignore x y)) 56 | (flet ((update (slot n) 57 | (setf (slot-value w slot) (mod (+ (slot-value w slot) n) 360)) 58 | (glut:post-redisplay))) 59 | (case key 60 | (#\s (update 'shoulder 10)) 61 | (#\S (update 'shoulder -10)) 62 | (#\e (update 'elbow 5)) 63 | (#\E (update 'elbow -5)) 64 | (#\Esc (glut:destroy-current-window))))) 65 | 66 | (defun rb-robot () 67 | (glut:display-window (make-instance 'robot-window))) 68 | -------------------------------------------------------------------------------- /examples/redbook/smooth.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; smooth.lisp --- Lisp version of smooth.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates smooth shading. 9 | ;;; A smooth shaded polygon is drawn in a 2-D projection. 10 | 11 | (in-package #:cl-glut-examples) 12 | 13 | (defclass smooth-window (glut:window) 14 | () 15 | (:default-initargs :width 500 :height 500 :pos-x 100 :pos-y 100 16 | :mode '(:single :rgb) :title "smooth.lisp")) 17 | 18 | (defmethod glut:display-window :before ((w smooth-window)) 19 | (gl:clear-color 0 0 0 0) 20 | (gl:shade-model :smooth)) 21 | 22 | (defmethod glut:display ((w smooth-window)) 23 | (gl:clear :color-buffer) 24 | (gl:with-primitives :triangles 25 | (gl:color 1 0 0) 26 | (gl:vertex 5 5) 27 | (gl:color 0 1 0) 28 | (gl:vertex 25 5) 29 | (gl:color 0 0 1) 30 | (gl:vertex 5 25)) 31 | (gl:flush)) 32 | 33 | (defmethod glut:reshape ((w smooth-window) width height) 34 | (gl:viewport 0 0 width height) 35 | (gl:matrix-mode :projection) 36 | (gl:load-identity) 37 | (if (<= width height) 38 | (glu:ortho-2d 0 30 0 (* 30 (/ height width))) 39 | (glu:ortho-2d 0 (* 30 (/ width height)) 0 30)) 40 | (gl:matrix-mode :modelview)) 41 | 42 | (defmethod glut:keyboard ((w smooth-window) key x y) 43 | (declare (ignore x y)) 44 | (case key 45 | (#\Esc (glut:destroy-current-window)))) 46 | 47 | (defun rb-smooth () 48 | (glut:display-window (make-instance 'smooth-window))) 49 | -------------------------------------------------------------------------------- /examples/redbook/stroke.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; stroke.lisp --- Lisp version of stroke.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates some characters of a 9 | ;;; stroke (vector) font. The characters are represented 10 | ;;; by display lists, which are given numbers which 11 | ;;; correspond to the ASCII values of the characters. 12 | ;;; Use of GL:CALL-LISTS is demonstrated. 13 | 14 | (in-package #:cl-glut-examples) 15 | 16 | (defclass stroke-window (glut:window) 17 | () 18 | (:default-initargs :width 440 :height 120 :title "stroke.lisp" 19 | :mode '(:single :rgb))) 20 | 21 | ;;; FIXME: like in the RB-LIST example we'll want some sort of 22 | ;;; mechanism to automatically deallocate display lists. 23 | 24 | (defmethod glut:display-window :before ((w stroke-window)) 25 | (let ((a '(#\A (0 0 pt) (0 9 pt) (1 10 pt) (4 10 pt) (5 9 pt) (5 0 stroke) 26 | (0 5 pt) (5 5 end))) 27 | (e '(#\E (5 0 pt) (0 0 pt) (0 10 pt) (5 10 stroke) (0 5 pt) (4 5 end))) 28 | (p '(#\P (0 0 pt) (0 10 pt) (4 10 pt) (5 9 pt) (5 6 pt) (4 5 pt) 29 | (0 5 end))) 30 | (r '(#\R (0 0 pt) (0 10 pt) (4 10 pt) (5 9 pt) (5 6 pt) (4 5 pt) 31 | (0 5 stroke) (3 5 pt) (5 0 end))) 32 | (s '(#\S (0 1 pt) (1 0 pt) (4 0 pt) (5 1 pt) (5 4 pt) (4 5 pt) (1 5 pt) 33 | (0 6 pt) (0 9 pt) (1 10 pt) (4 10 pt) (5 9 end)))) 34 | ;; draw-letter interprets the instructions above 35 | (flet ((draw-letter (instructions) 36 | (gl:begin :line-strip) 37 | (loop for (x y what) in instructions do 38 | (case what 39 | (pt (gl:vertex x y)) 40 | (stroke (gl:vertex x y) 41 | (gl:end) 42 | (gl:begin :line-strip)) 43 | (end (gl:vertex x y) 44 | (gl:end) 45 | (gl:translate 8 0 0)))))) 46 | ;; create a display list for each of 6 characters 47 | (gl:shade-model :flat) 48 | (let ((base (gl:gen-lists 128))) 49 | (gl:list-base base) 50 | (loop for char in (list a e p r s) do 51 | (gl:with-new-list ((+ base (char-code (car char))) :compile) 52 | (draw-letter (cdr char)))) 53 | ;; space 54 | (gl:with-new-list ((+ base (char-code #\Space)) :compile) 55 | (gl:translate 8 0 0)))))) 56 | 57 | (defmethod glut:display ((w stroke-window)) 58 | (flet ((print-stroked-string (string) 59 | (gl:call-lists (map 'vector #'char-code string)))) 60 | (gl:clear :color-buffer) 61 | (gl:color 1 1 1) 62 | (gl:with-pushed-matrix 63 | (gl:scale 2 2 2) 64 | (gl:translate 10 30 0) 65 | (print-stroked-string "A SPARE SERAPE APPEARS AS")) 66 | (gl:with-pushed-matrix 67 | (gl:scale 2 2 2) 68 | (gl:translate 10 13 0) 69 | (print-stroked-string "APES PREPARE RARE PEPPERS")) 70 | (gl:flush))) 71 | 72 | (defmethod glut:reshape ((w stroke-window) width height) 73 | (gl:viewport 0 0 width height) 74 | (gl:matrix-mode :projection) 75 | (gl:load-identity) 76 | (glu:ortho-2d 0 width 0 height)) 77 | 78 | (defmethod glut:keyboard ((w stroke-window) key x y) 79 | (declare (ignore x y)) 80 | (case key 81 | (#\Space (glut:post-redisplay)) 82 | (#\Esc (glut:destroy-current-window)))) 83 | 84 | (defun rb-stroke () 85 | (glut:display-window (make-instance 'stroke-window))) 86 | -------------------------------------------------------------------------------- /examples/redbook/tess-wind.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; tess-wind.lisp --- Lisp version of tesswind.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | (in-package #:cl-glut-examples) 9 | 10 | 11 | (defclass winding-tessellator (glu:tessellator) 12 | ()) 13 | 14 | (defclass tess-wind-window (glut:window) 15 | ((current-winding :accessor current-winding :initform :odd) 16 | (wind-list :accessor wind-list)) 17 | (:default-initargs :width 500 :height 500 :title "tess-wind.lisp" 18 | :mode '(:single :rgb))) 19 | 20 | (defmethod glut:display-window :before ((window tess-wind-window)) 21 | (gl:clear-color 0 0 0 0) 22 | (gl:shade-model :flat) 23 | (setf (wind-list window) (gl:gen-lists 4)) 24 | (make-new-lists window)) 25 | 26 | (defmethod glut:display ((window tess-wind-window)) 27 | (gl:clear :color-buffer) 28 | (gl:color 1 1 1) 29 | (gl:with-pushed-matrix 30 | (gl:call-list (wind-list window)) 31 | (gl:translate 0 500 0) 32 | (gl:call-list (1+ (wind-list window))) 33 | (gl:translate 500 -500 0) 34 | (gl:call-list (+ 2 (wind-list window))) 35 | (gl:translate 0 500 0) 36 | (gl:call-list (+ 3 (wind-list window)))) 37 | (gl:flush)) 38 | 39 | (defmethod glut:reshape ((w tess-wind-window) width height) 40 | (gl:viewport 0 0 width height) 41 | (gl:matrix-mode :projection) 42 | (gl:load-identity) 43 | (if (<= width height) 44 | (glu:ortho-2d 0 1000 0 (* 1000 (/ height width))) 45 | (glu:ortho-2d 0 (* 1000 (/ width height)) 0 1000)) 46 | (gl:matrix-mode :modelview) 47 | (gl:load-identity)) 48 | 49 | (defmethod glut:keyboard ((window tess-wind-window) key x y) 50 | (case key 51 | ((#\w #\W) 52 | (progn 53 | (cond ((equal (current-winding window) :odd) 54 | (setf (current-winding window) :nonzero)) 55 | ((equal (current-winding window) :nonzero) 56 | (setf (current-winding window) :positive)) 57 | ((equal (current-winding window) :positive) 58 | (setf (current-winding window) :negative)) 59 | ((equal (current-winding window) :negative) 60 | (setf (current-winding window) :abs-geq-two)) 61 | ((equal (current-winding window) :abs-geq-two) 62 | (setf (current-winding window) :odd))) 63 | (make-new-lists window) 64 | (glut:post-redisplay))) 65 | (#\Esc 66 | (glut:destroy-current-window)))) 67 | 68 | (defmethod glu:vertex-data-callback ((tess winding-tessellator) vertex-data polygon-data) 69 | (gl:vertex (first vertex-data)(second vertex-data)(third vertex-data))) 70 | 71 | (defmethod glu:combine-data-callback ((tess winding-tessellator) coords vertex-data weight polygon-data) 72 | (loop for i from 0 below 3 73 | collect (gl:glaref coords i))) 74 | 75 | (defun make-new-lists (window) 76 | (let ((tobj (make-instance 'winding-tessellator)) 77 | (rects '((50 50 0) (300 50 0) 78 | (300 300 0) (50 300 0) 79 | (100 100 0) (250 100 0) 80 | (250 250 0) (100 250 0) 81 | (150 150 0) (200 150 0) 82 | (200 200 0) (150 200 0))) 83 | (spiral '((400 250 0) (400 50 0) 84 | (50 50 0) (50 400 0) 85 | (350 400 0) (350 100 0) 86 | (100 100 0) (100 350 0) 87 | (300 350 0) (300 150 0) 88 | (150 150 0) (150 300 0) 89 | (250 300 0) (250 200 0) 90 | (200 200 0) (200 250 0))) 91 | (quad1 '((50 150 0) (350 150 0) 92 | (350 200 0) (50 200 0))) 93 | (quad2 '((100 100 0) (300 100 0) 94 | (300 350 0) (100 350 0))) 95 | (tri '((200 50 0) (250 300 0) 96 | (150 300 0)))) 97 | 98 | (glu:tess-property tobj :winding-rule (current-winding window)) 99 | 100 | (gl:with-new-list ((wind-list window) :compile) 101 | (glu:with-tess-polygon (tobj) 102 | (glu:with-tess-contour tobj 103 | (loop for i from 0 below 4 104 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))) 105 | (glu:with-tess-contour tobj 106 | (loop for i from 4 below 8 107 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))) 108 | (glu:with-tess-contour tobj 109 | (loop for i from 8 below 12 110 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))))) 111 | 112 | (gl:with-new-list ((1+ (wind-list window)) :compile) 113 | (glu:with-tess-polygon (tobj) 114 | (glu:with-tess-contour tobj 115 | (loop for i from 0 below 4 116 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))) 117 | (glu:with-tess-contour tobj 118 | (loop for i from 7 downto 4 119 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))) 120 | (glu:with-tess-contour tobj 121 | (loop for i from 11 downto 8 122 | do (glu:tess-vertex tobj (nth i rects)(nth i rects)))))) 123 | 124 | (gl:with-new-list ((+ 2 (wind-list window)) :compile) 125 | (glu:with-tess-polygon (tobj) 126 | (glu:with-tess-contour tobj 127 | (loop for coords in spiral 128 | do (glu:tess-vertex tobj coords coords))))) 129 | 130 | (gl:with-new-list ((+ 3 (wind-list window)) :compile) 131 | (glu:with-tess-polygon (tobj) 132 | (glu:with-tess-contour tobj 133 | (loop for coords in quad1 134 | do (glu:tess-vertex tobj coords coords))) 135 | (glu:with-tess-contour tobj 136 | (loop for coords in quad2 137 | do (glu:tess-vertex tobj coords coords))) 138 | (glu:with-tess-contour tobj 139 | (loop for coords in tri 140 | do (glu:tess-vertex tobj coords coords))))) 141 | (glu:tess-delete tobj))) 142 | 143 | (defun rb-tess-wind () 144 | (glut:display-window (make-instance 'tess-wind-window))) 145 | -------------------------------------------------------------------------------- /examples/redbook/tess.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; tess.lisp --- Lisp version of tess.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; 9 | ;;; This program demonstrates polygon tessellation. 10 | ;;; Two tesselated objects are drawn. The first is a 11 | ;;; rectangle with a triangular hole. The second is a 12 | ;;; smooth shaded, self-intersecting star. 13 | ;;; 14 | ;;; Note the exterior rectangle is drawn with its vertices 15 | ;;; in counter-clockwise order, but its interior clockwise. 16 | ;;; Note the combineCallback is needed for the self-intersecting 17 | ;;; star. Also note that removing the TessProperty for the 18 | ;;; star will make the interior unshaded (WINDING_ODD). 19 | 20 | (in-package #:cl-glut-examples) 21 | 22 | (defclass tess-window (glut:window) 23 | ((start-list :accessor start-list)) 24 | (:default-initargs :width 500 :height 500 :title "tess.lisp" 25 | :mode '(:single :rgb))) 26 | 27 | (defclass example-tessellator (glu:tessellator) 28 | ()) 29 | 30 | (defclass star-tessellator (glu:tessellator) 31 | ()) 32 | 33 | (defmethod glut:display-window :before ((window tess-window)) 34 | (let ((tobj (make-instance 'example-tessellator)) 35 | (rect '((50 50 0) 36 | (200 50 0) 37 | (200 200 0) 38 | (50 200 0))) 39 | (tri '((75 75 0) 40 | (125 175 0) 41 | (175 75 0))) 42 | (star '((250 50 0 1 0 1) 43 | (325 200 0 1 1 0) 44 | (400 50 0 0 1 1) 45 | (250 150 0 1 0 0) 46 | (400 150 0 0 1 0)))) 47 | 48 | (gl:clear-color 0 0 0 0) 49 | (setf (start-list window) (gl:gen-lists 2)) 50 | 51 | ;; need to initialize tess property in case it is messed up 52 | (glu:tess-property tobj :winding-rule :positive) 53 | 54 | ;;rectangle with triangular hole inside 55 | (gl:with-new-list ((start-list window) :compile) 56 | (gl:shade-model :flat) 57 | (glu:with-tess-polygon (tobj) 58 | (glu:with-tess-contour tobj 59 | (loop for coords in rect 60 | do (glu:tess-vertex tobj coords coords))) 61 | (glu:with-tess-contour tobj 62 | (loop for coords in tri 63 | do (glu:tess-vertex tobj coords coords))))) 64 | (glu:tess-delete tobj) 65 | 66 | ;;smooth shaded, self-intersecting star 67 | (setf tobj (make-instance 'star-tessellator)) 68 | (gl:with-new-list ((1+ (start-list window)) :compile) 69 | (gl:shade-model :smooth) 70 | (glu:tess-property tobj :winding-rule :positive) 71 | (glu:with-tess-polygon (tobj) 72 | (glu:with-tess-contour tobj 73 | (loop for coords in star 74 | do (glu:tess-vertex tobj coords coords))))) 75 | (glu:tess-delete tobj))) 76 | 77 | (defmethod glut:display ((window tess-window)) 78 | (gl:clear :color-buffer) 79 | (gl:color 1 1 1) 80 | (gl:call-list (start-list window)) 81 | (gl:call-list (1+ (start-list window))) 82 | (gl:flush)) 83 | 84 | (defmethod glut:reshape ((w tess-window) width height) 85 | (gl:viewport 0 0 width height) 86 | (gl:matrix-mode :projection) 87 | (gl:load-identity) 88 | (glu:ortho-2d 0 width 0 height)) 89 | 90 | (defmethod glut:keyboard ((w tess-window) key x y) 91 | (declare (ignore x y)) 92 | (when (eql key #\Esc) 93 | (glut:destroy-current-window))) 94 | 95 | (defmethod glu:vertex-data-callback ((tess example-tessellator) vertex-data polygon-data) 96 | (gl:vertex (first vertex-data) (second vertex-data) (third vertex-data))) 97 | 98 | (defmethod glu:vertex-data-callback ((tess star-tessellator) vertex-data polygon-data) 99 | (gl:color (fourth vertex-data) (fifth vertex-data) (sixth vertex-data)) 100 | (gl:vertex (first vertex-data) (second vertex-data) (third vertex-data))) 101 | 102 | (defmethod glu:combine-data-callback ((tess star-tessellator) coords vertex-data weight polygon-data) 103 | (nconc 104 | (loop for i from 0 below 3 105 | collect (gl:glaref coords i)) 106 | 107 | (loop for i from 3 below 6 108 | collect (+ (* (gl:glaref weight 0) 109 | (nth i (aref vertex-data 0))) 110 | (* (gl:glaref weight 1) 111 | (nth i (aref vertex-data 1))) 112 | (* (gl:glaref weight 2) 113 | (nth i (aref vertex-data 2))) 114 | (* (gl:glaref weight 3) 115 | (nth i (aref vertex-data 3))))))) 116 | 117 | (defun rb-tess () 118 | (glut:display-window (make-instance 'tess-window))) 119 | -------------------------------------------------------------------------------- /examples/redbook/varray.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; varray.lisp --- Lisp version of varray.c (Red Book examples) 3 | ;;; 4 | ;;; Original C version contains the following copyright notice: 5 | ;;; Copyright (c) 1993-1997, Silicon Graphics, Inc. 6 | ;;; ALL RIGHTS RESERVED 7 | 8 | ;;; This program demonstrates vertex arrays. 9 | 10 | (in-package #:cl-glut-examples) 11 | 12 | (defclass varray-window (glut:window) 13 | ((setup-method :accessor setup-method :initform 'pointer) 14 | (deref-method :accessor deref-method :initform 'draw-array)) 15 | (:default-initargs :width 350 :height 350 :title "varray.lisp" 16 | :mode '(:single :rgb))) 17 | 18 | (defun setup-pointers () 19 | (let ((vertices '(25 25 20 | 100 325 21 | 175 25 22 | 175 325 23 | 250 25 24 | 325 325)) 25 | (colors '(1.0 0.2 0.2 26 | 0.2 0.2 1.0 27 | 0.8 1.0 0.2 28 | 0.75 0.75 0.75 29 | 0.35 0.35 0.35 30 | 0.5 0.5 0.5))) 31 | (gl:enable-client-state :vertex-array) 32 | (gl:enable-client-state :color-array) 33 | (gl:vertex-pointer 2 :int 0 vertices) 34 | (gl:color-pointer 3 :float 0 colors))) 35 | 36 | (defun setup-interleave () 37 | (let ((intertwined '(1.0 0.2 1.0 100.0 100.0 0.0 38 | 1.0 0.2 0.2 0.0 200.0 0.0 39 | 1.0 1.0 0.2 100.0 300.0 0.0 40 | 0.2 1.0 0.2 200.0 300.0 0.0 41 | 0.2 1.0 1.0 300.0 200.0 0.0 42 | 0.2 0.2 1.0 200.0 100.0 0.0))) 43 | (gl:interleaved-arrays :c3f-v3f 0 intertwined))) 44 | 45 | (defmethod glut:display-window :before ((w varray-window)) 46 | (gl:clear-color 0 0 0 0) 47 | (gl:shade-model :smooth) 48 | (setup-pointers)) 49 | 50 | (defmethod glut:display ((w varray-window)) 51 | (gl:clear :color-buffer) 52 | (ecase (deref-method w) 53 | (draw-array 54 | (gl:draw-arrays :triangles 0 6)) 55 | (array-element 56 | (gl:with-primitives :triangles 57 | (gl:array-element 2) 58 | (gl:array-element 3) 59 | (gl:array-element 5))) 60 | (draw-elements 61 | (gl:draw-elements :polygon 4 :unsigned-int '(0 1 3 4)))) 62 | (gl:flush)) 63 | 64 | (defmethod glut:reshape ((w varray-window) width height) 65 | (gl:viewport 0 0 width height) 66 | (gl:matrix-mode :projection) 67 | (gl:load-identity) 68 | (glu:ortho-2d 0 width 0 height)) 69 | 70 | (defmethod glut:mouse ((w varray-window) button state x y) 71 | (declare (ignore x y)) 72 | (case button 73 | (:left-button 74 | (when (eql state :down) 75 | (case (setup-method w) 76 | (pointer 77 | (setf (setup-method w) 'interleaved) 78 | (setup-interleave)) 79 | (interleaved 80 | (setf (setup-method w) 'pointer) 81 | (setup-pointers))) 82 | (glut:post-redisplay))) 83 | ((:middle-button :right-button) 84 | (when (eql state :down) 85 | (setf (deref-method w) 86 | (ecase (deref-method w) 87 | (draw-array 'array-element) 88 | (array-element 'draw-elements) 89 | (draw-elements 'draw-array))) 90 | (glut:post-redisplay))))) 91 | 92 | (defmethod glut:keyboard ((w varray-window) key x y) 93 | (declare (ignore x y)) 94 | (case (code-char key) 95 | (#\Esc (glut:leave-main-loop)))) 96 | 97 | ;;; XXX verificar GL_VERSION_1_1 98 | 99 | (defun rb-varray () 100 | (glut:display-window (make-instance 'varray-window))) 101 | 102 | 103 | 104 | 105 | 106 | 107 | -------------------------------------------------------------------------------- /gl/debug-output.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-opengl) 2 | 3 | ;;; this API isn't final, and not completely sure it even works right, 4 | ;;; so probably shouldn't rely on it for anything permanent, but might 5 | ;;; help with debugging. 6 | 7 | ;; in particular needs configurable user-level callbacks (ideally 8 | ;; without using defcallback). Also should add wrappers for the 9 | ;; GetDebugMessageLog API 10 | 11 | ;; functions for Debug Output (from gl 4.3+ / KHR_Debug ) 12 | (defvar *break-severities* '(:debug-severity-high)) 13 | (defvar *synchronous* nil) 14 | 15 | (defvar *ignore-ids* #()) 16 | #++ (setf *ignore-ids* #(#x20071 #x20043)) 17 | #++ (setf *ignore-ids* #(#x20071)) 18 | 19 | (defcallback debug-output-callback :void 20 | ;; SOURCE,TYPE,SEVERITY are enums, but translating manually to 21 | ;; avoid ambiguity 22 | ((source :unsigned-int) 23 | (type :unsigned-int) 24 | (id %gl:uint) 25 | (severity :unsigned-int) 26 | (length %gl:sizei) 27 | (message (:pointer :char)) 28 | (user-param (:pointer :void))) 29 | (declare (ignorable user-param)) 30 | (unless (position id *ignore-ids*) 31 | (let ((message 32 | (format nil "~a:~a:~a:~4,'0x:~a~%" 33 | (enum-case source 34 | (:debug-source-api "API") 35 | (:debug-source-window-system "WIN") 36 | (:debug-source-shader-compiler "SHD") 37 | (:debug-source-third-party "3RD") 38 | (:debug-source-application "APP") 39 | (:debug-source-other "???")) 40 | (enum-case type 41 | (:debug-type-error "ERR") 42 | (:debug-type-deprecated-behavior "DEP") 43 | (:debug-type-undefined-behavior "U B") 44 | (:debug-type-portability "PRT") 45 | (:debug-type-performance "PER") 46 | (:debug-type-marker "MRK") 47 | (:debug-type-push-group "PUS") 48 | (:debug-type-pop-group "POP") 49 | (:debug-type-other "???")) 50 | (enum-case severity 51 | (:debug-severity-high "HIG") 52 | (:debug-severity-medium "MED") 53 | (:debug-severity-low "LOW") 54 | (:debug-severity-notification "NOT")) 55 | id 56 | (cffi:foreign-string-to-lisp message :max-chars length)))) 57 | (format t "~a" message) 58 | (when (and *synchronous* 59 | (loop for s in *break-severities* 60 | for i = (if (numberp s) 61 | s (cffi:foreign-enum-value '%gl:enum s)) 62 | thereis (= severity i))) 63 | (break message))))) 64 | 65 | (defmacro with-synchronous-debug ((&key (break '*break-severities*)) &body body) 66 | (alexandria:with-gensyms (prev) 67 | `(let* ((,prev *synchronous*) 68 | (*break-severities* ,break) 69 | (*synchronous* t)) 70 | (unwind-protect 71 | (progn 72 | (%gl:enable :debug-output-synchronous) 73 | ,@body) 74 | ;; match previous state even if user toggled it within this 75 | ;; scope, to match binding 76 | (if ,prev 77 | (%gl:enable :debug-output-synchronous) 78 | (%gl:disable :debug-output-synchronous)))))) 79 | 80 | (defmacro with-synchronous-debug* ((&key (break '*break-severities*)) &body body) 81 | `(let* ((*break-severities* ,break) 82 | (*synchronous* t)) 83 | ,@body)) 84 | 85 | (defun debug-output-insert (message &key (source :debug-source-application) 86 | (type :debug-type-other) 87 | (severity :debug-severity-notification) 88 | (id 0)) 89 | (cffi:with-foreign-string ((buf len) message) 90 | (%gl:debug-message-insert source type id severity len buf))) 91 | 92 | (defun init-debug-output (&key (enable t)) 93 | (%gl:debug-message-callback (get-callback 'debug-output-callback) 94 | (null-pointer)) 95 | (when enable 96 | (gl:enable :debug-output) 97 | (debug-output-insert "debug output enabled" 98 | :source :debug-source-third-party 99 | :id #x3b))) 100 | 101 | (defun object-label (id name label) 102 | (let ((label (format nil "~a(~a)" label name))) 103 | (cffi:with-foreign-string ((buf len) label) 104 | (%gl:object-label id name len buf)))) 105 | 106 | (defun debug-filter-ids (source type &key enable disable) 107 | (setf enable (alexandria:ensure-list enable)) 108 | (setf disable (alexandria:ensure-list disable)) 109 | (when enable 110 | (with-foreign-object (p '%gl:uint (length enable)) 111 | (loop for e in enable for i from 0 do (setf (mem-aref p '%gl:uint i) e)) 112 | (%gl:debug-message-control source type :dont-care 113 | (length enable) p :true))) 114 | (when disable 115 | (with-foreign-object (p '%gl:uint (length disable)) 116 | (loop for e in disable for i from 0 do (setf (mem-aref p '%gl:uint i) e)) 117 | #++(format t "disable ~s~% ~s~% ~s~%" 118 | disable (list source type :dont-care 119 | (length disable) p :false) 120 | (loop for i below (length disable) 121 | collect (mem-aref p '%gl:uint i))) 122 | (%gl:debug-message-control source type :dont-care 123 | (length disable) p :false)))) 124 | -------------------------------------------------------------------------------- /gl/dsa.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; Copyright (c) 2015, Bart Botta <00003b@gmeil.com> 4 | ;;; All rights reserved. 5 | ;;; 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions are met: 8 | ;;; 9 | ;;; o Redistributions of source code must retain the above copyright notice, 10 | ;;; this list of conditions and the following disclaimer. 11 | ;;; o Redistributions in binary form must reproduce the above copyright 12 | ;;; notice, this list of conditions and the following disclaimer in the 13 | ;;; documentation and/or other materials provided with the distribution. 14 | ;;; o Neither the name of the author nor the names of the contributors may be 15 | ;;; used to endorse or promote products derived from this software without 16 | ;;; specific prior written permission. 17 | ;;; 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | ;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 22 | ;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 23 | ;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 24 | ;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 26 | ;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 27 | ;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 28 | ;;; POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package #:cl-opengl) 31 | 32 | ;;;; DSA functions from gl 4.5+ 33 | 34 | ;;; buffers 35 | 36 | (defun create-buffers (count) 37 | (with-foreign-object (buffer-array '%gl:uint count) 38 | (%gl:create-buffers count buffer-array) 39 | (loop for i below count 40 | collecting (mem-aref buffer-array '%gl:uint i)))) 41 | 42 | (defun create-buffer () 43 | (with-foreign-object (array '%gl:uint 1) 44 | (%gl:create-buffers 1 array) 45 | (mem-aref array '%gl:uint 0))) 46 | 47 | (defun buffer-storage (target data flags &key end) 48 | ;; DATA should be either a foreign pointer (with END specified), 49 | ;; NIL, or a typed CL vector of some scalar numerical type 50 | (setf flags (cffi:foreign-bitfield-value 51 | ;; not quite right type, 52 | '%gl::mapbufferusagemask 53 | flags)) 54 | (when (cffi:pointerp data) 55 | (%gl:buffer-storage target end data flags) 56 | (return-from buffer-storage nil)) 57 | (setf end (if end 58 | (min end (length data)) 59 | (length data))) 60 | (macrolet ((copy (ctype size) 61 | `(with-foreign-object (b ,ctype (* end ,size)) 62 | (loop for element across data 63 | for i below end 64 | do (setf (cffi:mem-aref b ,ctype i) 65 | element)) 66 | (%gl:buffer-storage target end b flags)))) 67 | ;; todo: handle more types, possibly untyped arrays? 68 | (etypecase data 69 | ((simple-array (unsigned-byte 8) (*)) 70 | (copy :uint8 1)) 71 | ((simple-array single-float (*)) 72 | (copy :float 4)) 73 | ((simple-array (unsigned-byte 16) (*)) 74 | (copy :uint16 2)) 75 | ((simple-array (unsigned-byte 32) (*)) 76 | (copy :uint32 4))))) 77 | 78 | (defun named-buffer-storage (buffer data flags &key end) 79 | ;; DATA should be either a foreign pointer (with END specified), NIL 80 | ;; (with END specified), or a typed CL vector of some scalar 81 | ;; numerical type 82 | (unless (integerp flags) 83 | (setf flags (cffi:foreign-bitfield-value 84 | ;; not quite right type, 85 | '%gl::mapbufferusagemask 86 | flags))) 87 | (unless data 88 | (setf data (cffi:null-pointer))) 89 | (when (cffi:pointerp data) 90 | (%gl:named-buffer-storage buffer end data flags) 91 | (return-from named-buffer-storage nil)) 92 | (setf end (if end 93 | (min end (length data)) 94 | (length data))) 95 | (macrolet ((copy (ctype size) 96 | `(with-foreign-object (b ,ctype (* end ,size)) 97 | (loop for element across data 98 | for i below end 99 | do (setf (cffi:mem-aref b ,ctype i) 100 | element) 101 | (%gl:named-buffer-storage buffer end b flags))))) 102 | ;; todo: handle more types, possibly untyped arrays? 103 | (etypecase data 104 | ((simple-array (unsigned-byte 8) (*)) 105 | (copy :uint8 1)) 106 | ((simple-array single-float (*)) 107 | (copy :float 4)) 108 | ((simple-array (unsigned-byte 16) (*)) 109 | (copy :uint16 2)) 110 | ((simple-array (unsigned-byte 32) (*)) 111 | (copy :uint32 4))))) 112 | 113 | 114 | 115 | ;;; vertex arrays 116 | 117 | (defun create-vertex-arrays (count) 118 | (with-foreign-object (arrays '%gl:uint count) 119 | (%gl:create-vertex-arrays count arrays) 120 | (loop for i below count 121 | collecting (mem-aref arrays '%gl:uint i)))) 122 | 123 | (defun create-vertex-array () 124 | (with-foreign-object (arrays '%gl:uint 1) 125 | (%gl:create-vertex-arrays 1 arrays) 126 | (mem-aref arrays '%gl:uint 0))) 127 | -------------------------------------------------------------------------------- /gl/extensions.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; extensions.lisp --- OpenGL extensions. 4 | ;;; 5 | ;;; Copyright (c) 2006, Oliver Markovic 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-opengl) 34 | 35 | ;;; 36 | ;;; EXT_framebuffer_object 37 | ;;; 38 | 39 | (import-export %gl:is-renderbuffer-ext 40 | %gl:bind-renderbuffer-ext 41 | %gl:is-renderbuffer 42 | %gl:bind-renderbuffer) 43 | 44 | (defun delete-renderbuffers (renderbuffers) 45 | (with-opengl-sequence (array '%gl:uint renderbuffers) 46 | (%gl:delete-renderbuffers (length renderbuffers) array))) 47 | 48 | (defun delete-renderbuffer (renderbuffer) 49 | (with-foreign-object (array '%gl:uint 0) 50 | (setf (mem-aref array '%gl:uint 0) renderbuffer) 51 | (%gl:delete-renderbuffers 1 array))) 52 | 53 | (defun gen-renderbuffers (count) 54 | (with-foreign-object (renderbuffer-array '%gl:uint count) 55 | (%gl:gen-renderbuffers count renderbuffer-array) 56 | (loop for i below count 57 | collecting (mem-aref renderbuffer-array '%gl:uint i)))) 58 | 59 | (defun gen-renderbuffer () 60 | (with-foreign-object (renderbuffer '%gl:uint 1) 61 | (%gl:gen-renderbuffers 1 renderbuffer) 62 | (mem-aref renderbuffer '%gl:uint 0))) 63 | 64 | (defun create-renderbuffers (count) 65 | (with-foreign-object (renderbuffer-array '%gl:uint count) 66 | (%gl:create-renderbuffers count renderbuffer-array) 67 | (loop for i below count 68 | collecting (mem-aref renderbuffer-array '%gl:uint i)))) 69 | 70 | (defun create-renderbuffer () 71 | (with-foreign-object (renderbuffer '%gl:uint 1) 72 | (%gl:create-renderbuffers 1 renderbuffer) 73 | (mem-aref renderbuffer '%gl:uint 0))) 74 | 75 | 76 | (defun delete-renderbuffers-ext (renderbuffers) 77 | (with-opengl-sequence (array '%gl:uint renderbuffers) 78 | (%gl:delete-renderbuffers-ext (length renderbuffers) array))) 79 | 80 | (defun gen-renderbuffers-ext (count) 81 | (with-foreign-object (renderbuffer-array '%gl:uint count) 82 | (%gl:gen-renderbuffers-ext count renderbuffer-array) 83 | (loop for i below count 84 | collecting (mem-aref renderbuffer-array '%gl:uint i)))) 85 | 86 | (import-export %gl:renderbuffer-storage %gl:renderbuffer-storage-ext 87 | %gl:renderbuffer-storage-multisample %gl:renderbuffer-storage-multisample-ext) 88 | 89 | #+nil 90 | (defun get-renderbuffer-parameter-ext (target pname) 91 | ) 92 | 93 | (import-export %gl:is-framebuffer %gl:is-framebuffer-ext 94 | %gl:bind-framebuffer %gl:bind-framebuffer-ext) 95 | 96 | (defun delete-framebuffers (framebuffers) 97 | (with-opengl-sequence (array '%gl:uint framebuffers) 98 | (%gl:delete-framebuffers (length framebuffers) array))) 99 | 100 | (defun delete-framebuffer (framebuffer) 101 | (with-foreign-object (array '%gl:uint 1) 102 | (setf (cffi:mem-aref array '%gl:uint 0) framebuffer) 103 | (%gl:delete-framebuffers 1 array))) 104 | 105 | (defun gen-framebuffers (count) 106 | (with-foreign-object (framebuffer-array '%gl:uint count) 107 | (%gl:gen-framebuffers count framebuffer-array) 108 | (loop for i below count 109 | collecting (mem-aref framebuffer-array '%gl:uint i)))) 110 | 111 | (defun gen-framebuffer () 112 | (with-foreign-object (framebuffer '%gl:uint 1) 113 | (%gl:gen-framebuffers 1 framebuffer) 114 | (mem-aref framebuffer '%gl:uint 0))) 115 | 116 | (defun create-framebuffers (count) 117 | (with-foreign-object (framebuffer-array '%gl:uint count) 118 | (%gl:create-framebuffers count framebuffer-array) 119 | (loop for i below count 120 | collecting (mem-aref framebuffer-array '%gl:uint i)))) 121 | 122 | (defun create-framebuffer () 123 | (with-foreign-object (framebuffer '%gl:uint 1) 124 | (%gl:create-framebuffers 1 framebuffer) 125 | (mem-aref framebuffer '%gl:uint 0))) 126 | 127 | 128 | (defun delete-framebuffers-ext (framebuffers) 129 | (with-opengl-sequence (array '%gl:uint framebuffers) 130 | (%gl:delete-framebuffers-ext (length framebuffers) array))) 131 | 132 | (defun gen-framebuffers-ext (count) 133 | (with-foreign-object (framebuffer-array '%gl:uint count) 134 | (%gl:gen-framebuffers-ext count framebuffer-array) 135 | (loop for i below count 136 | collecting (mem-aref framebuffer-array '%gl:uint i)))) 137 | 138 | (import-export %gl:check-framebuffer-status %gl:check-framebuffer-status-ext 139 | %gl:check-named-framebuffer-status %gl:check-named-framebuffer-status-ext 140 | %gl:framebuffer-texture-1d %gl:framebuffer-texture-1d-ext 141 | %gl:framebuffer-texture-2d %gl:framebuffer-texture-2d-ext 142 | %gl:framebuffer-texture-3d %gl:framebuffer-texture-3d-ext 143 | %gl:framebuffer-renderbuffer %gl:framebuffer-renderbuffer-ext 144 | %gl:named-framebuffer-texture %gl:named-framebuffer-texture-ext 145 | %gl:framebuffer-texture-layer 146 | %gl:named-framebuffer-texture-layer %gl:named-framebuffer-texture-layer-ext) 147 | 148 | #+nil 149 | (defun get-framebuffer-attachment-parameter-ext (target attachment pname) 150 | (ecase pname 151 | (:framebuffer ))) 152 | 153 | (import-export %gl:generate-mipmap %gl:generate-mipmap-ext %gl:generate-texture-mipmap) 154 | 155 | ;;; 156 | ;;; ARB_uniform_buffer_object 157 | ;;; 158 | 159 | (defun get-uniform-block-index (program uniformblockname) 160 | (with-foreign-string (s uniformblockname) 161 | (%gl:get-uniform-block-index program s))) 162 | -------------------------------------------------------------------------------- /gl/funcs-gl-glcore-gles1-gles2-glsc2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defparameter *glext-version* 20240815) 13 | (defparameter *glext-last-updated* "2024-08-15T14:04:09Z") 14 | 15 | (defglextfun ("glDepthRangef" depth-range-f 290) :void 16 | (n float) 17 | (f float)) 18 | 19 | (defglextfun ("glClearDepthf" clear-depth-f 291) :void 20 | (d float)) 21 | 22 | -------------------------------------------------------------------------------- /gl/funcs-gl-glcore-gles1-gles2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglfun ("glGetPointerv" get-pointer-v 1417) :void 13 | (pname enum) 14 | (params (:pointer (:pointer :void)))) 15 | 16 | (defglextfun ("glDebugMessageControl" debug-message-control 1418) :void 17 | (source enum) 18 | (type enum) 19 | (severity enum) 20 | (count sizei) 21 | (ids (:pointer uint)) 22 | (enabled boolean)) 23 | 24 | (defglextfun ("glDebugMessageInsert" debug-message-insert 1419) :void 25 | (source enum) 26 | (type enum) 27 | (id uint) 28 | (severity enum) 29 | (length sizei) 30 | (buf (:pointer char))) 31 | 32 | (defglextfun ("glDebugMessageCallback" debug-message-callback 1420) :void 33 | (callback debugproc) 34 | (userParam (:pointer :void))) 35 | 36 | (defglextfun ("glGetDebugMessageLog" get-debug-message-log 1421) uint 37 | (count uint) 38 | (bufSize sizei) 39 | (sources (:pointer enum)) 40 | (types (:pointer enum)) 41 | (ids (:pointer uint)) 42 | (severities (:pointer enum)) 43 | (lengths (:pointer sizei)) 44 | (messageLog (:pointer char))) 45 | 46 | (defglextfun ("glPushDebugGroup" push-debug-group 1422) :void 47 | (source enum) 48 | (id uint) 49 | (length sizei) 50 | (message (:pointer char))) 51 | 52 | (defglextfun ("glPopDebugGroup" pop-debug-group 1423) :void) 53 | 54 | (defglextfun ("glObjectLabel" object-label 1424) :void 55 | (identifier enum) 56 | (name uint) 57 | (length sizei) 58 | (label (:pointer char))) 59 | 60 | (defglextfun ("glGetObjectLabel" get-object-label 1425) :void 61 | (identifier enum) 62 | (name uint) 63 | (bufSize sizei) 64 | (length (:pointer sizei)) 65 | (label (:pointer char))) 66 | 67 | (defglextfun ("glObjectPtrLabel" object-ptr-label 1426) :void 68 | (ptr (:pointer :void)) 69 | (length sizei) 70 | (label (:pointer char))) 71 | 72 | (defglextfun ("glGetObjectPtrLabel" get-object-ptr-label 1427) :void 73 | (ptr (:pointer :void)) 74 | (bufSize sizei) 75 | (length (:pointer sizei)) 76 | (label (:pointer char))) 77 | 78 | (defglextfun ("glInsertEventMarkerEXT" insert-event-marker-ext 1428) :void 79 | (length sizei) 80 | (marker (:pointer char))) 81 | 82 | (defglextfun ("glPushGroupMarkerEXT" push-group-marker-ext 1429) :void 83 | (length sizei) 84 | (marker (:pointer char))) 85 | 86 | (defglextfun ("glPopGroupMarkerEXT" pop-group-marker-ext 1430) :void) 87 | 88 | (defglextfun ("glTextureStorage1DEXT" texture-storage-1d-ext 1431) :void 89 | (texture uint) 90 | (target enum) 91 | (levels sizei) 92 | (internalformat enum) 93 | (width sizei)) 94 | 95 | (defglextfun ("glTextureStorage2DEXT" texture-storage-2d-ext 1432) :void 96 | (texture uint) 97 | (target enum) 98 | (levels sizei) 99 | (internalformat enum) 100 | (width sizei) 101 | (height sizei)) 102 | 103 | (defglextfun ("glTextureStorage3DEXT" texture-storage-3d-ext 1433) :void 104 | (texture uint) 105 | (target enum) 106 | (levels sizei) 107 | (internalformat enum) 108 | (width sizei) 109 | (height sizei) 110 | (depth sizei)) 111 | 112 | (defglextfun ("glTexStorage1DEXT" tex-storage-1d-ext 1434) :void 113 | (target enum) 114 | (levels sizei) 115 | (internalformat enum) 116 | (width sizei)) 117 | 118 | (defglextfun ("glTexStorage2DEXT" tex-storage-2d-ext 1435) :void 119 | (target enum) 120 | (levels sizei) 121 | (internalformat enum) 122 | (width sizei) 123 | (height sizei)) 124 | 125 | (defglextfun ("glTexStorage3DEXT" tex-storage-3d-ext 1436) :void 126 | (target enum) 127 | (levels sizei) 128 | (internalformat enum) 129 | (width sizei) 130 | (height sizei) 131 | (depth sizei)) 132 | 133 | (defglextfun ("glDebugMessageControlKHR" debug-message-control-khr 1437) :void 134 | (source enum) 135 | (type enum) 136 | (severity enum) 137 | (count sizei) 138 | (ids (:pointer uint)) 139 | (enabled boolean)) 140 | 141 | (defglextfun ("glDebugMessageInsertKHR" debug-message-insert-khr 1438) :void 142 | (source enum) 143 | (type enum) 144 | (id uint) 145 | (severity enum) 146 | (length sizei) 147 | (buf (:pointer char))) 148 | 149 | (defglextfun ("glDebugMessageCallbackKHR" debug-message-callback-khr 1439) :void 150 | (callback debugprockhr) 151 | (userParam (:pointer :void))) 152 | 153 | (defglextfun ("glGetDebugMessageLogKHR" get-debug-message-log-khr 1440) uint 154 | (count uint) 155 | (bufSize sizei) 156 | (sources (:pointer enum)) 157 | (types (:pointer enum)) 158 | (ids (:pointer uint)) 159 | (severities (:pointer enum)) 160 | (lengths (:pointer sizei)) 161 | (messageLog (:pointer char))) 162 | 163 | (defglextfun ("glPushDebugGroupKHR" push-debug-group-khr 1441) :void 164 | (source enum) 165 | (id uint) 166 | (length sizei) 167 | (message (:pointer char))) 168 | 169 | (defglextfun ("glPopDebugGroupKHR" pop-debug-group-khr 1442) :void) 170 | 171 | (defglextfun ("glObjectLabelKHR" object-label-khr 1443) :void 172 | (identifier enum) 173 | (name uint) 174 | (length sizei) 175 | (label (:pointer char))) 176 | 177 | (defglextfun ("glGetObjectLabelKHR" get-object-label-khr 1444) :void 178 | (identifier enum) 179 | (name uint) 180 | (bufSize sizei) 181 | (length (:pointer sizei)) 182 | (label (:pointer char))) 183 | 184 | (defglextfun ("glObjectPtrLabelKHR" object-ptr-label-khr 1445) :void 185 | (ptr (:pointer :void)) 186 | (length sizei) 187 | (label (:pointer char))) 188 | 189 | (defglextfun ("glGetObjectPtrLabelKHR" get-object-ptr-label-khr 1446) :void 190 | (ptr (:pointer :void)) 191 | (bufSize sizei) 192 | (length (:pointer sizei)) 193 | (label (:pointer char))) 194 | 195 | (defglextfun ("glGetPointervKHR" get-pointer-v-khr 1447) :void 196 | (pname enum) 197 | (params (:pointer (:pointer :void)))) 198 | 199 | -------------------------------------------------------------------------------- /gl/funcs-gl-glcore-gles2-glsc2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglextfun ("glBlendColor" blend-color 1354) :void 13 | (red float) 14 | (green float) 15 | (blue float) 16 | (alpha float)) 17 | 18 | (defglextfun ("glBlendEquation" blend-equation 1355) :void 19 | (mode enum)) 20 | 21 | (defglextfun ("glBindRenderbuffer" bind-renderbuffer 1356) :void 22 | (target enum) 23 | (renderbuffer uint)) 24 | 25 | (defglextfun ("glGenRenderbuffers" gen-renderbuffers 1357) :void 26 | (n sizei) 27 | (renderbuffers (:pointer uint))) 28 | 29 | (defglextfun ("glRenderbufferStorage" renderbuffer-storage 1358) :void 30 | (target enum) 31 | (internalformat enum) 32 | (width sizei) 33 | (height sizei)) 34 | 35 | (defglextfun ("glGetRenderbufferParameteriv" get-renderbuffer-parameter-iv 1359) :void 36 | (target enum) 37 | (pname enum) 38 | (params (:pointer int))) 39 | 40 | (defglextfun ("glBindFramebuffer" bind-framebuffer 1360) :void 41 | (target enum) 42 | (framebuffer uint)) 43 | 44 | (defglextfun ("glGenFramebuffers" gen-framebuffers 1361) :void 45 | (n sizei) 46 | (framebuffers (:pointer uint))) 47 | 48 | (defglextfun ("glCheckFramebufferStatus" check-framebuffer-status 1362) enum 49 | (target enum)) 50 | 51 | (defglextfun ("glFramebufferTexture2D" framebuffer-texture-2d 1363) :void 52 | (target enum) 53 | (attachment enum) 54 | (textarget enum) 55 | (texture uint) 56 | (level int)) 57 | 58 | (defglextfun ("glFramebufferRenderbuffer" framebuffer-renderbuffer 1364) :void 59 | (target enum) 60 | (attachment enum) 61 | (renderbuffertarget enum) 62 | (renderbuffer uint)) 63 | 64 | (defglextfun ("glGetFramebufferAttachmentParameteriv" get-framebuffer-attachment-parameter-iv 1365) :void 65 | (target enum) 66 | (attachment enum) 67 | (pname enum) 68 | (params (:pointer int))) 69 | 70 | (defglextfun ("glGenerateMipmap" generate-mipmap 1366) :void 71 | (target enum)) 72 | 73 | (defglextfun ("glProgramBinary" program-binary 1367) :void 74 | (program uint) 75 | (binaryFormat enum) 76 | (binary (:pointer :void)) 77 | (length sizei)) 78 | 79 | (defglextfun ("glTexStorage2D" tex-storage-2d 1368) :void 80 | (target enum) 81 | (levels sizei) 82 | (internalformat enum) 83 | (width sizei) 84 | (height sizei)) 85 | 86 | (defglextfun ("glGetGraphicsResetStatus" get-graphics-reset-status 1369) enum) 87 | 88 | (defglextfun ("glGetnUniformfv" getn-uniform-fv 1370) :void 89 | (program uint) 90 | (location int) 91 | (bufSize sizei) 92 | (params (:pointer float))) 93 | 94 | (defglextfun ("glGetnUniformiv" getn-uniform-iv 1371) :void 95 | (program uint) 96 | (location int) 97 | (bufSize sizei) 98 | (params (:pointer int))) 99 | 100 | (defglextfun ("glReadnPixels" readn-pixels 1372) :void 101 | (x int) 102 | (y int) 103 | (width sizei) 104 | (height sizei) 105 | (format enum) 106 | (type enum) 107 | (bufSize sizei) 108 | (data (:pointer :void))) 109 | 110 | -------------------------------------------------------------------------------- /gl/funcs-gl-gles1-gles2-glsc2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglfun ("glCullFace" cull-face 3249) :void 13 | (mode enum)) 14 | 15 | (defglfun ("glFrontFace" front-face 3250) :void 16 | (mode enum)) 17 | 18 | (defglfun ("glHint" hint 3251) :void 19 | (target enum) 20 | (mode enum)) 21 | 22 | (defglfun ("glLineWidth" line-width 3252) :void 23 | (width float)) 24 | 25 | (defglfun ("glScissor" scissor 3253) :void 26 | (x int) 27 | (y int) 28 | (width sizei) 29 | (height sizei)) 30 | 31 | (defglfun ("glTexParameterf" tex-parameter-f 3254) :void 32 | (target enum) 33 | (pname enum) 34 | (param float)) 35 | 36 | (defglfun ("glTexParameterfv" tex-parameter-fv 3255) :void 37 | (target enum) 38 | (pname enum) 39 | (params (:pointer float))) 40 | 41 | (defglfun ("glTexParameteri" tex-parameter-i 3256) :void 42 | (target enum) 43 | (pname enum) 44 | (param int)) 45 | 46 | (defglfun ("glTexParameteriv" tex-parameter-iv 3257) :void 47 | (target enum) 48 | (pname enum) 49 | (params (:pointer int))) 50 | 51 | (defglfun ("glClear" clear 3258) :void 52 | (mask ClearBufferMask)) 53 | 54 | (defglfun ("glClearColor" clear-color 3259) :void 55 | (red float) 56 | (green float) 57 | (blue float) 58 | (alpha float)) 59 | 60 | (defglfun ("glClearStencil" clear-stencil 3260) :void 61 | (s int)) 62 | 63 | (defglfun ("glStencilMask" stencil-mask 3261) :void 64 | (mask uint)) 65 | 66 | (defglfun ("glColorMask" color-mask 3262) :void 67 | (red boolean) 68 | (green boolean) 69 | (blue boolean) 70 | (alpha boolean)) 71 | 72 | (defglfun ("glDepthMask" depth-mask 3263) :void 73 | (flag boolean)) 74 | 75 | (defglfun ("glDisable" disable 3264) :void 76 | (cap enum)) 77 | 78 | (defglfun ("glEnable" enable 3265) :void 79 | (cap enum)) 80 | 81 | (defglfun ("glFinish" finish 3266) :void) 82 | 83 | (defglfun ("glFlush" flush 3267) :void) 84 | 85 | (defglfun ("glBlendFunc" blend-func 3268) :void 86 | (sfactor enum) 87 | (dfactor enum)) 88 | 89 | (defglfun ("glStencilFunc" stencil-func 3269) :void 90 | (func enum) 91 | (ref int) 92 | (mask uint)) 93 | 94 | (defglfun ("glStencilOp" stencil-op 3270) :void 95 | (fail enum) 96 | (zfail enum) 97 | (zpass enum)) 98 | 99 | (defglfun ("glDepthFunc" depth-func 3271) :void 100 | (func enum)) 101 | 102 | (defglfun ("glPixelStorei" pixel-store-i 3272) :void 103 | (pname enum) 104 | (param int)) 105 | 106 | (defglfun ("glGetBooleanv" get-boolean-v 3273) :void 107 | (pname enum) 108 | (data (:pointer boolean))) 109 | 110 | (defglfun ("glGetError" get-error 3274) enum) 111 | 112 | (defglfun ("glGetFloatv" get-float-v 3275) :void 113 | (pname enum) 114 | (data (:pointer float))) 115 | 116 | (defglfun ("glGetIntegerv" get-integer-v 3276) :void 117 | (pname enum) 118 | (data (:pointer int))) 119 | 120 | (defglfun ("glGetString" get-string 3277) string 121 | (name enum)) 122 | 123 | (defglfun ("glGetTexParameterfv" get-tex-parameter-fv 3278) :void 124 | (target enum) 125 | (pname enum) 126 | (params (:pointer float))) 127 | 128 | (defglfun ("glGetTexParameteriv" get-tex-parameter-iv 3279) :void 129 | (target enum) 130 | (pname enum) 131 | (params (:pointer int))) 132 | 133 | (defglfun ("glIsEnabled" is-enabled 3280) boolean 134 | (cap enum)) 135 | 136 | (defglfun ("glViewport" viewport 3281) :void 137 | (x int) 138 | (y int) 139 | (width sizei) 140 | (height sizei)) 141 | 142 | (defglfun ("glDrawArrays" draw-arrays 3282) :void 143 | (mode enum) 144 | (first int) 145 | (count sizei)) 146 | 147 | (defglfun ("glPolygonOffset" polygon-offset 3283) :void 148 | (factor float) 149 | (units float)) 150 | 151 | (defglfun ("glTexSubImage2D" tex-sub-image-2d 3284) :void 152 | (target enum) 153 | (level int) 154 | (xoffset int) 155 | (yoffset int) 156 | (width sizei) 157 | (height sizei) 158 | (format enum) 159 | (type enum) 160 | (pixels offset-or-pointer)) 161 | 162 | (defglfun ("glBindTexture" bind-texture 3285) :void 163 | (target enum) 164 | (texture uint)) 165 | 166 | (defglfun ("glGenTextures" gen-textures 3286) :void 167 | (n sizei) 168 | (textures (:pointer uint))) 169 | 170 | (defglextfun ("glActiveTexture" active-texture 3287) :void 171 | (texture enum)) 172 | 173 | (defglextfun ("glSampleCoverage" sample-coverage 3288) :void 174 | (value float) 175 | (invert boolean)) 176 | 177 | (defglextfun ("glCompressedTexSubImage2D" compressed-tex-sub-image-2d 3289) :void 178 | (target enum) 179 | (level int) 180 | (xoffset int) 181 | (yoffset int) 182 | (width sizei) 183 | (height sizei) 184 | (format enum) 185 | (imageSize sizei) 186 | (data offset-or-pointer)) 187 | 188 | (defglextfun ("glBindBuffer" bind-buffer 3290) :void 189 | (target enum) 190 | (buffer uint)) 191 | 192 | (defglextfun ("glGenBuffers" gen-buffers 3291) :void 193 | (n sizei) 194 | (buffers (:pointer uint))) 195 | 196 | (defglextfun ("glBufferData" buffer-data 3292) :void 197 | (target enum) 198 | (size sizeiptr) 199 | (data (:pointer :void)) 200 | (usage enum)) 201 | 202 | (defglextfun ("glBufferSubData" buffer-sub-data 3293) :void 203 | (target enum) 204 | (offset intptr) 205 | (size sizeiptr) 206 | (data (:pointer :void))) 207 | 208 | (defglextfun ("glGetBufferParameteriv" get-buffer-parameter-iv 3294) :void 209 | (target enum) 210 | (pname enum) 211 | (params (:pointer int))) 212 | 213 | -------------------------------------------------------------------------------- /gl/funcs-gl-gles1-gles2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglfun ("glTexImage2D" tex-image-2d 1590) :void 13 | (target enum) 14 | (level int) 15 | (internalformat int) 16 | (width sizei) 17 | (height sizei) 18 | (border int) 19 | (format enum) 20 | (type enum) 21 | (pixels offset-or-pointer)) 22 | 23 | (defglfun ("glReadPixels" read-pixels 1591) :void 24 | (x int) 25 | (y int) 26 | (width sizei) 27 | (height sizei) 28 | (format enum) 29 | (type enum) 30 | (pixels offset-or-pointer)) 31 | 32 | (defglfun ("glDrawElements" draw-elements 1592) :void 33 | (mode enum) 34 | (count sizei) 35 | (type enum) 36 | (indices offset-or-pointer)) 37 | 38 | (defglfun ("glCopyTexImage2D" copy-tex-image-2d 1593) :void 39 | (target enum) 40 | (level int) 41 | (internalformat enum) 42 | (x int) 43 | (y int) 44 | (width sizei) 45 | (height sizei) 46 | (border int)) 47 | 48 | (defglfun ("glCopyTexSubImage2D" copy-tex-sub-image-2d 1594) :void 49 | (target enum) 50 | (level int) 51 | (xoffset int) 52 | (yoffset int) 53 | (x int) 54 | (y int) 55 | (width sizei) 56 | (height sizei)) 57 | 58 | (defglfun ("glDeleteTextures" delete-textures 1595) :void 59 | (n sizei) 60 | (textures (:pointer uint))) 61 | 62 | (defglfun ("glIsTexture" is-texture 1596) boolean 63 | (texture uint)) 64 | 65 | (defglextfun ("glCompressedTexImage2D" compressed-tex-image-2d 1597) :void 66 | (target enum) 67 | (level int) 68 | (internalformat enum) 69 | (width sizei) 70 | (height sizei) 71 | (border int) 72 | (imageSize sizei) 73 | (data offset-or-pointer)) 74 | 75 | (defglextfun ("glDeleteBuffers" delete-buffers 1598) :void 76 | (n sizei) 77 | (buffers (:pointer uint))) 78 | 79 | (defglextfun ("glIsBuffer" is-buffer 1599) boolean 80 | (buffer uint)) 81 | 82 | (defglextfun ("glBlendEquationEXT" blend-equation-ext 1600) :void 83 | (mode enum)) 84 | 85 | (defglextfun ("glRenderbufferStorageMultisampleEXT" renderbuffer-storage-multisample-ext 1601) :void 86 | (target enum) 87 | (samples sizei) 88 | (internalformat enum) 89 | (width sizei) 90 | (height sizei)) 91 | 92 | (defglextfun ("glMultiDrawArraysEXT" multi-draw-arrays-ext 1602) :void 93 | (mode enum) 94 | (first (:pointer int)) 95 | (count (:pointer sizei)) 96 | (primcount sizei)) 97 | 98 | (defglextfun ("glMultiDrawElementsEXT" multi-draw-elements-ext 1603) :void 99 | (mode enum) 100 | (count (:pointer sizei)) 101 | (type enum) 102 | (indices (:pointer (:pointer :void))) 103 | (primcount sizei)) 104 | 105 | (defglextfun ("glDeleteFencesNV" delete-fences-nv 1604) :void 106 | (n sizei) 107 | (fences (:pointer uint))) 108 | 109 | (defglextfun ("glGenFencesNV" gen-fences-nv 1605) :void 110 | (n sizei) 111 | (fences (:pointer uint))) 112 | 113 | (defglextfun ("glIsFenceNV" is-fence-nv 1606) boolean 114 | (fence uint)) 115 | 116 | (defglextfun ("glTestFenceNV" test-fence-nv 1607) boolean 117 | (fence uint)) 118 | 119 | (defglextfun ("glGetFenceivNV" get-fence-iv-nv 1608) :void 120 | (fence uint) 121 | (pname enum) 122 | (params (:pointer int))) 123 | 124 | (defglextfun ("glFinishFenceNV" finish-fence-nv 1609) :void 125 | (fence uint)) 126 | 127 | (defglextfun ("glSetFenceNV" set-fence-nv 1610) :void 128 | (fence uint) 129 | (condition enum)) 130 | 131 | -------------------------------------------------------------------------------- /gl/funcs-gl-gles2-glsc2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglextfun ("glDrawRangeElements" draw-range-elements 1373) :void 13 | (mode enum) 14 | (start uint) 15 | (end uint) 16 | (count sizei) 17 | (type enum) 18 | (indices offset-or-pointer)) 19 | 20 | (defglextfun ("glBlendFuncSeparate" blend-func-separate 1374) :void 21 | (sfactorRGB enum) 22 | (dfactorRGB enum) 23 | (sfactorAlpha enum) 24 | (dfactorAlpha enum)) 25 | 26 | (defglextfun ("glBlendEquationSeparate" blend-equation-separate 1375) :void 27 | (modeRGB enum) 28 | (modeAlpha enum)) 29 | 30 | (defglextfun ("glStencilOpSeparate" stencil-op-separate 1376) :void 31 | (face enum) 32 | (sfail enum) 33 | (dpfail enum) 34 | (dppass enum)) 35 | 36 | (defglextfun ("glStencilFuncSeparate" stencil-func-separate 1377) :void 37 | (face enum) 38 | (func enum) 39 | (ref int) 40 | (mask uint)) 41 | 42 | (defglextfun ("glStencilMaskSeparate" stencil-mask-separate 1378) :void 43 | (face enum) 44 | (mask uint)) 45 | 46 | (defglextfun ("glCreateProgram" create-program 1379) uint) 47 | 48 | (defglextfun ("glDisableVertexAttribArray" disable-vertex-attrib-array 1380) :void 49 | (index uint)) 50 | 51 | (defglextfun ("glEnableVertexAttribArray" enable-vertex-attrib-array 1381) :void 52 | (index uint)) 53 | 54 | (defglextfun ("glGetAttribLocation" get-attrib-location 1382) int 55 | (program uint) 56 | (name (:pointer char))) 57 | 58 | (defglextfun ("glGetProgramiv" get-program-iv 1383) :void 59 | (program uint) 60 | (pname enum) 61 | (params (:pointer int))) 62 | 63 | (defglextfun ("glGetUniformLocation" get-uniform-location 1384) int 64 | (program uint) 65 | (name (:pointer char))) 66 | 67 | (defglextfun ("glGetVertexAttribfv" get-vertex-attrib-fv 1385) :void 68 | (index uint) 69 | (pname enum) 70 | (params (:pointer float))) 71 | 72 | (defglextfun ("glGetVertexAttribiv" get-vertex-attrib-iv 1386) :void 73 | (index uint) 74 | (pname enum) 75 | (params (:pointer int))) 76 | 77 | (defglextfun ("glGetVertexAttribPointerv" get-vertex-attrib-pointer-v 1387) :void 78 | (index uint) 79 | (pname enum) 80 | (pointer (:pointer (:pointer :void)))) 81 | 82 | (defglextfun ("glUseProgram" use-program 1388) :void 83 | (program uint)) 84 | 85 | (defglextfun ("glUniform1f" uniform-1f 1389) :void 86 | (location int) 87 | (v0 float)) 88 | 89 | (defglextfun ("glUniform2f" uniform-2f 1390) :void 90 | (location int) 91 | (v0 float) 92 | (v1 float)) 93 | 94 | (defglextfun ("glUniform3f" uniform-3f 1391) :void 95 | (location int) 96 | (v0 float) 97 | (v1 float) 98 | (v2 float)) 99 | 100 | (defglextfun ("glUniform4f" uniform-4f 1392) :void 101 | (location int) 102 | (v0 float) 103 | (v1 float) 104 | (v2 float) 105 | (v3 float)) 106 | 107 | (defglextfun ("glUniform1i" uniform-1i 1393) :void 108 | (location int) 109 | (v0 int)) 110 | 111 | (defglextfun ("glUniform2i" uniform-2i 1394) :void 112 | (location int) 113 | (v0 int) 114 | (v1 int)) 115 | 116 | (defglextfun ("glUniform3i" uniform-3i 1395) :void 117 | (location int) 118 | (v0 int) 119 | (v1 int) 120 | (v2 int)) 121 | 122 | (defglextfun ("glUniform4i" uniform-4i 1396) :void 123 | (location int) 124 | (v0 int) 125 | (v1 int) 126 | (v2 int) 127 | (v3 int)) 128 | 129 | (defglextfun ("glUniform1fv" uniform-1fv 1397) :void 130 | (location int) 131 | (count sizei) 132 | (value (:pointer float))) 133 | 134 | (defglextfun ("glUniform2fv" uniform-2fv 1398) :void 135 | (location int) 136 | (count sizei) 137 | (value (:pointer float))) 138 | 139 | (defglextfun ("glUniform3fv" uniform-3fv 1399) :void 140 | (location int) 141 | (count sizei) 142 | (value (:pointer float))) 143 | 144 | (defglextfun ("glUniform4fv" uniform-4fv 1400) :void 145 | (location int) 146 | (count sizei) 147 | (value (:pointer float))) 148 | 149 | (defglextfun ("glUniform1iv" uniform-1iv 1401) :void 150 | (location int) 151 | (count sizei) 152 | (value (:pointer int))) 153 | 154 | (defglextfun ("glUniform2iv" uniform-2iv 1402) :void 155 | (location int) 156 | (count sizei) 157 | (value (:pointer int))) 158 | 159 | (defglextfun ("glUniform3iv" uniform-3iv 1403) :void 160 | (location int) 161 | (count sizei) 162 | (value (:pointer int))) 163 | 164 | (defglextfun ("glUniform4iv" uniform-4iv 1404) :void 165 | (location int) 166 | (count sizei) 167 | (value (:pointer int))) 168 | 169 | (defglextfun ("glUniformMatrix2fv" uniform-matrix-2fv 1405) :void 170 | (location int) 171 | (count sizei) 172 | (transpose boolean) 173 | (value (:pointer float))) 174 | 175 | (defglextfun ("glUniformMatrix3fv" uniform-matrix-3fv 1406) :void 176 | (location int) 177 | (count sizei) 178 | (transpose boolean) 179 | (value (:pointer float))) 180 | 181 | (defglextfun ("glUniformMatrix4fv" uniform-matrix-4fv 1407) :void 182 | (location int) 183 | (count sizei) 184 | (transpose boolean) 185 | (value (:pointer float))) 186 | 187 | (defglextfun ("glVertexAttrib1f" vertex-attrib-1f 1408) :void 188 | (index uint) 189 | (x float)) 190 | 191 | (defglextfun ("glVertexAttrib1fv" vertex-attrib-1fv 1409) :void 192 | (index uint) 193 | (v (:pointer float))) 194 | 195 | (defglextfun ("glVertexAttrib2f" vertex-attrib-2f 1410) :void 196 | (index uint) 197 | (x float) 198 | (y float)) 199 | 200 | (defglextfun ("glVertexAttrib2fv" vertex-attrib-2fv 1411) :void 201 | (index uint) 202 | (v (:pointer float))) 203 | 204 | (defglextfun ("glVertexAttrib3f" vertex-attrib-3f 1412) :void 205 | (index uint) 206 | (x float) 207 | (y float) 208 | (z float)) 209 | 210 | (defglextfun ("glVertexAttrib3fv" vertex-attrib-3fv 1413) :void 211 | (index uint) 212 | (v (:pointer float))) 213 | 214 | (defglextfun ("glVertexAttrib4f" vertex-attrib-4f 1414) :void 215 | (index uint) 216 | (x float) 217 | (y float) 218 | (z float) 219 | (w float)) 220 | 221 | (defglextfun ("glVertexAttrib4fv" vertex-attrib-4fv 1415) :void 222 | (index uint) 223 | (v (:pointer float))) 224 | 225 | (defglextfun ("glVertexAttribPointer" vertex-attrib-pointer 1416) :void 226 | (index uint) 227 | (size int) 228 | (type enum) 229 | (normalized boolean) 230 | (stride sizei) 231 | (pointer offset-or-pointer)) 232 | 233 | -------------------------------------------------------------------------------- /gl/funcs-gles1-gles2.lisp: -------------------------------------------------------------------------------- 1 | ;;; this file is automatically generated, do not edit 2 | ;;; generated from files with the following copyright: 3 | ;;; 4 | ;;; Copyright 2013-2020 The Khronos Group Inc. 5 | ;;; SPDX-License-Identifier: Apache-2.0 6 | 7 | (in-package #:cl-opengl-bindings) 8 | 9 | ;;; generated 2024-08-16T20:46:56Z 10 | ;;; from gl.xml @ git sha 4f845dc97972c72cad684cc22c7bf96e6d5319a6, 2024-08-15T14:04:09Z 11 | 12 | (defglextfun ("glCopyTextureLevelsAPPLE" copy-texture-levels-apple 0) :void 13 | (destinationTexture uint) 14 | (sourceTexture uint) 15 | (sourceBaseLevel int) 16 | (sourceLevelCount sizei)) 17 | 18 | (defglextfun ("glRenderbufferStorageMultisampleAPPLE" renderbuffer-storage-multisample-apple 1) :void 19 | (target enum) 20 | (samples sizei) 21 | (internalformat enum) 22 | (width sizei) 23 | (height sizei)) 24 | 25 | (defglextfun ("glResolveMultisampleFramebufferAPPLE" resolve-multisample-framebuffer-apple 2) :void) 26 | 27 | (defglextfun ("glFenceSyncAPPLE" fence-sync-apple 3) sync 28 | (condition enum) 29 | (flags SyncBehaviorFlags)) 30 | 31 | (defglextfun ("glIsSyncAPPLE" is-sync-apple 4) boolean 32 | (sync sync)) 33 | 34 | (defglextfun ("glDeleteSyncAPPLE" delete-sync-apple 5) :void 35 | (sync sync)) 36 | 37 | (defglextfun ("glClientWaitSyncAPPLE" client-wait-sync-apple 6) enum 38 | (sync sync) 39 | (flags SyncObjectMask) 40 | (timeout uint64)) 41 | 42 | (defglextfun ("glWaitSyncAPPLE" wait-sync-apple 7) :void 43 | (sync sync) 44 | (flags SyncBehaviorFlags) 45 | (timeout uint64)) 46 | 47 | (defglextfun ("glGetInteger64vAPPLE" get-integer-64-v-apple 8) :void 48 | (pname enum) 49 | (params (:pointer int64))) 50 | 51 | (defglextfun ("glGetSyncivAPPLE" get-sync-iv-apple 9) :void 52 | (sync sync) 53 | (pname enum) 54 | (count sizei) 55 | (length (:pointer sizei)) 56 | (values (:pointer int))) 57 | 58 | (defglextfun ("glDiscardFramebufferEXT" discard-framebuffer-ext 10) :void 59 | (target enum) 60 | (numAttachments sizei) 61 | (attachments (:pointer enum))) 62 | 63 | (defglextfun ("glMapBufferRangeEXT" map-buffer-range-ext 11) (:pointer :void) 64 | (target enum) 65 | (offset intptr) 66 | (length sizeiptr) 67 | (access MapBufferAccessMask)) 68 | 69 | (defglextfun ("glFlushMappedBufferRangeEXT" flush-mapped-buffer-range-ext 12) :void 70 | (target enum) 71 | (offset intptr) 72 | (length sizeiptr)) 73 | 74 | (defglextfun ("glFramebufferTexture2DMultisampleEXT" framebuffer-texture-2d-multisample-ext 13) :void 75 | (target enum) 76 | (attachment enum) 77 | (textarget enum) 78 | (texture uint) 79 | (level int) 80 | (samples sizei)) 81 | 82 | (defglextfun ("glGetGraphicsResetStatusEXT" get-graphics-reset-status-ext 14) enum) 83 | 84 | (defglextfun ("glReadnPixelsEXT" readn-pixels-ext 15) :void 85 | (x int) 86 | (y int) 87 | (width sizei) 88 | (height sizei) 89 | (format enum) 90 | (type enum) 91 | (bufSize sizei) 92 | (data (:pointer :void))) 93 | 94 | (defglextfun ("glGetnUniformfvEXT" getn-uniformfv-ext 16) :void 95 | (program uint) 96 | (location int) 97 | (bufSize sizei) 98 | (params (:pointer float))) 99 | 100 | (defglextfun ("glGetnUniformivEXT" getn-uniformiv-ext 17) :void 101 | (program uint) 102 | (location int) 103 | (bufSize sizei) 104 | (params (:pointer int))) 105 | 106 | (defglextfun ("glRenderbufferStorageMultisampleIMG" renderbuffer-storage-multisample-img 18) :void 107 | (target enum) 108 | (samples sizei) 109 | (internalformat enum) 110 | (width sizei) 111 | (height sizei)) 112 | 113 | (defglextfun ("glFramebufferTexture2DMultisampleIMG" framebuffer-texture-2d-multisample-img 19) :void 114 | (target enum) 115 | (attachment enum) 116 | (textarget enum) 117 | (texture uint) 118 | (level int) 119 | (samples sizei)) 120 | 121 | (defglextfun ("glEGLImageTargetTexture2DOES" egl-image-target-texture-2d-oes 20) :void 122 | (target enum) 123 | (image egl-image-oes)) 124 | 125 | (defglextfun ("glEGLImageTargetRenderbufferStorageOES" egl-image-target-renderbuffer-storage-oes 21) :void 126 | (target enum) 127 | (image egl-image-oes)) 128 | 129 | (defglextfun ("glMapBufferOES" map-buffer-oes 22) (:pointer :void) 130 | (target enum) 131 | (access enum)) 132 | 133 | (defglextfun ("glUnmapBufferOES" unmap-buffer-oes 23) boolean 134 | (target enum)) 135 | 136 | (defglextfun ("glGetBufferPointervOES" get-buffer-pointer-v-oes 24) :void 137 | (target enum) 138 | (pname enum) 139 | (params (:pointer (:pointer :void)))) 140 | 141 | (defglextfun ("glBindVertexArrayOES" bind-vertex-array-oes 25) :void 142 | (array uint)) 143 | 144 | (defglextfun ("glDeleteVertexArraysOES" delete-vertex-arrays-oes 26) :void 145 | (n sizei) 146 | (arrays (:pointer uint))) 147 | 148 | (defglextfun ("glGenVertexArraysOES" gen-vertex-arrays-oes 27) :void 149 | (n sizei) 150 | (arrays (:pointer uint))) 151 | 152 | (defglextfun ("glIsVertexArrayOES" is-vertex-array-oes 28) boolean 153 | (array uint)) 154 | 155 | (defglextfun ("glGetDriverControlsQCOM" get-driver-controls-qcom 29) :void 156 | (num (:pointer int)) 157 | (size sizei) 158 | (driverControls (:pointer uint))) 159 | 160 | (defglextfun ("glGetDriverControlStringQCOM" get-driver-control-string-qcom 30) :void 161 | (driverControl uint) 162 | (bufSize sizei) 163 | (length (:pointer sizei)) 164 | (driverControlString (:pointer char))) 165 | 166 | (defglextfun ("glEnableDriverControlQCOM" enable-driver-control-qcom 31) :void 167 | (driverControl uint)) 168 | 169 | (defglextfun ("glDisableDriverControlQCOM" disable-driver-control-qcom 32) :void 170 | (driverControl uint)) 171 | 172 | (defglextfun ("glExtGetTexturesQCOM" ext-get-textures-qcom 33) :void 173 | (textures (:pointer uint)) 174 | (maxTextures int) 175 | (numTextures (:pointer int))) 176 | 177 | (defglextfun ("glExtGetBuffersQCOM" ext-get-buffers-qcom 34) :void 178 | (buffers (:pointer uint)) 179 | (maxBuffers int) 180 | (numBuffers (:pointer int))) 181 | 182 | (defglextfun ("glExtGetRenderbuffersQCOM" ext-get-renderbuffers-qcom 35) :void 183 | (renderbuffers (:pointer uint)) 184 | (maxRenderbuffers int) 185 | (numRenderbuffers (:pointer int))) 186 | 187 | (defglextfun ("glExtGetFramebuffersQCOM" ext-get-framebuffers-qcom 36) :void 188 | (framebuffers (:pointer uint)) 189 | (maxFramebuffers int) 190 | (numFramebuffers (:pointer int))) 191 | 192 | (defglextfun ("glExtGetTexLevelParameterivQCOM" ext-get-tex-level-parameter-iv-qcom 37) :void 193 | (texture uint) 194 | (face enum) 195 | (level int) 196 | (pname enum) 197 | (params (:pointer int))) 198 | 199 | (defglextfun ("glExtTexObjectStateOverrideiQCOM" ext-tex-object-state-override-i-qcom 38) :void 200 | (target enum) 201 | (pname enum) 202 | (param int)) 203 | 204 | (defglextfun ("glExtGetTexSubImageQCOM" ext-get-tex-sub-image-qcom 39) :void 205 | (target enum) 206 | (level int) 207 | (xoffset int) 208 | (yoffset int) 209 | (zoffset int) 210 | (width sizei) 211 | (height sizei) 212 | (depth sizei) 213 | (format enum) 214 | (type enum) 215 | (texels (:pointer :void))) 216 | 217 | (defglextfun ("glExtGetBufferPointervQCOM" ext-get-buffer-pointer-v-qcom 40) :void 218 | (target enum) 219 | (params (:pointer (:pointer :void)))) 220 | 221 | (defglextfun ("glExtGetShadersQCOM" ext-get-shaders-qcom 41) :void 222 | (shaders (:pointer uint)) 223 | (maxShaders int) 224 | (numShaders (:pointer int))) 225 | 226 | (defglextfun ("glExtGetProgramsQCOM" ext-get-programs-qcom 42) :void 227 | (programs (:pointer uint)) 228 | (maxPrograms int) 229 | (numPrograms (:pointer int))) 230 | 231 | (defglextfun ("glExtIsProgramBinaryQCOM" ext-is-program-binary-qcom 43) boolean 232 | (program uint)) 233 | 234 | (defglextfun ("glExtGetProgramBinarySourceQCOM" ext-get-program-binary-source-qcom 44) :void 235 | (program uint) 236 | (shadertype enum) 237 | (source (:pointer char)) 238 | (length (:pointer int))) 239 | 240 | (defglextfun ("glStartTilingQCOM" start-tiling-qcom 45) :void 241 | (x uint) 242 | (y uint) 243 | (width uint) 244 | (height uint) 245 | (preserveMask BufferBitQCOM)) 246 | 247 | (defglextfun ("glEndTilingQCOM" end-tiling-qcom 46) :void 248 | (preserveMask BufferBitQCOM)) 249 | 250 | -------------------------------------------------------------------------------- /gl/library-common.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:cl-opengl-library 2 | (:use #:cl #:cffi) 3 | (:export #:load-opengl-library 4 | #:close-opengl-library)) 5 | 6 | (in-package #:cl-opengl-bindings) 7 | 8 | (defun cl-opengl-library:load-opengl-library () 9 | (load-foreign-library 'opengl)) 10 | 11 | (defun cl-opengl-library:close-opengl-library () 12 | (close-foreign-library 'opengl)) 13 | -------------------------------------------------------------------------------- /gl/library-glesv2.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-opengl-bindings) 2 | 3 | ;;; we can't use libGL and libGLES* at the same time, so try to detect 4 | ;;; conflicts and complain 5 | 6 | ;;; either the lisp doesn't support specifying which library to use 7 | ;;; (most lisps, indicated by cffi-features:flat-namespace in 8 | ;;; *features*) or we specified it should use the one from library 9 | ;;; named by OPENGL when defining the function, so we need to use that 10 | ;;; name (or fix how they are defined, but it still wouldn't work 11 | ;;; right on the other lisps, so only supporting using 1 at a time for now) 12 | 13 | 14 | ;; fixme: figure out how to tell if cffi hasn't seen a definition for 15 | ;; OPENGL library yet 16 | (when (and (ignore-errors (foreign-library-loaded-p 'opengl)) 17 | (not (search "glesv2" 18 | (string-downcase 19 | (pathname-name 20 | (cffi:foreign-library-pathname 'opengl)))))) 21 | (cerror "load libGLESv2" 22 | "trying to load cl-opengl against libGLESv2, but ~s is already loaded" 23 | (namestring 24 | (cffi:foreign-library-pathname 'opengl))) 25 | (close-foreign-library 'opengl)) 26 | 27 | (define-foreign-library opengl 28 | (t (:or (:default "libGLESv3") (:default "libGLESv2")))) 29 | 30 | (unless (member :cl-opengl-no-preload *features*) 31 | (use-foreign-library opengl)) 32 | -------------------------------------------------------------------------------- /gl/library.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; library.lisp --- Foreign library definition 4 | ;;; 5 | ;;; Copyright (C) 2006-2007, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-opengl-bindings) 34 | 35 | (define-foreign-library opengl 36 | (:darwin (:framework "OpenGL")) 37 | (:windows "opengl32.dll" :convention :stdcall) 38 | (:unix (:or "libGL.so.4" "libGL.so.3" "libGL.so.2" "libGL.so.1" "libGL.so"))) 39 | 40 | 41 | (unless (member :cl-opengl-no-preload *features*) 42 | (use-foreign-library opengl)) 43 | -------------------------------------------------------------------------------- /gl/special-constants.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:cl-opengl) 2 | 3 | ;;; special values for some numeric arguments 4 | 5 | (defconstant +all-pixels-amd+ #xFFFFFFFF) 6 | (defconstant +invalid-index+ #xFFFFFFFF) 7 | (defconstant +timeout-ignored+ #xFFFFFFFFFFFFFFFF) 8 | (defconstant +timeout-ignored-apple+ #xFFFFFFFFFFFFFFFF) 9 | 10 | -------------------------------------------------------------------------------- /gl/special.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; Copyright (c) 2004, Oliver Markovic 4 | ;;; All rights reserved. 5 | ;;; 6 | ;;; Redistribution and use in source and binary forms, with or without 7 | ;;; modification, are permitted provided that the following conditions are met: 8 | ;;; 9 | ;;; o Redistributions of source code must retain the above copyright notice, 10 | ;;; this list of conditions and the following disclaimer. 11 | ;;; o Redistributions in binary form must reproduce the above copyright 12 | ;;; notice, this list of conditions and the following disclaimer in the 13 | ;;; documentation and/or other materials provided with the distribution. 14 | ;;; o Neither the name of the author nor the names of the contributors may be 15 | ;;; used to endorse or promote products derived from this software without 16 | ;;; specific prior written permission. 17 | ;;; 18 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | ;;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 21 | ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE 22 | ;;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 23 | ;;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 24 | ;;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 25 | ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 26 | ;;; CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 27 | ;;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 28 | ;;; POSSIBILITY OF SUCH DAMAGE. 29 | 30 | (in-package #:cl-opengl) 31 | 32 | ;;; 33 | ;;; Chapter 5 - Special Functions 34 | ;;; 35 | 36 | ;;; 37 | ;;; 5.1 Evaluators 38 | ;;; 39 | 40 | (defun map1 (target u1 u2 points) 41 | (let* ((stride (array-dimension points 1)) 42 | (order (array-dimension points 0)) 43 | (count (* stride order))) 44 | (with-foreign-object (array '%gl:float count) 45 | (dotimes (i count) 46 | (setf (mem-aref array '%gl:float i) (float (row-major-aref points i)))) 47 | (%gl:map-1f target (float u1) (float u2) stride order array)))) 48 | 49 | (defun map2 (target u1 u2 v1 v2 points) 50 | (let* ((ustride (array-dimension points 2)) 51 | (uorder (array-dimension points 1)) 52 | (vstride (* ustride uorder)) 53 | (vorder (array-dimension points 0)) 54 | (count (* vorder ustride uorder))) 55 | (with-foreign-object (array '%gl:float count) 56 | (dotimes (i count) 57 | (setf (mem-aref array '%gl:float i) (float (row-major-aref points i)))) 58 | (%gl:map-2f target 59 | (float u1) (float u2) ustride uorder 60 | (float v1) (float v2) vstride vorder 61 | array)))) 62 | 63 | (definline eval-coord-1 (x) 64 | (%gl:eval-coord-1f x)) 65 | 66 | (definline eval-coord-2 (x y) 67 | (%gl:eval-coord-2f x y)) 68 | 69 | (definline map-grid-1 (n u1 u2) 70 | (%gl:map-grid-1f n u1 u2)) 71 | 72 | (definline map-grid-2 (nu u1 u2 nv v1 v2) 73 | (%gl:map-grid-2f nu u1 u2 nv v1 v2)) 74 | 75 | (import-export %gl:eval-mesh-1 76 | %gl:eval-mesh-2 77 | %gl:eval-point-1 78 | %gl:eval-point-2) 79 | 80 | ;;; 81 | ;;; 5.2 Selection 82 | ;;; 83 | 84 | (import-export %gl:init-names 85 | %gl:pop-name 86 | %gl:push-name 87 | %gl:load-name 88 | %gl:render-mode) 89 | 90 | (defun select-buffer (array) 91 | (declare (ignore array)) 92 | (error "not implemented")) 93 | 94 | ;;; 95 | ;;; 5.3 Feedback 96 | ;;; 97 | 98 | (defun feedback-buffer (array) 99 | (declare (ignore array)) 100 | (error "not implemented")) 101 | 102 | (import-export %gl:pass-through) 103 | 104 | ;;; 105 | ;;; 5.4 Display Lists 106 | ;;; 107 | 108 | (import-export %gl:new-list 109 | %gl:end-list 110 | %gl:call-list) 111 | 112 | ;;; Maybe we could optimize some more here if LISTS is vector 113 | ;;; with a suitable element-type. 114 | (defun call-lists (lists) 115 | (with-opengl-sequence (array '%gl:uint lists) 116 | (%gl:call-lists (length lists) 117 | #.(foreign-enum-value '%gl:enum :unsigned-int) 118 | array))) 119 | 120 | (import-export %gl:list-base 121 | %gl:gen-lists 122 | ;; to be consistent we probably should rename this 123 | ;; LISTP but it'd conflict with CL:LISTP 124 | %gl:is-list 125 | %gl:delete-lists) 126 | 127 | ;;; Maybe UNWIND-PROTECT instead of PROG2? 128 | (defmacro with-new-list ((id mode) &body body) 129 | `(prog2 (new-list ,id ',mode) 130 | (progn ,@body) 131 | (end-list))) 132 | 133 | ;;; 134 | ;;; 5.5 Flush and Finish 135 | ;;; 136 | 137 | (import-export %gl:flush 138 | %gl:finish) 139 | 140 | ;;; 141 | ;;; 5.6 Hints 142 | ;;; 143 | 144 | (import-export %gl:hint) 145 | -------------------------------------------------------------------------------- /gl/thunks.lisp: -------------------------------------------------------------------------------- 1 | ;;; generated file, do not edit 2 | ;;; glext version 20240815 ( 2024-08-15T14:04:09Z ) 3 | 4 | 5 | (in-package #:cl-opengl-bindings) 6 | 7 | (declaim (type (simple-array function (3296)) *init-ext-thunks* *ext-thunks*)) 8 | ;; vector of thunks used to load extension functions, initialized by 9 | ;; defglextfun while loading bindings. 10 | (defvar *init-ext-thunks* (make-array 3296 11 | :element-type 'function 12 | :initial-contents (loop for i below 3296 13 | collect (missing-thunk i)))) 14 | ;; vector of thunks used to call extension functions, initialized to copy 15 | ;; of *init-ext-thunks* and modified as functions are used. 16 | (defvar *ext-thunks* (copy-seq *init-ext-thunks*)) 17 | -------------------------------------------------------------------------------- /glu/library.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; library.lisp --- GLU foreign library definition. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glu) 34 | 35 | ;;; On darwin GLU is part of the OpenGL framework and thus 36 | ;;; is loaded already by cl-opengl, on which cl-glu depends. 37 | (define-foreign-library glu 38 | (:windows "glu32.dll") ; XXX? 39 | ((:and :unix (:not :darwin)) (:or "libGLU.so.1" "libGLU.so")) 40 | ((:not :darwin) (:default "libGLU"))) 41 | 42 | (use-foreign-library glu) 43 | -------------------------------------------------------------------------------- /glu/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; package.lisp --- Package definition for cl-glu. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-user) 34 | 35 | (defpackage #:cl-glu 36 | (:nicknames #:glu) 37 | (:use #:cl #:cffi) 38 | (:export 39 | ;;# Functions 40 | #:quadric-texture 41 | #:quadric-orientation 42 | #:quadric-normals 43 | #:quadric-draw-style 44 | #:new-quadric 45 | #:delete-quadric 46 | #:quadric-normals 47 | #:sphere 48 | #:cylinder 49 | #:disk 50 | #:partial-disk 51 | #:build-2d-mipmaps 52 | #:get-string 53 | #:check-extension 54 | #:scale-image 55 | #:ortho-2d 56 | #:perspective 57 | #:look-at 58 | #:pick-matrix 59 | #:project 60 | #:un-project 61 | #:un-project4 62 | ;; Tessellation 63 | #:tessellator 64 | #:tess-delete 65 | ;; Tessellator methods 66 | #:tess-begin-polygon 67 | #:tess-begin-contour 68 | #:tess-vertex 69 | #:tess-end-contour 70 | #:tess-end-polygon 71 | #:tess-begin 72 | #:tess-error 73 | #:tess-end 74 | #:tess-property 75 | ;; Tessellator callbacks 76 | #:begin-data-callback 77 | #:edge-flag-data-callback 78 | #:end-data-callback 79 | #:vertex-data-callback 80 | #:error-data-callback 81 | #:combine-data-callback 82 | ;; Tessellator macros 83 | #:with-tess-polygon 84 | #:with-tess-contour)) 85 | -------------------------------------------------------------------------------- /glut/fonts.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; fonts.lisp --- GLUT Font Rendering API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;;; Erm, should we want CLISP cross-platform fasl portability I think 36 | ;;; those conditionals should be changed to calls to FEATURE-P. 37 | 38 | ;;; Ugh, freeglut's font macros seem to expand into a pointer to 39 | ;;; to a couple of global variables that point somewhere else. 40 | ;;; Unless it's windows, in which case it's a sort of enum-as-pointer 41 | ;;; thing. "So here it goes:" 42 | 43 | (defvar +stroke-roman+) 44 | (defvar +stroke-mono-roman+) 45 | (defvar +bitmap-9-by-15+) 46 | (defvar +bitmap-8-by-13+) 47 | (defvar +bitmap-times-roman-10+) 48 | (defvar +bitmap-times-roman-24+) 49 | (defvar +bitmap-helvetica-10+) 50 | (defvar +bitmap-helvetica-12+) 51 | (defvar +bitmap-helvetica-18+) 52 | 53 | ;; we need to be able to reinitialize the pointers after loading a 54 | ;; saved core, so move it to a separate function... 55 | (defun init-font-pointers () 56 | (setf +stroke-roman+ 57 | #+windows (make-pointer 0) 58 | #-windows (foreign-symbol-pointer "glutStrokeRoman")) 59 | 60 | (setf +stroke-mono-roman+ 61 | #+windows (make-pointer 1) 62 | #-windows (foreign-symbol-pointer "glutStrokeMonoRoman")) 63 | 64 | (setf +bitmap-9-by-15+ 65 | #+windows (make-pointer 2) 66 | #-windows (foreign-symbol-pointer "glutBitmap9By15")) 67 | 68 | (setf +bitmap-8-by-13+ 69 | #+windows (make-pointer 3) 70 | #-windows (foreign-symbol-pointer "glutBitmap8By13")) 71 | 72 | (setf +bitmap-times-roman-10+ 73 | #+windows (make-pointer 4) 74 | #-windows (foreign-symbol-pointer "glutBitmapTimesRoman10")) 75 | 76 | (setf +bitmap-times-roman-24+ 77 | #+windows (make-pointer 5) 78 | #-windows (foreign-symbol-pointer "glutBitmapTimesRoman24")) 79 | 80 | (setf +bitmap-helvetica-10+ 81 | #+windows (make-pointer 6) 82 | #-windows (foreign-symbol-pointer "glutBitmapHelvetica10")) 83 | 84 | (setf +bitmap-helvetica-12+ 85 | #+windows (make-pointer 7) 86 | #-windows (foreign-symbol-pointer "glutBitmapHelvetica12")) 87 | 88 | (setf +bitmap-helvetica-18+ 89 | #+windows (make-pointer 8) 90 | #-windows (foreign-symbol-pointer "glutBitmapHelvetica18"))) 91 | 92 | (init-font-pointers) 93 | 94 | ;;; Functions 95 | 96 | ;;; Do we want CHAR-CODE conversion here? 97 | 98 | (defcfun ("glutBitmapCharacter" bitmap-character) :void 99 | (font :pointer) 100 | (character :int)) 101 | 102 | (defcfun ("glutBitmapWidth" bitmap-width) :int 103 | (font :pointer) 104 | (character :int)) 105 | 106 | (defcfun ("glutStrokeCharacter" stroke-character) :void 107 | (font :pointer) 108 | (character :int)) 109 | 110 | (defcfun ("glutStrokeWidth" stroke-width) :int 111 | (font :pointer) 112 | (character :int)) 113 | 114 | ;; freeglut ext? 115 | (defcfun ("glutBitmapLength" bitmap-length) :int 116 | (font :pointer) 117 | (string :string)) 118 | 119 | ;; freeglut ext? 120 | (defcfun ("glutStrokeLength" stroke-length) :int 121 | (font :pointer) 122 | (string :string)) 123 | 124 | ;; freeglut ext 125 | #-darwin 126 | (defcfun ("glutBitmapHeight" bitmap-height) :int 127 | (font :pointer)) 128 | 129 | ;; freeglut ext 130 | #-darwin 131 | (defcfun ("glutStrokeHeight" stroke-height) %gl:float 132 | (font :pointer)) 133 | 134 | ;; freeglut ext 135 | #-darwin 136 | (defcfun ("glutBitmapString" bitmap-string) :void 137 | (font :pointer) 138 | (string :string)) 139 | 140 | ;; freeglut ext 141 | #-darwin 142 | (defcfun ("glutStrokeString" stroke-string) :void 143 | (font :pointer) 144 | (string :string)) -------------------------------------------------------------------------------- /glut/geometry.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; geometry.lisp --- GLUT Geometric Object Rendering API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;;; Functions. 36 | 37 | (defcfun ("glutWireCube" wire-cube) :void 38 | (size %gl:double)) 39 | 40 | (defcfun ("glutSolidCube" solid-cube) :void 41 | (size %gl:double)) 42 | 43 | (defcfun ("glutWireSphere" wire-sphere) :void 44 | (radius %gl:double) 45 | (slices %gl:int) 46 | (stacks %gl:int)) 47 | 48 | (defcfun ("glutSolidSphere" solid-sphere) :void 49 | (radius %gl:double) 50 | (slices %gl:int) 51 | (stacks %gl:int)) 52 | 53 | (defcfun ("glutWireCone" wire-cone) :void 54 | (base %gl:double) 55 | (height %gl:double) 56 | (slices %gl:int) 57 | (stacks %gl:int)) 58 | 59 | (defcfun ("glutSolidCone" solid-cone) :void 60 | (base %gl:double) 61 | (height %gl:double) 62 | (slices %gl:int) 63 | (stacks %gl:int)) 64 | 65 | (defcfun ("glutWireTorus" wire-torus) :void 66 | (inner-radius %gl:double) 67 | (outer-radius %gl:double) 68 | (slices %gl:int) 69 | (rings %gl:int)) 70 | 71 | (defcfun ("glutSolidTorus" solid-torus) :void 72 | (inner-radius %gl:double) 73 | (outer-radius %gl:double) 74 | (slices %gl:int) 75 | (rings %gl:int)) 76 | 77 | (defcfun ("glutWireDodecahedron" wire-dodecahedron) :void) 78 | (defcfun ("glutWireOctahedron" wire-octahedron) :void) 79 | (defcfun ("glutWireTetrahedron" wire-tetrahedron) :void) 80 | (defcfun ("glutWireIcosahedron" wire-icosahedron) :void) 81 | 82 | (defcfun ("glutSolidDodecahedron" solid-dodecahedron) :void) 83 | (defcfun ("glutSolidOctahedron" solid-octahedron) :void) 84 | (defcfun ("glutSolidTetrahedron" solid-tetrahedron) :void) 85 | (defcfun ("glutSolidIcosahedron" solid-icosahedron) :void) 86 | 87 | (defcfun ("glutWireTeapot" wire-teapot) :void 88 | (size %gl:double)) 89 | 90 | (defcfun ("glutSolidTeapot" solid-teapot) :void 91 | (size %gl:double)) 92 | 93 | ;;; The following are freeglut extensions: 94 | 95 | #-darwin 96 | (defcfun ("glutWireRhombicDodecahedron" wire-rhombic-dodecahedron) :void) 97 | 98 | #-darwin 99 | (defcfun ("glutSolidRhombicDodecahedron" solid-rhombic-dodecahedron) :void) 100 | 101 | #-darwin 102 | (defcfun ("glutWireSierpinskiSponge" %glutWireSierpinskiSponge) :void 103 | (num-levels :int) 104 | (offset-seq :pointer) ; GLdouble offset[3] 105 | (scale %gl:double)) 106 | 107 | #-darwin 108 | (defun wire-sierpinski-sponge (num-levels offset-seq scale) 109 | (gl::with-opengl-sequence (offset '%gl:double offset-seq) 110 | (%glutWireSierpinskiSponge num-levels offset scale))) 111 | 112 | #-darwin 113 | (defcfun ("glutSolidSierpinskiSponge" %glutSolidSierpinskiSponge) :void 114 | (num-levels :int) 115 | (offset-seq :pointer) ; GLdouble offset[3] 116 | (scale %gl:double)) 117 | 118 | #-darwin 119 | (defun solid-sierpinski-sponge (num-levels offset-seq scale) 120 | (gl::with-opengl-sequence (offset '%gl:double offset-seq) 121 | (%glutSolidSierpinskiSponge num-levels offset scale))) 122 | 123 | #-darwin 124 | (defcfun ("glutWireCylinder" wire-cylinder) :void 125 | (radius %gl:double) 126 | (height %gl:double) 127 | (slices %gl:int) 128 | (stacks %gl:int)) 129 | 130 | #-darwin 131 | (defcfun ("glutSolidCylinder" solid-cylinder) :void 132 | (radius %gl:double) 133 | (height %gl:double) 134 | (slices %gl:int) 135 | (stacks %gl:int)) -------------------------------------------------------------------------------- /glut/init.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; init.lisp --- GLUT Initialization API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | (defcfun ("glutInit" %glutInit) :void 36 | (argcp :pointer) ; int* 37 | (argv :pointer)) ; char** 38 | 39 | (defmacro without-fp-traps (&body body) 40 | `(float-features:with-float-traps-masked t 41 | ,@body) 42 | #-(and sbcl (or x86 x86-64)) 43 | `(progn ,@body)) 44 | 45 | (defparameter *glut-initialized-p* nil) 46 | 47 | (defun %init (program-name) 48 | (with-foreign-objects ((argcp :int) (argv :pointer)) 49 | (setf (mem-ref argcp :int) 1) 50 | (with-foreign-string (str program-name) 51 | (setf (mem-ref argv :pointer) str) 52 | (%glutInit argcp argv) 53 | (init-font-pointers) 54 | (setf *glut-initialized-p* t))) 55 | ;; By default, we choose the saner option to return from the event 56 | ;; loop on window close instead of exit()ing. 57 | (set-action-on-window-close :action-continue-execution) 58 | ;; this probably doesn't play well with other toolkits 59 | (setq %gl:*gl-get-proc-address* 'get-proc-address) 60 | (values)) 61 | 62 | (defun init (&optional (program-name (lisp-implementation-type))) 63 | (without-fp-traps 64 | ;; try to capture errors/warnings if we are running on freeglut, 65 | ;; and also avoid freeglut calling exit() on errors. (we set these 66 | ;; in init to make sure they are set correctly after loading a 67 | ;; core, call before glutInit) 68 | (ignore-errors (%init-error-func (callback %glut-error))) 69 | (ignore-errors (%init-warn-func (callback %glut-warn))) 70 | ;; freeglut will exit() if we try to call initGlut() when 71 | ;; things are already initialized. 72 | #-darwin 73 | (unless (getp :init-state) 74 | (%init program-name)) 75 | #+darwin 76 | (unless *glut-initialized-p* 77 | (%init program-name)) 78 | ;; we need to track menu state since it is illegal to modify menus 79 | ;; when one is in use (needs to be called after glutInit) 80 | (menu-status-func (callback %menu-status-callback))) 81 | (values)) 82 | 83 | ;; We call init at load-time in order to ensure a usable glut as often 84 | ;; as possible. Also, we call init when the main event loop returns in 85 | ;; main.lisp and some other places. We do this to avoid having 86 | ;; freeglut call exit() when performing some operation that needs 87 | ;; previous initialization. 88 | ;; -- this is causing problems in other situations (loading without X 89 | ;; available for example, possibly also making the OSX threading stuff 90 | ;; worse), so disabling for now. 91 | ;; (init) 92 | 93 | ;;; The display-mode bitfield is defined in state.lisp 94 | (defcfun ("glutInitDisplayMode" %glutInitDisplayMode) :void 95 | (mode display-mode)) 96 | 97 | ;;; freeglut_ext.h says: "Only one GLUT_AUXn bit may be used at a time." 98 | (defun init-display-mode (&rest options) 99 | (declare (dynamic-extent options)) 100 | (%glutInitDisplayMode options)) 101 | 102 | (defbitfield (init-context-flags :int) 103 | (:debug 1) 104 | (:forward-compatible 2)) 105 | 106 | (defcfun ("glutInitContextFlags" %glutInitContextFlags) :void 107 | (flags init-context-flags)) 108 | 109 | (defun init-context-flags (&rest flags) 110 | (declare (dynamic-extent flags)) 111 | (%glutInitContextFlags flags)) 112 | 113 | ;;; useless? 114 | (defcfun ("glutInitDisplayString" init-display-string) :void 115 | (display-mode :string)) 116 | 117 | (defcfun ("glutInitWindowPosition" init-window-position) :void 118 | (x :int) 119 | (y :int)) 120 | 121 | (defcfun ("glutInitWindowSize" init-window-size) :void 122 | (width :int) 123 | (height :int)) 124 | -------------------------------------------------------------------------------- /glut/library.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; library.lisp --- GLUT foreign library definition. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package :cl-glut) 34 | 35 | (define-foreign-library glut 36 | (:darwin (:framework "GLUT")) 37 | (:windows (:or "freeglut.dll" "libglut.dll" "libglut-0.dll" "libfreeglut.dll")) 38 | (:unix (:or "libglut.so" "libglut.so.3"))) 39 | 40 | (use-foreign-library glut) 41 | -------------------------------------------------------------------------------- /glut/main.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; main.lisp --- GLUT Event Processing API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | (defcfun ("glutMainLoop" %glutMainLoop) :void) 36 | 37 | #+darwin 38 | (defcfun ("glutCheckLoop" check-loop) :void) 39 | 40 | #-darwin 41 | (defun main-loop () 42 | (without-fp-traps 43 | (%glutMainLoop)) 44 | (init)) 45 | 46 | #+darwin 47 | (let ((darwin-run-main-loop-p t)) 48 | (defun main-loop () 49 | (flet ((%loop () 50 | (without-fp-traps 51 | (loop while darwin-run-main-loop-p do (check-loop))) 52 | (init) 53 | (setf darwin-run-main-loop-p t))) 54 | (%loop))) 55 | (defun leave-main-loop () 56 | (setf darwin-run-main-loop-p nil))) 57 | 58 | #-darwin (defcfun ("glutMainLoopEvent" main-loop-event) :void) 59 | #-darwin (defcfun ("glutLeaveMainLoop" leave-main-loop) :void) 60 | -------------------------------------------------------------------------------- /glut/menu-interface.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; menu.lisp --- CLOS interface to GLUT Menu Management API. 4 | ;;; 5 | ;;; Copyright (c) 2019, Bart Botta <00003b@gmail.com> 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;; (instance menu-name) -> id. EQL hash, so store cons in window 36 | ;; (defvar *menus* (make-hash-table)) 37 | ;; id -> (instance menu-name) 38 | (defvar *id->menu* (make-hash-table)) 39 | ;; used while building submenus 40 | (defvar *sub-menus*) 41 | 42 | ;; user callback to handle menu clicks 43 | ;;; 'menu' is name of mouse button, or keyword naming a submenu 44 | (defgeneric menu (window menu item)) 45 | 46 | (defun id->menu-item (window menu-name item-id) 47 | (let* ((m (gethash menu-name (%menu-ids window))) 48 | (id->item (second m))) 49 | (gethash item-id id->item))) 50 | 51 | (defcallback menu-callback :void ((item-id :int)) 52 | (let* ((menu-id (get-menu)) 53 | (menu (gethash menu-id *id->menu*)) 54 | (window-id (get-window)) 55 | (window (aref *id->window* window-id)) 56 | (button (cadr menu))) 57 | (assert menu) 58 | (assert (eql (car menu) window)) 59 | (with-simple-restart (continue "Skip processing this event") 60 | (menu window button (id->menu-item window (second menu) item-id))))) 61 | 62 | 63 | (defun canonicalize-menu-description (description) 64 | (loop 65 | for i in description 66 | collect (etypecase i 67 | ((cons (eql :menu)) 68 | (let* ((n (second i)) 69 | (sub 70 | (list* 71 | (first i) 72 | (etypecase n 73 | (cons n) 74 | (string 75 | (list n 76 | (intern (string-upcase n) 77 | (find-package :keyword)))) 78 | (symbol 79 | (list (substitute #\space #\- (symbol-name n)) n))) 80 | (canonicalize-menu-description (cddr i))))) 81 | sub)) 82 | (cons 83 | i) 84 | (string (list i (intern (string-upcase i) 85 | (find-package :keyword)))) 86 | (symbol (list (substitute #\space #\- (symbol-name i)) i))))) 87 | 88 | (defun ensure-menu-for-window (menu-name window items) 89 | (let* ((m (gethash menu-name (%menu-ids window)))) 90 | ;;; ideally this should be able to update menus in-place, but for 91 | ;;; now just requiring all changes to destroy and recreate all 92 | ;;; menus for window to change any of them 93 | (when m 94 | (error "can't modify menus yet")) 95 | (unless m 96 | (setf m (list (create-menu (callback menu-callback)) 97 | (make-hash-table) 98 | items)) 99 | (setf (gethash menu-name (%menu-ids window)) m) 100 | (setf (gethash (first m) *id->menu*) 101 | (list window menu-name))) 102 | (let ((menu-id (first m)) 103 | (item-hash (second m))) 104 | (set-menu menu-id) 105 | (loop for (text key . rest) in items 106 | do (cond 107 | ((eql text :menu) 108 | (ensure-menu-for-window (second key) window rest) 109 | (set-menu menu-id) 110 | (add-sub-menu (first key) 111 | (first (gethash (second key) 112 | (%menu-ids window))))) 113 | (t (let ((i (hash-table-count item-hash))) 114 | (setf (gethash i item-hash) key) 115 | (add-menu-entry text i)))))))) 116 | 117 | (defmethod create-window-menus ((window base-window)) 118 | (when (left-menu window) 119 | (ensure-menu-for-window :left-button window (left-menu window)) 120 | (set-window (id window)) 121 | (set-menu (first (gethash :left-button (%menu-ids window)))) 122 | (attach-menu :left-button)) 123 | (when (right-menu window) 124 | (ensure-menu-for-window :right-button window (right-menu window)) 125 | (set-window (id window)) 126 | (set-menu (first (gethash :right-button (%menu-ids window)))) 127 | (attach-menu :right-button)) 128 | (when (middle-menu window) 129 | (ensure-menu-for-window :middle-button window (middle-menu window)) 130 | (set-window (id window)) 131 | (set-menu (first (gethash :middle-button (%menu-ids window)))) 132 | (attach-menu :middle-button))) 133 | 134 | 135 | (defmethod destroy-window-menus ((window base-window)) 136 | (flet ((thunk () 137 | (with-window window 138 | (loop for k being the hash-keys of (%menu-ids window) 139 | using (hash-value (id)) 140 | do (remhash k (%menu-ids window)) 141 | (remhash id *id->menu*) 142 | ;; don't bother detaching menus if window was 143 | ;; destroyed already 144 | (when-current-window-exists 145 | (when (member k '(:left-button :right-button :middle-button)) 146 | (detach-menu k))) 147 | (destroy-menu id))))) 148 | (if *menu-active* 149 | (push #'thunk *deferred-menu-ops*) 150 | (thunk)))) 151 | 152 | (defmethod rebuild-window-menus ((window base-window) button) 153 | (destroy-window-menus window) 154 | (create-window-menus window)) 155 | 156 | (defmethod (setf left-menu) :around (new (window base-window)) 157 | (let ((old (left-menu window)) 158 | (new (canonicalize-menu-description new))) 159 | (setf (slot-value window 'left-menu) new) 160 | (when (and (slot-boundp window 'id) (id window)) 161 | (unless (tree-equal old new :test 'equal) 162 | (rebuild-window-menus window :left-button))) 163 | new)) 164 | 165 | (defmethod (setf right-menu) :around (new (window base-window)) 166 | (let ((old (right-menu window)) 167 | (new (canonicalize-menu-description new))) 168 | (setf (slot-value window 'right-menu) new) 169 | (when (and (slot-boundp window 'id) (id window)) 170 | (unless (tree-equal old new :test 'equal) 171 | (rebuild-window-menus window :right-button))) 172 | new)) 173 | 174 | (defmethod (setf middle-menu) :around (new (window base-window)) 175 | (let ((old (middle-menu window)) 176 | (new (canonicalize-menu-description new))) 177 | (setf (slot-value window 'middle-menu) new) 178 | (when (and (slot-boundp window 'id) (id window)) 179 | (unless (tree-equal old new :test 'equal) 180 | (rebuild-window-menus window :middle-button))) 181 | new)) 182 | -------------------------------------------------------------------------------- /glut/menu.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; menu.lisp --- GLUT Menu Management API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;;; TODO: high-level interface 36 | (defcfun ("glutCreateMenu" create-menu) :int 37 | (callback :pointer)) ; void (*callback)(int menu) 38 | 39 | (defcfun ("glutDestroyMenu" destroy-menu) :void 40 | (menu-id :int)) 41 | 42 | (defcfun ("glutGetMenu" get-menu) :int) 43 | 44 | (defcfun ("glutSetMenu" set-menu) :void 45 | (menu-id :int)) 46 | 47 | (defcfun ("glutAddMenuEntry" add-menu-entry) :void 48 | (label :string) 49 | (value :int)) 50 | 51 | (defcfun ("glutAddSubMenu" add-sub-menu) :void 52 | (label :string) 53 | (sub-menu-id :int)) 54 | 55 | (defcfun ("glutChangeToMenuEntry" change-to-menu-entry) :void 56 | (item :int) 57 | (label :string) 58 | (value :int)) 59 | 60 | (defcfun ("glutChangeToSubMenu" change-to-sub-menu) :void 61 | (item :int) 62 | (label :string) 63 | (value :int)) 64 | 65 | (defcfun ("glutRemoveMenuItem" remove-menu-item) :void 66 | (item :int)) 67 | 68 | (defcfun ("glutAttachMenu" attach-menu) :void 69 | (button mouse-button)) 70 | 71 | (defcfun ("glutDetachMenu" detach-menu) :void 72 | (button mouse-button)) 73 | 74 | (defvar *menu-active* nil) 75 | ;;; todo: handle more deferred menu ops, use atomic queue or something 76 | ;; currently we only defer destroy since that is somewhat easy to 77 | ;; trigger by closing a window with a menu open. We also push onto 78 | ;; this list and call them in list order, which would be wrong if 79 | ;; order matters (for example when destroying and rebuilding), and 80 | ;; might have problems with threads. 81 | (defvar *deferred-menu-ops* nil) 82 | 83 | (defcallback %menu-status-callback :void ((state menu-state) 84 | (x :int) (y :int)) 85 | (format t "menu status ~s~%" state) 86 | (setf *menu-active* (unless (eql state :menu-not-in-use) 87 | ;; might as well store something potentially 88 | ;; useful there for true 89 | (list x y))) 90 | (unless *menu-active* 91 | (loop while *deferred-menu-ops* 92 | do (funcall (pop *deferred-menu-ops*))))) 93 | 94 | #++ 95 | (defcallback %menu-state-callback :void ((state menu-state)) 96 | (setf *menu-active* (eql state :menu-in-use))) 97 | -------------------------------------------------------------------------------- /glut/misc.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; misc.lisp --- Misc functions from the GLUT API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;;; Color API 36 | 37 | (defcfun ("glutSetColor" set-color) :void 38 | (ndx :int) 39 | (red %gl:float) 40 | (green %gl:float) 41 | (blue %gl:float)) 42 | 43 | (defcenum color-component 44 | :red 45 | :green 46 | :blue) 47 | 48 | (defcfun ("glutGetColor" get-color) %gl:float 49 | (color :int) 50 | (component color-component)) 51 | 52 | (defcfun ("glutCopyColormap" copy-colormap) :void 53 | (window-id :int)) 54 | 55 | ;;; Misc keyboard and joystick functions. 56 | 57 | (defcfun ("glutIgnoreKeyRepeat" ignore-key-repeat) :void 58 | (ignore :int)) 59 | 60 | (defcenum key-repeat-mode 61 | :key-repeat-off 62 | :key-repeat-on 63 | :key-repeat-default) 64 | 65 | (defcfun ("glutSetKeyRepeat" set-key-repeat) :void 66 | (repeat-mode key-repeat-mode)) 67 | 68 | (defcfun ("glutForceJoystickFunc" force-joystick-func) :void) 69 | (defcfun ("glutReportErrors" report-errors) :void) 70 | 71 | ;;; Game Mode API 72 | 73 | (defcfun ("glutGameModeString" game-mode-string) :void 74 | (string :string)) 75 | 76 | (defcfun ("glutEnterGameMode" enter-game-mode) #-darwin :int #+darwin :void) 77 | (defcfun ("glutLeaveGameMode" leave-game-mode) :void) 78 | 79 | (defcenum (game-mode-param %gl:enum) 80 | :game-mode-active 81 | :game-mode-possible 82 | :game-mode-width 83 | :game-mode-height 84 | :game-mode-pixel-depth 85 | :game-mode-refresh-rate 86 | :game-mode-display-changed) 87 | 88 | (defcfun ("glutGameModeGet" game-mode-get) :int 89 | (query game-mode-param)) 90 | 91 | (defcfun ("glutGameModeGet" game-mode-getp) :boolean 92 | (query game-mode-param)) 93 | 94 | ;;; Video API 95 | 96 | ;;; freeglut doesn't implement any of these 97 | 98 | (defcenum (video-resize-param %gl:enum) 99 | (:video-resize-possible #x0384) 100 | :video-resize-in-use 101 | :video-resize-x-delta 102 | :video-resize-y-delta 103 | :video-resize-width-delta 104 | :video-resize-height-delta 105 | :video-resize-x 106 | :video-resize-y 107 | :video-resize-width 108 | :video-resize-height) 109 | 110 | (defcfun ("glutVideoResizeGet" video-resize-get) :int 111 | (query video-resize-param)) 112 | 113 | (defcfun ("glutVideoResizeGet" video-resize-getp) :boolean 114 | (query video-resize-param)) 115 | 116 | (defcfun ("glutSetupVideoResizing" setup-video-resizing) :void) 117 | (defcfun ("glutStopVideoResizing" stop-video-resizing) :void) 118 | 119 | (defcfun ("glutVideoResize" video-resize) :void 120 | (x :int) 121 | (y :int) 122 | (width :int) 123 | (height :int)) 124 | 125 | (defcfun ("glutVideoPan" video-pan) :void 126 | (x :int) 127 | (y :int) 128 | (width :int) 129 | (height :int)) -------------------------------------------------------------------------------- /glut/overlay.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; overlay.lisp --- GLUT Overlay Management API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | (defcfun ("glutEstablishOverlay" establish-overlay) :void) 36 | (defcfun ("glutRemoveOverlay" remove-overlay) :void) 37 | 38 | (defcenum (layer-type %gl:enum) 39 | :normal 40 | :overlay) 41 | 42 | (defcfun ("glutUseLayer" use-layer) :void 43 | (layer layer-type)) 44 | 45 | (defcfun ("glutPostOverlayRedisplay" post-overlay-redisplay) :void) 46 | 47 | (defcfun ("glutPostWindowOverlayRedisplay" post-window-overlay-redisplay) :void 48 | (window-id :int)) 49 | 50 | (defcfun ("glutShowOverlay" show-overlay) :void) 51 | (defcfun ("glutHideOverlay" hide-overlay) :void) -------------------------------------------------------------------------------- /glut/window.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- 2 | ;;; 3 | ;;; window.lisp --- GLUT window management API. 4 | ;;; 5 | ;;; Copyright (c) 2006, Luis Oliveira 6 | ;;; All rights reserved. 7 | ;;; 8 | ;;; Redistribution and use in source and binary forms, with or without 9 | ;;; modification, are permitted provided that the following conditions 10 | ;;; are met: 11 | ;;; 12 | ;;; o Redistributions of source code must retain the above copyright 13 | ;;; notice, this list of conditions and the following disclaimer. 14 | ;;; o Redistributions in binary form must reproduce the above copyright 15 | ;;; notice, this list of conditions and the following disclaimer in the 16 | ;;; documentation and/or other materials provided with the distribution. 17 | ;;; o Neither the name of the author nor the names of the contributors may 18 | ;;; be used to endorse or promote products derived from this software 19 | ;;; without specific prior written permission. 20 | ;;; 21 | ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 | ;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 | ;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24 | ;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25 | ;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26 | ;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 27 | ;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 28 | ;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 29 | ;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 30 | ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 31 | ;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32 | 33 | (in-package #:cl-glut) 34 | 35 | ;;; TODO: make sure if it's safe to free the window title 36 | ;;; right after calling glutCreateWindow(). 37 | (defcfun ("glutCreateWindow" create-window) :int 38 | (title :string)) 39 | 40 | (defcfun ("glutCreateSubWindow" create-sub-window) :int 41 | (window-id :int) 42 | (x :int) 43 | (y :int) 44 | (width :int) 45 | (height :int)) 46 | 47 | (defcfun ("glutDestroyWindow" destroy-window) :void 48 | (window-id :int)) 49 | 50 | (defcfun ("glutSetWindow" set-window) :void 51 | (window-id :int)) 52 | 53 | (defcfun ("glutGetWindow" get-window) :int) 54 | 55 | ;;; Do we need to be paranoid here too? See create-window. 56 | (defcfun ("glutSetWindowTitle" set-window-title) :void 57 | (string :string)) 58 | 59 | (defcfun ("glutSetIconTitle" set-icon-title) :void 60 | (string :string)) 61 | 62 | (defcfun ("glutReshapeWindow" reshape-window) :void 63 | (width :int) 64 | (height :int)) 65 | 66 | (defcfun ("glutPositionWindow" position-window) :void 67 | (x :int) 68 | (y :int)) 69 | 70 | (defcfun ("glutShowWindow" show-window) :void) 71 | (defcfun ("glutHideWindow" hide-window) :void) 72 | (defcfun ("glutIconifyWindow" iconify-window) :void) 73 | (defcfun ("glutPushWindow" push-window) :void) 74 | (defcfun ("glutPopWindow" pop-window) :void) 75 | (defcfun ("glutFullScreen" full-screen) :void) 76 | 77 | (defcfun ("glutPostWindowRedisplay" post-window-redisplay) :void 78 | (window-id :int)) 79 | 80 | (defcfun ("glutPostRedisplay" post-redisplay) :void) 81 | (defcfun ("glutSwapBuffers" swap-buffers) :void) 82 | 83 | ;; freeglut ext? 84 | (defcfun ("glutWarpPointer" warp-pointer) :void 85 | (x :int) 86 | (y :int)) 87 | 88 | (defcenum cursor 89 | :cursor-right-arrow 90 | :cursor-left-arrow 91 | :cursor-info 92 | :cursor-destroy 93 | :cursor-help 94 | :cursor-cycle 95 | :cursor-spray 96 | :cursor-wait 97 | :cursor-text 98 | :cursor-crosshair 99 | :cursor-up-down 100 | :cursor-left-right 101 | :cursor-top-side 102 | :cursor-bottom-side 103 | :cursor-left-side 104 | :cursor-right-side 105 | :cursor-top-left-corner 106 | :cursor-top-right-corner 107 | :cursor-bottom-right-corner 108 | :cursor-bottom-left-corner 109 | (:cursor-inherit #x0064) 110 | :cursor-none 111 | :cursor-full-crosshair) 112 | 113 | (defcfun ("glutSetCursor" set-cursor) :void 114 | (cursor cursor)) -------------------------------------------------------------------------------- /tools/OSSCOPYRIGHT: -------------------------------------------------------------------------------- 1 | License Applicability. Except to the extent portions of this file are 2 | made subject to an alternative license as permitted in the SGI Free 3 | Software License B, Version 1.1 (the "License"), the contents of this 4 | file are subject only to the provisions of the License. You may not use 5 | this file except in compliance with the License. You may obtain a copy 6 | of the License at Silicon Graphics, Inc., attn: Legal Services, 1600 7 | Amphitheatre Parkway, Mountain View, CA 94043-1351, or at: 8 | 9 | http://oss.sgi.com/projects/FreeB 10 | 11 | Note that, as provided in the License, the Software is distributed on an 12 | "AS IS" basis, with ALL EXPRESS AND IMPLIED WARRANTIES AND CONDITIONS 13 | DISCLAIMED, INCLUDING, WITHOUT LIMITATION, ANY IMPLIED WARRANTIES AND 14 | CONDITIONS OF MERCHANTABILITY, SATISFACTORY QUALITY, FITNESS FOR A 15 | PARTICULAR PURPOSE, AND NON-INFRINGEMENT. 16 | 17 | Original Code. The Original Code is: OpenGL Sample Implementation, 18 | Version 1.2.1, released January 26, 2000, developed by Silicon Graphics, 19 | Inc. The Original Code is Copyright (c) 1991-2002 Silicon Graphics, Inc. 20 | Copyright in any portions created by third parties is as indicated 21 | elsewhere herein. All Rights Reserved. 22 | 23 | Additional Notice Provisions: This software was created using the 24 | OpenGL(R) version 1.2.1 Sample Implementation published by SGI, but has 25 | not been independently verified as being compliant with the OpenGL(R) 26 | version 1.2.1 Specification. 27 | -------------------------------------------------------------------------------- /tools/README.md: -------------------------------------------------------------------------------- 1 | To rebuild/update bindings: 2 | 3 | 0. Download updated .spec file (optional): 4 | In top-level cl-opengl dir 5 | `make specs` 6 | 7 | 1. Build bindings: 8 | In top-level cl-opengl dir 9 | `make bindings > /tmp/changed` 10 | 11 | 2. Look at `/tmp/changed` file / `git diff` and see if any names need edited. 12 | Mostly looking at function names or suspicious value changes in enums, 13 | or if any argument types changed in a way that needs manual adjustment. 14 | 15 | For example add `-` before `i64v` in 16 | ``` 17 | (defglextfun ("glGetQueryBufferObjecti64v" get-query-buffer-objecti64v) :void 18 | (id uint) 19 | (buffer uint) 20 | (pname enum) 21 | (offset intptr)) 22 | 23 | ``` 24 | 25 | Just edit the generated file (`gl/funcs-gl-glcore.lisp` etc.,) it 26 | will re-use previous contents on next run. 27 | 28 | Generally try to keep actual words delimited by `-` in function 29 | names, as well as separating type/argument count suffixes like 30 | `i64v` and extension suffixes `ARB`,`EXT`,etc. Look at existing 31 | functions and try to match them if possible. 32 | 33 | Also check for any new `duplicate enum` messages, and see 34 | `special-cases.lisp` for example of handling differences between 35 | GL and GLES. 36 | 37 | 3. If any names were hand-edited, run `make bindings` again to 38 | regenerate package definition to match. 39 | 40 | 4. Proofread new function names in `git diff` or `gitk` or whatever. 41 | 42 | -------------------------------------------------------------------------------- /tools/special-cases.lisp: -------------------------------------------------------------------------------- 1 | ;;; override values from gl.xml 2 | 3 | (:enum "enum" 4 | ;; gl and gles have different values for GL_ACTIVE_PROGRAM_EXT 5 | ;; so force the GL value (see below for ES value) 6 | (:active-program-ext #x8b8d)) 7 | 8 | (:enum "GetProgramPipelineExtPname" 9 | ;; gles version of EXT_separate_shader_objects 10 | ;; uses a different value for GL_ACTIVE_PROGRAM_EXT from normal GL, 11 | ;; so define a separate enum for that param 12 | (:active-program-ext #x8259) 13 | (:vertex-shader (:import "ShaderType")) 14 | (:fragment-shader (:import "ShaderType")) 15 | (:validate-status (:import "enum")) 16 | (:info-log-length (:import "enum"))) 17 | 18 | (:func "glGetProgramPipelineivEXT" 19 | "void" 20 | (:NAME "pipeline" :TYPE "GLuint") 21 | ;; one of the possible enums has different values in gl and gles, 22 | ;; so use a custom enum for it (see GetProgramPipelineExtPname above) 23 | (:NAME "pname" :TYPE "GetProgramPipelineExtPname") 24 | (:NAME "params" :TYPE "GLint *")) 25 | 26 | (:func "glUseProgramStages" 27 | "void" 28 | (:NAME "pipeline" :TYPE "GLuint") 29 | ;; spec.xml doesn't specify type 30 | (:NAME "stages" :TYPE "UseProgramStageMask") 31 | (:NAME "program" :TYPE "GLuint")) 32 | 33 | (:func "glUseProgramStagesEXT" 34 | "void" 35 | (:NAME "pipeline" :TYPE "GLuint") 36 | ;; spec.xml doesn't specify type 37 | (:NAME "stages" :TYPE "UseProgramStageMask") 38 | (:NAME "program" :TYPE "GLuint")) 39 | --------------------------------------------------------------------------------