packages feed

GLUT 2.1.2.2 → 2.7.0.16

raw patch · 239 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,65 @@+2.7.0.16+--------+* Relaxed upper version bounds for `random` and `bytestring`.++2.7.0.15+--------+* Fixed typo in documentation.+* Relaxed upper version bound for `StateVar`.++2.7.0.14+--------+* Relaxed upper version bound for `containers`.++2.7.0.13+--------+* Relaxed upper version bound for `OpenGLRaw`.++2.7.0.12+--------+* Mac OS X: Make it possible to link against freeglut.++2.7.0.11+--------+* Linux: Try to load versioned GLUT library, too, because the unversioned one is often in *-dev packages only.++2.7.0.10+--------+* Mac OS X: Search public frameworks first, then system frameworks.++2.7.0.9+--------+* The GLUT package compiles without any additional library/framework now.+* Windows: We search for a native freeglut DLL, a MinGW freeglut DLL and a classic GLUT DLL, in that order.++2.7.0.8+--------+* Relaxed upper version bound for `OpenGLRaw`.++2.7.0.7+-------+* Removed redundant constraints.++2.7.0.6+--------+* Relaxed upper version bound for `OpenGLRaw`.++2.7.0.5+--------+* Make things work with both old and new `OpenGLRaw`/`GLURaw` packages.+* Build all examples via cabal, no need for `make` anymore.++2.7.0.4+--------+* Relaxed upper version bound for `transformers`.++2.7.0.3+--------+* Relaxed upper version bound for OpenGLRaw.+* Added CHANGELOG.md to distribution.+* Minor build/testing tweaks.++2.7.0.2+--------+* Fixed typo in shader file extension.+* Relaxed bounds for OpenGL package.
− GLUT.buildinfo.in 
@@ -1,8 +0,0 @@--- @configure_input@--- System-dependent values used by Distribution.Simple.defaultUserHooks----buildable: @BUILD_PACKAGE_BOOL@-ghc-options: -DCALLCONV=@CALLCONV@-cc-options: -DCALLCONV=@CALLCONV@ @GLUT_CFLAGS@-ld-options: @GLUT_LIBS@-frameworks: @GLUT_FRAMEWORKS@
GLUT.cabal view
@@ -1,161 +1,920 @@-name:		GLUT-version:	2.1.2.2-license:	BSD3-license-file:	LICENSE-maintainer:	Sven Panne <sven.panne@aedion.de>-bug-reports:	mailto:hopengl@haskell.org-homepage:	http://www.haskell.org/HOpenGL/-category:	Graphics-synopsis:	A binding for the OpenGL Utility Toolkit-description:-	A Haskell binding for the OpenGL Utility Toolkit, a window-	system independent toolkit for writing OpenGL programs. For more-	information about the C library on which this binding is based,-	please see: <http://www.opengl.org/resources/libraries/glut/>.-build-type:     Configure-cabal-version:  >=1.2-extra-source-files:-	GLUT.buildinfo.in-	README-	aclocal.m4-	config.guess-	config.sub-	configure-	configure.ac-	examples/BOGLGP/Chapter01/OnYourOwn1.hs-	examples/BOGLGP/Chapter01/Simple.hs-	examples/BOGLGP/Chapter02/OnYourOwn1.hs-	examples/BOGLGP/Chapter02/OpenGLApplication.hs-	examples/BOGLGP/Chapter03/Lines.hs-	examples/BOGLGP/Chapter03/OnYourOwn1.hs-	examples/BOGLGP/Chapter03/Points.hs-	examples/BOGLGP/Chapter03/Polygons.hs-	examples/BOGLGP/Chapter03/TrianglesQuads.hs-	examples/Misc/ARBOcclude.hs-	examples/Misc/ExtractContours.hs-	examples/Misc/Gears.hs-	examples/Misc/Pitfall14.hs-	examples/Misc/Triangulate.hs-	examples/OrangeBook/3Dlabs-License.txt-	examples/OrangeBook/ogl2brick/Brick.frag-	examples/OrangeBook/ogl2brick/Brick.hs-	examples/OrangeBook/ogl2brick/Brick.vert-	examples/RedBook/00-README-	examples/RedBook/AAIndex.hs-	examples/RedBook/AARGB.hs-	examples/RedBook/AccAnti.hs-	examples/RedBook/AccPersp.hs-	examples/RedBook/Alpha.hs-	examples/RedBook/Alpha3D.hs-	examples/RedBook/BezCurve.hs-	examples/RedBook/BezMesh.hs-	examples/RedBook/BezSurf.hs-	examples/RedBook/BlendEqn.hs-	examples/RedBook/Checker.hs-	examples/RedBook/Clip.hs-	examples/RedBook/ColorMat.hs-	examples/RedBook/ColorMatrix.hs-	examples/RedBook/ColorTable.hs-	examples/RedBook/Combiner.hs-	examples/RedBook/Convolution.hs-	examples/RedBook/Cube.hs-	examples/RedBook/CubeMap.hs-	examples/RedBook/DList.hs-	examples/RedBook/DOF.hs-	examples/RedBook/Data/leeds.bin-	examples/RedBook/Double.hs-	examples/RedBook/DrawF.hs-	examples/RedBook/Feedback.hs-	examples/RedBook/Fog.hs-	examples/RedBook/FogCoord.hs-	examples/RedBook/FogIndex.hs-	examples/RedBook/Font.hs-	examples/RedBook/Hello.hs-	examples/RedBook/Histogram.hs-	examples/RedBook/Image.hs-	examples/RedBook/Light.hs-	examples/RedBook/Lines.hs-	examples/RedBook/MVArray.hs-	examples/RedBook/Material.hs-	examples/RedBook/Minmax.hs-	examples/RedBook/Mipmap.hs-	examples/RedBook/Model.hs-	examples/RedBook/MoveLight.hs-	examples/RedBook/MultiTex.hs-	examples/RedBook/Multisamp.hs-	examples/RedBook/PickDepth.hs-	examples/RedBook/PickSquare.hs-	examples/RedBook/Planet.hs-	examples/RedBook/PointP.hs-	examples/RedBook/PolyOff.hs-	examples/RedBook/Polys.hs-	examples/RedBook/Quadric.hs-	examples/RedBook/ReadImage.hs-	examples/RedBook/Robot.hs-	examples/RedBook/Scene.hs-	examples/RedBook/Select.hs-	examples/RedBook/ShadowMap.hs-	examples/RedBook/Smooth.hs-	examples/RedBook/Stencil.hs-	examples/RedBook/Stroke.hs-	examples/RedBook/SurfPoints.hs-	examples/RedBook/Surface.hs-	examples/RedBook/Teapots.hs-	examples/RedBook/Tess.hs-	examples/RedBook/TessWind.hs-	examples/RedBook/TexBind.hs-	examples/RedBook/TexGen.hs-	examples/RedBook/TexProx.hs-	examples/RedBook/TexSub.hs-	examples/RedBook/Texture3D.hs-	examples/RedBook/TextureSurf.hs-	examples/RedBook/Torus.hs-	examples/RedBook/Trim.hs-	examples/RedBook/UnProject.hs-	examples/RedBook/VArray.hs-	examples/RedBook/Wrap.hs-	include/HsGLUT.h.in-	include/HsGLUTConfig.h.in-	include/HsGLUTExt.h-	install-sh-extra-tmp-files:-	config.log config.status autom4te.cache-	GLUT.buildinfo include/HsGLUTConfig.h include/HsGLUT.h--flag split-base--library-  exposed-modules:-        Graphics.UI.GLUT,-        Graphics.UI.GLUT.Begin,-        Graphics.UI.GLUT.Callbacks,-        Graphics.UI.GLUT.Callbacks.Global,-        Graphics.UI.GLUT.Callbacks.Window,-        Graphics.UI.GLUT.Colormap,-        Graphics.UI.GLUT.Debugging,-        Graphics.UI.GLUT.DeviceControl,-        Graphics.UI.GLUT.Fonts,-        Graphics.UI.GLUT.GameMode,-        Graphics.UI.GLUT.Initialization,-        Graphics.UI.GLUT.Menu,-        Graphics.UI.GLUT.Objects,-        Graphics.UI.GLUT.Overlay,-        Graphics.UI.GLUT.State,-        Graphics.UI.GLUT.Window-  other-modules:-        Graphics.UI.GLUT.Callbacks.Registration,-        Graphics.UI.GLUT.Constants,-        Graphics.UI.GLUT.Extensions,-        Graphics.UI.GLUT.QueryUtils,-        Graphics.UI.GLUT.Types-  include-dirs:	include-  includes: HsGLUT.h-  install-includes: HsGLUT.h-  c-sources:	cbits/HsGLUT.c-  if flag(split-base)-    build-depends:	base >= 3 && <5, array, containers-  else-    build-depends:	base < 3-  build-depends: OpenGL >= 2.2-  extensions:	CPP, ForeignFunctionInterface-  extra-libraries: glut+name: GLUT+version: 2.7.0.16+synopsis: A binding for the OpenGL Utility Toolkit+description:+  A Haskell binding for the OpenGL Utility Toolkit, a window system independent+  toolkit for writing OpenGL programs. For more information about the C library+  on which this binding is based, please see:+  <http://www.opengl.org/resources/libraries/glut/>.+homepage: http://www.haskell.org/haskellwiki/Opengl+bug-reports: https://github.com/haskell-opengl/GLUT/issues+copyright: Copyright (C) 2002-2018 Sven Panne+license: BSD3+license-file: LICENSE+author: Sven Panne+maintainer: Sven Panne <svenpanne@gmail.com>, Jason Dagit <dagitj@gmail.com>+category: Graphics+build-type: Simple+tested-with:+  GHC == 7.0.4+  GHC == 7.2.2+  GHC == 7.4.2+  GHC == 7.6.3+  GHC == 7.8.4+  GHC == 7.10.3+  GHC == 8.0.2+  GHC == 8.2.2+  GHC == 8.4.3+  GHC == 8.6.5+  GHC == 8.8.1+cabal-version: >= 1.10+extra-source-files:+   CHANGELOG.md+   README.md+   examples/00-README+   examples/BOGLGP/00-README+   examples/Misc/00-README+   examples/Misc/ColorTriangle/color_triangles.frag+   examples/Misc/ColorTriangle/color_triangles.vert+   examples/OrangeBook/00-README+   examples/OrangeBook/3Dlabs-License.txt+   examples/OrangeBook/ogl2brick/Brick.frag+   examples/OrangeBook/ogl2brick/Brick.vert+   examples/RedBook4/00-README+   examples/RedBook4/Data/leeds.bin+   examples/RedBook8/00-README+   examples/RedBook8/Chapter01/triangles.frag+   examples/RedBook8/Chapter01/triangles.vert++flag UseNativeWindowsLibraries+  description:+    When compiling under Windows, use the native libraries instead of e.g. the+    ones coming with Cygwin or MSYS.++flag BuildExamples+  description: Build various OpenGL/GLUT examples.+  default: False++library+  exposed-modules:+    Graphics.UI.GLUT+    Graphics.UI.GLUT.Begin+    Graphics.UI.GLUT.Callbacks+    Graphics.UI.GLUT.Callbacks.Global+    Graphics.UI.GLUT.Callbacks.Window+    Graphics.UI.GLUT.Colormap+    Graphics.UI.GLUT.Debugging+    Graphics.UI.GLUT.DeviceControl+    Graphics.UI.GLUT.Fonts+    Graphics.UI.GLUT.GameMode+    Graphics.UI.GLUT.Initialization+    Graphics.UI.GLUT.Menu+    Graphics.UI.GLUT.Objects+    Graphics.UI.GLUT.Overlay+    Graphics.UI.GLUT.State+    Graphics.UI.GLUT.Window+  other-modules:+    Graphics.UI.GLUT.Callbacks.Registration+    Graphics.UI.GLUT.QueryUtils+    Graphics.UI.GLUT.Raw+    Graphics.UI.GLUT.Raw.Callbacks+    Graphics.UI.GLUT.Raw.Fonts+    Graphics.UI.GLUT.Raw.Functions+    Graphics.UI.GLUT.Raw.Tokens+    Graphics.UI.GLUT.Types+  c-sources:+     cbits/HsGLUT.c+  hs-source-dirs: src+  build-depends:+    base         >= 3    && < 5,+    array        >= 0.3  && < 0.6,+    containers   >= 0.3  && < 0.7,+    transformers >= 0.2  && < 0.6,+    StateVar     >= 1.1  && < 1.3,+    OpenGL       >= 2.12 && < 3.1+  default-language: Haskell2010+  other-extensions: CPP+  ghc-options: -Wall+  if impl(ghc > 8)+    ghc-options: -Wcompat+  if os(windows) && flag(UseNativeWindowsLibraries)+    if arch(i386)+      cpp-options: "-DCALLCONV=stdcall"+    else+      cpp-options: "-DCALLCONV=ccall"+    cc-options: "-DUSE_GETPROCADDRESS"+  else+    cpp-options: "-DCALLCONV=ccall"+    cc-options: "-DUSE_DLSYM"++executable BOGLGP01-OnYourOwn1+  if !flag(BuildExamples)+    buildable: False+  main-is: OnYourOwn1.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter01+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP01-Simple+  if !flag(BuildExamples)+    buildable: False+  main-is: Simple.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter01+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP02-OnYourOwn1.hs+  if !flag(BuildExamples)+    buildable: False+  main-is: OnYourOwn1.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter02+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP02-OpenGLApplication.hs+  if !flag(BuildExamples)+    buildable: False+  main-is: OpenGLApplication.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter02+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP03-Lines+  if !flag(BuildExamples)+    buildable: False+  main-is: Lines.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter03+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP03-OnYourOwn1+  if !flag(BuildExamples)+    buildable: False+  main-is: OnYourOwn1.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter03+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP03-Points+  if !flag(BuildExamples)+    buildable: False+  main-is: Points.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter03+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP03-Polygons+  if !flag(BuildExamples)+    buildable: False+  main-is: Polygons.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter03+  default-language: Haskell2010+  ghc-options: -Wall++executable BOGLGP03-TrianglesQuads+  if !flag(BuildExamples)+    buildable: False+  main-is: TrianglesQuads.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/BOGLGP/Chapter03+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-ARBOcclude+  if !flag(BuildExamples)+    buildable: False+  main-is: ARBOcclude.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-ColorTriangle+  if !flag(BuildExamples)+    buildable: False+  main-is: ColorTriangle.hs+  other-modules: LoadShaders+  build-depends: base >= 3 && < 5, bytestring >= 0.9 && < 0.12, GLUT+  hs-source-dirs: examples/Misc/ColorTriangle, examples/RedBook8/common+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-ExtractContours+  if !flag(BuildExamples)+    buildable: False+  main-is: ExtractContours.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-Gears+  if !flag(BuildExamples)+    buildable: False+  main-is: Gears.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-Pitfall14+  if !flag(BuildExamples)+    buildable: False+  main-is: Pitfall14.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-SmoothOpenGL3+  if !flag(BuildExamples)+    buildable: False+  main-is: SmoothOpenGL3.hs+  build-depends: base >= 3 && < 5, bytestring >= 0.9 && < 0.12, OpenGLRaw >= 1.0 && < 3.4, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable Misc-Triangulate+  if !flag(BuildExamples)+    buildable: False+  main-is: Triangulate.hs+  build-depends: base >= 3 && < 5, random >= 1.0 && < 1.3, GLUT+  hs-source-dirs: examples/Misc+  default-language: Haskell2010+  ghc-options: -Wall++executable OrangeBook-Brick+  if !flag(BuildExamples)+    buildable: False+  main-is: Brick.hs+  build-depends: base >= 3 && < 5, bytestring >= 0.9 && < 0.12, GLUT+  hs-source-dirs: examples/OrangeBook/ogl2brick+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-AAIndex+  if !flag(BuildExamples)+    buildable: False+  main-is: AAIndex.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-AARGB+  if !flag(BuildExamples)+    buildable: False+  main-is: AARGB.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-AccAnti+  if !flag(BuildExamples)+    buildable: False+  main-is: AccAnti.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-AccPersp+  if !flag(BuildExamples)+    buildable: False+  main-is: AccPersp.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Alpha+  if !flag(BuildExamples)+    buildable: False+  main-is: Alpha.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Alpha3D+  if !flag(BuildExamples)+    buildable: False+  main-is: Alpha3D.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-BezCurve+  if !flag(BuildExamples)+    buildable: False+  main-is: BezCurve.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-BezMesh+  if !flag(BuildExamples)+    buildable: False+  main-is: BezMesh.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-BezSurf+  if !flag(BuildExamples)+    buildable: False+  main-is: BezSurf.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-BlendEqn+  if !flag(BuildExamples)+    buildable: False+  main-is: BlendEqn.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Checker+  if !flag(BuildExamples)+    buildable: False+  main-is: Checker.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Clip+  if !flag(BuildExamples)+    buildable: False+  main-is: Clip.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-ColorMat+  if !flag(BuildExamples)+    buildable: False+  main-is: ColorMat.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-ColorMatrix+  if !flag(BuildExamples)+    buildable: False+  main-is: ColorMatrix.hs+  other-modules: ReadImage+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-ColorTable+  if !flag(BuildExamples)+    buildable: False+  main-is: ColorTable.hs+  other-modules: ReadImage+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Combiner+  if !flag(BuildExamples)+    buildable: False+  main-is: Combiner.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Convolution+  if !flag(BuildExamples)+    buildable: False+  main-is: Convolution.hs+  other-modules: ReadImage+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Cube+  if !flag(BuildExamples)+    buildable: False+  main-is: Cube.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-CubeMap+  if !flag(BuildExamples)+    buildable: False+  main-is: CubeMap.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-DList+  if !flag(BuildExamples)+    buildable: False+  main-is: DList.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-DOF+  if !flag(BuildExamples)+    buildable: False+  main-is: DOF.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Double+  if !flag(BuildExamples)+    buildable: False+  main-is: Double.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-DrawF+  if !flag(BuildExamples)+    buildable: False+  main-is: DrawF.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Feedback+  if !flag(BuildExamples)+    buildable: False+  main-is: Feedback.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Fog+  if !flag(BuildExamples)+    buildable: False+  main-is: Fog.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-FogCoord+  if !flag(BuildExamples)+    buildable: False+  main-is: FogCoord.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-FogIndex+  if !flag(BuildExamples)+    buildable: False+  main-is: FogIndex.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Font+  if !flag(BuildExamples)+    buildable: False+  main-is: Font.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Hello+  if !flag(BuildExamples)+    buildable: False+  main-is: Hello.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Histogram+  if !flag(BuildExamples)+    buildable: False+  main-is: Histogram.hs+  other-modules: ReadImage+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Image+  if !flag(BuildExamples)+    buildable: False+  main-is: Image.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Light+  if !flag(BuildExamples)+    buildable: False+  main-is: Light.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Lines+  if !flag(BuildExamples)+    buildable: False+  main-is: Lines.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-MVArray+  if !flag(BuildExamples)+    buildable: False+  main-is: MVArray.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Material+  if !flag(BuildExamples)+    buildable: False+  main-is: Material.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Minmax+  if !flag(BuildExamples)+    buildable: False+  main-is: Minmax.hs+  other-modules: ReadImage+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Mipmap+  if !flag(BuildExamples)+    buildable: False+  main-is: Mipmap.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Model+  if !flag(BuildExamples)+    buildable: False+  main-is: Model.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-MoveLight+  if !flag(BuildExamples)+    buildable: False+  main-is: MoveLight.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-MultiTex+  if !flag(BuildExamples)+    buildable: False+  main-is: MultiTex.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Multisamp+  if !flag(BuildExamples)+    buildable: False+  main-is: Multisamp.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-PickDepth+  if !flag(BuildExamples)+    buildable: False+  main-is: PickDepth.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-PickSquare+  if !flag(BuildExamples)+    buildable: False+  main-is: PickSquare.hs+  build-depends: base >= 3 && < 5, array >= 0.1 && < 0.6, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Planet+  if !flag(BuildExamples)+    buildable: False+  main-is: Planet.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-PointP+  if !flag(BuildExamples)+    buildable: False+  main-is: PointP.hs+  build-depends: base >= 3 && < 5, random >= 1.0 && < 1.3, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-PolyOff+  if !flag(BuildExamples)+    buildable: False+  main-is: PolyOff.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Polys+  if !flag(BuildExamples)+    buildable: False+  main-is: Polys.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Quadric+  if !flag(BuildExamples)+    buildable: False+  main-is: Quadric.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Robot+  if !flag(BuildExamples)+    buildable: False+  main-is: Robot.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Scene+  if !flag(BuildExamples)+    buildable: False+  main-is: Scene.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Select+  if !flag(BuildExamples)+    buildable: False+  main-is: Select.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-ShadowMap+  if !flag(BuildExamples)+    buildable: False+  main-is: ShadowMap.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Smooth+  if !flag(BuildExamples)+    buildable: False+  main-is: Smooth.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Stencil+  if !flag(BuildExamples)+    buildable: False+  main-is: Stencil.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Stroke+  if !flag(BuildExamples)+    buildable: False+  main-is: Stroke.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-SurfPoints+  if !flag(BuildExamples)+    buildable: False+  main-is: SurfPoints.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Surface+  if !flag(BuildExamples)+    buildable: False+  main-is: Surface.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Teapots+  if !flag(BuildExamples)+    buildable: False+  main-is: Teapots.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Tess+  if !flag(BuildExamples)+    buildable: False+  main-is: Tess.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TessWind+  if !flag(BuildExamples)+    buildable: False+  main-is: TessWind.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TexBind+  if !flag(BuildExamples)+    buildable: False+  main-is: TexBind.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TexGen+  if !flag(BuildExamples)+    buildable: False+  main-is: TexGen.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TexProx+  if !flag(BuildExamples)+    buildable: False+  main-is: TexProx.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TexSub+  if !flag(BuildExamples)+    buildable: False+  main-is: TexSub.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Texture3D+  if !flag(BuildExamples)+    buildable: False+  main-is: Texture3D.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-TextureSurf+  if !flag(BuildExamples)+    buildable: False+  main-is: TextureSurf.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Torus+  if !flag(BuildExamples)+    buildable: False+  main-is: Torus.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Trim+  if !flag(BuildExamples)+    buildable: False+  main-is: Trim.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-UnProject+  if !flag(BuildExamples)+    buildable: False+  main-is: UnProject.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-VArray+  if !flag(BuildExamples)+    buildable: False+  main-is: VArray.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook4-Wrap+  if !flag(BuildExamples)+    buildable: False+  main-is: Wrap.hs+  build-depends: base >= 3 && < 5, GLUT+  hs-source-dirs: examples/RedBook4+  default-language: Haskell2010+  ghc-options: -Wall++executable RedBook8-Triangles+  if !flag(BuildExamples)+    buildable: False+  main-is: Triangles.hs+  other-modules: LoadShaders+  build-depends: base >= 3 && < 5, bytestring >= 0.9 && < 0.12, GLUT+  hs-source-dirs: examples/RedBook8/Chapter01, examples/RedBook8/common+  default-language: Haskell2010+  ghc-options: -Wall++source-repository head+  type: git+  location: https://github.com/haskell-opengl/GLUT.git
− Graphics/UI/GLUT.hs 
@@ -1,386 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Graphics.UI.GLUT--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ A Haskell binding for GLUT, the OpenGL Utility Toolkit, a window system--- independent toolkit for writing OpenGL programs. It includes support for--- the extended functionality available in freeglut (see--- <http://freeglut.sourceforge.net/>) and OpenGLUT (see--- <http://openglut.sourceforge.net/>), too.-----------------------------------------------------------------------------------module Graphics.UI.GLUT (-   -- * Legal stuff--   -- $LegalStuff--   -- * Introduction--   -- $Introduction--   -- ** Background--   -- $Background--   -- ** Design Philosophy--   -- $DesignPhilosophy--   -- ** API Versions--   -- $APIVersions--   -- ** Conventions--   -- $Conventions--   -- ** Terminology--   -- $Terminology--   module Graphics.Rendering.OpenGL,--   module Graphics.UI.GLUT.Initialization,-   module Graphics.UI.GLUT.Begin,-   module Graphics.UI.GLUT.Window,-   module Graphics.UI.GLUT.Overlay,-   module Graphics.UI.GLUT.Menu,-   module Graphics.UI.GLUT.Callbacks,-   module Graphics.UI.GLUT.Colormap,-   module Graphics.UI.GLUT.State,-   module Graphics.UI.GLUT.Fonts,-   module Graphics.UI.GLUT.Objects,-   module Graphics.UI.GLUT.Debugging,-   module Graphics.UI.GLUT.DeviceControl,-   module Graphics.UI.GLUT.GameMode-)  where--import Graphics.Rendering.OpenGL--import Graphics.UI.GLUT.Initialization-import Graphics.UI.GLUT.Begin-import Graphics.UI.GLUT.Window-import Graphics.UI.GLUT.Overlay-import Graphics.UI.GLUT.Menu-import Graphics.UI.GLUT.Callbacks-import Graphics.UI.GLUT.Colormap-import Graphics.UI.GLUT.State-import Graphics.UI.GLUT.Fonts-import Graphics.UI.GLUT.Objects-import Graphics.UI.GLUT.Debugging-import Graphics.UI.GLUT.DeviceControl-import Graphics.UI.GLUT.GameMode---------------------------------------------------------------------------------- $LegalStuff--- This documentation is heavily based on the man pages of Mark J. Kilgard\'s--- GLUT library.------ OpenGL is a trademark of Silicon Graphics, Inc.--- X Window System is a trademark of X Consortium, Inc.--- Spaceball is a registered trademark of Spatial Systems, Inc.------ The author has taken care in preparation of this documentation but makes--- no expressed or implied warranty of any kind and assumes no responsibility--- for errors or omissions. No liability is assumed for incidental or--- consequential damages in connection with or arising from the use of--- information or programs contained herein.---------------------------------------------------------------------------------- $Introduction--- The OpenGL Utility Toolkit (GLUT) is a programming interface for writing--- window system independent OpenGL programs. Currently there are--- implementations for the X Window System, the Windows family, OS\/2, and Mac.--- The toolkit supports the following functionality:------ * Multiple windows for OpenGL rendering.------ * Callback driven event processing.------ * Sophisticated input devices.------ * An /idle/ routine and timers.------ * A simple, cascading pop-up menu facility.------ * Utility routines to generate various solid and wire frame objects.------ * Support for bitmap and stroke fonts.------ * Miscellaneous window management functions, including managing overlays.------ This documentation serves as both a specification and a programming guide.--- If you are interested in a brief introduction to programming with GLUT,--- have a look at the relevant parts of <http://www.opengl.org/> and the vast--- amount of books on OpenGL, most of them use GLUT.------ The remainder of this section describes GLUT\'s design philosophy and--- usage model. The following sections specify the GLUT routines, grouped by--- functionality. The final sections discuss usage advice and the logical--- programmer visible state maintained by GLUT.---------------------------------------------------------------------------------- $Background--- One of the major accomplishments in the specification of OpenGL was--- the isolation of window system dependencies from OpenGL\'s rendering--- model. The result is that OpenGL is window system independent.------ Window system operations such as the creation of a rendering window and the--- handling of window system events are left to the native window system to--- define. Necessary interactions between OpenGL and the window system such as--- creating and binding an OpenGL context to a window are described separately--- from the OpenGL specification in a window system dependent specification. For--- example, the GLX specification describes the standard by which OpenGL--- interacts with the X Window System.------ The predecessor to OpenGL is IRIS GL. Unlike OpenGL, IRIS GL /does/--- specify how rendering windows are created and manipulated. IRIS GL\'s--- windowing interface is reasonably popular largely because it is simple to--- use. IRIS GL programmers can worry about graphics programming without needing--- to be an expert in programming the native window system. Experience also--- demonstrated that IRIS GL\'s windowing interface was high-level enough that--- it could be retargeted to different window systems. Silicon Graphics migrated--- from NeWS to the X Window System without any major changes to IRIS GL\'s--- basic windowing interface.------ Removing window system operations from OpenGL is a sound decision because it--- allows the OpenGL graphics system to be retargeted to various systems--- including powerful but expensive graphics workstations as well as--- mass-production graphics systems like video games, set-top boxes for--- interactive television, and PCs.------ Unfortunately, the lack of a window system interface for OpenGL is a gap in--- OpenGL\'s utility. Learning native window system APIs such as the X Window--- System\'s Xlib or Motif can be daunting. Even those familiar with--- native window system APIs need to understand the interface that binds OpenGL--- to the native window system. And when an OpenGL program is written using the--- native window system interface, despite the portability of the program\'s--- OpenGL rendering code, the program itself will be window system dependent.------ Testing and documenting OpenGL\'s functionality lead to the development of--- the @tk@ and @aux@ toolkits. The @aux@ toolkit is used in the examples found--- in the /OpenGL Programming Guide/. Unfortunately, @aux@ has numerous--- limitations and its utility is largely limited to toy programs. The @tk@--- library has more functionality than @aux@ but was developed in an /ad hoc/--- fashion and still lacks much important functionality that IRIS GL programmers--- expect, like pop-up menus and overlays.------ GLUT is designed to fill the need for a window system independent programming--- interface for OpenGL programs. The interface is designed to be simple yet--- still meet the needs of useful OpenGL programs. Features from the IRIS GL,--- @aux@, and @tk@ interfaces are included to make it easy for programmers used--- to these interfaces to develop programs for GLUT.---------------------------------------------------------------------------------- $DesignPhilosophy--- GLUT simplifies the implementation of programs using OpenGL rendering. The--- GLUT application programming interface (API) requires very few routines to--- display a graphics scene rendered using OpenGL. The GLUT API (like the OpenGL--- API) is stateful. Most initial GLUT state is defined and the initial state is--- reasonable for simple programs. The GLUT routines also take relatively few--- parameters.------ The GLUT API is (as much as reasonable) window system independent. For this--- reason, GLUT does not return /any/ native window system handles, pointers, or--- other data structures. More subtle window system dependencies such as--- reliance on window system dependent fonts are avoided by GLUT; instead, GLUT--- supplies its own (limited) set of fonts.------ For programming ease, GLUT provides a simple menu sub-API. While the menuing--- support is designed to be implemented as pop-up menus, GLUT gives window--- system leeway to support the menu functionality in another manner (pull-down--- menus for example).------ Two of the most important pieces of GLUT state are the /current window/ and--- /current menu/. Most window and menu routines affect the /current window/ or--- /menu/ respectively. Most callbacks implicitly set the /current window/ and--- /menu/ to the appropriate window or menu responsible for the callback. GLUT--- is designed so that a program with only a single window and\/or menu will not--- need to keep track of any window or menu identifiers. This greatly simplifies--- very simple GLUT programs.------ GLUT is designed for simple to moderately complex programs focused on OpenGL--- rendering. GLUT implements its own event loop. For this reason, mixing GLUT--- with other APIs that demand their own event handling structure may be--- difficult. The advantage of a builtin event dispatch loop is simplicity.------ GLUT contains routines for rendering fonts and geometric objects, however--- GLUT makes no claims on the OpenGL display list name space. For this reason,--- none of the GLUT rendering routines use OpenGL display lists. It is up to the--- GLUT programmer to compile the output from GLUT rendering routines into--- display lists if this is desired.------ GLUT routines are logically organized into several sub-APIs according to--- their functionality. The sub-APIs are:------ * /Initialization:/ Command line processing, window system initialization,---   and initial window creation state are controlled by these routines.------ * /Beginning Event Processing:/ This routine enters GLUT\'s event processing---   loop. This routine never returns, and it continuously calls GLUT callbacks---   as necessary.------ * /Window Management:/ These routines create and control windows.------ * /Overlay Management:/ These routines establish and manage overlays for---   windows.------ * /Menu Management:/ These routines create and control pop-up menus.------ * /Callback Registration:/ These routines register callbacks to be called by---   the GLUT event processing loop.------ * /Color Index Colormap Management:/ These routines allow the manipulation---   of color index colormaps for windows.------ * /State Retrieval:/ These routines allows programs to retrieve state from---   GLUT.------ * /Font Rendering:/ These routines allow rendering of stroke and bitmap---   fonts.------ * /Geometric Shape Rendering:/ These routines allow the rendering of 3D---   geometric objects including spheres, cones, icosahedrons, and teapots.------ * /Debugging:/ This routine reports any pending GL errors.------ * /Device Control:/ These routines allow setting the key repeat and polling---   the joystick.------ * /Game Mode:/ These routines allow programs to enter\/leave a full-screen---   mode with specified properties.---- Note that the following item has been left out intentionally, its--- implementation is too SGI-specific:--- * /Video Resizing:/ These routines provide a means for doing swap or frame---   synchronous resizing\/panning of the area that is to be magnified (or---   passed through) to the output video resolution.---------------------------------------------------------------------------------- $APIVersions--- The GLUT API has undergone several revisions with increasing functionality.--- This Haskell binding provides access to everything in API version 4,--- although it is not yet officially finalized. Nevertheless, it provides very--- useful things like handling full-screen modes and special keys.---------------------------------------------------------------------------------- $Conventions--- GLUT window and screen coordinates are expressed in pixels. The upper--- left hand corner of the screen or a window is (0,0). X coordinates--- increase in a rightward direction; Y coordinates increase in a--- downward direction. Note: This is inconsistent with OpenGL\'s--- coordinate scheme that generally considers the lower left hand--- coordinate of a window to be at (0,0) but is consistent with most--- popular window systems.---------------------------------------------------------------------------------- $Terminology--- A number of terms are used in a GLUT-specific manner throughout this--- document. The GLUT meaning of these terms is independent of the window--- system GLUT is used with. Here are GLUT-specific meanings for the--- following GLUT-specific terms:------ * /Callback:/ A programmer specified routine that can be registered with---   GLUT to be called in response to a specific type of event. Also used to--- refer to a specific callback routine being called.------ * /Colormap:/ A mapping of pixel values to RGB color values. Used by color---   index windows.------ * /Dials and button box:/ A sophisticated input device consisting of a pad---   of buttons and an array of rotating dials, often used by computer-aided---   design programs.------ * /Display mode:/ A set of OpenGL frame buffer capabilities that can be---   attributed to a window.------ * /Idle:/ A state when no window system events are received for processing---   as callbacks and the idle callback, if one is registered, is called.------ * /Layer in use:/ Either the normal plane or overlay. This per-window state---   determines what frame buffer layer OpenGL commands affect.------ * /Menu entry:/ A menu item that the user can select to trigger the menu---   callback for the menu entry\'s value.------ * /Menu item:/ Either a menu entry or a sub-menu trigger.------ * /Modifiers:/ The Shift, Ctrl, and Alt keys that can be held down---   simultaneously with a key or mouse button being pressed or released.------ * /Multisampling:/ A technique for hardware antialiasing generally available---   only on expensive 3D graphics hardware. Each pixel is composed of a number---   of samples (each containing color and depth information). The samples are---   averaged to determine the displayed pixel color value. Multisampling is---   supported as an extension to OpenGL.------ * /Normal plane:/ The default frame buffer layer where GLUT window state---   resides; as opposed to the /overlay/.------ * /Overlay:/ A frame buffer layer that can be displayed preferentially to---   the /normal plane/ and supports transparency to display through to the---   /normal plane/. Overlays are useful for rubber-banding effects, text---   annotation, and other operations, to avoid damaging the normal plane frame---   buffer state. Overlays require hardware support not present on all systems.------ * /Pop:/ The act of forcing a window to the top of the stacking order for---   sibling windows.------ * /Pop-up menu:/ A menu that can be set to appear when a specified mouse---   button is pressed in a window. A pop-menu consists of multiple menu items.------ * /Push:/ The act of forcing a window to the bottom of the stacking order---   for sibling windows.------ * /Reshape:/ The act of changing the size or shape of the window.------ * /Spaceball:/ A sophisticated 3D input device that provides six degrees of---   freedom, three axes of rotation and three axes of translation. It also---   supports a number of buttons. The device is a hand-sized ball attached to---   a base. By cupping the ball with one\'s hand and applying torsional or---   directional force on the ball, rotations and translationsare generated.------ * /Stereo:/ A frame buffer capability providing left and right color buffers---   for creating stereoscopic renderings. Typically, the user wears LCD---   shuttered goggles synchronized with the alternating display on the screen---   of the left and right color buffers.------ * /Sub-menu:/ A menu cascaded from some sub-menu trigger.------ * /Sub-menu trigger:/ A menu item that the user can enter to cascade another---   pop-up menu.------ * /Subwindow:/ A type of window that is the child window of a top-level---   window or other subwindow. The drawing and visible region of a subwindow---   is limited by its parent window.------ * /Tablet:/ A precise 2D input device. Like a mouse, 2D coordinates are---   returned. The absolute position of the tablet \"puck\" on the tablet is---   returned. Tablets also support a number of buttons.------ * /Timer:/ A callback that can be scheduled to be called in a specified---   interval of time.------ * /Top-level window:/ A window that can be placed, moved, resized, etc.---   independently from other top-level windows by the user. Subwindows may---   reside within a top-level window.------ * /Window:/ A rectangular area for OpenGL rendering.------ * /Window display state:/ One of shown, hidden, or iconified. A shown window---   is potentially visible on the screen (it may be obscured by other windows---   and not actually visible). A hidden window will never be visible. An---   iconified window is not visible but could be made visible in response to---   some user action like clicking on the window\'s corresponding icon.------ * /Window system:/ A broad notion that refers to both the mechanism and---   policy of the window system. For example, in the X Window System both the---   window manager and the X server are integral to what GLUT considers the---   window system.
− Graphics/UI/GLUT/Begin.hs 
@@ -1,108 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Begin--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ After a GLUT program has done initial setup such as creating windows and--- menus, GLUT programs enter the GLUT event processing loop by calling--- 'mainLoop' or handle events iteratively with 'mainLoopEvent'.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Begin (-   -- * Handling events-   mainLoop, mainLoopEvent, leaveMainLoop,--   -- * Controlling the behaviour when windows are closed-   ActionOnWindowClose(..), actionOnWindowClose-) where--import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )-import Graphics.UI.GLUT.Constants (-   glut_ACTION_ON_WINDOW_CLOSE, glut_ACTION_EXIT,-   glut_ACTION_GLUTMAINLOOP_RETURNS, glut_ACTION_CONTINUE_EXECUTION )-import Graphics.UI.GLUT.QueryUtils ( simpleGet, glutSetOption )-import Graphics.UI.GLUT.Extensions------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- | Enter the GLUT event processing loop; it will call as necessary any--- callbacks that have been registered. This routine should be called at most--- once in a GLUT program.--foreign import CALLCONV safe "glutMainLoop" mainLoop :: IO ()-------------------------------------------------------------------------------------- | (/freeglut only/) Process one iteration's worth of events in its event loop.--- This allows the application to control its own event loop and still use the--- GLUT package.--mainLoopEvent :: IO ()-mainLoopEvent = glutMainLoopEvent--EXTENSION_ENTRY(safe,"freeglut",glutMainLoopEvent,IO ())-------------------------------------------------------------------------------------- | (/freeglut only/) Stop the event loop. If 'actionOnWindowClose' contains--- 'Exit', the application will exit; otherwise control will return to the--- function which called 'mainLoop'.------ If the application has two nested calls to 'mainLoop' and calls--- 'leaveMainLoop', the behaviour is undefined. It may leave only the inner--- nested loop or it may leave both loops. If the reader has a strong preference--- for one behaviour over the other he should contact the freeglut Programming--- Consortium and ask for the code to be fixed.--leaveMainLoop :: IO ()-leaveMainLoop = glutLeaveMainLoop--EXTENSION_ENTRY(safe,"freeglut",glutLeaveMainLoop,IO ())-------------------------------------------------------------------------------------- | The behaviour when the user closes a window.--data ActionOnWindowClose-   = -- | Exit the whole program when any window is closed or 'leaveMainLoop'-     -- is called (default).-     Exit-   | -- | Return from mainLoop when any window is closed.-     MainLoopReturns-   | -- | Return from mainLoop after the last window is closed.-     ContinueExectuion-   deriving ( Eq, Ord, Show )--marshalActionOnWindowClose :: ActionOnWindowClose -> CInt-marshalActionOnWindowClose x = case x of-   Exit ->  glut_ACTION_EXIT-   MainLoopReturns -> glut_ACTION_GLUTMAINLOOP_RETURNS-   ContinueExectuion -> glut_ACTION_CONTINUE_EXECUTION--unmarshalActionOnWindowClose :: CInt -> ActionOnWindowClose-unmarshalActionOnWindowClose x-   | x == glut_ACTION_EXIT = Exit-   | x == glut_ACTION_GLUTMAINLOOP_RETURNS = MainLoopReturns-   | x == glut_ACTION_CONTINUE_EXECUTION = ContinueExectuion-   | otherwise = error ("unmarshalActionOnWindowClose: illegal value " ++ show x)----------------------------------------------------------------------------------- | (/freeglut only/) Controls the behaviour when the user closes a window.--actionOnWindowClose :: StateVar ActionOnWindowClose-actionOnWindowClose =-   makeStateVar-      (simpleGet unmarshalActionOnWindowClose glut_ACTION_ON_WINDOW_CLOSE)-      (glutSetOption glut_ACTION_ON_WINDOW_CLOSE . marshalActionOnWindowClose)
− Graphics/UI/GLUT/Callbacks.hs 
@@ -1,47 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Callbacks--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable--------- GLUT supports a number of callbacks to respond to events. There are three--- types of callbacks: window, menu, and global. Window callbacks indicate when--- to redisplay or reshape a window, when the visibility of the window changes,--- and when input is available for the window. Menu callbacks are described in--- "Graphics.UI.GLUT.Menu". The global callbacks manage the passing of time and--- menu usage. The calling order of callbacks between different windows is--- undefined.------ Callbacks for input events should be delivered to the window the event occurs--- in. Events should not propagate to parent windows.------ A callback of type @Foo@ can registered by setting @fooCallback@ to 'Just'--- the callback. Almost all callbacks can be de-registered by setting--- the corresponding @fooCallback@ to 'Nothing', the only exceptions being--- 'Graphics.UI.GLUT.Callbacks.Window.DisplayCallback' (can only be--- re-registered) and 'Graphics.UI.GLUT.Callbacks.Global.TimerCallback' (can\'t--- be unregistered).------ /X Implementation Notes:/ The X GLUT implementation uses the X Input--- extension to support sophisticated input devices: Spaceball, dial & button--- box, and digitizing tablet. Because the X Input extension  does not mandate--- how particular types of devices are advertised through the extension, it is--- possible GLUT for X may not correctly support input devices that would--- otherwise be of the correct type. The X GLUT implementation will support the--- Silicon Graphics Spaceball, dial & button box, and digitizing tablet as--- advertised through the X Input extension.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Callbacks (-   module Graphics.UI.GLUT.Callbacks.Window,-   module Graphics.UI.GLUT.Callbacks.Global-) where--import Graphics.UI.GLUT.Callbacks.Window-import Graphics.UI.GLUT.Callbacks.Global
− Graphics/UI/GLUT/Callbacks/Global.hs 
@@ -1,138 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Callbacks.Global--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Callbacks.Global (-   -- * Menu status callback-   MenuUsage(..), MenuStatusCallback, menuStatusCallback,--   -- * Idle callback-   IdleCallback, idleCallback,--   -- * Timer callbacks-   Timeout, TimerCallback, addTimerCallback-) where--import Control.Monad.Fix ( MonadFix(..) )-import Foreign.C.Types ( CInt, CUInt )-import Foreign.Ptr ( FunPtr )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   SettableStateVar, makeSettableStateVar )-import Graphics.UI.GLUT.Constants ( glut_MENU_NOT_IN_USE, glut_MENU_IN_USE )-import Graphics.UI.GLUT.Callbacks.Registration (-   CallbackType(..), setCallback, registerForCleanup )------------------------------------------------------------------------------------data MenuUsage-   = NotInUse-   | InUse-   deriving ( Eq, Ord, Show )--unmarshalMenuUsage :: CInt -> MenuUsage-unmarshalMenuUsage x-   | x == glut_MENU_NOT_IN_USE = NotInUse-   | x == glut_MENU_IN_USE = InUse-   | otherwise = error ("unmarshalMenuUsage: illegal value " ++ show x)--type MenuStatusCallback  = MenuUsage -> Position -> IO ()--type MenuStatusCallback' = CInt -> CInt -> CInt -> IO ()---- | Controls the global menu status callback so a GLUT program can determine--- when a menu is in use or not. When a menu status callback is registered, it--- will be called with the value 'InUse' when pop-up menus are in use by the--- user; and the callback will be called with the value 'NotInUse' when pop-up--- menus are no longer in use. Additionally, the location in window coordinates--- of the button press that caused the menu to go into use, or the location where--- the menu was released (maybe outside the window). Other callbacks continue to--- operate (except mouse motion callbacks) when pop-up menus are in use so the--- menu status callback allows a program to suspend animation or other tasks--- when menus are in use. The cascading and unmapping of sub-menus from an--- initial pop-up menu does not generate menu status callbacks. There is a--- single menu status callback for GLUT.------ When the menu status callback is called, the /current menu/ will be set to--- the initial pop-up menu in both the 'InUse' and 'NotInUse' cases. The--- /current window/ will be set to the window from which the initial menu was--- popped up from, also in both cases.--menuStatusCallback :: SettableStateVar (Maybe MenuStatusCallback)-menuStatusCallback =-   makeSettableStateVar $-      setCallback MenuStatusCB glutMenuStatusFunc-                  (makeMenuStatusCallback . unmarshal)-   where unmarshal cb s x y =-            cb (unmarshalMenuUsage s)-               (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeMenuStatusCallback ::-   MenuStatusCallback' -> IO (FunPtr MenuStatusCallback')--foreign import CALLCONV unsafe "glutMenuStatusFunc" glutMenuStatusFunc ::-   FunPtr MenuStatusCallback' -> IO ()------------------------------------------------------------------------------------type IdleCallback = IO ()---- | Controls the global idle callback so a GLUT program can perform background--- processing tasks or continuous animation when window system events are not--- being received. If enabled, the idle callback is continuously called when--- events are not being received. The /current window/ and /current menu/ will--- not be changed before the idle callback. Programs with multiple windows--- and\/or menus should explicitly set the /current window/ and\/or /current--- menu/ and not rely on its current setting.------ The amount of computation and rendering done in an idle callback should be--- minimized to avoid affecting the program\'s interactive response. In general,--- not more than a single frame of rendering should be done in an idle callback.--idleCallback :: SettableStateVar (Maybe IdleCallback)-idleCallback =-   makeSettableStateVar $ setCallback IdleCB glutIdleFunc makeIdleCallback--foreign import ccall "wrapper" makeIdleCallback ::-   IdleCallback -> IO (FunPtr IdleCallback)--foreign import CALLCONV unsafe "glutIdleFunc" glutIdleFunc ::-   FunPtr IdleCallback -> IO ()-------------------------------------------------------------------------------------- | Timeout for the timer callback in milliseconds-type Timeout = Int--type TimerCallback  = IO ()--type TimerCallback' = CInt -> IO ()---- | Register a one-shot timer callback to be triggered after at least the given--- amount of time. Multiple timer callbacks at same or differing times may be--- registered simultaneously. There is no support for canceling a registered--- callback.------ The number of milliseconds is a lower bound on the time before the callback--- is generated. GLUT attempts to deliver the timer callback as soon as possible--- after the expiration of the callback\'s time interval.--addTimerCallback :: Timeout -> TimerCallback -> IO ()-addTimerCallback msecs timerCallback = do-   funPtr <- mfix (\self -> makeTimerCallback (\_ -> do registerForCleanup self-                                                        timerCallback))-   glutTimerFunc (fromIntegral msecs) funPtr 0--foreign import ccall "wrapper" makeTimerCallback ::-   TimerCallback' -> IO (FunPtr TimerCallback')--foreign import CALLCONV unsafe "glutTimerFunc" glutTimerFunc ::-   CUInt -> FunPtr TimerCallback' -> CInt -> IO ()
− Graphics/UI/GLUT/Callbacks/Registration.hs 
@@ -1,171 +0,0 @@-{-# OPTIONS_GHC -fno-cse #-}---- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Callbacks.Registration--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Callbacks.Registration (-   CallbackType(..), registerForCleanup, setCallback, getCurrentWindow-) where------------------------------------------------------------------------------------import Control.Monad ( when )-import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef )-import qualified Data.Map as Map ( empty, lookup, insert, delete )-import Data.Map ( Map )-import Foreign.C.Types ( CInt, CUInt )-import Foreign.Ptr ( FunPtr, nullFunPtr, freeHaskellFunPtr )-import System.IO.Unsafe ( unsafePerformIO )-import Graphics.Rendering.OpenGL.GL.StateVar ( HasGetter(get) )-import Graphics.UI.GLUT.Window ( Window, currentWindow )------------------------------------------------------------------------------------- No timer callback here, because they are one-shot and "self destroy"--data CallbackType-   = DisplayCB         | OverlayDisplayCB  | ReshapeCB-   | KeyboardCB        | KeyboardUpCB      | MouseCB-   | MotionCB          | PassiveMotionCB   | CrossingCB-   | VisibilityCB      | WindowStatusCB    | SpecialCB-   | SpecialUpCB       | SpaceballMotionCB | SpaceballRotateCB-   | SpaceballButtonCB | ButtonBoxCB       | DialsCB-   | TabletMotionCB    | TabletButtonCB    | JoystickCB-   | MenuStatusCB      | IdleCB-   | CloseCB   -- freeglut only-   | MouseWheelCB   -- freeglut only-   deriving ( Eq, Ord )--isGlobal :: CallbackType -> Bool-isGlobal MenuStatusCB = True-isGlobal IdleCB       = True-isGlobal _            = False------------------------------------------------------------------------------------- To uniquely identify a particular callback, the associated window is needed--- for window callbacks.--data CallbackID = CallbackID (Maybe Window) CallbackType-   deriving ( Eq, Ord )--getCallbackID :: CallbackType -> IO CallbackID-getCallbackID callbackType = do-   maybeWindow <- if isGlobal callbackType-                     then return Nothing-                     else fmap Just $ getCurrentWindow "getCallbackID"-   return $ CallbackID maybeWindow callbackType--getCurrentWindow :: String -> IO Window-getCurrentWindow func = do-   win <- get currentWindow-   maybe (error (func ++ ": no current window")) return win------------------------------------------------------------------------------------- This seems to be a common Haskell hack nowadays: A plain old global variable--- with an associated mutator. Perhaps some language/library support is needed?--{-# NOINLINE theCallbackTable #-}-theCallbackTable :: IORef (CallbackTable a)-theCallbackTable = unsafePerformIO (newIORef emptyCallbackTable)--getCallbackTable :: IO (CallbackTable a)-getCallbackTable = readIORef theCallbackTable--modifyCallbackTable :: (CallbackTable a -> CallbackTable a) -> IO ()-modifyCallbackTable = modifyIORef theCallbackTable------------------------------------------------------------------------------------type CallbackTable a = Map CallbackID (FunPtr a)--emptyCallbackTable :: CallbackTable a-emptyCallbackTable = Map.empty--lookupInCallbackTable :: CallbackID -> IO (Maybe (FunPtr a))-lookupInCallbackTable callbackID =-   fmap (Map.lookup callbackID) getCallbackTable--deleteFromCallbackTable :: CallbackID -> IO ()-deleteFromCallbackTable callbackID =-   modifyCallbackTable (Map.delete callbackID)--addToCallbackTable :: CallbackID -> FunPtr a -> IO ()-addToCallbackTable callbackID funPtr =-   modifyCallbackTable (Map.insert callbackID funPtr)------------------------------------------------------------------------------------- Another global mutable variable: The list of function pointers ready to be--- freed by freeHaskellFunPtr--{-# NOINLINE theCleanupList #-}-theCleanupList :: IORef [FunPtr a]-theCleanupList = unsafePerformIO (newIORef [])--getCleanupList :: IO [FunPtr a]-getCleanupList = readIORef theCleanupList--setCleanupList :: [FunPtr a] -> IO ()-setCleanupList = writeIORef theCleanupList------------------------------------------------------------------------------------- And yet another mutable (write-once) variable: A function pointer to a--- callback which frees all function pointers on the cleanup list.--{-# NOINLINE theScavenger #-}-theScavenger :: IORef (FunPtr TimerCallback)-theScavenger = unsafePerformIO (newIORef =<< makeTimerCallback (\_ -> do-   cleanupList <- getCleanupList-   mapM_ freeHaskellFunPtr cleanupList-   setCleanupList []))--getScavenger :: IO (FunPtr TimerCallback)-getScavenger = readIORef theScavenger---- More or less copied from Global.hs to avoid mutual dependencies--type TimerCallback = CInt -> IO ()--foreign import ccall "wrapper" makeTimerCallback ::-   TimerCallback -> IO (FunPtr TimerCallback)--foreign import CALLCONV unsafe "glutTimerFunc" glutTimerFunc ::-   CUInt -> FunPtr TimerCallback -> CInt -> IO ()------------------------------------------------------------------------------------- Here is the really cunning stuff: If an element is added to the cleanup list--- when it is empty, register an immediate callback at GLUT to free the list as--- soon as possible.--registerForCleanup :: FunPtr a -> IO ()-registerForCleanup funPtr = do-   oldCleanupList <- getCleanupList-   setCleanupList (funPtr : oldCleanupList)-   when (null oldCleanupList) $ do-        scavenger <- getScavenger-        glutTimerFunc 0 scavenger 0------------------------------------------------------------------------------------setCallback :: CallbackType -> (FunPtr a -> IO ()) -> (b -> IO (FunPtr a))-            -> Maybe b -> IO ()-setCallback callbackType registerAtGLUT makeCallback maybeCallback = do-   callbackID <- getCallbackID callbackType-   maybeOldFunPtr <- lookupInCallbackTable callbackID-   case maybeOldFunPtr of-      Nothing -> return ()-      Just oldFunPtr -> do registerForCleanup oldFunPtr-                           deleteFromCallbackTable callbackID-   case maybeCallback of-      Nothing -> registerAtGLUT nullFunPtr-      Just callback -> do newFunPtr <- makeCallback callback-                          addToCallbackTable callbackID newFunPtr-                          registerAtGLUT newFunPtr
− Graphics/UI/GLUT/Callbacks/Window.hs 
@@ -1,974 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Callbacks.Window--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Callbacks.Window (-   -- * Redisplay callbacks-   DisplayCallback, displayCallback, overlayDisplayCallback,--   -- * Reshape callback-   ReshapeCallback, reshapeCallback,--   -- * Callbacks for visibility changes-   Visibility(..), VisibilityCallback, visibilityCallback,-   WindowState(..), WindowStateCallback, windowStateCallback,--   -- * Window close callback-   CloseCallback, closeCallback,--   -- * Keyboard and mouse input callback-   Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..),-   KeyboardMouseCallback, keyboardMouseCallback,--   -- * Mouse wheel callback-   WheelNumber, WheelDirection, MouseWheelCallback, mouseWheelCallback,--   -- * Mouse movement callbacks-   MotionCallback, motionCallback, passiveMotionCallback,-   Crossing(..), CrossingCallback, crossingCallback,--   -- * Spaceball callback-   SpaceballMotion, SpaceballRotation, ButtonIndex, SpaceballInput(..),-   SpaceballCallback, spaceballCallback,--   -- * Dial & button box callback-   DialAndButtonBoxInput(..), DialIndex,-   DialAndButtonBoxCallback, dialAndButtonBoxCallback,--   -- * Tablet callback-   TabletPosition(..), TabletInput(..), TabletCallback, tabletCallback,--   -- * Joystick callback-   JoystickButtons(..), JoystickPosition(..),-   JoystickCallback, joystickCallback-) where--import Data.Bits ( Bits((.&.)) )-import Data.Char ( chr )-import Data.Maybe ( fromJust )-import Foreign.C.Types ( CInt, CUInt, CUChar )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   SettableStateVar, makeSettableStateVar )-import Graphics.UI.GLUT.Callbacks.Registration ( CallbackType(..), setCallback )-import Graphics.UI.GLUT.Constants (-   glut_NOT_VISIBLE, glut_VISIBLE,-   glut_HIDDEN, glut_FULLY_RETAINED, glut_PARTIALLY_RETAINED, glut_FULLY_COVERED,-   glut_KEY_F1, glut_KEY_F2, glut_KEY_F3, glut_KEY_F4, glut_KEY_F5, glut_KEY_F6,-   glut_KEY_F7, glut_KEY_F8, glut_KEY_F9, glut_KEY_F10, glut_KEY_F11,-   glut_KEY_F12, glut_KEY_LEFT, glut_KEY_UP, glut_KEY_RIGHT, glut_KEY_DOWN,-   glut_KEY_PAGE_UP, glut_KEY_PAGE_DOWN, glut_KEY_HOME, glut_KEY_END,-   glut_KEY_INSERT, glut_KEY_NUM_LOCK, glut_KEY_BEGIN, glut_KEY_DELETE,-   glut_DOWN, glut_UP,-   glut_ACTIVE_SHIFT, glut_ACTIVE_CTRL, glut_ACTIVE_ALT,-   glut_LEFT, glut_ENTERED,-   glut_JOYSTICK_BUTTON_A, glut_JOYSTICK_BUTTON_B,-   glut_JOYSTICK_BUTTON_C, glut_JOYSTICK_BUTTON_D )-import Graphics.UI.GLUT.State ( PollRate )-import Graphics.UI.GLUT.Types ( MouseButton(..), unmarshalMouseButton )-import Graphics.UI.GLUT.Extensions------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- | A display callback--type DisplayCallback = IO ()---- | Controls the display callback for the /current window./ When GLUT determines--- that the normal plane for the window needs to be redisplayed, the display--- callback for the window is called. Before the callback, the /current window/--- is set to the window needing to be redisplayed and (if no overlay display--- callback is registered) the /layer in use/ is set to the normal plane. The--- entire normal plane region should be redisplayed in response to the callback--- (this includes ancillary buffers if your program depends on their state).------ GLUT determines when the display callback should be triggered based on the--- window\'s redisplay state. The redisplay state for a window can be either set--- explicitly by calling 'Graphics.UI.GLUT.Window.postRedisplay' or implicitly--- as the result of window damage reported by the window system. Multiple posted--- redisplays for a window are coalesced by GLUT to minimize the number of--- display callbacks called.------ When an overlay is established for a window, but there is no overlay display--- callback registered, the display callback is used for redisplaying both the--- overlay and normal plane (that is, it will be called if either the redisplay--- state or overlay redisplay state is set). In this case, the /layer in use/ is--- not implicitly changed on entry to the display callback.------ See 'overlayDisplayCallback' to understand how distinct callbacks for the--- overlay and normal plane of a window may be established.------ When a window is created, no display callback exists for the window. It is--- the responsibility of the programmer to install a display callback for the--- window before the window is shown. A display callback must be registered for--- any window that is shown. If a window becomes displayed without a display--- callback being registered, a fatal error occurs. There is no way to--- \"deregister\" a display callback (though another callback routine can always--- be registered).------ Upon return from the display callback, the normal damaged state of the window--- (see 'Graphics.UI.GLUT.State.damaged') is cleared. If there is no overlay--- display callback registered the overlay damaged state of the window (see--- 'Graphics.UI.GLUT.State.damaged') is also cleared.--displayCallback :: SettableStateVar DisplayCallback-displayCallback = makeSettableStateVar $-   setCallback DisplayCB glutDisplayFunc makeDisplayCallback . Just--foreign import ccall "wrapper" makeDisplayCallback ::-   DisplayCallback -> IO (FunPtr DisplayCallback)--foreign import CALLCONV unsafe "glutDisplayFunc" glutDisplayFunc ::-   FunPtr DisplayCallback -> IO ()-------------------------------------------------------------------------------------- | Controls the overlay display callback for the /current window./ The overlay--- display callback is functionally the same as the window\'s display callback--- except that the overlay display callback is used to redisplay the window\'s--- overlay.------ When GLUT determines that the overlay plane for the window needs to be--- redisplayed, the overlay display callback for the window is called. Before--- the callback, the /current window/ is set to the window needing to be--- redisplayed and the /layer in use/ is set to the overlay. The entire overlay--- region should be redisplayed in response to the callback (this includes--- ancillary buffers if your program depends on their state).------ GLUT determines when the overlay display callback should be triggered based--- on the window\'s overlay redisplay state. The overlay redisplay state for a--- window can be either set explicitly by calling--- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' or implicitly as the result--- of window damage reported by the window system. Multiple posted overlay--- redisplays for a window are coalesced by GLUT to minimize the number of--- overlay display callbacks called.------ Upon return from the overlay display callback, the overlay damaged state of--- the window (see 'Graphics.UI.GLUT.State.damaged') is cleared.------ Initially there is no overlay display callback registered when an overlay is--- established. See 'displayCallback' to understand how the display callback--- alone is used if an overlay display callback is not registered.--overlayDisplayCallback :: SettableStateVar (Maybe DisplayCallback)-overlayDisplayCallback = makeSettableStateVar $-   setCallback OverlayDisplayCB glutOverlayDisplayFunc makeDisplayCallback--foreign import CALLCONV unsafe "glutOverlayDisplayFunc" glutOverlayDisplayFunc-   :: FunPtr DisplayCallback -> IO ()-------------------------------------------------------------------------------------- | A reshape callback--type ReshapeCallback = Size -> IO ()--type ReshapeCallback' = CInt -> CInt -> IO ()---- | Controls the reshape callback for the /current window./ The reshape callback--- is triggered when a window is reshaped. A reshape callback is also triggered--- immediately before a window\'s first display callback after a window is--- created or whenever an overlay for the window is established. The parameter--- of the callback specifies the new window size in pixels. Before the callback,--- the /current window/ is set to the window that has been reshaped.------ If a reshape callback is not registered for a window or 'reshapeCallback' is--- set to 'Nothing' (to deregister a previously registered callback), the--- default reshape callback is used. This default callback will simply call------ @--- 'Graphics.Rendering.OpenGL.GL.CoordTrans.viewport' ('Graphics.Rendering.OpenGL.GL.CoordTrans.Position' 0 0) ('Graphics.Rendering.OpenGL.GL.CoordTrans.Size' /width/ /height/)--- @------ on the normal plane (and on the overlay if one exists).------ If an overlay is established for the window, a single reshape callback is--- generated. It is the callback\'s responsibility to update both the normal--- plane and overlay for the window (changing the layer in use as necessary).------ When a top-level window is reshaped, subwindows are not reshaped. It is up to--- the GLUT program to manage the size and positions of subwindows within a--- top-level window. Still, reshape callbacks will be triggered for subwindows--- when their size is changed using 'Graphics.UI.GLUT.Window.windowSize'.--reshapeCallback :: SettableStateVar (Maybe ReshapeCallback)-reshapeCallback = makeSettableStateVar $-   setCallback ReshapeCB glutReshapeFunc (makeReshapeCallback . unmarshal)-   where unmarshal cb w h = cb (Size (fromIntegral w) (fromIntegral h))--foreign import ccall "wrapper" makeReshapeCallback ::-   ReshapeCallback' -> IO (FunPtr ReshapeCallback')--foreign import CALLCONV unsafe "glutReshapeFunc" glutReshapeFunc ::-   FunPtr ReshapeCallback' -> IO ()-------------------------------------------------------------------------------------- | The visibility state of the /current window/--data Visibility-   = NotVisible -- ^ No part of the /current window/ is visible, i.e., until the-                --   window\'s visibility changes, all further rendering to the-                --   window is discarded.-   | Visible    -- ^ The /current window/ is totally or partially visible. GLUT-                --   considers a window visible if any pixel of the window is-                --   visible or any pixel of any descendant window is visible on-                --   the screen.-   deriving ( Eq, Ord, Show )--unmarshalVisibility :: CInt -> Visibility-unmarshalVisibility x-   | x == glut_NOT_VISIBLE = NotVisible-   | x == glut_VISIBLE = Visible-   | otherwise = error ("unmarshalVisibility: illegal value " ++ show x)-------------------------------------------------------------------------------------- | A visibility callback--type VisibilityCallback = Visibility -> IO ()--type VisibilityCallback' = CInt -> IO ()---- | Controls the visibility callback for the /current window./ The visibility--- callback for a window is called when the visibility of a window changes.------ If the visibility callback for a window is disabled and later re-enabled, the--- visibility status of the window is undefined; any change in window visibility--- will be reported, that is if you disable a visibility callback and re-enable--- the callback, you are guaranteed the next visibility change will be reported.------ Note that you can either use 'visibilityCallback' or 'windowStateCallback',--- but not both, because the former is implemented via the latter.--visibilityCallback :: SettableStateVar (Maybe VisibilityCallback)-visibilityCallback = makeSettableStateVar $-   setCallback VisibilityCB glutVisibilityFunc-               (makeVisibilityCallback . unmarshal)-   where unmarshal cb  = cb . unmarshalVisibility--foreign import ccall "wrapper" makeVisibilityCallback ::-   VisibilityCallback' -> IO (FunPtr VisibilityCallback')--foreign import CALLCONV unsafe "glutVisibilityFunc" glutVisibilityFunc ::-   FunPtr VisibilityCallback' -> IO ()-------------------------------------------------------------------------------------- | The window state of the /current window/--data WindowState-   = Unmapped          -- ^ The /current window/ is unmapped.-   | FullyRetained     -- ^ The /current window/ is unobscured.-   | PartiallyRetained -- ^ The /current window/ is partially obscured.-   | FullyCovered      -- ^ The /current window/ is fully obscured.-   deriving ( Eq, Ord, Show )--unmarshalWindowState :: CInt -> WindowState-unmarshalWindowState x-   | x == glut_HIDDEN = Unmapped-   | x == glut_FULLY_RETAINED = FullyRetained-   | x == glut_PARTIALLY_RETAINED = PartiallyRetained-   | x == glut_FULLY_COVERED = FullyCovered-   | otherwise = error ("unmarshalWindowState: illegal value " ++ show x)-------------------------------------------------------------------------------------- | A window state callback--type WindowStateCallback = WindowState -> IO ()--type WindowStateCallback_ = CInt -> IO ()---- | (/freeglut only/) Controls the window state callback for the--- /current window./ The window state callback for a window is called when the--- window state of a window changes.------ If the window state callback for a window is disabled and later re-enabled,--- the window state state of the window is undefined; any change in the window--- state will be reported, that is if you disable a window state callback and--- re-enable the callback, you are guaranteed the next window state change will--- be reported.------ Note that you can either use 'visibilityCallback' or 'windowStateCallback',--- but not both, because the former is implemented via the latter.--windowStateCallback :: SettableStateVar (Maybe WindowStateCallback)-windowStateCallback = makeSettableStateVar $-   setCallback WindowStatusCB glutWindowStateFunc-               (makeWindowStateCallback . unmarshal)-   where unmarshal cb  = cb . unmarshalWindowState--foreign import ccall "wrapper" makeWindowStateCallback ::-   WindowStateCallback_ -> IO (FunPtr WindowStateCallback_)--EXTENSION_ENTRY(unsafe,"freeglut",glutWindowStateFunc,FunPtr WindowStateCallback_ -> IO ())------------------------------------------------------------------------------------type CloseCallback = IO ()--closeCallback :: SettableStateVar (Maybe CloseCallback)-closeCallback = makeSettableStateVar $-   setCallback CloseCB glutCloseFunc makeCloseCallback--foreign import ccall "wrapper"-   makeCloseCallback :: CloseCallback -> IO (FunPtr CloseCallback)--EXTENSION_ENTRY(unsafe,"freeglut",glutCloseFunc,FunPtr CloseCallback -> IO ())------------------------------------------------------------------------------------type KeyboardCallback = Char -> Position -> IO ()--type KeyboardCallback' = CUChar -> CInt -> CInt -> IO ()--setKeyboardCallback :: Maybe KeyboardCallback -> IO ()-setKeyboardCallback =-   setCallback KeyboardCB glutKeyboardFunc (makeKeyboardCallback . unmarshal)-   where unmarshal cb c x y = cb (chr (fromIntegral c))-                                 (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeKeyboardCallback ::-   KeyboardCallback' -> IO (FunPtr KeyboardCallback')--foreign import CALLCONV unsafe "glutKeyboardFunc" glutKeyboardFunc ::-   FunPtr KeyboardCallback' -> IO ()------------------------------------------------------------------------------------setKeyboardUpCallback :: Maybe KeyboardCallback -> IO ()-setKeyboardUpCallback =-   setCallback KeyboardUpCB glutKeyboardUpFunc-               (makeKeyboardCallback . unmarshal)-   where unmarshal cb c x y = cb (chr (fromIntegral c))-                                 (Position (fromIntegral x) (fromIntegral y))--foreign import CALLCONV unsafe "glutKeyboardUpFunc" glutKeyboardUpFunc ::-   FunPtr KeyboardCallback' -> IO ()-------------------------------------------------------------------------------------- | Special keys--data SpecialKey-   = KeyF1-   | KeyF2-   | KeyF3-   | KeyF4-   | KeyF5-   | KeyF6-   | KeyF7-   | KeyF8-   | KeyF9-   | KeyF10-   | KeyF11-   | KeyF12-   | KeyLeft-   | KeyUp-   | KeyRight-   | KeyDown-   | KeyPageUp-   | KeyPageDown-   | KeyHome-   | KeyEnd-   | KeyInsert-   | KeyNumLock-   | KeyBegin-   | KeyDelete-   deriving ( Eq, Ord, Show )--unmarshalSpecialKey :: CInt -> SpecialKey-unmarshalSpecialKey x-   | x == glut_KEY_F1 = KeyF1-   | x == glut_KEY_F2 = KeyF2-   | x == glut_KEY_F3 = KeyF3-   | x == glut_KEY_F4 = KeyF4-   | x == glut_KEY_F5 = KeyF5-   | x == glut_KEY_F6 = KeyF6-   | x == glut_KEY_F7 = KeyF7-   | x == glut_KEY_F8 = KeyF8-   | x == glut_KEY_F9 = KeyF9-   | x == glut_KEY_F10 = KeyF10-   | x == glut_KEY_F11 = KeyF11-   | x == glut_KEY_F12 = KeyF12-   | x == glut_KEY_LEFT = KeyLeft-   | x == glut_KEY_UP = KeyUp-   | x == glut_KEY_RIGHT = KeyRight-   | x == glut_KEY_DOWN = KeyDown-   | x == glut_KEY_PAGE_UP = KeyPageUp-   | x == glut_KEY_PAGE_DOWN = KeyPageDown-   | x == glut_KEY_HOME = KeyHome-   | x == glut_KEY_END = KeyEnd-   | x == glut_KEY_INSERT = KeyInsert-   | x == glut_KEY_NUM_LOCK = KeyNumLock-   | x == glut_KEY_BEGIN = KeyBegin-   | x == glut_KEY_DELETE = KeyDelete-   | otherwise = error ("unmarshalSpecialKey: illegal value " ++ show x)------------------------------------------------------------------------------------type SpecialCallback = SpecialKey -> Position -> IO ()--type SpecialCallback' = CInt -> CInt -> CInt -> IO ()--setSpecialCallback :: Maybe SpecialCallback -> IO ()-setSpecialCallback =-   setCallback SpecialCB glutSpecialFunc (makeSpecialCallback . unmarshal)-   where unmarshal cb k x y = cb (unmarshalSpecialKey k)-                                 (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeSpecialCallback ::-   SpecialCallback' -> IO (FunPtr SpecialCallback')--foreign import CALLCONV unsafe "glutSpecialFunc" glutSpecialFunc ::-   FunPtr SpecialCallback' -> IO ()------------------------------------------------------------------------------------setSpecialUpCallback :: Maybe SpecialCallback -> IO ()-setSpecialUpCallback =-   setCallback SpecialUpCB glutSpecialUpFunc (makeSpecialCallback . unmarshal)-   where unmarshal cb k x y = cb (unmarshalSpecialKey k)-                                 (Position (fromIntegral x) (fromIntegral y))--foreign import CALLCONV unsafe "glutSpecialUpFunc" glutSpecialUpFunc ::-   FunPtr SpecialCallback' -> IO ()-------------------------------------------------------------------------------------- | The current state of a key or button--data KeyState-   = Down-   | Up-   deriving ( Eq, Ord, Show )--unmarshalKeyState :: CInt -> KeyState-unmarshalKeyState x-   | x == glut_DOWN = Down-   | x == glut_UP = Up-   | otherwise = error ("unmarshalKeyState: illegal value " ++ show x)------------------------------------------------------------------------------------type MouseCallback = MouseButton -> KeyState -> Position -> IO ()--type MouseCallback' = CInt -> CInt -> CInt -> CInt -> IO ()--setMouseCallback :: Maybe MouseCallback -> IO ()-setMouseCallback =-   setCallback MouseCB glutMouseFunc (makeMouseCallback . unmarshal)-   where unmarshal cb b s x y = cb (unmarshalMouseButton b)-                                   (unmarshalKeyState s)-                                   (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeMouseCallback ::-   MouseCallback' -> IO (FunPtr MouseCallback')--foreign import CALLCONV unsafe "glutMouseFunc" glutMouseFunc ::-   FunPtr MouseCallback' -> IO ()-------------------------------------------------------------------------------------- | The state of the keyboard modifiers--data Modifiers = Modifiers { shift, ctrl, alt :: KeyState }-   deriving ( Eq, Ord, Show )---- Could use fromBitfield + Enum/Bounded instances + marshalModifier instead...-unmarshalModifiers :: CInt -> Modifiers-unmarshalModifiers m = Modifiers {-   shift = if (m .&. glut_ACTIVE_SHIFT) /= 0 then Down else Up,-   ctrl  = if (m .&. glut_ACTIVE_CTRL ) /= 0 then Down else Up,-   alt   = if (m .&. glut_ACTIVE_ALT  ) /= 0 then Down else Up }--getModifiers :: IO Modifiers-getModifiers = fmap unmarshalModifiers glutGetModifiers--foreign import CALLCONV unsafe "glutGetModifiers" glutGetModifiers :: IO CInt-------------------------------------------------------------------------------------- | A generalized view of keys--data Key-   = Char Char-   | SpecialKey SpecialKey-   | MouseButton MouseButton-   deriving ( Eq, Ord, Show )---- | A keyboard\/mouse callback--type KeyboardMouseCallback =-   Key -> KeyState -> Modifiers -> Position -> IO ()---- | Controls the keyboard\/mouse callback for the /current window./ The--- keyboard\/mouse callback for a window is called when the state of a key or--- mouse button changes. The callback parameters indicate the new state of the--- key\/button, the state of the keyboard modifiers, and the mouse location in--- window relative coordinates.--keyboardMouseCallback :: SettableStateVar (Maybe KeyboardMouseCallback)-keyboardMouseCallback = makeSettableStateVar setKeyboardMouseCallback--setKeyboardMouseCallback :: Maybe KeyboardMouseCallback -> IO ()-setKeyboardMouseCallback Nothing = do-   setKeyboardCallback   Nothing-   setKeyboardUpCallback Nothing-   setSpecialCallback    Nothing-   setSpecialUpCallback  Nothing-   setMouseCallback      Nothing-setKeyboardMouseCallback (Just cb) = do-   setKeyboardCallback   (Just (\c   p -> do m <- getModifiers-                                             cb (Char        c) Down m p))-   setKeyboardUpCallback (Just (\c   p -> do m <- getModifiers-                                             cb (Char        c) Up   m p))-   setSpecialCallback    (Just (\s   p -> do m <- getModifiers-                                             cb (SpecialKey  s) Down m p))-   setSpecialUpCallback  (Just (\s   p -> do m <- getModifiers-                                             cb (SpecialKey  s) Up   m p))-   setMouseCallback      (Just (\b s p -> do m <- getModifiers-                                             cb (MouseButton b) s    m p))------------------------------------------------------------------------------------type WheelNumber = Int--type WheelDirection = Int--type MouseWheelCallback = WheelNumber -> WheelDirection -> Position -> IO ()--type MouseWheelCallback_ = CInt -> CInt -> CInt -> CInt -> IO ()---- | (/freeglut only/) Controls the mouse wheel callback for the--- /current window./ The mouse wheel callback for a window is called when a--- mouse wheel is used and the wheel number is greater than or equal to--- 'Graphics.UI.GLUT.State.numMouseButtons'.--mouseWheelCallback :: SettableStateVar (Maybe MouseWheelCallback)-mouseWheelCallback = makeSettableStateVar $-   setCallback MouseWheelCB glutMouseWheelFunc (makeMouseWheelCallback . unmarshal)-   where unmarshal cb n d x y = cb (fromIntegral n) (fromIntegral d)-                                   (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeMouseWheelCallback ::-   MouseWheelCallback_ -> IO (FunPtr MouseWheelCallback_)--EXTENSION_ENTRY(unsafe,"freeglut",glutMouseWheelFunc,FunPtr MouseWheelCallback_ -> IO ())-------------------------------------------------------------------------------------- | A motion callback--type MotionCallback = Position -> IO ()--type MotionCallback' = CInt -> CInt -> IO ()---- | Controls the motion callback for the /current window./ The motion callback--- for a window is called when the mouse moves within the window while one or--- more mouse buttons are pressed. The callback parameter indicates the mouse--- location in window relative coordinates.--motionCallback :: SettableStateVar (Maybe MotionCallback)-motionCallback = makeSettableStateVar $-   setCallback MotionCB glutMotionFunc (makeMotionCallback . unmarshal)-   where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeMotionCallback ::-   MotionCallback' -> IO (FunPtr MotionCallback')--foreign import CALLCONV unsafe "glutMotionFunc" glutMotionFunc ::-   FunPtr MotionCallback' -> IO ()-------------------------------------------------------------------------------------- | Controls the passive motion callback for the /current window./ The passive--- motion callback for a window is called when the mouse moves within the window--- while /no/ mouse buttons are pressed. The callback parameter indicates the--- mouse location in window relative coordinates.--passiveMotionCallback :: SettableStateVar (Maybe MotionCallback)-passiveMotionCallback = makeSettableStateVar $-   setCallback PassiveMotionCB glutPassiveMotionFunc-               (makeMotionCallback . unmarshal)-   where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))--foreign import CALLCONV unsafe "glutPassiveMotionFunc" glutPassiveMotionFunc ::-   FunPtr MotionCallback' -> IO ()-------------------------------------------------------------------------------------- | The relation between the mouse pointer and the /current window/ has--- changed.--data Crossing-   = WindowLeft    -- ^ The mouse pointer has left the /current window./-   | WindowEntered -- ^ The mouse pointer has entered the /current window./-   deriving ( Eq, Ord, Show )--unmarshalCrossing :: CInt -> Crossing-unmarshalCrossing x-   | x == glut_LEFT = WindowLeft-   | x == glut_ENTERED = WindowEntered-   | otherwise = error ("unmarshalCrossing: illegal value " ++ show x)-------------------------------------------------------------------------------------- | An enter\/leave callback--type CrossingCallback = Crossing -> IO ()--type CrossingCallback' = CInt -> IO ()---- | Controls the mouse enter\/leave callback for the /current window./ Note--- that some window systems may not generate accurate enter\/leave callbacks.------ /X Implementation Notes:/ An X implementation of GLUT should generate--- accurate enter\/leave callbacks.--crossingCallback :: SettableStateVar (Maybe CrossingCallback)-crossingCallback = makeSettableStateVar $-   setCallback CrossingCB glutEntryFunc (makeCrossingCallback . unmarshal)-   where unmarshal cb = cb . unmarshalCrossing--foreign import ccall "wrapper" makeCrossingCallback ::-   CrossingCallback' -> IO (FunPtr CrossingCallback')--foreign import CALLCONV unsafe "glutEntryFunc" glutEntryFunc ::-   FunPtr CrossingCallback' -> IO ()-------------------------------------------------------------------------------------- | Translation of the Spaceball along one axis, normalized to be in the range--- of -1000 to +1000 inclusive--type SpaceballMotion = Int---- | Rotation of the Spaceball along one axis, normalized to be in the range--- of -1800 .. +1800 inclusive--type SpaceballRotation = Int---- | The index of a specific buttons of an input device.--type ButtonIndex = Int---- | The state of the Spaceball has changed.--data SpaceballInput-   = SpaceballMotion   SpaceballMotion SpaceballMotion SpaceballMotion-   | SpaceballRotation SpaceballRotation SpaceballRotation SpaceballRotation-   | SpaceballButton   ButtonIndex KeyState-   deriving ( Eq, Ord, Show )---- | A SpaceballButton callback--type SpaceballCallback = SpaceballInput -> IO ()---- | Controls the Spaceball callback for the /current window./ The Spaceball--- callback for a window is called when the window has Spaceball input focus--- (normally, when the mouse is in the window) and the user generates Spaceball--- translations, rotations, or button presses. The number of available Spaceball--- buttons can be determined with 'Graphics.UI.GLUT.State.numSpaceballButtons'.------ Registering a Spaceball callback when a Spaceball device is not available has--- no effect and is not an error. In this case, no Spaceball callbacks will be--- generated.--spaceballCallback :: SettableStateVar (Maybe SpaceballCallback)-spaceballCallback = makeSettableStateVar setSpaceballCallback--setSpaceballCallback :: Maybe SpaceballCallback -> IO ()-setSpaceballCallback Nothing = do-   setSpaceballMotionCallback   Nothing-   setSpaceballRotationCallback Nothing-   setSpaceballButtonCallback   Nothing-setSpaceballCallback (Just cb) = do-   setSpaceballMotionCallback   (Just (\x y z -> cb (SpaceballMotion   x y z)))-   setSpaceballRotationCallback (Just (\x y z -> cb (SpaceballRotation x y z)))-   setSpaceballButtonCallback   (Just (\b s   -> cb (SpaceballButton   b s)))------------------------------------------------------------------------------------type SpaceballMotionCallback =-   SpaceballMotion -> SpaceballMotion -> SpaceballMotion -> IO ()--setSpaceballMotionCallback :: Maybe SpaceballMotionCallback -> IO ()-setSpaceballMotionCallback =-   setCallback SpaceballMotionCB glutSpaceballMotionFunc-               (makeSpaceballMotionCallback . unmarshal)-   where unmarshal cb x y z =-            cb (fromIntegral x) (fromIntegral y) (fromIntegral z)--foreign import ccall "wrapper" makeSpaceballMotionCallback ::-   SpaceballMotionCallback -> IO (FunPtr SpaceballMotionCallback)--foreign import CALLCONV unsafe "glutSpaceballMotionFunc" glutSpaceballMotionFunc-   :: FunPtr SpaceballMotionCallback -> IO ()------------------------------------------------------------------------------------type SpaceballRotationCallback =-   SpaceballRotation -> SpaceballRotation -> SpaceballRotation -> IO ()--setSpaceballRotationCallback :: Maybe SpaceballRotationCallback -> IO ()-setSpaceballRotationCallback =-   setCallback SpaceballRotateCB glutSpaceballRotateFunc-               (makeSpaceballRotationCallback . unmarshal)-   where unmarshal cb x y z =-            cb (fromIntegral x) (fromIntegral y) (fromIntegral z)--foreign import ccall "wrapper" makeSpaceballRotationCallback ::-   SpaceballRotationCallback -> IO (FunPtr SpaceballRotationCallback)--foreign import CALLCONV unsafe "glutSpaceballRotateFunc" glutSpaceballRotateFunc-   :: FunPtr SpaceballRotationCallback -> IO ()------------------------------------------------------------------------------------type SpaceballButtonCallback = ButtonIndex -> KeyState -> IO ()--type SpaceballButtonCallback' = CInt -> CInt -> IO ()--setSpaceballButtonCallback :: Maybe SpaceballButtonCallback -> IO ()-setSpaceballButtonCallback =-   setCallback SpaceballButtonCB glutSpaceballButtonFunc-               (makeSpaceballButtonCallback . unmarshal)-   where unmarshal cb b s = cb (fromIntegral b) (unmarshalKeyState s)--foreign import ccall "wrapper" makeSpaceballButtonCallback ::-   SpaceballButtonCallback' -> IO (FunPtr SpaceballButtonCallback')--foreign import CALLCONV unsafe "glutSpaceballButtonFunc"-   glutSpaceballButtonFunc :: FunPtr SpaceballButtonCallback' -> IO ()-------------------------------------------------------------------------------------- | The index of a specific dial of a dial and button box.--type DialIndex = Int---- | The dial & button box state has changed.--data DialAndButtonBoxInput-   = DialAndButtonBoxButton ButtonIndex KeyState-   | DialAndButtonBoxDial   DialIndex Int-   deriving ( Eq, Ord, Show )---- | A dial & button box callback--type DialAndButtonBoxCallback = DialAndButtonBoxInput -> IO ()---- | Controls the dial & button box callback for the /current window./ The dial--- & button box button callback for a window is called when the window has dial--- & button box input focus (normally, when the mouse is in the window) and the--- user generates dial & button box button presses or dial changes. The number--- of available dial & button box buttons and dials can be determined with--- 'Graphics.UI.GLUT.State.numDialsAndButtons'.------ Registering a dial & button box callback when a dial & button box device is--- not available is ineffectual and not an error. In this case, no dial & button--- box button will be generated.--dialAndButtonBoxCallback :: SettableStateVar (Maybe DialAndButtonBoxCallback)-dialAndButtonBoxCallback = makeSettableStateVar setDialAndButtonBoxCallback--setDialAndButtonBoxCallback :: Maybe DialAndButtonBoxCallback -> IO ()-setDialAndButtonBoxCallback Nothing = do-   setButtonBoxCallback Nothing-   setDialsCallback     Nothing-setDialAndButtonBoxCallback (Just cb) = do-   setButtonBoxCallback (Just (\b s -> cb (DialAndButtonBoxButton b s)))-   setDialsCallback     (Just (\d x -> cb (DialAndButtonBoxDial   d x)))------------------------------------------------------------------------------------type ButtonBoxCallback = ButtonIndex -> KeyState -> IO ()--type ButtonBoxCallback' = CInt -> CInt -> IO ()--setButtonBoxCallback :: Maybe ButtonBoxCallback -> IO ()-setButtonBoxCallback =-   setCallback ButtonBoxCB glutButtonBoxFunc (makeButtonBoxFunc . unmarshal)-   where unmarshal cb b s = cb (fromIntegral b) (unmarshalKeyState s)--foreign import ccall "wrapper" makeButtonBoxFunc ::-   ButtonBoxCallback' -> IO (FunPtr ButtonBoxCallback')--foreign import CALLCONV unsafe "glutButtonBoxFunc" glutButtonBoxFunc ::-   FunPtr ButtonBoxCallback' -> IO ()------------------------------------------------------------------------------------type DialsCallback = DialIndex -> Int -> IO ()--type DialsCallback' = CInt -> CInt -> IO ()--setDialsCallback :: Maybe DialsCallback -> IO ()-setDialsCallback =-    setCallback DialsCB glutDialsFunc (makeDialsFunc . unmarshal)-    where unmarshal cb d x = cb (fromIntegral d) (fromIntegral x)--foreign import ccall "wrapper" makeDialsFunc ::-   DialsCallback -> IO (FunPtr DialsCallback')--foreign import CALLCONV unsafe "glutDialsFunc" glutDialsFunc ::-   FunPtr DialsCallback' -> IO ()-------------------------------------------------------------------------------------- | Absolute tablet position, with coordinates normalized to be in the range of--- 0 to 2000 inclusive--data TabletPosition = TabletPosition Int Int-   deriving ( Eq, Ord, Show )---- | The table state has changed.--data TabletInput-   = TabletMotion-   | TabletButton ButtonIndex KeyState-   deriving ( Eq, Ord, Show )---- | A tablet callback--type TabletCallback = TabletInput -> TabletPosition -> IO ()---- | Controls the tablet callback for the /current window./ The tablet callback--- for a window is called when the window has tablet input focus (normally, when--- the mouse is in the window) and the user generates tablet motion or button--- presses. The number of available tablet buttons can be determined with--- 'Graphics.UI.GLUT.State.numTabletButtons'.------ Registering a tablet callback when a tablet device is not available is--- ineffectual and not an error. In this case, no tablet callbacks will be--- generated.--tabletCallback :: SettableStateVar (Maybe TabletCallback)-tabletCallback = makeSettableStateVar setTabletCallback--setTabletCallback :: Maybe TabletCallback -> IO ()-setTabletCallback Nothing = do-   setTabletMotionCallback Nothing-   setTabletButtonCallback Nothing-setTabletCallback (Just cb) = do-   setTabletMotionCallback (Just (\p     -> cb TabletMotion       p))-   setTabletButtonCallback (Just (\b s p -> cb (TabletButton b s) p))------------------------------------------------------------------------------------type TabletMotionCallback = TabletPosition -> IO ()--type TabletMotionCallback' = CInt -> CInt -> IO ()--setTabletMotionCallback :: Maybe TabletMotionCallback -> IO ()-setTabletMotionCallback =-    setCallback TabletMotionCB glutTabletMotionFunc-                (makeTabletMotionFunc . unmarshal)-    where unmarshal cb x y =-             cb (TabletPosition (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeTabletMotionFunc ::-   TabletMotionCallback' -> IO (FunPtr TabletMotionCallback')--foreign import CALLCONV unsafe "glutTabletMotionFunc" glutTabletMotionFunc ::-   FunPtr TabletMotionCallback' -> IO ()------------------------------------------------------------------------------------type TabletButtonCallback = ButtonIndex -> KeyState -> TabletPosition -> IO ()--type TabletButtonCallback' = CInt -> CInt -> CInt -> CInt -> IO ()--setTabletButtonCallback :: Maybe TabletButtonCallback -> IO ()-setTabletButtonCallback =-    setCallback TabletButtonCB glutTabletButtonFunc-                (makeTabletButtonFunc . unmarshal)-    where unmarshal cb b s x y =-             cb (fromIntegral b) (unmarshalKeyState s)-                (TabletPosition (fromIntegral x) (fromIntegral y))--foreign import ccall "wrapper" makeTabletButtonFunc ::-   TabletButtonCallback' -> IO (FunPtr TabletButtonCallback')--foreign import CALLCONV unsafe "glutTabletButtonFunc" glutTabletButtonFunc ::-   FunPtr TabletButtonCallback' -> IO ()-------------------------------------------------------------------------------------- | The state of the joystick buttons--data JoystickButtons = JoystickButtons {-   joystickButtonA, joystickButtonB,-   joystickButtonC, joystickButtonD :: KeyState }-   deriving ( Eq, Ord, Show )---- Could use fromBitfield + Enum/Bounded instances + unmarshalJoystickButton--- instead...-unmarshalJoystickButtons :: CUInt -> JoystickButtons-unmarshalJoystickButtons m = JoystickButtons {-   joystickButtonA = if (m .&. glut_JOYSTICK_BUTTON_A) /= 0 then Down else Up,-   joystickButtonB = if (m .&. glut_JOYSTICK_BUTTON_B) /= 0 then Down else Up,-   joystickButtonC = if (m .&. glut_JOYSTICK_BUTTON_C) /= 0 then Down else Up,-   joystickButtonD = if (m .&. glut_JOYSTICK_BUTTON_D) /= 0 then Down else Up }-------------------------------------------------------------------------------------- | Absolute joystick position, with coordinates normalized to be in the range--- of -1000 to 1000 inclusive. The signs of the three axes mean the following:------ * negative = left, positive = right------ * negative = towards player, positive = away------ * if available (e.g. rudder): negative = down, positive = up--data JoystickPosition = JoystickPosition Int Int Int-   deriving ( Eq, Ord, Show )-------------------------------------------------------------------------------------- | A joystick callback--type JoystickCallback = JoystickButtons -> JoystickPosition -> IO ()--type JoystickCallback' = CUInt -> CInt -> CInt -> CInt -> IO ()---- | Controls the joystick callback for the /current window./ The joystick--- callback is called either due to polling of the joystick at the uniform timer--- interval specified (if > 0) or in response to an explicit call of--- 'Graphics.UI.GLUT.DeviceControl.forceJoystickCallback'.------ /X Implementation Notes:/ Currently GLUT has no joystick support for X11.---- joystickCallback :: SettableStateVar (Maybe JoystickCallback, PollRate)-joystickCallback :: SettableStateVar (Maybe (JoystickCallback, PollRate))-joystickCallback =-   makeSettableStateVar $ \maybeCBAndRate ->-      setCallback JoystickCB-                  (\f -> glutJoystickFunc f (fromIntegral (snd (fromJust maybeCBAndRate))))-                  (makeJoystickFunc . unmarshal)-                  (fmap fst maybeCBAndRate)-    where unmarshal cb b x y z = cb (unmarshalJoystickButtons b)-                                    (JoystickPosition (fromIntegral x)-                                                      (fromIntegral y)-                                                      (fromIntegral z))--foreign import ccall "wrapper" makeJoystickFunc ::-   JoystickCallback' -> IO (FunPtr JoystickCallback')--foreign import CALLCONV unsafe "glutJoystickFunc" glutJoystickFunc ::-   FunPtr JoystickCallback' -> CInt -> IO ()
− Graphics/UI/GLUT/Colormap.hs 
@@ -1,119 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Colormap--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ OpenGL supports both RGBA and color index rendering. The RGBA mode is--- generally preferable to color index because more OpenGL rendering--- capabilities are available and color index mode requires the loading of--- colormap entries.------ The GLUT color index state variables are used to read and write entries in a--- window\'s color index colormap. Every GLUT color index window has its own--- logical color index colormap. The size of a window\'s colormap can be--- determined by reading 'numColorMapEntries'.------ GLUT color index windows within a program can attempt to share colormap--- resources by copying a single color index colormap to multiple windows using--- 'copyColormap'. If possible GLUT will attempt to share the actual colormap.--- While copying colormaps using 'copyColormap' can potentially allow sharing of--- physical colormap resources, logically each window has its own colormap. So--- changing a copied colormap of a window will force the duplication of the--- colormap. For this reason, color index programs should generally load a--- single color index colormap, copy it to all color index windows within the--- program, and then not modify any colormap cells.------ Use of multiple colormaps is likely to result in colormap installation--- problems where some windows are displayed with an incorrect colormap due to--- limitations on colormap resources.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Colormap (-   colorMapEntry,-   copyColormap,-   numColorMapEntries,-   transparentIndex-) where--import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLfloat )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Color3(..), Index1(..) )-import Graphics.UI.GLUT.Constants (-   glut_RED, glut_GREEN, glut_BLUE,-   glut_WINDOW_COLORMAP_SIZE, glut_TRANSPARENT_INDEX )-import Graphics.UI.GLUT.QueryUtils ( simpleGet, layerGet )-import Graphics.UI.GLUT.Window ( Window )-------------------------------------------------------------------------------------- | Controls the color index colormap entry of the /current window/\'s logical--- colormap for the /layer in use/. The /layer in use/ of the /current window/--- should be a color index window. The color index should be zero or greater and--- less than the total number of colormap entries for the window (see--- 'numColorMapEntries') and different from an overlay\'s transparent index (see--- 'transparentIndex').------ If the /layer in use/\'s colormap was copied by reference, setting a colormap--- entry will force the duplication of the colormap.--colorMapEntry :: Index1 GLint -> StateVar (Color3 GLfloat)-colorMapEntry (Index1 cell) =-   makeStateVar (getColorMapEntry (fromIntegral cell))-                (setColorMapEntry (fromIntegral cell))--setColorMapEntry :: CInt -> Color3 GLfloat -> IO ()-setColorMapEntry cell (Color3 r g b) = glutSetColor cell r g b--foreign import CALLCONV unsafe "glutSetColor" glutSetColor ::-   CInt -> GLfloat -> GLfloat -> GLfloat -> IO ()--getColorMapEntry :: CInt -> IO (Color3 GLfloat)-getColorMapEntry cell = do-   r <- glutGetColor cell glut_RED-   g <- glutGetColor cell glut_GREEN-   b <- glutGetColor cell glut_BLUE-   return $ Color3 r g b--foreign import CALLCONV unsafe "glutGetColor" glutGetColor ::-   CInt -> CInt -> IO GLfloat-------------------------------------------------------------------------------------- | Copy (lazily if possible to promote sharing) the logical colormap from a--- specified window to the /current window/\'s /layer in use/. The copy will be--- from the normal plane to the normal plane; or from the overlay to the overlay--- (never across different layers). Once a colormap has been copied, avoid--- setting cells in the colormap via 'colorMapEntry' since that will force an--- actual copy of the colormap if it was previously copied by reference.--- 'copyColormap' should only be called when both the /current window/ and the--- specified window are color index windows.--foreign import CALLCONV unsafe "glutCopyColormap" copyColormap ::-      Window -> IO ()-------------------------------------------------------------------------------------- | Contains the number of entries in the colormap of the /current window/\'s--- current layer (0 in RGBA mode).--numColorMapEntries :: GettableStateVar GLint-numColorMapEntries =-   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_COLORMAP_SIZE-------------------------------------------------------------------------------------- | Contains the transparent color index of the overlay of the /current window/--- or -1 if no overlay is in use.--transparentIndex :: GettableStateVar (Index1 GLint)-transparentIndex =-   makeGettableStateVar $-      layerGet (Index1 . fromIntegral) glut_TRANSPARENT_INDEX
− Graphics/UI/GLUT/Constants.hs 
@@ -1,367 +0,0 @@--- #hide--------------------------------------------------------------------------------- |--- Module      :  Graphics.UI.GLUT.Constants--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This purely internal module defines all numeric GLUT constants.-----------------------------------------------------------------------------------module Graphics.UI.GLUT.Constants where--import Foreign.C.Types ( CInt, CUInt )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )---------------------------------------------------------------------------------- * Display mode bit masks-glut_RGB, glut_RGBA, glut_INDEX, glut_SINGLE, glut_DOUBLE, glut_ACCUM,-   glut_ALPHA, glut_DEPTH, glut_STENCIL, glut_MULTISAMPLE, glut_STEREO,-   glut_LUMINANCE, glut_CAPTIONLESS, glut_BORDERLESS, glut_AUX1, glut_AUX2,-   glut_AUX3, glut_AUX4 :: CUInt-glut_RGB                               = 0x0000-glut_RGBA                              = glut_RGB-glut_INDEX                             = 0x0001-glut_SINGLE                            = 0x0000-glut_DOUBLE                            = 0x0002-glut_ACCUM                             = 0x0004-glut_ALPHA                             = 0x0008-glut_DEPTH                             = 0x0010-glut_STENCIL                           = 0x0020-glut_MULTISAMPLE                       = 0x0080-glut_STEREO                            = 0x0100-glut_LUMINANCE                         = 0x0200-glut_CAPTIONLESS                       = 0x0400-glut_BORDERLESS                        = 0x0800-glut_AUX1                              = 0x1000-glut_AUX2                              = 0x2000-glut_AUX3                              = 0x4000-glut_AUX4                              = 0x8000---------------------------------------------------------------------------------- * Mouse buttons-glut_LEFT_BUTTON, glut_MIDDLE_BUTTON, glut_RIGHT_BUTTON, glut_WHEEL_UP,-   glut_WHEEL_DOWN :: CInt-glut_LEFT_BUTTON                       = 0-glut_MIDDLE_BUTTON                     = 1-glut_RIGHT_BUTTON                      = 2-glut_WHEEL_UP                          = 3-glut_WHEEL_DOWN                        = 4---------------------------------------------------------------------------------- * Mouse button  state-glut_DOWN, glut_UP :: CInt-glut_DOWN                              = 0-glut_UP                                = 1---------------------------------------------------------------------------------- * Function keys-glut_KEY_F1, glut_KEY_F2, glut_KEY_F3, glut_KEY_F4, glut_KEY_F5, glut_KEY_F6,-   glut_KEY_F7, glut_KEY_F8, glut_KEY_F9, glut_KEY_F10, glut_KEY_F11,-   glut_KEY_F12 :: CInt-glut_KEY_F1                            = 1-glut_KEY_F2                            = 2-glut_KEY_F3                            = 3-glut_KEY_F4                            = 4-glut_KEY_F5                            = 5-glut_KEY_F6                            = 6-glut_KEY_F7                            = 7-glut_KEY_F8                            = 8-glut_KEY_F9                            = 9-glut_KEY_F10                           = 10-glut_KEY_F11                           = 11-glut_KEY_F12                           = 12---------------------------------------------------------------------------------- * Directional Keys-glut_KEY_LEFT, glut_KEY_UP, glut_KEY_RIGHT, glut_KEY_DOWN, glut_KEY_PAGE_UP,-   glut_KEY_PAGE_DOWN, glut_KEY_HOME, glut_KEY_END, glut_KEY_INSERT,-   glut_KEY_NUM_LOCK, glut_KEY_BEGIN, glut_KEY_DELETE :: CInt-glut_KEY_LEFT                          = 100-glut_KEY_UP                            = 101-glut_KEY_RIGHT                         = 102-glut_KEY_DOWN                          = 103-glut_KEY_PAGE_UP                       = 104-glut_KEY_PAGE_DOWN                     = 105-glut_KEY_HOME                          = 106-glut_KEY_END                           = 107-glut_KEY_INSERT                        = 108-glut_KEY_NUM_LOCK                      = 109-glut_KEY_BEGIN                         = 110-glut_KEY_DELETE                        = 111---------------------------------------------------------------------------------- * Entry\/exit state-glut_LEFT, glut_ENTERED :: CInt-glut_LEFT                              = 0-glut_ENTERED                           = 1---------------------------------------------------------------------------------- * Menu usage state-glut_MENU_NOT_IN_USE, glut_MENU_IN_USE :: CInt-glut_MENU_NOT_IN_USE                   = 0-glut_MENU_IN_USE                       = 1---------------------------------------------------------------------------------- * Visibility state-glut_NOT_VISIBLE, glut_VISIBLE :: CInt-glut_NOT_VISIBLE                       = 0-glut_VISIBLE                           = 1---------------------------------------------------------------------------------- * Window status state-glut_HIDDEN, glut_FULLY_RETAINED, glut_PARTIALLY_RETAINED,-   glut_FULLY_COVERED :: CInt-glut_HIDDEN                            = 0-glut_FULLY_RETAINED                    = 1-glut_PARTIALLY_RETAINED                = 2-glut_FULLY_COVERED                     = 3---------------------------------------------------------------------------------- * Color index component selection values-glut_RED, glut_GREEN, glut_BLUE :: CInt-glut_RED                               = 0-glut_GREEN                             = 1-glut_BLUE                              = 2---------------------------------------------------------------------------------- * Layers in use-glut_NORMAL, glut_OVERLAY :: GLenum-glut_NORMAL                            = 0-glut_OVERLAY                           = 1---------------------------------------------------------------------------------- * @glutGet@ parameters--glut_WINDOW_X, glut_WINDOW_Y, glut_WINDOW_WIDTH, glut_WINDOW_HEIGHT,-   glut_WINDOW_BUFFER_SIZE, glut_WINDOW_STENCIL_SIZE, glut_WINDOW_DEPTH_SIZE,-   glut_WINDOW_RED_SIZE, glut_WINDOW_GREEN_SIZE, glut_WINDOW_BLUE_SIZE,-   glut_WINDOW_ALPHA_SIZE, glut_WINDOW_ACCUM_RED_SIZE,-   glut_WINDOW_ACCUM_GREEN_SIZE, glut_WINDOW_ACCUM_BLUE_SIZE,-   glut_WINDOW_ACCUM_ALPHA_SIZE, glut_WINDOW_DOUBLEBUFFER, glut_WINDOW_RGBA,-   glut_WINDOW_PARENT, glut_WINDOW_NUM_CHILDREN, glut_WINDOW_COLORMAP_SIZE,-   glut_WINDOW_NUM_SAMPLES, glut_WINDOW_STEREO, glut_WINDOW_CURSOR,-   glut_INIT_STATE, glut_SCREEN_WIDTH, glut_SCREEN_HEIGHT,-   glut_SCREEN_WIDTH_MM, glut_SCREEN_HEIGHT_MM, glut_MENU_NUM_ITEMS,-   glut_DISPLAY_MODE_POSSIBLE, glut_INIT_WINDOW_X, glut_INIT_WINDOW_Y,-   glut_INIT_WINDOW_WIDTH, glut_INIT_WINDOW_HEIGHT, glut_INIT_DISPLAY_MODE,-   glut_ELAPSED_TIME, glut_WINDOW_FORMAT_ID, glut_ACTION_ON_WINDOW_CLOSE,-   glut_WINDOW_BORDER_WIDTH, glut_WINDOW_HEADER_HEIGHT, glut_VERSION,-   glut_RENDERING_CONTEXT, glut_DIRECT_RENDERING, glut_FULL_SCREEN,-   glut_INIT_MAJOR_VERSION, glut_INIT_MINOR_VERSION, glut_INIT_FLAGS :: GLenum-glut_WINDOW_X                          = 100-glut_WINDOW_Y                          = 101-glut_WINDOW_WIDTH                      = 102-glut_WINDOW_HEIGHT                     = 103-glut_WINDOW_BUFFER_SIZE                = 104-glut_WINDOW_STENCIL_SIZE               = 105-glut_WINDOW_DEPTH_SIZE                 = 106-glut_WINDOW_RED_SIZE                   = 107-glut_WINDOW_GREEN_SIZE                 = 108-glut_WINDOW_BLUE_SIZE                  = 109-glut_WINDOW_ALPHA_SIZE                 = 110-glut_WINDOW_ACCUM_RED_SIZE             = 111-glut_WINDOW_ACCUM_GREEN_SIZE           = 112-glut_WINDOW_ACCUM_BLUE_SIZE            = 113-glut_WINDOW_ACCUM_ALPHA_SIZE           = 114-glut_WINDOW_DOUBLEBUFFER               = 115-glut_WINDOW_RGBA                       = 116-glut_WINDOW_PARENT                     = 117-glut_WINDOW_NUM_CHILDREN               = 118-glut_WINDOW_COLORMAP_SIZE              = 119-glut_WINDOW_NUM_SAMPLES                = 120-glut_WINDOW_STEREO                     = 121-glut_WINDOW_CURSOR                     = 122-glut_INIT_STATE                        = 124-glut_SCREEN_WIDTH                      = 200-glut_SCREEN_HEIGHT                     = 201-glut_SCREEN_WIDTH_MM                   = 202-glut_SCREEN_HEIGHT_MM                  = 203-glut_MENU_NUM_ITEMS                    = 300-glut_DISPLAY_MODE_POSSIBLE             = 400-glut_INIT_WINDOW_X                     = 500-glut_INIT_WINDOW_Y                     = 501-glut_INIT_WINDOW_WIDTH                 = 502-glut_INIT_WINDOW_HEIGHT                = 503-glut_INIT_DISPLAY_MODE                 = 504-glut_ELAPSED_TIME                      = 700-glut_WINDOW_FORMAT_ID                  = 123-glut_ACTION_ON_WINDOW_CLOSE            = 505-glut_WINDOW_BORDER_WIDTH               = 506-glut_WINDOW_HEADER_HEIGHT              = 507-glut_VERSION                           = 508-glut_RENDERING_CONTEXT                 = 509-glut_DIRECT_RENDERING                  = 510-glut_FULL_SCREEN                       = 511-glut_INIT_MAJOR_VERSION                = 512-glut_INIT_MINOR_VERSION                = 513-glut_INIT_FLAGS                        = 514---------------------------------------------------------------------------------- * @glutDeviceGet@ parameters-glut_HAS_KEYBOARD, glut_HAS_MOUSE, glut_HAS_SPACEBALL,-   glut_HAS_DIAL_AND_BUTTON_BOX, glut_HAS_TABLET, glut_NUM_MOUSE_BUTTONS,-   glut_NUM_SPACEBALL_BUTTONS, glut_NUM_BUTTON_BOX_BUTTONS, glut_NUM_DIALS,-   glut_NUM_TABLET_BUTTONS, glut_DEVICE_IGNORE_KEY_REPEAT,-   glut_DEVICE_KEY_REPEAT, glut_HAS_JOYSTICK, glut_OWNS_JOYSTICK,-   glut_JOYSTICK_BUTTONS, glut_JOYSTICK_AXES, glut_JOYSTICK_POLL_RATE :: GLenum-glut_HAS_KEYBOARD                      = 600-glut_HAS_MOUSE                         = 601-glut_HAS_SPACEBALL                     = 602-glut_HAS_DIAL_AND_BUTTON_BOX           = 603-glut_HAS_TABLET                        = 604-glut_NUM_MOUSE_BUTTONS                 = 605-glut_NUM_SPACEBALL_BUTTONS             = 606-glut_NUM_BUTTON_BOX_BUTTONS            = 607-glut_NUM_DIALS                         = 608-glut_NUM_TABLET_BUTTONS                = 609-glut_DEVICE_IGNORE_KEY_REPEAT          = 610-glut_DEVICE_KEY_REPEAT                 = 611-glut_HAS_JOYSTICK                      = 612-glut_OWNS_JOYSTICK                     = 613-glut_JOYSTICK_BUTTONS                  = 614-glut_JOYSTICK_AXES                     = 615-glut_JOYSTICK_POLL_RATE                = 616---------------------------------------------------------------------------------- * @glutLayerGet@ parameters-glut_OVERLAY_POSSIBLE, glut_LAYER_IN_USE, glut_HAS_OVERLAY,-   glut_TRANSPARENT_INDEX, glut_NORMAL_DAMAGED, glut_OVERLAY_DAMAGED :: GLenum--glut_OVERLAY_POSSIBLE                  = 800-glut_LAYER_IN_USE                      = 801-glut_HAS_OVERLAY                       = 802-glut_TRANSPARENT_INDEX                 = 803-glut_NORMAL_DAMAGED                    = 804-glut_OVERLAY_DAMAGED                   = 805---------------------------------------------------------------------------------- * @glutVideoResizeGet@ parameters-glut_VIDEO_RESIZE_POSSIBLE, glut_VIDEO_RESIZE_IN_USE,-   glut_VIDEO_RESIZE_X_DELTA, glut_VIDEO_RESIZE_Y_DELTA,-   glut_VIDEO_RESIZE_WIDTH_DELTA, glut_VIDEO_RESIZE_HEIGHT_DELTA,-   glut_VIDEO_RESIZE_X, glut_VIDEO_RESIZE_Y, glut_VIDEO_RESIZE_WIDTH,-   glut_VIDEO_RESIZE_HEIGHT :: CInt-glut_VIDEO_RESIZE_POSSIBLE             = 900-glut_VIDEO_RESIZE_IN_USE               = 901-glut_VIDEO_RESIZE_X_DELTA              = 902-glut_VIDEO_RESIZE_Y_DELTA              = 903-glut_VIDEO_RESIZE_WIDTH_DELTA          = 904-glut_VIDEO_RESIZE_HEIGHT_DELTA         = 905-glut_VIDEO_RESIZE_X                    = 906-glut_VIDEO_RESIZE_Y                    = 907-glut_VIDEO_RESIZE_WIDTH                = 908-glut_VIDEO_RESIZE_HEIGHT               = 909---------------------------------------------------------------------------------- * @glutGetModifiers@ return mask-glut_ACTIVE_SHIFT, glut_ACTIVE_CTRL, glut_ACTIVE_ALT :: CInt-glut_ACTIVE_SHIFT                      = 0x01-glut_ACTIVE_CTRL                       = 0x02-glut_ACTIVE_ALT                        = 0x04---------------------------------------------------------------------------------- * @glutSetCursor@ parameters-glut_CURSOR_RIGHT_ARROW, glut_CURSOR_LEFT_ARROW, glut_CURSOR_INFO,-   glut_CURSOR_DESTROY, glut_CURSOR_HELP, glut_CURSOR_CYCLE,-   glut_CURSOR_SPRAY, glut_CURSOR_WAIT, glut_CURSOR_TEXT,-   glut_CURSOR_CROSSHAIR, glut_CURSOR_UP_DOWN, glut_CURSOR_LEFT_RIGHT,-   glut_CURSOR_TOP_SIDE, glut_CURSOR_BOTTOM_SIDE, glut_CURSOR_LEFT_SIDE,-   glut_CURSOR_RIGHT_SIDE, glut_CURSOR_TOP_LEFT_CORNER,-   glut_CURSOR_TOP_RIGHT_CORNER, glut_CURSOR_BOTTOM_RIGHT_CORNER,-   glut_CURSOR_BOTTOM_LEFT_CORNER, glut_CURSOR_INHERIT, glut_CURSOR_NONE,-   glut_CURSOR_FULL_CROSSHAIR :: CInt-glut_CURSOR_RIGHT_ARROW                = 0-glut_CURSOR_LEFT_ARROW                 = 1-glut_CURSOR_INFO                       = 2-glut_CURSOR_DESTROY                    = 3-glut_CURSOR_HELP                       = 4-glut_CURSOR_CYCLE                      = 5-glut_CURSOR_SPRAY                      = 6-glut_CURSOR_WAIT                       = 7-glut_CURSOR_TEXT                       = 8-glut_CURSOR_CROSSHAIR                  = 9-glut_CURSOR_UP_DOWN                    = 10-glut_CURSOR_LEFT_RIGHT                 = 11-glut_CURSOR_TOP_SIDE                   = 12-glut_CURSOR_BOTTOM_SIDE                = 13-glut_CURSOR_LEFT_SIDE                  = 14-glut_CURSOR_RIGHT_SIDE                 = 15-glut_CURSOR_TOP_LEFT_CORNER            = 16-glut_CURSOR_TOP_RIGHT_CORNER           = 17-glut_CURSOR_BOTTOM_RIGHT_CORNER        = 18-glut_CURSOR_BOTTOM_LEFT_CORNER         = 19-glut_CURSOR_INHERIT                    = 100-glut_CURSOR_NONE                       = 101-glut_CURSOR_FULL_CROSSHAIR             = 102---------------------------------------------------------------------------------- * @glutSetKeyRepeat@ modes-glut_KEY_REPEAT_OFF, glut_KEY_REPEAT_ON, glut_KEY_REPEAT_DEFAULT :: CInt-glut_KEY_REPEAT_OFF                    = 0-glut_KEY_REPEAT_ON                     = 1-glut_KEY_REPEAT_DEFAULT                = 2---------------------------------------------------------------------------------- * Joystick button masks-glut_JOYSTICK_BUTTON_A, glut_JOYSTICK_BUTTON_B, glut_JOYSTICK_BUTTON_C,-   glut_JOYSTICK_BUTTON_D :: CUInt-glut_JOYSTICK_BUTTON_A                 = 0x01-glut_JOYSTICK_BUTTON_B                 = 0x02-glut_JOYSTICK_BUTTON_C                 = 0x04-glut_JOYSTICK_BUTTON_D                 = 0x08---------------------------------------------------------------------------------- @glutGameModeGet@ parameters-glut_GAME_MODE_ACTIVE, glut_GAME_MODE_POSSIBLE, glut_GAME_MODE_WIDTH,-   glut_GAME_MODE_HEIGHT, glut_GAME_MODE_PIXEL_DEPTH,-   glut_GAME_MODE_REFRESH_RATE, glut_GAME_MODE_DISPLAY_CHANGED :: GLenum-glut_GAME_MODE_ACTIVE                  = 0-glut_GAME_MODE_POSSIBLE                = 1-glut_GAME_MODE_WIDTH                   = 2-glut_GAME_MODE_HEIGHT                  = 3-glut_GAME_MODE_PIXEL_DEPTH             = 4-glut_GAME_MODE_REFRESH_RATE            = 5-glut_GAME_MODE_DISPLAY_CHANGED         = 6---------------------------------------------------------------------------------- Direct/indirect rendering context options (has meaning only in unix/x11),--- see glut_DIRECT_RENDERING (freeglut extension)-glut_FORCE_INDIRECT_CONTEXT, glut_ALLOW_DIRECT_CONTEXT,-   glut_TRY_DIRECT_CONTEXT, glut_FORCE_DIRECT_CONTEXT :: CInt-glut_FORCE_INDIRECT_CONTEXT            = 0-glut_ALLOW_DIRECT_CONTEXT              = 1-glut_TRY_DIRECT_CONTEXT                = 2-glut_FORCE_DIRECT_CONTEXT              = 3---------------------------------------------------------------------------------- Behaviour when the user clicks on an "x" to close a window, see--- glut_ACTION_ON_WINDOW_CLOSE (freeglut extension)-glut_ACTION_EXIT, glut_ACTION_GLUTMAINLOOP_RETURNS,-   glut_ACTION_CONTINUE_EXECUTION :: CInt-glut_ACTION_EXIT                       = 0-glut_ACTION_GLUTMAINLOOP_RETURNS       = 1-glut_ACTION_CONTINUE_EXECUTION         = 2---------------------------------------------------------------------------------- Create a new rendering context when the user opens a new window? See--- glut_RENDERING_CONTEXT (freeglut extension)-glut_CREATE_NEW_CONTEXT, glut_USE_CURRENT_CONTEXT :: CInt-glut_CREATE_NEW_CONTEXT                = 0-glut_USE_CURRENT_CONTEXT               = 1---------------------------------------------------------------------------------- OpenGL 3.x context creation flags (freeglut extension)-glut_DEBUG, glut_FORWARD_COMPATIBLE :: CInt-glut_DEBUG                             = 1-glut_FORWARD_COMPATIBLE                = 2---------------------------------------------------------------------------------- glutGetModeValues parameter (freeglut extension)-glut_AUX :: GLenum-glut_AUX                               = 0x1000
− Graphics/UI/GLUT/Debugging.hs 
@@ -1,38 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Debugging--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This module contains a simple utility routine to report any pending GL--- errors.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Debugging (-   reportErrors-) where--import System.Environment ( getProgName )-import System.IO ( hPutStrLn, stderr )-import Graphics.Rendering.OpenGL.GL.StateVar ( HasGetter(get) )-import Graphics.Rendering.OpenGL.GLU.Errors ( Error(..), errors )-------------------------------------------------------------------------------------- | Report any pending GL errors to stderr (which is typically the console).--- If there are no pending errors, this routine does nothing. Note that the--- error flags are reset after this action, i.e. there are no pending errors--- left afterwards.--reportErrors :: IO ()-reportErrors = get errors >>= mapM_ reportError--reportError :: Error -> IO ()-reportError (Error _ msg) = do-   pn <- getProgName-   hPutStrLn stderr ("GLUT: Warning in " ++ pn ++ ": GL error: " ++ msg)
− Graphics/UI/GLUT/DeviceControl.hs 
@@ -1,130 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.DeviceControl--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT offers some routines for controlling the key repeat and polling the--- joystick.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.DeviceControl (-   GlobalKeyRepeat(..), globalKeyRepeat,-   PerWindowKeyRepeat(..), perWindowKeyRepeat,-   forceJoystickCallback-) where--import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.StateVar ( StateVar, makeStateVar )-import Graphics.UI.GLUT.Constants (-   glut_KEY_REPEAT_OFF, glut_KEY_REPEAT_ON, glut_KEY_REPEAT_DEFAULT,-   glut_DEVICE_KEY_REPEAT, glut_DEVICE_IGNORE_KEY_REPEAT )-import Graphics.UI.GLUT.QueryUtils ( deviceGet )-------------------------------------------------------------------------------------- | The state of the global key repeat--data GlobalKeyRepeat-   = GlobalKeyRepeatOff-   | GlobalKeyRepeatOn-   | GlobalKeyRepeatDefault-   deriving ( Eq, Ord, Show )--marshalGlobalKeyRepeat :: GlobalKeyRepeat -> CInt-marshalGlobalKeyRepeat x = case x of-   GlobalKeyRepeatOff -> glut_KEY_REPEAT_OFF-   GlobalKeyRepeatOn -> glut_KEY_REPEAT_ON-   GlobalKeyRepeatDefault -> glut_KEY_REPEAT_DEFAULT--unmarshalGlobalKeyRepeat :: CInt -> GlobalKeyRepeat-unmarshalGlobalKeyRepeat x-   | x == glut_KEY_REPEAT_OFF     = GlobalKeyRepeatOff-   | x == glut_KEY_REPEAT_ON      = GlobalKeyRepeatOn-   | x == glut_KEY_REPEAT_DEFAULT = GlobalKeyRepeatDefault-   | otherwise = error ("unmarshalGlobalKeyRepeat: illegal value " ++ show x)-------------------------------------------------------------------------------------- | Controls the key repeat mode for the window system on a global basis if--- possible. If supported by the window system, the key repeat can either be--- disabled, enabled, or set to the window system\'s default key repeat state.------ /X Implementation Notes:/ X11 sends @KeyPress@ events repeatedly when the--- window system\'s global auto repeat is enabled. 'perWindowKeyRepeat' can--- prevent these auto repeated keystrokes from being reported as keyboard or--- special callbacks, but there is still some minimal overhead by the X server--- to continually stream @KeyPress@ events to the GLUT application. The--- 'globalKeyRepeat' state variable can be used to actually disable the global--- sending of auto repeated @KeyPress@ events. Note that 'globalKeyRepeat'--- affects the global window system auto repeat state so other applications--- will not auto repeat if you disable auto repeat globally through--- 'globalKeyRepeat'. GLUT applications using the X11 GLUT implementation--- should disable key repeat with 'globalKeyRepeat' to disable key repeats most--- efficiently, but are responsible for explicitly restoring the default key--- repeat state on exit.------ /Win32 Implementation Notes:/ The Win32 implementation of 'globalKeyRepeat'--- does nothing. The 'perWindowKeyRepeat' can be used in the Win32 GLUT--- implementation to ignore repeated keys on a per-window basis without changing--- the global window system key repeat.--globalKeyRepeat :: StateVar GlobalKeyRepeat-globalKeyRepeat =-   makeStateVar (deviceGet unmarshalGlobalKeyRepeat glut_DEVICE_KEY_REPEAT)-                (glutSetKeyRepeat . marshalGlobalKeyRepeat)--foreign import CALLCONV unsafe "glutSetKeyRepeat" glutSetKeyRepeat ::-   CInt -> IO ()-------------------------------------------------------------------------------------- | The state of the per-window key repeat--data PerWindowKeyRepeat-   = PerWindowKeyRepeatOff-   | PerWindowKeyRepeatOn-   deriving ( Eq, Ord, Show )--marshalPerWindowKeyRepeat :: PerWindowKeyRepeat -> CInt-marshalPerWindowKeyRepeat x = case x of-   PerWindowKeyRepeatOn -> 0-   PerWindowKeyRepeatOff -> 1--unmarshalPerWindowKeyRepeat :: CInt -> PerWindowKeyRepeat-unmarshalPerWindowKeyRepeat x-   | x == 0 = PerWindowKeyRepeatOn-   | otherwise = PerWindowKeyRepeatOff-------------------------------------------------------------------------------------- | Controls if auto repeat keystrokes are reported to the /current window./--- Ignoring auto repeated keystrokes is generally done in conjunction with using--- the 'Graphics.UI.GLUT.Callbacks.Window.keyboardMouseCallback'. If you do--- not ignore auto repeated keystrokes, your GLUT application will experience--- repeated release\/press callbacks. Games using the keyboard will typically--- want to ignore key repeat.--perWindowKeyRepeat :: StateVar PerWindowKeyRepeat-perWindowKeyRepeat =-   makeStateVar-      (deviceGet unmarshalPerWindowKeyRepeat glut_DEVICE_IGNORE_KEY_REPEAT)-      (glutIgnoreKeyRepeat . marshalPerWindowKeyRepeat)--foreign import CALLCONV unsafe "glutIgnoreKeyRepeat" glutIgnoreKeyRepeat ::-   CInt -> IO ()-------------------------------------------------------------------------------------- | Execute the joystick callback set by--- 'Graphics.UI.GLUT.Callbacks.Window.joystickCallback' once (if one exists).--- This is done in a synchronous fashion within the current context, i.e. when--- 'forceJoystickCallback' returns, the callback will have already happened.-		-foreign import CALLCONV unsafe "glutForceJoystickFunc" forceJoystickCallback ::-   IO ()
− Graphics/UI/GLUT/Extensions.hs 
@@ -1,46 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Extensions--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  provisional--- Portability :  portable------ This is a purely internal module for handling an OpenGL-like extension--- mechanism for GLUT.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Extensions (-   FunPtr, unsafePerformIO,-   Invoker, getProcAddress, getProcAddressInternal   -- used only internally-) where--import Foreign.C.String ( CString, withCString )-import Foreign.Ptr ( FunPtr, nullFunPtr )-import System.IO.Unsafe ( unsafePerformIO )------------------------------------------------------------------------------------type Invoker a = FunPtr a -> a--getProcAddress :: String -> String -> IO (FunPtr a)-getProcAddress ext call =-   throwIfNull ("unknown GLUT call " ++ call ++ ", check for " ++ ext) $-      getProcAddressInternal call--throwIfNull :: String -> IO (FunPtr a) -> IO (FunPtr a)-throwIfNull msg act = do-   res <- act-   if res == nullFunPtr-      then ioError (userError msg)-      else return res--getProcAddressInternal :: String -> IO (FunPtr a)-getProcAddressInternal call = withCString call hs_GLUT_getProcAddress--foreign import ccall unsafe "hs_GLUT_getProcAddress" hs_GLUT_getProcAddress-   :: CString -> IO (FunPtr a)
− Graphics/UI/GLUT/Fonts.hs 
@@ -1,213 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Fonts--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT supports two types of font rendering: stroke fonts, meaning each--- character is rendered as a set of line segments; and bitmap fonts, where each--- character is a bitmap generated with--- 'Graphics.Rendering.OpenGL.GL.Bitmaps.bitmap'. Stroke fonts have the--- advantage that because they are geometry, they can be arbitrarily scale and--- rendered. Bitmap fonts are less flexible since they are rendered as bitmaps--- but are usually faster than stroke fonts.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Fonts (-   Font(..), BitmapFont(..), StrokeFont(..),-) where--import Data.Char ( ord )-import Foreign.C.String ( CString, withCString )-import Foreign.C.Types ( CInt )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLfloat )-import Graphics.UI.GLUT.Extensions--#ifdef __HUGS__-{-# CFILES cbits/HsGLUT.c #-}-#endif------------------------------------------------------------------------------------#include "HsGLUTExt.h"------------------------------------------------------------------------------------class Font a where-   -- | Render the string in the named font, without using any display lists.-   -- Rendering a nonexistent character has no effect.-   ---   -- If the font is a bitmap font, 'renderString' automatically sets the OpenGL-   -- unpack pixel storage modes it needs appropriately and saves and restores-   -- the previous modes before returning. The generated call to-   -- 'Graphics.Rendering.OpenGL.GL.bitmap' will adjust the current raster-   -- position based on the width of the string.-   -- If the font is a stroke font,-   -- 'Graphics.Rendering.OpenGL.GL.CoordTrans.translate' is used to translate-   -- the current model view matrix to advance the width of the string.--   renderString :: a -> String -> IO ()--   -- | For a bitmap font, return the width in pixels of a string. For a stroke-   -- font, return the width in units. While the width of characters in a font-   -- may vary (though fixed width fonts do not vary), the maximum height-   -- characteristics of a particular font are fixed.--   stringWidth :: a -> String -> IO GLint--   -- | (/freeglut only/) For a bitmap font, return the maximum height of the-   -- characters in the given font measured in pixels. For a stroke font,-   -- return the width in units.--   fontHeight :: a -> IO GLfloat--instance Font BitmapFont where-   renderString = bitmapString-   stringWidth  = bitmapLength-   fontHeight   = bitmapHeight---instance Font StrokeFont where-   renderString = strokeString-   stringWidth  = strokeLength-   fontHeight   = strokeHeight-------------------------------------------------------------------------------------- | The bitmap fonts available in GLUT. The exact bitmap to be used is--- defined by the standard X glyph bitmaps for the X font with the given name.--data BitmapFont-   = Fixed8By13   -- ^ A fixed width font with every character fitting in an 8-                  --   by 13 pixel rectangle.-                  --   (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)-   | Fixed9By15   -- ^ A fixed width font with every character fitting in an 9-                  --   by 15 pixel rectangle.-                  --   (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)-   | TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.-                  --   (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)-   | TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.-                  --   (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)-   | Helvetica10  -- ^ A 10-point proportional spaced Helvetica font.-                  --   (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)-   | Helvetica12  -- ^ A 12-point proportional spaced Helvetica font.-                  --   (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)-   | Helvetica18  -- ^ A 18-point proportional spaced Helvetica font.-                  --   (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)-   deriving ( Eq, Ord, Show )---- Alas, fonts in GLUT are not denoted by some integral value, but by opaque--- pointers on the C side. Even worse: For WinDoze, they are simply small ints,--- casted to void*, for other platforms addresses of global variables are used.--- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable--- way is using integers on the Haskell side and doing the marshaling via some--- small C wrappers around those macros. *sigh*-type GLUTbitmapFont = Ptr ()--foreign import ccall unsafe "hs_GLUT_marshalBitmapFont"-   hs_GLUT_marshalBitmapFont :: CInt -> IO GLUTbitmapFont--marhshalBitmapFont :: BitmapFont -> IO GLUTbitmapFont-marhshalBitmapFont x = case x of-   Fixed8By13 -> hs_GLUT_marshalBitmapFont 0-   Fixed9By15 -> hs_GLUT_marshalBitmapFont 1-   TimesRoman10 -> hs_GLUT_marshalBitmapFont 2-   TimesRoman24 -> hs_GLUT_marshalBitmapFont 3-   Helvetica10 -> hs_GLUT_marshalBitmapFont 4-   Helvetica12 -> hs_GLUT_marshalBitmapFont 5-   Helvetica18 -> hs_GLUT_marshalBitmapFont 6-------------------------------------------------------------------------------------- | The stroke fonts available in GLUT.-data StrokeFont-   = Roman     -- ^ A proportionally spaced Roman Simplex font for ASCII-               --   characters 32 through 127. The maximum top character in the-               --   font is 119.05 units; the bottom descends 33.33 units.-   | MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as-               --   'Roman') for ASCII characters 32 through 127. The maximum-               --   top character in the font is 119.05 units; the bottom-               --   descends 33.33 units. Each character is 104.76 units wide.-   deriving ( Eq, Ord, Show )---- Same remarks as for GLUTbitmapFont-type GLUTstrokeFont = Ptr ()--foreign import ccall unsafe "hs_GLUT_marshalStrokeFont"-   hs_GLUT_marshalStrokeFont :: CInt -> IO GLUTstrokeFont--marhshalStrokeFont :: StrokeFont -> IO GLUTstrokeFont-marhshalStrokeFont x = case x of-   Roman -> hs_GLUT_marshalStrokeFont 0-   MonoRoman -> hs_GLUT_marshalStrokeFont 1------------------------------------------------------------------------------------bitmapString :: BitmapFont -> String -> IO ()-bitmapString f s = do-   i <- marhshalBitmapFont f-   mapM_ (\c -> withChar c (glutBitmapCharacter i)) s--withChar :: Char -> (CInt -> IO a) -> IO a-withChar c f = f . fromIntegral . ord $ c--foreign import CALLCONV "glutBitmapCharacter" glutBitmapCharacter ::-   GLUTbitmapFont -> CInt -> IO ()------------------------------------------------------------------------------------strokeString :: StrokeFont -> String -> IO ()-strokeString f s = do-   i <- marhshalStrokeFont f-   mapM_ (\c -> withChar c (glutStrokeCharacter i)) s--foreign import CALLCONV unsafe "glutStrokeCharacter"-   glutStrokeCharacter :: GLUTstrokeFont -> CInt -> IO ()------------------------------------------------------------------------------------bitmapLength :: BitmapFont -- ^ Bitmap font to use.-             -> String     -- ^ String to return width of (not confined to 8-                           --   bits).-             -> IO GLint   -- ^ Width in pixels.-bitmapLength f s = do-   i <- marhshalBitmapFont f-   fmap fromIntegral $ withCString s (glutBitmapLength i)--foreign import CALLCONV unsafe "glutBitmapLength"-   glutBitmapLength :: GLUTbitmapFont -> CString -> IO CInt------------------------------------------------------------------------------------strokeLength :: StrokeFont -- ^ Stroke font to use.-             -> String     -- ^ String to return width of (not confined to 8-                           --   bits).-             -> IO GLint   -- ^ Width in units.-strokeLength f s = do-   i <- marhshalStrokeFont f-   fmap fromIntegral $ withCString s (glutStrokeLength i)--foreign import CALLCONV unsafe "glutStrokeLength"-   glutStrokeLength :: GLUTstrokeFont -> CString -> IO CInt------------------------------------------------------------------------------------bitmapHeight :: BitmapFont -- ^ Bitmap font to use.-             -> IO GLfloat -- ^ Height in pixels.-bitmapHeight f = fmap fromIntegral $ glutBitmapHeight =<< marhshalBitmapFont f--EXTENSION_ENTRY(unsafe,"freeglut",glutBitmapHeight,GLUTbitmapFont -> IO CInt)------------------------------------------------------------------------------------strokeHeight :: StrokeFont -- ^ Stroke font to use.-             -> IO GLfloat -- ^ Height in units.-strokeHeight f = glutStrokeHeight =<< marhshalStrokeFont f--EXTENSION_ENTRY(unsafe,"freeglut",glutStrokeHeight,GLUTstrokeFont -> IO GLfloat)
− Graphics/UI/GLUT/GameMode.hs 
@@ -1,205 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.GameMode--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ In addition to the functionality offered by--- 'Graphics.UI.GLUT.Window.fullScreen', GLUT offers an sub-API to change the--- screen resolution, color depth, and refresh rate of the display for a single--- full screen window. This mode of operation is called /game mode/, and is--- restricted in various ways: No pop-up menus are allowed for this full screen--- window, no other (sub-)windows can be created, and all other applications are--- hidden.------ /X Implementation Notes:/ Note that game mode is not fully supported in the--- original GLUT for X, it is essentially the same as using--- 'Graphics.UI.GLUT.Window.fullScreen'. The GLUT clone freeglut--- (see <http://freeglut.sourceforge.net/>) does not have this restriction.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.GameMode (-   GameModeCapability(..), GameModeCapabilityDescription(..),-   gameModeCapabilities, enterGameMode, leaveGameMode,-   BitsPerPlane, RefreshRate, GameModeInfo(..), gameModeInfo,-   gameModeActive-) where--import Data.List ( intersperse )-import Foreign.C.String ( CString, withCString )-import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar )-import Graphics.UI.GLUT.Constants (-   glut_GAME_MODE_DISPLAY_CHANGED, glut_GAME_MODE_POSSIBLE,-   glut_GAME_MODE_WIDTH, glut_GAME_MODE_HEIGHT,-   glut_GAME_MODE_PIXEL_DEPTH, glut_GAME_MODE_REFRESH_RATE,-   glut_GAME_MODE_ACTIVE )-import Graphics.UI.GLUT.Types ( makeWindow, relationToString )-import Graphics.UI.GLUT.Window ( Window )-import Graphics.UI.GLUT.Initialization ( Relation(..) )-------------------------------------------------------------------------------------- | Capabilities for 'gameModeCapabilities'--data GameModeCapability-   = GameModeWidth         -- ^ Width of the screen resolution in pixels-   | GameModeHeight        -- ^ Height of the screen resolution in pixels-   | GameModeBitsPerPlane  -- ^ Color depth of the screen in bits-   | GameModeRefreshRate   -- ^ Refresh rate in Hertz-   | GameModeNum           -- ^ Match the Nth frame buffer configuration-                           --   compatible with the given capabilities-                           --   (numbering starts at 1)-   deriving ( Eq, Ord, Show )--gameModeCapabilityToString :: GameModeCapability -> String-gameModeCapabilityToString x = case x of-   GameModeWidth        -> "width"-   GameModeHeight       -> "height"-   GameModeBitsPerPlane -> "bpp"-   GameModeRefreshRate  -> "hertz"-   GameModeNum          -> "num"---- | A single capability description for 'gameModeCapabilities'.--data GameModeCapabilityDescription = Where' GameModeCapability Relation Int-   deriving ( Eq, Ord, Show )--gameModeCapabilityDescriptionToString :: GameModeCapabilityDescription -> String-gameModeCapabilityDescriptionToString (Where' c r i) =-      gameModeCapabilityToString c ++ relationToString r ++ show i-------------------------------------------------------------------------------------- | Controls the /game mode/ to be used when 'enterGameMode' is called. It is--- described by a list of zero or more capability descriptions, which are--- translated into a set of criteria used to select the appropriate screen--- configuration. The criteria are matched in strict left to right order of--- precdence. That is, the first specified criterion (leftmost) takes precedence--- over the later criteria for non-exact criteria--- ('Graphics.UI.GLUT.Initialization.IsGreaterThan',--- 'Graphics.UI.GLUT.Initialization.IsLessThan', etc.). Exact criteria--- ('Graphics.UI.GLUT.Initialization.IsEqualTo',--- 'Graphics.UI.GLUT.Initialization.IsNotEqualTo') must match exactly so--- precedence is not relevant.------ To determine which configuration will actually be tried by 'enterGameMode'--- (if any), use 'gameModeInfo'.------ Note that even for game mode the current values of--- 'Graphics.UI.GLUT.Initialization.initialDisplayMode'or--- 'Graphics.UI.GLUT.Initialization.initialDisplayCapabilities' will--- determine which buffers are available, if double buffering is used or not,--- etc.--gameModeCapabilities :: SettableStateVar [GameModeCapabilityDescription]-gameModeCapabilities = makeSettableStateVar $ \ds ->-   withCString (descriptionsToString ds) glutGameModeString--foreign import CALLCONV unsafe "glutGameModeString" glutGameModeString ::-   CString -> IO ()---- freeglut currently handles only simple game mode descriptions like "WxH:B@R",--- so we try hard to use this format instead of the more general format allowed--- by the "real" GLUT.-descriptionsToString :: [GameModeCapabilityDescription] -> String-descriptionsToString ds =-   let ws = [ x | Where' GameModeWidth        IsEqualTo x <- ds ]-       hs = [ x | Where' GameModeHeight       IsEqualTo x <- ds ]-       bs = [ x | Where' GameModeBitsPerPlane IsEqualTo x <- ds ]-       rs = [ x | Where' GameModeRefreshRate  IsEqualTo x <- ds ]-       allSimple = (length ws + length hs + length bs + length rs) == (length ds)-       dimensionsOK = (null ws) == (null hs)-   in if allSimple && dimensionsOK-         then simpleCapStr ws hs bs rs-         else generalCapStr ds--simpleCapStr :: [Int] -> [Int] -> [Int] -> [Int] -> String-simpleCapStr ws hs bs rs =-   showCap "" ws ++ showCap "x" hs ++ showCap ":" bs ++ showCap "@" rs-   where showCap _      []    = ""-         showCap prefix (x:_) = prefix ++ show x--generalCapStr :: [GameModeCapabilityDescription] -> String-generalCapStr =-   concat . intersperse " " . map gameModeCapabilityDescriptionToString-------------------------------------------------------------------------------------- | Enter /game mode/, trying to change resolution, refresh rate, etc., as--- specified by the current value of 'gameModeCapabilities'. An identifier for--- the game mode window and a flag, indicating if the display mode actually--- changed, are returned. The game mode window is made the /current window/.------ Re-entering /game mode/ is allowed, the previous game mode window gets--- destroyed by this, and a new one is created.--enterGameMode :: IO (Window, Bool)-enterGameMode = do-   w <- glutEnterGameMode-   c <- getBool glut_GAME_MODE_DISPLAY_CHANGED-   return (makeWindow w, c)--foreign import CALLCONV unsafe "glutEnterGameMode" glutEnterGameMode :: IO CInt-------------------------------------------------------------------------------------- | Leave /game mode/, restoring the old display mode and destroying the game--- mode window.--foreign import CALLCONV unsafe "glutLeaveGameMode" leaveGameMode :: IO ()-------------------------------------------------------------------------------------- | The color depth of the screen, measured in bits (e.g. 8, 16, 24, 32, ...)--type BitsPerPlane = Int---- | The refresh rate of the screen, measured in Hertz (e.g. 60, 75, 100, ...)--type RefreshRate = Int--data GameModeInfo = GameModeInfo Size BitsPerPlane RefreshRate-   deriving ( Eq, Ord, Show )-------------------------------------------------------------------------------------- | Return 'Just' the mode which would be tried by the next call to--- 'enterGameMode'. Returns 'Nothing' if the mode requested by the current value--- of 'gameModeCapabilities' is not possible, in which case 'enterGameMode'--- would simply create a full screen window using the current mode.--gameModeInfo :: GettableStateVar (Maybe GameModeInfo)-gameModeInfo = makeGettableStateVar $ do-   possible <- getBool glut_GAME_MODE_POSSIBLE-   if possible-      then do-         w <- glutGameModeGet glut_GAME_MODE_WIDTH-         h <- glutGameModeGet glut_GAME_MODE_HEIGHT-         let size = Size (fromIntegral w) (fromIntegral h)-         b <- glutGameModeGet glut_GAME_MODE_PIXEL_DEPTH-         r <- glutGameModeGet glut_GAME_MODE_REFRESH_RATE-         return $ Just $ GameModeInfo size (fromIntegral b) (fromIntegral r)-      else return Nothing--getBool :: GLenum -> IO Bool-getBool = fmap (/= 0) . glutGameModeGet--foreign import CALLCONV unsafe "glutGameModeGet" glutGameModeGet ::-   GLenum -> IO CInt-------------------------------------------------------------------------------------- | Contains 'True' when the /game mode/ is active, 'False' otherwise.--gameModeActive :: GettableStateVar Bool-gameModeActive = makeGettableStateVar $ getBool glut_GAME_MODE_ACTIVE
− Graphics/UI/GLUT/Initialization.hs 
@@ -1,772 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Initialization--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ Actions and state variables in this module are used to initialize GLUT state.--- The primary initialization routine is 'initialize', which should only be--- called exactly once in a GLUT program. No other GLUT or OpenGL actions should--- be called before 'initialize', apart from getting or setting the state--- variables in this module.------ The reason is that these state variables can be used to set default window--- initialization state that might be modified by the command processing done in--- 'initialize'. For example, 'initialWindowSize' can be set to @('Size'--- 400 400)@ before 'initialize' is called to indicate 400 by 400 is the--- program\'s default window size. Setting the initial window size or position--- before 'initialize' allows the GLUT program user to specify the initial size--- or position using command line arguments.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Initialization (-   -- * Primary initialization-   initialize, getArgsAndInitialize, exit,--   -- * Initial window geometry-   initialWindowPosition, initialWindowSize,--   -- * Setting the initial display mode (I)-   DisplayMode(..), initialDisplayMode, displayModePossible,--   -- * Setting the initial display mode (II)-   DisplayCapability(..), Relation(..), DisplayCapabilityDescription(..),-   initialDisplayCapabilities,--   -- * Controlling the creation of rendering contexts-   RenderingContext(..), renderingContext,--   -- * Direct\/indirect rendering-   DirectRendering(..), directRendering,--   -- * OpenGL 3.x context support-   initialContextVersion, ContextFlag(..), initialContextFlags-) where--import Control.Monad ( when )-import Data.Bits ( Bits((.|.),(.&.)), complement )-import Data.List ( genericLength, intersperse, mapAccumR )-import Foreign.C.String ( CString, withCString, peekCString )-import Foreign.C.Types ( CInt, CUInt )-import Foreign.Marshal.Array ( withArray0, peekArray )-import Foreign.Marshal.Utils ( with, withMany )-import Foreign.Ptr ( Ptr, nullPtr, nullFunPtr )-import Foreign.Storable ( Storable(..) )-import System.Environment ( getProgName, getArgs )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar, HasGetter(..), HasSetter(..) )-import Graphics.UI.GLUT.Constants (-   glut_INIT_WINDOW_X, glut_INIT_WINDOW_Y,-   glut_INIT_WINDOW_WIDTH, glut_INIT_WINDOW_HEIGHT,-   glut_RGBA, glut_RGB, glut_INDEX, glut_LUMINANCE,-   glut_ALPHA, glut_ACCUM, glut_DEPTH, glut_STENCIL,-   glut_AUX1, glut_AUX2, glut_AUX3, glut_AUX4,-   glut_SINGLE, glut_DOUBLE, glut_MULTISAMPLE, glut_STEREO,-   glut_CAPTIONLESS, glut_BORDERLESS,-   glut_INIT_DISPLAY_MODE,-   glut_DISPLAY_MODE_POSSIBLE,-   glut_RENDERING_CONTEXT, glut_CREATE_NEW_CONTEXT, glut_USE_CURRENT_CONTEXT,-   glut_DIRECT_RENDERING,-   glut_FORCE_INDIRECT_CONTEXT, glut_ALLOW_DIRECT_CONTEXT,-   glut_TRY_DIRECT_CONTEXT, glut_FORCE_DIRECT_CONTEXT,-   glut_INIT_MAJOR_VERSION, glut_INIT_MINOR_VERSION,-   glut_DEBUG, glut_FORWARD_COMPATIBLE, glut_INIT_FLAGS )-import Graphics.UI.GLUT.Extensions-import Graphics.UI.GLUT.QueryUtils ( simpleGet, glutSetOption )-import Graphics.UI.GLUT.Types ( Relation(..), relationToString )------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- | Given the program name and command line arguments, initialize the GLUT--- library and negotiate a session with the window system. During this--- process, 'initialize' may cause the termination of the GLUT program with an--- error message to the user if GLUT cannot be properly initialized.--- Examples of this situation include the failure to connect to the window--- system, the lack of window system support for OpenGL, and invalid command--- line options.------ 'initialize' also processes command line options, but the specific options--- parsed are window system dependent. Any command line arguments which are--- not GLUT-specific are returned.------ /X Implementation Notes:/ The X Window System specific options parsed by--- 'initialize' are as follows:------ * @-display /DISPLAY/@: Specify the X server to connect to. If not specified,---   the value of the @DISPLAY@ environment variable is used.------ * @-geometry /WxH+X+Y/@: Determines where windows should be created on the---   screen. The parameter following @-geometry@ should be formatted as a---   standard X geometry specification. The effect of using this option is to---   change the GLUT initial size and initial position the same as if---   'initialWindowSize' or 'initialWindowPosition' were modified directly.------ * @-iconic@: Requests all top-level windows be created in an iconic state.------ * @-indirect@: Force the use of indirect OpenGL rendering contexts.------ * @-direct@: Force the use of direct OpenGL rendering contexts (not all GLX---   implementations support direct rendering contexts). A fatal error is---   generated if direct rendering is not supported by the OpenGL---   implementation. If neither @-indirect@ or @-direct@ are used to force a---   particular behavior, GLUT will attempt to use direct rendering if---   possible and otherwise fallback to indirect rendering.------ * @-gldebug@: After processing callbacks and\/or events, call---   'Graphics.UI.GLUT.Debugging.reportErrors' to check if there are any pending---   OpenGL errors. Using this option is helpful in detecting OpenGL run-time---   errors.------ * @-sync@: Enable synchronous X protocol transactions. This option makes---   it easier to track down potential X protocol errors.--initialize :: String      -- ^ The program name.-           -> [String]    -- ^ The command line arguments-           -> IO [String] -- ^ Non-GLUT command line arguments-initialize prog args =-   with (1 + genericLength args) $ \argcBuf ->-   withMany withCString (prog : args) $ \argvPtrs ->-   withArray0 nullPtr argvPtrs $ \argvBuf -> do-   glutInit argcBuf argvBuf-   newArgc <- peek argcBuf-   newArgvPtrs <- peekArray (fromIntegral newArgc) argvBuf-   newArgv <- mapM peekCString newArgvPtrs-   return $ tail newArgv--foreign import CALLCONV unsafe "glutInit" glutInit ::-   Ptr CInt -> Ptr CString -> IO ()---- | Convenience action: Initialize GLUT, returning the program name and any--- non-GLUT command line arguments.--getArgsAndInitialize :: IO (String, [String])-getArgsAndInitialize = do-   prog <- getProgName-   args <- getArgs-   nonGLUTArgs <- initialize prog args-   return (prog, nonGLUTArgs)----------------------------------------------------------------------------------- | (/freeglut only/) De-initialize GLUT. After this, one has to use--- 'initialize' or 'getArgsAndInitialize' to initialize GLUT again.--exit :: IO ()-exit = glutExit--EXTENSION_ENTRY(unsafe,"freeglut",glutExit,IO ())-------------------------------------------------------------------------------------- | Controls the /initial window position/.  Windows created by--- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with--- the current /initial window position/. The initial value of the /initial--- window position/ GLUT state is @'Size' (-1) (-1)@. If either the X or Y--- component of the /initial window position/ is negative, the actual window--- position is left to the window system to determine.------ The intent of the /initial window position/ is to provide a suggestion to--- the window system for a window\'s initial position. The window system is--- not obligated to use this information. Therefore, GLUT programs should not--- assume the window was created at the specified position.--initialWindowPosition :: StateVar Position-initialWindowPosition =-   makeStateVar getInitialWindowPosition setInitialWindowPosition--getInitialWindowPosition :: IO Position-getInitialWindowPosition = do-   x <- simpleGet fromIntegral glut_INIT_WINDOW_X-   y <- simpleGet fromIntegral glut_INIT_WINDOW_Y-   return $ Position x y--setInitialWindowPosition :: Position -> IO ()-setInitialWindowPosition (Position x y) =-    glutInitWindowPosition (fromIntegral x) (fromIntegral y)--foreign import CALLCONV unsafe "glutInitWindowPosition" glutInitWindowPosition-   :: CInt -> CInt -> IO ()-------------------------------------------------------------------------------------- | Controls the /initial window size/.  Windows created by--- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with--- the current /initial window size/. The initial value of the /initial window--- size/ GLUT state is @'Size' 300 300@. If either the width or the height--- component of the /initial window size/ is non-positive, the actual window--- size is left to the window system to determine.------ The intent of the /initial window size/ is to provide a suggestion to the--- window system for a window\'s initial size. The window system is not--- obligated to use this information. Therefore, GLUT programs should not--- assume the window was created at the specified size. A GLUT program should--- use the window\'s reshape callback to determine the true size of the--- window.--initialWindowSize :: StateVar Size-initialWindowSize = makeStateVar getInitialWindowSize setInitialWindowSize--getInitialWindowSize :: IO Size-getInitialWindowSize = do-   w <- simpleGet fromIntegral glut_INIT_WINDOW_WIDTH-   h <- simpleGet fromIntegral glut_INIT_WINDOW_HEIGHT-   return $ Size w h--setInitialWindowSize :: Size -> IO ()-setInitialWindowSize (Size w h) =-   glutInitWindowSize (fromIntegral w) (fromIntegral h)--foreign import CALLCONV unsafe "glutInitWindowSize" glutInitWindowSize ::-   CInt -> CInt -> IO ()-------------------------------------------------------------------------------------- | A single aspect of a window which is to be created, used in conjunction--- with 'initialDisplayMode'.--data DisplayMode-   = RGBAMode-     -- ^ Select an RGBA mode window. This is the default if neither 'RGBAMode'-     -- nor 'IndexMode' are specified.-   | RGBMode-     -- ^ An alias for 'RGBAMode'.-   | IndexMode-     -- ^ Select a color index mode window. This overrides 'RGBAMode' if it is-     -- also specified.-   | LuminanceMode-     -- ^ Select a window with a \"luminance\" color model. This model provides-     -- the functionality of OpenGL\'s RGBA color model, but the green and blue-     -- components are not maintained in the frame buffer. Instead each pixel\'s-     -- red component is converted to an index between zero and-     --  'Graphics.UI.GLUT.Colormap.numColorMapEntries' and looked up in a-     -- per-window color map to determine the color of pixels within the window.-     -- The initial colormap of 'LuminanceMode' windows is initialized to be a-     -- linear gray ramp, but can be modified with GLUT\'s colormap actions.-     -- /Implementation Notes:/ 'LuminanceMode' is not supported on most OpenGL-     -- platforms.-   | WithAlphaComponent-     -- ^ Select a window with an alpha component to the color buffer(s).-   | WithAccumBuffer-     -- ^ Select a window with an accumulation buffer.-   | WithDepthBuffer-     -- ^ Select a window with a depth buffer.-   | WithStencilBuffer-     -- ^ Select a window with a stencil buffer.-   | WithAuxBuffers Int-     -- ^ (/freeglut only/) Select a window with /n/ (1 .. 4) auxiliary buffers.-     -- Any /n/ outside the range 1 .. 4 is a fatal error.-   | SingleBuffered-     -- ^ Select a single buffered window. This is the default if neither-     -- 'DoubleBuffered' nor 'SingleBuffered' are specified.-   | DoubleBuffered-     -- ^ Select a double buffered window. This overrides 'SingleBuffered' if it-     -- is also specified.-   | Multisampling-     -- ^ Select a window with multisampling support. If multisampling is not-     -- available, a non-multisampling window will automatically be chosen.-     -- Note: both the OpenGL client-side and server-side implementations must-     -- support the @GLX_SAMPLE_SGIS@ extension for multisampling to be-     -- available. Deprecated, use 'WithSamplesPerPixel'.-   | WithSamplesPerPixel Int-     -- ^ Select a window with multisampling, using the given samples per pixel.-   | Stereoscopic-     -- ^ Select a stereo window.-   | Captionless-     -- ^ Select a window without a caption (/freeglut only/).-   | Borderless-     -- ^ Select a window without any borders (/freeglut only/).-   deriving ( Eq, Ord, Show )--marshalDisplayMode :: DisplayMode -> CUInt-marshalDisplayMode m = case m of-   RGBAMode -> glut_RGBA-   RGBMode -> glut_RGB-   IndexMode -> glut_INDEX-   LuminanceMode -> glut_LUMINANCE-   WithAlphaComponent -> glut_ALPHA-   WithAccumBuffer -> glut_ACCUM-   WithDepthBuffer -> glut_DEPTH-   WithStencilBuffer -> glut_STENCIL-   WithAuxBuffers 1 -> glut_AUX1-   WithAuxBuffers 2 -> glut_AUX2-   WithAuxBuffers 3 -> glut_AUX3-   WithAuxBuffers 4 -> glut_AUX4-   WithAuxBuffers n ->-      error ("marshalDisplayMode: illegal number of auxiliary buffers: " ++ show n)-   SingleBuffered -> glut_SINGLE-   DoubleBuffered -> glut_DOUBLE-   Multisampling -> glut_MULTISAMPLE-   WithSamplesPerPixel _ -> error ("marshalDisplayMode: this should not happen")-   Stereoscopic -> glut_STEREO-   Captionless -> glut_CAPTIONLESS-   Borderless -> glut_BORDERLESS-------------------------------------------------------------------------------------- | Controls the /initial display mode/ used when creating top-level windows,--- subwindows, and overlays to determine the OpenGL display mode for the--- to-be-created window or overlay.------ Note that 'RGBAMode' selects the RGBA color model, but it does not request any--- bits of alpha (sometimes called an /alpha buffer/ or /destination alpha/)--- be allocated. To request alpha, specify 'WithAlphaComponent'. The same--- applies to 'LuminanceMode'.--initialDisplayMode :: StateVar [DisplayMode]-initialDisplayMode = makeStateVar getInitialDisplayMode setInitialDisplayMode--getInitialDisplayMode :: IO [DisplayMode]-getInitialDisplayMode = do-   mode <- simpleGet fromIntegral glut_INIT_DISPLAY_MODE-   let displayModes = i2dms (mode .&. complement glut_MULTISAMPLE)-   if mode .&. glut_MULTISAMPLE == 0-      then return displayModes-      else do-         n <- get samplesPerPixel-         return $ WithSamplesPerPixel n : displayModes--i2dms :: CUInt -> [DisplayMode]-i2dms bitfield | IndexMode `elem` modes || LuminanceMode `elem` modes = modes-               | otherwise = RGBAMode : modes-   where modes = i2dmsWithoutRGBA bitfield--i2dmsWithoutRGBA :: CUInt -> [DisplayMode]-i2dmsWithoutRGBA bitfield =-   [ c | c <- [ IndexMode, LuminanceMode, WithAlphaComponent,-                WithAccumBuffer, WithDepthBuffer, WithStencilBuffer,-                WithAuxBuffers 1, WithAuxBuffers 2, WithAuxBuffers 3,-                WithAuxBuffers 4, SingleBuffered, DoubleBuffered, Multisampling,-                Stereoscopic, Captionless, Borderless ]-       , (bitfield .&. marshalDisplayMode c) /= 0 ]--setInitialDisplayMode :: [DisplayMode] -> IO ()-setInitialDisplayMode modes = do-   let (spps, transformedModes) = mapAccumR handleMultisampling [] modes-   mapM_ (samplesPerPixel $=) spps-   glutInitDisplayMode (toBitfield marshalDisplayMode transformedModes)--handleMultisampling :: [Int] -> DisplayMode -> ([Int], DisplayMode)-handleMultisampling spps (WithSamplesPerPixel spp) = (spp : spps, Multisampling)-handleMultisampling spps mode                      = (spps, mode)--toBitfield :: (Bits b) => (a -> b) -> [a] -> b-toBitfield marshal = foldl (.|.) 0 . map marshal--foreign import CALLCONV unsafe "glutInitDisplayMode" glutInitDisplayMode ::-   CUInt -> IO ()---- | Contains 'True' if the /current display mode/ is supported, 'False'--- otherwise.--displayModePossible :: GettableStateVar Bool-displayModePossible =-   makeGettableStateVar $ simpleGet (/= 0) glut_DISPLAY_MODE_POSSIBLE------------------------------------------------------------------------------------samplesPerPixel :: StateVar Int-samplesPerPixel = makeStateVar getSamplesPerPixel setSamplesPerPixel--getSamplesPerPixel :: IO Int-getSamplesPerPixel = do-   m <- multisamplingSupported-   if m-      then simpleGet fromIntegral (fromIntegral glut_MULTISAMPLE)-      else return defaultSamplesPerPixels--defaultSamplesPerPixels :: Int-defaultSamplesPerPixels = 4--setSamplesPerPixel :: Int -> IO ()-setSamplesPerPixel spp = do-   m <- multisamplingSupported-   when m $-      glutSetOption (fromIntegral glut_MULTISAMPLE) (fromIntegral spp)--multisamplingSupported :: IO Bool-multisamplingSupported = isKnown "glutGetModeValues"-   where isKnown = fmap (/= nullFunPtr) . getProcAddressInternal-------------------------------------------------------------------------------------- | Capabilities for 'initialDisplayCapabilities', most of them are extensions--- of the constructors of 'DisplayMode'.--data DisplayCapability-   = DisplayRGBA  -- ^ Number of bits of red, green, blue, and alpha in the RGBA-                  --   color buffer. Default is \"'IsAtLeast' @1@\" for red,-                  --   green, blue, and alpha capabilities, and \"'IsEqualTo'-                  --   @1@\" for the RGBA color model capability.-   | DisplayRGB   -- ^ Number of bits of red, green, and blue in the RGBA color-                  --   buffer and zero bits of alpha color buffer precision.-                  --   Default is \"'IsAtLeast' @1@\" for the red, green, and-                  --   blue capabilities, and \"'IsNotLessThan' @0@\" for alpha-                  --   capability, and \"'IsEqualTo' @1@\" for the RGBA color-                  --   model capability.-   | DisplayRed   -- ^ Red color buffer precision in bits. Default is-                  --   \"'IsAtLeast' @1@\".-   | DisplayGreen -- ^ Green color buffer precision in bits. Default is-                  --   \"'IsAtLeast' @1@\".-   | DisplayBlue  -- ^ Blue color buffer precision in bits. Default is-                  --   \"'IsAtLeast' @1@\".-   | DisplayIndex -- ^ Boolean if the color model is color index or not. True is-                  --   color index. Default is \"'IsAtLeast' @1@\".-   | DisplayBuffer -- ^ Number of bits in the color index color buffer. Default-                  --   is \"'IsAtLeast' @1@\".-   | DisplaySingle -- ^ Boolean indicate the color buffer is single buffered.-                  --   Default is \"'IsEqualTo' @1@\".-   | DisplayDouble -- ^ Boolean indicating if the color buffer is double-                  --   buffered. Default is \"'IsEqualTo' @1@\".-   | DisplayAccA  -- ^ Red, green, blue, and alpha accumulation buffer precision-                  --   in  bits. Default is \"'IsAtLeast' @1@\" for red, green,-                  --   blue, and alpha capabilities.-   | DisplayAcc   -- ^ Red, green, and green accumulation buffer precision in-                  --   bits and zero bits of alpha accumulation buffer precision.-                  --   Default is \"'IsAtLeast' @1@\" for red, green, and blue-                  --   capabilities, and \"'IsNotLessThan' @0@\" for the alpha-                  --   capability.-   | DisplayAlpha -- ^ Alpha color buffer precision in bits. Default is-                  --   \"'IsAtLeast' @1@\".-   | DisplayDepth -- ^ Number of bits of precsion in the depth buffer. Default-                  --   is \"'IsAtLeast' @12@\".-   | DisplayStencil -- ^ Number of bits in the stencil buffer. Default is-                  --   \"'IsNotLessThan' @1@\".-   | DisplaySamples -- ^ Indicates the number of multisamples to use based on-                  --   GLX\'s @SGIS_multisample@ extension (for antialiasing).-                  --   Default is \"'IsNotGreaterThan' @4@\". This default means-                  --   that a GLUT application can request multisampling if-                  --   available by simply specifying \"'With' 'DisplaySamples'\".-   | DisplayStereo -- ^ Boolean indicating the color buffer is supports-                  --   OpenGL-style stereo. Default is \"'IsEqualTo' @1@\".-   | DisplayLuminance -- ^ Number of bits of red in the RGBA and zero bits of green,-                  --   blue (alpha not specified) of color buffer precision.-                  --   Default is \"'IsAtLeast' @1@\" for the red capabilitis,-                  --   and \"'IsEqualTo' @0@\" for the green and blue-                  --   capabilities, and \"'IsEqualTo' @1@\" for the RGBA color-                  --   model capability, and, for X11, \"'IsEqualTo' @1@\" for-                  --   the 'DisplayXStaticGray' capability. SGI InfiniteReality (and-                  --   other future machines) support a 16-bit luminance (single-                  --   channel) display mode (an additional 16-bit alpha channel-                  --   can also be requested). The red channel maps to gray-                  --   scale and green and blue channels are not available. A-                  --   16-bit precision luminance display mode is often-                  --   appropriate for medical imaging applications. Do not-                  --   expect many machines to support extended precision-                  --   luminance display modes.-   | DisplayAux   -- ^ (/freeglut only/) Number of auxiliary buffers. Default is-                  --   \"'IsEqualTo' @1@\".-   | DisplayNum   -- ^ A special capability name indicating where the value-                  --   represents the Nth frame buffer configuration matching-                  --   the description string. When not specified,-                  --   'initialDisplayCapabilities' also uses the first-                  --   (best matching) configuration. 'Num' requires a relation-                  --   and numeric value.-   | DisplayConformant -- ^ Boolean indicating if the frame buffer configuration is-                  --   conformant or not. Conformance information is based on-                  --   GLX\'s @EXT_visual_rating@ extension if supported. If the-                  --   extension is not supported, all visuals are assumed-                  --   conformant. Default is \"'IsEqualTo' @1@\".-   | DisplaySlow  -- ^ Boolean indicating if the frame buffer configuration is-                  --   slow or not. Slowness information is based on GLX\'s-                  --   @EXT_visual_rating@ extension if supported. If the-                  --   extension is not supported, all visuals are assumed fast.-                  --   Note that slowness is a relative designation relative to-                  --   other frame buffer configurations available. The intent-                  --   of the slow capability is to help programs avoid frame-                  --   buffer configurations that are slower (but perhaps higher-                  --   precision) for the current machine. Default is-                  --   \"'IsAtLeast' @0@\". This default means that slow visuals-                  --   are used in preference to fast visuals, but fast visuals-                  --   will still be allowed.-   | DisplayWin32PFD -- ^ Only recognized on GLUT implementations for Win32, this-                  --   capability name matches the Win32 Pixel Format Descriptor-                  --   by number. 'DisplayWin32PFD' can only be used with 'Where'.-   | DisplayXVisual -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, this capability name matches the X visual ID by-                  --   number. 'DisplayXVisual' requires a relation and numeric value.-   | DisplayXStaticGray -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @StaticGray@.-                  --   Default is \"'IsEqualTo' @1@\".-   | DisplayXGrayScale -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @GrayScale@. Default-                  --   is \"'IsEqualTo' @1@\".-   | DisplayXStaticColor -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @StaticColor@.-                  --   Default is \"'IsEqualTo' @1@\".-   | DisplayXPseudoColor -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @PsuedoColor@.-                  --   Default is \"'IsEqualTo' @1@\".-   | DisplayXTrueColor -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @TrueColor@. Default-                  --   is \"'IsEqualTo' @1@\".-   | DisplayXDirectColor -- ^ Only recongized on GLUT implementations for the X Window-                  --   System, boolean indicating if the frame buffer-                  --   configuration\'s X visual is of type @DirectColor@.-                  --   Default is \"'IsEqualTo' @1@\".-   deriving ( Eq, Ord, Show )--displayCapabilityToString :: DisplayCapability -> String-displayCapabilityToString x = case x of-   DisplayRGBA         -> "rgba"-   DisplayRGB          -> "rgb"-   DisplayRed          -> "red"-   DisplayGreen        -> "green"-   DisplayBlue         -> "blue"-   DisplayIndex        -> "index"-   DisplayBuffer       -> "buffer"-   DisplaySingle       -> "single"-   DisplayDouble       -> "double"-   DisplayAccA         -> "acca"-   DisplayAcc          -> "acc"-   DisplayAlpha        -> "alpha"-   DisplayDepth        -> "depth"-   DisplayStencil      -> "stencil"-   DisplaySamples      -> "samples"-   DisplayStereo       -> "stereo"-   DisplayLuminance    -> "luminance"-   DisplayAux          -> "aux"-   DisplayNum          -> "num"-   DisplayConformant   -> "conformant"-   DisplaySlow         -> "slow"-   DisplayWin32PFD     -> "win32pfd"-   DisplayXVisual      -> "xvisual"-   DisplayXStaticGray  -> "xstaticgray"-   DisplayXGrayScale   -> "xgrayscale"-   DisplayXStaticColor -> "xstaticcolor"-   DisplayXPseudoColor -> "xpseudocolor"-   DisplayXTrueColor   -> "xtruecolor"-   DisplayXDirectColor -> "xdirectcolor"---- | A single capability description for 'initialDisplayCapabilities'.--data DisplayCapabilityDescription-   = Where DisplayCapability Relation Int-     -- ^ A description of a capability with a specific relation to a numeric-     --   value.-   | With  DisplayCapability-     -- ^ When the relation and numeric value are not specified, each capability-     --   has a different default, see the different constructors of-     --   'DisplayCapability'.-   deriving ( Eq, Ord, Show )--displayCapabilityDescriptionToString ::  DisplayCapabilityDescription -> String-displayCapabilityDescriptionToString (Where c r i) =-   displayCapabilityToString c ++ relationToString r ++ show i-displayCapabilityDescriptionToString (With c) = displayCapabilityToString c---- | Controls the /initial display mode/ used when creating top-level windows,--- subwindows, and overlays to determine the OpenGL display mode for the--- to-be-created window or overlay. It is described by a list of zero or more--- capability descriptions, which are translated into a set of criteria used to--- select the appropriate frame buffer configuration. The criteria are matched--- in strict left to right order of precdence. That is, the first specified--- criterion (leftmost) takes precedence over the later criteria for non-exact--- criteria ('IsGreaterThan', 'IsLessThan', etc.). Exact criteria ('IsEqualTo',--- 'IsNotEqualTo') must match exactly so precedence is not relevant.------ Unspecified capability descriptions will result in unspecified criteria being--- generated. These unspecified criteria help 'initialDisplayCapabilities'--- behave sensibly with terse display mode descriptions.------ Here is an example using 'initialDisplayCapabilities':------ @---    initialDisplayCapabilities $= [ With  DisplayRGB,---                                    Where DisplayDepth IsAtLeast 16,---                                    With  DisplaySamples,---                                    Where DisplayStencil IsNotLessThan 2,---                                    With  DisplayDouble ]--- @------ The above call requests a window with an RGBA color model (but requesting--- no bits of alpha), a depth buffer with at least 16 bits of precision but--- preferring more, multisampling if available, at least 2 bits of stencil--- (favoring less stencil to more as long as 2 bits are available), and double--- buffering.--initialDisplayCapabilities :: SettableStateVar [DisplayCapabilityDescription]-initialDisplayCapabilities =-   makeSettableStateVar $ \caps ->-      withCString-         (concat . intersperse " " . map displayCapabilityDescriptionToString $-          caps)-         glutInitDisplayString--foreign import CALLCONV unsafe "glutInitDisplayString" glutInitDisplayString ::-  CString -> IO ()----------------------------------------------------------------------------------- | How rendering context for new windows are created.--data RenderingContext-   = -- | Create a new context via @glXCreateContext@ or @wglCreateContext@-     --   (default).-     CreateNewContext-   | -- | Re-use the current rendering context.-     UseCurrentContext-   deriving ( Eq, Ord, Show )--marshalRenderingContext :: RenderingContext -> CInt-marshalRenderingContext CreateNewContext  = glut_CREATE_NEW_CONTEXT-marshalRenderingContext UseCurrentContext = glut_USE_CURRENT_CONTEXT--unmarshalRenderingContext :: CInt -> RenderingContext-unmarshalRenderingContext r-   | r == glut_CREATE_NEW_CONTEXT  = CreateNewContext-   | r == glut_USE_CURRENT_CONTEXT = UseCurrentContext-   | otherwise = error "unmarshalRenderingContext"----------------------------------------------------------------------------------- | (/freeglut only/) Controls the creation of rendering contexts for new--- windows.--renderingContext :: StateVar RenderingContext-renderingContext =-   makeStateVar-      (simpleGet unmarshalRenderingContext glut_RENDERING_CONTEXT)-      (glutSetOption glut_RENDERING_CONTEXT . marshalRenderingContext)----------------------------------------------------------------------------------- | The kind of GLX rendering context used. Direct rendering provides a--- performance advantage in some implementations. However, direct rendering--- contexts cannot be shared outside a single process, and they may be unable--- to render to GLX pixmaps.--data DirectRendering-   = -- | Rendering is always done through the X server. This corresponds to-     -- the command line argument @-indirect@, see 'initialize'.-     ForceIndirectContext-   | -- | Try to use direct rendering, silently using indirect rendering if this-     -- is not possible.-     AllowDirectContext-   | -- | Try to use direct rendering, issue a warning and use indirect-     -- rendering if this is not possible.-     TryDirectContext-   | -- | Try to use direct rendering, issue an error and terminate the program-     -- if this is not possible.This corresponds to the command line argument-     -- @-direct@, see 'initialize'.-     ForceDirectContext-   deriving ( Eq, Ord, Show )--marshalDirectRendering :: DirectRendering -> CInt-marshalDirectRendering x = case x of-   ForceIndirectContext -> glut_FORCE_INDIRECT_CONTEXT-   AllowDirectContext -> glut_ALLOW_DIRECT_CONTEXT-   TryDirectContext -> glut_TRY_DIRECT_CONTEXT-   ForceDirectContext -> glut_FORCE_DIRECT_CONTEXT--unmarshalDirectRendering :: CInt -> DirectRendering-unmarshalDirectRendering x-   | x == glut_FORCE_INDIRECT_CONTEXT = ForceIndirectContext-   | x == glut_ALLOW_DIRECT_CONTEXT = AllowDirectContext-   | x == glut_TRY_DIRECT_CONTEXT = TryDirectContext-   | x == glut_FORCE_DIRECT_CONTEXT = ForceDirectContext-   | otherwise = error ("unmarshalDirectRendering: illegal value " ++ show x)----------------------------------------------------------------------------------- | (/freeglut on X11 only/) Controls which kind of rendering context is--- created when a new one is required.--directRendering :: StateVar DirectRendering-directRendering =-   makeStateVar-      (simpleGet unmarshalDirectRendering glut_DIRECT_RENDERING)-      (glutSetOption glut_DIRECT_RENDERING . marshalDirectRendering)----------------------------------------------------------------------------------- | (/freeglut only/) Controls the API major\/minor version of the OpenGL--- context. If a version less than or equal to 2.1 is requested, the context--- returned may implement any version no less than that requested and no--- greater than 2.1. If version 3.0 is requested, the context returned must--- implement exactly version 3.0. Versioning behavior once GL versions beyond--- 3.0 are defined will be defined by an amendment to the OpenGL specification--- to define dependencies on such GL versions.------ 'Graphics.Rendering.OpenGL.GL.StringQueries.glVersion' and--- 'Graphics.Rendering.OpenGL.GL.StringQueries.majorMinor' will return the--- actual version supported by a context.------ The default context version is (1, 0), which will typically return an--- OpenGL 2.1 context, if one is available.--initialContextVersion :: StateVar (Int, Int)-initialContextVersion = makeStateVar getContextVersion setContextVersion--getContextVersion :: IO (Int, Int)-getContextVersion = do-   major <- simpleGet fromIntegral glut_INIT_MAJOR_VERSION-   minor <- simpleGet fromIntegral glut_INIT_MINOR_VERSION-   return (major, minor)--setContextVersion :: (Int, Int) -> IO ()-setContextVersion (major, minor) =-   glutInitContextVersion (fromIntegral major) (fromIntegral minor)--EXTENSION_ENTRY(unsafe,"freeglut",glutInitContextVersion,CInt -> CInt -> IO ())----------------------------------------------------------------------------------- | A flag affecting the rendering context to create, used in conjunction--- with 'initialContextFlags'.--data ContextFlag-   = -- | Debug contexts are intended for use during application development,-     -- and provide additional runtime checking, validation, and logging-     -- functionality while possibly incurring performance penalties. The-     -- additional functionality provided by debug contexts may vary according-     -- to the implementation. In some cases a debug context may be identical-     -- to a non-debug context.-     DebugContext-   | -- | Forward-compatible contexts are defined only for OpenGL versions 3.0-     -- and later. They must not support functionality marked as /deprecated/-     -- by that version of the API, while a non-forward-compatible context must-     -- support all functionality in that version, deprecated or not.-     ForwardCompatibleContext-   deriving ( Eq, Ord, Show )--marshalContextFlag :: ContextFlag -> CInt-marshalContextFlag x = case x of-   DebugContext -> glut_DEBUG-   ForwardCompatibleContext -> glut_FORWARD_COMPATIBLE----------------------------------------------------------------------------------- | (/freeglut only/) Controls the set of flags for the rendering context.--initialContextFlags :: StateVar [ContextFlag]-initialContextFlags = makeStateVar getContextFlags setContextFlags--getContextFlags :: IO [ContextFlag]-getContextFlags = simpleGet i2cfs glut_INIT_FLAGS--i2cfs :: CInt -> [ContextFlag]-i2cfs bitfield =-   [ c | c <- [ DebugContext, ForwardCompatibleContext ]-       , (fromIntegral bitfield .&. marshalContextFlag c) /= 0 ]--setContextFlags :: [ContextFlag] -> IO ()-setContextFlags = glutInitContextFlags . toBitfield marshalContextFlag--EXTENSION_ENTRY(unsafe,"freeglut",glutInitContextFlags,CInt -> IO ())
− Graphics/UI/GLUT/Menu.hs 
@@ -1,310 +0,0 @@-{-# OPTIONS_GHC -fno-cse #-}------------------------------------------------------------------------------------- |--- Module      :  Graphics.UI.GLUT.Menu--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT supports simple cascading pop-up menus. They are designed to let a user--- select various modes within a program. The functionality is simple and--- minimalistic and is meant to be that way. Do not mistake GLUT\'s pop-up menu--- facility with an attempt to create a full-featured user interface.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Menu (-   Menu(..), MenuItem(..), MenuCallback, attachMenu,-   numMenuItems-) where--import Data.Array ( listArray, (!) )-import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )-import qualified Data.Map as Map ( empty, lookup, insert, delete )-import Data.Map ( Map )-import Foreign.C.String ( CString, withCString )-import Foreign.C.Types ( CInt )-import Foreign.Ptr ( FunPtr, freeHaskellFunPtr )-import Control.Monad ( unless, zipWithM, when )-import System.IO.Unsafe ( unsafePerformIO )-import Graphics.Rendering.OpenGL.GL.StateVar (-   HasGetter(get), HasSetter(($=)),-   GettableStateVar, makeGettableStateVar,-   StateVar, makeStateVar )-import Graphics.UI.GLUT.Constants ( glut_MENU_NUM_ITEMS )-import Graphics.UI.GLUT.QueryUtils ( simpleGet )-import Graphics.UI.GLUT.Types ( marshalMouseButton )-import Graphics.UI.GLUT.Window ( Window )-import Graphics.UI.GLUT.Callbacks.Registration ( getCurrentWindow )-import Graphics.UI.GLUT.Callbacks.Window ( MouseButton )-------------------------------------------------------------------------------------- | A menu is simply a list of menu items.-newtype Menu = Menu [MenuItem]---- | A single item within a menu can either be a plain menu entry or a sub-menu--- entry, allowing for arbitrarily deep nested menus.-data MenuItem-   = MenuEntry String MenuCallback -- ^ A plain menu entry with an associated-                                   --   callback, which is triggered when the-                                   --   user selects the entry-   | SubMenu   String Menu         -- ^ A sub-menu, which is cascaded when the-                                   --   user selects the entry, allowing-                                   --   sub-menu entries to be selected--type MenuCallback = IO ()---- | Create a new pop-up menu for the /current window,/ attaching it to the--- given mouse button. A previously attached menu (if any), is detached before--- and won\'t receive callbacks anymore.------ It is illegal to call 'attachMenu' while any (sub-)menu is in use, i.e.--- popped up.------ /X Implementation Notes:/ If available, GLUT for X will take advantage of--- overlay planes for implementing pop-up menus. The use of overlay planes can--- eliminate display callbacks when pop-up menus are deactivated. The--- @SERVER_OVERLAY_VISUALS@ convention is used to determine if overlay visuals--- are available.--attachMenu :: MouseButton -> Menu -> IO ()-attachMenu mouseButton menu@(Menu items) = do-   win <- getCurrentWindow "attachMenu"-   let hook = MenuHook win mouseButton-   detachMenu hook-   unless (null items) $ do-      (_, destructor) <- traverseMenu menu-      addToMenuTable hook destructor-      attachMenu_ mouseButton--detachMenu :: MenuHook -> IO ()-detachMenu hook@(MenuHook _ mouseButton) = do-   maybeDestructor <- lookupInMenuTable hook-   case maybeDestructor of-      Nothing         -> return ()-      Just destructor -> do detachMenu_ mouseButton-                            destructor-   deleteFromMenuTable hook--traverseMenu :: Menu -> IO (MenuID, Destructor)-traverseMenu (Menu items) = do-   let callbackArray = listArray (1, length items) (map makeCallback items)-   cb <- makeMenuFunc (\i -> callbackArray ! (fromIntegral i))-   menuID <- glutCreateMenu cb-   destructors <- zipWithM addMenuItem items [1..]-   let destructor = do sequence_ destructors-                       glutDestroyMenu menuID-                       freeHaskellFunPtr cb-   return (menuID, destructor)--makeCallback :: MenuItem -> MenuCallback-makeCallback (MenuEntry _ cb) = cb-makeCallback _ = error "shouldn't receive a callback for submenus"--addMenuItem :: MenuItem -> Value -> IO Destructor-addMenuItem (MenuEntry s _) v = do-   addMenuEntry s v-   return $ glutRemoveMenuItem 1-addMenuItem (SubMenu s m) _ = do-   (menuID, destructor) <- saveExcursion (traverseMenu m)-   addSubMenu s menuID-   return $ do glutRemoveMenuItem 1-               destructor---- Perform an action, saving/restoring the current menu around it-saveExcursion :: IO a -> IO a-saveExcursion act = do-   menuID <- get currentMenu-   returnValue <- act-   when (isRealMenu menuID) $-      currentMenu $= menuID-   return returnValue------------------------------------------------------------------------------------- This seems to be a common Haskell hack nowadays: A plain old global variable--- with an associated mutator. Perhaps some language/library support is needed?--{-# NOINLINE theMenuTable #-}-theMenuTable :: IORef MenuTable-theMenuTable = unsafePerformIO (newIORef emptyMenuTable)--getMenuTable :: IO MenuTable-getMenuTable = readIORef theMenuTable--modifyMenuTable :: (MenuTable -> MenuTable) -> IO ()-modifyMenuTable = modifyIORef theMenuTable------------------------------------------------------------------------------------- To facilitate cleanup, we have to keep track how to destroy menus which are--- currently attached in a window to a mouse button.--data MenuHook = MenuHook Window MouseButton-   deriving ( Eq, Ord )--type Destructor = IO ()--type MenuTable = Map MenuHook Destructor--emptyMenuTable :: MenuTable-emptyMenuTable = Map.empty--lookupInMenuTable :: MenuHook -> IO (Maybe Destructor)-lookupInMenuTable callbackID =-   fmap (Map.lookup callbackID) getMenuTable--deleteFromMenuTable :: MenuHook -> IO ()-deleteFromMenuTable callbackID =-   modifyMenuTable (Map.delete callbackID)--addToMenuTable :: MenuHook -> Destructor -> IO ()-addToMenuTable callbackID funPtr =-   modifyMenuTable (Map.insert callbackID funPtr)------------------------------------------------------------------------------------type MenuID = CInt-type Value  = CInt-type Item   = CInt-------------------------------------------------------------------------------------- | The type of a menu callback action that is called when a menu entry from a--- menu is selected. The value passed to the callback is determined by the value--- for the selected menu entry.--type MenuCB = CInt -> IO ()---- | Create a new pop-up menu and return a unique identifier for it, which can--- be used when setting 'currentMenu'. Implicitly, the /current menu/ is set to--- the newly created menu.------ When the menu callback is called because a menu entry is selected for the--- menu, the /current menu/ will be implicitly set to the menu with the selected--- entry before the callback is made.------ /X Implementation Notes:/ If available, GLUT for X will take advantage of--- overlay planes for implementing pop-up menus. The use of overlay planes can--- eliminate display callbacks when pop-up menus are deactivated. The--- @SERVER_OVERLAY_VISUALS@ convention is used to determine if overlay visuals--- are available.--foreign import CALLCONV unsafe "glutCreateMenu" glutCreateMenu ::-   FunPtr MenuCB -> IO MenuID--foreign import ccall "wrapper" makeMenuFunc :: MenuCB -> IO (FunPtr MenuCB)---- | Destroy the specified menu. If it was the /current menu/, the /current--- menu/ becomes invalid and 'currentMenu' will contain 'Nothing'.--foreign import CALLCONV unsafe "glutDestroyMenu" glutDestroyMenu ::-   MenuID -> IO ()-------------------------------------------------------------------------------------- | Controls the /current menu./ If no menus exist or the previous /current--- menu/ was destroyed, a pseudo menu is returned, see 'isRealMenu'.--currentMenu :: StateVar MenuID-currentMenu = makeStateVar glutGetMenu glutSetMenu--foreign import CALLCONV unsafe "glutSetMenu" glutSetMenu :: MenuID -> IO ()--foreign import CALLCONV unsafe "glutGetMenu" glutGetMenu :: IO MenuID---- | Returns 'True' if the given menu identifier refers to a real menu, not--- a pseudo one.--isRealMenu :: MenuID -> Bool-isRealMenu = (/= 0)-------------------------------------------------------------------------------------- | Add a menu entry to the bottom of the /current menu./ The given string will--- be displayed for the newly added menu entry. If the menu entry is selected by--- the user, the menu\'s callback will be called passing the given value as the--- callback\'s parameter.--addMenuEntry :: String -> Value -> IO ()-addMenuEntry name value = withCString name $ \n -> glutAddMenuEntry n value--foreign import CALLCONV unsafe "glutAddMenuEntry" glutAddMenuEntry ::-   CString -> Value -> IO ()---- | Add a sub-menu trigger to the bottom of the /current menu./ The given--- string will be displayed for the newly added sub-menu trigger. If the--- sub-menu trigger is entered, the sub-menu specified by the given menu--- identifier will be cascaded, allowing sub-menu menu items to be selected.--addSubMenu :: String -> MenuID -> IO ()-addSubMenu name menuID = withCString name $ \n -> glutAddSubMenu n menuID--foreign import CALLCONV unsafe "glutAddSubMenu" glutAddSubMenu ::-   CString -> MenuID -> IO ()------------------------------------------------------------------------------------{- UNUSED--- | Change the specified menu entry in the /current menu/ into a menu entry.--- The given position determines which menu item should be changed and must be--- between 1 (the topmost menu item) and--- 'Graphics.UI.GLUT.State.getNumMenuItems' inclusive. The menu item to change--- does not have to be a menu entry already. The given string will be displayed--- for the newly changed menu entry. The given value will be returned to the--- menu\'s callback if this menu entry is selected.--foreign import CALLCONV unsafe "glutChangeToMenuEntry" glutChangeToMenuEntry ::-   Item -> CString -> Value -> IO ()---- | Change the specified menu item in the /current menu/ into a sub-menu--- trigger. The  given position determines which menu item should be changed and--- must be between 1 and 'Graphics.UI.GLUT.State.getNumMenuItems' inclusive. The--- menu item to change does not have to be a sub-menu trigger already. The--- given name will be displayed for the newly changed sub-menu trigger. The--- given menu identifier names the sub-menu to cascade from the newly added--- sub-menu trigger.--foreign import CALLCONV unsafe "glutChangeToSubMenu" glutChangeToSubMenu ::-   Item -> CString -> MenuID -> IO ()--}-------------------------------------------------------------------------------------- | Remove the menu item at the given position, regardless of whether it is a--- menu entry or sub-menu trigger. The position must be between 1 (the topmost--- menu item) and 'Graphics.UI.GLUT.State.getNumMenuItems' inclusive. Menu items--- below the removed menu item are renumbered.--foreign import CALLCONV unsafe "glutRemoveMenuItem" glutRemoveMenuItem ::-   Item -> IO ()-------------------------------------------------------------------------------------- | Attach a mouse button for the /current window/ to the identifier of the--- /current menu./ By attaching a menu identifier to a button, the named menu--- will be popped up when the user presses the specified button. Note that the--- menu is attached to the button by identifier, not by reference.---attachMenu_ :: MouseButton -> IO ()-attachMenu_ = glutAttachMenu . marshalMouseButton--foreign import CALLCONV unsafe "glutAttachMenu" glutAttachMenu :: CInt -> IO ()---- | Detach an attached mouse button from the /current window./--detachMenu_ :: MouseButton -> IO ()-detachMenu_ = glutDetachMenu . marshalMouseButton--foreign import CALLCONV unsafe "glutDetachMenu" glutDetachMenu :: CInt -> IO ()-------------------------------------------------------------------------------------- | Contains the number of menu items in the /current menu./--numMenuItems :: GettableStateVar Int-numMenuItems = makeGettableStateVar $ simpleGet fromIntegral glut_MENU_NUM_ITEMS
− Graphics/UI/GLUT/Objects.hs 
@@ -1,342 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Objects--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT includes a number of routines for generating easily recognizable 3D--- geometric objects. These routines reflect functionality available in the--- @aux@ toolkit described in the /OpenGL Programmer\'s Guide/ and are included--- in GLUT to allow the construction of simple GLUT programs that render--- recognizable objects. These routines can be implemented as pure OpenGL--- rendering routines. The routines do not generate display lists for the--- objects they create. The routines generate normals appropriate for lighting--- but do not generate texture coordinates (except for the teapot).--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Objects (-   -- * Rendering flavour-   Flavour(..),--   -- * Object description-   Object(..),--   -- * Type synonyms-   Sides, Rings, NumLevels,--   -- * Rendering-   renderObject-) where--import Foreign.C.Types ( CInt )-import Foreign.Marshal.Utils ( with )-import Foreign.Ptr ( Ptr )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLint, GLdouble )-import Graphics.Rendering.OpenGL.GL.VertexSpec ( Vertex3(..) )-import Graphics.Rendering.OpenGL.GLU.Quadrics ( Radius, Height, Slices, Stacks )-import Graphics.UI.GLUT.Extensions------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- | Flavour of object rendering--data Flavour-   = -- | Object is rendered as a solid with shading and surface normals.-     Solid-   | -- | Object is rendered as a wireframe without surface normals.-     Wireframe-   deriving ( Eq, Ord, Show )-------------------------------------------------------------------------------------- | GLUT offers five types of objects:------ *  The five Platonic solids, see---    <http://mathworld.wolfram.com/PlatonicSolid.html>.------ * A rhombic dodecahedron, see---   <http://mathworld.wolfram.com/RhombicDodecahedron.html>.------ * Approximations to rounded objects.------ * The classic teapot modeled by Martin Newell in 1975. Both surface normals---   and texture coordinates for the teapot are generated. The teapot is---   generated with OpenGL evaluators.------ * A Sierpinski sponge, see---   <http://mathworld.wolfram.com/Tetrix.html>.--data Object-   = -- | A cube centered at the modeling coordinates origin with sides of the-     --   given length.-     Cube Height-   | -- | A dodecahedron (12-sided regular solid) centered at the modeling-     --   coordinates origin with a radius of @sqrt 3@.-     Dodecahedron-   | -- | A icosahedron (20-sided regular solid) centered at the modeling-     --   coordinates origin with a radius of 1.0.-     Icosahedron-   | -- | Render a solid octahedron (8-sided regular solid) centered at the-     --   modeling coordinates origin with a radius of 1.0.-     Octahedron-   | -- | Render a solid tetrahedron (4-sided regular solid) centered at the-     --   modeling coordinates origin with a radius of @sqrt 3@.-     Tetrahedron-   | -- | (/freeglut only/) A rhombic dodecahedron whose corners are at most a-     -- distance of one from the origin. The rhombic dodecahedron has faces-     -- which are identical rhombi, but which have some vertices at which three-     -- faces meet and some vertices at which four faces meet. The length of-     -- each side is @(sqrt 3)\/2@. Vertices at which four faces meet are found-     -- at @(0, 0, +\/-1)@ and @(+\/-(sqrt 2)\/2, +\/-(sqrt 2)\/2, 0)@.-     RhombicDodecahedron-   | -- | A sphere centered at the modeling coordinates origin of the specified-     --   radius. The sphere is subdivided around the Z axis into slices-     --   (similar to lines of longitude) and along the Z axis into stacks-     --   (similar to lines of latitude).-     Sphere' Radius Slices Stacks-   | -- | A cone oriented along the Z axis. The base of the cone is placed at Z-     --   = 0, and the top at Z = the given height. The cone is subdivided-     --   around the Z axis into slices, and along the Z axis into stacks.-     Cone Radius Height Slices Stacks-   | -- |(/freeglut only/) A cylinder oriented along the Z axis. The base of the-     --  cylinder is placed at Z = 0, and the top at Z = the given height. The-     --  cylinder is subdivided around the Z axis into slices, and along the Z-     -- axis into stacks.-     Cylinder' Radius Height Slices Stacks-   | -- | A torus (doughnut) centered at the modeling coordinates origin-     -- whose axis is aligned with the Z axis. The torus is described by its-     -- inner and outer radius, the number of sides for each radial section,-     -- and the number of radial divisions (rings).-     Torus Radius Radius Sides Rings-   | -- | A teapot with a given relative size.-     Teapot Height-   | -- |(/freeglut only/) A Sierpinski sponge of a given level, where a level-     -- 0 sponge is the same as a 'Tetrahedron'.-     SierpinskiSponge NumLevels-   deriving ( Eq, Ord, Show )------------------------------------------------------------------------------------type Sides     = GLint-type Rings     = GLint-type NumLevels = GLint-------------------------------------------------------------------------------------- | Render an object in the given flavour.--renderObject :: Flavour -> Object -> IO ()-renderObject Solid     (Cube h)             = solidCube h-renderObject Wireframe (Cube h)             = wireCube  h-renderObject Solid     Dodecahedron         = solidDodecahedron-renderObject Wireframe Dodecahedron         = wireDodecahedron-renderObject Solid     Icosahedron          = solidIcosahedron-renderObject Wireframe Icosahedron          = wireIcosahedron-renderObject Solid     Octahedron           = solidOctahedron-renderObject Wireframe Octahedron           = wireOctahedron-renderObject Solid     Tetrahedron          = solidTetrahedron-renderObject Wireframe Tetrahedron          = wireTetrahedron-renderObject Solid     RhombicDodecahedron  = glutSolidRhombicDodecahedron-renderObject Wireframe RhombicDodecahedron  = glutWireRhombicDodecahedron-renderObject Solid     (Sphere' r s t)      = solidSphere r s t-renderObject Wireframe (Sphere' r s t)      = wireSphere  r s t-renderObject Solid     (Cone r h s t)       = solidCone r h s t-renderObject Wireframe (Cone r h s t)       = wireCone  r h s t-renderObject Solid     (Cylinder' r h s t)  = glutSolidCylinder r h s t-renderObject Wireframe (Cylinder' r h s t)  = glutWireCylinder r h s t-renderObject Solid     (Torus i o s r)      = solidTorus i o s r-renderObject Wireframe (Torus i o s r)      = wireTorus  i o s r-renderObject Solid     (Teapot h)           = solidTeapot h-renderObject Wireframe (Teapot h)           = wireTeapot  h-renderObject Solid     (SierpinskiSponge n) = solidSierpinskiSponge n-renderObject Wireframe (SierpinskiSponge n) = wireSierpinskiSponge n-------------------------------------------------------------------------------------- | Render a solid cube centered at the modeling coordinates origin with sides--- of the given length.--foreign import CALLCONV unsafe "glutSolidCube" solidCube-   :: Height -- ^ Length of the cube sides-   -> IO ()---- | Render a wireframe cube centered at the modeling coordinates origin with--- sides of the given length.--foreign import CALLCONV unsafe "glutWireCube" wireCube-   :: Height -- ^ Length of the cube sides-   -> IO ()-------------------------------------------------------------------------------------- | Render a solid dodecahedron (12-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--foreign import CALLCONV unsafe "glutSolidDodecahedron" solidDodecahedron ::-   IO ()---- | Render a wireframe dodecahedron (12-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--foreign import CALLCONV unsafe "glutWireDodecahedron" wireDodecahedron :: IO ()-------------------------------------------------------------------------------------- | Render a solid icosahedron (20-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--foreign import CALLCONV unsafe "glutWireIcosahedron" wireIcosahedron :: IO ()---- | Render a wireframe icosahedron (20-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--foreign import CALLCONV unsafe "glutSolidIcosahedron" solidIcosahedron :: IO ()-------------------------------------------------------------------------------------- | Render a solid octahedron (8-sided regular solid) centered at the modeling--- coordinates origin with a radius of 1.0.--foreign import CALLCONV unsafe "glutSolidOctahedron" solidOctahedron :: IO ()---- | Render a wireframe octahedron (8-sided regular solid) centered at the--- modeling coordinates origin with a radius of 1.0.--foreign import CALLCONV unsafe "glutWireOctahedron" wireOctahedron :: IO ()-------------------------------------------------------------------------------------- | Render a solid tetrahedron (4-sided regular solid) centered at the modeling--- coordinates origin with a radius of @sqrt 3@.--foreign import CALLCONV unsafe "glutWireTetrahedron" wireTetrahedron :: IO ()---- | Render a wireframe tetrahedron (4-sided regular solid) centered at the--- modeling coordinates origin with a radius of @sqrt 3@.--foreign import CALLCONV unsafe "glutSolidTetrahedron" solidTetrahedron  :: IO ()------------------------------------------------------------------------------------EXTENSION_ENTRY(unsafe,"freeglut",glutSolidRhombicDodecahedron,IO ())--EXTENSION_ENTRY(unsafe,"freeglut",glutWireRhombicDodecahedron,IO ())-------------------------------------------------------------------------------------- | Render a solid sphere centered at the modeling coordinates origin of the--- specified radius. The sphere is subdivided around the Z axis into slices--- and along the Z axis into stacks.--foreign import CALLCONV unsafe "glutSolidSphere" solidSphere-   :: Radius   -- ^ Radius of the sphere.-   -> Slices   -- ^ Number of subdivisions (slices) around the Z axis, similar-               --   to lines of longitude.-   -> Stacks   -- ^ The number of subdivisions (stacks) along the Z axis,-               --   similar to lines of latitude.-   -> IO ()---- | Render a wireframe sphere centered at the modeling coordinates origin of--- the specified radius. The sphere is subdivided around the Z axis into slices--- and along the Z axis into stacks.--foreign import CALLCONV unsafe "glutWireSphere" wireSphere-   :: Radius   -- ^ Radius of the sphere.-   -> Slices   -- ^ Number of subdivisions (slices) around the Z axis, similar-               --   to lines of longitude.-   -> Stacks   -- ^ The number of subdivisions (stacks) along the Z axis,-               --   similar to lines of latitude.-   -> IO ()-------------------------------------------------------------------------------------- | Render a solid cone oriented along the Z axis. The base of the cone is--- placed at Z = 0, and the top at Z = height. The cone is subdivided around the--- Z axis into slices, and along the Z axis into stacks.--foreign import CALLCONV unsafe "glutSolidCone" solidCone-   :: Radius   -- ^ Radius of the base of the cone.-   -> Height   -- ^ Height of the cone.-   -> Slices   -- ^ Number of subdivisions around the Z axis.-   -> Stacks   -- ^ The number of subdivisions along the Z axis.-   -> IO ()---- | Render a wireframe cone oriented along the Z axis. The base of the cone is--- placed at Z = 0, and the top at Z = height. The cone is subdivided around the--- Z axis into slices, and along the Z axis into stacks.--foreign import CALLCONV unsafe "glutWireCone" wireCone-   :: Radius   -- ^ Radius of the base of the cone.-   -> Height   -- ^ Height of the cone.-   -> Slices   -- ^ Number of subdivisions around the Z axis.-   -> Stacks   -- ^ The number of subdivisions along the Z axis.-   -> IO ()------------------------------------------------------------------------------------EXTENSION_ENTRY(unsafe,"freeglut",glutSolidCylinder,Radius -> Height -> Slices -> Stacks -> IO ())--EXTENSION_ENTRY(unsafe,"freeglut",glutWireCylinder,Radius -> Height -> Slices -> Stacks -> IO ())-------------------------------------------------------------------------------------- | Render a solid torus (doughnut) centered at the modeling coordinates origin--- whose axis is aligned with the Z axis.--foreign import CALLCONV unsafe "glutSolidTorus" solidTorus-   :: Radius   -- ^ Inner radius of the torus.-   -> Radius   -- ^ Outer radius of the torus.-   -> Slices   -- ^ Number of sides for each radial section.-   -> Stacks   -- ^ Number of radial divisions for the torus.-   -> IO ()---- | Render a wireframe torus (doughnut) centered at the modeling coordinates--- origin whose axis is aligned with the Z axis.--foreign import CALLCONV unsafe "glutWireTorus" wireTorus-   :: Radius   -- ^ Inner radius of the torus.-   -> Radius   -- ^ Outer radius of the torus.-   -> Slices   -- ^ Number of sides for each radial section.-   -> Stacks   -- ^ Number of radial divisions for the torus.-   -> IO ()-------------------------------------------------------------------------------------- | Render a solid teapot.--foreign import CALLCONV unsafe "glutSolidTeapot" solidTeapot-   :: Height -- ^ Relative size of the teapot-   -> IO ()---- | Render a wireframe teapot.--foreign import CALLCONV unsafe "glutWireTeapot" wireTeapot-   :: Height -- ^ Relative size of the teapot-   -> IO ()------------------------------------------------------------------------------------solidSierpinskiSponge :: NumLevels -> IO ()-solidSierpinskiSponge = sierpinskiSponge glutSolidSierpinskiSponge--EXTENSION_ENTRY(unsafe,"freeglut",glutSolidSierpinskiSponge,CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ())--wireSierpinskiSponge :: NumLevels -> IO ()-wireSierpinskiSponge = sierpinskiSponge glutWireSierpinskiSponge--EXTENSION_ENTRY(unsafe,"freeglut",glutWireSierpinskiSponge,CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ())---- for consistency, we hide the offset and scale on the Haskell side-sierpinskiSponge :: (CInt -> Ptr (Vertex3 GLdouble) -> Height -> IO ()) -> NumLevels -> IO ()-sierpinskiSponge f n =-   with (Vertex3 0 0 0) $ \offsetBuf ->-      f (fromIntegral n) offsetBuf 1
− Graphics/UI/GLUT/Overlay.hs 
@@ -1,191 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Overlay--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ When  overlay hardware is available, GLUT provides a set of routines for--- establishing, using, and removing an overlay for GLUT windows. When an--- overlay is established, a separate OpenGL context is also established. A--- window\'s overlay OpenGL state is kept distinct from the normal planes\'--- OpenGL state.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Overlay (-   -- * Overlay creation and destruction-   hasOverlay, overlayPossible,--   -- * Showing and hiding an overlay-   overlayVisible,--   -- * Changing the /layer in use/-   Layer(..), layerInUse,--   -- * Re-displaying-   postOverlayRedisplay-) where--import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar )-import Graphics.UI.GLUT.Constants (-   glut_OVERLAY_POSSIBLE, glut_HAS_OVERLAY, glut_NORMAL, glut_OVERLAY,-   glut_LAYER_IN_USE )-import Graphics.UI.GLUT.QueryUtils ( layerGet )-#ifdef __NHC__-import NHC.FFI ( CInt )-#endif-import Graphics.UI.GLUT.Window ( Window )-------------------------------------------------------------------------------------- | Controls the overlay for the /current window/. The requested display mode--- for the overlay is determined by the /initial display mode/.--- 'overlayPossible' can be used to determine if an overlay is possible for the--- /current window/ with the current /initial display mode/. Do not attempt to--- establish an overlay when one is not possible; GLUT will terminate the--- program.------ When 'hasOverlay' is set to 'True' when an overlay already exists, the--- existing overlay is first removed, and then a new overlay is established. The--- state of the old overlay\'s OpenGL context is discarded. Implicitly, the--- window\'s /layer in use/ changes to the overlay immediately after the overlay--- is established.------ The initial display state of an overlay is shown, however the overlay is only--- actually shown if the overlay\'s window is shown.------ Setting 'hasOverlay' to 'False' is safe even if no overlay is currently--- established, nothing happens in this case. Implicitly, the window\'s /layer--- in use/ changes to the normal plane immediately once the overlay is removed.------ If the program intends to re-establish the overlay later, it is typically--- faster and less resource intensive to use 'overlayVisible' to simply change--- the display status of the overlay.------ /X Implementation Notes:/ GLUT for X uses the @SERVER_OVERLAY_VISUALS@--- convention to determine if overlay visuals are available. While the--- convention allows for opaque overlays (no transparency) and overlays with the--- transparency specified as a bitmask, GLUT overlay management only provides--- access to transparent pixel overlays.------ Until RGBA overlays are better understood, GLUT only supports color index--- overlays.--hasOverlay :: StateVar Bool-hasOverlay = makeStateVar getHasOverlay setHasOverlay--setHasOverlay :: Bool -> IO ()-setHasOverlay False = glutRemoveOverlay-setHasOverlay True  = glutEstablishOverlay--foreign import CALLCONV safe "glutRemoveOverlay" glutRemoveOverlay :: IO ()--foreign import CALLCONV safe "glutEstablishOverlay" glutEstablishOverlay :: IO ()--getHasOverlay :: IO Bool-getHasOverlay = layerGet (/= 0) glut_HAS_OVERLAY-------------------------------------------------------------------------------------- | Contains 'True' if an overlay could be established for the /current window/--- given the current /initial display mode/. If it contains 'False',--- 'setHasOverlay' will fail with a fatal error if called.--overlayPossible :: GettableStateVar Bool-overlayPossible = makeGettableStateVar $ layerGet (/= 0) glut_OVERLAY_POSSIBLE-------------------------------------------------------------------------------------- | Controls the visibility of the overlay of the /current window/.------ The effect of showing or hiding an overlay takes place immediately. Note that--- setting 'overlayVisible' to 'True' will not actually display the overlay--- unless the window is also shown (and even a shown window may be obscured by--- other windows, thereby obscuring the overlay). It is typically faster and--- less resource intensive to use the routines below to control the display--- status of an overlay as opposed to removing and re-establishing the overlay.--overlayVisible :: SettableStateVar Bool-overlayVisible =-   makeSettableStateVar $ \flag ->-      if flag then glutShowOverlay else glutHideOverlay--foreign import CALLCONV safe "glutShowOverlay" glutShowOverlay :: IO ()--foreign import CALLCONV safe "glutHideOverlay" glutHideOverlay :: IO ()-------------------------------------------------------------------------------------- | The /layer in use/.-data Layer-   = Normal   -- ^ The normal plane.-   | Overlay  -- ^ The overlay.-   deriving ( Eq, Ord, Show )--marshalLayer :: Layer -> GLenum-marshalLayer x = case x of-   Normal -> glut_NORMAL-   Overlay -> glut_OVERLAY--unmarshalLayer :: GLenum -> Layer-unmarshalLayer x-   | x == glut_NORMAL  = Normal-   | x == glut_OVERLAY = Overlay-   | otherwise = error ("unmarshalLayer: illegal value " ++ show x)-------------------------------------------------------------------------------------- | Controls the per-window /layer in use/ for the /current window/, which can--- either be the normal plane or the overlay. Selecting the overlay should only--- be done if an overlay exists, however windows without an overlay may still--- set the /layer in use/ to 'Normal'. OpenGL commands for the window are--- directed to the current /layer in use/.--layerInUse :: StateVar Layer-layerInUse =-   makeStateVar getLayerInUse setLayerInUse--setLayerInUse :: Layer -> IO ()-setLayerInUse = glutUseLayer . marshalLayer--foreign import CALLCONV safe "glutUseLayer" glutUseLayer :: GLenum -> IO ()--getLayerInUse :: IO Layer-getLayerInUse = layerGet (unmarshalLayer . fromIntegral) glut_LAYER_IN_USE-------------------------------------------------------------------------------------- | Mark the overlay of the given window (or the /current window/, if none is--- supplied) as needing to be redisplayed. The next iteration through--- 'Graphics.UI.GLUT.Begin.mainLoop', the window\'s overlay display callback--- (or simply the display callback if no overlay display callback is registered)--- will be called to redisplay the window\'s overlay plane. Multiple calls to--- 'postOverlayRedisplay' before the next display callback opportunity (or--- overlay display callback opportunity if one is registered) generate only a--- single redisplay. 'postOverlayRedisplay' may be called within a window\'s--- display or overlay display callback to re-mark that window for redisplay.------ Logically, overlay damage notification for a window is treated as a--- 'postOverlayRedisplay' on the damaged window. Unlike damage reported by the--- window system, 'postOverlayRedisplay' will not set to true the overlay\'s--- damaged status (see 'Graphics.UI.GLUT.State.damaged').------ Also, see 'Graphics.UI.GLUT.Window.postRedisplay'.--postOverlayRedisplay :: Maybe Window -> IO ()-postOverlayRedisplay =-   maybe glutPostOverlayRedisplay glutPostWindowOverlayRedisplay--foreign import CALLCONV safe "glutPostOverlayRedisplay"-   glutPostOverlayRedisplay :: IO ()--foreign import CALLCONV safe "glutPostWindowOverlayRedisplay"-   glutPostWindowOverlayRedisplay :: Window -> IO ()
− Graphics/UI/GLUT/QueryUtils.hs 
@@ -1,46 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.QueryUtils--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module with utilities to query GLUT state.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.QueryUtils (-  Getter, simpleGet, layerGet, deviceGet, glutSetOption-) where--import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.UI.GLUT.Extensions------------------------------------------------------------------------------------#include "HsGLUTExt.h"------------------------------------------------------------------------------------type PrimGetter =                GLenum -> IO CInt-type Getter a   = (CInt -> a) -> GLenum -> IO a--makeGetter :: PrimGetter -> Getter a-makeGetter g f = fmap f . g--simpleGet, layerGet, deviceGet :: Getter a-simpleGet = makeGetter glutGet-layerGet  = makeGetter glutLayerGet-deviceGet = makeGetter glutDeviceGet--foreign import CALLCONV unsafe "glutGet"       glutGet       :: PrimGetter-foreign import CALLCONV unsafe "glutLayerGet"  glutLayerGet  :: PrimGetter-foreign import CALLCONV unsafe "glutDeviceGet" glutDeviceGet :: PrimGetter---- Not really a query function, but it's quite handy to have it here-EXTENSION_ENTRY(unsafe,"freeglut",glutSetOption,GLenum -> CInt -> IO ())
− Graphics/UI/GLUT/State.hs 
@@ -1,412 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.State--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT maintains a considerable amount of programmer visible state. Some (but--- not all) of this state may be directly retrieved.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.State (-  -- * State of all windows-  windowBorderWidth, windowHeaderHeight,--  -- * State of the /current window/-  rgba,-  BufferDepth, rgbaBufferDepths, colorBufferDepth,-  doubleBuffered, stereo,-  accumBufferDepths, depthBufferDepth, stencilBufferDepth,-  SampleCount, sampleCount, formatID,-  fullScreenMode,--  -- * GLUT state pertaining to the layers of the /current window/-  damaged,--  -- * Timing-  elapsedTime,--  -- * Device information--  -- $DeviceInformation-  screenSize, screenSizeMM,-  hasKeyboard,-  ButtonCount, numMouseButtons,-  numSpaceballButtons,-  DialCount, numDialsAndButtons,-  numTabletButtons,-  AxisCount, PollRate, joystickInfo,-  supportedNumAuxBuffers, supportedSamplesPerPixel,--  -- * GLUT information-  glutVersion, initState-) where--import Control.Monad ( unless )-import Foreign.C.Types ( CInt )-import Foreign.Marshal.Alloc ( alloca )-import Foreign.Marshal.Array ( peekArray )-import Foreign.Ptr ( Ptr, nullFunPtr )-import Foreign.Storable ( Storable(..) )-import Graphics.Rendering.OpenGL.GL.BasicTypes ( GLenum )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Size(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   StateVar, makeStateVar, GettableStateVar, makeGettableStateVar )-import Graphics.UI.GLUT.Constants (-   glut_WINDOW_RGBA,-   glut_WINDOW_RED_SIZE, glut_WINDOW_GREEN_SIZE, glut_WINDOW_BLUE_SIZE,-   glut_WINDOW_ALPHA_SIZE, glut_WINDOW_BUFFER_SIZE,-   glut_WINDOW_DOUBLEBUFFER, glut_WINDOW_STEREO,-   glut_WINDOW_ACCUM_RED_SIZE, glut_WINDOW_ACCUM_GREEN_SIZE,-   glut_WINDOW_ACCUM_BLUE_SIZE, glut_WINDOW_ACCUM_ALPHA_SIZE,-   glut_WINDOW_DEPTH_SIZE, glut_WINDOW_STENCIL_SIZE, glut_WINDOW_NUM_SAMPLES,-   glut_WINDOW_FORMAT_ID, glut_ELAPSED_TIME,-   glut_NORMAL_DAMAGED, glut_OVERLAY_DAMAGED,-   glut_SCREEN_WIDTH, glut_SCREEN_HEIGHT,-   glut_SCREEN_WIDTH_MM, glut_SCREEN_HEIGHT_MM,-   glut_FULL_SCREEN,-   glut_HAS_KEYBOARD,-   glut_HAS_MOUSE, glut_NUM_MOUSE_BUTTONS,-   glut_HAS_SPACEBALL, glut_NUM_SPACEBALL_BUTTONS,-   glut_HAS_DIAL_AND_BUTTON_BOX, glut_NUM_DIALS, glut_NUM_BUTTON_BOX_BUTTONS,-   glut_HAS_TABLET, glut_NUM_TABLET_BUTTONS,-   glut_HAS_JOYSTICK, glut_JOYSTICK_BUTTONS, glut_JOYSTICK_POLL_RATE,-   glut_JOYSTICK_AXES,-   glut_AUX, glut_MULTISAMPLE,-   glut_VERSION, glut_WINDOW_BORDER_WIDTH, glut_WINDOW_HEADER_HEIGHT,-   glut_INIT_STATE )-import Graphics.UI.GLUT.Overlay ( Layer(..) )-import Graphics.UI.GLUT.QueryUtils ( simpleGet, layerGet, deviceGet )-import Graphics.UI.GLUT.Window ( fullScreenToggle )-import Graphics.UI.GLUT.Extensions------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- | Contains 'True' when the current layer of the /current window/ is in RGBA--- mode, 'False' means color index mode.--rgba :: GettableStateVar Bool-rgba = makeGettableStateVar$ simpleGet i2b glut_WINDOW_RGBA---- | Bit depth of a buffer--type BufferDepth = Int---- | Contains the number of red, green, blue, and alpha bits in the color buffer--- of the /current window\'s/ current layer (0 in color index mode).--rgbaBufferDepths ::-   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)-rgbaBufferDepths = makeGettableStateVar $ do-   r <- simpleGet fromIntegral glut_WINDOW_RED_SIZE-   g <- simpleGet fromIntegral glut_WINDOW_GREEN_SIZE-   b <- simpleGet fromIntegral glut_WINDOW_BLUE_SIZE-   a <- simpleGet fromIntegral glut_WINDOW_ALPHA_SIZE-   return (r, g, b, a)---- | Contains the total number of bits in the color buffer of the /current--- window\'s/ current layer. For an RGBA layer, this is the sum of the red,--- green, blue, and alpha bits. For an color index layer, this is the number--- of bits of the color indexes.--colorBufferDepth :: GettableStateVar BufferDepth-colorBufferDepth =-   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_BUFFER_SIZE---- | Contains 'True' when the current layer of the /current window/ is double--- buffered, 'False' otherwise.--doubleBuffered :: GettableStateVar Bool-doubleBuffered = makeGettableStateVar $ simpleGet i2b glut_WINDOW_DOUBLEBUFFER---- | Contains 'True' when the current layer of the /current window/ is stereo,--- 'False' otherwise.--stereo :: GettableStateVar Bool-stereo = makeGettableStateVar $ simpleGet i2b glut_WINDOW_STEREO---- | Contains the number of red, green, blue, and alpha bits in the accumulation--- buffer of the /current window\'s/ current layer (0 in color index mode).--accumBufferDepths ::-   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)-accumBufferDepths = makeGettableStateVar $ do-   r <- simpleGet fromIntegral glut_WINDOW_ACCUM_RED_SIZE-   g <- simpleGet fromIntegral glut_WINDOW_ACCUM_GREEN_SIZE-   b <- simpleGet fromIntegral glut_WINDOW_ACCUM_BLUE_SIZE-   a <- simpleGet fromIntegral glut_WINDOW_ACCUM_ALPHA_SIZE-   return (r, g, b, a)---- | Contains the number of bits in the depth buffer of the /current window\'s/--- current layer.--depthBufferDepth :: GettableStateVar BufferDepth-depthBufferDepth =-   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_DEPTH_SIZE---- | Contains the number of bits in the stencil buffer of the /current--- window\'s/ current layer.--stencilBufferDepth :: GettableStateVar BufferDepth-stencilBufferDepth =-   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_STENCIL_SIZE---- | Number of samples for multisampling--type SampleCount = Int---- | Contains the number of samples for multisampling for the /current window./--sampleCount :: GettableStateVar SampleCount-sampleCount =-   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_NUM_SAMPLES---- | Contains the window system dependent format ID for the current layer of the--- /current window/. On X11 GLUT implementations, this is the X visual ID. On--- Win32 GLUT implementations, this is the Win32 Pixel Format Descriptor number.--- This value is returned for debugging, benchmarking, and testing ease.--formatID :: GettableStateVar Int-formatID = makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_FORMAT_ID-------------------------------------------------------------------------------------- | (/freeglut only/) Contains 'True' if the /current window/ is in full screen--- mode, 'False' otherwise.--fullScreenMode :: StateVar Bool-fullScreenMode = makeStateVar getFullScreenMode setFullScreenMode--getFullScreenMode :: IO Bool-getFullScreenMode = simpleGet i2b glut_FULL_SCREEN--setFullScreenMode :: Bool -> IO ()-setFullScreenMode newMode = do-   oldMode <- getFullScreenMode-   unless (newMode == oldMode) fullScreenToggle-------------------------------------------------------------------------------------- | Contains the number of milliseconds since--- 'Graphics.UI.GLUT.Initialization.initialize' was called.--elapsedTime :: GettableStateVar Int-elapsedTime = makeGettableStateVar $ simpleGet fromIntegral glut_ELAPSED_TIME-------------------------------------------------------------------------------------- | Contains 'True' if the given plane of the /current window/ has been--- damaged (by window system activity) since the last display callback was--- triggered. Calling 'Graphics.UI.GLUT.Window.postRedisplay' or--- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' will not set this 'True'.--damaged :: Layer -> GettableStateVar Bool-damaged l = makeGettableStateVar $ layerGet isDamaged (marshalDamagedLayer l)-   where isDamaged d = d /= 0 && d /= -1-         marshalDamagedLayer x = case x of-            Normal -> glut_NORMAL_DAMAGED-            Overlay -> glut_OVERLAY_DAMAGED-------------------------------------------------------------------------------------- $DeviceInformation--- If a device is not available, the following state variables contain--- 'Nothing', otherwise they return 'Just' the specific device information.--- Only a screen is always assumed.-------------------------------------------------------------------------------------- | The size of the screen in pixels.--screenSize :: GettableStateVar Size-screenSize =-   makeGettableStateVar $ do-      wpx <- simpleGet fromIntegral glut_SCREEN_WIDTH-      hpx <- simpleGet fromIntegral glut_SCREEN_HEIGHT-      return $ Size wpx hpx---- | The size of the screen in millimeters.--screenSizeMM :: GettableStateVar Size-screenSizeMM =-   makeGettableStateVar $ do-      wmm <- simpleGet fromIntegral glut_SCREEN_WIDTH_MM-      hmm <- simpleGet fromIntegral glut_SCREEN_HEIGHT_MM-      return $ Size wmm hmm-------------------------------------------------------------------------------------- | Contains 'True' if a keyboard is present, 'False' otherwise.--hasKeyboard :: GettableStateVar Bool-hasKeyboard = makeGettableStateVar $ deviceGet i2b glut_HAS_KEYBOARD-------------------------------------------------------------------------------------- | Number of buttons of an input device--type ButtonCount = Int---- | Contains 'Just' the number of buttons of an attached mouse or 'Nothing' if--- there is none.--numMouseButtons :: GettableStateVar (Maybe ButtonCount)-numMouseButtons =-   getDeviceInfo glut_HAS_MOUSE $-      deviceGet fromIntegral glut_NUM_MOUSE_BUTTONS-------------------------------------------------------------------------------------- | Contains 'Just' the number of buttons of the attached Spaceball or 'Nothing'--- if there is none.--numSpaceballButtons :: GettableStateVar (Maybe ButtonCount)-numSpaceballButtons =-   getDeviceInfo glut_HAS_SPACEBALL $-      deviceGet fromIntegral glut_NUM_SPACEBALL_BUTTONS-------------------------------------------------------------------------------------- | Number of dials of a dial and button box--type DialCount = Int---- | Contains 'Just' the number of dials and buttons of an attached dial &--- button box or 'Nothing' if there is none.--numDialsAndButtons :: GettableStateVar (Maybe (DialCount, ButtonCount))-numDialsAndButtons =-   getDeviceInfo glut_HAS_DIAL_AND_BUTTON_BOX $ do-      d <- deviceGet fromIntegral glut_NUM_DIALS-      b <- deviceGet fromIntegral glut_NUM_BUTTON_BOX_BUTTONS-      return (d, b)-------------------------------------------------------------------------------------- | Contains 'Just' the number of buttons of an attached tablet or 'Nothing' if--- there is none.--numTabletButtons :: GettableStateVar (Maybe ButtonCount)-numTabletButtons =-   getDeviceInfo glut_HAS_TABLET $-      deviceGet fromIntegral glut_NUM_TABLET_BUTTONS-------------------------------------------------------------------------------------- | Number of axes of a joystick--type AxisCount = Int---- | The a rate at which a joystick is polled (in milliseconds)--type PollRate = Int---- | Contains 'Just' the number of buttons of an attached joystick, the number--- of joystick axes, and the rate at which the joystick is polled. Contains--- 'Nothing' if there is no joystick attached.--joystickInfo :: GettableStateVar (Maybe (ButtonCount, PollRate, AxisCount))-joystickInfo =-   getDeviceInfo glut_HAS_JOYSTICK $ do-      b <- deviceGet fromIntegral glut_JOYSTICK_BUTTONS-      a <- deviceGet fromIntegral glut_JOYSTICK_AXES-      r <- deviceGet fromIntegral glut_JOYSTICK_POLL_RATE-      return (b, a, r)----------------------------------------------------------------------------------- | (/freeglut only/) Contains a list of the number of auxiliary buffers--- supported, in increasing order.--supportedNumAuxBuffers :: GettableStateVar [Int]-supportedNumAuxBuffers = getModeValues glut_AUX---- | (/freeglut only/) Contains a list of the number of samples per pixel--- supported for multisampling, in increasing order.--supportedSamplesPerPixel :: GettableStateVar [SampleCount]-supportedSamplesPerPixel = getModeValues (fromIntegral glut_MULTISAMPLE)--getModeValues :: Integral a => GLenum -> GettableStateVar [a]-getModeValues what = makeGettableStateVar $-   alloca $ \sizeBuffer -> do-      valuesBuffer <- glutGetModeValues what sizeBuffer-      size <- peek sizeBuffer-      fmap (map fromIntegral) $ peekArray (fromIntegral size) valuesBuffer--EXTENSION_ENTRY(unsafe,"freeglut",glutGetModeValues,GLenum -> Ptr CInt -> IO (Ptr CInt))------------------------------------------------------------------------------------- Convenience unmarshalers--i2b :: CInt -> Bool-i2b = (/= 0)------------------------------------------------------------------------------------getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)-getDeviceInfo dev act =-   makeGettableStateVar $ do-      hasDevice <- deviceGet i2b dev-      if hasDevice then fmap Just act else return Nothing----------------------------------------------------------------------------------- | Contains version of GLUT in the form of--- @/flavour/ /major/./minor/./patchlevel/@, where @/flavour/@ is one of--- @GLUT@, @freeglut@ or @OpenGLUT@.--glutVersion :: GettableStateVar String-glutVersion = makeGettableStateVar $ do-   let isGLUT = isUnknown "glutSetOption"-       isFreeglut = isUnknown "glutSetWindowStayOnTop"-       isUnknown = fmap (== nullFunPtr) . getProcAddressInternal-       showVersionPart x = shows (x `mod` 100)-       showVersion v = showVersionPart (v `div` 10000) . showChar '.' .-                       showVersionPart (v `div`   100) . showChar '.' .-                       showVersionPart  v-   g <- isGLUT-   if g-      then return "GLUT 3.7"   -- ToDo: just guessing-      else do f <- isFreeglut-              v <- simpleGet id glut_VERSION-              let prefix = if f then "freeglut" else "OpenGLUT"-              return $ showString prefix . showChar ' ' . showVersion v $ ""----------------------------------------------------------------------------------- | (/freeglut only/) Contains the thickness of the sizing border around the--- perimeter of a window that can be resized, in pixels.--windowBorderWidth :: GettableStateVar Int-windowBorderWidth =-   makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_BORDER_WIDTH)----------------------------------------------------------------------------------- | (/freeglut only/) Contains the height of the header\/caption area of a--- window in pixels.--windowHeaderHeight :: GettableStateVar Int-windowHeaderHeight =-   makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_HEADER_HEIGHT)----------------------------------------------------------------------------------- | (/freeglut only/) Contains 'True' if GLUT has been initialized --- with 'Graphics.UI.GLUT.Initialization.initialize' or--- 'Graphics.UI.GLUT.Initialization.getArgsAndInitialize' has and not yet--- been de-initialized with 'Graphics.UI.GLUT.Initialization.exit'. Contains--- 'False' otherwise.--initState :: GettableStateVar Bool-initState = makeGettableStateVar$ simpleGet i2b glut_INIT_STATE
− Graphics/UI/GLUT/Types.hs 
@@ -1,102 +0,0 @@--- #hide------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Types--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ This is a purely internal module with miscellaneous types which don\'t really--- have a good place elsewhere.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Types (-   Window,                                   -- constructor used only internally-   makeWindow,                               -- used only internally-   Relation(..),-   relationToString,                         -- used only internally-   MouseButton(..),-   marshalMouseButton, unmarshalMouseButton  -- used only internally-) where--import Foreign.C.Types ( CInt )-import Graphics.UI.GLUT.Constants (-   glut_LEFT_BUTTON, glut_MIDDLE_BUTTON, glut_RIGHT_BUTTON,-   glut_WHEEL_UP, glut_WHEEL_DOWN )-------------------------------------------------------------------------------------- | An opaque identifier for a top-level window or a subwindow.--newtype Window = Window CInt-   deriving ( Eq, Ord, Show )--makeWindow :: CInt -> Window-makeWindow = Window-------------------------------------------------------------------------------------- | A relation between a 'Graphics.UI.GLUT.Initialization.DisplayCapability'--- and a numeric value.--data Relation-   = IsEqualTo        -- ^ Equal.-   | IsNotEqualTo     -- ^ Not equal.-   | IsLessThan       -- ^ Less than and preferring larger difference (the least-                      --   is best).-   | IsNotGreaterThan -- ^ Less than or equal and preferring larger difference-                      --   (the least is best).-   | IsGreaterThan    -- ^ Greater than and preferring larger differences (the-                      --   most is best).-   | IsAtLeast        -- ^ Greater than or equal and preferring more instead of-                      --   less. This relation is useful for allocating-                      --   resources like color precision or depth buffer-                      --   precision where the maximum precision is generally-                      --   preferred. Contrast with 'IsNotLessThan' relation.-   | IsNotLessThan    -- ^ Greater than or equal but preferring less instead of-                      --   more. This relation is useful for allocating-                      --   resources such as stencil bits or auxillary color-                      --   buffers where you would rather not over-allocate.-   deriving ( Eq, Ord, Show )--relationToString :: Relation -> String-relationToString IsEqualTo        = "="-relationToString IsNotEqualTo     = "!="-relationToString IsLessThan       = "<"-relationToString IsNotGreaterThan = "<="-relationToString IsGreaterThan    = ">"-relationToString IsAtLeast        = ">="-relationToString IsNotLessThan    = "~"-------------------------------------------------------------------------------------- | Mouse buttons, including a wheel--data MouseButton-   = LeftButton-   | MiddleButton-   | RightButton-   | WheelUp-   | WheelDown-   deriving ( Eq, Ord, Show )--marshalMouseButton :: MouseButton -> CInt-marshalMouseButton x = case x of-   LeftButton -> glut_LEFT_BUTTON-   MiddleButton -> glut_MIDDLE_BUTTON-   RightButton -> glut_RIGHT_BUTTON-   WheelUp ->glut_WHEEL_UP-   WheelDown -> glut_WHEEL_DOWN--unmarshalMouseButton :: CInt -> MouseButton-unmarshalMouseButton x-   | x == glut_LEFT_BUTTON = LeftButton-   | x == glut_MIDDLE_BUTTON = MiddleButton-   | x == glut_RIGHT_BUTTON = RightButton-   | x == glut_WHEEL_UP = WheelUp-   | x == glut_WHEEL_DOWN = WheelDown-   | otherwise = error ("unmarshalMouseButton: illegal value " ++ show x)
− Graphics/UI/GLUT/Window.hs 
@@ -1,544 +0,0 @@------------------------------------------------------------------------------------ |--- Module      :  Graphics.UI.GLUT.Window--- Copyright   :  (c) Sven Panne 2002-2005--- License     :  BSD-style (see the file libraries/GLUT/LICENSE)------ Maintainer  :  sven.panne@aedion.de--- Stability   :  stable--- Portability :  portable------ GLUT supports two types of windows: top-level windows and subwindows. Both--- types support OpenGL rendering and GLUT callbacks. There is a single--- identifier space for both types of windows.--------------------------------------------------------------------------------------module Graphics.UI.GLUT.Window (-   -- * Window identifiers-   Window,--   -- * Creating and destroying (sub-)windows--   -- $CreatingAndDestroyingSubWindows-   createWindow, createSubWindow, destroyWindow,-   parentWindow, numSubWindows,--   -- * Manipulating the /current window/-   currentWindow,--   -- * Re-displaying and double buffer management-   postRedisplay, swapBuffers,--   -- * Changing the window geometry--   -- $ChangingTheWindowGeometry-   windowPosition, windowSize, fullScreen, fullScreenToggle,--   -- * Manipulating the stacking order--   -- $ManipulatingTheStackingOrder-   pushWindow, popWindow,--   -- * Managing a window\'s display status-   WindowStatus(..), windowStatus,--   -- * Changing the window\/icon title--   -- $ChangingTheWindowIconTitle-   windowTitle, iconTitle,--   -- * Cursor management-   Cursor(..), cursor, pointerPosition-) where--import Foreign.C.String ( CString, withCString )-import Foreign.C.Types ( CInt )-import Graphics.Rendering.OpenGL.GL.CoordTrans ( Position(..), Size(..) )-import Graphics.Rendering.OpenGL.GL.StateVar (-   GettableStateVar, makeGettableStateVar,-   SettableStateVar, makeSettableStateVar,-   StateVar, makeStateVar )-import Graphics.UI.GLUT.Constants (-   glut_WINDOW_PARENT, glut_WINDOW_NUM_CHILDREN,-   glut_WINDOW_X, glut_WINDOW_Y, glut_WINDOW_WIDTH, glut_WINDOW_HEIGHT,-   glut_CURSOR_RIGHT_ARROW, glut_CURSOR_LEFT_ARROW, glut_CURSOR_INFO,-   glut_CURSOR_DESTROY, glut_CURSOR_HELP, glut_CURSOR_CYCLE, glut_CURSOR_SPRAY,-   glut_CURSOR_WAIT, glut_CURSOR_TEXT, glut_CURSOR_CROSSHAIR,-   glut_CURSOR_UP_DOWN, glut_CURSOR_LEFT_RIGHT, glut_CURSOR_TOP_SIDE,-   glut_CURSOR_BOTTOM_SIDE, glut_CURSOR_LEFT_SIDE, glut_CURSOR_RIGHT_SIDE,-   glut_CURSOR_TOP_LEFT_CORNER, glut_CURSOR_TOP_RIGHT_CORNER,-   glut_CURSOR_BOTTOM_RIGHT_CORNER, glut_CURSOR_BOTTOM_LEFT_CORNER,-   glut_CURSOR_INHERIT, glut_CURSOR_NONE, glut_CURSOR_FULL_CROSSHAIR,-   glut_WINDOW_CURSOR )-import Graphics.UI.GLUT.Extensions-import Graphics.UI.GLUT.QueryUtils ( simpleGet )-import Graphics.UI.GLUT.Types ( Window, makeWindow )------------------------------------------------------------------------------------#include "HsGLUTExt.h"-------------------------------------------------------------------------------------- $CreatingAndDestroyingSubWindows--- Each created window has a unique associated OpenGL context. State changes to--- a window\'s associated OpenGL context can be done immediately after the--- window is created.------ The /display state/ of a window is initially for the window to be shown. But--- the window\'s /display state/ is not actually acted upon until--- 'Graphics.UI.GLUT.Begin.mainLoop' is entered. This means until--- 'Graphics.UI.GLUT.Begin.mainLoop' is called, rendering to a created window is--- ineffective because the window can not yet be displayed.------ The value returned by 'createWindow' and 'createSubWindow' is a unique--- identifier for the window, which can be used with 'currentWindow'.---- | Create a top-level window. The given name will be provided to the window--- system as the window\'s name. The intent is that the window system will label--- the window with the name.Implicitly, the /current window/ is set to the newly--- created window.------ /X Implementation Notes:/ The proper X Inter-Client Communication Conventions--- Manual (ICCCM) top-level properties are established. The @WM_COMMAND@--- property that lists the command line used to invoke the GLUT program is only--- established for the first window created.--createWindow-   :: String    -- ^ The window name-   -> IO Window -- ^ The identifier for the newly created window-createWindow name = withCString name glutCreateWindow--foreign import CALLCONV unsafe "glutCreateWindow" glutCreateWindow ::-      CString -> IO Window-------------------------------------------------------------------------------------- | Create a subwindow of the identified window with the given relative--- position and size. Implicitly, the /current window/ is set to the--- newly created subwindow. Subwindows can be nested arbitrarily deep.--createSubWindow-   :: Window    -- ^ Identifier of the subwindow\'s parent window.-   -> Position  -- ^ Window position in pixels relative to parent window\'s-                --   origin.-   -> Size      -- ^ Window size in pixels-   -> IO Window -- ^ The identifier for the newly created subwindow-createSubWindow win (Position x y) (Size w h) =-   glutCreateSubWindow win-                       (fromIntegral x) (fromIntegral y)-                       (fromIntegral w) (fromIntegral h)--foreign import CALLCONV unsafe "glutCreateSubWindow" glutCreateSubWindow ::-      Window -> CInt -> CInt -> CInt -> CInt -> IO Window-------------------------------------------------------------------------------------- | Contains the /current window\'s/ parent. If the /current window/ is a--- top-level window, 'Nothing' is returned.--parentWindow :: GettableStateVar (Maybe Window)-parentWindow =-   makeGettableStateVar $-      getWindow (simpleGet makeWindow glut_WINDOW_PARENT)-------------------------------------------------------------------------------------- | Contains the number of subwindows the /current window/ has, not counting--- children of children.--numSubWindows :: GettableStateVar Int-numSubWindows =-   makeGettableStateVar $-      simpleGet fromIntegral glut_WINDOW_NUM_CHILDREN-------------------------------------------------------------------------------------- | Destroy the specified window and the window\'s associated OpenGL context,--- logical colormap (if the window is color index), and overlay and related--- state (if an overlay has been established). Any subwindows of the destroyed--- window are also destroyed by 'destroyWindow'. If the specified window was the--- /current window/, the /current window/ becomes invalid ('currentWindow' will--- contain 'Nothing').--foreign import CALLCONV unsafe "glutDestroyWindow" destroyWindow ::-   Window -> IO ()-------------------------------------------------------------------------------------- | Controls the /current window/. It does /not/ affect the /layer in use/ for--- the window; this is done using 'Graphics.UI.GLUT.Overlay.layerInUse'.--- Contains 'Nothing' if no windows exist or the previously /current window/ was--- destroyed. Setting the /current window/ to 'Nothing' is a no-op.--currentWindow :: StateVar (Maybe Window)-currentWindow =-   makeStateVar (getWindow glutGetWindow) (maybe (return ()) glutSetWindow)--getWindow :: IO Window -> IO (Maybe Window)-getWindow act = do-   win <- act-   return $ if win == makeWindow 0 then Nothing else Just win--foreign import CALLCONV unsafe "glutSetWindow" glutSetWindow :: Window -> IO ()--foreign import CALLCONV unsafe "glutGetWindow" glutGetWindow :: IO Window-------------------------------------------------------------------------------------- | Mark the normal plane of given window (or the /current window/, if none--- is supplied) as needing to be redisplayed. The next iteration through--- 'Graphics.UI.GLUT.Begin.mainLoop', the window\'s display callback will be--- called to redisplay the window\'s normal plane. Multiple calls to--- 'postRedisplay' before the next display callback opportunity generates only a--- single redisplay callback. 'postRedisplay' may be called within a window\'s--- display or overlay display callback to re-mark that window for redisplay.------ Logically, normal plane damage notification for a window is treated as a--- 'postRedisplay' on the damaged window. Unlike damage reported by the window--- system, 'postRedisplay' will /not/ set to true the normal plane\'s damaged--- status (see 'Graphics.UI.GLUT.State.damaged').------ Also, see 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay'.--postRedisplay :: Maybe Window -> IO ()-postRedisplay = maybe glutPostRedisplay glutPostWindowRedisplay--foreign import CALLCONV unsafe "glutPostRedisplay" glutPostRedisplay :: IO ()---- | Mark the normal plane of the given window as needing to be redisplayed,--- otherwise the same as 'postRedisplay'.------ The advantage of this routine is that it saves the cost of using--- 'currentWindow' (entailing an expensive OpenGL context switch), which is--- particularly useful when multiple windows need redisplays posted at the same--- time.--foreign import CALLCONV unsafe "glutPostWindowRedisplay"-   glutPostWindowRedisplay :: Window -> IO ()-------------------------------------------------------------------------------------- | Perform a buffer swap on the /layer in use/ for the /current window/.--- Specifically, 'swapBuffers' promotes the contents of the back buffer of the--- /layer in use/ of the /current window/ to become the contents of the front--- buffer. The contents of the back buffer then become undefined. The update--- typically takes place during the vertical retrace of the monitor, rather than--- immediately after 'swapBuffers' is called.------ An implicit 'Graphics.Rendering.OpenGL.GL.FlushFinish.flush' is done by--- 'swapBuffers' before it returns. Subsequent OpenGL commands can be issued--- immediately after calling 'swapBuffers', but are not executed until the--- buffer exchange is completed.------ If the /layer in use/ is not double buffered, 'swapBuffers' has no effect.--foreign import CALLCONV unsafe "glutSwapBuffers" swapBuffers :: IO ()-------------------------------------------------------------------------------------- $ChangingTheWindowGeometry--- Note that the requests by 'windowPosition', 'windowSize', and 'fullScreen'--- are not processed immediately. A request is executed after returning to the--- main event loop. This allows multiple requests to the same window to be--- coalesced.------ 'windowPosition' and 'windowSize' requests on a window will disable the full--- screen status of the window.-------------------------------------------------------------------------------------- | Controls the position of the /current window/. For top-level windows,--- parameters of 'Position' are pixel offsets from the screen origin. For--- subwindows, the parameters are pixel offsets from the window\'s parent window--- origin.------ In the case of top-level windows, setting 'windowPosition' is considered only--- a request for positioning the window. The window system is free to apply its--- own policies to top-level window placement. The intent is that top-level--- windows should be repositioned according to the value of 'windowPosition'.--windowPosition :: StateVar Position-windowPosition = makeStateVar getWindowPosition setWindowPosition--setWindowPosition :: Position -> IO ()-setWindowPosition (Position x y) =-   glutPositionWindow (fromIntegral x) (fromIntegral y)--foreign import CALLCONV unsafe "glutPositionWindow" glutPositionWindow ::-   CInt -> CInt -> IO ()--getWindowPosition :: IO Position-getWindowPosition = do-   x <- simpleGet fromIntegral glut_WINDOW_X-   y <- simpleGet fromIntegral glut_WINDOW_Y-   return $ Position x y-------------------------------------------------------------------------------------- | Controls the size of the /current window/. The parameters of 'Size' are--- size extents in pixels. The width and height must be positive values.------ In the case of top-level windows, setting 'windowSize' is considered only a--- request for sizing the window. The window system is free to apply its own--- policies to top-level window sizing. The intent is that top-level windows--- should be reshaped according to the value of 'windowSize'. Whether a reshape--- actually takes effect and, if so, the reshaped dimensions are reported to the--- program by a reshape callback.--windowSize :: StateVar Size-windowSize = makeStateVar getWindowSize setWindowSize--setWindowSize :: Size -> IO ()-setWindowSize (Size w h) =-   glutReshapeWindow (fromIntegral w) (fromIntegral h)--foreign import CALLCONV unsafe "glutReshapeWindow" glutReshapeWindow ::-   CInt -> CInt -> IO ()--getWindowSize :: IO Size-getWindowSize = do-   w <- simpleGet fromIntegral glut_WINDOW_WIDTH-   h <- simpleGet fromIntegral glut_WINDOW_HEIGHT-   return $ Size w h-------------------------------------------------------------------------------------- | Request that the /current window/ be made full screen. The exact semantics--- of what full screen means may vary by window system. The intent is to make--- the window as large as possible and disable any window decorations or borders--- added the window system. The window width and height are not guaranteed to be--- the same as the screen width and height, but that is the intent of making a--- window full screen.------ 'fullScreen' is defined to work only on top-level windows.------ /X Implementation Notes:/ In the X implementation of GLUT, full screen is--- implemented by sizing and positioning the window to cover the entire screen--- and posting the @_MOTIF_WM_HINTS@ property on the window requesting--- absolutely no decorations. Non-Motif window managers may not respond to--- @_MOTIF_WM_HINTS@.--foreign import CALLCONV unsafe "glutFullScreen" fullScreen :: IO ()-------------------------------------------------------------------------------------- | (/freeglut only/) Toggle between windowed and full screen mode.--fullScreenToggle :: IO ()-fullScreenToggle = glutFullScreenToggle--EXTENSION_ENTRY(unsafe,"freeglut",glutFullScreenToggle,IO ())-------------------------------------------------------------------------------------- $ManipulatingTheStackingOrder--- 'pushWindow' and 'popWindow' work on both top-level windows and subwindows.--- The effect of pushing and popping windows does not take place immediately.--- Instead the push or pop is saved for execution upon return to the GLUT event--- loop. Subsequent pop or push requests on a window replace the previously--- saved request for that window. The effect of pushing and popping top-level--- windows is subject to the window system\'s policy for restacking windows.---- | Change the stacking order of the /current window/ relative to its siblings--- (lowering it).--foreign import CALLCONV unsafe "glutPushWindow" pushWindow :: IO ()---- | Change the stacking order of the /current window/ relative to its siblings,--- bringing the /current window/ closer to the top.--foreign import CALLCONV unsafe "glutPopWindow" popWindow :: IO ()-------------------------------------------------------------------------------------- | The display status of a window.--data WindowStatus-   = Shown-   | Hidden-   | Iconified-   deriving ( Eq, Ord, Show )---- | Controls the display status of the /current window/.------ Note that the effect of showing, hiding, and iconifying windows does not take--- place immediately. Instead the requests are saved for execution upon return--- to the GLUT event loop. Subsequent show, hide, or iconification requests on a--- window replace the previously saved request for that window. The effect of--- hiding, showing, or iconifying top-level windows is subject to the window--- system\'s policy for displaying windows. Subwindows can\'t be iconified.--windowStatus :: SettableStateVar WindowStatus-windowStatus = makeSettableStateVar setStatus-   where setStatus Shown     = glutShowWindow-         setStatus Hidden    = glutHideWindow-         setStatus Iconified = glutIconifyWindow--foreign import CALLCONV unsafe "glutShowWindow" glutShowWindow :: IO ()--foreign import CALLCONV unsafe "glutHideWindow" glutHideWindow :: IO ()--foreign import CALLCONV unsafe "glutIconifyWindow" glutIconifyWindow :: IO ()-------------------------------------------------------------------------------------- $ChangingTheWindowIconTitle--- 'windowTitle' and 'iconTitle' should be set only when the /current--- window/ is a top-level window. Upon creation of a top-level window, the--- window and icon names are determined by the name given to 'createWindow'.--- Once created, setting 'windowTitle' and 'iconTitle' can change the window and--- icon names respectively of top-level windows. Each call requests the window--- system change the title appropriately. Requests are not buffered or--- coalesced. The policy by which the window and icon name are displayed is--- window system dependent.---- | Controls the window title of the /current top-level window/.--windowTitle :: SettableStateVar String-windowTitle =-   makeSettableStateVar $ \name ->-      withCString name glutSetWindowTitle--foreign import CALLCONV unsafe "glutSetWindowTitle" glutSetWindowTitle ::-      CString -> IO ()---- | Controls the icon title of the /current top-level window/.--iconTitle :: SettableStateVar String-iconTitle =-   makeSettableStateVar $ \name ->-      withCString name glutSetIconTitle--foreign import CALLCONV unsafe "glutSetIconTitle" glutSetIconTitle ::-      CString -> IO ()-------------------------------------------------------------------------------------- | The different cursor images GLUT supports.--data Cursor-   = RightArrow        -- ^ Arrow pointing up and to the right.-   | LeftArrow         -- ^ Arrow pointing up and to the left.-   | Info              -- ^ Pointing hand.-   | Destroy           -- ^ Skull & cross bones.-   | Help              -- ^ Question mark.-   | Cycle             -- ^ Arrows rotating in a circle.-   | Spray             -- ^ Spray can.-   | Wait              -- ^ Wrist watch.-   | Text              -- ^ Insertion point cursor for text.-   | Crosshair         -- ^ Simple cross-hair.-   | UpDown            -- ^ Bi-directional pointing up & down.-   | LeftRight         -- ^ Bi-directional pointing left & right.-   | TopSide           -- ^ Arrow pointing to top side.-   | BottomSide        -- ^ Arrow pointing to bottom side.-   | LeftSide          -- ^ Arrow pointing to left side.-   | RightSide         -- ^ Arrow pointing to right side.-   | TopLeftCorner     -- ^ Arrow pointing to top-left corner.-   | TopRightCorner    -- ^ Arrow pointing to top-right corner.-   | BottomRightCorner -- ^ Arrow pointing to bottom-left corner.-   | BottomLeftCorner  -- ^ Arrow pointing to bottom-right corner.-   | Inherit           -- ^ Use parent\'s cursor.-   | None              -- ^ Invisible cursor.-   | FullCrosshair     -- ^ Full-screen cross-hair cursor (if possible, otherwise 'Crosshair').-   deriving ( Eq, Ord, Show )--marshalCursor :: Cursor -> CInt-marshalCursor x = case x of-   RightArrow -> glut_CURSOR_RIGHT_ARROW-   LeftArrow -> glut_CURSOR_LEFT_ARROW-   Info -> glut_CURSOR_INFO-   Destroy -> glut_CURSOR_DESTROY-   Help -> glut_CURSOR_HELP-   Cycle -> glut_CURSOR_CYCLE-   Spray -> glut_CURSOR_SPRAY-   Wait -> glut_CURSOR_WAIT-   Text -> glut_CURSOR_TEXT-   Crosshair -> glut_CURSOR_CROSSHAIR-   UpDown -> glut_CURSOR_UP_DOWN-   LeftRight -> glut_CURSOR_LEFT_RIGHT-   TopSide -> glut_CURSOR_TOP_SIDE-   BottomSide -> glut_CURSOR_BOTTOM_SIDE-   LeftSide -> glut_CURSOR_LEFT_SIDE-   RightSide -> glut_CURSOR_RIGHT_SIDE-   TopLeftCorner -> glut_CURSOR_TOP_LEFT_CORNER-   TopRightCorner -> glut_CURSOR_TOP_RIGHT_CORNER-   BottomRightCorner -> glut_CURSOR_BOTTOM_RIGHT_CORNER-   BottomLeftCorner -> glut_CURSOR_BOTTOM_LEFT_CORNER-   Inherit -> glut_CURSOR_INHERIT-   None -> glut_CURSOR_NONE-   FullCrosshair -> glut_CURSOR_FULL_CROSSHAIR--unmarshalCursor :: CInt -> Cursor-unmarshalCursor x-   | x == glut_CURSOR_RIGHT_ARROW = RightArrow-   | x == glut_CURSOR_LEFT_ARROW = LeftArrow-   | x == glut_CURSOR_INFO = Info-   | x == glut_CURSOR_DESTROY = Destroy-   | x == glut_CURSOR_HELP = Help-   | x == glut_CURSOR_CYCLE = Cycle-   | x == glut_CURSOR_SPRAY = Spray-   | x == glut_CURSOR_WAIT = Wait-   | x == glut_CURSOR_TEXT = Text-   | x == glut_CURSOR_CROSSHAIR = Crosshair-   | x == glut_CURSOR_UP_DOWN = UpDown-   | x == glut_CURSOR_LEFT_RIGHT = LeftRight-   | x == glut_CURSOR_TOP_SIDE = TopSide-   | x == glut_CURSOR_BOTTOM_SIDE = BottomSide-   | x == glut_CURSOR_LEFT_SIDE = LeftSide-   | x == glut_CURSOR_RIGHT_SIDE = RightSide-   | x == glut_CURSOR_TOP_LEFT_CORNER = TopLeftCorner-   | x == glut_CURSOR_TOP_RIGHT_CORNER = TopRightCorner-   | x == glut_CURSOR_BOTTOM_RIGHT_CORNER = BottomRightCorner-   | x == glut_CURSOR_BOTTOM_LEFT_CORNER = BottomLeftCorner-   | x == glut_CURSOR_INHERIT = Inherit-   | x == glut_CURSOR_NONE = None-   | x == glut_CURSOR_FULL_CROSSHAIR = FullCrosshair-   | otherwise = error ("unmarshalCursor: illegal value " ++ show x)-------------------------------------------------------------------------------------- | Change the cursor image of the /current window/. Each call requests the--- window system change the cursor appropriately. The cursor image when a window--- is created is 'Inherit'. The exact cursor images used are implementation--- dependent. The intent is for the image to convey the meaning of the cursor--- name. For a top-level window, 'Inherit' uses the default window system--- cursor.------ /X Implementation Notes:/ GLUT for X uses SGI\'s @_SGI_CROSSHAIR_CURSOR@--- convention to access a full-screen cross-hair cursor if possible.--cursor :: StateVar Cursor-cursor = makeStateVar getCursor setCursor--setCursor :: Cursor -> IO ()-setCursor = glutSetCursor . marshalCursor--foreign import CALLCONV unsafe "glutSetCursor" glutSetCursor :: CInt -> IO ()--getCursor :: IO Cursor-getCursor = simpleGet unmarshalCursor glut_WINDOW_CURSOR-------------------------------------------------------------------------------------- | Setting 'pointerPosition' warps the window system\'s pointer to a new--- location relative to the origin of the /current window/ by the specified--- pixel offset, which may be negative. The warp is done immediately.------ If the pointer would be warped outside the screen\'s frame buffer region, the--- location will be clamped to the nearest screen edge. The window system is--- allowed to further constrain the pointer\'s location in window system--- dependent ways.------ Good advice from Xlib\'s @XWarpPointer@ man page: \"There is seldom any--- reason for calling this function. The pointer should normally be left to the--- user.\"--pointerPosition :: SettableStateVar Position-pointerPosition =-   makeSettableStateVar $ \(Position x y) ->-      glutWarpPointer (fromIntegral x) (fromIntegral y)--foreign import CALLCONV unsafe "glutWarpPointer" glutWarpPointer ::-   CInt -> CInt -> IO ()
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2002-2005, Sven Panne+Copyright (c) 2002-2018, Sven Panne All rights reserved.  Redistribution and use in source and binary forms, with or without
− README 
@@ -1,4 +0,0 @@-To build this package using Cabal directly from darcs, you must run-"autoreconf" before the usual Cabal build steps (configure/build/install).-autoreconf is included in the GNU autoconf tools.  There is no need to run-the "configure" script: the "setup configure" step will do this for you.
+ README.md view
@@ -0,0 +1,4 @@+[![Hackage](https://img.shields.io/hackage/v/GLUT.svg)](https://hackage.haskell.org/package/GLUT)+[![Stackage LTS](https://www.stackage.org/package/GLUT/badge/lts)](https://www.stackage.org/lts/package/GLUT)+[![Stackage nightly](https://www.stackage.org/package/GLUT/badge/nightly)](https://www.stackage.org/nightly/package/GLUT)+[![Build Status](https://img.shields.io/travis/haskell-opengl/GLUT/master.svg)](https://travis-ci.org/haskell-opengl/GLUT)
Setup.hs view
@@ -1,6 +1,2 @@-module Main (main) where- import Distribution.Simple--main :: IO ()-main = defaultMainWithHooks autoconfUserHooks+main = defaultMain
− aclocal.m4 
@@ -1,346 +0,0 @@-# Extra autoconf macros for the Glasgow fptools-#-# To be a good autoconf citizen, names of local macros have prefixed with FP_ to-# ensure we don't clash with any pre-supplied autoconf ones.--dnl ** Map an arithmetic C type to a Haskell type.-dnl    Based on autconf's AC_CHECK_SIZEOF.--dnl FPTOOLS_CHECK_HTYPE(TYPE [, DEFAULT_VALUE, [, VALUE-FOR-CROSS-COMPILATION])-AC_DEFUN([FPTOOLS_CHECK_HTYPE],-[changequote(<<, >>)dnl-dnl The name to #define.-define(<<AC_TYPE_NAME>>, translit(htype_$1, [a-z *], [A-Z_P]))dnl-dnl The cache variable name.-define(<<AC_CV_NAME>>, translit(fptools_cv_htype_$1, [ *], [_p]))dnl-define(<<AC_CV_NAME_supported>>, translit(fptools_cv_htype_sup_$1, [ *], [_p]))dnl-changequote([, ])dnl-AC_MSG_CHECKING(Haskell type for $1)-AC_CACHE_VAL(AC_CV_NAME,-[AC_CV_NAME_supported=yes-fp_check_htype_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-AC_RUN_IFELSE([AC_LANG_SOURCE([[#include <stdio.h>-#include <stddef.h>--#if HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif--#if HAVE_UNISTD_H-# include <unistd.h>-#endif--#if HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif--#if HAVE_FCNTL_H-# include <fcntl.h>-#endif--#if HAVE_SIGNAL_H-# include <signal.h>-#endif--#if HAVE_TIME_H-# include <time.h>-#endif--#if HAVE_TERMIOS_H-# include <termios.h>-#endif--#if HAVE_STRING_H-# include <string.h>-#endif--#if HAVE_CTYPE_H-# include <ctype.h>-#endif--#if defined(HAVE_GL_GL_H)-# include <GL/gl.h>-#elif defined(HAVE_OPENGL_GL_H)-# include <OpenGL/gl.h>-#endif--#if defined(HAVE_AL_AL_H)-# include <AL/al.h>-#elif defined(HAVE_OPENAL_AL_H)-# include <OpenAL/al.h>-#endif--#if defined(HAVE_AL_ALC_H)-# include <AL/alc.h>-#elif defined(HAVE_OPENAL_ALC_H)-# include <OpenAL/alc.h>-#endif--#if HAVE_SYS_RESOURCE_H-# include <sys/resource.h>-#endif--typedef $1 testing;--main() {-  FILE *f=fopen("conftestval", "w");-  if (!f) exit(1);-  if (((testing)((int)((testing)1.4))) == ((testing)1.4)) {-    fprintf(f, "%s%d\n",-           ((testing)(-1) < (testing)0) ? "Int" : "Word",-           sizeof(testing)*8);-  } else {-    fprintf(f,"%s\n",-           (sizeof(testing) >  sizeof(double)) ? "LDouble" :-           (sizeof(testing) == sizeof(double)) ? "Double"  : "Float");-  }-  fclose(f);-  exit(0);-}]])],[AC_CV_NAME=`cat conftestval`],-[ifelse([$2], , [AC_CV_NAME=NotReallyAType; AC_CV_NAME_supported=no], [AC_CV_NAME=$2])],-[ifelse([$3], , [AC_CV_NAME=NotReallyATypeCross; AC_CV_NAME_supported=no], [AC_CV_NAME=$3])])-CPPFLAGS="$fp_check_htype_save_cppflags"]) dnl-if test "$AC_CV_NAME_supported" = yes; then-  AC_MSG_RESULT($AC_CV_NAME)-  AC_DEFINE_UNQUOTED(AC_TYPE_NAME, $AC_CV_NAME, [Define to Haskell type for $1])-else-  AC_MSG_RESULT([not supported])-fi-undefine([AC_TYPE_NAME])dnl-undefine([AC_CV_NAME])dnl-undefine([AC_CV_NAME_supported])dnl-])---# FP_ARG_OPENGL-# --------------AC_DEFUN([FP_ARG_OPENGL],-[AC_ARG_ENABLE([opengl],-  [AC_HELP_STRING([--enable-opengl],-    [build a Haskell binding for OpenGL (GL/GLU). On Mac OS X, use-     --enable-opengl=x11 to use X11 instead of the "native" libraries.-     (default=autodetect)])],-  [enable_opengl=$enableval],-  [enable_opengl=yes])-])# FP_ARG_OPENGL---# FP_ARG_GLUT-# --------------AC_DEFUN([FP_ARG_GLUT],-[AC_REQUIRE([FP_ARG_OPENGL])-AC_ARG_ENABLE([glut],-  [AC_HELP_STRING([--enable-glut],-    [build a Haskell binding for GLUT (default=autodetect)])],-  [enable_glut=$enableval],-  [enable_glut=yes])-])# FP_ARG_GLUT---# FP_CHECK_QUARTZ_OPENGL-# -----------------------AC_DEFUN([FP_CHECK_QUARTZ_OPENGL],-[AC_REQUIRE([FP_ARG_OPENGL])-AC_REQUIRE([AC_CANONICAL_TARGET])--use_quartz_opengl=no-if test x"$enable_opengl" = xyes; then-  case $target_os in-  darwin*)-    AC_DEFINE([USE_QUARTZ_OPENGL], [1],-              [Define to 1 if native OpenGL should be used on Mac OS X])-    use_quartz_opengl=yes-    ;;-  esac-fi--GLU_FRAMEWORKS=-GLUT_FRAMEWORKS=-GLUT_EXTRA_LIBS=-if test x"$use_quartz_opengl" = xyes; then-  GLU_FRAMEWORKS=OpenGL-  GLUT_FRAMEWORKS=GLUT-  GLUT_EXTRA_LIBS=objc-fi-AC_SUBST([GLU_FRAMEWORKS])-AC_SUBST([GLUT_FRAMEWORKS])-AC_SUBST([GLUT_EXTRA_LIBS])-])# FP_CHECK_QUARTZ_OPENGL---# FP_CHECK_WIN32-# ---------------# If Windows is the target platform (e.g. MinGW/MSYS or Cygwin with-# -mno-cygwin), the variable "fp_is_win32" is set to "yes", otherwise (e.g. *nix-# systems or plain Cygwin) it is set to "no".-AC_DEFUN([FP_CHECK_WIN32],-[AC_CACHE_CHECK([for Windows environment], [fp_cv_is_win32],-  [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], [-#if !_WIN32-   syntax error;-#endif-])], [fp_cv_is_win32=yes], [fp_cv_is_win32=no])])-fp_is_win32="$fp_cv_is_win32"[]dnl-])# FP_CHECK_WIN32---# FP_PATH_XTRA-# -------------# Same as AC_PATH_XTRA, but works even for broken Cygwins which try to include-# the non-existant <gl/mesa_wgl.h> header when -mno-cygwin is used.-AC_DEFUN([FP_PATH_XTRA],-[AC_REQUIRE([FP_CHECK_WIN32])-if test x"$fp_is_win32" = xyes; then-  no_x=yes-else-  AC_PATH_XTRA-fi-])# FP_PATH_XTRA---# FP_CHECK_GL_HELPER(LIBNAME, LIBS, INCLUDES, FUNCTION-BODY)-# -----------------------------------------------------------# Try each library in LIBS to successfully link INCLUDES plus FUNCTION-BODY,-# setting LIBNAME_CFLAGS and LIBNAME_LIBS to the corresponding values. Sets-# no_LIBNAME to "yes" if no suitable library was found. (LIBNAME_CFLAGS0-# contains the value of LIBNAME_CFLAGS without CPPFLAGS, and LIBNAME_LIBS0-# contains the value of LIBNAME_LIBS without LDFLAGS, but these are only-# used internally.)-AC_DEFUN([FP_CHECK_GL_HELPER],-[AC_CACHE_CHECK([for $1 library], [fp_cv_check_$1_lib],-  [fp_cv_check_$1_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${$1_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in $2; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${$1_LIBS} $fp_save_LIBS"-    AC_LINK_IFELSE([AC_LANG_PROGRAM([$3], [$4])], [fp_cv_check_$1_lib="$fp_try_lib ${$1_LIBS}"; break])-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"])--  if test x"$fp_cv_check_$1_lib" = xno; then-    no_$1=yes-    $1_CFLAGS=-    $1_LIBS=-  else-    $1_CFLAGS0="${$1_CFLAGS}"-    $1_CFLAGS="$CPPFLAGS ${$1_CFLAGS0}"-    $1_LIBS0="$fp_cv_check_$1_lib"-    $1_LIBS="$LDFLAGS ${$1_LIBS0}"-  fi-])# FP_CHECK_GL_HELPER---# FP_CHECK_GL-# ------------AC_DEFUN([FP_CHECK_GL],-[AC_REQUIRE([FP_PATH_XTRA])-AC_REQUIRE([FP_CHECK_QUARTZ_OPENGL])-AC_REQUIRE([FP_CHECK_WIN32])--if test x"$use_quartz_opengl" = xno; then-  AC_CHECK_FUNC(atan,[fp_libm_not_needed=yes],[fp_libm_not_needed=dunno])-  if test x"$fp_libm_not_needed" = xdunno; then-     AC_CHECK_LIB([m], [atan], [GL_LIBS="-lm $GL_LIBS"])-  fi--  if test x"$no_x" != xyes; then-    test -n "$x_includes" && GL_CFLAGS="-I$x_includes $GL_CFLAGS"-    test -n "$x_libraries" && GL_LIBS="-L$x_libraries -lX11 $GL_LIBS"-  fi--  FP_CHECK_GL_HELPER([GL], [-lGL -lopengl32], [@%:@include <GL/gl.h>], [glEnd()])--  if test x"$fp_is_win32" = xyes; then-    # Ugly: To get wglGetProcAddress on Windows, we have to link with-    # opengl32.dll, too, even when we are using Cygwin with X11.-    case "$GL_LIBS" in-      *-lopengl32*|*opengl32.lib*) ;;-      *) fp_save_LIBS="$LIBS"-         LIBS="$LIBS -lopengl32"-         AC_LINK_IFELSE([AC_LANG_PROGRAM([[@%:@include <GL/gl.h>]], [[glEnd()]])],-           [GL_LIBS="$GL_LIBS -lopengl32"; GL_LIBS0="$GL_LIBS0 -lopengl32"])-         LIBS="$fp_save_LIBS"-         ;;-    esac-  fi-fi-AC_SUBST([GL_CFLAGS])-AC_SUBST([GL_LIBS])-])# FP_CHECK_GL---# FP_CHECK_GLU-# -------------AC_DEFUN([FP_CHECK_GLU],-[AC_REQUIRE([FP_CHECK_GL])dnl-GLU_CFLAGS="$GL_CFLAGS0"-GLU_LIBS="$GL_LIBS0"--if test x"$use_quartz_opengl" = xno; then-  FP_CHECK_GL_HELPER([GLU], [-lglu32 -lGLU], [@%:@include <GL/glu.h>], [gluNewQuadric()])-fi--AC_SUBST([GLU_CFLAGS])-AC_SUBST([GLU_LIBS])-])# FP_CHECK_GLU---# FP_CHECK_GLUT-# --------------AC_DEFUN([FP_CHECK_GLUT],-[AC_REQUIRE([FP_CHECK_GLU])-AC_REQUIRE([FP_CHECK_QUARTZ_OPENGL])--if test x"$use_quartz_opengl" = xno; then-  GLUT_CFLAGS="$GLU_CFLAGS0"-  GLUT_LIBS="$GLU_LIBS0"--  if test x"$no_x" != xyes; then-    GLUT_LIBS="$X_PRE_LIBS -lXmu -lXi $X_EXTRA_LIBS $GLUT_LIBS"-  fi--  AC_CHECK_HEADERS([windows.h])--  fp_save_cppflags="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS $X_CFLAGS"-  AC_CHECK_HEADERS([GL/glut.h])-  CPPFLAGS="$fp_save_cppflags"--  # Note 1: On Cygwin with X11, GL/GLU functions use the "normal" calling-  # convention, but GLUT functions use stdcall. To get this right, it is-  # necessary to include <windows.h> first.-  # Note 2: MinGW/MSYS comes without a GLUT header, so we use Cygwin's one in-  # that case.-  FP_CHECK_GL_HELPER([GLUT], [-lglut32 -lglut], [-#if HAVE_WINDOWS_H-#include <windows.h>-#endif-#if HAVE_GL_GLUT_H-#include <GL/glut.h>-#else-#include "glut_local.h"-#endif-    ], [glutMainLoop()])-fi--AC_SUBST([GLUT_CFLAGS])-AC_SUBST([GLUT_LIBS])-])# FP_CHECK_GLUT---# FP_ARG_COMPILER-# --------------AC_DEFUN([FP_ARG_COMPILER],-[AC_ARG_WITH([compiler],-  [AC_HELP_STRING([--with-compiler@<:@=HC@:>@],-    [use the given Haskell compiler (default=ghc)])],-  [with_compiler=$withval],-  [with_compiler=ghc])-])# FP_ARG_COMPILER
cbits/HsGLUT.c view
@@ -1,64 +1,153 @@ /* -----------------------------------------------------------------------------  *- * Module      :  C support for Graphics.UI.GLUT.Fonts- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/GLUT/LICENSE)+ * Module      :  C support for Graphics.UI.GLUT.Raw+ * Copyright   :  (c) Sven Panne 2002-2018+ * License     :  BSD3  *- * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional+ * Maintainer  :  Sven Panne <svenpanne@gmail.com>+ * Stability   :  stable  * Portability :  portable  *  * -------------------------------------------------------------------------- */ -#include "HsGLUT.h"+#if defined(USE_GETPROCADDRESS) -/* needed only for GLUT_GET_PROC_ADDRESS_IS_BROKEN */-#include "HsGLUTConfig.h"+#define WIN32_LEAN_AND_MEAN+#include <windows.h> -#if (FREEGLUT || GLUT_API_VERSION >= 5) && GLUT_GET_PROC_ADDRESS_IS_BROKEN-#include <string.h>+static LPCTSTR libNames[] = {+  /* Try to load freeglut first, it has a few extra features compared to classic+     GLUT. */+  TEXT("freeglut"),+  /* The MinGW-w64 version of freeglut prefixes "lib" onto the DLL name. */+  TEXT("libfreeglut"),+  /* If no freeglut version is found, try plain old glut32 instead. */+  TEXT("glut32")+};++void*+hs_GLUT_getProcAddress(const char *name)+{+  static int firstTime = 1;+  static HMODULE handle = NULL;++  if (firstTime) {+    int i, numNames = (int)(sizeof(libNames) / sizeof(libNames[0]));+    firstTime = 0;+    for (i = 0;   (!handle) && (i < numNames);   ++i) {+      handle = LoadLibrary(libNames[i]);+    }+  }++  return handle ? GetProcAddress(handle, name) : NULL;+}++/* -------------------------------------------------------------------------- */+#elif defined(USE_DLSYM)++#include <stdlib.h>+#include <dlfcn.h>++static const char* libNames[] = {+#ifdef __APPLE__+  /* Try to use freeglut, checking the LD_LIBRARY_PATH */+  "libglut.dylib",+  /* Try public framework path first. */+  "/Library/Frameworks/GLUT.framework/GLUT",+  /* If the public path failed, try the system framework path. */+  "/System/Library/Frameworks/GLUT.framework/GLUT"+#else+  "libglut.so", "libglut.so.3" #endif+};  void*-hs_GLUT_marshalBitmapFont(int fontID)+hs_GLUT_getProcAddress(const char *name) {-  switch (fontID) {-  case 0 : return GLUT_BITMAP_8_BY_13;-  case 1 : return GLUT_BITMAP_9_BY_15;-  case 2 : return GLUT_BITMAP_TIMES_ROMAN_10;-  case 3 : return GLUT_BITMAP_TIMES_ROMAN_24;-  case 4 : return GLUT_BITMAP_HELVETICA_10;-  case 5 : return GLUT_BITMAP_HELVETICA_12;-  case 6 : return GLUT_BITMAP_HELVETICA_18;+  static int firstTime = 1;+  static void *handle = NULL;++  if (firstTime) {+    int i, numNames = (int)(sizeof(libNames) / sizeof(libNames[0]));+    firstTime = 0;+    for (i = 0;   (!handle) && (i < numNames);   ++i) {+      handle = dlopen(libNames[i], RTLD_LAZY | RTLD_GLOBAL);+    }   }-  return (void*)0;++  return handle ? dlsym(handle, name) : NULL; } +/* -------------------------------------------------------------------------- */+#else++#error "Don't know how to retrieve GLUT entries"++#endif++/* -------------------------------------------------------------------------- */++/* Note: This #if below is in sync with freeglut_std.h, classic GLUT simply used+   #if defined(_WIN32). */+#if defined(_MSC_VER) || defined(__CYGWIN__) || defined(__MINGW32__) || defined(__WATCOMC__)+#define INIT_FONT(name,num) hs_##name = ((void*)(num))+#else+#define INIT_FONT(name,num) hs_##name = hs_GLUT_getProcAddress(#name)+#endif+ void*-hs_GLUT_marshalStrokeFont(int fontID)+hs_GLUT_marshalBitmapFont(int fontID) {+  static int firstTime = 1;+  static void *hs_glutBitmap9By15        = NULL;+  static void *hs_glutBitmap8By13        = NULL;+  static void *hs_glutBitmapTimesRoman10 = NULL;+  static void *hs_glutBitmapTimesRoman24 = NULL;+  static void *hs_glutBitmapHelvetica10  = NULL;+  static void *hs_glutBitmapHelvetica12  = NULL;+  static void *hs_glutBitmapHelvetica18  = NULL;++  if (firstTime) {+    firstTime = 0;++    INIT_FONT(glutBitmap9By15, 0x0002);+    INIT_FONT(glutBitmap8By13, 0x0003);+    INIT_FONT(glutBitmapTimesRoman10, 0x0004);+    INIT_FONT(glutBitmapTimesRoman24, 0x0005);+    INIT_FONT(glutBitmapHelvetica10, 0x0006);+    INIT_FONT(glutBitmapHelvetica12, 0x0007);+    INIT_FONT(glutBitmapHelvetica18, 0x0008);+  }+   switch (fontID) {-  case 0 : return GLUT_STROKE_ROMAN;-  case 1 : return GLUT_STROKE_MONO_ROMAN;+  case 0 : return hs_glutBitmap8By13;+  case 1 : return hs_glutBitmap9By15;+  case 2 : return hs_glutBitmapTimesRoman10;+  case 3 : return hs_glutBitmapTimesRoman24;+  case 4 : return hs_glutBitmapHelvetica10;+  case 5 : return hs_glutBitmapHelvetica12;+  case 6 : return hs_glutBitmapHelvetica18;   }   return (void*)0; } -/* procName is really a const char*, but currently we can't specify this in-   Haskell's FFI and consequently get a warning from the C compiler. */ void*-hs_GLUT_getProcAddress(char *procName)+hs_GLUT_marshalStrokeFont(int fontID) {-#if (FREEGLUT || GLUT_API_VERSION >= 5)-#if GLUT_GET_PROC_ADDRESS_IS_BROKEN-  /* There are a few typos/omissions in freeglut 2.20 */-  if (strcmp(procName, "glutWireCylinder"         ) == 0) return (void*)glutWireCylinder;-  if (strcmp(procName, "glutSolidCylinder"        ) == 0) return (void*)glutSolidCylinder;-  if (strcmp(procName, "glutWireSierpinskiSponge" ) == 0) return (void*)glutWireSierpinskiSponge;-  if (strcmp(procName, "glutSolidSierpinskiSponge") == 0) return (void*)glutSolidSierpinskiSponge;-#endif-  return glutGetProcAddress(procName);-#else+  static int firstTime = 1;+  static void *hs_glutStrokeRoman     = NULL;+  static void *hs_glutStrokeMonoRoman = NULL;++  if (firstTime) {+    firstTime = 0;++    INIT_FONT(glutStrokeRoman, 0x0000);+    INIT_FONT(glutStrokeMonoRoman, 0x0001);+  }++  switch (fontID) {+  case 0 : return hs_glutStrokeRoman;+  case 1 : return hs_glutStrokeMonoRoman;+  }   return (void*)0;-#endif }
− config.guess 
@@ -1,1497 +0,0 @@-#! /bin/sh-# Attempt to guess a canonical system name.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.--timestamp='2006-02-23'--# This file is free software; you can redistribute it and/or modify it-# under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or-# (at your option) any later version.-#-# This program is distributed in the hope that it will be useful, but-# WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU-# General Public License for more details.-#-# You should have received a copy of the GNU General Public License-# along with this program; if not, write to the Free Software-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA-# 02110-1301, USA.-#-# As a special exception to the GNU General Public License, if you-# distribute this file as part of a program that contains a-# configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Originally written by Per Bothner <per@bothner.com>.-# Please send patches to <config-patches@gnu.org>.  Submit a context-# diff and a properly formatted ChangeLog entry.-#-# This script attempts to guess a canonical system name similar to-# config.sub.  If it succeeds, it prints the system name on stdout, and-# exits with 0.  Otherwise, it exits with 1.-#-# The plan is that this can be called by configure scripts if you-# don't specify an explicit build system type.--me=`echo "$0" | sed -e 's,.*/,,'`--usage="\-Usage: $0 [OPTION]--Output the configuration name of the system \`$me' is run on.--Operation modes:-  -h, --help         print this help, then exit-  -t, --time-stamp   print date of last modification, then exit-  -v, --version      print version number, then exit--Report bugs and patches to <config-patches@gnu.org>."--version="\-GNU config.guess ($timestamp)--Originally written by Per Bothner.-Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005-Free Software Foundation, Inc.--This is free software; see the source for copying conditions.  There is NO-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."--help="-Try \`$me --help' for more information."--# Parse command line-while test $# -gt 0 ; do-  case $1 in-    --time-stamp | --time* | -t )-       echo "$timestamp" ; exit ;;-    --version | -v )-       echo "$version" ; exit ;;-    --help | --h* | -h )-       echo "$usage"; exit ;;-    -- )     # Stop option processing-       shift; break ;;-    - )	# Use stdin as input.-       break ;;-    -* )-       echo "$me: invalid option $1$help" >&2-       exit 1 ;;-    * )-       break ;;-  esac-done--if test $# != 0; then-  echo "$me: too many arguments$help" >&2-  exit 1-fi--trap 'exit 1' 1 2 15--# CC_FOR_BUILD -- compiler used by this script. Note that the use of a-# compiler to aid in system detection is discouraged as it requires-# temporary files to be created and, as you can see below, it is a-# headache to deal with in a portable fashion.--# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still-# use `HOST_CC' if defined, but it is deprecated.--# Portable tmp directory creation inspired by the Autoconf team.--set_cc_for_build='-trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;-trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;-: ${TMPDIR=/tmp} ;- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;-dummy=$tmp/dummy ;-tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;-case $CC_FOR_BUILD,$HOST_CC,$CC in- ,,)    echo "int x;" > $dummy.c ;-	for c in cc gcc c89 c99 ; do-	  if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then-	     CC_FOR_BUILD="$c"; break ;-	  fi ;-	done ;-	if test x"$CC_FOR_BUILD" = x ; then-	  CC_FOR_BUILD=no_compiler_found ;-	fi-	;;- ,,*)   CC_FOR_BUILD=$CC ;;- ,*,*)  CC_FOR_BUILD=$HOST_CC ;;-esac ; set_cc_for_build= ;'--# This is needed to find uname on a Pyramid OSx when run in the BSD universe.-# (ghazi@noc.rutgers.edu 1994-08-24)-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then-	PATH=$PATH:/.attbin ; export PATH-fi--UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown-UNAME_SYSTEM=`(uname -s) 2>/dev/null`  || UNAME_SYSTEM=unknown-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown--# Note: order is significant - the case branches are not exclusive.--case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in-    *:NetBSD:*:*)-	# NetBSD (nbsd) targets should (where applicable) match one or-	# more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*,-	# *-*-netbsdecoff* and *-*-netbsd*.  For targets that recently-	# switched to ELF, *-*-netbsd* would select the old-	# object file format.  This provides both forward-	# compatibility and a consistent mechanism for selecting the-	# object file format.-	#-	# Note: NetBSD doesn't particularly care about the vendor-	# portion of the name.  We always set it to "unknown".-	sysctl="sysctl -n hw.machine_arch"-	UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \-	    /usr/sbin/$sysctl 2>/dev/null || echo unknown)`-	case "${UNAME_MACHINE_ARCH}" in-	    armeb) machine=armeb-unknown ;;-	    arm*) machine=arm-unknown ;;-	    sh3el) machine=shl-unknown ;;-	    sh3eb) machine=sh-unknown ;;-	    *) machine=${UNAME_MACHINE_ARCH}-unknown ;;-	esac-	# The Operating System including object format, if it has switched-	# to ELF recently, or will in the future.-	case "${UNAME_MACHINE_ARCH}" in-	    arm*|i386|m68k|ns32k|sh3*|sparc|vax)-		eval $set_cc_for_build-		if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \-			| grep __ELF__ >/dev/null-		then-		    # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).-		    # Return netbsd for either.  FIX?-		    os=netbsd-		else-		    os=netbsdelf-		fi-		;;-	    *)-	        os=netbsd-		;;-	esac-	# The OS release-	# Debian GNU/NetBSD machines have a different userland, and-	# thus, need a distinct triplet. However, they do not need-	# kernel version information, so it can be replaced with a-	# suitable tag, in the style of linux-gnu.-	case "${UNAME_VERSION}" in-	    Debian*)-		release='-gnu'-		;;-	    *)-		release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`-		;;-	esac-	# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:-	# contains redundant information, the shorter form:-	# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.-	echo "${machine}-${os}${release}"-	exit ;;-    *:OpenBSD:*:*)-	UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`-	echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}-	exit ;;-    *:ekkoBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}-	exit ;;-    *:SolidBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}-	exit ;;-    macppc:MirBSD:*:*)-	echo powerppc-unknown-mirbsd${UNAME_RELEASE}-	exit ;;-    *:MirBSD:*:*)-	echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}-	exit ;;-    alpha:OSF1:*:*)-	case $UNAME_RELEASE in-	*4.0)-		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`-		;;-	*5.*)-	        UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`-		;;-	esac-	# According to Compaq, /usr/sbin/psrinfo has been available on-	# OSF/1 and Tru64 systems produced since 1995.  I hope that-	# covers most systems running today.  This code pipes the CPU-	# types through head -n 1, so we only detect the type of CPU 0.-	ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^  The alpha \(.*\) processor.*$/\1/p' | head -n 1`-	case "$ALPHA_CPU_TYPE" in-	    "EV4 (21064)")-		UNAME_MACHINE="alpha" ;;-	    "EV4.5 (21064)")-		UNAME_MACHINE="alpha" ;;-	    "LCA4 (21066/21068)")-		UNAME_MACHINE="alpha" ;;-	    "EV5 (21164)")-		UNAME_MACHINE="alphaev5" ;;-	    "EV5.6 (21164A)")-		UNAME_MACHINE="alphaev56" ;;-	    "EV5.6 (21164PC)")-		UNAME_MACHINE="alphapca56" ;;-	    "EV5.7 (21164PC)")-		UNAME_MACHINE="alphapca57" ;;-	    "EV6 (21264)")-		UNAME_MACHINE="alphaev6" ;;-	    "EV6.7 (21264A)")-		UNAME_MACHINE="alphaev67" ;;-	    "EV6.8CB (21264C)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.8AL (21264B)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.8CX (21264D)")-		UNAME_MACHINE="alphaev68" ;;-	    "EV6.9A (21264/EV69A)")-		UNAME_MACHINE="alphaev69" ;;-	    "EV7 (21364)")-		UNAME_MACHINE="alphaev7" ;;-	    "EV7.9 (21364A)")-		UNAME_MACHINE="alphaev79" ;;-	esac-	# A Pn.n version is a patched version.-	# A Vn.n version is a released version.-	# A Tn.n version is a released field test version.-	# A Xn.n version is an unreleased experimental baselevel.-	# 1.2 uses "1.2" for uname -r.-	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`-	exit ;;-    Alpha\ *:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# Should we change UNAME_MACHINE based on the output of uname instead-	# of the specific Alpha model?-	echo alpha-pc-interix-	exit ;;-    21064:Windows_NT:50:3)-	echo alpha-dec-winnt3.5-	exit ;;-    Amiga*:UNIX_System_V:4.0:*)-	echo m68k-unknown-sysv4-	exit ;;-    *:[Aa]miga[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-amigaos-	exit ;;-    *:[Mm]orph[Oo][Ss]:*:*)-	echo ${UNAME_MACHINE}-unknown-morphos-	exit ;;-    *:OS/390:*:*)-	echo i370-ibm-openedition-	exit ;;-    *:z/VM:*:*)-	echo s390-ibm-zvmoe-	exit ;;-    *:OS400:*:*)-        echo powerpc-ibm-os400-	exit ;;-    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)-	echo arm-acorn-riscix${UNAME_RELEASE}-	exit ;;-    arm:riscos:*:*|arm:RISCOS:*:*)-	echo arm-unknown-riscos-	exit ;;-    SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)-	echo hppa1.1-hitachi-hiuxmpp-	exit ;;-    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)-	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.-	if test "`(/bin/universe) 2>/dev/null`" = att ; then-		echo pyramid-pyramid-sysv3-	else-		echo pyramid-pyramid-bsd-	fi-	exit ;;-    NILE*:*:*:dcosx)-	echo pyramid-pyramid-svr4-	exit ;;-    DRS?6000:unix:4.0:6*)-	echo sparc-icl-nx6-	exit ;;-    DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)-	case `/usr/bin/uname -p` in-	    sparc) echo sparc-icl-nx7; exit ;;-	esac ;;-    sun4H:SunOS:5.*:*)-	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)-	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    i86pc:SunOS:5.*:*)-	echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:6*:*)-	# According to config.sub, this is the proper way to canonicalize-	# SunOS6.  Hard to guess exactly what SunOS6 will be like, but-	# it's likely to be more like Solaris than SunOS4.-	echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    sun4*:SunOS:*:*)-	case "`/usr/bin/arch -k`" in-	    Series*|S4*)-		UNAME_RELEASE=`uname -v`-		;;-	esac-	# Japanese Language versions have a version number like `4.1.3-JL'.-	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`-	exit ;;-    sun3*:SunOS:*:*)-	echo m68k-sun-sunos${UNAME_RELEASE}-	exit ;;-    sun*:*:4.2BSD:*)-	UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`-	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3-	case "`/bin/arch`" in-	    sun3)-		echo m68k-sun-sunos${UNAME_RELEASE}-		;;-	    sun4)-		echo sparc-sun-sunos${UNAME_RELEASE}-		;;-	esac-	exit ;;-    aushp:SunOS:*:*)-	echo sparc-auspex-sunos${UNAME_RELEASE}-	exit ;;-    # The situation for MiNT is a little confusing.  The machine name-    # can be virtually everything (everything which is not-    # "atarist" or "atariste" at least should have a processor-    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"-    # to the lowercase version "mint" (or "freemint").  Finally-    # the system name "TOS" denotes a system which is actually not-    # MiNT.  But MiNT is downward compatible to TOS, so this should-    # be no problem.-    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)-        echo m68k-atari-mint${UNAME_RELEASE}-	exit ;;-    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)-	echo m68k-atari-mint${UNAME_RELEASE}-        exit ;;-    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)-        echo m68k-atari-mint${UNAME_RELEASE}-	exit ;;-    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)-        echo m68k-milan-mint${UNAME_RELEASE}-        exit ;;-    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)-        echo m68k-hades-mint${UNAME_RELEASE}-        exit ;;-    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)-        echo m68k-unknown-mint${UNAME_RELEASE}-        exit ;;-    m68k:machten:*:*)-	echo m68k-apple-machten${UNAME_RELEASE}-	exit ;;-    powerpc:machten:*:*)-	echo powerpc-apple-machten${UNAME_RELEASE}-	exit ;;-    RISC*:Mach:*:*)-	echo mips-dec-mach_bsd4.3-	exit ;;-    RISC*:ULTRIX:*:*)-	echo mips-dec-ultrix${UNAME_RELEASE}-	exit ;;-    VAX*:ULTRIX*:*:*)-	echo vax-dec-ultrix${UNAME_RELEASE}-	exit ;;-    2020:CLIX:*:* | 2430:CLIX:*:*)-	echo clipper-intergraph-clix${UNAME_RELEASE}-	exit ;;-    mips:*:*:UMIPS | mips:*:*:RISCos)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-#ifdef __cplusplus-#include <stdio.h>  /* for printf() prototype */-	int main (int argc, char *argv[]) {-#else-	int main (argc, argv) int argc; char *argv[]; {-#endif-	#if defined (host_mips) && defined (MIPSEB)-	#if defined (SYSTYPE_SYSV)-	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);-	#endif-	#if defined (SYSTYPE_SVR4)-	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);-	#endif-	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)-	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);-	#endif-	#endif-	  exit (-1);-	}-EOF-	$CC_FOR_BUILD -o $dummy $dummy.c &&-	  dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&-	  SYSTEM_NAME=`$dummy $dummyarg` &&-	    { echo "$SYSTEM_NAME"; exit; }-	echo mips-mips-riscos${UNAME_RELEASE}-	exit ;;-    Motorola:PowerMAX_OS:*:*)-	echo powerpc-motorola-powermax-	exit ;;-    Motorola:*:4.3:PL8-*)-	echo powerpc-harris-powermax-	exit ;;-    Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)-	echo powerpc-harris-powermax-	exit ;;-    Night_Hawk:Power_UNIX:*:*)-	echo powerpc-harris-powerunix-	exit ;;-    m88k:CX/UX:7*:*)-	echo m88k-harris-cxux7-	exit ;;-    m88k:*:4*:R4*)-	echo m88k-motorola-sysv4-	exit ;;-    m88k:*:3*:R3*)-	echo m88k-motorola-sysv3-	exit ;;-    AViiON:dgux:*:*)-        # DG/UX returns AViiON for all architectures-        UNAME_PROCESSOR=`/usr/bin/uname -p`-	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]-	then-	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \-	       [ ${TARGET_BINARY_INTERFACE}x = x ]-	    then-		echo m88k-dg-dgux${UNAME_RELEASE}-	    else-		echo m88k-dg-dguxbcs${UNAME_RELEASE}-	    fi-	else-	    echo i586-dg-dgux${UNAME_RELEASE}-	fi- 	exit ;;-    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)-	echo m88k-dolphin-sysv3-	exit ;;-    M88*:*:R3*:*)-	# Delta 88k system running SVR3-	echo m88k-motorola-sysv3-	exit ;;-    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)-	echo m88k-tektronix-sysv3-	exit ;;-    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)-	echo m68k-tektronix-bsd-	exit ;;-    *:IRIX*:*:*)-	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`-	exit ;;-    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.-	echo romp-ibm-aix     # uname -m gives an 8 hex-code CPU id-	exit ;;               # Note that: echo "'`uname -s`'" gives 'AIX '-    i*86:AIX:*:*)-	echo i386-ibm-aix-	exit ;;-    ia64:AIX:*:*)-	if [ -x /usr/bin/oslevel ] ; then-		IBM_REV=`/usr/bin/oslevel`-	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}-	fi-	echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}-	exit ;;-    *:AIX:2:3)-	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then-		eval $set_cc_for_build-		sed 's/^		//' << EOF >$dummy.c-		#include <sys/systemcfg.h>--		main()-			{-			if (!__power_pc())-				exit(1);-			puts("powerpc-ibm-aix3.2.5");-			exit(0);-			}-EOF-		if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`-		then-			echo "$SYSTEM_NAME"-		else-			echo rs6000-ibm-aix3.2.5-		fi-	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then-		echo rs6000-ibm-aix3.2.4-	else-		echo rs6000-ibm-aix3.2-	fi-	exit ;;-    *:AIX:*:[45])-	IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`-	if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then-		IBM_ARCH=rs6000-	else-		IBM_ARCH=powerpc-	fi-	if [ -x /usr/bin/oslevel ] ; then-		IBM_REV=`/usr/bin/oslevel`-	else-		IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}-	fi-	echo ${IBM_ARCH}-ibm-aix${IBM_REV}-	exit ;;-    *:AIX:*:*)-	echo rs6000-ibm-aix-	exit ;;-    ibmrt:4.4BSD:*|romp-ibm:BSD:*)-	echo romp-ibm-bsd4.4-	exit ;;-    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and-	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to-	exit ;;                             # report: romp-ibm BSD 4.3-    *:BOSX:*:*)-	echo rs6000-bull-bosx-	exit ;;-    DPX/2?00:B.O.S.:*:*)-	echo m68k-bull-sysv3-	exit ;;-    9000/[34]??:4.3bsd:1.*:*)-	echo m68k-hp-bsd-	exit ;;-    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)-	echo m68k-hp-bsd4.4-	exit ;;-    9000/[34678]??:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	case "${UNAME_MACHINE}" in-	    9000/31? )            HP_ARCH=m68000 ;;-	    9000/[34]?? )         HP_ARCH=m68k ;;-	    9000/[678][0-9][0-9])-		if [ -x /usr/bin/getconf ]; then-		    sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`-                    sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`-                    case "${sc_cpu_version}" in-                      523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0-                      528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1-                      532)                      # CPU_PA_RISC2_0-                        case "${sc_kernel_bits}" in-                          32) HP_ARCH="hppa2.0n" ;;-                          64) HP_ARCH="hppa2.0w" ;;-			  '') HP_ARCH="hppa2.0" ;;   # HP-UX 10.20-                        esac ;;-                    esac-		fi-		if [ "${HP_ARCH}" = "" ]; then-		    eval $set_cc_for_build-		    sed 's/^              //' << EOF >$dummy.c--              #define _HPUX_SOURCE-              #include <stdlib.h>-              #include <unistd.h>--              int main ()-              {-              #if defined(_SC_KERNEL_BITS)-                  long bits = sysconf(_SC_KERNEL_BITS);-              #endif-                  long cpu  = sysconf (_SC_CPU_VERSION);--                  switch (cpu)-              	{-              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;-              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;-              	case CPU_PA_RISC2_0:-              #if defined(_SC_KERNEL_BITS)-              	    switch (bits)-              		{-              		case 64: puts ("hppa2.0w"); break;-              		case 32: puts ("hppa2.0n"); break;-              		default: puts ("hppa2.0"); break;-              		} break;-              #else  /* !defined(_SC_KERNEL_BITS) */-              	    puts ("hppa2.0"); break;-              #endif-              	default: puts ("hppa1.0"); break;-              	}-                  exit (0);-              }-EOF-		    (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`-		    test -z "$HP_ARCH" && HP_ARCH=hppa-		fi ;;-	esac-	if [ ${HP_ARCH} = "hppa2.0w" ]-	then-	    eval $set_cc_for_build--	    # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating-	    # 32-bit code.  hppa64-hp-hpux* has the same kernel and a compiler-	    # generating 64-bit code.  GNU and HP use different nomenclature:-	    #-	    # $ CC_FOR_BUILD=cc ./config.guess-	    # => hppa2.0w-hp-hpux11.23-	    # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess-	    # => hppa64-hp-hpux11.23--	    if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |-		grep __LP64__ >/dev/null-	    then-		HP_ARCH="hppa2.0w"-	    else-		HP_ARCH="hppa64"-	    fi-	fi-	echo ${HP_ARCH}-hp-hpux${HPUX_REV}-	exit ;;-    ia64:HP-UX:*:*)-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`-	echo ia64-hp-hpux${HPUX_REV}-	exit ;;-    3050*:HI-UX:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#include <unistd.h>-	int-	main ()-	{-	  long cpu = sysconf (_SC_CPU_VERSION);-	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns-	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct-	     results, however.  */-	  if (CPU_IS_PA_RISC (cpu))-	    {-	      switch (cpu)-		{-		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;-		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;-		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;-		  default: puts ("hppa-hitachi-hiuxwe2"); break;-		}-	    }-	  else if (CPU_IS_HP_MC68K (cpu))-	    puts ("m68k-hitachi-hiuxwe2");-	  else puts ("unknown-hitachi-hiuxwe2");-	  exit (0);-	}-EOF-	$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&-		{ echo "$SYSTEM_NAME"; exit; }-	echo unknown-hitachi-hiuxwe2-	exit ;;-    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )-	echo hppa1.1-hp-bsd-	exit ;;-    9000/8??:4.3bsd:*:*)-	echo hppa1.0-hp-bsd-	exit ;;-    *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)-	echo hppa1.0-hp-mpeix-	exit ;;-    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )-	echo hppa1.1-hp-osf-	exit ;;-    hp8??:OSF1:*:*)-	echo hppa1.0-hp-osf-	exit ;;-    i*86:OSF1:*:*)-	if [ -x /usr/sbin/sysversion ] ; then-	    echo ${UNAME_MACHINE}-unknown-osf1mk-	else-	    echo ${UNAME_MACHINE}-unknown-osf1-	fi-	exit ;;-    parisc*:Lites*:*:*)-	echo hppa1.1-hp-lites-	exit ;;-    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)-	echo c1-convex-bsd-        exit ;;-    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)-	if getsysinfo -f scalar_acc-	then echo c32-convex-bsd-	else echo c2-convex-bsd-	fi-        exit ;;-    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)-	echo c34-convex-bsd-        exit ;;-    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)-	echo c38-convex-bsd-        exit ;;-    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)-	echo c4-convex-bsd-        exit ;;-    CRAY*Y-MP:*:*:*)-	echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*[A-Z]90:*:*:*)-	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \-	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \-	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \-	      -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*TS:*:*:*)-	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*T3E:*:*:*)-	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    CRAY*SV1:*:*:*)-	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    *:UNICOS/mp:*:*)-	echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'-	exit ;;-    F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)-	FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`-        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`-        echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"-        exit ;;-    5000:UNIX_System_V:4.*:*)-        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`-        FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`-        echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"-	exit ;;-    i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)-	echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}-	exit ;;-    sparc*:BSD/OS:*:*)-	echo sparc-unknown-bsdi${UNAME_RELEASE}-	exit ;;-    *:BSD/OS:*:*)-	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}-	exit ;;-    *:FreeBSD:*:*)-	case ${UNAME_MACHINE} in-	    pc98)-		echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;-	    *)-		echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;-	esac-	exit ;;-    i*:CYGWIN*:*)-	echo ${UNAME_MACHINE}-pc-cygwin-	exit ;;-    i*:MINGW*:*)-	echo ${UNAME_MACHINE}-pc-mingw32-	exit ;;-    i*:MSYS_NT-*:*:*)-	echo ${UNAME_MACHINE}-pc-mingw32-	exit ;;-    i*:windows32*:*)-    	# uname -m includes "-pc" on this system.-    	echo ${UNAME_MACHINE}-mingw32-	exit ;;-    i*:PW*:*)-	echo ${UNAME_MACHINE}-pc-pw32-	exit ;;-    x86:Interix*:[345]*)-	echo i586-pc-interix${UNAME_RELEASE}-	exit ;;-    EM64T:Interix*:[345]*)-	echo x86_64-unknown-interix${UNAME_RELEASE}-	exit ;;-    [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)-	echo i${UNAME_MACHINE}-pc-mks-	exit ;;-    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)-	# How do we know it's Interix rather than the generic POSIX subsystem?-	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we-	# UNAME_MACHINE based on the output of uname instead of i386?-	echo i586-pc-interix-	exit ;;-    i*:UWIN*:*)-	echo ${UNAME_MACHINE}-pc-uwin-	exit ;;-    amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)-	echo x86_64-unknown-cygwin-	exit ;;-    p*:CYGWIN*:*)-	echo powerpcle-unknown-cygwin-	exit ;;-    prep*:SunOS:5.*:*)-	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`-	exit ;;-    *:GNU:*:*)-	# the GNU system-	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`-	exit ;;-    *:GNU/*:*:*)-	# other systems with GNU libc and userland-	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu-	exit ;;-    i*86:Minix:*:*)-	echo ${UNAME_MACHINE}-pc-minix-	exit ;;-    arm*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    cris:Linux:*:*)-	echo cris-axis-linux-gnu-	exit ;;-    crisv32:Linux:*:*)-	echo crisv32-axis-linux-gnu-	exit ;;-    frv:Linux:*:*)-    	echo frv-unknown-linux-gnu-	exit ;;-    ia64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    m32r*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    m68*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    mips:Linux:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#undef CPU-	#undef mips-	#undef mipsel-	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)-	CPU=mipsel-	#else-	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)-	CPU=mips-	#else-	CPU=-	#endif-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^CPU/{-		s: ::g-		p-	    }'`"-	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }-	;;-    mips64:Linux:*:*)-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#undef CPU-	#undef mips64-	#undef mips64el-	#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)-	CPU=mips64el-	#else-	#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)-	CPU=mips64-	#else-	CPU=-	#endif-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^CPU/{-		s: ::g-		p-	    }'`"-	test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }-	;;-    or32:Linux:*:*)-	echo or32-unknown-linux-gnu-	exit ;;-    ppc:Linux:*:*)-	echo powerpc-unknown-linux-gnu-	exit ;;-    ppc64:Linux:*:*)-	echo powerpc64-unknown-linux-gnu-	exit ;;-    alpha:Linux:*:*)-	case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in-	  EV5)   UNAME_MACHINE=alphaev5 ;;-	  EV56)  UNAME_MACHINE=alphaev56 ;;-	  PCA56) UNAME_MACHINE=alphapca56 ;;-	  PCA57) UNAME_MACHINE=alphapca56 ;;-	  EV6)   UNAME_MACHINE=alphaev6 ;;-	  EV67)  UNAME_MACHINE=alphaev67 ;;-	  EV68*) UNAME_MACHINE=alphaev68 ;;-        esac-	objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null-	if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi-	echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}-	exit ;;-    parisc:Linux:*:* | hppa:Linux:*:*)-	# Look for CPU level-	case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in-	  PA7*) echo hppa1.1-unknown-linux-gnu ;;-	  PA8*) echo hppa2.0-unknown-linux-gnu ;;-	  *)    echo hppa-unknown-linux-gnu ;;-	esac-	exit ;;-    parisc64:Linux:*:* | hppa64:Linux:*:*)-	echo hppa64-unknown-linux-gnu-	exit ;;-    s390:Linux:*:* | s390x:Linux:*:*)-	echo ${UNAME_MACHINE}-ibm-linux-	exit ;;-    sh64*:Linux:*:*)-    	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    sh*:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    sparc:Linux:*:* | sparc64:Linux:*:*)-	echo ${UNAME_MACHINE}-unknown-linux-gnu-	exit ;;-    vax:Linux:*:*)-	echo ${UNAME_MACHINE}-dec-linux-gnu-	exit ;;-    x86_64:Linux:*:*)-	echo x86_64-unknown-linux-gnu-	exit ;;-    i*86:Linux:*:*)-	# The BFD linker knows what the default object file format is, so-	# first see if it will tell us. cd to the root directory to prevent-	# problems with other programs or directories called `ld' in the path.-	# Set LC_ALL=C to ensure ld outputs messages in English.-	ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \-			 | sed -ne '/supported targets:/!d-				    s/[ 	][ 	]*/ /g-				    s/.*supported targets: *//-				    s/ .*//-				    p'`-        case "$ld_supported_targets" in-	  elf32-i386)-		TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"-		;;-	  a.out-i386-linux)-		echo "${UNAME_MACHINE}-pc-linux-gnuaout"-		exit ;;-	  coff-i386)-		echo "${UNAME_MACHINE}-pc-linux-gnucoff"-		exit ;;-	  "")-		# Either a pre-BFD a.out linker (linux-gnuoldld) or-		# one that does not give us useful --help.-		echo "${UNAME_MACHINE}-pc-linux-gnuoldld"-		exit ;;-	esac-	# Determine whether the default compiler is a.out or elf-	eval $set_cc_for_build-	sed 's/^	//' << EOF >$dummy.c-	#include <features.h>-	#ifdef __ELF__-	# ifdef __GLIBC__-	#  if __GLIBC__ >= 2-	LIBC=gnu-	#  else-	LIBC=gnulibc1-	#  endif-	# else-	LIBC=gnulibc1-	# endif-	#else-	#if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__sun)-	LIBC=gnu-	#else-	LIBC=gnuaout-	#endif-	#endif-	#ifdef __dietlibc__-	LIBC=dietlibc-	#endif-EOF-	eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '-	    /^LIBC/{-		s: ::g-		p-	    }'`"-	test x"${LIBC}" != x && {-		echo "${UNAME_MACHINE}-pc-linux-${LIBC}"-		exit-	}-	test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }-	;;-    i*86:DYNIX/ptx:4*:*)-	# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.-	# earlier versions are messed up and put the nodename in both-	# sysname and nodename.-	echo i386-sequent-sysv4-	exit ;;-    i*86:UNIX_SV:4.2MP:2.*)-        # Unixware is an offshoot of SVR4, but it has its own version-        # number series starting with 2...-        # I am not positive that other SVR4 systems won't match this,-	# I just have to hope.  -- rms.-        # Use sysv4.2uw... so that sysv4* matches it.-	echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}-	exit ;;-    i*86:OS/2:*:*)-	# If we were able to find `uname', then EMX Unix compatibility-	# is probably installed.-	echo ${UNAME_MACHINE}-pc-os2-emx-	exit ;;-    i*86:XTS-300:*:STOP)-	echo ${UNAME_MACHINE}-unknown-stop-	exit ;;-    i*86:atheos:*:*)-	echo ${UNAME_MACHINE}-unknown-atheos-	exit ;;-    i*86:syllable:*:*)-	echo ${UNAME_MACHINE}-pc-syllable-	exit ;;-    i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*)-	echo i386-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    i*86:*DOS:*:*)-	echo ${UNAME_MACHINE}-pc-msdosdjgpp-	exit ;;-    i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)-	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`-	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then-		echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}-	else-		echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}-	fi-	exit ;;-    i*86:*:5:[678]*)-    	# UnixWare 7.x, OpenUNIX and OpenServer 6.-	case `/bin/uname -X | grep "^Machine"` in-	    *486*)	     UNAME_MACHINE=i486 ;;-	    *Pentium)	     UNAME_MACHINE=i586 ;;-	    *Pent*|*Celeron) UNAME_MACHINE=i686 ;;-	esac-	echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}-	exit ;;-    i*86:*:3.2:*)-	if test -f /usr/options/cb.name; then-		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`-		echo ${UNAME_MACHINE}-pc-isc$UNAME_REL-	elif /bin/uname -X 2>/dev/null >/dev/null ; then-		UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`-		(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486-		(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \-			&& UNAME_MACHINE=i586-		(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \-			&& UNAME_MACHINE=i686-		(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \-			&& UNAME_MACHINE=i686-		echo ${UNAME_MACHINE}-pc-sco$UNAME_REL-	else-		echo ${UNAME_MACHINE}-pc-sysv32-	fi-	exit ;;-    pc:*:*:*)-	# Left here for compatibility:-        # uname -m prints for DJGPP always 'pc', but it prints nothing about-        # the processor, so we play safe by assuming i386.-	echo i386-pc-msdosdjgpp-        exit ;;-    Intel:Mach:3*:*)-	echo i386-pc-mach3-	exit ;;-    paragon:*:*:*)-	echo i860-intel-osf1-	exit ;;-    i860:*:4.*:*) # i860-SVR4-	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then-	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4-	else # Add other i860-SVR4 vendors below as they are discovered.-	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4-	fi-	exit ;;-    mini*:CTIX:SYS*5:*)-	# "miniframe"-	echo m68010-convergent-sysv-	exit ;;-    mc68k:UNIX:SYSTEM5:3.51m)-	echo m68k-convergent-sysv-	exit ;;-    M680?0:D-NIX:5.3:*)-	echo m68k-diab-dnix-	exit ;;-    M68*:*:R3V[5678]*:*)-	test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;-    3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)-	OS_REL=''-	test -r /etc/.relid \-	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`-	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \-	  && { echo i486-ncr-sysv4.3${OS_REL}; exit; }-	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \-	  && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;-    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)-        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \-          && { echo i486-ncr-sysv4; exit; } ;;-    m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)-	echo m68k-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    mc68030:UNIX_System_V:4.*:*)-	echo m68k-atari-sysv4-	exit ;;-    TSUNAMI:LynxOS:2.*:*)-	echo sparc-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    rs6000:LynxOS:2.*:*)-	echo rs6000-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*)-	echo powerpc-unknown-lynxos${UNAME_RELEASE}-	exit ;;-    SM[BE]S:UNIX_SV:*:*)-	echo mips-dde-sysv${UNAME_RELEASE}-	exit ;;-    RM*:ReliantUNIX-*:*:*)-	echo mips-sni-sysv4-	exit ;;-    RM*:SINIX-*:*:*)-	echo mips-sni-sysv4-	exit ;;-    *:SINIX-*:*:*)-	if uname -p 2>/dev/null >/dev/null ; then-		UNAME_MACHINE=`(uname -p) 2>/dev/null`-		echo ${UNAME_MACHINE}-sni-sysv4-	else-		echo ns32k-sni-sysv-	fi-	exit ;;-    PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort-                      # says <Richard.M.Bartel@ccMail.Census.GOV>-        echo i586-unisys-sysv4-        exit ;;-    *:UNIX_System_V:4*:FTX*)-	# From Gerald Hewes <hewes@openmarket.com>.-	# How about differentiating between stratus architectures? -djm-	echo hppa1.1-stratus-sysv4-	exit ;;-    *:*:*:FTX*)-	# From seanf@swdc.stratus.com.-	echo i860-stratus-sysv4-	exit ;;-    i*86:VOS:*:*)-	# From Paul.Green@stratus.com.-	echo ${UNAME_MACHINE}-stratus-vos-	exit ;;-    *:VOS:*:*)-	# From Paul.Green@stratus.com.-	echo hppa1.1-stratus-vos-	exit ;;-    mc68*:A/UX:*:*)-	echo m68k-apple-aux${UNAME_RELEASE}-	exit ;;-    news*:NEWS-OS:6*:*)-	echo mips-sony-newsos6-	exit ;;-    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)-	if [ -d /usr/nec ]; then-	        echo mips-nec-sysv${UNAME_RELEASE}-	else-	        echo mips-unknown-sysv${UNAME_RELEASE}-	fi-        exit ;;-    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.-	echo powerpc-be-beos-	exit ;;-    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.-	echo powerpc-apple-beos-	exit ;;-    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.-	echo i586-pc-beos-	exit ;;-    SX-4:SUPER-UX:*:*)-	echo sx4-nec-superux${UNAME_RELEASE}-	exit ;;-    SX-5:SUPER-UX:*:*)-	echo sx5-nec-superux${UNAME_RELEASE}-	exit ;;-    SX-6:SUPER-UX:*:*)-	echo sx6-nec-superux${UNAME_RELEASE}-	exit ;;-    Power*:Rhapsody:*:*)-	echo powerpc-apple-rhapsody${UNAME_RELEASE}-	exit ;;-    *:Rhapsody:*:*)-	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}-	exit ;;-    *:Darwin:*:*)-	UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown-	case $UNAME_PROCESSOR in-	    unknown) UNAME_PROCESSOR=powerpc ;;-	esac-	echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}-	exit ;;-    *:procnto*:*:* | *:QNX:[0123456789]*:*)-	UNAME_PROCESSOR=`uname -p`-	if test "$UNAME_PROCESSOR" = "x86"; then-		UNAME_PROCESSOR=i386-		UNAME_MACHINE=pc-	fi-	echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}-	exit ;;-    *:QNX:*:4*)-	echo i386-pc-qnx-	exit ;;-    NSE-?:NONSTOP_KERNEL:*:*)-	echo nse-tandem-nsk${UNAME_RELEASE}-	exit ;;-    NSR-?:NONSTOP_KERNEL:*:*)-	echo nsr-tandem-nsk${UNAME_RELEASE}-	exit ;;-    *:NonStop-UX:*:*)-	echo mips-compaq-nonstopux-	exit ;;-    BS2000:POSIX*:*:*)-	echo bs2000-siemens-sysv-	exit ;;-    DS/*:UNIX_System_V:*:*)-	echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}-	exit ;;-    *:Plan9:*:*)-	# "uname -m" is not consistent, so use $cputype instead. 386-	# is converted to i386 for consistency with other x86-	# operating systems.-	if test "$cputype" = "386"; then-	    UNAME_MACHINE=i386-	else-	    UNAME_MACHINE="$cputype"-	fi-	echo ${UNAME_MACHINE}-unknown-plan9-	exit ;;-    *:TOPS-10:*:*)-	echo pdp10-unknown-tops10-	exit ;;-    *:TENEX:*:*)-	echo pdp10-unknown-tenex-	exit ;;-    KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)-	echo pdp10-dec-tops20-	exit ;;-    XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)-	echo pdp10-xkl-tops20-	exit ;;-    *:TOPS-20:*:*)-	echo pdp10-unknown-tops20-	exit ;;-    *:ITS:*:*)-	echo pdp10-unknown-its-	exit ;;-    SEI:*:*:SEIUX)-        echo mips-sei-seiux${UNAME_RELEASE}-	exit ;;-    *:DragonFly:*:*)-	echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-	exit ;;-    *:*VMS:*:*)-    	UNAME_MACHINE=`(uname -p) 2>/dev/null`-	case "${UNAME_MACHINE}" in-	    A*) echo alpha-dec-vms ; exit ;;-	    I*) echo ia64-dec-vms ; exit ;;-	    V*) echo vax-dec-vms ; exit ;;-	esac ;;-    *:XENIX:*:SysV)-	echo i386-pc-xenix-	exit ;;-    i*86:skyos:*:*)-	echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'-	exit ;;-    i*86:rdos:*:*)-	echo ${UNAME_MACHINE}-pc-rdos-	exit ;;-esac--#echo '(No uname command or uname output not recognized.)' 1>&2-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2--eval $set_cc_for_build-cat >$dummy.c <<EOF-#ifdef _SEQUENT_-# include <sys/types.h>-# include <sys/utsname.h>-#endif-main ()-{-#if defined (sony)-#if defined (MIPSEB)-  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,-     I don't know....  */-  printf ("mips-sony-bsd\n"); exit (0);-#else-#include <sys/param.h>-  printf ("m68k-sony-newsos%s\n",-#ifdef NEWSOS4-          "4"-#else-	  ""-#endif-         ); exit (0);-#endif-#endif--#if defined (__arm) && defined (__acorn) && defined (__unix)-  printf ("arm-acorn-riscix\n"); exit (0);-#endif--#if defined (hp300) && !defined (hpux)-  printf ("m68k-hp-bsd\n"); exit (0);-#endif--#if defined (NeXT)-#if !defined (__ARCHITECTURE__)-#define __ARCHITECTURE__ "m68k"-#endif-  int version;-  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;-  if (version < 4)-    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);-  else-    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);-  exit (0);-#endif--#if defined (MULTIMAX) || defined (n16)-#if defined (UMAXV)-  printf ("ns32k-encore-sysv\n"); exit (0);-#else-#if defined (CMU)-  printf ("ns32k-encore-mach\n"); exit (0);-#else-  printf ("ns32k-encore-bsd\n"); exit (0);-#endif-#endif-#endif--#if defined (__386BSD__)-  printf ("i386-pc-bsd\n"); exit (0);-#endif--#if defined (sequent)-#if defined (i386)-  printf ("i386-sequent-dynix\n"); exit (0);-#endif-#if defined (ns32000)-  printf ("ns32k-sequent-dynix\n"); exit (0);-#endif-#endif--#if defined (_SEQUENT_)-    struct utsname un;--    uname(&un);--    if (strncmp(un.version, "V2", 2) == 0) {-	printf ("i386-sequent-ptx2\n"); exit (0);-    }-    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */-	printf ("i386-sequent-ptx1\n"); exit (0);-    }-    printf ("i386-sequent-ptx\n"); exit (0);--#endif--#if defined (vax)-# if !defined (ultrix)-#  include <sys/param.h>-#  if defined (BSD)-#   if BSD == 43-      printf ("vax-dec-bsd4.3\n"); exit (0);-#   else-#    if BSD == 199006-      printf ("vax-dec-bsd4.3reno\n"); exit (0);-#    else-      printf ("vax-dec-bsd\n"); exit (0);-#    endif-#   endif-#  else-    printf ("vax-dec-bsd\n"); exit (0);-#  endif-# else-    printf ("vax-dec-ultrix\n"); exit (0);-# endif-#endif--#if defined (alliant) && defined (i860)-  printf ("i860-alliant-bsd\n"); exit (0);-#endif--  exit (1);-}-EOF--$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&-	{ echo "$SYSTEM_NAME"; exit; }--# Apollos put the system type in the environment.--test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }--# Convex versions that predate uname can use getsysinfo(1)--if [ -x /usr/convex/getsysinfo ]-then-    case `getsysinfo -f cpu_type` in-    c1*)-	echo c1-convex-bsd-	exit ;;-    c2*)-	if getsysinfo -f scalar_acc-	then echo c32-convex-bsd-	else echo c2-convex-bsd-	fi-	exit ;;-    c34*)-	echo c34-convex-bsd-	exit ;;-    c38*)-	echo c38-convex-bsd-	exit ;;-    c4*)-	echo c4-convex-bsd-	exit ;;-    esac-fi--cat >&2 <<EOF-$0: unable to guess system type--This script, last modified $timestamp, has failed to recognize-the operating system you are using. It is advised that you-download the most up to date version of the config scripts from--  http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.guess-and-  http://savannah.gnu.org/cgi-bin/viewcvs/*checkout*/config/config/config.sub--If the version you run ($0) is already up to date, please-send the following data and any information you think might be-pertinent to <config-patches@gnu.org> in order to provide the needed-information to handle your system.--config.guess timestamp = $timestamp--uname -m = `(uname -m) 2>/dev/null || echo unknown`-uname -r = `(uname -r) 2>/dev/null || echo unknown`-uname -s = `(uname -s) 2>/dev/null || echo unknown`-uname -v = `(uname -v) 2>/dev/null || echo unknown`--/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`-/bin/uname -X     = `(/bin/uname -X) 2>/dev/null`--hostinfo               = `(hostinfo) 2>/dev/null`-/bin/universe          = `(/bin/universe) 2>/dev/null`-/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null`-/bin/arch              = `(/bin/arch) 2>/dev/null`-/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null`-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`--UNAME_MACHINE = ${UNAME_MACHINE}-UNAME_RELEASE = ${UNAME_RELEASE}-UNAME_SYSTEM  = ${UNAME_SYSTEM}-UNAME_VERSION = ${UNAME_VERSION}-EOF--exit 1--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "timestamp='"-# time-stamp-format: "%:y-%02m-%02d"-# time-stamp-end: "'"-# End:
− config.sub 
@@ -1,1608 +0,0 @@-#! /bin/sh-# Configuration validation subroutine script.-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,-#   2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.--timestamp='2006-02-23'--# This file is (in principle) common to ALL GNU software.-# The presence of a machine in this file suggests that SOME GNU software-# can handle that machine.  It does not imply ALL GNU software can.-#-# This file is free software; you can redistribute it and/or modify-# it under the terms of the GNU General Public License as published by-# the Free Software Foundation; either version 2 of the License, or-# (at your option) any later version.-#-# This program is distributed in the hope that it will be useful,-# but WITHOUT ANY WARRANTY; without even the implied warranty of-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the-# GNU General Public License for more details.-#-# You should have received a copy of the GNU General Public License-# along with this program; if not, write to the Free Software-# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA-# 02110-1301, USA.-#-# As a special exception to the GNU General Public License, if you-# distribute this file as part of a program that contains a-# configuration script generated by Autoconf, you may include it under-# the same distribution terms that you use for the rest of that program.---# Please send patches to <config-patches@gnu.org>.  Submit a context-# diff and a properly formatted ChangeLog entry.-#-# Configuration subroutine to validate and canonicalize a configuration type.-# Supply the specified configuration type as an argument.-# If it is invalid, we print an error message on stderr and exit with code 1.-# Otherwise, we print the canonical config type on stdout and succeed.--# This file is supposed to be the same for all GNU packages-# and recognize all the CPU types, system types and aliases-# that are meaningful with *any* GNU software.-# Each package is responsible for reporting which valid configurations-# it does not support.  The user should be able to distinguish-# a failure to support a valid configuration from a meaningless-# configuration.--# The goal of this file is to map all the various variations of a given-# machine specification into a single specification in the form:-#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM-# or in some cases, the newer four-part form:-#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM-# It is wrong to echo any other type of specification.--me=`echo "$0" | sed -e 's,.*/,,'`--usage="\-Usage: $0 [OPTION] CPU-MFR-OPSYS-       $0 [OPTION] ALIAS--Canonicalize a configuration name.--Operation modes:-  -h, --help         print this help, then exit-  -t, --time-stamp   print date of last modification, then exit-  -v, --version      print version number, then exit--Report bugs and patches to <config-patches@gnu.org>."--version="\-GNU config.sub ($timestamp)--Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005-Free Software Foundation, Inc.--This is free software; see the source for copying conditions.  There is NO-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."--help="-Try \`$me --help' for more information."--# Parse command line-while test $# -gt 0 ; do-  case $1 in-    --time-stamp | --time* | -t )-       echo "$timestamp" ; exit ;;-    --version | -v )-       echo "$version" ; exit ;;-    --help | --h* | -h )-       echo "$usage"; exit ;;-    -- )     # Stop option processing-       shift; break ;;-    - )	# Use stdin as input.-       break ;;-    -* )-       echo "$me: invalid option $1$help"-       exit 1 ;;--    *local*)-       # First pass through any local machine types.-       echo $1-       exit ;;--    * )-       break ;;-  esac-done--case $# in- 0) echo "$me: missing argument$help" >&2-    exit 1;;- 1) ;;- *) echo "$me: too many arguments$help" >&2-    exit 1;;-esac--# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).-# Here we must recognize all the valid KERNEL-OS combinations.-maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`-case $maybe_os in-  nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \-  uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \-  storm-chaos* | os2-emx* | rtmk-nova*)-    os=-$maybe_os-    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-    ;;-  *)-    basic_machine=`echo $1 | sed 's/-[^-]*$//'`-    if [ $basic_machine != $1 ]-    then os=`echo $1 | sed 's/.*-/-/'`-    else os=; fi-    ;;-esac--### Let's recognize common machines as not being operating systems so-### that things like config.sub decstation-3100 work.  We also-### recognize some manufacturers as not being operating systems, so we-### can provide default operating systems below.-case $os in-	-sun*os*)-		# Prevent following clause from handling this invalid input.-		;;-	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \-	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \-	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \-	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\-	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \-	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \-	-apple | -axis | -knuth | -cray)-		os=-		basic_machine=$1-		;;-	-sim | -cisco | -oki | -wec | -winbond)-		os=-		basic_machine=$1-		;;-	-scout)-		;;-	-wrs)-		os=-vxworks-		basic_machine=$1-		;;-	-chorusos*)-		os=-chorusos-		basic_machine=$1-		;;- 	-chorusrdb)- 		os=-chorusrdb-		basic_machine=$1- 		;;-	-hiux*)-		os=-hiuxwe2-		;;-	-sco6)-		os=-sco5v6-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5)-		os=-sco3.2v5-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco4)-		os=-sco3.2v4-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2.[4-9]*)-		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco3.2v[4-9]*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco5v6*)-		# Don't forget version if it is 3.2v4 or newer.-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-sco*)-		os=-sco3.2v2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-udk*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-isc)-		os=-isc2.2-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-clix*)-		basic_machine=clipper-intergraph-		;;-	-isc*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`-		;;-	-lynx*)-		os=-lynxos-		;;-	-ptx*)-		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`-		;;-	-windowsnt*)-		os=`echo $os | sed -e 's/windowsnt/winnt/'`-		;;-	-psos*)-		os=-psos-		;;-	-mint | -mint[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-esac--# Decode aliases for certain CPU-COMPANY combinations.-case $basic_machine in-	# Recognize the basic CPU types without company name.-	# Some are omitted here because they have special meanings below.-	1750a | 580 \-	| a29k \-	| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \-	| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \-	| am33_2.0 \-	| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \-	| bfin \-	| c4x | clipper \-	| d10v | d30v | dlx | dsp16xx \-	| fr30 | frv \-	| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \-	| i370 | i860 | i960 | ia64 \-	| ip2k | iq2000 \-	| m32r | m32rle | m68000 | m68k | m88k | maxq | mb | microblaze | mcore \-	| mips | mipsbe | mipseb | mipsel | mipsle \-	| mips16 \-	| mips64 | mips64el \-	| mips64vr | mips64vrel \-	| mips64orion | mips64orionel \-	| mips64vr4100 | mips64vr4100el \-	| mips64vr4300 | mips64vr4300el \-	| mips64vr5000 | mips64vr5000el \-	| mips64vr5900 | mips64vr5900el \-	| mipsisa32 | mipsisa32el \-	| mipsisa32r2 | mipsisa32r2el \-	| mipsisa64 | mipsisa64el \-	| mipsisa64r2 | mipsisa64r2el \-	| mipsisa64sb1 | mipsisa64sb1el \-	| mipsisa64sr71k | mipsisa64sr71kel \-	| mipstx39 | mipstx39el \-	| mn10200 | mn10300 \-	| mt \-	| msp430 \-	| nios | nios2 \-	| ns16k | ns32k \-	| or32 \-	| pdp10 | pdp11 | pj | pjl \-	| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \-	| pyramid \-	| sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \-	| sh64 | sh64le \-	| sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \-	| sparcv8 | sparcv9 | sparcv9b \-	| strongarm \-	| tahoe | thumb | tic4x | tic80 | tron \-	| v850 | v850e \-	| we32k \-	| x86 | xscale | xscalee[bl] | xstormy16 | xtensa \-	| z8k)-		basic_machine=$basic_machine-unknown-		;;-	m32c)-		basic_machine=$basic_machine-unknown-		;;-	m6811 | m68hc11 | m6812 | m68hc12)-		# Motorola 68HC11/12.-		basic_machine=$basic_machine-unknown-		os=-none-		;;-	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)-		;;-	ms1)-		basic_machine=mt-unknown-		;;--	# We use `pc' rather than `unknown'-	# because (1) that's what they normally are, and-	# (2) the word "unknown" tends to confuse beginning users.-	i*86 | x86_64)-	  basic_machine=$basic_machine-pc-	  ;;-	# Object if more than one company name word.-	*-*-*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-	# Recognize the basic CPU types with company name.-	580-* \-	| a29k-* \-	| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \-	| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \-	| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \-	| arm-*  | armbe-* | armle-* | armeb-* | armv*-* \-	| avr-* \-	| bfin-* | bs2000-* \-	| c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \-	| clipper-* | craynv-* | cydra-* \-	| d10v-* | d30v-* | dlx-* \-	| elxsi-* \-	| f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \-	| h8300-* | h8500-* \-	| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \-	| i*86-* | i860-* | i960-* | ia64-* \-	| ip2k-* | iq2000-* \-	| m32r-* | m32rle-* \-	| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \-	| m88110-* | m88k-* | maxq-* | mcore-* \-	| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \-	| mips16-* \-	| mips64-* | mips64el-* \-	| mips64vr-* | mips64vrel-* \-	| mips64orion-* | mips64orionel-* \-	| mips64vr4100-* | mips64vr4100el-* \-	| mips64vr4300-* | mips64vr4300el-* \-	| mips64vr5000-* | mips64vr5000el-* \-	| mips64vr5900-* | mips64vr5900el-* \-	| mipsisa32-* | mipsisa32el-* \-	| mipsisa32r2-* | mipsisa32r2el-* \-	| mipsisa64-* | mipsisa64el-* \-	| mipsisa64r2-* | mipsisa64r2el-* \-	| mipsisa64sb1-* | mipsisa64sb1el-* \-	| mipsisa64sr71k-* | mipsisa64sr71kel-* \-	| mipstx39-* | mipstx39el-* \-	| mmix-* \-	| mt-* \-	| msp430-* \-	| nios-* | nios2-* \-	| none-* | np1-* | ns16k-* | ns32k-* \-	| orion-* \-	| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \-	| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \-	| pyramid-* \-	| romp-* | rs6000-* \-	| sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \-	| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \-	| sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \-	| sparclite-* \-	| sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \-	| tahoe-* | thumb-* \-	| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \-	| tron-* \-	| v850-* | v850e-* | vax-* \-	| we32k-* \-	| x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \-	| xstormy16-* | xtensa-* \-	| ymp-* \-	| z8k-*)-		;;-	m32c-*)-		;;-	# Recognize the various machine names and aliases which stand-	# for a CPU type and a company and sometimes even an OS.-	386bsd)-		basic_machine=i386-unknown-		os=-bsd-		;;-	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)-		basic_machine=m68000-att-		;;-	3b*)-		basic_machine=we32k-att-		;;-	a29khif)-		basic_machine=a29k-amd-		os=-udi-		;;-    	abacus)-		basic_machine=abacus-unknown-		;;-	adobe68k)-		basic_machine=m68010-adobe-		os=-scout-		;;-	alliant | fx80)-		basic_machine=fx80-alliant-		;;-	altos | altos3068)-		basic_machine=m68k-altos-		;;-	am29k)-		basic_machine=a29k-none-		os=-bsd-		;;-	amd64)-		basic_machine=x86_64-pc-		;;-	amd64-*)-		basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	amdahl)-		basic_machine=580-amdahl-		os=-sysv-		;;-	amiga | amiga-*)-		basic_machine=m68k-unknown-		;;-	amigaos | amigados)-		basic_machine=m68k-unknown-		os=-amigaos-		;;-	amigaunix | amix)-		basic_machine=m68k-unknown-		os=-sysv4-		;;-	apollo68)-		basic_machine=m68k-apollo-		os=-sysv-		;;-	apollo68bsd)-		basic_machine=m68k-apollo-		os=-bsd-		;;-	aux)-		basic_machine=m68k-apple-		os=-aux-		;;-	balance)-		basic_machine=ns32k-sequent-		os=-dynix-		;;-	c90)-		basic_machine=c90-cray-		os=-unicos-		;;-	convex-c1)-		basic_machine=c1-convex-		os=-bsd-		;;-	convex-c2)-		basic_machine=c2-convex-		os=-bsd-		;;-	convex-c32)-		basic_machine=c32-convex-		os=-bsd-		;;-	convex-c34)-		basic_machine=c34-convex-		os=-bsd-		;;-	convex-c38)-		basic_machine=c38-convex-		os=-bsd-		;;-	cray | j90)-		basic_machine=j90-cray-		os=-unicos-		;;-	craynv)-		basic_machine=craynv-cray-		os=-unicosmp-		;;-	cr16c)-		basic_machine=cr16c-unknown-		os=-elf-		;;-	crds | unos)-		basic_machine=m68k-crds-		;;-	crisv32 | crisv32-* | etraxfs*)-		basic_machine=crisv32-axis-		;;-	cris | cris-* | etrax*)-		basic_machine=cris-axis-		;;-	crx)-		basic_machine=crx-unknown-		os=-elf-		;;-	da30 | da30-*)-		basic_machine=m68k-da30-		;;-	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)-		basic_machine=mips-dec-		;;-	decsystem10* | dec10*)-		basic_machine=pdp10-dec-		os=-tops10-		;;-	decsystem20* | dec20*)-		basic_machine=pdp10-dec-		os=-tops20-		;;-	delta | 3300 | motorola-3300 | motorola-delta \-	      | 3300-motorola | delta-motorola)-		basic_machine=m68k-motorola-		;;-	delta88)-		basic_machine=m88k-motorola-		os=-sysv3-		;;-	djgpp)-		basic_machine=i586-pc-		os=-msdosdjgpp-		;;-	dpx20 | dpx20-*)-		basic_machine=rs6000-bull-		os=-bosx-		;;-	dpx2* | dpx2*-bull)-		basic_machine=m68k-bull-		os=-sysv3-		;;-	ebmon29k)-		basic_machine=a29k-amd-		os=-ebmon-		;;-	elxsi)-		basic_machine=elxsi-elxsi-		os=-bsd-		;;-	encore | umax | mmax)-		basic_machine=ns32k-encore-		;;-	es1800 | OSE68k | ose68k | ose | OSE)-		basic_machine=m68k-ericsson-		os=-ose-		;;-	fx2800)-		basic_machine=i860-alliant-		;;-	genix)-		basic_machine=ns32k-ns-		;;-	gmicro)-		basic_machine=tron-gmicro-		os=-sysv-		;;-	go32)-		basic_machine=i386-pc-		os=-go32-		;;-	h3050r* | hiux*)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	h8300hms)-		basic_machine=h8300-hitachi-		os=-hms-		;;-	h8300xray)-		basic_machine=h8300-hitachi-		os=-xray-		;;-	h8500hms)-		basic_machine=h8500-hitachi-		os=-hms-		;;-	harris)-		basic_machine=m88k-harris-		os=-sysv3-		;;-	hp300-*)-		basic_machine=m68k-hp-		;;-	hp300bsd)-		basic_machine=m68k-hp-		os=-bsd-		;;-	hp300hpux)-		basic_machine=m68k-hp-		os=-hpux-		;;-	hp3k9[0-9][0-9] | hp9[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k2[0-9][0-9] | hp9k31[0-9])-		basic_machine=m68000-hp-		;;-	hp9k3[2-9][0-9])-		basic_machine=m68k-hp-		;;-	hp9k6[0-9][0-9] | hp6[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hp9k7[0-79][0-9] | hp7[0-79][0-9])-		basic_machine=hppa1.1-hp-		;;-	hp9k78[0-9] | hp78[0-9])-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)-		# FIXME: really hppa2.0-hp-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][13679] | hp8[0-9][13679])-		basic_machine=hppa1.1-hp-		;;-	hp9k8[0-9][0-9] | hp8[0-9][0-9])-		basic_machine=hppa1.0-hp-		;;-	hppa-next)-		os=-nextstep3-		;;-	hppaosf)-		basic_machine=hppa1.1-hp-		os=-osf-		;;-	hppro)-		basic_machine=hppa1.1-hp-		os=-proelf-		;;-	i370-ibm* | ibm*)-		basic_machine=i370-ibm-		;;-# I'm not sure what "Sysv32" means.  Should this be sysv3.2?-	i*86v32)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv32-		;;-	i*86v4*)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv4-		;;-	i*86v)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-sysv-		;;-	i*86sol2)-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`-		os=-solaris2-		;;-	i386mach)-		basic_machine=i386-mach-		os=-mach-		;;-	i386-vsta | vsta)-		basic_machine=i386-unknown-		os=-vsta-		;;-	iris | iris4d)-		basic_machine=mips-sgi-		case $os in-		    -irix*)-			;;-		    *)-			os=-irix4-			;;-		esac-		;;-	isi68 | isi)-		basic_machine=m68k-isi-		os=-sysv-		;;-	m88k-omron*)-		basic_machine=m88k-omron-		;;-	magnum | m3230)-		basic_machine=mips-mips-		os=-sysv-		;;-	merlin)-		basic_machine=ns32k-utek-		os=-sysv-		;;-	mingw32)-		basic_machine=i386-pc-		os=-mingw32-		;;-	miniframe)-		basic_machine=m68000-convergent-		;;-	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)-		basic_machine=m68k-atari-		os=-mint-		;;-	mips3*-*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-		;;-	mips3*)-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown-		;;-	monitor)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	morphos)-		basic_machine=powerpc-unknown-		os=-morphos-		;;-	msdos)-		basic_machine=i386-pc-		os=-msdos-		;;-	ms1-*)-		basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`-		;;-	mvs)-		basic_machine=i370-ibm-		os=-mvs-		;;-	ncr3000)-		basic_machine=i486-ncr-		os=-sysv4-		;;-	netbsd386)-		basic_machine=i386-unknown-		os=-netbsd-		;;-	netwinder)-		basic_machine=armv4l-rebel-		os=-linux-		;;-	news | news700 | news800 | news900)-		basic_machine=m68k-sony-		os=-newsos-		;;-	news1000)-		basic_machine=m68030-sony-		os=-newsos-		;;-	news-3600 | risc-news)-		basic_machine=mips-sony-		os=-newsos-		;;-	necv70)-		basic_machine=v70-nec-		os=-sysv-		;;-	next | m*-next )-		basic_machine=m68k-next-		case $os in-		    -nextstep* )-			;;-		    -ns2*)-		      os=-nextstep2-			;;-		    *)-		      os=-nextstep3-			;;-		esac-		;;-	nh3000)-		basic_machine=m68k-harris-		os=-cxux-		;;-	nh[45]000)-		basic_machine=m88k-harris-		os=-cxux-		;;-	nindy960)-		basic_machine=i960-intel-		os=-nindy-		;;-	mon960)-		basic_machine=i960-intel-		os=-mon960-		;;-	nonstopux)-		basic_machine=mips-compaq-		os=-nonstopux-		;;-	np1)-		basic_machine=np1-gould-		;;-	nsr-tandem)-		basic_machine=nsr-tandem-		;;-	op50n-* | op60c-*)-		basic_machine=hppa1.1-oki-		os=-proelf-		;;-	openrisc | openrisc-*)-		basic_machine=or32-unknown-		;;-	os400)-		basic_machine=powerpc-ibm-		os=-os400-		;;-	OSE68000 | ose68000)-		basic_machine=m68000-ericsson-		os=-ose-		;;-	os68k)-		basic_machine=m68k-none-		os=-os68k-		;;-	pa-hitachi)-		basic_machine=hppa1.1-hitachi-		os=-hiuxwe2-		;;-	paragon)-		basic_machine=i860-intel-		os=-osf-		;;-	pbd)-		basic_machine=sparc-tti-		;;-	pbb)-		basic_machine=m68k-tti-		;;-	pc532 | pc532-*)-		basic_machine=ns32k-pc532-		;;-	pc98)-		basic_machine=i386-pc-		;;-	pc98-*)-		basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium | p5 | k5 | k6 | nexgen | viac3)-		basic_machine=i586-pc-		;;-	pentiumpro | p6 | 6x86 | athlon | athlon_*)-		basic_machine=i686-pc-		;;-	pentiumii | pentium2 | pentiumiii | pentium3)-		basic_machine=i686-pc-		;;-	pentium4)-		basic_machine=i786-pc-		;;-	pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)-		basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumpro-* | p6-* | 6x86-* | athlon-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)-		basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pentium4-*)-		basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	pn)-		basic_machine=pn-gould-		;;-	power)	basic_machine=power-ibm-		;;-	ppc)	basic_machine=powerpc-unknown-		;;-	ppc-*)	basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppcle | powerpclittle | ppc-le | powerpc-little)-		basic_machine=powerpcle-unknown-		;;-	ppcle-* | powerpclittle-*)-		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64)	basic_machine=powerpc64-unknown-		;;-	ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ppc64le | powerpc64little | ppc64-le | powerpc64-little)-		basic_machine=powerpc64le-unknown-		;;-	ppc64le-* | powerpc64little-*)-		basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`-		;;-	ps2)-		basic_machine=i386-ibm-		;;-	pw32)-		basic_machine=i586-unknown-		os=-pw32-		;;-	rdos)-		basic_machine=i386-pc-		os=-rdos-		;;-	rom68k)-		basic_machine=m68k-rom68k-		os=-coff-		;;-	rm[46]00)-		basic_machine=mips-siemens-		;;-	rtpc | rtpc-*)-		basic_machine=romp-ibm-		;;-	s390 | s390-*)-		basic_machine=s390-ibm-		;;-	s390x | s390x-*)-		basic_machine=s390x-ibm-		;;-	sa29200)-		basic_machine=a29k-amd-		os=-udi-		;;-	sb1)-		basic_machine=mipsisa64sb1-unknown-		;;-	sb1el)-		basic_machine=mipsisa64sb1el-unknown-		;;-	sei)-		basic_machine=mips-sei-		os=-seiux-		;;-	sequent)-		basic_machine=i386-sequent-		;;-	sh)-		basic_machine=sh-hitachi-		os=-hms-		;;-	sh64)-		basic_machine=sh64-unknown-		;;-	sparclite-wrs | simso-wrs)-		basic_machine=sparclite-wrs-		os=-vxworks-		;;-	sps7)-		basic_machine=m68k-bull-		os=-sysv2-		;;-	spur)-		basic_machine=spur-unknown-		;;-	st2000)-		basic_machine=m68k-tandem-		;;-	stratus)-		basic_machine=i860-stratus-		os=-sysv4-		;;-	sun2)-		basic_machine=m68000-sun-		;;-	sun2os3)-		basic_machine=m68000-sun-		os=-sunos3-		;;-	sun2os4)-		basic_machine=m68000-sun-		os=-sunos4-		;;-	sun3os3)-		basic_machine=m68k-sun-		os=-sunos3-		;;-	sun3os4)-		basic_machine=m68k-sun-		os=-sunos4-		;;-	sun4os3)-		basic_machine=sparc-sun-		os=-sunos3-		;;-	sun4os4)-		basic_machine=sparc-sun-		os=-sunos4-		;;-	sun4sol2)-		basic_machine=sparc-sun-		os=-solaris2-		;;-	sun3 | sun3-*)-		basic_machine=m68k-sun-		;;-	sun4)-		basic_machine=sparc-sun-		;;-	sun386 | sun386i | roadrunner)-		basic_machine=i386-sun-		;;-	sv1)-		basic_machine=sv1-cray-		os=-unicos-		;;-	symmetry)-		basic_machine=i386-sequent-		os=-dynix-		;;-	t3e)-		basic_machine=alphaev5-cray-		os=-unicos-		;;-	t90)-		basic_machine=t90-cray-		os=-unicos-		;;-	tic54x | c54x*)-		basic_machine=tic54x-unknown-		os=-coff-		;;-	tic55x | c55x*)-		basic_machine=tic55x-unknown-		os=-coff-		;;-	tic6x | c6x*)-		basic_machine=tic6x-unknown-		os=-coff-		;;-	tx39)-		basic_machine=mipstx39-unknown-		;;-	tx39el)-		basic_machine=mipstx39el-unknown-		;;-	toad1)-		basic_machine=pdp10-xkl-		os=-tops20-		;;-	tower | tower-32)-		basic_machine=m68k-ncr-		;;-	tpf)-		basic_machine=s390x-ibm-		os=-tpf-		;;-	udi29k)-		basic_machine=a29k-amd-		os=-udi-		;;-	ultra3)-		basic_machine=a29k-nyu-		os=-sym1-		;;-	v810 | necv810)-		basic_machine=v810-nec-		os=-none-		;;-	vaxv)-		basic_machine=vax-dec-		os=-sysv-		;;-	vms)-		basic_machine=vax-dec-		os=-vms-		;;-	vpp*|vx|vx-*)-		basic_machine=f301-fujitsu-		;;-	vxworks960)-		basic_machine=i960-wrs-		os=-vxworks-		;;-	vxworks68)-		basic_machine=m68k-wrs-		os=-vxworks-		;;-	vxworks29k)-		basic_machine=a29k-wrs-		os=-vxworks-		;;-	w65*)-		basic_machine=w65-wdc-		os=-none-		;;-	w89k-*)-		basic_machine=hppa1.1-winbond-		os=-proelf-		;;-	xbox)-		basic_machine=i686-pc-		os=-mingw32-		;;-	xps | xps100)-		basic_machine=xps100-honeywell-		;;-	ymp)-		basic_machine=ymp-cray-		os=-unicos-		;;-	z8k-*-coff)-		basic_machine=z8k-unknown-		os=-sim-		;;-	none)-		basic_machine=none-none-		os=-none-		;;--# Here we handle the default manufacturer of certain CPU types.  It is in-# some cases the only manufacturer, in others, it is the most popular.-	w89k)-		basic_machine=hppa1.1-winbond-		;;-	op50n)-		basic_machine=hppa1.1-oki-		;;-	op60c)-		basic_machine=hppa1.1-oki-		;;-	romp)-		basic_machine=romp-ibm-		;;-	mmix)-		basic_machine=mmix-knuth-		;;-	rs6000)-		basic_machine=rs6000-ibm-		;;-	vax)-		basic_machine=vax-dec-		;;-	pdp10)-		# there are many clones, so DEC is not a safe bet-		basic_machine=pdp10-unknown-		;;-	pdp11)-		basic_machine=pdp11-dec-		;;-	we32k)-		basic_machine=we32k-att-		;;-	sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele)-		basic_machine=sh-unknown-		;;-	sparc | sparcv8 | sparcv9 | sparcv9b)-		basic_machine=sparc-sun-		;;-	cydra)-		basic_machine=cydra-cydrome-		;;-	orion)-		basic_machine=orion-highlevel-		;;-	orion105)-		basic_machine=clipper-highlevel-		;;-	mac | mpw | mac-mpw)-		basic_machine=m68k-apple-		;;-	pmac | pmac-mpw)-		basic_machine=powerpc-apple-		;;-	*-unknown)-		# Make sure to match an already-canonicalized machine name.-		;;-	*)-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2-		exit 1-		;;-esac--# Here we canonicalize certain aliases for manufacturers.-case $basic_machine in-	*-digital*)-		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`-		;;-	*-commodore*)-		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`-		;;-	*)-		;;-esac--# Decode manufacturer-specific aliases for certain operating systems.--if [ x"$os" != x"" ]-then-case $os in-        # First match some system type aliases-        # that might get confused with valid system types.-	# -solaris* is a basic system type, with this one exception.-	-solaris1 | -solaris1.*)-		os=`echo $os | sed -e 's|solaris1|sunos4|'`-		;;-	-solaris)-		os=-solaris2-		;;-	-svr4*)-		os=-sysv4-		;;-	-unixware*)-		os=-sysv4.2uw-		;;-	-gnu/linux*)-		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`-		;;-	# First accept the basic system types.-	# The portable systems comes first.-	# Each alternative MUST END IN A *, to match a version number.-	# -sysv* is not here because it comes later, after sysvr4.-	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \-	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\-	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \-	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \-	      | -aos* \-	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \-	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \-	      | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \-	      | -openbsd* | -solidbsd* \-	      | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \-	      | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \-	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \-	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \-	      | -chorusos* | -chorusrdb* \-	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \-	      | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \-	      | -uxpv* | -beos* | -mpeix* | -udk* \-	      | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \-	      | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \-	      | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \-	      | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \-	      | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \-	      | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \-	      | -skyos* | -haiku* | -rdos*)-	# Remember, each alternative MUST END IN *, to match a version number.-		;;-	-qnx*)-		case $basic_machine in-		    x86-* | i*86-*)-			;;-		    *)-			os=-nto$os-			;;-		esac-		;;-	-nto-qnx*)-		;;-	-nto*)-		os=`echo $os | sed -e 's|nto|nto-qnx|'`-		;;-	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \-	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \-	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)-		;;-	-mac*)-		os=`echo $os | sed -e 's|mac|macos|'`-		;;-	-linux-dietlibc)-		os=-linux-dietlibc-		;;-	-linux*)-		os=`echo $os | sed -e 's|linux|linux-gnu|'`-		;;-	-sunos5*)-		os=`echo $os | sed -e 's|sunos5|solaris2|'`-		;;-	-sunos6*)-		os=`echo $os | sed -e 's|sunos6|solaris3|'`-		;;-	-opened*)-		os=-openedition-		;;-        -os400*)-		os=-os400-		;;-	-wince*)-		os=-wince-		;;-	-osfrose*)-		os=-osfrose-		;;-	-osf*)-		os=-osf-		;;-	-utek*)-		os=-bsd-		;;-	-dynix*)-		os=-bsd-		;;-	-acis*)-		os=-aos-		;;-	-atheos*)-		os=-atheos-		;;-	-syllable*)-		os=-syllable-		;;-	-386bsd)-		os=-bsd-		;;-	-ctix* | -uts*)-		os=-sysv-		;;-	-nova*)-		os=-rtmk-nova-		;;-	-ns2 )-		os=-nextstep2-		;;-	-nsk*)-		os=-nsk-		;;-	# Preserve the version number of sinix5.-	-sinix5.*)-		os=`echo $os | sed -e 's|sinix|sysv|'`-		;;-	-sinix*)-		os=-sysv4-		;;-        -tpf*)-		os=-tpf-		;;-	-triton*)-		os=-sysv3-		;;-	-oss*)-		os=-sysv3-		;;-	-svr4)-		os=-sysv4-		;;-	-svr3)-		os=-sysv3-		;;-	-sysvr4)-		os=-sysv4-		;;-	# This must come after -sysvr4.-	-sysv*)-		;;-	-ose*)-		os=-ose-		;;-	-es1800*)-		os=-ose-		;;-	-xenix)-		os=-xenix-		;;-	-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-		os=-mint-		;;-	-aros*)-		os=-aros-		;;-	-kaos*)-		os=-kaos-		;;-	-zvmoe)-		os=-zvmoe-		;;-	-none)-		;;-	*)-		# Get rid of the `-' at the beginning of $os.-		os=`echo $os | sed 's/[^-]*-//'`-		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2-		exit 1-		;;-esac-else--# Here we handle the default operating systems that come with various machines.-# The value should be what the vendor currently ships out the door with their-# machine or put another way, the most popular os provided with the machine.--# Note that if you're going to try to match "-MANUFACTURER" here (say,-# "-sun"), then you have to tell the case statement up towards the top-# that MANUFACTURER isn't an operating system.  Otherwise, code above-# will signal an error saying that MANUFACTURER isn't an operating-# system, and we'll never get to this point.--case $basic_machine in-	*-acorn)-		os=-riscix1.2-		;;-	arm*-rebel)-		os=-linux-		;;-	arm*-semi)-		os=-aout-		;;-    c4x-* | tic4x-*)-        os=-coff-        ;;-	# This must come before the *-dec entry.-	pdp10-*)-		os=-tops20-		;;-	pdp11-*)-		os=-none-		;;-	*-dec | vax-*)-		os=-ultrix4.2-		;;-	m68*-apollo)-		os=-domain-		;;-	i386-sun)-		os=-sunos4.0.2-		;;-	m68000-sun)-		os=-sunos3-		# This also exists in the configure program, but was not the-		# default.-		# os=-sunos4-		;;-	m68*-cisco)-		os=-aout-		;;-	mips*-cisco)-		os=-elf-		;;-	mips*-*)-		os=-elf-		;;-	or32-*)-		os=-coff-		;;-	*-tti)	# must be before sparc entry or we get the wrong os.-		os=-sysv3-		;;-	sparc-* | *-sun)-		os=-sunos4.1.1-		;;-	*-be)-		os=-beos-		;;-	*-haiku)-		os=-haiku-		;;-	*-ibm)-		os=-aix-		;;-    	*-knuth)-		os=-mmixware-		;;-	*-wec)-		os=-proelf-		;;-	*-winbond)-		os=-proelf-		;;-	*-oki)-		os=-proelf-		;;-	*-hp)-		os=-hpux-		;;-	*-hitachi)-		os=-hiux-		;;-	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)-		os=-sysv-		;;-	*-cbm)-		os=-amigaos-		;;-	*-dg)-		os=-dgux-		;;-	*-dolphin)-		os=-sysv3-		;;-	m68k-ccur)-		os=-rtu-		;;-	m88k-omron*)-		os=-luna-		;;-	*-next )-		os=-nextstep-		;;-	*-sequent)-		os=-ptx-		;;-	*-crds)-		os=-unos-		;;-	*-ns)-		os=-genix-		;;-	i370-*)-		os=-mvs-		;;-	*-next)-		os=-nextstep3-		;;-	*-gould)-		os=-sysv-		;;-	*-highlevel)-		os=-bsd-		;;-	*-encore)-		os=-bsd-		;;-	*-sgi)-		os=-irix-		;;-	*-siemens)-		os=-sysv4-		;;-	*-masscomp)-		os=-rtu-		;;-	f30[01]-fujitsu | f700-fujitsu)-		os=-uxpv-		;;-	*-rom68k)-		os=-coff-		;;-	*-*bug)-		os=-coff-		;;-	*-apple)-		os=-macos-		;;-	*-atari*)-		os=-mint-		;;-	*)-		os=-none-		;;-esac-fi--# Here we handle the case where we know the os, and the CPU type, but not the-# manufacturer.  We pick the logical manufacturer.-vendor=unknown-case $basic_machine in-	*-unknown)-		case $os in-			-riscix*)-				vendor=acorn-				;;-			-sunos*)-				vendor=sun-				;;-			-aix*)-				vendor=ibm-				;;-			-beos*)-				vendor=be-				;;-			-hpux*)-				vendor=hp-				;;-			-mpeix*)-				vendor=hp-				;;-			-hiux*)-				vendor=hitachi-				;;-			-unos*)-				vendor=crds-				;;-			-dgux*)-				vendor=dg-				;;-			-luna*)-				vendor=omron-				;;-			-genix*)-				vendor=ns-				;;-			-mvs* | -opened*)-				vendor=ibm-				;;-			-os400*)-				vendor=ibm-				;;-			-ptx*)-				vendor=sequent-				;;-			-tpf*)-				vendor=ibm-				;;-			-vxsim* | -vxworks* | -windiss*)-				vendor=wrs-				;;-			-aux*)-				vendor=apple-				;;-			-hms*)-				vendor=hitachi-				;;-			-mpw* | -macos*)-				vendor=apple-				;;-			-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)-				vendor=atari-				;;-			-vos*)-				vendor=stratus-				;;-		esac-		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`-		;;-esac--echo $basic_machine$os-exit--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "timestamp='"-# time-stamp-format: "%:y-%02m-%02d"-# time-stamp-end: "'"-# End:
− configure 
@@ -1,7509 +0,0 @@-#! /bin/sh-# Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.63 for Haskell GLUT package 2.1.2.1.-#-# Report bugs to <sven.panne@aedion.de>.-#-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,-# 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.-# This configure script is free software; the Free Software Foundation-# gives unlimited permission to copy, distribute and modify it.-## --------------------- ##-## M4sh Initialization.  ##-## --------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in-  *posix*) set -o posix ;;-esac--fi-----# PATH needs CR-# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits--as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='printf %s\n'-  as_echo_n='printf %s'-else-  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then-    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'-    as_echo_n='/usr/ucb/echo -n'-  else-    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'-    as_echo_n_body='eval-      arg=$1;-      case $arg in-      *"$as_nl"*)-	expr "X$arg" : "X\\(.*\\)$as_nl";-	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;-      esac;-      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"-    '-    export as_echo_n_body-    as_echo_n='sh -c $as_echo_n_body as_echo'-  fi-  export as_echo_body-  as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then-  PATH_SEPARATOR=:-  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {-    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||-      PATH_SEPARATOR=';'-  }-fi--# Support unset when possible.-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then-  as_unset=unset-else-  as_unset=false-fi---# IFS-# We need space, tab and new line, in precisely that order.  Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" ""	$as_nl"--# Find who we are.  Look in the path if we contain no directory separator.-case $0 in-  *[\\/]* ) as_myself=$0 ;;-  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break-done-IFS=$as_save_IFS--     ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then-  as_myself=$0-fi-if test ! -f "$as_myself"; then-  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2-  { (exit 1); exit 1; }-fi--# Work around bugs in pre-3.0 UWIN ksh.-for as_var in ENV MAIL MAILPATH-do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# Required to use basename.-if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then-  as_basename=basename-else-  as_basename=false-fi---# Name of the executable.-as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \-	 X"$0" : 'X\(//\)$' \| \-	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |-    sed '/^.*\/\([^/][^/]*\)\/*$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`--# CDPATH.-$as_unset CDPATH---if test "x$CONFIG_SHELL" = x; then-  if (eval ":") 2>/dev/null; then-  as_have_required=yes-else-  as_have_required=no-fi--  if test $as_have_required = yes &&	 (eval ":-(as_func_return () {-  (exit \$1)-}-as_func_success () {-  as_func_return 0-}-as_func_failure () {-  as_func_return 1-}-as_func_ret_success () {-  return 0-}-as_func_ret_failure () {-  return 1-}--exitcode=0-if as_func_success; then-  :-else-  exitcode=1-  echo as_func_success failed.-fi--if as_func_failure; then-  exitcode=1-  echo as_func_failure succeeded.-fi--if as_func_ret_success; then-  :-else-  exitcode=1-  echo as_func_ret_success failed.-fi--if as_func_ret_failure; then-  exitcode=1-  echo as_func_ret_failure succeeded.-fi--if ( set x; as_func_ret_success y && test x = \"\$1\" ); then-  :-else-  exitcode=1-  echo positional parameters were not saved.-fi--test \$exitcode = 0) || { (exit 1); exit 1; }--(-  as_lineno_1=\$LINENO-  as_lineno_2=\$LINENO-  test \"x\$as_lineno_1\" != \"x\$as_lineno_2\" &&-  test \"x\`expr \$as_lineno_1 + 1\`\" = \"x\$as_lineno_2\") || { (exit 1); exit 1; }-") 2> /dev/null; then-  :-else-  as_candidate_shells=-    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  case $as_dir in-	 /*)-	   for as_base in sh bash ksh sh5; do-	     as_candidate_shells="$as_candidate_shells $as_dir/$as_base"-	   done;;-       esac-done-IFS=$as_save_IFS---      for as_shell in $as_candidate_shells $SHELL; do-	 # Try only shells that exist, to save several forks.-	 if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&-		{ ("$as_shell") 2> /dev/null <<\_ASEOF-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in-  *posix*) set -o posix ;;-esac--fi---:-_ASEOF-}; then-  CONFIG_SHELL=$as_shell-	       as_have_required=yes-	       if { "$as_shell" 2> /dev/null <<\_ASEOF-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in-  *posix*) set -o posix ;;-esac--fi---:-(as_func_return () {-  (exit $1)-}-as_func_success () {-  as_func_return 0-}-as_func_failure () {-  as_func_return 1-}-as_func_ret_success () {-  return 0-}-as_func_ret_failure () {-  return 1-}--exitcode=0-if as_func_success; then-  :-else-  exitcode=1-  echo as_func_success failed.-fi--if as_func_failure; then-  exitcode=1-  echo as_func_failure succeeded.-fi--if as_func_ret_success; then-  :-else-  exitcode=1-  echo as_func_ret_success failed.-fi--if as_func_ret_failure; then-  exitcode=1-  echo as_func_ret_failure succeeded.-fi--if ( set x; as_func_ret_success y && test x = "$1" ); then-  :-else-  exitcode=1-  echo positional parameters were not saved.-fi--test $exitcode = 0) || { (exit 1); exit 1; }--(-  as_lineno_1=$LINENO-  as_lineno_2=$LINENO-  test "x$as_lineno_1" != "x$as_lineno_2" &&-  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2") || { (exit 1); exit 1; }--_ASEOF-}; then-  break-fi--fi--      done--      if test "x$CONFIG_SHELL" != x; then-  for as_var in BASH_ENV ENV-	do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var-	done-	export CONFIG_SHELL-	exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"}-fi---    if test $as_have_required = no; then-  echo This script requires a shell more modern than all the-      echo shells that I found on your system.  Please install a-      echo modern shell, or manually run the script under such a-      echo shell if you do have one.-      { (exit 1); exit 1; }-fi---fi--fi----(eval "as_func_return () {-  (exit \$1)-}-as_func_success () {-  as_func_return 0-}-as_func_failure () {-  as_func_return 1-}-as_func_ret_success () {-  return 0-}-as_func_ret_failure () {-  return 1-}--exitcode=0-if as_func_success; then-  :-else-  exitcode=1-  echo as_func_success failed.-fi--if as_func_failure; then-  exitcode=1-  echo as_func_failure succeeded.-fi--if as_func_ret_success; then-  :-else-  exitcode=1-  echo as_func_ret_success failed.-fi--if as_func_ret_failure; then-  exitcode=1-  echo as_func_ret_failure succeeded.-fi--if ( set x; as_func_ret_success y && test x = \"\$1\" ); then-  :-else-  exitcode=1-  echo positional parameters were not saved.-fi--test \$exitcode = 0") || {-  echo No shell found that supports shell functions.-  echo Please tell bug-autoconf@gnu.org about your system,-  echo including any error possibly output before this message.-  echo This can help us improve future autoconf versions.-  echo Configuration will now proceed without shell functions.-}----  as_lineno_1=$LINENO-  as_lineno_2=$LINENO-  test "x$as_lineno_1" != "x$as_lineno_2" &&-  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {--  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO-  # uniformly replaced by the line number.  The first 'sed' inserts a-  # line-number line after each line using $LINENO; the second 'sed'-  # does the real work.  The second script uses 'N' to pair each-  # line-number line with the line containing $LINENO, and appends-  # trailing '-' during substitution so that $LINENO is not a special-  # case at line end.-  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the-  # scripts with optimization help from Paolo Bonzini.  Blame Lee-  # E. McMahon (1931-1989) for sed's syntax.  :-)-  sed -n '-    p-    /[$]LINENO/=-  ' <$as_myself |-    sed '-      s/[$]LINENO.*/&-/-      t lineno-      b-      :lineno-      N-      :loop-      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/-      t loop-      s/-\n.*//-    ' >$as_me.lineno &&-  chmod +x "$as_me.lineno" ||-    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2-   { (exit 1); exit 1; }; }--  # Don't try to exec as it changes $[0], causing all sort of problems-  # (the dirname of $[0] is not the place where we might find the-  # original and so on.  Autoconf is especially sensitive to this).-  . "./$as_me.lineno"-  # Exit status is that of the last command.-  exit-}---if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then-  as_dirname=dirname-else-  as_dirname=false-fi--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in--n*)-  case `echo 'x\c'` in-  *c*) ECHO_T='	';;	# ECHO_T is single tab character.-  *)   ECHO_C='\c';;-  esac;;-*)-  ECHO_N='-n';;-esac-if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then-  rm -f conf$$.dir/conf$$.file-else-  rm -f conf$$.dir-  mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then-  if ln -s conf$$.file conf$$ 2>/dev/null; then-    as_ln_s='ln -s'-    # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -p'.-    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||-      as_ln_s='cp -p'-  elif ln conf$$.file conf$$ 2>/dev/null; then-    as_ln_s=ln-  else-    as_ln_s='cp -p'-  fi-else-  as_ln_s='cp -p'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null--if mkdir -p . 2>/dev/null; then-  as_mkdir_p=:-else-  test -d ./-p && rmdir ./-p-  as_mkdir_p=false-fi--if test -x / >/dev/null 2>&1; then-  as_test_x='test -x'-else-  if ls -dL / >/dev/null 2>&1; then-    as_ls_L_option=L-  else-    as_ls_L_option=-  fi-  as_test_x='-    eval sh -c '\''-      if test -d "$1"; then-	test -d "$1/.";-      else-	case $1 in-	-*)set "./$1";;-	esac;-	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in-	???[sx]*):;;*)false;;esac;fi-    '\'' sh-  '-fi-as_executable_p=$as_test_x--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"----exec 7<&0 </dev/null 6>&1--# Name of the host.-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,-# so uname gets run too.-ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`--#-# Initializations.-#-ac_default_prefix=/usr/local-ac_clean_files=-ac_config_libobj_dir=.-LIBOBJS=-cross_compiling=no-subdirs=-MFLAGS=-MAKEFLAGS=-SHELL=${CONFIG_SHELL-/bin/sh}--# Identity of this package.-PACKAGE_NAME='Haskell GLUT package'-PACKAGE_TARNAME='GLUT'-PACKAGE_VERSION='2.1.2.1'-PACKAGE_STRING='Haskell GLUT package 2.1.2.1'-PACKAGE_BUGREPORT='sven.panne@aedion.de'--ac_unique_file="include/HsGLUT.h.in"-# Factoring default headers for most tests.-ac_includes_default="\-#include <stdio.h>-#ifdef HAVE_SYS_TYPES_H-# include <sys/types.h>-#endif-#ifdef HAVE_SYS_STAT_H-# include <sys/stat.h>-#endif-#ifdef STDC_HEADERS-# include <stdlib.h>-# include <stddef.h>-#else-# ifdef HAVE_STDLIB_H-#  include <stdlib.h>-# endif-#endif-#ifdef HAVE_STRING_H-# if !defined STDC_HEADERS && defined HAVE_MEMORY_H-#  include <memory.h>-# endif-# include <string.h>-#endif-#ifdef HAVE_STRINGS_H-# include <strings.h>-#endif-#ifdef HAVE_INTTYPES_H-# include <inttypes.h>-#endif-#ifdef HAVE_STDINT_H-# include <stdint.h>-#endif-#ifdef HAVE_UNISTD_H-# include <unistd.h>-#endif"--ac_subst_vars='LTLIBOBJS-LIBOBJS-CALLCONV-BUILD_PACKAGE_BOOL-GLUT_LIBS-GLUT_CFLAGS-EGREP-GREP-GLU_LIBS-GLU_CFLAGS-GL_LIBS-GL_CFLAGS-GLUT_EXTRA_LIBS-GLUT_FRAMEWORKS-GLU_FRAMEWORKS-target_os-target_vendor-target_cpu-target-host_os-host_vendor-host_cpu-host-build_os-build_vendor-build_cpu-build-X_EXTRA_LIBS-X_LIBS-X_PRE_LIBS-X_CFLAGS-CPP-XMKMF-OBJEXT-EXEEXT-ac_ct_CC-CPPFLAGS-LDFLAGS-CFLAGS-CC-target_alias-host_alias-build_alias-LIBS-ECHO_T-ECHO_N-ECHO_C-DEFS-mandir-localedir-libdir-psdir-pdfdir-dvidir-htmldir-infodir-docdir-oldincludedir-includedir-localstatedir-sharedstatedir-sysconfdir-datadir-datarootdir-libexecdir-sbindir-bindir-program_transform_name-prefix-exec_prefix-PACKAGE_BUGREPORT-PACKAGE_STRING-PACKAGE_VERSION-PACKAGE_TARNAME-PACKAGE_NAME-PATH_SEPARATOR-SHELL'-ac_subst_files=''-ac_user_opts='-enable_option_checking-with_cc-with_compiler-enable_opengl-enable_glut-with_x-'-      ac_precious_vars='build_alias-host_alias-target_alias-CC-CFLAGS-LDFLAGS-LIBS-CPPFLAGS-XMKMF-CPP'---# Initialize some variables set by options.-ac_init_help=-ac_init_version=false-ac_unrecognized_opts=-ac_unrecognized_sep=-# The variables have the same names as the options, with-# dashes changed to underlines.-cache_file=/dev/null-exec_prefix=NONE-no_create=-no_recursion=-prefix=NONE-program_prefix=NONE-program_suffix=NONE-program_transform_name=s,x,x,-silent=-site=-srcdir=-verbose=-x_includes=NONE-x_libraries=NONE--# Installation directory options.-# These are left unexpanded so users can "make install exec_prefix=/foo"-# and all the variables that are supposed to be based on exec_prefix-# by default will actually change.-# Use braces instead of parens because sh, perl, etc. also accept them.-# (The list follows the same order as the GNU Coding Standards.)-bindir='${exec_prefix}/bin'-sbindir='${exec_prefix}/sbin'-libexecdir='${exec_prefix}/libexec'-datarootdir='${prefix}/share'-datadir='${datarootdir}'-sysconfdir='${prefix}/etc'-sharedstatedir='${prefix}/com'-localstatedir='${prefix}/var'-includedir='${prefix}/include'-oldincludedir='/usr/include'-docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'-infodir='${datarootdir}/info'-htmldir='${docdir}'-dvidir='${docdir}'-pdfdir='${docdir}'-psdir='${docdir}'-libdir='${exec_prefix}/lib'-localedir='${datarootdir}/locale'-mandir='${datarootdir}/man'--ac_prev=-ac_dashdash=-for ac_option-do-  # If the previous option needs an argument, assign it.-  if test -n "$ac_prev"; then-    eval $ac_prev=\$ac_option-    ac_prev=-    continue-  fi--  case $ac_option in-  *=*)	ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;-  *)	ac_optarg=yes ;;-  esac--  # Accept the important Cygnus configure options, so we can diagnose typos.--  case $ac_dashdash$ac_option in-  --)-    ac_dashdash=yes ;;--  -bindir | --bindir | --bindi | --bind | --bin | --bi)-    ac_prev=bindir ;;-  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)-    bindir=$ac_optarg ;;--  -build | --build | --buil | --bui | --bu)-    ac_prev=build_alias ;;-  -build=* | --build=* | --buil=* | --bui=* | --bu=*)-    build_alias=$ac_optarg ;;--  -cache-file | --cache-file | --cache-fil | --cache-fi \-  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)-    ac_prev=cache_file ;;-  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \-  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)-    cache_file=$ac_optarg ;;--  --config-cache | -C)-    cache_file=config.cache ;;--  -datadir | --datadir | --datadi | --datad)-    ac_prev=datadir ;;-  -datadir=* | --datadir=* | --datadi=* | --datad=*)-    datadir=$ac_optarg ;;--  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \-  | --dataroo | --dataro | --datar)-    ac_prev=datarootdir ;;-  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \-  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)-    datarootdir=$ac_optarg ;;--  -disable-* | --disable-*)-    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2-   { (exit 1); exit 1; }; }-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"enable_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval enable_$ac_useropt=no ;;--  -docdir | --docdir | --docdi | --doc | --do)-    ac_prev=docdir ;;-  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)-    docdir=$ac_optarg ;;--  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)-    ac_prev=dvidir ;;-  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)-    dvidir=$ac_optarg ;;--  -enable-* | --enable-*)-    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      { $as_echo "$as_me: error: invalid feature name: $ac_useropt" >&2-   { (exit 1); exit 1; }; }-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"enable_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval enable_$ac_useropt=\$ac_optarg ;;--  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \-  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \-  | --exec | --exe | --ex)-    ac_prev=exec_prefix ;;-  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \-  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \-  | --exec=* | --exe=* | --ex=*)-    exec_prefix=$ac_optarg ;;--  -gas | --gas | --ga | --g)-    # Obsolete; use --with-gas.-    with_gas=yes ;;--  -help | --help | --hel | --he | -h)-    ac_init_help=long ;;-  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)-    ac_init_help=recursive ;;-  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)-    ac_init_help=short ;;--  -host | --host | --hos | --ho)-    ac_prev=host_alias ;;-  -host=* | --host=* | --hos=* | --ho=*)-    host_alias=$ac_optarg ;;--  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)-    ac_prev=htmldir ;;-  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \-  | --ht=*)-    htmldir=$ac_optarg ;;--  -includedir | --includedir | --includedi | --included | --include \-  | --includ | --inclu | --incl | --inc)-    ac_prev=includedir ;;-  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \-  | --includ=* | --inclu=* | --incl=* | --inc=*)-    includedir=$ac_optarg ;;--  -infodir | --infodir | --infodi | --infod | --info | --inf)-    ac_prev=infodir ;;-  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)-    infodir=$ac_optarg ;;--  -libdir | --libdir | --libdi | --libd)-    ac_prev=libdir ;;-  -libdir=* | --libdir=* | --libdi=* | --libd=*)-    libdir=$ac_optarg ;;--  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \-  | --libexe | --libex | --libe)-    ac_prev=libexecdir ;;-  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \-  | --libexe=* | --libex=* | --libe=*)-    libexecdir=$ac_optarg ;;--  -localedir | --localedir | --localedi | --localed | --locale)-    ac_prev=localedir ;;-  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)-    localedir=$ac_optarg ;;--  -localstatedir | --localstatedir | --localstatedi | --localstated \-  | --localstate | --localstat | --localsta | --localst | --locals)-    ac_prev=localstatedir ;;-  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \-  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)-    localstatedir=$ac_optarg ;;--  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)-    ac_prev=mandir ;;-  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)-    mandir=$ac_optarg ;;--  -nfp | --nfp | --nf)-    # Obsolete; use --without-fp.-    with_fp=no ;;--  -no-create | --no-create | --no-creat | --no-crea | --no-cre \-  | --no-cr | --no-c | -n)-    no_create=yes ;;--  -no-recursion | --no-recursion | --no-recursio | --no-recursi \-  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)-    no_recursion=yes ;;--  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \-  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \-  | --oldin | --oldi | --old | --ol | --o)-    ac_prev=oldincludedir ;;-  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \-  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \-  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)-    oldincludedir=$ac_optarg ;;--  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)-    ac_prev=prefix ;;-  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)-    prefix=$ac_optarg ;;--  -program-prefix | --program-prefix | --program-prefi | --program-pref \-  | --program-pre | --program-pr | --program-p)-    ac_prev=program_prefix ;;-  -program-prefix=* | --program-prefix=* | --program-prefi=* \-  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)-    program_prefix=$ac_optarg ;;--  -program-suffix | --program-suffix | --program-suffi | --program-suff \-  | --program-suf | --program-su | --program-s)-    ac_prev=program_suffix ;;-  -program-suffix=* | --program-suffix=* | --program-suffi=* \-  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)-    program_suffix=$ac_optarg ;;--  -program-transform-name | --program-transform-name \-  | --program-transform-nam | --program-transform-na \-  | --program-transform-n | --program-transform- \-  | --program-transform | --program-transfor \-  | --program-transfo | --program-transf \-  | --program-trans | --program-tran \-  | --progr-tra | --program-tr | --program-t)-    ac_prev=program_transform_name ;;-  -program-transform-name=* | --program-transform-name=* \-  | --program-transform-nam=* | --program-transform-na=* \-  | --program-transform-n=* | --program-transform-=* \-  | --program-transform=* | --program-transfor=* \-  | --program-transfo=* | --program-transf=* \-  | --program-trans=* | --program-tran=* \-  | --progr-tra=* | --program-tr=* | --program-t=*)-    program_transform_name=$ac_optarg ;;--  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)-    ac_prev=pdfdir ;;-  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)-    pdfdir=$ac_optarg ;;--  -psdir | --psdir | --psdi | --psd | --ps)-    ac_prev=psdir ;;-  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)-    psdir=$ac_optarg ;;--  -q | -quiet | --quiet | --quie | --qui | --qu | --q \-  | -silent | --silent | --silen | --sile | --sil)-    silent=yes ;;--  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)-    ac_prev=sbindir ;;-  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \-  | --sbi=* | --sb=*)-    sbindir=$ac_optarg ;;--  -sharedstatedir | --sharedstatedir | --sharedstatedi \-  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \-  | --sharedst | --shareds | --shared | --share | --shar \-  | --sha | --sh)-    ac_prev=sharedstatedir ;;-  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \-  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \-  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \-  | --sha=* | --sh=*)-    sharedstatedir=$ac_optarg ;;--  -site | --site | --sit)-    ac_prev=site ;;-  -site=* | --site=* | --sit=*)-    site=$ac_optarg ;;--  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)-    ac_prev=srcdir ;;-  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)-    srcdir=$ac_optarg ;;--  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \-  | --syscon | --sysco | --sysc | --sys | --sy)-    ac_prev=sysconfdir ;;-  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \-  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)-    sysconfdir=$ac_optarg ;;--  -target | --target | --targe | --targ | --tar | --ta | --t)-    ac_prev=target_alias ;;-  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)-    target_alias=$ac_optarg ;;--  -v | -verbose | --verbose | --verbos | --verbo | --verb)-    verbose=yes ;;--  -version | --version | --versio | --versi | --vers | -V)-    ac_init_version=: ;;--  -with-* | --with-*)-    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2-   { (exit 1); exit 1; }; }-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"with_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval with_$ac_useropt=\$ac_optarg ;;--  -without-* | --without-*)-    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`-    # Reject names that are not valid shell variable names.-    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      { $as_echo "$as_me: error: invalid package name: $ac_useropt" >&2-   { (exit 1); exit 1; }; }-    ac_useropt_orig=$ac_useropt-    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`-    case $ac_user_opts in-      *"-"with_$ac_useropt"-"*) ;;-      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"-	 ac_unrecognized_sep=', ';;-    esac-    eval with_$ac_useropt=no ;;--  --x)-    # Obsolete; use --with-x.-    with_x=yes ;;--  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \-  | --x-incl | --x-inc | --x-in | --x-i)-    ac_prev=x_includes ;;-  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \-  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)-    x_includes=$ac_optarg ;;--  -x-libraries | --x-libraries | --x-librarie | --x-librari \-  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)-    ac_prev=x_libraries ;;-  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \-  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)-    x_libraries=$ac_optarg ;;--  -*) { $as_echo "$as_me: error: unrecognized option: $ac_option-Try \`$0 --help' for more information." >&2-   { (exit 1); exit 1; }; }-    ;;--  *=*)-    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`-    # Reject names that are not valid shell variable names.-    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&-      { $as_echo "$as_me: error: invalid variable name: $ac_envvar" >&2-   { (exit 1); exit 1; }; }-    eval $ac_envvar=\$ac_optarg-    export $ac_envvar ;;--  *)-    # FIXME: should be removed in autoconf 3.0.-    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2-    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&-      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2-    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}-    ;;--  esac-done--if test -n "$ac_prev"; then-  ac_option=--`echo $ac_prev | sed 's/_/-/g'`-  { $as_echo "$as_me: error: missing argument to $ac_option" >&2-   { (exit 1); exit 1; }; }-fi--if test -n "$ac_unrecognized_opts"; then-  case $enable_option_checking in-    no) ;;-    fatal) { $as_echo "$as_me: error: unrecognized options: $ac_unrecognized_opts" >&2-   { (exit 1); exit 1; }; } ;;-    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;-  esac-fi--# Check all directory arguments for consistency.-for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \-		datadir sysconfdir sharedstatedir localstatedir includedir \-		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \-		libdir localedir mandir-do-  eval ac_val=\$$ac_var-  # Remove trailing slashes.-  case $ac_val in-    */ )-      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`-      eval $ac_var=\$ac_val;;-  esac-  # Be sure to have absolute directory names.-  case $ac_val in-    [\\/$]* | ?:[\\/]* )  continue;;-    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;-  esac-  { $as_echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2-   { (exit 1); exit 1; }; }-done--# There might be people who depend on the old broken behavior: `$host'-# used to hold the argument of --host etc.-# FIXME: To remove some day.-build=$build_alias-host=$host_alias-target=$target_alias--# FIXME: To remove some day.-if test "x$host_alias" != x; then-  if test "x$build_alias" = x; then-    cross_compiling=maybe-    $as_echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.-    If a cross compiler is detected then cross compile mode will be used." >&2-  elif test "x$build_alias" != "x$host_alias"; then-    cross_compiling=yes-  fi-fi--ac_tool_prefix=-test -n "$host_alias" && ac_tool_prefix=$host_alias---test "$silent" = yes && exec 6>/dev/null---ac_pwd=`pwd` && test -n "$ac_pwd" &&-ac_ls_di=`ls -di .` &&-ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||-  { $as_echo "$as_me: error: working directory cannot be determined" >&2-   { (exit 1); exit 1; }; }-test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||-  { $as_echo "$as_me: error: pwd does not report name of working directory" >&2-   { (exit 1); exit 1; }; }---# Find the source files, if location was not specified.-if test -z "$srcdir"; then-  ac_srcdir_defaulted=yes-  # Try the directory containing this script, then the parent directory.-  ac_confdir=`$as_dirname -- "$as_myself" ||-$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$as_myself" : 'X\(//\)[^/]' \| \-	 X"$as_myself" : 'X\(//\)$' \| \-	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_myself" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-  srcdir=$ac_confdir-  if test ! -r "$srcdir/$ac_unique_file"; then-    srcdir=..-  fi-else-  ac_srcdir_defaulted=no-fi-if test ! -r "$srcdir/$ac_unique_file"; then-  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."-  { $as_echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2-   { (exit 1); exit 1; }; }-fi-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"-ac_abs_confdir=`(-	cd "$srcdir" && test -r "./$ac_unique_file" || { $as_echo "$as_me: error: $ac_msg" >&2-   { (exit 1); exit 1; }; }-	pwd)`-# When building in place, set srcdir=.-if test "$ac_abs_confdir" = "$ac_pwd"; then-  srcdir=.-fi-# Remove unnecessary trailing slashes from srcdir.-# Double slashes in file names in object file debugging info-# mess up M-x gdb in Emacs.-case $srcdir in-*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;-esac-for ac_var in $ac_precious_vars; do-  eval ac_env_${ac_var}_set=\${${ac_var}+set}-  eval ac_env_${ac_var}_value=\$${ac_var}-  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}-  eval ac_cv_env_${ac_var}_value=\$${ac_var}-done--#-# Report the --help message.-#-if test "$ac_init_help" = "long"; then-  # Omit some internal or obsolete options to make the list less imposing.-  # This message is too long to be a string in the A/UX 3.1 sh.-  cat <<_ACEOF-\`configure' configures Haskell GLUT package 2.1.2.1 to adapt to many kinds of systems.--Usage: $0 [OPTION]... [VAR=VALUE]...--To assign environment variables (e.g., CC, CFLAGS...), specify them as-VAR=VALUE.  See below for descriptions of some of the useful variables.--Defaults for the options are specified in brackets.--Configuration:-  -h, --help              display this help and exit-      --help=short        display options specific to this package-      --help=recursive    display the short help of all the included packages-  -V, --version           display version information and exit-  -q, --quiet, --silent   do not print \`checking...' messages-      --cache-file=FILE   cache test results in FILE [disabled]-  -C, --config-cache      alias for \`--cache-file=config.cache'-  -n, --no-create         do not create output files-      --srcdir=DIR        find the sources in DIR [configure dir or \`..']--Installation directories:-  --prefix=PREFIX         install architecture-independent files in PREFIX-                          [$ac_default_prefix]-  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX-                          [PREFIX]--By default, \`make install' will install all the files in-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify-an installation prefix other than \`$ac_default_prefix' using \`--prefix',-for instance \`--prefix=\$HOME'.--For better control, use the options below.--Fine tuning of the installation directories:-  --bindir=DIR            user executables [EPREFIX/bin]-  --sbindir=DIR           system admin executables [EPREFIX/sbin]-  --libexecdir=DIR        program executables [EPREFIX/libexec]-  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]-  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]-  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]-  --libdir=DIR            object code libraries [EPREFIX/lib]-  --includedir=DIR        C header files [PREFIX/include]-  --oldincludedir=DIR     C header files for non-gcc [/usr/include]-  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]-  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]-  --infodir=DIR           info documentation [DATAROOTDIR/info]-  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]-  --mandir=DIR            man documentation [DATAROOTDIR/man]-  --docdir=DIR            documentation root [DATAROOTDIR/doc/GLUT]-  --htmldir=DIR           html documentation [DOCDIR]-  --dvidir=DIR            dvi documentation [DOCDIR]-  --pdfdir=DIR            pdf documentation [DOCDIR]-  --psdir=DIR             ps documentation [DOCDIR]-_ACEOF--  cat <<\_ACEOF--X features:-  --x-includes=DIR    X include files are in DIR-  --x-libraries=DIR   X library files are in DIR--System types:-  --build=BUILD     configure for building on BUILD [guessed]-  --host=HOST       cross-compile to build programs to run on HOST [BUILD]-  --target=TARGET   configure for building compilers for TARGET [HOST]-_ACEOF-fi--if test -n "$ac_init_help"; then-  case $ac_init_help in-     short | recursive ) echo "Configuration of Haskell GLUT package 2.1.2.1:";;-   esac-  cat <<\_ACEOF--Optional Features:-  --disable-option-checking  ignore unrecognized --enable/--with options-  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)-  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]-  --enable-opengl         build a Haskell binding for OpenGL (GL/GLU). On Mac-                          OS X, use --enable-opengl=x11 to use X11 instead of-                          the "native" libraries. (default=autodetect)-  --enable-glut           build a Haskell binding for GLUT-                          (default=autodetect)--Optional Packages:-  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]-  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)-C compiler-  --with-compiler[=HC]    use the given Haskell compiler (default=ghc)-  --with-x                use the X Window System--Some influential environment variables:-  CC          C compiler command-  CFLAGS      C compiler flags-  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a-              nonstandard directory <lib dir>-  LIBS        libraries to pass to the linker, e.g. -l<library>-  CPPFLAGS    C/C++/Objective C preprocessor flags, e.g. -I<include dir> if-              you have headers in a nonstandard directory <include dir>-  XMKMF       Path to xmkmf, Makefile generator for X Window System-  CPP         C preprocessor--Use these variables to override the choices made by `configure' or to help-it to find libraries and programs with nonstandard names/locations.--Report bugs to <sven.panne@aedion.de>.-_ACEOF-ac_status=$?-fi--if test "$ac_init_help" = "recursive"; then-  # If there are subdirs, report their specific --help.-  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue-    test -d "$ac_dir" ||-      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||-      continue-    ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)-  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`-  # A ".." for each directory in $ac_dir_suffix.-  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`-  case $ac_top_builddir_sub in-  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;-  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;-  esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in-  .)  # We are building in place.-    ac_srcdir=.-    ac_top_srcdir=$ac_top_builddir_sub-    ac_abs_top_srcdir=$ac_pwd ;;-  [\\/]* | ?:[\\/]* )  # Absolute name.-    ac_srcdir=$srcdir$ac_dir_suffix;-    ac_top_srcdir=$srcdir-    ac_abs_top_srcdir=$srcdir ;;-  *) # Relative name.-    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix-    ac_top_srcdir=$ac_top_build_prefix$srcdir-    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix--    cd "$ac_dir" || { ac_status=$?; continue; }-    # Check for guested configure.-    if test -f "$ac_srcdir/configure.gnu"; then-      echo &&-      $SHELL "$ac_srcdir/configure.gnu" --help=recursive-    elif test -f "$ac_srcdir/configure"; then-      echo &&-      $SHELL "$ac_srcdir/configure" --help=recursive-    else-      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2-    fi || ac_status=$?-    cd "$ac_pwd" || { ac_status=$?; break; }-  done-fi--test -n "$ac_init_help" && exit $ac_status-if $ac_init_version; then-  cat <<\_ACEOF-Haskell GLUT package configure 2.1.2.1-generated by GNU Autoconf 2.63--Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,-2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.-This configure script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it.-_ACEOF-  exit-fi-cat >config.log <<_ACEOF-This file contains any messages produced by compilers while-running configure, to aid debugging if configure makes a mistake.--It was created by Haskell GLUT package $as_me 2.1.2.1, which was-generated by GNU Autoconf 2.63.  Invocation command line was--  $ $0 $@--_ACEOF-exec 5>>config.log-{-cat <<_ASUNAME-## --------- ##-## Platform. ##-## --------- ##--hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`-uname -m = `(uname -m) 2>/dev/null || echo unknown`-uname -r = `(uname -r) 2>/dev/null || echo unknown`-uname -s = `(uname -s) 2>/dev/null || echo unknown`-uname -v = `(uname -v) 2>/dev/null || echo unknown`--/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`-/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`--/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`-/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`-/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`-/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`-/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`-/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`--_ASUNAME--as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  $as_echo "PATH: $as_dir"-done-IFS=$as_save_IFS--} >&5--cat >&5 <<_ACEOF---## ----------- ##-## Core tests. ##-## ----------- ##--_ACEOF---# Keep a trace of the command line.-# Strip out --no-create and --no-recursion so they do not pile up.-# Strip out --silent because we don't want to record it for future runs.-# Also quote any args containing shell meta-characters.-# Make two passes to allow for proper duplicate-argument suppression.-ac_configure_args=-ac_configure_args0=-ac_configure_args1=-ac_must_keep_next=false-for ac_pass in 1 2-do-  for ac_arg-  do-    case $ac_arg in-    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;-    -q | -quiet | --quiet | --quie | --qui | --qu | --q \-    | -silent | --silent | --silen | --sile | --sil)-      continue ;;-    *\'*)-      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;-    esac-    case $ac_pass in-    1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;-    2)-      ac_configure_args1="$ac_configure_args1 '$ac_arg'"-      if test $ac_must_keep_next = true; then-	ac_must_keep_next=false # Got value, back to normal.-      else-	case $ac_arg in-	  *=* | --config-cache | -C | -disable-* | --disable-* \-	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \-	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \-	  | -with-* | --with-* | -without-* | --without-* | --x)-	    case "$ac_configure_args0 " in-	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;-	    esac-	    ;;-	  -* ) ac_must_keep_next=true ;;-	esac-      fi-      ac_configure_args="$ac_configure_args '$ac_arg'"-      ;;-    esac-  done-done-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }--# When interrupted or exit'd, cleanup temporary files, and complete-# config.log.  We remove comments because anyway the quotes in there-# would cause problems or look ugly.-# WARNING: Use '\'' to represent an apostrophe within the trap.-# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.-trap 'exit_status=$?-  # Save into config.log some information that might help in debugging.-  {-    echo--    cat <<\_ASBOX-## ---------------- ##-## Cache variables. ##-## ---------------- ##-_ASBOX-    echo-    # The following way of writing the cache mishandles newlines in values,-(-  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do-    eval ac_val=\$$ac_var-    case $ac_val in #(-    *${as_nl}*)-      case $ac_var in #(-      *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;-      esac-      case $ac_var in #(-      _ | IFS | as_nl) ;; #(-      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(-      *) $as_unset $ac_var ;;-      esac ;;-    esac-  done-  (set) 2>&1 |-    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(-    *${as_nl}ac_space=\ *)-      sed -n \-	"s/'\''/'\''\\\\'\'''\''/g;-	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"-      ;; #(-    *)-      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"-      ;;-    esac |-    sort-)-    echo--    cat <<\_ASBOX-## ----------------- ##-## Output variables. ##-## ----------------- ##-_ASBOX-    echo-    for ac_var in $ac_subst_vars-    do-      eval ac_val=\$$ac_var-      case $ac_val in-      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;-      esac-      $as_echo "$ac_var='\''$ac_val'\''"-    done | sort-    echo--    if test -n "$ac_subst_files"; then-      cat <<\_ASBOX-## ------------------- ##-## File substitutions. ##-## ------------------- ##-_ASBOX-      echo-      for ac_var in $ac_subst_files-      do-	eval ac_val=\$$ac_var-	case $ac_val in-	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;-	esac-	$as_echo "$ac_var='\''$ac_val'\''"-      done | sort-      echo-    fi--    if test -s confdefs.h; then-      cat <<\_ASBOX-## ----------- ##-## confdefs.h. ##-## ----------- ##-_ASBOX-      echo-      cat confdefs.h-      echo-    fi-    test "$ac_signal" != 0 &&-      $as_echo "$as_me: caught signal $ac_signal"-    $as_echo "$as_me: exit $exit_status"-  } >&5-  rm -f core *.core core.conftest.* &&-    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&-    exit $exit_status-' 0-for ac_signal in 1 2 13 15; do-  trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal-done-ac_signal=0--# confdefs.h avoids OS command line length limits that DEFS can exceed.-rm -f -r conftest* confdefs.h--# Predefined preprocessor variables.--cat >>confdefs.h <<_ACEOF-#define PACKAGE_NAME "$PACKAGE_NAME"-_ACEOF---cat >>confdefs.h <<_ACEOF-#define PACKAGE_TARNAME "$PACKAGE_TARNAME"-_ACEOF---cat >>confdefs.h <<_ACEOF-#define PACKAGE_VERSION "$PACKAGE_VERSION"-_ACEOF---cat >>confdefs.h <<_ACEOF-#define PACKAGE_STRING "$PACKAGE_STRING"-_ACEOF---cat >>confdefs.h <<_ACEOF-#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"-_ACEOF---# Let the site file select an alternate cache file if it wants to.-# Prefer an explicitly selected file to automatically selected ones.-ac_site_file1=NONE-ac_site_file2=NONE-if test -n "$CONFIG_SITE"; then-  ac_site_file1=$CONFIG_SITE-elif test "x$prefix" != xNONE; then-  ac_site_file1=$prefix/share/config.site-  ac_site_file2=$prefix/etc/config.site-else-  ac_site_file1=$ac_default_prefix/share/config.site-  ac_site_file2=$ac_default_prefix/etc/config.site-fi-for ac_site_file in "$ac_site_file1" "$ac_site_file2"-do-  test "x$ac_site_file" = xNONE && continue-  if test -r "$ac_site_file"; then-    { $as_echo "$as_me:$LINENO: loading site script $ac_site_file" >&5-$as_echo "$as_me: loading site script $ac_site_file" >&6;}-    sed 's/^/| /' "$ac_site_file" >&5-    . "$ac_site_file"-  fi-done--if test -r "$cache_file"; then-  # Some versions of bash will fail to source /dev/null (special-  # files actually), so we avoid doing that.-  if test -f "$cache_file"; then-    { $as_echo "$as_me:$LINENO: loading cache $cache_file" >&5-$as_echo "$as_me: loading cache $cache_file" >&6;}-    case $cache_file in-      [\\/]* | ?:[\\/]* ) . "$cache_file";;-      *)                      . "./$cache_file";;-    esac-  fi-else-  { $as_echo "$as_me:$LINENO: creating cache $cache_file" >&5-$as_echo "$as_me: creating cache $cache_file" >&6;}-  >$cache_file-fi--# Check that the precious variables saved in the cache have kept the same-# value.-ac_cache_corrupted=false-for ac_var in $ac_precious_vars; do-  eval ac_old_set=\$ac_cv_env_${ac_var}_set-  eval ac_new_set=\$ac_env_${ac_var}_set-  eval ac_old_val=\$ac_cv_env_${ac_var}_value-  eval ac_new_val=\$ac_env_${ac_var}_value-  case $ac_old_set,$ac_new_set in-    set,)-      { $as_echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}-      ac_cache_corrupted=: ;;-    ,set)-      { $as_echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}-      ac_cache_corrupted=: ;;-    ,);;-    *)-      if test "x$ac_old_val" != "x$ac_new_val"; then-	# differences in whitespace do not lead to failure.-	ac_old_val_w=`echo x $ac_old_val`-	ac_new_val_w=`echo x $ac_new_val`-	if test "$ac_old_val_w" != "$ac_new_val_w"; then-	  { $as_echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5-$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}-	  ac_cache_corrupted=:-	else-	  { $as_echo "$as_me:$LINENO: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5-$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}-	  eval $ac_var=\$ac_old_val-	fi-	{ $as_echo "$as_me:$LINENO:   former value:  \`$ac_old_val'" >&5-$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}-	{ $as_echo "$as_me:$LINENO:   current value: \`$ac_new_val'" >&5-$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}-      fi;;-  esac-  # Pass precious variables to config.status.-  if test "$ac_new_set" = set; then-    case $ac_new_val in-    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;-    *) ac_arg=$ac_var=$ac_new_val ;;-    esac-    case " $ac_configure_args " in-      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.-      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;-    esac-  fi-done-if $ac_cache_corrupted; then-  { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-  { $as_echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5-$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}-  { { $as_echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5-$as_echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}-   { (exit 1); exit 1; }; }-fi--------------------------ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu----# Safety check: Ensure that we are in the correct source directory.---# The first file mentioned below will be generated by autoheader and contains-# defines which are needed during package build time only. The second header-# contains all kinds of stuff which is needed for using this package.-ac_config_headers="$ac_config_headers include/HsGLUTConfig.h include/HsGLUT.h"---# Necessary for Cabal, which passes with --with-cc flag on Windows:--# Check whether --with-cc was given.-if test "${with_cc+set}" = set; then-  withval=$with_cc; CC=$withval-fi--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu-if test -n "$ac_tool_prefix"; then-  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.-set dummy ${ac_tool_prefix}gcc; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="${ac_tool_prefix}gcc"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:$LINENO: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi---fi-if test -z "$ac_cv_prog_CC"; then-  ac_ct_CC=$CC-  # Extract the first word of "gcc", so it can be a program name with args.-set dummy gcc; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$ac_ct_CC"; then-  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_ac_ct_CC="gcc"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--fi-fi-ac_ct_CC=$ac_cv_prog_ac_ct_CC-if test -n "$ac_ct_CC"; then-  { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5-$as_echo "$ac_ct_CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi--  if test "x$ac_ct_CC" = x; then-    CC=""-  else-    case $cross_compiling:$ac_tool_warned in-yes:)-{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}-ac_tool_warned=yes ;;-esac-    CC=$ac_ct_CC-  fi-else-  CC="$ac_cv_prog_CC"-fi--if test -z "$CC"; then-          if test -n "$ac_tool_prefix"; then-    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.-set dummy ${ac_tool_prefix}cc; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="${ac_tool_prefix}cc"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:$LINENO: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi---  fi-fi-if test -z "$CC"; then-  # Extract the first word of "cc", so it can be a program name with args.-set dummy cc; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-  ac_prog_rejected=no-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then-       ac_prog_rejected=yes-       continue-     fi-    ac_cv_prog_CC="cc"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--if test $ac_prog_rejected = yes; then-  # We found a bogon in the path, so make sure we never use it.-  set dummy $ac_cv_prog_CC-  shift-  if test $# != 0; then-    # We chose a different compiler from the bogus one.-    # However, it has the same basename, so the bogon will be chosen-    # first if we set CC to just the basename; use the full file name.-    shift-    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"-  fi-fi-fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:$LINENO: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi---fi-if test -z "$CC"; then-  if test -n "$ac_tool_prefix"; then-  for ac_prog in cl.exe-  do-    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.-set dummy $ac_tool_prefix$ac_prog; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$CC"; then-  ac_cv_prog_CC="$CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--fi-fi-CC=$ac_cv_prog_CC-if test -n "$CC"; then-  { $as_echo "$as_me:$LINENO: result: $CC" >&5-$as_echo "$CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi---    test -n "$CC" && break-  done-fi-if test -z "$CC"; then-  ac_ct_CC=$CC-  for ac_prog in cl.exe-do-  # Extract the first word of "$ac_prog", so it can be a program name with args.-set dummy $ac_prog; ac_word=$2-{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -n "$ac_ct_CC"; then-  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.-else-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_exec_ext in '' $ac_executable_extensions; do-  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then-    ac_cv_prog_ac_ct_CC="$ac_prog"-    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5-    break 2-  fi-done-done-IFS=$as_save_IFS--fi-fi-ac_ct_CC=$ac_cv_prog_ac_ct_CC-if test -n "$ac_ct_CC"; then-  { $as_echo "$as_me:$LINENO: result: $ac_ct_CC" >&5-$as_echo "$ac_ct_CC" >&6; }-else-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-fi---  test -n "$ac_ct_CC" && break-done--  if test "x$ac_ct_CC" = x; then-    CC=""-  else-    case $cross_compiling:$ac_tool_warned in-yes:)-{ $as_echo "$as_me:$LINENO: WARNING: using cross tools not prefixed with host triplet" >&5-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}-ac_tool_warned=yes ;;-esac-    CC=$ac_ct_CC-  fi-fi--fi---test -z "$CC" && { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH-See \`config.log' for more details." >&5-$as_echo "$as_me: error: no acceptable C compiler found in \$PATH-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }--# Provide some information about the compiler.-$as_echo "$as_me:$LINENO: checking for C compiler version" >&5-set X $ac_compile-ac_compiler=$2-{ (ac_try="$ac_compiler --version >&5"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compiler --version >&5") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }-{ (ac_try="$ac_compiler -v >&5"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compiler -v >&5") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }-{ (ac_try="$ac_compiler -V >&5"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compiler -V >&5") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }--cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-ac_clean_files_save=$ac_clean_files-ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"-# Try to create an executable without -o first, disregard a.out.-# It will help us diagnose broken compilers, and finding out an intuition-# of exeext.-{ $as_echo "$as_me:$LINENO: checking for C compiler default output file name" >&5-$as_echo_n "checking for C compiler default output file name... " >&6; }-ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`--# The possible output files:-ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"--ac_rmfiles=-for ac_file in $ac_files-do-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;-    * ) ac_rmfiles="$ac_rmfiles $ac_file";;-  esac-done-rm -f $ac_rmfiles--if { (ac_try="$ac_link_default"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link_default") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }; then-  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.-# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'-# in a Makefile.  We should not override ac_cv_exeext if it was cached,-# so that the user can short-circuit this test for compilers unknown to-# Autoconf.-for ac_file in $ac_files ''-do-  test -f "$ac_file" || continue-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )-	;;-    [ab].out )-	# We found the default executable, but exeext='' is most-	# certainly right.-	break;;-    *.* )-        if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;-	then :; else-	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`-	fi-	# We set ac_cv_exeext here because the later test for it is not-	# safe: cross compilers may not add the suffix if given an `-o'-	# argument, so we may need to know it at that point already.-	# Even if this section looks crufty: it has the advantage of-	# actually working.-	break;;-    * )-	break;;-  esac-done-test "$ac_cv_exeext" = no && ac_cv_exeext=--else-  ac_file=''-fi--{ $as_echo "$as_me:$LINENO: result: $ac_file" >&5-$as_echo "$ac_file" >&6; }-if test -z "$ac_file"; then-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: C compiler cannot create executables-See \`config.log' for more details." >&5-$as_echo "$as_me: error: C compiler cannot create executables-See \`config.log' for more details." >&2;}-   { (exit 77); exit 77; }; }; }-fi--ac_exeext=$ac_cv_exeext--# Check that the compiler produces executables we can run.  If not, either-# the compiler is broken, or we cross compile.-{ $as_echo "$as_me:$LINENO: checking whether the C compiler works" >&5-$as_echo_n "checking whether the C compiler works... " >&6; }-# FIXME: These cross compiler hacks should be removed for Autoconf 3.0-# If not cross compiling, check that we can run a simple program.-if test "$cross_compiling" != yes; then-  if { ac_try='./$ac_file'-  { (case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_try") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }; }; then-    cross_compiling=no-  else-    if test "$cross_compiling" = maybe; then-	cross_compiling=yes-    else-	{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: cannot run C compiled programs.-If you meant to cross compile, use \`--host'.-See \`config.log' for more details." >&5-$as_echo "$as_me: error: cannot run C compiled programs.-If you meant to cross compile, use \`--host'.-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-    fi-  fi-fi-{ $as_echo "$as_me:$LINENO: result: yes" >&5-$as_echo "yes" >&6; }--rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out-ac_clean_files=$ac_clean_files_save-# Check that the compiler produces executables we can run.  If not, either-# the compiler is broken, or we cross compile.-{ $as_echo "$as_me:$LINENO: checking whether we are cross compiling" >&5-$as_echo_n "checking whether we are cross compiling... " >&6; }-{ $as_echo "$as_me:$LINENO: result: $cross_compiling" >&5-$as_echo "$cross_compiling" >&6; }--{ $as_echo "$as_me:$LINENO: checking for suffix of executables" >&5-$as_echo_n "checking for suffix of executables... " >&6; }-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }; then-  # If both `conftest.exe' and `conftest' are `present' (well, observable)-# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will-# work properly (i.e., refer to `conftest.exe'), while it won't with-# `rm'.-for ac_file in conftest.exe conftest conftest.*; do-  test -f "$ac_file" || continue-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;-    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`-	  break;;-    * ) break;;-  esac-done-else-  { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details." >&5-$as_echo "$as_me: error: cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-fi--rm -f conftest$ac_cv_exeext-{ $as_echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5-$as_echo "$ac_cv_exeext" >&6; }--rm -f conftest.$ac_ext-EXEEXT=$ac_cv_exeext-ac_exeext=$EXEEXT-{ $as_echo "$as_me:$LINENO: checking for suffix of object files" >&5-$as_echo_n "checking for suffix of object files... " >&6; }-if test "${ac_cv_objext+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.o conftest.obj-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }; then-  for ac_file in conftest.o conftest.obj conftest.*; do-  test -f "$ac_file" || continue;-  case $ac_file in-    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;-    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`-       break;;-  esac-done-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--{ { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile-See \`config.log' for more details." >&5-$as_echo "$as_me: error: cannot compute suffix of object files: cannot compile-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-fi--rm -f conftest.$ac_cv_objext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_objext" >&5-$as_echo "$ac_cv_objext" >&6; }-OBJEXT=$ac_cv_objext-ac_objext=$OBJEXT-{ $as_echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5-$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }-if test "${ac_cv_c_compiler_gnu+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{-#ifndef __GNUC__-       choke me-#endif--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_compiler_gnu=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_compiler_gnu=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-ac_cv_c_compiler_gnu=$ac_compiler_gnu--fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5-$as_echo "$ac_cv_c_compiler_gnu" >&6; }-if test $ac_compiler_gnu = yes; then-  GCC=yes-else-  GCC=-fi-ac_test_CFLAGS=${CFLAGS+set}-ac_save_CFLAGS=$CFLAGS-{ $as_echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5-$as_echo_n "checking whether $CC accepts -g... " >&6; }-if test "${ac_cv_prog_cc_g+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_save_c_werror_flag=$ac_c_werror_flag-   ac_c_werror_flag=yes-   ac_cv_prog_cc_g=no-   CFLAGS="-g"-   cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_cv_prog_cc_g=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	CFLAGS=""-      cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  :-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_c_werror_flag=$ac_save_c_werror_flag-	 CFLAGS="-g"-	 cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_cv_prog_cc_g=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-   ac_c_werror_flag=$ac_save_c_werror_flag-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5-$as_echo "$ac_cv_prog_cc_g" >&6; }-if test "$ac_test_CFLAGS" = set; then-  CFLAGS=$ac_save_CFLAGS-elif test $ac_cv_prog_cc_g = yes; then-  if test "$GCC" = yes; then-    CFLAGS="-g -O2"-  else-    CFLAGS="-g"-  fi-else-  if test "$GCC" = yes; then-    CFLAGS="-O2"-  else-    CFLAGS=-  fi-fi-{ $as_echo "$as_me:$LINENO: checking for $CC option to accept ISO C89" >&5-$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }-if test "${ac_cv_prog_cc_c89+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_cv_prog_cc_c89=no-ac_save_CC=$CC-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <stdarg.h>-#include <stdio.h>-#include <sys/types.h>-#include <sys/stat.h>-/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */-struct buf { int x; };-FILE * (*rcsopen) (struct buf *, struct stat *, int);-static char *e (p, i)-     char **p;-     int i;-{-  return p[i];-}-static char *f (char * (*g) (char **, int), char **p, ...)-{-  char *s;-  va_list v;-  va_start (v,p);-  s = g (p, va_arg (v,int));-  va_end (v);-  return s;-}--/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has-   function prototypes and stuff, but not '\xHH' hex character constants.-   These don't provoke an error unfortunately, instead are silently treated-   as 'x'.  The following induces an error, until -std is added to get-   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an-   array size at least.  It's necessary to write '\x00'==0 to get something-   that's true only with -std.  */-int osf4_cc_array ['\x00' == 0 ? 1 : -1];--/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters-   inside strings and character constants.  */-#define FOO(x) 'x'-int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];--int test (int i, double x);-struct s1 {int (*f) (int a);};-struct s2 {int (*f) (double a);};-int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);-int argc;-char **argv;-int-main ()-{-return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];-  ;-  return 0;-}-_ACEOF-for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \-	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"-do-  CC="$ac_save_CC $ac_arg"-  rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_cv_prog_cc_c89=$ac_arg-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -f core conftest.err conftest.$ac_objext-  test "x$ac_cv_prog_cc_c89" != "xno" && break-done-rm -f conftest.$ac_ext-CC=$ac_save_CC--fi-# AC_CACHE_VAL-case "x$ac_cv_prog_cc_c89" in-  x)-    { $as_echo "$as_me:$LINENO: result: none needed" >&5-$as_echo "none needed" >&6; } ;;-  xno)-    { $as_echo "$as_me:$LINENO: result: unsupported" >&5-$as_echo "unsupported" >&6; } ;;-  *)-    CC="$CC $ac_cv_prog_cc_c89"-    { $as_echo "$as_me:$LINENO: result: $ac_cv_prog_cc_c89" >&5-$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;-esac---ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu---# we do not really care about this here, but this avoids a warning about an-# unknown option--# Check whether --with-compiler was given.-if test "${with_compiler+set}" = set; then-  withval=$with_compiler; with_compiler=$withval-else-  with_compiler=ghc-fi----# We set this to "yes" later when we have found GLUT libs and headers.-GLUT_BUILD_PACKAGE=no--# Shall we build this package at all?-# Check whether --enable-opengl was given.-if test "${enable_opengl+set}" = set; then-  enableval=$enable_opengl; enable_opengl=$enableval-else-  enable_opengl=yes-fi----# Check whether --enable-glut was given.-if test "${enable_glut+set}" = set; then-  enableval=$enable_glut; enable_glut=$enableval-else-  enable_glut=yes-fi----if test x"$enable_glut" = xyes; then--# Check for GLUT include paths and libraries--{ $as_echo "$as_me:$LINENO: checking for Windows environment" >&5-$as_echo_n "checking for Windows environment... " >&6; }-if test "${fp_cv_is_win32+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--#if !_WIN32-   syntax error;-#endif--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  fp_cv_is_win32=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	fp_cv_is_win32=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $fp_cv_is_win32" >&5-$as_echo "$fp_cv_is_win32" >&6; }-fp_is_win32="$fp_cv_is_win32"-ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu-{ $as_echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5-$as_echo_n "checking how to run the C preprocessor... " >&6; }-# On Suns, sometimes $CPP names a directory.-if test -n "$CPP" && test -d "$CPP"; then-  CPP=-fi-if test -z "$CPP"; then-  if test "${ac_cv_prog_CPP+set}" = set; then-  $as_echo_n "(cached) " >&6-else-      # Double quotes because CPP needs to be expanded-    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"-    do-      ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  :-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  # Broken: fails on valid input.-continue-fi--rm -f conftest.err conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  # Broken: success on invalid input.-continue-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  # Passes both tests.-ac_preproc_ok=:-break-fi--rm -f conftest.err conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.err conftest.$ac_ext-if $ac_preproc_ok; then-  break-fi--    done-    ac_cv_prog_CPP=$CPP--fi-  CPP=$ac_cv_prog_CPP-else-  ac_cv_prog_CPP=$CPP-fi-{ $as_echo "$as_me:$LINENO: result: $CPP" >&5-$as_echo "$CPP" >&6; }-ac_preproc_ok=false-for ac_c_preproc_warn_flag in '' yes-do-  # Use a header file that comes with gcc, so configuring glibc-  # with a fresh cross-compiler works.-  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-  # <limits.h> exists even on freestanding compilers.-  # On the NeXT, cc -E runs the code through the compiler's parser,-  # not just through cpp. "Syntax error" is here to catch this case.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif-		     Syntax error-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  :-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  # Broken: fails on valid input.-continue-fi--rm -f conftest.err conftest.$ac_ext--  # OK, works on sane cases.  Now check whether nonexistent headers-  # can be detected and how.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <ac_nonexistent.h>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  # Broken: success on invalid input.-continue-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  # Passes both tests.-ac_preproc_ok=:-break-fi--rm -f conftest.err conftest.$ac_ext--done-# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.-rm -f conftest.err conftest.$ac_ext-if $ac_preproc_ok; then-  :-else-  { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details." >&5-$as_echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-fi--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu---{ $as_echo "$as_me:$LINENO: checking for X" >&5-$as_echo_n "checking for X... " >&6; }---# Check whether --with-x was given.-if test "${with_x+set}" = set; then-  withval=$with_x;-fi--# $have_x is `yes', `no', `disabled', or empty when we do not yet know.-if test "x$with_x" = xno; then-  # The user explicitly disabled X.-  have_x=disabled-else-  case $x_includes,$x_libraries in #(-    *\'*) { { $as_echo "$as_me:$LINENO: error: cannot use X directory names containing '" >&5-$as_echo "$as_me: error: cannot use X directory names containing '" >&2;}-   { (exit 1); exit 1; }; };; #(-    *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  # One or both of the vars are not set, and there is no cached value.-ac_x_includes=no ac_x_libraries=no-rm -f -r conftest.dir-if mkdir conftest.dir; then-  cd conftest.dir-  cat >Imakefile <<'_ACEOF'-incroot:-	@echo incroot='${INCROOT}'-usrlibdir:-	@echo usrlibdir='${USRLIBDIR}'-libdir:-	@echo libdir='${LIBDIR}'-_ACEOF-  if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then-    # GNU make sometimes prints "make[1]: Entering...", which would confuse us.-    for ac_var in incroot usrlibdir libdir; do-      eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`"-    done-    # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.-    for ac_extension in a so sl dylib la dll; do-      if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" &&-	 test -f "$ac_im_libdir/libX11.$ac_extension"; then-	ac_im_usrlibdir=$ac_im_libdir; break-      fi-    done-    # Screen out bogus values from the imake configuration.  They are-    # bogus both because they are the default anyway, and because-    # using them would break gcc on systems where it needs fixed includes.-    case $ac_im_incroot in-	/usr/include) ac_x_includes= ;;-	*) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;;-    esac-    case $ac_im_usrlibdir in-	/usr/lib | /usr/lib64 | /lib | /lib64) ;;-	*) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;;-    esac-  fi-  cd ..-  rm -f -r conftest.dir-fi--# Standard set of common directories for X headers.-# Check X11 before X11Rn because it is often a symlink to the current release.-ac_x_header_dirs='-/usr/X11/include-/usr/X11R6/include-/usr/X11R5/include-/usr/X11R4/include--/usr/include/X11-/usr/include/X11R6-/usr/include/X11R5-/usr/include/X11R4--/usr/local/X11/include-/usr/local/X11R6/include-/usr/local/X11R5/include-/usr/local/X11R4/include--/usr/local/include/X11-/usr/local/include/X11R6-/usr/local/include/X11R5-/usr/local/include/X11R4--/usr/X386/include-/usr/x386/include-/usr/XFree86/include/X11--/usr/include-/usr/local/include-/usr/unsupported/include-/usr/athena/include-/usr/local/x11r5/include-/usr/lpp/Xamples/include--/usr/openwin/include-/usr/openwin/share/include'--if test "$ac_x_includes" = no; then-  # Guess where to find include files, by looking for Xlib.h.-  # First, try using that file with no special directory specified.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <X11/Xlib.h>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  # We can compile using X headers with no special include directory.-ac_x_includes=-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  for ac_dir in $ac_x_header_dirs; do-  if test -r "$ac_dir/X11/Xlib.h"; then-    ac_x_includes=$ac_dir-    break-  fi-done-fi--rm -f conftest.err conftest.$ac_ext-fi # $ac_x_includes = no--if test "$ac_x_libraries" = no; then-  # Check for the libraries.-  # See if we find them without any special options.-  # Don't add to $LIBS permanently.-  ac_save_LIBS=$LIBS-  LIBS="-lX11 $LIBS"-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <X11/Xlib.h>-int-main ()-{-XrmInitialize ()-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  LIBS=$ac_save_LIBS-# We can link X programs with no special library path.-ac_x_libraries=-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	LIBS=$ac_save_LIBS-for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g`-do-  # Don't even attempt the hair of trying to link an X program!-  for ac_extension in a so sl dylib la dll; do-    if test -r "$ac_dir/libX11.$ac_extension"; then-      ac_x_libraries=$ac_dir-      break 2-    fi-  done-done-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi # $ac_x_libraries = no--case $ac_x_includes,$ac_x_libraries in #(-  no,* | *,no | *\'*)-    # Didn't find X, or a directory has "'" in its name.-    ac_cv_have_x="have_x=no";; #(-  *)-    # Record where we found X for the cache.-    ac_cv_have_x="have_x=yes\-	ac_x_includes='$ac_x_includes'\-	ac_x_libraries='$ac_x_libraries'"-esac-fi-;; #(-    *) have_x=yes;;-  esac-  eval "$ac_cv_have_x"-fi # $with_x != no--if test "$have_x" != yes; then-  { $as_echo "$as_me:$LINENO: result: $have_x" >&5-$as_echo "$have_x" >&6; }-  no_x=yes-else-  # If each of the values was on the command line, it overrides each guess.-  test "x$x_includes" = xNONE && x_includes=$ac_x_includes-  test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries-  # Update the cache value to reflect the command line values.-  ac_cv_have_x="have_x=yes\-	ac_x_includes='$x_includes'\-	ac_x_libraries='$x_libraries'"-  { $as_echo "$as_me:$LINENO: result: libraries $x_libraries, headers $x_includes" >&5-$as_echo "libraries $x_libraries, headers $x_includes" >&6; }-fi---if test x"$fp_is_win32" = xyes; then-  no_x=yes-else-  if test "$no_x" = yes; then-  # Not all programs may use this symbol, but it does not hurt to define it.--cat >>confdefs.h <<\_ACEOF-#define X_DISPLAY_MISSING 1-_ACEOF--  X_CFLAGS= X_PRE_LIBS= X_LIBS= X_EXTRA_LIBS=-else-  if test -n "$x_includes"; then-    X_CFLAGS="$X_CFLAGS -I$x_includes"-  fi--  # It would also be nice to do this for all -L options, not just this one.-  if test -n "$x_libraries"; then-    X_LIBS="$X_LIBS -L$x_libraries"-    # For Solaris; some versions of Sun CC require a space after -R and-    # others require no space.  Words are not sufficient . . . .-    { $as_echo "$as_me:$LINENO: checking whether -R must be followed by a space" >&5-$as_echo_n "checking whether -R must be followed by a space... " >&6; }-    ac_xsave_LIBS=$LIBS; LIBS="$LIBS -R$x_libraries"-    ac_xsave_c_werror_flag=$ac_c_werror_flag-    ac_c_werror_flag=yes-    cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  { $as_echo "$as_me:$LINENO: result: no" >&5-$as_echo "no" >&6; }-       X_LIBS="$X_LIBS -R$x_libraries"-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	LIBS="$ac_xsave_LIBS -R $x_libraries"-       cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  { $as_echo "$as_me:$LINENO: result: yes" >&5-$as_echo "yes" >&6; }-	  X_LIBS="$X_LIBS -R $x_libraries"-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	{ $as_echo "$as_me:$LINENO: result: neither works" >&5-$as_echo "neither works" >&6; }-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-    ac_c_werror_flag=$ac_xsave_c_werror_flag-    LIBS=$ac_xsave_LIBS-  fi--  # Check for system-dependent libraries X programs must link with.-  # Do this before checking for the system-independent R6 libraries-  # (-lICE), since we may need -lsocket or whatever for X linking.--  if test "$ISC" = yes; then-    X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl_s -linet"-  else-    # Martyn Johnson says this is needed for Ultrix, if the X-    # libraries were built with DECnet support.  And Karl Berry says-    # the Alpha needs dnet_stub (dnet does not exist).-    ac_xsave_LIBS="$LIBS"; LIBS="$LIBS $X_LIBS -lX11"-    cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char XOpenDisplay ();-int-main ()-{-return XOpenDisplay ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  :-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	{ $as_echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet" >&5-$as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; }-if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-ldnet  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char dnet_ntoa ();-int-main ()-{-return dnet_ntoa ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_dnet_dnet_ntoa=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_dnet_dnet_ntoa=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_dnet_ntoa" >&5-$as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; }-if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet"-fi--    if test $ac_cv_lib_dnet_dnet_ntoa = no; then-      { $as_echo "$as_me:$LINENO: checking for dnet_ntoa in -ldnet_stub" >&5-$as_echo_n "checking for dnet_ntoa in -ldnet_stub... " >&6; }-if test "${ac_cv_lib_dnet_stub_dnet_ntoa+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-ldnet_stub  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char dnet_ntoa ();-int-main ()-{-return dnet_ntoa ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_dnet_stub_dnet_ntoa=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_dnet_stub_dnet_ntoa=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_dnet_stub_dnet_ntoa" >&5-$as_echo "$ac_cv_lib_dnet_stub_dnet_ntoa" >&6; }-if test "x$ac_cv_lib_dnet_stub_dnet_ntoa" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -ldnet_stub"-fi--    fi-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-    LIBS="$ac_xsave_LIBS"--    # msh@cis.ufl.edu says -lnsl (and -lsocket) are needed for his 386/AT,-    # to get the SysV transport functions.-    # Chad R. Larson says the Pyramis MIS-ES running DC/OSx (SVR4)-    # needs -lnsl.-    # The nsl library prevents programs from opening the X display-    # on Irix 5.2, according to T.E. Dickey.-    # The functions gethostbyname, getservbyname, and inet_addr are-    # in -lbsd on LynxOS 3.0.1/i386, according to Lars Hecking.-    { $as_echo "$as_me:$LINENO: checking for gethostbyname" >&5-$as_echo_n "checking for gethostbyname... " >&6; }-if test "${ac_cv_func_gethostbyname+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-/* Define gethostbyname to an innocuous variant, in case <limits.h> declares gethostbyname.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define gethostbyname innocuous_gethostbyname--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char gethostbyname (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef gethostbyname--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char gethostbyname ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_gethostbyname || defined __stub___gethostbyname-choke me-#endif--int-main ()-{-return gethostbyname ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_func_gethostbyname=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_func_gethostbyname=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5-$as_echo "$ac_cv_func_gethostbyname" >&6; }--    if test $ac_cv_func_gethostbyname = no; then-      { $as_echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5-$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }-if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lnsl  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char gethostbyname ();-int-main ()-{-return gethostbyname ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_nsl_gethostbyname=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_nsl_gethostbyname=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5-$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }-if test "x$ac_cv_lib_nsl_gethostbyname" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lnsl"-fi--      if test $ac_cv_lib_nsl_gethostbyname = no; then-	{ $as_echo "$as_me:$LINENO: checking for gethostbyname in -lbsd" >&5-$as_echo_n "checking for gethostbyname in -lbsd... " >&6; }-if test "${ac_cv_lib_bsd_gethostbyname+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lbsd  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char gethostbyname ();-int-main ()-{-return gethostbyname ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_bsd_gethostbyname=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_bsd_gethostbyname=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_bsd_gethostbyname" >&5-$as_echo "$ac_cv_lib_bsd_gethostbyname" >&6; }-if test "x$ac_cv_lib_bsd_gethostbyname" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lbsd"-fi--      fi-    fi--    # lieder@skyler.mavd.honeywell.com says without -lsocket,-    # socket/setsockopt and other routines are undefined under SCO ODT-    # 2.0.  But -lsocket is broken on IRIX 5.2 (and is not necessary-    # on later versions), says Simon Leinen: it contains gethostby*-    # variants that don't use the name server (or something).  -lsocket-    # must be given before -lnsl if both are needed.  We assume that-    # if connect needs -lnsl, so does gethostbyname.-    { $as_echo "$as_me:$LINENO: checking for connect" >&5-$as_echo_n "checking for connect... " >&6; }-if test "${ac_cv_func_connect+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-/* Define connect to an innocuous variant, in case <limits.h> declares connect.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define connect innocuous_connect--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char connect (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef connect--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char connect ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_connect || defined __stub___connect-choke me-#endif--int-main ()-{-return connect ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_func_connect=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_func_connect=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5-$as_echo "$ac_cv_func_connect" >&6; }--    if test $ac_cv_func_connect = no; then-      { $as_echo "$as_me:$LINENO: checking for connect in -lsocket" >&5-$as_echo_n "checking for connect in -lsocket... " >&6; }-if test "${ac_cv_lib_socket_connect+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lsocket $X_EXTRA_LIBS $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char connect ();-int-main ()-{-return connect ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_socket_connect=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_socket_connect=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_socket_connect" >&5-$as_echo "$ac_cv_lib_socket_connect" >&6; }-if test "x$ac_cv_lib_socket_connect" = x""yes; then-  X_EXTRA_LIBS="-lsocket $X_EXTRA_LIBS"-fi--    fi--    # Guillermo Gomez says -lposix is necessary on A/UX.-    { $as_echo "$as_me:$LINENO: checking for remove" >&5-$as_echo_n "checking for remove... " >&6; }-if test "${ac_cv_func_remove+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-/* Define remove to an innocuous variant, in case <limits.h> declares remove.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define remove innocuous_remove--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char remove (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef remove--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char remove ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_remove || defined __stub___remove-choke me-#endif--int-main ()-{-return remove ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_func_remove=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_func_remove=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_remove" >&5-$as_echo "$ac_cv_func_remove" >&6; }--    if test $ac_cv_func_remove = no; then-      { $as_echo "$as_me:$LINENO: checking for remove in -lposix" >&5-$as_echo_n "checking for remove in -lposix... " >&6; }-if test "${ac_cv_lib_posix_remove+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lposix  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char remove ();-int-main ()-{-return remove ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_posix_remove=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_posix_remove=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_posix_remove" >&5-$as_echo "$ac_cv_lib_posix_remove" >&6; }-if test "x$ac_cv_lib_posix_remove" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lposix"-fi--    fi--    # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay.-    { $as_echo "$as_me:$LINENO: checking for shmat" >&5-$as_echo_n "checking for shmat... " >&6; }-if test "${ac_cv_func_shmat+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-/* Define shmat to an innocuous variant, in case <limits.h> declares shmat.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define shmat innocuous_shmat--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char shmat (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef shmat--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char shmat ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_shmat || defined __stub___shmat-choke me-#endif--int-main ()-{-return shmat ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_func_shmat=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_func_shmat=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_shmat" >&5-$as_echo "$ac_cv_func_shmat" >&6; }--    if test $ac_cv_func_shmat = no; then-      { $as_echo "$as_me:$LINENO: checking for shmat in -lipc" >&5-$as_echo_n "checking for shmat in -lipc... " >&6; }-if test "${ac_cv_lib_ipc_shmat+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lipc  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char shmat ();-int-main ()-{-return shmat ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_ipc_shmat=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_ipc_shmat=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_ipc_shmat" >&5-$as_echo "$ac_cv_lib_ipc_shmat" >&6; }-if test "x$ac_cv_lib_ipc_shmat" = x""yes; then-  X_EXTRA_LIBS="$X_EXTRA_LIBS -lipc"-fi--    fi-  fi--  # Check for libraries that X11R6 Xt/Xaw programs need.-  ac_save_LDFLAGS=$LDFLAGS-  test -n "$x_libraries" && LDFLAGS="$LDFLAGS -L$x_libraries"-  # SM needs ICE to (dynamically) link under SunOS 4.x (so we have to-  # check for ICE first), but we must link in the order -lSM -lICE or-  # we get undefined symbols.  So assume we have SM if we have ICE.-  # These have to be linked with before -lX11, unlike the other-  # libraries we check for below, so use a different variable.-  # John Interrante, Karl Berry-  { $as_echo "$as_me:$LINENO: checking for IceConnectionNumber in -lICE" >&5-$as_echo_n "checking for IceConnectionNumber in -lICE... " >&6; }-if test "${ac_cv_lib_ICE_IceConnectionNumber+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lICE $X_EXTRA_LIBS $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char IceConnectionNumber ();-int-main ()-{-return IceConnectionNumber ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_ICE_IceConnectionNumber=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_ICE_IceConnectionNumber=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_ICE_IceConnectionNumber" >&5-$as_echo "$ac_cv_lib_ICE_IceConnectionNumber" >&6; }-if test "x$ac_cv_lib_ICE_IceConnectionNumber" = x""yes; then-  X_PRE_LIBS="$X_PRE_LIBS -lSM -lICE"-fi--  LDFLAGS=$ac_save_LDFLAGS--fi--fi--ac_aux_dir=-for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do-  if test -f "$ac_dir/install-sh"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/install-sh -c"-    break-  elif test -f "$ac_dir/install.sh"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/install.sh -c"-    break-  elif test -f "$ac_dir/shtool"; then-    ac_aux_dir=$ac_dir-    ac_install_sh="$ac_aux_dir/shtool install -c"-    break-  fi-done-if test -z "$ac_aux_dir"; then-  { { $as_echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&5-$as_echo "$as_me: error: cannot find install-sh or install.sh in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" >&2;}-   { (exit 1); exit 1; }; }-fi--# These three variables are undocumented and unsupported,-# and are intended to be withdrawn in a future Autoconf release.-# They can cause serious problems if a builder's source tree is in a directory-# whose full name contains unusual characters.-ac_config_guess="$SHELL $ac_aux_dir/config.guess"  # Please don't use this var.-ac_config_sub="$SHELL $ac_aux_dir/config.sub"  # Please don't use this var.-ac_configure="$SHELL $ac_aux_dir/configure"  # Please don't use this var.---# Make sure we can run config.sub.-$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||-  { { $as_echo "$as_me:$LINENO: error: cannot run $SHELL $ac_aux_dir/config.sub" >&5-$as_echo "$as_me: error: cannot run $SHELL $ac_aux_dir/config.sub" >&2;}-   { (exit 1); exit 1; }; }--{ $as_echo "$as_me:$LINENO: checking build system type" >&5-$as_echo_n "checking build system type... " >&6; }-if test "${ac_cv_build+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_build_alias=$build_alias-test "x$ac_build_alias" = x &&-  ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`-test "x$ac_build_alias" = x &&-  { { $as_echo "$as_me:$LINENO: error: cannot guess build type; you must specify one" >&5-$as_echo "$as_me: error: cannot guess build type; you must specify one" >&2;}-   { (exit 1); exit 1; }; }-ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||-  { { $as_echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&5-$as_echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $ac_build_alias failed" >&2;}-   { (exit 1); exit 1; }; }--fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_build" >&5-$as_echo "$ac_cv_build" >&6; }-case $ac_cv_build in-*-*-*) ;;-*) { { $as_echo "$as_me:$LINENO: error: invalid value of canonical build" >&5-$as_echo "$as_me: error: invalid value of canonical build" >&2;}-   { (exit 1); exit 1; }; };;-esac-build=$ac_cv_build-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_build-shift-build_cpu=$1-build_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-build_os=$*-IFS=$ac_save_IFS-case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac---{ $as_echo "$as_me:$LINENO: checking host system type" >&5-$as_echo_n "checking host system type... " >&6; }-if test "${ac_cv_host+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test "x$host_alias" = x; then-  ac_cv_host=$ac_cv_build-else-  ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||-    { { $as_echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&5-$as_echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $host_alias failed" >&2;}-   { (exit 1); exit 1; }; }-fi--fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_host" >&5-$as_echo "$ac_cv_host" >&6; }-case $ac_cv_host in-*-*-*) ;;-*) { { $as_echo "$as_me:$LINENO: error: invalid value of canonical host" >&5-$as_echo "$as_me: error: invalid value of canonical host" >&2;}-   { (exit 1); exit 1; }; };;-esac-host=$ac_cv_host-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_host-shift-host_cpu=$1-host_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-host_os=$*-IFS=$ac_save_IFS-case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac---{ $as_echo "$as_me:$LINENO: checking target system type" >&5-$as_echo_n "checking target system type... " >&6; }-if test "${ac_cv_target+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test "x$target_alias" = x; then-  ac_cv_target=$ac_cv_host-else-  ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` ||-    { { $as_echo "$as_me:$LINENO: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&5-$as_echo "$as_me: error: $SHELL $ac_aux_dir/config.sub $target_alias failed" >&2;}-   { (exit 1); exit 1; }; }-fi--fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_target" >&5-$as_echo "$ac_cv_target" >&6; }-case $ac_cv_target in-*-*-*) ;;-*) { { $as_echo "$as_me:$LINENO: error: invalid value of canonical target" >&5-$as_echo "$as_me: error: invalid value of canonical target" >&2;}-   { (exit 1); exit 1; }; };;-esac-target=$ac_cv_target-ac_save_IFS=$IFS; IFS='-'-set x $ac_cv_target-shift-target_cpu=$1-target_vendor=$2-shift; shift-# Remember, the first character of IFS is used to create $*,-# except with old shells:-target_os=$*-IFS=$ac_save_IFS-case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac---# The aliases save the names the user supplied, while $host etc.-# will get canonicalized.-test -n "$target_alias" &&-  test "$program_prefix$program_suffix$program_transform_name" = \-    NONENONEs,x,x, &&-  program_prefix=${target_alias}-----use_quartz_opengl=no-if test x"$enable_opengl" = xyes; then-  case $target_os in-  darwin*)--cat >>confdefs.h <<\_ACEOF-#define USE_QUARTZ_OPENGL 1-_ACEOF--    use_quartz_opengl=yes-    ;;-  esac-fi--GLU_FRAMEWORKS=-GLUT_FRAMEWORKS=-GLUT_EXTRA_LIBS=-if test x"$use_quartz_opengl" = xyes; then-  GLU_FRAMEWORKS=OpenGL-  GLUT_FRAMEWORKS=GLUT-  GLUT_EXTRA_LIBS=objc-fi---------if test x"$use_quartz_opengl" = xno; then-  { $as_echo "$as_me:$LINENO: checking for atan" >&5-$as_echo_n "checking for atan... " >&6; }-if test "${ac_cv_func_atan+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-/* Define atan to an innocuous variant, in case <limits.h> declares atan.-   For example, HP-UX 11i <limits.h> declares gettimeofday.  */-#define atan innocuous_atan--/* System header to define __stub macros and hopefully few prototypes,-    which can conflict with char atan (); below.-    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since-    <limits.h> exists even on freestanding compilers.  */--#ifdef __STDC__-# include <limits.h>-#else-# include <assert.h>-#endif--#undef atan--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char atan ();-/* The GNU C library defines this for functions which it implements-    to always fail with ENOSYS.  Some functions are actually named-    something starting with __ and the normal name is an alias.  */-#if defined __stub_atan || defined __stub___atan-choke me-#endif--int-main ()-{-return atan ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_func_atan=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_func_atan=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_func_atan" >&5-$as_echo "$ac_cv_func_atan" >&6; }-if test "x$ac_cv_func_atan" = x""yes; then-  fp_libm_not_needed=yes-else-  fp_libm_not_needed=dunno-fi--  if test x"$fp_libm_not_needed" = xdunno; then-     { $as_echo "$as_me:$LINENO: checking for atan in -lm" >&5-$as_echo_n "checking for atan in -lm... " >&6; }-if test "${ac_cv_lib_m_atan+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  ac_check_lib_save_LIBS=$LIBS-LIBS="-lm  $LIBS"-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--/* Override any GCC internal prototype to avoid an error.-   Use char because int might match the return type of a GCC-   builtin and then its argument prototype would still apply.  */-#ifdef __cplusplus-extern "C"-#endif-char atan ();-int-main ()-{-return atan ();-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  ac_cv_lib_m_atan=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_lib_m_atan=no-fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-LIBS=$ac_check_lib_save_LIBS-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_lib_m_atan" >&5-$as_echo "$ac_cv_lib_m_atan" >&6; }-if test "x$ac_cv_lib_m_atan" = x""yes; then-  GL_LIBS="-lm $GL_LIBS"-fi--  fi--  if test x"$no_x" != xyes; then-    test -n "$x_includes" && GL_CFLAGS="-I$x_includes $GL_CFLAGS"-    test -n "$x_libraries" && GL_LIBS="-L$x_libraries -lX11 $GL_LIBS"-  fi--  { $as_echo "$as_me:$LINENO: checking for GL library" >&5-$as_echo_n "checking for GL library... " >&6; }-if test "${fp_cv_check_GL_lib+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  fp_cv_check_GL_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${GL_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in -lGL -lopengl32; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${GL_LIBS} $fp_save_LIBS"-    cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <GL/gl.h>-int-main ()-{-glEnd()-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  fp_cv_check_GL_lib="$fp_try_lib ${GL_LIBS}"; break-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"-fi-{ $as_echo "$as_me:$LINENO: result: $fp_cv_check_GL_lib" >&5-$as_echo "$fp_cv_check_GL_lib" >&6; }--  if test x"$fp_cv_check_GL_lib" = xno; then-    no_GL=yes-    GL_CFLAGS=-    GL_LIBS=-  else-    GL_CFLAGS0="${GL_CFLAGS}"-    GL_CFLAGS="$CPPFLAGS ${GL_CFLAGS0}"-    GL_LIBS0="$fp_cv_check_GL_lib"-    GL_LIBS="$LDFLAGS ${GL_LIBS0}"-  fi---  if test x"$fp_is_win32" = xyes; then-    # Ugly: To get wglGetProcAddress on Windows, we have to link with-    # opengl32.dll, too, even when we are using Cygwin with X11.-    case "$GL_LIBS" in-      *-lopengl32*|*opengl32.lib*) ;;-      *) fp_save_LIBS="$LIBS"-         LIBS="$LIBS -lopengl32"-         cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <GL/gl.h>-int-main ()-{-glEnd()-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  GL_LIBS="$GL_LIBS -lopengl32"; GL_LIBS0="$GL_LIBS0 -lopengl32"-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-         LIBS="$fp_save_LIBS"-         ;;-    esac-  fi-fi----GLU_CFLAGS="$GL_CFLAGS0"-GLU_LIBS="$GL_LIBS0"--if test x"$use_quartz_opengl" = xno; then-  { $as_echo "$as_me:$LINENO: checking for GLU library" >&5-$as_echo_n "checking for GLU library... " >&6; }-if test "${fp_cv_check_GLU_lib+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  fp_cv_check_GLU_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${GLU_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in -lglu32 -lGLU; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${GLU_LIBS} $fp_save_LIBS"-    cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <GL/glu.h>-int-main ()-{-gluNewQuadric()-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  fp_cv_check_GLU_lib="$fp_try_lib ${GLU_LIBS}"; break-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"-fi-{ $as_echo "$as_me:$LINENO: result: $fp_cv_check_GLU_lib" >&5-$as_echo "$fp_cv_check_GLU_lib" >&6; }--  if test x"$fp_cv_check_GLU_lib" = xno; then-    no_GLU=yes-    GLU_CFLAGS=-    GLU_LIBS=-  else-    GLU_CFLAGS0="${GLU_CFLAGS}"-    GLU_CFLAGS="$CPPFLAGS ${GLU_CFLAGS0}"-    GLU_LIBS0="$fp_cv_check_GLU_lib"-    GLU_LIBS="$LDFLAGS ${GLU_LIBS0}"-  fi--fi-----{ $as_echo "$as_me:$LINENO: checking for grep that handles long lines and -e" >&5-$as_echo_n "checking for grep that handles long lines and -e... " >&6; }-if test "${ac_cv_path_GREP+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if test -z "$GREP"; then-  ac_path_GREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_prog in grep ggrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue-# Check for GNU ac_path_GREP and select it if it is found.-  # Check for GNU $ac_path_GREP-case `"$ac_path_GREP" --version 2>&1` in-*GNU*)-  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'GREP' >> "conftest.nl"-    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    ac_count=`expr $ac_count + 1`-    if test $ac_count -gt ${ac_path_GREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_GREP="$ac_path_GREP"-      ac_path_GREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_GREP_found && break 3-    done-  done-done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_GREP"; then-    { { $as_echo "$as_me:$LINENO: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5-$as_echo "$as_me: error: no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}-   { (exit 1); exit 1; }; }-  fi-else-  ac_cv_path_GREP=$GREP-fi--fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_GREP" >&5-$as_echo "$ac_cv_path_GREP" >&6; }- GREP="$ac_cv_path_GREP"---{ $as_echo "$as_me:$LINENO: checking for egrep" >&5-$as_echo_n "checking for egrep... " >&6; }-if test "${ac_cv_path_EGREP+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1-   then ac_cv_path_EGREP="$GREP -E"-   else-     if test -z "$EGREP"; then-  ac_path_EGREP_found=false-  # Loop through the user's path and test for each of PROGNAME-LIST-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  for ac_prog in egrep; do-    for ac_exec_ext in '' $ac_executable_extensions; do-      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"-      { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue-# Check for GNU ac_path_EGREP and select it if it is found.-  # Check for GNU $ac_path_EGREP-case `"$ac_path_EGREP" --version 2>&1` in-*GNU*)-  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;-*)-  ac_count=0-  $as_echo_n 0123456789 >"conftest.in"-  while :-  do-    cat "conftest.in" "conftest.in" >"conftest.tmp"-    mv "conftest.tmp" "conftest.in"-    cp "conftest.in" "conftest.nl"-    $as_echo 'EGREP' >> "conftest.nl"-    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break-    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break-    ac_count=`expr $ac_count + 1`-    if test $ac_count -gt ${ac_path_EGREP_max-0}; then-      # Best one so far, save it but keep looking for a better one-      ac_cv_path_EGREP="$ac_path_EGREP"-      ac_path_EGREP_max=$ac_count-    fi-    # 10*(2^10) chars as input seems more than enough-    test $ac_count -gt 10 && break-  done-  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;-esac--      $ac_path_EGREP_found && break 3-    done-  done-done-IFS=$as_save_IFS-  if test -z "$ac_cv_path_EGREP"; then-    { { $as_echo "$as_me:$LINENO: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&5-$as_echo "$as_me: error: no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" >&2;}-   { (exit 1); exit 1; }; }-  fi-else-  ac_cv_path_EGREP=$EGREP-fi--   fi-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_path_EGREP" >&5-$as_echo "$ac_cv_path_EGREP" >&6; }- EGREP="$ac_cv_path_EGREP"---{ $as_echo "$as_me:$LINENO: checking for ANSI C header files" >&5-$as_echo_n "checking for ANSI C header files... " >&6; }-if test "${ac_cv_header_stdc+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <stdlib.h>-#include <stdarg.h>-#include <string.h>-#include <float.h>--int-main ()-{--  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_cv_header_stdc=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_cv_header_stdc=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext--if test $ac_cv_header_stdc = yes; then-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <string.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "memchr" >/dev/null 2>&1; then-  :-else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <stdlib.h>--_ACEOF-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |-  $EGREP "free" >/dev/null 2>&1; then-  :-else-  ac_cv_header_stdc=no-fi-rm -f conftest*--fi--if test $ac_cv_header_stdc = yes; then-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.-  if test "$cross_compiling" = yes; then-  :-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <ctype.h>-#include <stdlib.h>-#if ((' ' & 0x0FF) == 0x020)-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))-#else-# define ISLOWER(c) \-		   (('a' <= (c) && (c) <= 'i') \-		     || ('j' <= (c) && (c) <= 'r') \-		     || ('s' <= (c) && (c) <= 'z'))-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))-#endif--#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))-int-main ()-{-  int i;-  for (i = 0; i < 256; i++)-    if (XOR (islower (i), ISLOWER (i))-	|| toupper (i) != TOUPPER (i))-      return 2;-  return 0;-}-_ACEOF-rm -f conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && { ac_try='./conftest$ac_exeext'-  { (case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_try") 2>&5-  ac_status=$?-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); }; }; then-  :-else-  $as_echo "$as_me: program exited with status $ac_status" >&5-$as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--( exit $ac_status )-ac_cv_header_stdc=no-fi-rm -rf conftest.dSYM-rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext-fi---fi-fi-{ $as_echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5-$as_echo "$ac_cv_header_stdc" >&6; }-if test $ac_cv_header_stdc = yes; then--cat >>confdefs.h <<\_ACEOF-#define STDC_HEADERS 1-_ACEOF--fi--# On IRIX 5.3, sys/types and inttypes.h are conflicting.----------for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \-		  inttypes.h stdint.h unistd.h-do-as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-else-  cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-$ac_includes_default--#include <$ac_header>-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  eval "$as_ac_Header=yes"-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	eval "$as_ac_Header=no"-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-as_val=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-   if test "x$as_val" = x""yes; then-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done------if test x"$use_quartz_opengl" = xno; then-  GLUT_CFLAGS="$GLU_CFLAGS0"-  GLUT_LIBS="$GLU_LIBS0"--  if test x"$no_x" != xyes; then-    GLUT_LIBS="$X_PRE_LIBS -lXmu -lXi $X_EXTRA_LIBS $GLUT_LIBS"-  fi---for ac_header in windows.h-do-as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-else-  # Is the header compilable?-{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5-$as_echo_n "checking $ac_header usability... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-$ac_includes_default-#include <$ac_header>-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_header_compiler=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_header_compiler=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5-$as_echo "$ac_header_compiler" >&6; }--# Is the header present?-{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5-$as_echo_n "checking $ac_header presence... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <$ac_header>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  ac_header_preproc=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  ac_header_preproc=no-fi--rm -f conftest.err conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5-$as_echo "$ac_header_preproc" >&6; }--# So?  What about this header?-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in-  yes:no: )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5-$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}-    ac_header_preproc=yes-    ;;-  no:yes:* )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5-$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5-$as_echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5-$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5-$as_echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5-$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}-    ( cat <<\_ASBOX-## ----------------------------------- ##-## Report this to sven.panne@aedion.de ##-## ----------------------------------- ##-_ASBOX-     ) | sed "s/^/$as_me: WARNING:     /" >&2-    ;;-esac-{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-else-  eval "$as_ac_Header=\$ac_header_preproc"-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }--fi-as_val=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-   if test "x$as_val" = x""yes; then-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done---  fp_save_cppflags="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS $X_CFLAGS"--for ac_header in GL/glut.h-do-as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-else-  # Is the header compilable?-{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5-$as_echo_n "checking $ac_header usability... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-$ac_includes_default-#include <$ac_header>-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_header_compiler=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_header_compiler=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5-$as_echo "$ac_header_compiler" >&6; }--# Is the header present?-{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5-$as_echo_n "checking $ac_header presence... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <$ac_header>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  ac_header_preproc=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  ac_header_preproc=no-fi--rm -f conftest.err conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5-$as_echo "$ac_header_preproc" >&6; }--# So?  What about this header?-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in-  yes:no: )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5-$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}-    ac_header_preproc=yes-    ;;-  no:yes:* )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5-$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5-$as_echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5-$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5-$as_echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5-$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}-    ( cat <<\_ASBOX-## ----------------------------------- ##-## Report this to sven.panne@aedion.de ##-## ----------------------------------- ##-_ASBOX-     ) | sed "s/^/$as_me: WARNING:     /" >&2-    ;;-esac-{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-else-  eval "$as_ac_Header=\$ac_header_preproc"-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }--fi-as_val=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-   if test "x$as_val" = x""yes; then-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done--  CPPFLAGS="$fp_save_cppflags"--  # Note 1: On Cygwin with X11, GL/GLU functions use the "normal" calling-  # convention, but GLUT functions use stdcall. To get this right, it is-  # necessary to include <windows.h> first.-  # Note 2: MinGW/MSYS comes without a GLUT header, so we use Cygwin's one in-  # that case.-  { $as_echo "$as_me:$LINENO: checking for GLUT library" >&5-$as_echo_n "checking for GLUT library... " >&6; }-if test "${fp_cv_check_GLUT_lib+set}" = set; then-  $as_echo_n "(cached) " >&6-else-  fp_cv_check_GLUT_lib="no"-  fp_save_CPPFLAGS="$CPPFLAGS"-  CPPFLAGS="$CPPFLAGS ${GLUT_CFLAGS}"-  fp_save_LIBS="$LIBS"-  for fp_try_lib in -lglut32 -lglut; do-    # transform "-lfoo" to "foo.lib" when using cl-    if test x"$CC" = xcl; then-      fp_try_lib=`echo $fp_try_lib | sed -e 's/^-l//' -e 's/$/.lib/'`-    fi-    LIBS="$fp_try_lib ${GLUT_LIBS} $fp_save_LIBS"-    cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */--#if HAVE_WINDOWS_H-#include <windows.h>-#endif-#if HAVE_GL_GLUT_H-#include <GL/glut.h>-#else-#include "glut_local.h"-#endif--int-main ()-{-glutMainLoop()-  ;-  return 0;-}-_ACEOF-rm -f conftest.$ac_objext conftest$ac_exeext-if { (ac_try="$ac_link"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_link") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest$ac_exeext && {-	 test "$cross_compiling" = yes ||-	 $as_test_x conftest$ac_exeext-       }; then-  fp_cv_check_GLUT_lib="$fp_try_lib ${GLUT_LIBS}"; break-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5---fi--rm -rf conftest.dSYM-rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \-      conftest$ac_exeext conftest.$ac_ext-  done-  LIBS="$fp_save_LIBS"-  CPPFLAGS="$fp_save_CPPFLAGS"-fi-{ $as_echo "$as_me:$LINENO: result: $fp_cv_check_GLUT_lib" >&5-$as_echo "$fp_cv_check_GLUT_lib" >&6; }--  if test x"$fp_cv_check_GLUT_lib" = xno; then-    no_GLUT=yes-    GLUT_CFLAGS=-    GLUT_LIBS=-  else-    GLUT_CFLAGS0="${GLUT_CFLAGS}"-    GLUT_CFLAGS="$CPPFLAGS ${GLUT_CFLAGS0}"-    GLUT_LIBS0="$fp_cv_check_GLUT_lib"-    GLUT_LIBS="$LDFLAGS ${GLUT_LIBS0}"-  fi--fi------if test "$GLUT_LIBS" = no; then-  { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: no GLUT library found, so this package cannot be built-See \`config.log' for more details." >&5-$as_echo "$as_me: error: no GLUT library found, so this package cannot be built-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-fi--# check for GLUT include files-glut_found_header=no-fp_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"---for ac_header in GL/glut.h GLUT/glut.h-do-as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-else-  # Is the header compilable?-{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5-$as_echo_n "checking $ac_header usability... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-$ac_includes_default-#include <$ac_header>-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_header_compiler=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_header_compiler=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5-$as_echo "$ac_header_compiler" >&6; }--# Is the header present?-{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5-$as_echo_n "checking $ac_header presence... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <$ac_header>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  ac_header_preproc=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  ac_header_preproc=no-fi--rm -f conftest.err conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5-$as_echo "$ac_header_preproc" >&6; }--# So?  What about this header?-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in-  yes:no: )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5-$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}-    ac_header_preproc=yes-    ;;-  no:yes:* )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5-$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5-$as_echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5-$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5-$as_echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5-$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}-    ( cat <<\_ASBOX-## ----------------------------------- ##-## Report this to sven.panne@aedion.de ##-## ----------------------------------- ##-_ASBOX-     ) | sed "s/^/$as_me: WARNING:     /" >&2-    ;;-esac-{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-else-  eval "$as_ac_Header=\$ac_header_preproc"-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }--fi-as_val=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-   if test "x$as_val" = x""yes; then-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF- glut_found_header=yes-fi--done--CPPFLAGS="$fp_save_cppflags"--if test "$glut_found_header" = no; then-  { { $as_echo "$as_me:$LINENO: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-{ { $as_echo "$as_me:$LINENO: error: no GLUT header found, so this package cannot be built-See \`config.log' for more details." >&5-$as_echo "$as_me: error: no GLUT header found, so this package cannot be built-See \`config.log' for more details." >&2;}-   { (exit 1); exit 1; }; }; }-fi--GLUT_BUILD_PACKAGE=yes---for ac_header in windows.h-do-as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  { $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }-else-  # Is the header compilable?-{ $as_echo "$as_me:$LINENO: checking $ac_header usability" >&5-$as_echo_n "checking $ac_header usability... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-$ac_includes_default-#include <$ac_header>-_ACEOF-rm -f conftest.$ac_objext-if { (ac_try="$ac_compile"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_compile") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } && {-	 test -z "$ac_c_werror_flag" ||-	 test ! -s conftest.err-       } && test -s conftest.$ac_objext; then-  ac_header_compiler=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--	ac_header_compiler=no-fi--rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_compiler" >&5-$as_echo "$ac_header_compiler" >&6; }--# Is the header present?-{ $as_echo "$as_me:$LINENO: checking $ac_header presence" >&5-$as_echo_n "checking $ac_header presence... " >&6; }-cat >conftest.$ac_ext <<_ACEOF-/* confdefs.h.  */-_ACEOF-cat confdefs.h >>conftest.$ac_ext-cat >>conftest.$ac_ext <<_ACEOF-/* end confdefs.h.  */-#include <$ac_header>-_ACEOF-if { (ac_try="$ac_cpp conftest.$ac_ext"-case "(($ac_try" in-  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;-  *) ac_try_echo=$ac_try;;-esac-eval ac_try_echo="\"\$as_me:$LINENO: $ac_try_echo\""-$as_echo "$ac_try_echo") >&5-  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1-  ac_status=$?-  grep -v '^ *+' conftest.er1 >conftest.err-  rm -f conftest.er1-  cat conftest.err >&5-  $as_echo "$as_me:$LINENO: \$? = $ac_status" >&5-  (exit $ac_status); } >/dev/null && {-	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||-	 test ! -s conftest.err-       }; then-  ac_header_preproc=yes-else-  $as_echo "$as_me: failed program was:" >&5-sed 's/^/| /' conftest.$ac_ext >&5--  ac_header_preproc=no-fi--rm -f conftest.err conftest.$ac_ext-{ $as_echo "$as_me:$LINENO: result: $ac_header_preproc" >&5-$as_echo "$ac_header_preproc" >&6; }--# So?  What about this header?-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in-  yes:no: )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5-$as_echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}-    ac_header_preproc=yes-    ;;-  no:yes:* )-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5-$as_echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     check for missing prerequisite headers?" >&5-$as_echo "$as_me: WARNING: $ac_header:     check for missing prerequisite headers?" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5-$as_echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&5-$as_echo "$as_me: WARNING: $ac_header:     section \"Present But Cannot Be Compiled\"" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5-$as_echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}-    { $as_echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5-$as_echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}-    ( cat <<\_ASBOX-## ----------------------------------- ##-## Report this to sven.panne@aedion.de ##-## ----------------------------------- ##-_ASBOX-     ) | sed "s/^/$as_me: WARNING:     /" >&2-    ;;-esac-{ $as_echo "$as_me:$LINENO: checking for $ac_header" >&5-$as_echo_n "checking for $ac_header... " >&6; }-if { as_var=$as_ac_Header; eval "test \"\${$as_var+set}\" = set"; }; then-  $as_echo_n "(cached) " >&6-else-  eval "$as_ac_Header=\$ac_header_preproc"-fi-ac_res=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-	       { $as_echo "$as_me:$LINENO: result: $ac_res" >&5-$as_echo "$ac_res" >&6; }--fi-as_val=`eval 'as_val=${'$as_ac_Header'}-		 $as_echo "$as_val"'`-   if test "x$as_val" = x""yes; then-  cat >>confdefs.h <<_ACEOF-#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1-_ACEOF--fi--done----cat >>confdefs.h <<_ACEOF-#define GLUT_EXTRA_LIBS `echo HSGLUT_cbits $GLUT_EXTRA_LIBS | sed -e 's/[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF----cat >>confdefs.h <<_ACEOF-#define GLUT_CFLAGS `echo '' $GLUT_CFLAGS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF----cat >>confdefs.h <<_ACEOF-#define GLUT_LIBS `echo '' $GLUT_LIBS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF----cat >>confdefs.h <<_ACEOF-#define GLUT_FRAMEWORKS `echo '' $GLUT_FRAMEWORKS | sed -e 's/-[^ ]*/,"&"/g' -e 's/^ *,//'`-_ACEOF---fi--if test "$GLUT_BUILD_PACKAGE" = yes; then-  BUILD_PACKAGE_BOOL=True-else-  BUILD_PACKAGE_BOOL=False-fi---case "$host" in-*-mingw32) CALLCONV=stdcall ;;-*)	CALLCONV=ccall ;;-esac---ac_config_files="$ac_config_files GLUT.buildinfo"--cat >confcache <<\_ACEOF-# This file is a shell script that caches the results of configure-# tests run on this system so they can be shared between configure-# scripts and configure runs, see configure's option --config-cache.-# It is not useful on other systems.  If it contains results you don't-# want to keep, you may remove or edit it.-#-# config.status only pays attention to the cache file if you give it-# the --recheck option to rerun configure.-#-# `ac_cv_env_foo' variables (set or unset) will be overridden when-# loading this file, other *unset* `ac_cv_foo' will be assigned the-# following values.--_ACEOF--# The following way of writing the cache mishandles newlines in values,-# but we know of no workaround that is simple, portable, and efficient.-# So, we kill variables containing newlines.-# Ultrix sh set writes to stderr and can't be redirected directly,-# and sets the high bit in the cache file unless we assign to the vars.-(-  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do-    eval ac_val=\$$ac_var-    case $ac_val in #(-    *${as_nl}*)-      case $ac_var in #(-      *_cv_*) { $as_echo "$as_me:$LINENO: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;-      esac-      case $ac_var in #(-      _ | IFS | as_nl) ;; #(-      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(-      *) $as_unset $ac_var ;;-      esac ;;-    esac-  done--  (set) 2>&1 |-    case $as_nl`(ac_space=' '; set) 2>&1` in #(-    *${as_nl}ac_space=\ *)-      # `set' does not quote correctly, so add quotes (double-quote-      # substitution turns \\\\ into \\, and sed turns \\ into \).-      sed -n \-	"s/'/'\\\\''/g;-	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"-      ;; #(-    *)-      # `set' quotes correctly as required by POSIX, so do not add quotes.-      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"-      ;;-    esac |-    sort-) |-  sed '-     /^ac_cv_env_/b end-     t clear-     :clear-     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/-     t end-     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/-     :end' >>confcache-if diff "$cache_file" confcache >/dev/null 2>&1; then :; else-  if test -w "$cache_file"; then-    test "x$cache_file" != "x/dev/null" &&-      { $as_echo "$as_me:$LINENO: updating cache $cache_file" >&5-$as_echo "$as_me: updating cache $cache_file" >&6;}-    cat confcache >$cache_file-  else-    { $as_echo "$as_me:$LINENO: not updating unwritable cache $cache_file" >&5-$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}-  fi-fi-rm -f confcache--test "x$prefix" = xNONE && prefix=$ac_default_prefix-# Let make expand exec_prefix.-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'--DEFS=-DHAVE_CONFIG_H--ac_libobjs=-ac_ltlibobjs=-for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue-  # 1. Remove the extension, and $U if already installed.-  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'-  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`-  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR-  #    will be set to the directory where LIBOBJS objects are built.-  ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"-  ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'-done-LIBOBJS=$ac_libobjs--LTLIBOBJS=$ac_ltlibobjs----: ${CONFIG_STATUS=./config.status}-ac_write_fail=0-ac_clean_files_save=$ac_clean_files-ac_clean_files="$ac_clean_files $CONFIG_STATUS"-{ $as_echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5-$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}-cat >$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-#! $SHELL-# Generated by $as_me.-# Run this file to recreate the current configuration.-# Compiler output produced by configure, useful for debugging-# configure, is in config.log if it exists.--debug=false-ac_cs_recheck=false-ac_cs_silent=false-SHELL=\${CONFIG_SHELL-$SHELL}-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-## --------------------- ##-## M4sh Initialization.  ##-## --------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then-  emulate sh-  NULLCMD=:-  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which-  # is contrary to our usage.  Disable this feature.-  alias -g '${1+"$@"}'='"$@"'-  setopt NO_GLOB_SUBST-else-  case `(set -o) 2>/dev/null` in-  *posix*) set -o posix ;;-esac--fi-----# PATH needs CR-# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits--as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-if (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then-  as_echo='printf %s\n'-  as_echo_n='printf %s'-else-  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then-    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'-    as_echo_n='/usr/ucb/echo -n'-  else-    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'-    as_echo_n_body='eval-      arg=$1;-      case $arg in-      *"$as_nl"*)-	expr "X$arg" : "X\\(.*\\)$as_nl";-	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;-      esac;-      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"-    '-    export as_echo_n_body-    as_echo_n='sh -c $as_echo_n_body as_echo'-  fi-  export as_echo_body-  as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then-  PATH_SEPARATOR=:-  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {-    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||-      PATH_SEPARATOR=';'-  }-fi--# Support unset when possible.-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then-  as_unset=unset-else-  as_unset=false-fi---# IFS-# We need space, tab and new line, in precisely that order.  Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" ""	$as_nl"--# Find who we are.  Look in the path if we contain no directory separator.-case $0 in-  *[\\/]* ) as_myself=$0 ;;-  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do-  IFS=$as_save_IFS-  test -z "$as_dir" && as_dir=.-  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break-done-IFS=$as_save_IFS--     ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then-  as_myself=$0-fi-if test ! -f "$as_myself"; then-  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2-  { (exit 1); exit 1; }-fi--# Work around bugs in pre-3.0 UWIN ksh.-for as_var in ENV MAIL MAILPATH-do ($as_unset $as_var) >/dev/null 2>&1 && $as_unset $as_var-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# Required to use basename.-if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then-  as_basename=basename-else-  as_basename=false-fi---# Name of the executable.-as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \-	 X"$0" : 'X\(//\)$' \| \-	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |-    sed '/^.*\/\([^/][^/]*\)\/*$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\/\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`--# CDPATH.-$as_unset CDPATH----  as_lineno_1=$LINENO-  as_lineno_2=$LINENO-  test "x$as_lineno_1" != "x$as_lineno_2" &&-  test "x`expr $as_lineno_1 + 1`" = "x$as_lineno_2" || {--  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO-  # uniformly replaced by the line number.  The first 'sed' inserts a-  # line-number line after each line using $LINENO; the second 'sed'-  # does the real work.  The second script uses 'N' to pair each-  # line-number line with the line containing $LINENO, and appends-  # trailing '-' during substitution so that $LINENO is not a special-  # case at line end.-  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the-  # scripts with optimization help from Paolo Bonzini.  Blame Lee-  # E. McMahon (1931-1989) for sed's syntax.  :-)-  sed -n '-    p-    /[$]LINENO/=-  ' <$as_myself |-    sed '-      s/[$]LINENO.*/&-/-      t lineno-      b-      :lineno-      N-      :loop-      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/-      t loop-      s/-\n.*//-    ' >$as_me.lineno &&-  chmod +x "$as_me.lineno" ||-    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2-   { (exit 1); exit 1; }; }--  # Don't try to exec as it changes $[0], causing all sort of problems-  # (the dirname of $[0] is not the place where we might find the-  # original and so on.  Autoconf is especially sensitive to this).-  . "./$as_me.lineno"-  # Exit status is that of the last command.-  exit-}---if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then-  as_dirname=dirname-else-  as_dirname=false-fi--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in--n*)-  case `echo 'x\c'` in-  *c*) ECHO_T='	';;	# ECHO_T is single tab character.-  *)   ECHO_C='\c';;-  esac;;-*)-  ECHO_N='-n';;-esac-if expr a : '\(a\)' >/dev/null 2>&1 &&-   test "X`expr 00001 : '.*\(...\)'`" = X001; then-  as_expr=expr-else-  as_expr=false-fi--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then-  rm -f conf$$.dir/conf$$.file-else-  rm -f conf$$.dir-  mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then-  if ln -s conf$$.file conf$$ 2>/dev/null; then-    as_ln_s='ln -s'-    # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -p'.-    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||-      as_ln_s='cp -p'-  elif ln conf$$.file conf$$ 2>/dev/null; then-    as_ln_s=ln-  else-    as_ln_s='cp -p'-  fi-else-  as_ln_s='cp -p'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null--if mkdir -p . 2>/dev/null; then-  as_mkdir_p=:-else-  test -d ./-p && rmdir ./-p-  as_mkdir_p=false-fi--if test -x / >/dev/null 2>&1; then-  as_test_x='test -x'-else-  if ls -dL / >/dev/null 2>&1; then-    as_ls_L_option=L-  else-    as_ls_L_option=-  fi-  as_test_x='-    eval sh -c '\''-      if test -d "$1"; then-	test -d "$1/.";-      else-	case $1 in-	-*)set "./$1";;-	esac;-	case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in-	???[sx]*):;;*)false;;esac;fi-    '\'' sh-  '-fi-as_executable_p=$as_test_x--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"---exec 6>&1--# Save the log message, to keep $[0] and so on meaningful, and to-# report actual input values of CONFIG_FILES etc. instead of their-# values after options handling.-ac_log="-This file was extended by Haskell GLUT package $as_me 2.1.2.1, which was-generated by GNU Autoconf 2.63.  Invocation command line was--  CONFIG_FILES    = $CONFIG_FILES-  CONFIG_HEADERS  = $CONFIG_HEADERS-  CONFIG_LINKS    = $CONFIG_LINKS-  CONFIG_COMMANDS = $CONFIG_COMMANDS-  $ $0 $@--on `(hostname || uname -n) 2>/dev/null | sed 1q`-"--_ACEOF--case $ac_config_files in *"-"*) set x $ac_config_files; shift; ac_config_files=$*;;-esac--case $ac_config_headers in *"-"*) set x $ac_config_headers; shift; ac_config_headers=$*;;-esac---cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-# Files that config.status was made for.-config_files="$ac_config_files"-config_headers="$ac_config_headers"--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-ac_cs_usage="\-\`$as_me' instantiates files from templates according to the-current configuration.--Usage: $0 [OPTION]... [FILE]...--  -h, --help       print this help, then exit-  -V, --version    print version number and configuration settings, then exit-  -q, --quiet, --silent-                   do not print progress messages-  -d, --debug      don't remove temporary files-      --recheck    update $as_me by reconfiguring in the same conditions-      --file=FILE[:TEMPLATE]-                   instantiate the configuration file FILE-      --header=FILE[:TEMPLATE]-                   instantiate the configuration header FILE--Configuration files:-$config_files--Configuration headers:-$config_headers--Report bugs to <bug-autoconf@gnu.org>."--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_cs_version="\\-Haskell GLUT package config.status 2.1.2.1-configured by $0, generated by GNU Autoconf 2.63,-  with options \\"`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"--Copyright (C) 2008 Free Software Foundation, Inc.-This config.status script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it."--ac_pwd='$ac_pwd'-srcdir='$srcdir'-test -n "\$AWK" || AWK=awk-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# The default lists apply if the user does not specify any file.-ac_need_defaults=:-while test $# != 0-do-  case $1 in-  --*=*)-    ac_option=`expr "X$1" : 'X\([^=]*\)='`-    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`-    ac_shift=:-    ;;-  *)-    ac_option=$1-    ac_optarg=$2-    ac_shift=shift-    ;;-  esac--  case $ac_option in-  # Handling of the options.-  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)-    ac_cs_recheck=: ;;-  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )-    $as_echo "$ac_cs_version"; exit ;;-  --debug | --debu | --deb | --de | --d | -d )-    debug=: ;;-  --file | --fil | --fi | --f )-    $ac_shift-    case $ac_optarg in-    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;-    esac-    CONFIG_FILES="$CONFIG_FILES '$ac_optarg'"-    ac_need_defaults=false;;-  --header | --heade | --head | --hea )-    $ac_shift-    case $ac_optarg in-    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;-    esac-    CONFIG_HEADERS="$CONFIG_HEADERS '$ac_optarg'"-    ac_need_defaults=false;;-  --he | --h)-    # Conflict between --help and --header-    { $as_echo "$as_me: error: ambiguous option: $1-Try \`$0 --help' for more information." >&2-   { (exit 1); exit 1; }; };;-  --help | --hel | -h )-    $as_echo "$ac_cs_usage"; exit ;;-  -q | -quiet | --quiet | --quie | --qui | --qu | --q \-  | -silent | --silent | --silen | --sile | --sil | --si | --s)-    ac_cs_silent=: ;;--  # This is an error.-  -*) { $as_echo "$as_me: error: unrecognized option: $1-Try \`$0 --help' for more information." >&2-   { (exit 1); exit 1; }; } ;;--  *) ac_config_targets="$ac_config_targets $1"-     ac_need_defaults=false ;;--  esac-  shift-done--ac_configure_extra_args=--if $ac_cs_silent; then-  exec 6>/dev/null-  ac_configure_extra_args="$ac_configure_extra_args --silent"-fi--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-if \$ac_cs_recheck; then-  set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion-  shift-  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6-  CONFIG_SHELL='$SHELL'-  export CONFIG_SHELL-  exec "\$@"-fi--_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-exec 5>>config.log-{-  echo-  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX-## Running $as_me. ##-_ASBOX-  $as_echo "$ac_log"-} >&5--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1--# Handling of arguments.-for ac_config_target in $ac_config_targets-do-  case $ac_config_target in-    "include/HsGLUTConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsGLUTConfig.h" ;;-    "include/HsGLUT.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsGLUT.h" ;;-    "GLUT.buildinfo") CONFIG_FILES="$CONFIG_FILES GLUT.buildinfo" ;;--  *) { { $as_echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5-$as_echo "$as_me: error: invalid argument: $ac_config_target" >&2;}-   { (exit 1); exit 1; }; };;-  esac-done---# If the user did not use the arguments to specify the items to instantiate,-# then the envvar interface is used.  Set only those that are not.-# We use the long form for the default assignment because of an extremely-# bizarre bug on SunOS 4.1.3.-if $ac_need_defaults; then-  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files-  test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers-fi--# Have a temporary directory for convenience.  Make it in the build tree-# simply because there is no reason against having it here, and in addition,-# creating and moving files from /tmp can sometimes cause problems.-# Hook for its removal unless debugging.-# Note that there is a small window in which the directory will not be cleaned:-# after its creation but before its name has been assigned to `$tmp'.-$debug ||-{-  tmp=-  trap 'exit_status=$?-  { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status-' 0-  trap '{ (exit 1); exit 1; }' 1 2 13 15-}-# Create a (secure) tmp directory for tmp files.--{-  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&-  test -n "$tmp" && test -d "$tmp"-}  ||-{-  tmp=./conf$$-$RANDOM-  (umask 077 && mkdir "$tmp")-} ||-{-   $as_echo "$as_me: cannot create a temporary directory in ." >&2-   { (exit 1); exit 1; }-}--# Set up the scripts for CONFIG_FILES section.-# No need to generate them if there are no CONFIG_FILES.-# This happens for instance with `./config.status config.h'.-if test -n "$CONFIG_FILES"; then---ac_cr='
'-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then-  ac_cs_awk_cr='\\r'-else-  ac_cs_awk_cr=$ac_cr-fi--echo 'BEGIN {' >"$tmp/subs1.awk" &&-_ACEOF---{-  echo "cat >conf$$subs.awk <<_ACEOF" &&-  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&-  echo "_ACEOF"-} >conf$$subs.sh ||-  { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5-$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}-   { (exit 1); exit 1; }; }-ac_delim_num=`echo "$ac_subst_vars" | grep -c '$'`-ac_delim='%!_!# '-for ac_last_try in false false false false false :; do-  . ./conf$$subs.sh ||-    { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5-$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}-   { (exit 1); exit 1; }; }--  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`-  if test $ac_delim_n = $ac_delim_num; then-    break-  elif $ac_last_try; then-    { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5-$as_echo "$as_me: error: could not make $CONFIG_STATUS" >&2;}-   { (exit 1); exit 1; }; }-  else-    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "-  fi-done-rm -f conf$$subs.sh--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&-_ACEOF-sed -n '-h-s/^/S["/; s/!.*/"]=/-p-g-s/^[^!]*!//-:repl-t repl-s/'"$ac_delim"'$//-t delim-:nl-h-s/\(.\{148\}\).*/\1/-t more1-s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/-p-n-b repl-:more1-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t nl-:delim-h-s/\(.\{148\}\).*/\1/-t more2-s/["\\]/\\&/g; s/^/"/; s/$/"/-p-b-:more2-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t delim-' <conf$$subs.awk | sed '-/^[^""]/{-  N-  s/\n//-}-' >>$CONFIG_STATUS || ac_write_fail=1-rm -f conf$$subs.awk-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACAWK-cat >>"\$tmp/subs1.awk" <<_ACAWK &&-  for (key in S) S_is_set[key] = 1-  FS = ""--}-{-  line = $ 0-  nfields = split(line, field, "@")-  substed = 0-  len = length(field[1])-  for (i = 2; i < nfields; i++) {-    key = field[i]-    keylen = length(key)-    if (S_is_set[key]) {-      value = S[key]-      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)-      len += length(value) + length(field[++i])-      substed = 1-    } else-      len += 1 + keylen-  }--  print line-}--_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then-  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"-else-  cat-fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \-  || { { $as_echo "$as_me:$LINENO: error: could not setup config files machinery" >&5-$as_echo "$as_me: error: could not setup config files machinery" >&2;}-   { (exit 1); exit 1; }; }-_ACEOF--# VPATH may cause trouble with some makes, so we remove $(srcdir),-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and-# trailing colons and then remove the whole line if VPATH becomes empty-# (actually we leave an empty line to preserve line numbers).-if test "x$srcdir" = x.; then-  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{-s/:*\$(srcdir):*/:/-s/:*\${srcdir}:*/:/-s/:*@srcdir@:*/:/-s/^\([^=]*=[	 ]*\):*/\1/-s/:*$//-s/^[^=]*=[	 ]*$//-}'-fi--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-fi # test -n "$CONFIG_FILES"--# Set up the scripts for CONFIG_HEADERS section.-# No need to generate them if there are no CONFIG_HEADERS.-# This happens for instance with `./config.status Makefile'.-if test -n "$CONFIG_HEADERS"; then-cat >"$tmp/defines.awk" <<\_ACAWK ||-BEGIN {-_ACEOF--# Transform confdefs.h into an awk script `defines.awk', embedded as-# here-document in config.status, that substitutes the proper values into-# config.h.in to produce config.h.--# Create a delimiter string that does not exist in confdefs.h, to ease-# handling of long lines.-ac_delim='%!_!# '-for ac_last_try in false false :; do-  ac_t=`sed -n "/$ac_delim/p" confdefs.h`-  if test -z "$ac_t"; then-    break-  elif $ac_last_try; then-    { { $as_echo "$as_me:$LINENO: error: could not make $CONFIG_HEADERS" >&5-$as_echo "$as_me: error: could not make $CONFIG_HEADERS" >&2;}-   { (exit 1); exit 1; }; }-  else-    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "-  fi-done--# For the awk script, D is an array of macro values keyed by name,-# likewise P contains macro parameters if any.  Preserve backslash-# newline sequences.--ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*-sed -n '-s/.\{148\}/&'"$ac_delim"'/g-t rset-:rset-s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /-t def-d-:def-s/\\$//-t bsnl-s/["\\]/\\&/g-s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\-D["\1"]=" \3"/p-s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p-d-:bsnl-s/["\\]/\\&/g-s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\-D["\1"]=" \3\\\\\\n"\\/p-t cont-s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p-t cont-d-:cont-n-s/.\{148\}/&'"$ac_delim"'/g-t clear-:clear-s/\\$//-t bsnlc-s/["\\]/\\&/g; s/^/"/; s/$/"/p-d-:bsnlc-s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p-b cont-' <confdefs.h | sed '-s/'"$ac_delim"'/"\\\-"/g' >>$CONFIG_STATUS || ac_write_fail=1--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-  for (key in D) D_is_set[key] = 1-  FS = ""-}-/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {-  line = \$ 0-  split(line, arg, " ")-  if (arg[1] == "#") {-    defundef = arg[2]-    mac1 = arg[3]-  } else {-    defundef = substr(arg[1], 2)-    mac1 = arg[2]-  }-  split(mac1, mac2, "(") #)-  macro = mac2[1]-  prefix = substr(line, 1, index(line, defundef) - 1)-  if (D_is_set[macro]) {-    # Preserve the white space surrounding the "#".-    print prefix "define", macro P[macro] D[macro]-    next-  } else {-    # Replace #undef with comments.  This is necessary, for example,-    # in the case of _POSIX_SOURCE, which is predefined and required-    # on some systems where configure will not decide to define it.-    if (defundef == "undef") {-      print "/*", prefix defundef, macro, "*/"-      next-    }-  }-}-{ print }-_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-  { { $as_echo "$as_me:$LINENO: error: could not setup config headers machinery" >&5-$as_echo "$as_me: error: could not setup config headers machinery" >&2;}-   { (exit 1); exit 1; }; }-fi # test -n "$CONFIG_HEADERS"---eval set X "  :F $CONFIG_FILES  :H $CONFIG_HEADERS    "-shift-for ac_tag-do-  case $ac_tag in-  :[FHLC]) ac_mode=$ac_tag; continue;;-  esac-  case $ac_mode$ac_tag in-  :[FHL]*:*);;-  :L* | :C*:*) { { $as_echo "$as_me:$LINENO: error: invalid tag $ac_tag" >&5-$as_echo "$as_me: error: invalid tag $ac_tag" >&2;}-   { (exit 1); exit 1; }; };;-  :[FH]-) ac_tag=-:-;;-  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;-  esac-  ac_save_IFS=$IFS-  IFS=:-  set x $ac_tag-  IFS=$ac_save_IFS-  shift-  ac_file=$1-  shift--  case $ac_mode in-  :L) ac_source=$1;;-  :[FH])-    ac_file_inputs=-    for ac_f-    do-      case $ac_f in-      -) ac_f="$tmp/stdin";;-      *) # Look for the file first in the build tree, then in the source tree-	 # (if the path is not absolute).  The absolute path cannot be DOS-style,-	 # because $ac_f cannot contain `:'.-	 test -f "$ac_f" ||-	   case $ac_f in-	   [\\/$]*) false;;-	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;-	   esac ||-	   { { $as_echo "$as_me:$LINENO: error: cannot find input file: $ac_f" >&5-$as_echo "$as_me: error: cannot find input file: $ac_f" >&2;}-   { (exit 1); exit 1; }; };;-      esac-      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac-      ac_file_inputs="$ac_file_inputs '$ac_f'"-    done--    # Let's still pretend it is `configure' which instantiates (i.e., don't-    # use $as_me), people would be surprised to read:-    #    /* config.h.  Generated by config.status.  */-    configure_input='Generated from '`-	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'-	`' by configure.'-    if test x"$ac_file" != x-; then-      configure_input="$ac_file.  $configure_input"-      { $as_echo "$as_me:$LINENO: creating $ac_file" >&5-$as_echo "$as_me: creating $ac_file" >&6;}-    fi-    # Neutralize special characters interpreted by sed in replacement strings.-    case $configure_input in #(-    *\&* | *\|* | *\\* )-       ac_sed_conf_input=`$as_echo "$configure_input" |-       sed 's/[\\\\&|]/\\\\&/g'`;; #(-    *) ac_sed_conf_input=$configure_input;;-    esac--    case $ac_tag in-    *:-:* | *:-) cat >"$tmp/stdin" \-      || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5-$as_echo "$as_me: error: could not create $ac_file" >&2;}-   { (exit 1); exit 1; }; } ;;-    esac-    ;;-  esac--  ac_dir=`$as_dirname -- "$ac_file" ||-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$ac_file" : 'X\(//\)[^/]' \| \-	 X"$ac_file" : 'X\(//\)$' \| \-	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$ac_file" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-  { as_dir="$ac_dir"-  case $as_dir in #(-  -*) as_dir=./$as_dir;;-  esac-  test -d "$as_dir" || { $as_mkdir_p && mkdir -p "$as_dir"; } || {-    as_dirs=-    while :; do-      case $as_dir in #(-      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(-      *) as_qdir=$as_dir;;-      esac-      as_dirs="'$as_qdir' $as_dirs"-      as_dir=`$as_dirname -- "$as_dir" ||-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \-	 X"$as_dir" : 'X\(//\)[^/]' \| \-	 X"$as_dir" : 'X\(//\)$' \| \-	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_dir" |-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)[^/].*/{-	    s//\1/-	    q-	  }-	  /^X\(\/\/\)$/{-	    s//\1/-	    q-	  }-	  /^X\(\/\).*/{-	    s//\1/-	    q-	  }-	  s/.*/./; q'`-      test -d "$as_dir" && break-    done-    test -z "$as_dirs" || eval "mkdir $as_dirs"-  } || test -d "$as_dir" || { { $as_echo "$as_me:$LINENO: error: cannot create directory $as_dir" >&5-$as_echo "$as_me: error: cannot create directory $as_dir" >&2;}-   { (exit 1); exit 1; }; }; }-  ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)-  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`-  # A ".." for each directory in $ac_dir_suffix.-  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`-  case $ac_top_builddir_sub in-  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;-  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;-  esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in-  .)  # We are building in place.-    ac_srcdir=.-    ac_top_srcdir=$ac_top_builddir_sub-    ac_abs_top_srcdir=$ac_pwd ;;-  [\\/]* | ?:[\\/]* )  # Absolute name.-    ac_srcdir=$srcdir$ac_dir_suffix;-    ac_top_srcdir=$srcdir-    ac_abs_top_srcdir=$srcdir ;;-  *) # Relative name.-    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix-    ac_top_srcdir=$ac_top_build_prefix$srcdir-    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix---  case $ac_mode in-  :F)-  #-  # CONFIG_FILE-  #--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# If the template does not know about datarootdir, expand it.-# FIXME: This hack should be removed a few years after 2.60.-ac_datarootdir_hack=; ac_datarootdir_seen=--ac_sed_dataroot='-/datarootdir/ {-  p-  q-}-/@datadir@/p-/@docdir@/p-/@infodir@/p-/@localedir@/p-/@mandir@/p-'-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in-*datarootdir*) ac_datarootdir_seen=yes;;-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)-  { $as_echo "$as_me:$LINENO: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}-_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-  ac_datarootdir_hack='-  s&@datadir@&$datadir&g-  s&@docdir@&$docdir&g-  s&@infodir@&$infodir&g-  s&@localedir@&$localedir&g-  s&@mandir@&$mandir&g-    s&\\\${datarootdir}&$datarootdir&g' ;;-esac-_ACEOF--# Neutralize VPATH when `$srcdir' = `.'.-# Shell code in configure.ac might set extrasub.-# FIXME: do we really want to maintain this feature?-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_sed_extra="$ac_vpsub-$extrasub-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-:t-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b-s|@configure_input@|$ac_sed_conf_input|;t t-s&@top_builddir@&$ac_top_builddir_sub&;t t-s&@top_build_prefix@&$ac_top_build_prefix&;t t-s&@srcdir@&$ac_srcdir&;t t-s&@abs_srcdir@&$ac_abs_srcdir&;t t-s&@top_srcdir@&$ac_top_srcdir&;t t-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t-s&@builddir@&$ac_builddir&;t t-s&@abs_builddir@&$ac_abs_builddir&;t t-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t-$ac_datarootdir_hack-"-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$tmp/subs.awk" >$tmp/out \-  || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5-$as_echo "$as_me: error: could not create $ac_file" >&2;}-   { (exit 1); exit 1; }; }--test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&-  { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } &&-  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } &&-  { $as_echo "$as_me:$LINENO: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined." >&5-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined.  Please make sure it is defined." >&2;}--  rm -f "$tmp/stdin"-  case $ac_file in-  -) cat "$tmp/out" && rm -f "$tmp/out";;-  *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";;-  esac \-  || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5-$as_echo "$as_me: error: could not create $ac_file" >&2;}-   { (exit 1); exit 1; }; }- ;;-  :H)-  #-  # CONFIG_HEADER-  #-  if test x"$ac_file" != x-; then-    {-      $as_echo "/* $configure_input  */" \-      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs"-    } >"$tmp/config.h" \-      || { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5-$as_echo "$as_me: error: could not create $ac_file" >&2;}-   { (exit 1); exit 1; }; }-    if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then-      { $as_echo "$as_me:$LINENO: $ac_file is unchanged" >&5-$as_echo "$as_me: $ac_file is unchanged" >&6;}-    else-      rm -f "$ac_file"-      mv "$tmp/config.h" "$ac_file" \-	|| { { $as_echo "$as_me:$LINENO: error: could not create $ac_file" >&5-$as_echo "$as_me: error: could not create $ac_file" >&2;}-   { (exit 1); exit 1; }; }-    fi-  else-    $as_echo "/* $configure_input  */" \-      && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \-      || { { $as_echo "$as_me:$LINENO: error: could not create -" >&5-$as_echo "$as_me: error: could not create -" >&2;}-   { (exit 1); exit 1; }; }-  fi- ;;---  esac--done # for ac_tag---{ (exit 0); exit 0; }-_ACEOF-chmod +x $CONFIG_STATUS-ac_clean_files=$ac_clean_files_save--test $ac_write_fail = 0 ||-  { { $as_echo "$as_me:$LINENO: error: write failure creating $CONFIG_STATUS" >&5-$as_echo "$as_me: error: write failure creating $CONFIG_STATUS" >&2;}-   { (exit 1); exit 1; }; }---# configure is writing to config.log, and then calls config.status.-# config.status does its own redirection, appending to config.log.-# Unfortunately, on DOS this fails, as config.log is still kept open-# by configure, so config.status won't be able to write to it; its-# output is simply discarded.  So we exec the FD to /dev/null,-# effectively closing config.log, so it can be properly (re)opened and-# appended to by config.status.  When coming back to configure, we-# need to make the FD available again.-if test "$no_create" != yes; then-  ac_cs_success=:-  ac_config_status_args=-  test "$silent" = yes &&-    ac_config_status_args="$ac_config_status_args --quiet"-  exec 5>/dev/null-  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false-  exec 5>>config.log-  # Use ||, not &&, to avoid exiting from the if with $? = 1, which-  # would make configure fail if this is the last instruction.-  $ac_cs_success || { (exit 1); exit 1; }-fi-if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then-  { $as_echo "$as_me:$LINENO: WARNING: unrecognized options: $ac_unrecognized_opts" >&5-$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}-fi-
− configure.ac 
@@ -1,83 +0,0 @@-AC_INIT([Haskell GLUT package], [2.1.2.1], [sven.panne@aedion.de], [GLUT])--# Safety check: Ensure that we are in the correct source directory.-AC_CONFIG_SRCDIR([include/HsGLUT.h.in])--# The first file mentioned below will be generated by autoheader and contains-# defines which are needed during package build time only. The second header-# contains all kinds of stuff which is needed for using this package.-AC_CONFIG_HEADERS([include/HsGLUTConfig.h include/HsGLUT.h])--# Necessary for Cabal, which passes with --with-cc flag on Windows:-AC_ARG_WITH([cc],-            [C compiler],-            [CC=$withval])-AC_PROG_CC()--# we do not really care about this here, but this avoids a warning about an-# unknown option-FP_ARG_COMPILER--# We set this to "yes" later when we have found GLUT libs and headers.-GLUT_BUILD_PACKAGE=no--# Shall we build this package at all?-FP_ARG_GLUT--if test x"$enable_glut" = xyes; then--# Check for GLUT include paths and libraries-FP_CHECK_GLUT--if test "$GLUT_LIBS" = no; then-  AC_MSG_FAILURE([no GLUT library found, so this package cannot be built])-fi--# check for GLUT include files-glut_found_header=no-fp_save_cppflags="$CPPFLAGS"-CPPFLAGS="$CPPFLAGS $X_CFLAGS"-AC_CHECK_HEADERS([GL/glut.h GLUT/glut.h], [glut_found_header=yes])-CPPFLAGS="$fp_save_cppflags"--if test "$glut_found_header" = no; then-  AC_MSG_FAILURE([no GLUT header found, so this package cannot be built])-fi--GLUT_BUILD_PACKAGE=yes--AC_CHECK_HEADERS([windows.h])--AC_DEFINE_UNQUOTED([GLUT_EXTRA_LIBS],-  [`echo HSGLUT_cbits $GLUT_EXTRA_LIBS | sed -e 's/[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [Extra libraries for GLUT, as a list of string literals.])--AC_DEFINE_UNQUOTED([GLUT_CFLAGS],-  [`echo '' $GLUT_CFLAGS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [C flags for GLUT, as a list of string literals.])--AC_DEFINE_UNQUOTED([GLUT_LIBS],-  [`echo '' $GLUT_LIBS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [Library flags for GLUT, as a list of string literals.])--AC_DEFINE_UNQUOTED([GLUT_FRAMEWORKS],-  [`echo '' $GLUT_FRAMEWORKS | sed -e 's/-[[^ ]]*/,"&"/g' -e 's/^ *,//'`],-  [Framework flags for GLUT, as a list of string literals.])--fi--if test "$GLUT_BUILD_PACKAGE" = yes; then-  BUILD_PACKAGE_BOOL=True-else-  BUILD_PACKAGE_BOOL=False-fi-AC_SUBST([BUILD_PACKAGE_BOOL])--case "$host" in-*-mingw32) CALLCONV=stdcall ;;-*)	CALLCONV=ccall ;;-esac-AC_SUBST([CALLCONV])--AC_CONFIG_FILES([GLUT.buildinfo])-AC_OUTPUT
+ examples/00-README view
@@ -0,0 +1,24 @@+This directory contains OpenGL example programs from various sources:++   * BOGLP: Contains some examples from the book "Beginning OpenGL Game+     Programming", 2nd ed., by Benstead/Astle/Hawkins.++   * Misc: Contains a few random examples from e.g. the Mesa sources.++   * OrangeBook: Contains an example from the book "OpenGL Shading Language",+     3rd ed, by Rost/Licea-Kane/Ginsburg/Kessenich/Lichtenbelt/Malan/Weiblen.++   * RedBook4: Contains all examples from the book "OpenGL Programming Guide:+     The Official Guide to Learning OpenGL, Version 1.4", 4th ed., by+     Shreiner/Woo/Neider/Davis.++   * RedBook8: Contains various examples from the book "OpenGL Programming+     Guide: The Official Guide to Learning OpenGL, Version 4.3", 8th ed., by+     Shreiner/Sellers/Kessenich/Licea-Kane.++If you have 'make' and 'ghc' installed, you can just issue 'make' at any+directory level to compile the examples. 'make clean' cleans up afterwards, and+you can use '-j [N]' for parallel builds. Directly loading the examples into+e.g. ghci is possible, too, just ':load' an example and run it via 'main'. For+some examples, you might have to extend the search path like '-i../common', see+the corresponding Makefile.
+ examples/BOGLGP/00-README view
@@ -0,0 +1,2 @@+This directory contains some examples from the book "Beginning OpenGL Game+Programming", 2nd ed., by Benstead/Astle/Hawkins.
examples/BOGLGP/Chapter01/OnYourOwn1.hs view
@@ -1,6 +1,6 @@ {-    OnYourOwn1.hs (adapted from Simple.cpp which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -15,13 +15,13 @@ main :: IO () main = do    -- Setup the basic GLUT stuff-   getArgsAndInitialize+   _ <- getArgsAndInitialize    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]     -- Create the window    initialWindowSize $= Size 1024 768    initialWindowPosition $= Position 100 150-   createWindow "BOGLGP - Chapter 1 - On Your Own 1"+   _ <- createWindow "BOGLGP - Chapter 1 - On Your Own 1"     initialize
examples/BOGLGP/Chapter01/Simple.hs view
@@ -1,6 +1,6 @@ {-    Simple.hs (adapted from Simple.cpp which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -15,13 +15,13 @@ main :: IO () main = do    -- Setup the basic GLUT stuff-   getArgsAndInitialize+   _ <- getArgsAndInitialize    initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]     -- Create the window    initialWindowSize $= Size 1024 768    initialWindowPosition $= Position 100 150-   createWindow "BOGLGP - Chapter 1 - Simple"+   _ <- createWindow "BOGLGP - Chapter 1 - Simple"     initialize
examples/BOGLGP/Chapter02/OnYourOwn1.hs view
@@ -1,6 +1,6 @@ {-    OnYourOwn1.hs (adapted from OpenGLApplication which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 2 - On Your Own 1"+   _ <- createWindow "BOGLGP - Chapter 2 - On Your Own 1"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter02/OpenGLApplication.hs view
@@ -1,6 +1,6 @@ {-    OpenGLApplication.hs (adapted from OpenGLApplication which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 2 - OpenGL Application"+   _ <- createWindow "BOGLGP - Chapter 2 - OpenGL Application"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter03/Lines.hs view
@@ -1,6 +1,6 @@ {-    Lines.hs (adapted from Lines which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 3 - Lines"+   _ <- createWindow "BOGLGP - Chapter 3 - Lines"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter03/OnYourOwn1.hs view
@@ -1,6 +1,6 @@ {-    OnYourOwn1.hs (adapted from OnYourOwn1 which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 3 - On Your Own 1"+   _ <- createWindow "BOGLGP - Chapter 3 - On Your Own 1"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter03/Points.hs view
@@ -1,6 +1,6 @@ {-    Points.hs (adapted from Points which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 3 - Points"+   _ <- createWindow "BOGLGP - Chapter 3 - Points"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter03/Polygons.hs view
@@ -1,6 +1,6 @@ {-    Polygons.hs (adapted from Polygons which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 3 - Polygons"+   _ <- createWindow "BOGLGP - Chapter 3 - Polygons"    return ()  --------------------------------------------------------------------------------
examples/BOGLGP/Chapter03/TrianglesQuads.hs view
@@ -1,6 +1,6 @@ {-    TrianglesQuads.hs (adapted from TrianglesQuads which is (c) 2004 Astle/Hawkins)-   Copyright (c) Sven Panne 2004-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2004-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -45,7 +45,7 @@        addCapability GameModeHeight (Just (windowHeight opts)) .        addCapability GameModeBitsPerPlane (bpp opts) .        addCapability GameModeRefreshRate (refreshRate opts)) []-   enterGameMode+   _ <- enterGameMode    maybeWin <- get currentWindow    if isJust maybeWin       then cursor $= None@@ -57,7 +57,7 @@ windowedMode opts = do    initialWindowSize $=       Size (fromIntegral (windowWidth opts)) (fromIntegral (windowHeight opts))-   createWindow "BOGLGP - Chapter 3 - TrianglesQuads"+   _ <- createWindow "BOGLGP - Chapter 3 - TrianglesQuads"    return ()  --------------------------------------------------------------------------------@@ -252,7 +252,7 @@    renderPrimitive TriangleFan $ do       -- center vertex of fan       vertex (Vertex3 0 0 (0 :: GLfloat))-	+       -- bottom side       for [ 3, 2 .. 0 ] $ \x ->          vertex (Vertex3 x 0 3)
+ examples/Misc/00-README view
@@ -0,0 +1,1 @@+This directory contains a few random examples from e.g. the Mesa sources.
examples/Misc/ARBOcclude.hs view
@@ -1,6 +1,6 @@ {-    ARBOcclude.hs (adapted from arbocclude.c which is (c) Brian Paul)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -}@@ -182,12 +182,12 @@    initialWindowPosition $= Position 0 0    initialWindowSize $= Size 400 400    initialDisplayMode $= [ RGBMode, DoubleBuffered, WithDepthBuffer ]-   createWindow progName+   _ <- createWindow progName    state <- makeState    reshapeCallback $= Just (\size -> viewport $= (Position 0 0, size))    keyboardMouseCallback $= Just (keyboard state)    setIdleCallback state-   [ occQuery ] <- genObjectNames 1+   occQuery <- genObjectName    displayCallback $= display occQuery state    myInit    mainLoop
+ examples/Misc/ColorTriangle/ColorTriangle.hs view
@@ -0,0 +1,101 @@+{-+   ColorTriangle.hs (adapted from triangles.cpp which is (c) The Red Book+   Authors.)+   Copyright (c) Sven Panne 2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file GLUT/LICENSE++   A variation of Triangles.hs, adding colors to vertices via interleaved vertex+   attributes.+-}++import Control.Monad+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.UI.GLUT+import Prelude hiding ( init )+import LoadShaders++bufferOffset :: Integral a => a -> Ptr b+bufferOffset = plusPtr nullPtr . fromIntegral++data Descriptor = Descriptor VertexArrayObject ArrayIndex NumArrayIndices++data ColoredVertex = ColoredVertex (Vertex2 GLfloat) (Color3 GLfloat)++instance Storable ColoredVertex where+  sizeOf ~(ColoredVertex v c) = sizeOf v + sizeOf c+  alignment ~(ColoredVertex v _) = alignment v+  peek ptr = do v <- peek (castPtr ptr)+                c <- peekByteOff (castPtr ptr) (sizeOf v)+                return $ ColoredVertex v c+  poke ptr (ColoredVertex v c) = do poke (castPtr ptr) v+                                    pokeByteOff (castPtr ptr) (sizeOf v) c++init :: IO Descriptor+init = do+  triangles <- genObjectName+  bindVertexArrayObject $= Just triangles++  let vertices = [+        -- Triangle 1+        ColoredVertex (Vertex2 (-0.90) (-0.90)) (Color3 1 0 0),+        ColoredVertex (Vertex2   0.85  (-0.90)) (Color3 0 1 0),+        ColoredVertex (Vertex2 (-0.90)   0.85 ) (Color3 0 0 1),+        -- Triangle 2+        ColoredVertex (Vertex2   0.90  (-0.85)) (Color3 0 1 1),+        ColoredVertex (Vertex2   0.90    0.90 ) (Color3 1 0 1),+        ColoredVertex (Vertex2 (-0.85)   0.90 ) (Color3 1 1 0)]+      numVertices = length vertices+      vertexSize = sizeOf (head vertices)++  arrayBuffer <- genObjectName+  bindBuffer ArrayBuffer $= Just arrayBuffer+  withArray vertices $ \ptr -> do+    let size = fromIntegral (numVertices * vertexSize)+    bufferData ArrayBuffer $= (size, ptr, StaticDraw)++  program <- loadShaders [+     ShaderInfo VertexShader (FileSource "color_triangles.vert"),+     ShaderInfo FragmentShader (FileSource "color_triangles.frag")]+  currentProgram $= Just program++  let firstIndex = 0+      vPosition = AttribLocation 0+      vColor = AttribLocation 1+  vertexAttribPointer vPosition $=+    (ToFloat,+     VertexArrayDescriptor 2 Float (fromIntegral vertexSize)+                           (bufferOffset (firstIndex * vertexSize)))+  vertexAttribArray vPosition $= Enabled+  let colorOffset = case head vertices of ~(ColoredVertex v _) -> sizeOf v+  vertexAttribPointer vColor $=+    (ToFloat,+     VertexArrayDescriptor 3 Float (fromIntegral vertexSize)+                           (bufferOffset ((firstIndex * vertexSize) ++                                          fromIntegral colorOffset)))+  vertexAttribArray vColor $= Enabled++  return $+    Descriptor triangles (fromIntegral firstIndex) (fromIntegral numVertices)++display :: Descriptor -> DisplayCallback+display (Descriptor triangles firstIndex numVertices) = do+  clear [ ColorBuffer ]+  bindVertexArrayObject $= Just triangles+  drawArrays Triangles firstIndex numVertices+  flush++main :: IO ()+main = do+  (progName, _args) <- getArgsAndInitialize+  initialDisplayMode $= [ RGBAMode ]+  initialWindowSize $= Size 512 512+  initialContextVersion $= (4, 3)+  initialContextFlags $= [ DebugContext ]+  initialContextProfile $= [ CoreProfile ]+  _ <- createWindow progName+  descriptor <- init+  displayCallback $= display descriptor+  mainLoop
+ examples/Misc/ColorTriangle/color_triangles.frag view
@@ -0,0 +1,10 @@+#version 430 core++in vec4 color;+out vec4 fColor;++void+main()+{+   fColor = color;+}
+ examples/Misc/ColorTriangle/color_triangles.vert view
@@ -0,0 +1,12 @@+#version 430 core++layout(location = 0) in vec4 vPosition;+layout(location = 1) in vec4 vColor;+out vec4 color;++void+main()+{+   gl_Position = vPosition;+   color = vColor;+}
examples/Misc/ExtractContours.hs view
@@ -1,6 +1,6 @@ {-    ExtractContours.hs (adapted from tess.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE @@ -23,7 +23,7 @@    -- resolve overloading, not needed in "real" programs    let color3f = color :: Color3 GLfloat -> IO ()    color3f (Color3 1 1 1)-   mapM callList displayLists+   mapM_ callList displayLists    flush  -- 'Float' is a dummy, any marshalable type would do@@ -48,7 +48,7 @@ noOpCombiner :: Combiner DontCare noOpCombiner _newVertex _weightedProperties = 0 -star :: ComplexPolygon (Color3 GLclampf)+star :: ComplexPolygon (Color3 GLfloat) star = ComplexPolygon [    ComplexContour [       AnnotatedVertex (Vertex3 250  50 0) (Color3 1 0 1),@@ -57,7 +57,7 @@       AnnotatedVertex (Vertex3 250 150 0) (Color3 1 0 0),       AnnotatedVertex (Vertex3 400 150 0) (Color3 0 1 0) ] ] -combineColors :: Combiner (Color3 GLclampf)+combineColors :: Combiner (Color3 GLfloat) combineColors    _newVertex    (WeightedProperties@@ -109,7 +109,7 @@    (progName, _args) <- getArgsAndInitialize    initialDisplayMode $= [ SingleBuffered, RGBMode ]    initialWindowSize $= Size 500 500-   createWindow progName+   _ <- createWindow progName    displayLists <- myInit    displayCallback $= display displayLists    reshapeCallback $= Just reshape
examples/Misc/Gears.hs view
@@ -1,7 +1,7 @@ {-    Gears.hs (adapted from gears.c which is (c) Brian Paul)    Copyright (c) Shawn P. Garbett 2004 <shawn@garbett.org>-   Further hacked by Sven Panne <sven.panne@aedion.de>+   Further hacked by Sven Panne <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE @@ -289,7 +289,7 @@     initialWindowPosition $= Position 0 0    initialWindowSize $= Size 300 300-   createWindow "Gears"+   _ <- createWindow "Gears"    state <- makeState    gearsAndAuto <- myInit args
examples/Misc/Pitfall14.hs view
@@ -1,6 +1,6 @@ {-    Pitfall14-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE @@ -17,7 +17,7 @@ main = do    (progName, _args) <- getArgsAndInitialize    initialDisplayMode $= [ SingleBuffered, RGBMode ]-   createWindow progName+   _ <- createWindow progName     currentColor $= Color4 1 1 1 1    materialAmbient Front $= Color4 0.1 0.1 0.1 1
+ examples/Misc/SmoothOpenGL3.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE CPP #-}+{-+   SmoothOpenGL3.hs (adapted from freeglut's smooth_opengl3.c example)+   Copyright (c) Sven Panne 2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file LICENSE+-}++import Control.Monad+import qualified Data.ByteString as B+import Data.List+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+#if MIN_VERSION_OpenGLRaw(3,0,0)+import Graphics.GL+#else+import Graphics.Rendering.OpenGL.Raw+#define GL_FALSE gl_FALSE+#define GL_TRUE gl_TRUE+#endif+import Graphics.UI.GLUT+import System.Exit+import System.IO++data State = State {+   vertexBufferName :: BufferObject,+   vertexArrayObject :: VertexArrayObject,+   fgProjectionMatrixIndex :: UniformLocation,+   fgColorIndex :: AttribLocation ,+   fgVertexIndex :: AttribLocation,+   projectionMatrix :: GLmatrix GLfloat }++checkError :: String -> IO ()+checkError functionName = get errors >>= mapM_ reportError+   where reportError e = +            hPutStrLn stderr (showError e ++ " detected in " ++ functionName)+         showError (Error category message) =+            "GL error " ++ show category ++ " (" ++ message ++ ")"++varray :: [GLfloat]+varray = [+   1, 0, 0, -- red+   5, 5,    -- lower left++   0, 1, 0, -- green+   25, 5,   -- lower right++   0, 0, 1, -- blue+   5, 25 ]  -- upper left++numColorComponents :: NumComponents+numColorComponents = 3++numVertexComponents :: NumComponents+numVertexComponents = 2++sizeOfComponent :: Int+sizeOfComponent = sizeOf (head varray)++stride :: Stride+stride = fromIntegral sizeOfComponent * fromIntegral (numColorComponents + numVertexComponents)++sizeOfVarray :: Int+sizeOfVarray = length varray * sizeOfComponent++numElements :: NumArrayIndices+numElements = fromIntegral sizeOfVarray `div` fromIntegral stride++initBuffer :: IO BufferObject+initBuffer = do+   bufferObject <- genObjectName+   bindBuffer ArrayBuffer $= Just bufferObject+   withArray varray $ \buffer ->+      bufferData ArrayBuffer $= (fromIntegral sizeOfVarray, buffer, StaticDraw)+   checkError "initBuffer"+   return bufferObject++vertexShaderSource :: B.ByteString+vertexShaderSource = packUtf8 . unlines $ [+   "#version 140",+   "uniform mat4 fg_ProjectionMatrix;",+   "in vec4 fg_Color;",+   "in vec4 fg_Vertex;",+   "smooth out vec4 fg_SmoothColor;",+   "void main()",+   "{",+   "   fg_SmoothColor = fg_Color;",+   "   gl_Position = fg_ProjectionMatrix * fg_Vertex;",+   "}" ]++fragmentShaderSource :: B.ByteString+fragmentShaderSource = packUtf8 . unlines $ [+   "#version 140",+   "smooth in vec4 fg_SmoothColor;",+   "out vec4 fg_FragColor;",+   "void main(void)",+   "{",+   "   fg_FragColor = fg_SmoothColor;",+   "}" ]++checked :: (t -> IO ()) -> (t -> GettableStateVar Bool) -> (t -> GettableStateVar String) -> String -> t -> IO ()+checked action getStatus getInfoLog message object = do+   action object+   status <- get (getStatus object)+   unless status $+      hPutStrLn stderr . ((message ++ " log: ") ++) =<< get (getInfoLog object)++compileAndCheck :: Shader -> IO ()+compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"++compileShaderSource :: ShaderType -> B.ByteString -> IO Shader+compileShaderSource st source = do+   shader <- createShader st+   shaderSourceBS shader $= source+   compileAndCheck shader+   return shader++linkAndCheck :: Program -> IO ()+linkAndCheck = checked linkProgram linkStatus programInfoLog "link"++createProgramUsing :: [Shader] -> IO Program+createProgramUsing shaders = do+   program <- createProgram+   attachedShaders program $= shaders+   linkAndCheck program+   return program++initShader :: IO (UniformLocation, AttribLocation, AttribLocation)+initShader = do+   vertexShader <- compileShaderSource VertexShader vertexShaderSource+   fragmentShader <- compileShaderSource FragmentShader fragmentShaderSource+   program <- createProgramUsing [vertexShader, fragmentShader]+   currentProgram $= Just program++   projectionMatrixIndex <- get (uniformLocation program "fg_ProjectionMatrix")++   colorIndex <- get (attribLocation program "fg_Color")+   vertexAttribArray colorIndex $= Enabled++   vertexIndex <- get (attribLocation program "fg_Vertex")+   vertexAttribArray vertexIndex $= Enabled++   checkError "initShader"+   return (projectionMatrixIndex, colorIndex, vertexIndex)++initRendering :: IO ()+initRendering = do+   clearColor $= Color4 0 0 0 0+   checkError "initRendering"++myInit :: IO State+myInit = do+   vao <- genObjectName+   bindVertexArrayObject $= Just vao+   bufferObject <- initBuffer+   (projectionMatrixIndex, colorIndex, vertexIndex) <- initShader+   initRendering+   m <- newMatrix ColumnMajor (replicate 16 0)+   return $ State {+      vertexBufferName = bufferObject,+      vertexArrayObject = vao,+      fgProjectionMatrixIndex = projectionMatrixIndex,+      fgColorIndex = colorIndex,+      fgVertexIndex = vertexIndex,+      projectionMatrix = m }++dumpInfo :: IO ()+dumpInfo = do+   let dump :: String -> GettableStateVar String -> IO ()+       dump message var = putStrLn . ((message ++ ": ") ++) =<< get var+   dump "Vendor" vendor+   dump "Renderer" renderer+   dump "Version" glVersion+   dump "GLSL" shadingLanguageVersion+   checkError "dumpInfo"++bufferObjectPtr :: Integral a => a -> Ptr b+bufferObjectPtr = plusPtr (nullPtr :: Ptr GLchar) . fromIntegral++vertexArrayDescriptor :: NumComponents -> NumComponents -> VertexArrayDescriptor a+vertexArrayDescriptor count offset =+   VertexArrayDescriptor count Float stride (bufferObjectPtr (fromIntegral sizeOfComponent * offset))++triangle :: State -> IO ()+triangle state = do+   withMatrix (projectionMatrix state) $ \order buffer ->+      uniformMatrix4fv (fgProjectionMatrixIndex state) 1 (order == RowMajor) buffer+   bindVertexArrayObject $= Just (vertexArrayObject state)+   bindBuffer ArrayBuffer $= Just (vertexBufferName state)+   vertexAttribPointer (fgColorIndex state) $=+      (ToFloat, vertexArrayDescriptor numColorComponents 0)+   vertexAttribPointer (fgVertexIndex state) $=+      (ToFloat, vertexArrayDescriptor numVertexComponents numColorComponents)+   drawArrays Triangles 0 numElements+   checkError "triangle"++-- The OpenGL package offers no interface for glUniformMatrix*fv yet+uniformMatrix4fv :: UniformLocation -> GLsizei -> Bool -> Ptr GLfloat -> IO ()+uniformMatrix4fv location count =+   glUniformMatrix4fv (uniformLocationToGLint location) count . marshalGLboolean+   where marshalGLboolean x = fromIntegral $ case x of+            False -> GL_FALSE+            True -> GL_TRUE+         -- MEGA HACK because UniformLocation is abstract+         uniformLocationToGLint = read . head . tail . words . show++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   triangle state+   flush+   checkError "display"++loadOrtho :: (Matrix m, MatrixComponent a, Fractional a) => m a -> a -> a -> a -> a -> a -> a -> IO ()+loadOrtho m l r b t n f =+   fillMatrix m [+      [2 / (r - l),+       0,+       0,+       0],++      [0,+       2 / (t - b),+       0,+       0],++      [0,+       0,+       -2 / (f - n),+       0],++      [-(r + l) / (r - l),+       -(t + b) / (t - b),+       -(f + n) / (f - n),+       1 ]]++fillMatrix :: (Matrix m, MatrixComponent a) => m a -> [[a]] -> IO ()+fillMatrix m xs =+   withMatrix m $ \order buffer ->+      pokeArray buffer . concat . rearrange order $ xs++rearrange :: MatrixOrder -> [[a]] -> [[a]]+rearrange ColumnMajor = id+rearrange RowMajor = transpose++loadOrtho2D :: (Matrix m, MatrixComponent a, Fractional a) => m a -> a -> a -> a -> a -> IO ()+loadOrtho2D m l r b t = loadOrtho m l r b t (-1) 1++reshape :: State -> ReshapeCallback+reshape state size@(Size w h) = do+   viewport $= (Position 0 0, size)+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then loadOrtho2D (projectionMatrix state) 0 30 0 (30 * hf / wf)+      else loadOrtho2D (projectionMatrix state) 0 (30 * wf / hf) 0 30+   checkError "reshape"++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   -- add command line argument "classic" for a pre-3.x context+   unless (args == ["classic"]) $ do+      initialContextVersion $= (3, 1)+      initialContextFlags $= [ ForwardCompatibleContext, DebugContext ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   dumpInfo+   state <- myInit+   displayCallback $= display state+   reshapeCallback $= Just (reshape state)+   keyboardMouseCallback $= Just keyboard+   mainLoop
examples/Misc/Triangulate.hs view
@@ -1,6 +1,6 @@ {-    Triangulate.hs (adapted from tess.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE @@ -24,7 +24,7 @@    -- resolve overloading, not needed in "real" programs    let color3f = color :: Color3 GLfloat -> IO ()    color3f (Color3 1 1 1)-   mapM callList displayLists+   mapM_ callList displayLists    flush  -- 'Float' is a dummy, any marshalable type would do@@ -80,14 +80,16 @@          drawTriangleVertex tv2          drawTriangleVertex tv3 +-- CFloat has no Random instance, so we go via Float+randomGLfloat :: IO GLfloat+randomGLfloat = fmap (realToFrac :: Float -> GLfloat) randomIO+ randomColor :: IO () randomColor = do-   r <- randomIO-   g <- randomIO-   b <- randomIO-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 r g b)+   r <- randomGLfloat+   g <- randomGLfloat+   b <- randomGLfloat+   color (Color3 r g b)  drawTriangleVertex :: TriangleVertex DontCare -> IO () drawTriangleVertex (AnnotatedVertex plainVertex (_, e)) = do@@ -112,7 +114,7 @@    (progName, _args) <- getArgsAndInitialize    initialDisplayMode $= [ SingleBuffered, RGBMode ]    initialWindowSize $= Size 500 500-   createWindow progName+   _ <- createWindow progName    displayLists <- myInit    displayCallback $= display displayLists    reshapeCallback $= Just reshape
+ examples/OrangeBook/00-README view
@@ -0,0 +1,2 @@+This directory contains an example from the book "OpenGL Shading Language", 3rd+ed, by Rost/Licea-Kane/Ginsburg/Kessenich/Lichtenbelt/Malan/Weiblen.
examples/OrangeBook/ogl2brick/Brick.hs view
@@ -1,15 +1,26 @@+{-# LANGUAGE CPP #-} {-    Brick.hs (adapted from ogl2brick.c which is (c) 3Dlabs Inc. Ltd.)-   Copyright (c) Sven Panne 2006 <sven.panne@aedion.de>+   Copyright (c) Sven Panne 2018 <svenpanne@gmail.com>    This file is part of HOpenGL and distributed under a BSD-style license    See the file libraries/GLUT/LICENSE -} -import Control.Monad+#if !MIN_VERSION_base(4,8,0)+import Prelude hiding ( sum )+import Data.Foldable ( Foldable, sum )+#endif+import Control.Applicative+import Control.Exception ( IOException, catch )+import Control.Monad ( when, unless )+import qualified Data.ByteString as B import Data.IORef import System.Exit import Graphics.UI.GLUT +infixl 6 $+, $-+infixl 7 $*+ inertiaThreshold, inertiaFactor :: GLfloat inertiaThreshold = 1 inertiaFactor = 0.5@@ -21,7 +32,7 @@ timerFrequencyMillis :: Timeout timerFrequencyMillis = 20 -clearColors :: [Color4 GLfloat]+clearColors :: [Color4 GLclampf] clearColors = [    Color4 0.0 0.0 0.0 1,    Color4 0.2 0.2 0.3 1,@@ -48,7 +59,7 @@    theScale :: IORef GLfloat,    lastPosition :: IORef Position,    shouldRotate :: IORef Bool,-   colorCycle :: IORef [Color4 GLfloat],+   colorCycle :: IORef [Color4 GLclampf],    modelCycle :: IORef [IO ()],    modifiers :: IORef Modifiers    }@@ -56,9 +67,9 @@ makeState :: IO State makeState = do    di <- newIORef initialDiff-   li <- newIORef 0+   li <- newIORef (pure 0)    ia <- newIORef initialInertia-   io <- newIORef 0+   io <- newIORef (pure 0)    sc <- newIORef 1    lp <- newIORef (Position (-1) (-1))    sr <- newIORef True@@ -78,32 +89,17 @@       modifiers = mo       } -instance Num a => Num (Vector3 a) where-   (Vector3 x1 y1 z1) + (Vector3 x2 y2 z2) =-      Vector3 (x1 + x2) (y1 + y2) (z1 + z2)-   (Vector3 x1 y1 z1) - (Vector3 x2 y2 z2) =-      Vector3 (x1 - x2) (y1 - y2) (z1 - z2)-   (Vector3 x1 y1 z1) * (Vector3 x2 y2 z2) =-      Vector3 (x1 * x2) (y1 * y2) (z1 * z2)-   negate (Vector3 x y z) =-      Vector3 (negate x) (negate y) (negate z)-   abs (Vector3 x y z) =-      Vector3 (abs x) (abs y) (abs z)-   signum (Vector3 x y z) =-      Vector3 (signum x) (signum y) (signum z)-   fromInteger i =-      Vector3 (fromInteger i) (fromInteger i) (fromInteger i)--fromScalar :: Num a => a -> Vector3 a-fromScalar s = Vector3 s s s+-- Our tiny vector math library...+($+), ($-), ($*) :: (Applicative t, Num a) => t a -> t a -> t a+($+) = liftA2 (+)+($-) = liftA2 (-)+($*) = liftA2 (*) -step :: (Num a, Ord a) => Vector3 a -> Vector3 a -> Vector3 a-step (Vector3 x1 y1 z1) (Vector3 x2 y2 z2) =-   Vector3 (s x1 x2) (s y1 y2) (s z1 z2)-   where s e x = if x < e then 0 else 1+step :: (Applicative t, Num a, Ord a) => t a -> t a -> t a+step = liftA2 (\e x -> if x < e then 0 else 1) -dot :: Num a => Vector3 a -> Vector3 a -> a-dot (Vector3 x1 y1 z1) (Vector3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2+dot :: (Applicative t, Foldable t, Num a) => t a -> t a -> a+dot v1 v2 = sum (v1 $* v2)  drawFace :: Normal3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat          -> Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()@@ -208,7 +204,7 @@ resetState :: State -> IO () resetState state = do    diff state $= initialDiff-   lastIncr state $= 0+   lastIncr state $= pure 0    inertia state $= initialInertia    theScale state $= 1 @@ -217,12 +213,12 @@    lastPosition state $= Position (-1) (-1)    li <- get (lastIncr state)    ia <- get (inertia state)-   let t = fromScalar inertiaThreshold-       f = fromScalar inertiaFactor-       l = (1 - (step (-t) li)) * ((li + t) * f - ia)-       r = (step t li) * ((li - t) * f - ia)-   inertia state $= l + ia + r-   lastIncr state $= 0+   let t = pure inertiaThreshold+       f = pure inertiaFactor+       l = (pure 1 $- (step (fmap negate t) li)) $* ((li $+ t) $* f $- ia)+       r = (step t li) $* ((li $- t) $* f $- ia)+   inertia state $= l $+ ia $+ r+   lastIncr state $= pure 0  keyboard :: State -> KeyboardMouseCallback keyboard state key keyState mods _ = do@@ -238,13 +234,13 @@       (Char '-', Down) -> theScale state $~ (+ (- scaleIncrement))       (Char _, Down) -> printHelp       (SpecialKey KeyHome, Down) -> resetState state-      (SpecialKey KeyLeft, Down) -> diff state $~ (+ (- Vector3 1 0 0))-      (SpecialKey KeyRight, Down) -> diff state $~ (+ Vector3 1 0 0)-      (SpecialKey KeyUp, Down) -> diff state $~ (+ (- Vector3 0 1 0))-      (SpecialKey KeyDown, Down) -> diff state $~ (+ Vector3 0 1 0)+      (SpecialKey KeyLeft, Down) -> diff state $~ ($- Vector3 1 0 0)+      (SpecialKey KeyRight, Down) -> diff state $~ ($+ Vector3 1 0 0)+      (SpecialKey KeyUp, Down) -> diff state $~ ($- Vector3 0 1 0)+      (SpecialKey KeyDown, Down) -> diff state $~ ($+ Vector3 0 1 0)       (MouseButton LeftButton, Down) -> do-         inertia state $= 0-         lastIncr state $= 0+         inertia state $= pure 0+         lastIncr state $= pure 0       (MouseButton LeftButton, Up) -> calcInertia state       (_, _) -> return () @@ -259,16 +255,16 @@       when (xt /= -1) $ do          mods <- get (modifiers state)          if ctrl mods == Down-            then do diff state $~ (+ Vector3 0 0 xl)+            then do diff state $~ ($+ Vector3 0 0 xl)                     theScale state $~ (+ (yl * scaleFactor))-            else diff state $~ (+ li)+            else diff state $~ ($+ li)  timer :: State -> TimerCallback timer state = do    rot <- get (shouldRotate state)    when rot $ do       ia <- get (inertia state)-      diff state $~ (+ ia)+      diff state $~ ($+ ia)       postRedisplay Nothing    addTimerCallback timerFrequencyMillis (timer state) @@ -297,11 +293,11 @@       unless ("GL_ARB_shading_language_100" `elem` extensions) $          ioError (userError "No GLSL support found.") -readAndCompileShader :: Shader s => FilePath -> IO s-readAndCompileShader filePath = do-   src <- readFile filePath-   [shader] <- genObjectNames 1-   shaderSource shader $= [src]+readAndCompileShader :: ShaderType -> FilePath -> IO Shader+readAndCompileShader st filePath = do+   src <- B.readFile filePath+   shader <- createShader st+   shaderSourceBS shader $= src    compileShader shader    reportErrors    ok <- get (compileStatus shader)@@ -312,10 +308,10 @@       ioError (userError "shader compilation failed")    return shader -installBrickShaders :: [VertexShader] -> [FragmentShader] -> IO ()-installBrickShaders vs fs = do-   [brickProg] <- genObjectNames 1-   attachedShaders brickProg $= (vs, fs)+installBrickShaders :: [Shader] -> IO ()+installBrickShaders shaders = do+   brickProg <- createProgram+   attachedShaders brickProg $= shaders    linkProgram brickProg    reportErrors    ok <- get (linkStatus brickProg)@@ -328,9 +324,9 @@    currentProgram $= Just brickProg     let setUniform var val = do-       location <- get (uniformLocation brickProg var)-       reportErrors-       uniform location $= val+          location <- get (uniformLocation brickProg var)+          reportErrors+          uniform location $= val     setUniform "BrickColor" (Color3 1.0 0.3 (0.2 :: GLfloat))    setUniform "MortarColor" (Color3 0.85 0.86 (0.84 :: GLfloat))@@ -340,10 +336,10 @@  main :: IO () main = do-   getArgsAndInitialize+   _ <- getArgsAndInitialize    initialDisplayMode $= [ RGBMode, WithDepthBuffer, DoubleBuffered ]    initialWindowSize $= Size 500 500-   createWindow "3Dlabs Brick Shader"+   _ <- createWindow "3Dlabs Brick Shader"     -- Note: We don't use an idle callback, we redisplay more intelligently.    state <- makeState@@ -353,13 +349,13 @@    motionCallback $= Just (motion state)    addTimerCallback timerFrequencyMillis (timer state) -   catch+   Control.Exception.catch      (do checkGLSLSupport-         vs <- readAndCompileShader "Brick.vert"-         fs <- readAndCompileShader "Brick.frag"-         installBrickShaders [vs] [fs])+         vs <- readAndCompileShader VertexShader "Brick.vert"+         fs <- readAndCompileShader FragmentShader "Brick.frag"+         installBrickShaders [vs, fs])      (\exception -> do-         print exception+         print (exception :: IOException)          putStrLn "Using fixed function pipeline."          materialDiffuse Front $= Color4 1 0.3 0.2 1          materialSpecular Front $= Color4 0.3 0.3 0.3 1
− examples/RedBook/00-README 
@@ -1,189 +0,0 @@-This file lists the programs that are referenced in the OpenGL Programming-Guide, Fourth Edition, by chapter. For each program, the version of OpenGL-that is required is listed with the program.--Chapter 1: Introduction to OpenGL--        Hello.hs        (1.0)-        Double.hs       (1.0)--Chapter 2: State Management and Drawing Geometric Objects--        Lines.hs        (1.0)-        Polys.hs        (1.0)-        VArray.hs       (1.1)-        MVArray.hs      (1.4)--Chapter 3: Viewing--        Cube.hs         (1.0)-        Model.hs        (1.0)-        Clip.hs         (1.0)-        Planet.hs       (1.0)-        Robot.hs        (1.0)-        UnProject.hs    (1.1)--Chapter 4: Color--        Smooth.hs       (1.0)--Chapter 5: Lighting--        Light.hs        (1.0)-        MoveLight.hs    (1.0)-        Material.hs     (1.0)-        ColorMat.hs     (1.1)-        Scene.hs        (1.0)--Chapter 6: Blending, Antialiasing, Fog, and Polygon Offset--        BlendEqn.hs     (1.3 or ARB_imaging_subset)-        Alpha.hs        (1.0)-        Alpha3D.hs      (1.1)-        AARGB.hs        (1.1)-        AAIndex.hs      (1.1)-        Multisamp.hs    (1.3)-        Fog.hs          (1.0)-        FogIndex.hs     (1.0)-        FogCoord.hs     (1.4)-        PointP.hs       (1.4)-        PolyOff.hs      (1.1)--Chapter 7: Display Lists--        Torus.hs        (1.0)-        DList.hs        (1.0)-        Stroke.hs       (1.0)--Chapter 8: Drawing Pixels, Bitmaps, Fonts, and Images--        DrawF.hs        (1.0)-        Font.hs         (1.0)-        Image.hs        (1.1)-        ColorTable.hs   (ARB_imaging_subset)-        Convolution.hs  (ARB_imaging_subset)-        ColorMatrix.hs  (ARB_imaging_subset)-        Histogram.hs    (ARB_imaging_subset)-        Minmax.hs       (ARB_imaging_subset)--Chapter 9: Texture Mapping--        Checker.hs      (1.0)-        TexSub.hs       (1.1)-        Texture3D.hs    (1.2)-        Mipmap.hs       (1.0)-        TexBind.hs      (1.1)-        TexGen.hs       (1.1)-        CubeMap.hs      (1.3)-        MultiTex.hs     (1.3 or ARB_multitexture)-        Combiner.hs     (1.3)-        ShadowMap.hs    (1.4)-        Wrap.hs         (1.0)-        TexProx.hs      (1.1)--Chapter 10: The Framebuffer--        Stencil.hs      (1.0)-        AccPersp.hs     (1.0)-        AccAnti.hs      (1.0)-        DOF.hs          (1.0)--Chapter 11: Tessellators and Quadrics--        Tess.hs         (1.1)-        TessWind.hs     (1.1)-        Quadric.hs      (1.1)--Chapter 12: Evaluators and NURBS--        BezCurve.hs     (1.1)-        BezSurf.hs      (1.1)-        BezMesh.hs      (1.1)-        TextureSurf.hs  (1.1)-        Surface.hs      (1.1)-        SurfPoints.hs   (1.2)-        Trim.hs         (1.1)--Chapter 13: Selection and Feedback--        Select.hs       (1.1)-        PickSquare.hs   (1.0)-        PickDepth.hs    (1.0)-        Feedback.hs     (1.0)--Chapter 14: Now That You Know--        <No programs included>--Color Plates:--        Teapots.hs      (1.1)--Some remarks regarding the style of the programs:--To ease comparisons, the Haskell programs in this directory try to stay as-close to the original examples in C as possible. Consequently, they should-not be considered as examples for the best way to implement things in-Haskell.--The Haskell OpenGL binding uses overloading quite extensively, which makes-its use quite flexible, e.g.:--   class Vertex a where-      vertex  ::     a -> IO ()-      vertexv :: Ptr a -> IO ()--This single class subsumes all 24 vertex specification calls in OpenGL's C-binding, i.e. glVertex{234}{sifd}[v](), with the help of the following-class and instances:--   class VertexComponent a  -- an opaque class--   VertexComponent GLshort-   VertexComponent GLint-   VertexComponent GLfloat-   VertexComponent GLdouble--   VertexComponent a => Vertex (Vertex2 a)-   VertexComponent a => Vertex (Vertex3 a)-   VertexComponent a => Vertex (Vertex4 a)--There is a small inconvenience with this when used in "toy" programs:-Haskell's numeric literals are overloaded, too, so the programmer's help is-needed to disambiguate the type of expressions like:--   vertex (Vertex3 0 0 1)--Let's assume we mean the equivalent of glVertex3f() here. One can either-use an explicitly typed helper function:--   let vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   in vertex3f (Vertex3 0 0 1)--This comes in handy when there are a lot of uses of vertex3f. An-alternative is to use a type annotation for the literal:--   vertex (Vertex3 0 0 (1 :: GLfloat))--or a type annotation for the vertex:--   vertex (Vertex3 0 0 1 :: Vertex3 GLfloat)--This is largely a matter of taste and normally not a problem in "real"-programs with type signatures for functions.--Sometimes different callbacks need to share some state, which is done via-global variables in the C examples. To achieve a unified presentation, all-Haskell examples use a `State' type for this purpose, which collects the-different parts of the global state, i.e. one or more IORefs. There are-alternatives for modeling this, which should be considered in own programs,-depending on the use cases:-- * Separate IORefs: This makes it explicit which parts of the program need-   which parts of the state.-- * A single IORef/MVar containing all the state: This enables one to change-   the whole state atomically, which is often quite handy in multithreaded-   programs.-- * A custom monad: This can hide all the state threading behind the scenes.
− examples/RedBook/AAIndex.hs 
@@ -1,104 +0,0 @@-{--   AAIndex.hs (adapted from aaindex.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws shows how to draw anti-aliased lines in color index-   mode. It draws two diagonal lines to form an X; when 'r' is typed in the-   window, the lines are rotated in opposite directions.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { rotAngle :: IORef Int }--makeState :: IO State-makeState = do-   r <- newIORef 0-   return $ State { rotAngle = r }--rampSize, ramp1Start, ramp2Start :: GLint-rampSize = 16-ramp1Start = 32-ramp2Start = 48---- Initialize antialiasing for color index mode, including loading a green color--- ramp starting at ramp1Start, and a blue color ramp starting at ramp2Start.--- The ramps must be a multiple of 16.-myInit :: IO ()-myInit = do-   flip mapM_ [ 0 .. rampSize - 1 ] $ \i -> do-      let shade = fromIntegral i / fromIntegral rampSize-      colorMapEntry (Index1 (ramp1Start + i)) $= Color3 0 shade 0-      colorMapEntry (Index1 (ramp2Start + i)) $= Color3 0 0 shade--   lineSmooth $= Enabled-   hint LineSmooth $= DontCare-   lineWidth $= 1.5--   clearIndex $= Index1 (fromIntegral ramp1Start)---- Draw 2 diagonal lines to form an X-display :: State -> DisplayCallback-display state = do-   r <- get (rotAngle state)-   clear [ ColorBuffer ]--   -- resolve overloading, not needed in "real" programs-   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()--   index (Index1 ramp1Start)-   preservingMatrix $ do-      rotate (-(fromIntegral r :: GLfloat)) (Vector3 0 0 0.1)-      renderPrimitive Lines $ do-         vertex2f (Vertex2 (-0.5) 0.5)-         vertex2f (Vertex2 0.5 (-0.5))--   index (Index1 ramp2Start)-   preservingMatrix $ do-      rotate (fromIntegral r :: GLfloat) (Vector3 0 0 0.1)-      renderPrimitive Lines $ do-         vertex2f (Vertex2 0.5 0.5)-         vertex2f (Vertex2 (-0.5) (-0.5))--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D (-1) 1 (-1*hf/wf) (1*hf/wf)-      else ortho2D (-1*wf/hf) (1*wf/hf) (-1) 1-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'r'   -> do rotAngle state  $~ ((`mod` 360) . (+ 30)); postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()---- Main Loop--- Open window with initial window size, title bar,--- color index display mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, IndexMode ]-   initialWindowSize $= Size 200 200-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state-   mainLoop
− examples/RedBook/AARGB.hs 
@@ -1,104 +0,0 @@-{--   AARGB.hs (adapted from aargb.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws shows how to draw anti-aliased lines. It draws two-   diagonal lines to form an X; when 'r' is typed in the window, the lines are-   rotated in opposite directions.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { rotAngle :: IORef Int }--makeState :: IO State-makeState = do-   r <- newIORef 0-   return $ State { rotAngle = r }---- Initialize antialiasing for RGBA mode, including alpha blending, hint, and--- line width. Print out implementation specific info on line width granularity--- and width.-myInit :: IO ()-myInit = do-   g <- get smoothLineWidthGranularity-   putStrLn ("smoothLineWidthGranularity is " ++ show g)--   r <- get smoothLineWidthRange-   putStrLn ("smoothLineWidthRange is " ++ show r)--   lineSmooth $= Enabled--   blend $= Enabled-   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)-   hint LineSmooth $= DontCare-   lineWidth $= 1.5--   clearColor $= Color4 0 0 0 0---- Draw 2 diagonal lines to form an X-display :: State -> DisplayCallback-display state = do-   r <- get (rotAngle state)-   clear [ ColorBuffer ]--   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       vertex2f = vertex :: Vertex2 GLfloat -> IO ()--   color3f (Color3 0 1 0)-   preservingMatrix $ do-      rotate (-(fromIntegral r :: GLfloat)) (Vector3 0 0 0.1)-      renderPrimitive Lines $ do-         vertex2f (Vertex2 (-0.5) 0.5)-         vertex2f (Vertex2 0.5 (-0.5))--   color3f (Color3 0 0 1)-   preservingMatrix $ do-      rotate (fromIntegral r :: GLfloat) (Vector3 0 0 0.1)-      renderPrimitive Lines $ do-         vertex2f (Vertex2 0.5 0.5)-         vertex2f (Vertex2 (-0.5) (-0.5))--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D (-1) 1 (-1*hf/wf) (1*hf/wf)-      else ortho2D (-1*wf/hf) (1*wf/hf) (-1) 1-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'r'   -> do rotAngle state  $~ ((`mod` 360) . (+ 30)); postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()---- Main Loop--- Open window with initial window size, title bar,--- RGBA display mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 200 200-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state-   mainLoop
− examples/RedBook/AccAnti.hs 
@@ -1,132 +0,0 @@-{--   AccAnti.hs (adapted from accanti.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Use the accumulation buffer to do full-scene antialiasing on a scene with-   orthographic parallel projection.--}--import Data.List ( genericLength )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a--- gaussian distribution around the origin. Use these to do model jittering for--- scene anti-aliasing and view volume jittering for depth of field effects. Use--- in conjunction with the accwindow routine.-j8 :: [Vector2 GLdouble]-j8 = [-   Vector2 (-0.334818)   0.435331 ,-   Vector2   0.286438  (-0.393495),-   Vector2   0.459462    0.141540 ,-   Vector2 (-0.414498) (-0.192829),-   Vector2 (-0.183790)   0.082102 ,-   Vector2 (-0.079263) (-0.317383),-   Vector2   0.102254    0.299133 ,-   Vector2   0.164216  (-0.054399) ]---- Initialize lighting and other values.-myInit :: IO ()-myInit = do-   materialAmbient Front $= Color4 1 1 1 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 50-   position (Light 0) $= Vertex4 0 0 10 1-   lightModelAmbient $= Color4 0.2 0.2 0.2 1--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less-   shadeModel $= Flat--   clearColor $= Color4 0 0 0 0-   clearAccum $= Color4 0 0 0 0--displayObjects :: IO ()-displayObjects = do-   -- resolve overloading, not needed in "real" programs-   let translatef = translate :: Vector3 GLfloat -> IO ()-       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()--   preservingMatrix $ do-      rotatef 30 (Vector3 1 0 0)--      preservingMatrix $ do-         translatef (Vector3 (-0.80) 0.35 0)-         rotatef 100 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0.7 0.7 0 1-         renderObject Solid (Torus 0.275 0.85 16 16)--      preservingMatrix $ do-         translatef (Vector3 (-0.75) (-0.50) 0)-         rotatef 45 (Vector3 0 0 1)-         rotatef 45 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0 0.7 0.7 1-         renderObject Solid (Cube 1.5)--      preservingMatrix $ do-         translatef (Vector3 0.75 0.60 0)-         rotatef 30 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0.7 0 0.7 1-         renderObject Solid (Sphere' 1 16 16)--      preservingMatrix $ do-         translatef (Vector3 0.70 (-0.90) 0.25)-         materialDiffuse Front $= Color4 0.7 0.4 0.4 1-         renderObject Solid Octahedron---- display draws 5 teapots into the accumulation buffer several times; each time--- with a jittered perspective. The focal point is at z = 5.0, so the gold--- teapot will stay in focus. The amount of jitter is adjusted by the magnitude--- of the accPerspective jitter; in this example, 0.33. In this example, the--- teapots are drawn 8 times.-display :: DisplayCallback-display = do-   (_, Size w h) <- get viewport-   clear [ AccumBuffer ]--   flip mapM_ j8 $ \(Vector2 x y) -> do-      clear [ ColorBuffer, DepthBuffer ]-      preservingMatrix $ do-         -- Note that 4.5 is the distance in world space between left and right-         -- and bottom and top. This formula converts fractional pixel movement-         -- to world coordinates.-         translate (Vector3 (x*4.5/fromIntegral w) (y*4.5/fromIntegral h) 0)-         displayObjects-      accum Accum (recip (genericLength j8))--   accum Return 1-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-2.25) 2.25 (-2.25*hf/wf) (2.25*hf/wf) (-10) 10-      else ortho (-2.25*wf/hf) (2.25*wf/hf) (-2.25) 2.25 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Be certain to request an accumulation buffer.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/AccPersp.hs 
@@ -1,166 +0,0 @@-{--   AccPersp.hs (adapted from accpersp.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Use the accumulation buffer to do full-scene antialiasing on a scene with-   perspective projection, using the special routines accFrustum and-   accPerspective.--}--import Data.List ( genericLength )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a--- gaussian distribution around the origin. Use these to do model jittering for--- scene anti-aliasing and view volume jittering for depth of field effects. Use--- in conjunction with the accwindow routine.-j8 :: [Vector2 GLdouble]-j8 = [-   Vector2 (-0.334818)   0.435331 ,-   Vector2   0.286438  (-0.393495),-   Vector2   0.459462    0.141540 ,-   Vector2 (-0.414498) (-0.192829),-   Vector2 (-0.183790)   0.082102 ,-   Vector2 (-0.079263) (-0.317383),-   Vector2   0.102254    0.299133 ,-   Vector2   0.164216  (-0.054399) ]---- The first 6 arguments are identical to the frustum call. pixD is anti-alias--- jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD is--- depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field--- effects. focus is distance from eye to plane in focus. focus must be greater--- than, but not equal to 0. Note that accFrustum calls translate. You will--- probably want to insure that your ModelView matrix has been initialized to--- identity before calling accFrustum.-accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble-           -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()-accFrustum left right bottom top zNear zFar-           (Vector2 pixDx pixDy) (Vector2 eyeDx eyeDy) focus = do-   (_, Size w h) <- get viewport-	-   let xWSize = right - left;-       yWSize = top - bottom;-	-       dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)-       dy = -(pixDy * yWSize / fromIntegral h + eyeDy * zNear / focus)-	-   matrixMode $= Projection-   loadIdentity-   frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 (-eyeDx) (-eyeDy) 0)---- The first 4 arguments are identical to the perspective call. pixD is--- anti-alias jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD--- is depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field--- effects. focus is distance from eye to plane in focus. focus must be greater--- than, but not equal to 0. Note that accPerspective calls accFrustum.-accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble-               -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()-accPerspective fovY aspect zNear zFar  pixD eyeD focus = do-   let fov2 = ((fovY * pi) / 180) / 2--       top = zNear / (cos fov2 / sin fov2)-       bottom = -top--       right = top * aspect-       left = -right--   accFrustum left right bottom top zNear zFar pixD eyeD focus---- Initialize lighting and other values.-myInit :: IO ()-myInit = do-   materialAmbient Front $= Color4 1 1 1 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 50-   position (Light 0) $= Vertex4 0 0 10 1-   lightModelAmbient $= Color4 0.2 0.2 0.2 1--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less-   shadeModel $= Flat--   clearColor $= Color4 0 0 0 0-   clearAccum $= Color4 0 0 0 0--displayObjects :: IO ()-displayObjects = do-   -- resolve overloading, not needed in "real" programs-   let translatef = translate :: Vector3 GLfloat -> IO ()-       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()--   preservingMatrix $ do-      translatef (Vector3 0 0 (-5))-      rotatef 30 (Vector3 1 0 0)--      preservingMatrix $ do-         translatef (Vector3 (-0.80) 0.35 0)-         rotatef 100 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0.7 0.7 0 1-         renderObject Solid (Torus 0.275 0.85 16 16)--      preservingMatrix $ do-         translatef (Vector3 (-0.75) (-0.50) 0)-         rotatef 45 (Vector3 0 0 1)-         rotatef 45 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0 0.7 0.7 1-         renderObject Solid (Cube 1.5)--      preservingMatrix $ do-         translatef (Vector3 0.75 0.60 0)-         rotatef 30 (Vector3 1 0 0)-         materialDiffuse Front $= Color4 0.7 0 0.7 1-         renderObject Solid (Sphere' 1 16 16)--      preservingMatrix $ do-         translatef (Vector3 0.70 (-0.90) 0.25)-         materialDiffuse Front $= Color4 0.7 0.4 0.4 1-         renderObject Solid Octahedron---- display draws 5 teapots into the accumulation buffer several times; each time--- with a jittered perspective. The focal point is at z = 5.0, so the gold--- teapot will stay in focus. The amount of jitter is adjusted by the magnitude--- of the accPerspective jitter; in this example, 0.33. In this example, the--- teapots are drawn 8 times.-display :: DisplayCallback-display = do-   (_, Size w h) <- get viewport-   clear [ AccumBuffer ]--   flip mapM_ j8 $ \(Vector2 x y) -> do-      clear [ ColorBuffer, DepthBuffer ]-      accPerspective 50 (fromIntegral w / fromIntegral h) 1 15-                     (Vector2 x y) (Vector2 0 0) 1-      displayObjects-      accum Accum (recip (genericLength j8))--   accum Return 1-   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Be certain you request an accumulation buffer.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Alpha.hs 
@@ -1,91 +0,0 @@-{--   Alpha.hs (adapted from alpha.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws several overlapping filled polygons to demonstrate the-   effect order has on alpha blending results. Use the 't' key to toggle the-   order of drawing polygons.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { leftFirst :: IORef Bool }--makeState :: IO State-makeState = do-   l <- newIORef True-   return $ State { leftFirst = l }---- Initialize alpha blending function.-myInit :: IO ()-myInit = do-   blend $= Enabled-   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)-   shadeModel $= Flat-   clearColor $= Color4 0 0 0 0--drawLeftTriangle :: IO ()-drawLeftTriangle =-   -- draw yellow triangle on LHS of screen-   renderPrimitive Triangles $ do-      color (Color4 1 1 0 (0.75 :: GLfloat))-      vertex (Vertex3 0.1 0.9 (0 :: GLfloat))-      vertex (Vertex3 0.1 0.1 (0 :: GLfloat))-      vertex (Vertex3 0.7 0.5 (0 :: GLfloat))--drawRightTriangle :: IO ()-drawRightTriangle =-   -- draw cyan triangle on RHS of screen-   renderPrimitive Triangles $ do-      color (Color4 0 1 1 (0.75 :: GLfloat))-      vertex (Vertex3 0.9 0.9 (0 :: GLfloat))-      vertex (Vertex3 0.3 0.5 (0 :: GLfloat))-      vertex (Vertex3 0.9 0.1 (0 :: GLfloat))--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   l <- get (leftFirst state)-   if l-      then do drawLeftTriangle; drawRightTriangle-      else do drawRightTriangle; drawLeftTriangle-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D 0 1 0 (hf/wf)-      else ortho2D 0 (wf/hf) 0 1--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   't'   -> do leftFirst state $~ not; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess   -- Escape key-   _     -> return ()-keyboard _ _ _ _ _ = return ()---- Main Loop--- Open window with initial window size, title bar, RGBA display mode, and--- handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 200 200-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state-   mainLoop
− examples/RedBook/Alpha3D.hs 
@@ -1,124 +0,0 @@-{--   Alpha3D.hs (adapted from alpha3D.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates how to intermix opaque and alpha blended polygons-   in the same scene, by using depthMask. Press the 'a' key to animate moving-   the transparent object through the opaque object.  Press the 'r' key to reset-   the scene.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--maxZ, minZ, zInc :: GLfloat-maxZ = 8-minZ = -8-zInc = 0.4---- We don't animate via the idle callback, because this is way too fast on--- modern computers. A timer with the delay below is used instead for redraw.-delay :: Timeout-delay = 100--data State = State { solidZ, transparentZ :: IORef GLfloat }--makeState :: IO State-makeState = do-   s <- newIORef maxZ-   t <- newIORef minZ-   return $ State { solidZ = s, transparentZ = t }--data DisplayLists = DisplayLists { sphereList, cubeList :: DisplayList }--myInit :: IO DisplayLists-myInit = do-   materialSpecular Front $= Color4 1 1 1 0.15-   materialShininess Front $= 100-   position (Light 0) $= Vertex4 0.5 0.5 1 0--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less--   s <- defineNewList Compile $ renderObject Solid (Sphere' 0.4 16 16)-   c <- defineNewList Compile $ renderObject Solid (Cube 0.6)-   return $ DisplayLists { sphereList = s, cubeList = c }--display :: State -> DisplayLists -> DisplayCallback-display state displayLists = do-   clear [ ColorBuffer, DepthBuffer ]--   preservingMatrix $ do-      s <- get (solidZ state)-      translate (Vector3 (-0.15) (-0.15) s)-      materialEmission Front $= Color4 0 0 0 1-      materialDiffuse Front $= Color4 0.75 0.75 0 1-      callList (sphereList displayLists)--   preservingMatrix $ do-      t <- get (transparentZ state)-      translate (Vector3 (0.15) (0.15) t)-      rotate (15 :: GLfloat) (Vector3 1 1 0)-      rotate (30 :: GLfloat) (Vector3 0 1 0)-      materialEmission Front $= Color4 0 0.3 0.3 0.6-      materialDiffuse Front $= Color4 0 0.8 0.8 0.6-      blend $= Enabled-      depthMask $= Disabled-      blendFunc $= (SrcAlpha, One)-      callList (cubeList displayLists)-      depthMask $= Enabled-      blend $= Disabled--   swapBuffers--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-1.5) 1.5 (-1.5*hf/wf) (1.5*hf/wf) (-10) 10-      else ortho (-1.5*wf/hf) (1.5*wf/hf) (-1.5) 1.5 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--animate :: State -> TimerCallback-animate state = do-   s <- get (solidZ state)-   t <- get (transparentZ state)-   if (s <= minZ || t >= maxZ)-      then idleCallback $= Nothing-      else do-         solidZ state $~ (+ (- zInc))-         transparentZ state $~ (+ zInc)-         addTimerCallback delay (animate state)-         postRedisplay Nothing--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'a'   -> do solidZ state $= maxZ; transparentZ state $= minZ; addTimerCallback delay (animate state)-   'r'   -> do solidZ state $= maxZ; transparentZ state $= minZ; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   -- The original C example uses single buffering, which flickers a lot.-   initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   createWindow progName-   state <- makeState-   displayLists <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state displayLists-   mainLoop
− examples/RedBook/BezCurve.hs 
@@ -1,67 +0,0 @@-{--   BezCurve.hs (adapted from bezcurve.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program uses evaluators to draw a Bezier curve.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--ctrlPoints :: [Vertex3 GLfloat]-ctrlPoints = [ Vertex3 (-4)(-4) 0, Vertex3 (-2) 4 0,-               Vertex3   2 (-4) 0, Vertex3   4  4 0 ]--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   m <- newMap1 (0, 1) ctrlPoints-   map1 $= Just (m :: GLmap1 Vertex3 GLfloat)--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 1 1 1)-   renderPrimitive LineStrip $-      mapM_ evalCoord1 [ i/30.0 :: GLfloat | i <- [0..30] ]-   -- The following code displays the control points as dots.-   pointSize $= 5-   color3f (Color3 1 1 0)-   renderPrimitive Points $-      mapM_ vertex ctrlPoints-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-5.0) 5.0 (-5.0*hf/wf) (5.0*hf/wf) (-5.0) 5.0-      else ortho (-5.0*wf/hf) (5.0*wf/hf) (-5.0) 5.0 (-5.0) 5.0-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/BezMesh.hs 
@@ -1,84 +0,0 @@-{--   BezMesh.hs (adapted from bezmesh.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program renders a lighted, filled Bezier surface, using two-dimensional-   evaluators.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Data.List ( transpose )-import Graphics.UI.GLUT--ctrlPoints :: [[Vertex3 GLfloat]]-ctrlPoints = [-   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,-     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],-   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,-     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],-   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,-     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],-   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),-     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]--initlights :: IO ()-initlights = do-   lighting $= Enabled-   light (Light 0) $= Enabled--   ambient  (Light 0) $= Color4 0.2 0.2 0.2 1.0-   position (Light 0) $= Vertex4 0 0 2 1--   materialDiffuse   Front $= Color4 0.6 0.6 0.6 1.0-   materialSpecular  Front $= Color4 1.0 1.0 1.0 1.0-   materialShininess Front $= 50--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (85 :: GLfloat) (Vector3 1 1 1)-      evalMesh2 Fill (0, 20) (0, 20)-   flush--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   depthFunc $= Just Less-   m <- newMap2 (0, 1) (0, 1) (transpose ctrlPoints)-   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)-   autoNormal $= Enabled-   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))-   initlights  -- for lighted version only--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0-      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/BezSurf.hs 
@@ -1,79 +0,0 @@-{--   BezSurf.hs (adapted from bezsurf.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program renders a wireframe Bezier surface, using two-dimensional-   evaluators.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--ctrlPoints :: [[Vertex3 GLfloat]]-ctrlPoints = [-   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,-     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],-   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,-     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],-   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,-     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],-   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),-     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]---- Hey mom, look, it's C!  ;-)-for :: GLfloat -> GLfloat -> (GLfloat -> IO ()) -> IO ()-for s e f = mapM_ f [ i | i <- [ s, if s <= e then s + 1 else s - 1 .. e ] ]--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   color (Color3 1 1 1 :: Color3 GLfloat)-   preservingMatrix $ do-      rotate (85 :: GLfloat) (Vector3 1 1 1)-      for 0 8 $ \j -> do-         renderPrimitive LineStrip $ do-            for 0 30 $ \i -> evalCoord2 (i/30, j/ 8)-         renderPrimitive LineStrip $ do-            for 0 30 $ \i -> evalCoord2 (j/ 8, i/30)-   flush--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   m <- newMap2 (0, 1) (0, 1) ctrlPoints-   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)-   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))-   depthFunc $= Just Less-   shadeModel $= Flat--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0-      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/BlendEqn.hs 
@@ -1,95 +0,0 @@-{--   BlendEqn.hs (adapted from blendeqn.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Demonstrate the different blending functions available with the OpenGL-   imaging subset. This program demonstrates use of blendEquation.--   The following keys change the selected blend equation function:--       'a'  ->  FuncAdd-       's'  ->  FuncSubtract-       'r'  ->  FuncReverseSubtract-       'm'  ->  Min-       'x'  ->  Max--}--import Data.Char ( toLower )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 1 1 0 0-   blendFunc $= (One, One)-   blend $= Enabled--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]--   color (Color3 0 0 (1 :: GLfloat))-   rect (Vertex2 (-0.5) (-0.5)) (Vertex2 0.5 (0.5 :: GLfloat))--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   let aspect = fromIntegral w / fromIntegral h--   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   if aspect < 1-      then let aspect' = recip aspect-           in ortho (-aspect') aspect' (-1) 1 (-1) 1-      else ortho (-1) 1 (-aspect) aspect (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char c) Down _ _ = case toLower c of-   -- Colors are added as: (0, 0, 1) + (1, 1, 0) = (1, 1, 1)-   -- which will produce a white square on a yellow background.-   'a'   -> setBlendEquation FuncAdd--   -- Colors are subtracted as: (0, 0, 1) - (1, 1, 0) = (-1, -1, 1)-   -- which is clamped to (0, 0, 1), producing a blue square on a-   -- yellow background-   's'   -> setBlendEquation FuncSubtract--   -- Colors are subtracted as: (1, 1, 0) - (0, 0, 1) = (1, 1, -1)-   -- which is clamed to (1, 1, 0). This produces yellow for both-   -- the square and the background.-   'r'   -> setBlendEquation FuncReverseSubtract--   -- The minimum of each component is computed, as-   -- [min(0, 1), min(0, 1), min(1, 0)] which equates to (0, 0, 0).-   -- This will produce a black square on the yellow background.-   'm'   -> setBlendEquation Min--   -- The minimum of each component is computed, as-   -- [max(0, 1), max(0, 1), max(1, 0)] which equates to (1, 1, 1)-   -- This will produce a white square on the yellow background.-   'x'   -> setBlendEquation Max--   '\27' -> exitWith ExitSuccess-   _     -> return ()-   where setBlendEquation e = do-            blendEquation $= e-            postRedisplay Nothing-keyboard _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 512 512-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display-   mainLoop
− examples/RedBook/Checker.hs 
@@ -1,101 +0,0 @@-{--   Checker.hs  (adapted from checker.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program texture maps a checkerboard image onto two rectangles.--   Texture objects are only used when GL_EXT_texture_object is supported.--}--import Control.Monad ( when )-import Data.Maybe ( isJust, listToMaybe )-import Data.Bits ( (.&.) )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Create checkerboard image-checkImageSize :: TextureSize2D-checkImageSize = TextureSize2D 64 64--withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))-               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()-withCheckImage (TextureSize2D w h) n f act =-   withArray [ f c |-               i <- [ 0 .. w - 1 ],-               j <- [ 0 .. h - 1 ],-               let c | (i .&. n) == (j .&. n) = 0-                     | otherwise              = 255 ] $-   act. PixelData RGBA UnsignedByte--myInit :: IO (Maybe TextureObject)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less-   rowAlignment Unpack $= 1--   exts <- get glExtensions-   mbTexName <- if "GL_EXT_texture_object" `elem` exts-                   then fmap listToMaybe $ genObjectNames 1-                   else return Nothing-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName--   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   withCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255) $-      texImage2D Nothing NoProxy 0  RGBA' checkImageSize 0-   return mbTexName--display ::  Maybe TextureObject -> DisplayCallback-display mbTexName = do-   clear [ ColorBuffer, DepthBuffer ]-   texture Texture2D $= Enabled-   textureFunction $= Decal-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName--   -- resolve overloading, not needed in "real" programs-   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )--      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))-   flush-   texture Texture2D $= Disabled--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-3.6 :: GLfloat))--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   mbTexName <- myInit-   displayCallback $= display mbTexName-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Clip.hs 
@@ -1,63 +0,0 @@-{--   Clip.hs (adapted from clip.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates arbitrary clipping planes.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()-   color3f (Color3 1 1 1)--   preservingMatrix $ do-      translatef (Vector3 0 0 (-5))--      -- clip lower half -- y < 0-      clipPlane (ClipPlaneName 0) $= Just (Plane 0 1 0 0)-      -- clip left half -- x < 0-      clipPlane (ClipPlaneName 1) $= Just (Plane 1 0 0 0)--      rotatef 90 (Vector3 1 0 0)-      renderObject Wireframe (Sphere' 1 20 16)--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 20-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/ColorMat.hs 
@@ -1,94 +0,0 @@-{--   Light.hs (adapted from light.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   After initialization, the program will be in ColorMaterial mode.-   Interaction: pressing the mouse buttons will change the diffuse-   reflection values.--}--import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { r, g, b :: IORef GLfloat }--diffuseMaterial :: State -> IO (Color4 GLfloat)-diffuseMaterial state = do-   r' <- get (r state)-   g' <- get (g state)-   b' <- get (b state)-   return $ Color4 r' g' b' 1--makeState :: IO State-makeState = do-   r' <- newIORef 0.5-   g' <- newIORef 0.5-   b' <- newIORef 0.5-   return $ State { r = r', g = g', b = b' }---- Initialize material property, light source, lighting model,--- and depth buffer.-myInit :: State -> IO ()-myInit state = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth-   depthFunc $= Just Less-   dm <- diffuseMaterial state-   materialDiffuse Front $= dm-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 25-   position (Light 0) $= Vertex4 1 1 1 0-   lighting $= Enabled-   light (Light 0) $= Enabled-   colorMaterial $= Just (Front, Diffuse)--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   renderObject Solid (Sphere' 1 20 16)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10-      else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--keyboardMouse :: State -> KeyboardMouseCallback-keyboardMouse state (MouseButton button) Down _ _ = case button of-   LeftButton   -> update r-   MiddleButton -> update g-   RightButton  -> update b-   _ -> return ()-   where update component = do-            component state $~ inc-            dm <- diffuseMaterial state-            color dm-            postRedisplay Nothing-         inc x = let s = x + 0.1 in if s > 1 then 0 else s-keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyboardMouse _ _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit state-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboardMouse state)-   mainLoop
− examples/RedBook/ColorMatrix.hs 
@@ -1,65 +0,0 @@-{--   ColorMatrix.hs (adapted from colormatrix.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program uses the color matrix to exchange the color channels of an image.--     Red   -> Green-     Green -> Blue-     Blue  -> Red--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT-import ReadImage--myInit :: IO ()-myInit = do-   m <- newMatrix ColumnMajor [ 0, 1, 0, 0,-                                0, 0, 1, 0,-                                1, 0, 0, 0,-                                0, 0, 0, 1 ]-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0-   matrixMode $= Color-   matrix Nothing $= (m :: GLmatrix GLfloat)-   matrixMode $= Modelview 0--display :: Size -> PixelData a -> DisplayCallback-display size pixels = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 1 1)-   drawPixels size pixels-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, args) <- getArgsAndInitialize-   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= size-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display size pixels-   mainLoop
− examples/RedBook/ColorTable.hs 
@@ -1,62 +0,0 @@-{--   ColorTable.hs (adapted from colortable.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Invert a passed block of pixels.  This program illustrates the use of the-   colorTable function.--}--import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT-import ReadImage--myInit :: IO ()-myInit = do-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0-   -- Set up an inverse color table-   let tableSize = 256-       t = fromIntegral (tableSize - 1) :: GLubyte-   withArray [ Color3 i i i | i <- [ t, t - 1 .. 0 ] ] $ \buf ->-      colorTable NoProxy ColorTable RGB' tableSize (PixelData RGB UnsignedByte buf)-   colorTableStage ColorTableStage $= Enabled--display :: Size -> PixelData a -> DisplayCallback-display size pixels = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 1 1)-   drawPixels size pixels-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, args) <- getArgsAndInitialize-   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= size-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display size pixels-   mainLoop
− examples/RedBook/Combiner.hs 
@@ -1,236 +0,0 @@-{--   Combiner.hs  (adapted from combiner.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program renders a variety of quads showing different effects of-   texture combiner functions.--   The first row renders an untextured polygon (so you can compare the-   fragment colors) and then the 2 textures.--   The second row shows several different combiner functions on a single-   texture: replace, modulate, add, add-signed, and subtract.--   The third row shows the interpolate combiner function on a single texture-   with a constant color/alpha value, varying the amount of interpolation.--   The fourth row uses multitexturing with two textures and different-   combiner functions.--   The fifth row are some combiner experiments: using the scaling factor and-   reversing the order of subtraction for a combination function.--}--import Data.Bits ( (.&.) )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Create checkerboard image-imageSize :: TextureSize2D-imageSize = TextureSize2D 8 8--makeImage :: TextureSize2D -> (GLsizei -> GLsizei -> Color4 GLubyte)-               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()-makeImage (TextureSize2D w h) f act =-   withArray [ f i j |-               i <- [ 0 .. w - 1 ],-               j <- [ 0 .. h - 1 ] ] $-   act . PixelData RGBA UnsignedByte--myInit :: IO (TextureObject, TextureObject, DisplayList)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth--   rowAlignment Unpack $= 1--   [texName0, texName1] <- genObjectNames 2--   textureBinding Texture2D $= Just texName0-   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   -- horiz b & w stripes-   makeImage imageSize (\i _ -> let c = if i .&. 2 == 0 then 255 else 0 in Color4 c c c 255) $-      texImage2D Nothing NoProxy 0  RGBA' imageSize 0--   textureBinding Texture2D $= Just texName1-   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   textureFunction $= Decal-   -- wider vertical 50% cyan and black stripes-   makeImage imageSize (\_ j -> let c = if j .&. 4 /= 0 then 128 else 0 in Color4 0 c c 255) $-      texImage2D Nothing NoProxy 0  RGBA' imageSize 0--   -- smooth-shaded polygon with multiple texture coordinates-   let vert :: TexCoord2 GLfloat -> Color3 GLfloat -> Vertex3 GLfloat -> IO ()-       vert t c v = do-          multiTexCoord (TextureUnit 0) t-          multiTexCoord (TextureUnit 1) t-          color c-          vertex v--   dl <- defineNewList Compile $-      renderPrimitive Quads $ do-         vert (TexCoord2 0 0) (Color3 0.5 1   0.25) (Vertex3 0 0 0)-         vert (TexCoord2 0 2) (Color3 1   1   1   ) (Vertex3 0 1 0)-         vert (TexCoord2 2 2) (Color3 1   1   1   ) (Vertex3 1 1 0)-         vert (TexCoord2 2 0) (Color3 1   0.5 0.25) (Vertex3 1 0 0)--   return (texName0, texName1, dl)--display ::  (TextureObject, TextureObject, DisplayList) -> DisplayCallback-display (texName0, texName1, dl) = do-   clear [ ColorBuffer ]--   let drawAt :: GLfloat -> GLfloat -> IO ()-       drawAt x y = preservingMatrix $ do-                   translate (Vector3 x y 0)-                   callList dl--   -- untextured polygon -- see the "fragment" colors-   texture Texture2D $= Disabled-   drawAt 0 5--   texture Texture2D $= Enabled-   -- draw ordinary textured polys; 1 texture unit; combine mode disabled-   textureFunction $= Modulate-   textureBinding Texture2D $= Just texName0-   drawAt 1 5--   textureBinding Texture2D $= Just texName1-   drawAt 2 5--   -- different combine modes enabled; 1 texture unit-   -- defaults are:-   -- argRGB Arg0 $= Arg SrcColor CurrentUnit-   -- argRGB Arg1 $= Arg SrcColor Previous--   textureBinding Texture2D $= Just texName0-   textureFunction $= Combine-   combineRGB $= Replace'-   argRGB Arg0 $= Arg SrcColor CurrentUnit-   drawAt 1 4--   combineRGB $= Modulate'-   argRGB Arg1 $= Arg SrcColor Previous-   drawAt 2 4--   combineRGB $= AddUnsigned'-   drawAt 3 4--   combineRGB $= AddSigned-   drawAt 4 4--   combineRGB $= Subtract-   drawAt 5 4--   -- interpolate combine with constant color; 1 texture unit-   -- use different alpha values for constant color-   -- defaults are:-   -- argRGB Arg0 $= Arg SrcColor CurrentUnit-   -- argRGB Arg1 $= Arg SrcColor Previous-   -- argRGB Arg2 $= Arg SrcAlpha Constant--   constantColor $= Color4 0 0 0 0.2-   textureBinding Texture2D $= Just texName0-   textureFunction $= Combine-   combineRGB $= Interpolate-   argRGB Arg0 $= Arg SrcColor CurrentUnit-   argRGB Arg1 $= Arg SrcColor Previous-   argRGB Arg2 $= Arg SrcAlpha Constant-   drawAt 1 3--   constantColor $= Color4 0 0 0 0.4-   drawAt 2 3--   constantColor $= Color4 0 0 0 0.6-   drawAt 3 3--   constantColor $= Color4 0 0 0 0.8-   drawAt 4 3--   -- combine textures 0 & 1-   -- defaults are:-   -- argRGB Arg0 $= Arg SrcColor CurrentUnit-   -- argRGB Arg1 $= Arg SrcColor Previous--   activeTexture $= TextureUnit 0-   texture Texture2D $= Enabled-   textureBinding Texture2D $= Just texName0-   textureFunction $= Modulate--   activeTexture $= TextureUnit 1-   texture Texture2D $= Enabled-   textureBinding Texture2D $= Just texName1-   textureFunction $= Combine-   combineRGB $= Replace'-   drawAt 1 2--   -- try different combiner modes of texture unit 1-   combineRGB $= Modulate'-   drawAt 2 2--   combineRGB $= AddUnsigned'-   drawAt 3 2--   combineRGB $= AddSigned-   drawAt 4 2--   combineRGB $= Subtract-   drawAt 5 2--   -- some experiments--   -- see the effect of rgbScale-   rgbScale $= 2-   combineRGB $= Replace'-   drawAt 1 1--   combineRGB $= Modulate'-   drawAt 2 1-   rgbScale $= 1--   -- reverse the order of subtraction Arg1-Arg0--   textureFunction $= Combine-   combineRGB $= Subtract-   argRGB Arg0 $= Arg SrcColor Previous-   argRGB Arg1 $= Arg SrcColor CurrentUnit-   drawAt 5 1--   activeTexture $= TextureUnit 1   -- deactivate multitexturing-   texture Texture2D $= Disabled-   activeTexture $= TextureUnit 0   -- activate single texture unit--   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 7 0 7-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 400 400-   initialWindowPosition $= Position 100 100-   createWindow progName-   texNamesAndDL <- myInit-   displayCallback $= display texNamesAndDL-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Convolution.hs 
@@ -1,83 +0,0 @@-{--   Convolution.hs (adapted from convolution.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Use various 2D convolutions filters to find edges in an image.--}--import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT-import ReadImage--data Filter = Filter String [GLfloat]--filterTable :: [(Key,Filter)]-filterTable = [-   (Char 'h', Filter "horizontal" [ 0, -1, 0,-                                    0,  1, 0,-                                    0,  0, 0 ]),--   (Char 'v', Filter "vertical" [ 0, 0, 0,-                                 -1, 1, 0,-                                  0, 0, 0 ]),--   (Char 'l', Filter "laplacian" [ -0.125, -0.125, -0.125,-                                   -0.125,  1.0  , -0.125,-                                   -0.125, -0.125, -0.125 ])]--setFilter :: Filter -> IO ()-setFilter (Filter filterName filterData) = do-   putStrLn ("Using the " ++ filterName ++ " filter")-   withArray filterData $ \buf ->-      convolutionFilter2D Luminance' (Size 3 3) (PixelData Luminance Float buf)--myInit :: IO ()-myInit = do-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0-   setFilter (snd (head filterTable))-   convolution Convolution2D $= Enabled--display :: Size -> PixelData a -> DisplayCallback-display size pixels = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 1 1)-   drawPixels size pixels-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard key          Down _ _ =-   maybe (return ())-         (\f -> do setFilter f; postRedisplay Nothing)-         (lookup key filterTable)-keyboard _            _    _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, args) <- getArgsAndInitialize-   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)-   initialDisplayMode $= [ SingleBuffered, RGBAMode ]-   initialWindowSize $= size-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display size pixels-   mainLoop
− examples/RedBook/Cube.hs 
@@ -1,56 +0,0 @@-{--   Cube.hs (adapted from cube.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates a single modeling transformation, scale and a-   single viewing transformation, lookAt. A wireframe cube is rendered.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()-   color3f (Color3 1 1 1)-   loadIdentity   -- clear the matrix-   -- viewing transformation-   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)-   scalef 1 2 1   -- modeling transformation-   renderObject Wireframe (Cube 1)-   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   frustum (-1) 1 (-1) 1 1.5 20-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/CubeMap.hs 
@@ -1,118 +0,0 @@-{--   CubeMap.hs  (adapted from CubeMap.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates cube map textures. Six different colored checker-   board textures are created and applied to a lit sphere.--   Pressing the 'f' and 'b' keys translate the viewer forward and backward.--}--import Data.Bits ( (.&.) )-import Data.IORef ( IORef, newIORef )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { zTrans :: IORef GLfloat }--makeState :: IO State-makeState = do-   z <- newIORef 0-   return $ State { zTrans = z }--imageSize :: TextureSize2D-imageSize = TextureSize2D 4 4--withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))-               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()-withCheckImage (TextureSize2D w h) n f act =-   withArray [ f c |-               i <- [ 0 .. w - 1 ],-               j <- [ 0 .. h - 1 ],-               let c | (i .&. n) == (j .&. n) = 0-                     | otherwise              = 255 ] $-   act. PixelData RGBA UnsignedByte--makeImage :: CubeMapTarget -> (GLubyte -> (Color4 GLubyte)) -> IO ()-makeImage target f =-   withCheckImage imageSize 0x1 f $-      texImage2D (Just target) NoProxy 0  RGBA' imageSize 0--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   depthFunc $= Just Less-   shadeModel $= Smooth--   rowAlignment Unpack $= 1-   textureWrapMode TextureCubeMap S $= (Repeated, Repeat)-   textureWrapMode TextureCubeMap T $= (Repeated, Repeat)-   textureWrapMode TextureCubeMap R $= (Repeated, Repeat)-   textureFilter TextureCubeMap $= ((Nearest, Nothing), Nearest)--   makeImage TextureCubeMapPositiveX (\c -> Color4   c c   c 255)-   makeImage TextureCubeMapNegativeX (\c -> Color4   0 c   c 255)-   makeImage TextureCubeMapPositiveY (\c -> Color4   c c   0 255)-   makeImage TextureCubeMapNegativeY (\c -> Color4 255 c   c 255)-   makeImage TextureCubeMapPositiveZ (\c -> Color4   c 0   c 255)-   makeImage TextureCubeMapNegativeZ (\c -> Color4   c c 255 255)--   textureGenMode S $= Just NormalMap-   textureGenMode T $= Just NormalMap-   textureGenMode R $= Just NormalMap--   textureFunction $= Modulate--   texture TextureCubeMap $= Enabled-   lighting $= Enabled-   light (Light 0) $= Enabled-   autoNormal $= Enabled-   normalize $= Enabled-   materialDiffuse Front $= Color4 1 1 1 1--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      z <- get (zTrans state)-      translate (Vector3 0 0 z)-      renderObject Solid (Sphere' 5 20 10)-   swapBuffers--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 40 (fromIntegral w / fromIntegral h) 1 300-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-20 :: GLfloat))--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char 'f')   Down _ _ = move state (-0.2)-keyboard state (Char 'b')   Down _ _ = move state   0.2-keyboard _     (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _     _            _    _ _ = return ()--move :: State -> GLfloat -> IO ()-move state inc = do-   zTrans state $~ (+ inc)-   postRedisplay Nothing--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 400 400-   initialWindowPosition $= Position 50 50-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   mainLoop
− examples/RedBook/DList.hs 
@@ -1,85 +0,0 @@-{--   DList.hs (adapted from list.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates how to make and execute a-   display list.  Note that attributes, such as current-   color and matrix, are changed.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO DisplayList-myInit = do-   [listName] <- genObjectNames 1-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       vertex2f = vertex :: Vertex2 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-   defineList listName Compile $ do-      color3f (Color3 1 0 0) -- current color red-      renderPrimitive Triangles $ do-         vertex2f (Vertex2 0 0)-         vertex2f (Vertex2 1 0)-         vertex2f (Vertex2 0 1)-      translatef (Vector3 1.5 0.0 0.0) -- move position-   shadeModel $= Flat-   return listName--drawLine :: IO ()-drawLine = do-   -- resolve overloading, not needed in "real" programs-   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()-   renderPrimitive Lines $ do-      vertex2f (Vertex2  0.0 0.5)-      vertex2f (Vertex2 15.0 0.5)--display :: DisplayList -> DisplayCallback-display listName = do-   -- NOTE: The following 'loadIdentity' is missing in the original-   -- example, but without it the translatef calls accumulate and-   -- the graphics wander out of the window after a few redraws...-   loadIdentity--   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 0 1 0) -- current color green-   sequence_ (replicate 10 (callList listName)) -- draw 10 triangles-   drawLine -- is this line green? NO!-            -- where is the line drawn?-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D 0.0 2.0 (-0.5*hf/wf) (1.5*hf/wf)-      else ortho2D 0.0 (2.0*wf/hf) (-0.5) 1.5-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Open window with initial window size, title bar,--- RGBA display mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 650 50-   createWindow progName-   listName <- myInit-   reshapeCallback $= Just reshape-   displayCallback $= display listName-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/DOF.hs 
@@ -1,182 +0,0 @@-{--   DOF.hs (adapted from dof.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates use of the accumulation buffer to create an-   out-of-focus depth-of-field effect. The teapots are drawn several times into-   the accumulation buffer. The viewing volume is jittered, except at the focal-   point, where the viewing volume is at the same position, each time. In this-   case, the gold teapot remains in focus.--}--import Data.List ( genericLength )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a--- gaussian distribution around the origin. Use these to do model jittering for--- scene anti-aliasing and view volume jittering for depth of field effects. Use--- in conjunction with the accwindow routine.-j8 :: [Vector2 GLdouble]-j8 = [-   Vector2 (-0.334818)   0.435331 ,-   Vector2   0.286438  (-0.393495),-   Vector2   0.459462    0.141540 ,-   Vector2 (-0.414498) (-0.192829),-   Vector2 (-0.183790)   0.082102 ,-   Vector2 (-0.079263) (-0.317383),-   Vector2   0.102254    0.299133 ,-   Vector2   0.164216  (-0.054399) ]---- The first 6 arguments are identical to the frustum call. pixD is anti-alias--- jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD is--- depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field--- effects. focus is distance from eye to plane in focus. focus must be greater--- than, but not equal to 0. Note that accFrustum calls translate. You will--- probably want to insure that your ModelView matrix has been initialized to--- identity before calling accFrustum.-accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble-           -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()-accFrustum left right bottom top zNear zFar-           (Vector2 pixDx pixDy) (Vector2 eyeDx eyeDy) focus = do-   (_, Size w h) <- get viewport-	-   let xWSize = right - left;-       yWSize = top - bottom;-	-       dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)-       dy = -(pixDy * yWSize / fromIntegral h + eyeDy * zNear / focus)-	-   matrixMode $= Projection-   loadIdentity-   frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 (-eyeDx) (-eyeDy) 0)---- The first 4 arguments are identical to the perspective call. pixD is--- anti-alias jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD--- is depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field--- effects. focus is distance from eye to plane in focus. focus must be greater--- than, but not equal to 0. Note that accPerspective calls accFrustum.-accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble-               -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()-accPerspective fovY aspect zNear zFar  pixD eyeD focus = do-   let fov2 = ((fovY * pi) / 180) / 2--       top = zNear / (cos fov2 / sin fov2)-       bottom = -top--       right = top * aspect-       left = -right--   accFrustum left right bottom top zNear zFar pixD eyeD focus--myInit :: IO DisplayList-myInit = do-   ambient (Light 0) $= Color4 0 0 0 1-   diffuse (Light 0) $= Color4 1 1 1 1-   position (Light 0) $= Vertex4 0 3 3 0--   lightModelAmbient $= Color4 0.2 0.2 0.2 1-   lightModelLocalViewer $= Disabled--   frontFace $= CW-   lighting $= Enabled-   light (Light 0) $= Enabled-   autoNormal $= Enabled-   normalize $= Enabled-   depthFunc $= Just Less--   clearColor $= Color4 0 0 0 0-   clearAccum $= Color4 0 0 0 0-   -- make teapot display list-   defineNewList Compile $-      renderObject Solid (Teapot 0.5)---- Move object into position, specify the material properties, draw a teapot.-renderTeapot :: DisplayList -> Vector3 GLfloat -> Color4 GLfloat-             -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> IO ()-renderTeapot teapotList pos amb dif spec shine =-   preservingMatrix $ do-      translate pos-      materialAmbient Front $= amb-      materialDiffuse Front $= dif-      materialSpecular Front $= spec-      materialShininess Front $= shine * 128-      callList teapotList---- display draws 5 teapots into the accumulation buffer several times; each time--- with a jittered perspective. The focal point is at z = 5.0, so the gold--- teapot will stay in focus. The amount of jitter is adjusted by the magnitude--- of the accPerspective jitter; in this example, 0.33. In this example, the--- teapots are drawn 8 times.-display :: DisplayList -> DisplayCallback-display teapotList = do-   (_, Size w h) <- get viewport-   clear [ AccumBuffer ]--   flip mapM_ j8 $ \(Vector2 x y) -> do-      clear [ ColorBuffer, DepthBuffer ]-      accPerspective 45 (fromIntegral w / fromIntegral h) 1 15-                     (Vector2 0 0) (Vector2 (0.33 * x) (0.33 * y)) 5--      -- ruby, gold, silver, emerald, and cyan teapots-      renderTeapot teapotList-                   (Vector3 (-1.1) (-0.5) (-4.5))-                   (Color4 0.1745     0.01175    0.01175    1)-                   (Color4 0.61424    0.04136    0.04136    1)-                   (Color4 0.727811   0.626959   0.626959   1)-                   0.6-      renderTeapot teapotList-                   (Vector3 (-0.5) (-0.5) (-5.0))-                   (Color4 0.24725    0.1995     0.0745     1)-                   (Color4 0.75164    0.60648    0.22648    1)-                   (Color4 0.628281   0.555802   0.366065   1)-                   0.4-      renderTeapot teapotList-                   (Vector3   0.2  (-0.5) (-5.5))-                   (Color4 0.19225    0.19225    0.19225    1)-                   (Color4 0.50754    0.50754    0.50754    1)-                   (Color4 0.508273   0.508273   0.508273   1)-                   0.4-      renderTeapot teapotList-                   (Vector3   1.0  (-0.5) (-6.0))-                   (Color4 0.0215     0.1745     0.0215     1)-                   (Color4 0.07568    0.61424    0.07568    1)-                   (Color4 0.633      0.727811   0.633      1)-                   0.6-      renderTeapot teapotList-                   (Vector3   1.8  (-0.5) (-6.5))-                   (Color4 0.0        0.1        0.06       1)-                   (Color4 0.0        0.50980392 0.50980392 1)-                   (Color4 0.50196078 0.50196078 0.50196078 1)-                    0.25-      accum Accum (recip (genericLength j8))--   accum Return 1-   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Be certain you request an accumulation buffer.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]-   initialWindowSize $= Size 400 400-   initialWindowPosition $= Position 100 100-   createWindow progName-   teapotList <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display teapotList-   mainLoop
− examples/RedBook/Data/leeds.bin

binary file changed (720605 → absent bytes)

− examples/RedBook/Double.hs 
@@ -1,76 +0,0 @@-{--   Double.hs (adapted from double.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This is a simple double buffered program.-   Pressing the left mouse button rotates the rectangle.-   Pressing the middle mouse button stops the rotation.--}--import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { spin :: IORef GLfloat }--makeState :: IO State-makeState = do-   s <- newIORef 0-   return $ State { spin = s }--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   preservingMatrix $ do-      s <- get (spin state)-      rotate s (Vector3 0 0 1)-      color (Color3 1 1 1 :: Color3 GLfloat)-      rect (Vertex2 (-25) (-25)) (Vertex2 25 25 :: Vertex2 GLfloat)-   swapBuffers--spinDisplay :: State -> IdleCallback-spinDisplay state = do-   let wrap n s = if s > n then s - n else s-   spin state $~ (wrap 360 . (+ 2))-   postRedisplay Nothing--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho (-50) 50 (-50) 50 (-1) 1-   matrixMode $= Modelview 0-   loadIdentity--keyboardMouse :: State -> KeyboardMouseCallback-keyboardMouse state (MouseButton b) Down _ _ =-   idleCallback $= case b of-      LeftButton -> Just (spinDisplay state)-      _ -> Nothing--- ESC not handled in the original example, but useful nevertheless-keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyboardMouse _ _ _ _ _ = return ()----  Request double buffer display mode.---  Register mouse input callback functions-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboardMouse state)-   mainLoop
− examples/RedBook/DrawF.hs 
@@ -1,62 +0,0 @@-{--   DrawF.hs  (adapted from drawf.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Draws the bitmapped letter F on the screen (several times).-   This demonstrates use of the bitmap call.--}--import Foreign ( Ptr, newArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO (Ptr GLubyte)-myInit = do-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0-   newArray [-      0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,-      0xff, 0x00, 0xff, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,-      0xff, 0xc0, 0xff, 0xc0 ]--display :: Ptr GLubyte -> DisplayCallback-display rasters = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   color3f (Color3 1 1 1)-   rasterPos2i (Vertex2 20 20)-   sequence_ $ replicate 3 $-      bitmap (Size 10 12) (Vertex2 0 0) (Vector2 11 0) rasters-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop--- Open window with initial window size, title bar,--- RGBA display mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 100 100-   initialWindowPosition $= Position 100 100-   createWindow progName-   rasters <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display rasters-   mainLoop
− examples/RedBook/Feedback.hs 
@@ -1,77 +0,0 @@-{--   Feedback.hs (adapted from feedback.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates use of OpenGL feedback. First, a lighting-   environment is set up and a few lines are drawn. Then feedback mode is-   entered, and the same lines are drawn. The results in the feedback buffer are-   printed.--}--import Control.Monad ( when )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Initialize lighting.-myInit :: IO ()-myInit = do-   lighting $= Enabled-   light (Light 0) $= Enabled---- Draw a few lines and two points, one of which will be clipped. If in feedback--- mode, a passthrough token is issued between each primitive-drawGeometry :: IO ()-drawGeometry = do-   mode <- get renderMode-   -- resolve overloading, not needed in "real" programs-   let normal3f = normal :: Normal3 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive LineStrip $ do-      normal3f (Normal3 0 0 1)-      vertex3f (Vertex3 30 30 0)-      vertex3f (Vertex3 50 60 0)-      vertex3f (Vertex3 70 40 0)-   when (mode == Feedback) $-      passThrough (PassThroughValue 1)-   renderPrimitive Points $-      vertex3f (Vertex3 (-100) (-100) (-100))   -- will be clipped-   when (mode == Feedback) $-      passThrough (PassThroughValue 2)-   renderPrimitive Points $ do-      normal3f (Normal3 0 0 1)-      vertex3f (Vertex3 50 50 0)-   flush   -- not in original example--printBuffer :: Maybe [FeedbackToken] -> IO ()-printBuffer = maybe (putStrLn "feedback buffer overflow") (mapM_ print)--display :: DisplayCallback-display = do-   matrixMode $= Projection-   loadIdentity-   ortho 0 100 0 100 0 1--   clearColor $= Color4 0 0 0 0-   clear [ ColorBuffer ]-   drawGeometry--   (_, tokens) <- getFeedbackTokens 1024 ThreeDColor drawGeometry-   printBuffer tokens--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 100 100-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Fog.hs 
@@ -1,90 +0,0 @@-{--   Fog.hs (adapted from fog.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws 5 red spheres, each at a different z distance from the-   eye, in different types of fog. Pressing the f key chooses between 3 types-   of fog: exponential, exponential squared, and linear. In this program, there-   is a fixed density value, as well as fixed start and end values for the-   linear fog.--}--import Data.Char ( toLower )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   depthFunc $= Just Less--   position (Light 0) $= Vertex4 0.5 0.5 3.0 0.0-   lighting $= Enabled-   light (Light 0) $= Enabled--   -- NOTE: The alpha values are missing from fog.c!-   materialAmbient   Front $= Color4 0.1745   0.01175  0.01175  1.0-   materialDiffuse   Front $= Color4 0.61424  0.04136  0.04136  1.0-   materialSpecular  Front $= Color4 0.727811 0.626959 0.626959 1.0-   materialShininess Front $= 0.6 * 128--   fog $= Enabled-   let c = Color4 0.5 0.5 0.5 1.0-   fogMode $= Exp 0.35-   fogColor $= c-   hint Fog $= DontCare-   clearColor $= c--renderSpehere :: Vector3 GLfloat -> IO ()-renderSpehere xyz =-   preservingMatrix $ do-      translate xyz-      renderObject Solid (Sphere' 0.4 16 16)---- display draws 5 spheres at different z positions.-display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   mapM_ renderSpehere [ Vector3 x (-0.5) (-3 - x) | x <- [-2 .. 2] ]-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10.0) 10.0-      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10.0) 10.0-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char c) Down _ _ = case toLower c of-   'f'   -> do-      mode <- get fogMode-      case mode of-         Linear _ _    -> do fogMode $= Exp   0.35; putStrLn "Fog mode is Exp"-         Exp _         -> do fogMode $= Exp2  0.35; putStrLn "Fog mode is Exp2"-         Exp2 _        -> do fogMode $= Linear 1 5; putStrLn "Fog mode is Linear"-      postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, depth buffer, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display-   mainLoop
− examples/RedBook/FogCoord.hs 
@@ -1,122 +0,0 @@-{--   FogCoord.hs (adapted from fogcoord.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the use of explicit fog coordinates. You can press-   the keyboard and change the fog coordinate value at any vertex. You can also-   switch between using explicit fog coordinates and the default fog generation-   mode.--   Pressing the 'f' and 'b' keys move the viewer forward and backwards. Pressing-   'c' initiates the default fog generation.  Pressing capital 'C' restores-   explicit fog coordinates.  Pressing '1', '2', '3', '8', '9', and '0' add or-   subtract from the fog coordinate values at one of the three vertices of the-   triangle.--}--import Control.Monad ( when )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { f1, f2, f3 :: IORef (FogCoord1 GLfloat)   }--makeState :: IO State-makeState = do-   f1' <- newIORef (FogCoord1  1)-   f2' <- newIORef (FogCoord1  5)-   f3' <- newIORef (FogCoord1 10)-   return $ State { f1 = f1', f2 = f2', f3 = f3' }---- Initialize fog-myInit :: IO ()-myInit = do-   let theFogColor = Color4 0 0.25 0.25 1-   fog $= Enabled-   fogMode $= Exp 0.25-   fogColor $= theFogColor-   hint Fog $= DontCare-   fogCoordSrc $= FogCoord-   clearColor $= theFogColor--drawTriangle :: State -> (State -> IORef (FogCoord1 GLfloat)) -> Vertex3 GLfloat -> IO ()-drawTriangle state f v = do-   fc <- get (f state)-   fogCoord fc-   vertex v---- display draws a triangle at an angle.-display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]--   color (Color3 1 0.75 (0 :: GLfloat))-   renderPrimitive Triangles $ do-      drawTriangle state f1 (Vertex3   2  (-2)   0 )-      drawTriangle state f2 (Vertex3 (-2)   0  (-5))-      drawTriangle state f3 (Vertex3   0    2 (-10))--   swapBuffers--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 1 0.25 25-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-5 :: GLfloat))--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case c of-   'c'   -> setSrc FragmentDepth-   'C'   -> setSrc FogCoord-   '1'   -> inc f1   0.25-   '2'   -> inc f2   0.25-   '3'   -> inc f3   0.25-   '8'   -> inc f1 (-0.25)-   '9'   -> inc f2 (-0.25)-   '0'   -> inc f3 (-0.25)-   'b'   -> trans  (-0.25)-   'f'   -> trans    0.25-   '\27' -> exitWith ExitSuccess-   _     -> return ()-   where setSrc :: FogCoordSrc -> IO ()-         setSrc s = do-            fogCoordSrc $= s-            postRedisplay Nothing--         inc :: (State -> IORef (FogCoord1 GLfloat)) -> GLfloat -> IO ()-         inc f x = do-            FogCoord1 oldValue <- get (f state)-            let newValue = oldValue + x-            when (newValue > 0) $ do-               f state $= FogCoord1 newValue-               postRedisplay Nothing--         trans :: GLfloat -> IO ()-         trans x = do-            matrixMode $= Modelview 0-            translate (Vector3 0 0 x)-            postRedisplay Nothing-keyboard _ _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state-   mainLoop--
− examples/RedBook/FogIndex.hs 
@@ -1,76 +0,0 @@-{--   FogIndex.hs (adapted from fogindex.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws 5 wireframe spheres, each at a different z distance from-   the eye, in linear fog.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Initialize color map and fog. Set screen clear color to end of color ramp.-numColors, rampStart :: GLint-numColors = 32-rampStart = 16--myInit :: IO ()-myInit = do-   depthFunc $= Just Less--   flip mapM_ [ 0 .. numColors - 1 ] $ \i -> do-      let shade = fromIntegral (numColors - i) / fromIntegral numColors-      colorMapEntry (Index1 (rampStart + i)) $= Color3 shade shade shade-   fog $= Enabled--   fogMode $= Linear 1 6-   fogIndex $= Index1 numColors-   hint Fog $= Nicest-   clearIndex $= Index1 (fromIntegral (numColors + rampStart - 1))--renderSpehere :: Vector3 GLfloat -> IO ()-renderSpehere xyz =-   preservingMatrix $ do-      translate xyz-      renderObject Wireframe (Sphere' 0.4 16 16)---- display draws 5 spheres at different z positions.-display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   index (Index1 rampStart)-   mapM_ renderSpehere [ Vector3 x (-0.5) (-3 - x) | x <- [-2 .. 2] ]-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10.0) 10.0-      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10.0) 10.0-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, color index--- display mode, depth buffer, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, IndexMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display-   mainLoop
− examples/RedBook/Font.hs 
@@ -1,127 +0,0 @@-{--   Font.hs  (adapted from font.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Draws some text in a bitmapped font. Uses bitmap and other pixel routines.-   Also demonstrates use of display lists.--}--import Control.Monad ( zipWithM_ )-import Data.List ( genericDrop, genericLength )-import Foreign.C.String ( castCharToCChar )-import Foreign.Marshal.Array ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--space :: [GLubyte]-space = [-     0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ]--letters :: [[GLubyte]]-letters = [-   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xff, 0xc3, 0xc3, 0xc3, 0x66, 0x3c, 0x18 ],-   [ 0x00, 0x00, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],-   [ 0x00, 0x00, 0x7e, 0xe7, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xe7, 0x7e ],-   [ 0x00, 0x00, 0xfc, 0xce, 0xc7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc7, 0xce, 0xfc ],-   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0xc0, 0xc0, 0xfc, 0xc0, 0xc0, 0xc0, 0xc0, 0xff ],-   [ 0x00, 0x00, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xfc, 0xc0, 0xc0, 0xc0, 0xff ],-   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xcf, 0xc0, 0xc0, 0xc0, 0xc0, 0xe7, 0x7e ],-   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xff, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],-   [ 0x00, 0x00, 0x7e, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x7e ],-   [ 0x00, 0x00, 0x7c, 0xee, 0xc6, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06 ],-   [ 0x00, 0x00, 0xc3, 0xc6, 0xcc, 0xd8, 0xf0, 0xe0, 0xf0, 0xd8, 0xcc, 0xc6, 0xc3 ],-   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0 ],-   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xdb, 0xff, 0xff, 0xe7, 0xc3 ],-   [ 0x00, 0x00, 0xc7, 0xc7, 0xcf, 0xcf, 0xdf, 0xdb, 0xfb, 0xf3, 0xf3, 0xe3, 0xe3 ],-   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xe7, 0x7e ],-   [ 0x00, 0x00, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],-   [ 0x00, 0x00, 0x3f, 0x6e, 0xdf, 0xdb, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0x66, 0x3c ],-   [ 0x00, 0x00, 0xc3, 0xc6, 0xcc, 0xd8, 0xf0, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],-   [ 0x00, 0x00, 0x7e, 0xe7, 0x03, 0x03, 0x07, 0x7e, 0xe0, 0xc0, 0xc0, 0xe7, 0x7e ],-   [ 0x00, 0x00, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0xff ],-   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],-   [ 0x00, 0x00, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],-   [ 0x00, 0x00, 0xc3, 0xe7, 0xff, 0xff, 0xdb, 0xdb, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],-   [ 0x00, 0x00, 0xc3, 0x66, 0x66, 0x3c, 0x3c, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3 ],-   [ 0x00, 0x00, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3 ],-   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0x60, 0x30, 0x7e, 0x0c, 0x06, 0x03, 0x03, 0xff ]]--charToGLubyte :: Char -> GLubyte-charToGLubyte = fromIntegral . castCharToCChar--makeRasterFont :: IO DisplayList-makeRasterFont = do-   rowAlignment Unpack $= 1--   fontDisplayLists@(fontOffset:_) <- genObjectNames 128-   let listsStartingWith ch = genericDrop (charToGLubyte ch) fontDisplayLists-       makeLetter dl letter =-          defineList dl Compile $-             withArray letter $-                bitmap (Size 8 13) (Vertex2 0 2) (Vector2 10 0)--   zipWithM_ makeLetter (listsStartingWith 'A') letters-   makeLetter (head (listsStartingWith ' ')) space-   return fontOffset--myInit :: IO DisplayList-myInit = do-   shadeModel $= Flat-   makeRasterFont--printString :: DisplayList -> String -> IO ()-printString fontOffset s =-   preservingAttrib [ ListAttributes ] $ do-      listBase $= fontOffset-      withArray (map charToGLubyte s) $-         callLists (genericLength s) UnsignedByte---- Everything above this line could be in a library--- that defines a font.  To make it work, you've got--- to call makeRasterFont before you start making--- calls to printString.-display :: DisplayList -> DisplayCallback-display fontOffset = do-   let white = Color3 1 1 1--   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   color3f white--   rasterPos2i (Vertex2 20 60)-   printString fontOffset "THE QUICK BROWN FOX JUMPS"-   rasterPos2i (Vertex2 20 40)-   printString fontOffset "OVER A LAZY DOG"-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop--- Open window with initial window size, title bar,--- RGBA display mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 300 100-   initialWindowPosition $= Position 100 100-   createWindow progName-   fontOffset <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display fontOffset-   mainLoop
− examples/RedBook/Hello.hs 
@@ -1,55 +0,0 @@-{--   Hello.hs (adapted from hello.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This is a simple, introductory OpenGL program.--}--import Graphics.UI.GLUT--display :: DisplayCallback-display = do-   -- clear all pixels-   clear [ ColorBuffer ]--   -- draw white polygon (rectangle) with corners at-   -- (0.25, 0.25, 0.0) and (0.75, 0.75, 0.0)-   color (Color3 1.0 1.0 (1.0 :: GLfloat))-   -- resolve overloading, not needed in "real" programs-   let vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Polygon $ mapM_ vertex3f [-      Vertex3 0.25 0.25 0.0,-      Vertex3 0.75 0.25 0.0,-      Vertex3 0.75 0.75 0.0,-      Vertex3 0.25 0.75 0.0]--   -- don't wait!-   -- start processing buffered OpenGL routines-   flush--myInit :: IO ()-myInit = do-   -- select clearing color-   clearColor $= Color4 0 0 0 0--   -- initialize viewing values-   matrixMode $= Projection-   loadIdentity-   ortho 0 1 0 1 (-1) 1---- Declare initial window size, position, and display mode (single buffer and--- RGBA). Open window with "hello" in its title bar. Call initialization--- routines. Register callback function to display graphics. Enter main loop and--- process events.-main :: IO ()-main = do-   getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow "hello"-   myInit-   displayCallback $= display-   mainLoop
− examples/RedBook/Histogram.hs 
@@ -1,85 +0,0 @@-{--   Histogram.hs (adapted from histogram.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Compute the histogram of the image.  This program illustrates the use of-   the histogram function.--}--import Control.Monad ( zipWithM_ )-import Foreign ( allocaArray, peekArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT-import ReadImage--histogramSize :: Int-histogramSize = 256   -- Must be a power of 2--myInit :: IO ()-myInit = do-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0--   histogram NoProxy $= Just (fromIntegral histogramSize, RGB', PassThrough)--display :: Size -> PixelData a -> DisplayCallback-display size pixels = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 1 1)-   drawPixels size pixels--   values <- allocaArray histogramSize $ \buf -> do-      -- Note: The example in the Red Book uses GL_UNSIGNED_SHORT here,-      -- but we are more honest by using Short...-      getHistogram Reset (PixelData RGB Short buf)-      peekArray histogramSize buf--   -- Plot histogram-   zipWithM_ (plotHistogram values)-             [  Color3 1 0 0,         Color3 0 1 0,         Color3 0 0 1       ]-             [\(Color3 r _ _) -> r, \(Color3 _ g _) -> g, \(Color3 _ _ b) -> b ]-   flush--plotHistogram ::-   [Color3 GLshort] -> Color3 GLfloat -> (Color3 GLshort -> GLshort) -> IO ()-plotHistogram values c selectComponent =-   renderPrimitive LineStrip $ do-      color c-      zipWithM_ (\i h -> vertex (Vertex2 i (selectComponent h))) [ 0 .. ] values--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral histogramSize) 0 10000 (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char 's')   Down _ _ = do-   Just (width, format, sink) <- get (histogram NoProxy)-   let newSink = if sink == Sink then PassThrough else Sink-   histogram NoProxy $= Just (width, format, newSink)-   postRedisplay Nothing-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, args) <- getArgsAndInitialize-   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= size-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display size pixels-   mainLoop
− examples/RedBook/Image.hs 
@@ -1,116 +0,0 @@-{--   Image.hs  (adapted from image.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates drawing pixels and shows the effect of-   drawPixels, copyPixels, and pixelZoom.--   Interaction: moving the mouse while pressing the mouse button will copy-   the image in the lower-left corner of the window to the mouse position,-   using the current pixel zoom factors. There is no attempt to prevent you-   from drawing over the original image. If you press the 'r' key, the-   original image and zoom factors are reset. If you press the 'z' or 'Z'-   keys, you change the zoom factors.--}--import Data.Bits ( (.&.) )-import Data.IORef ( IORef, newIORef )-import Foreign ( newArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { zoomFactor :: IORef GLfloat }--makeState :: IO State-makeState = do-   z <- newIORef 1-   return $ State { zoomFactor = z }---- Create checkerboard image-checkImageSize :: Size-checkImageSize = Size 64 64--type Image = PixelData (Color3 GLubyte)--makeCheckImage :: Size -> GLsizei -> (GLubyte -> (Color3 GLubyte)) -> IO Image-makeCheckImage (Size w h) n f =-   fmap (PixelData RGB UnsignedByte) $-      newArray [ f c |-                 i <- [ 0 .. w - 1 ],-                 j <- [ 0 .. h - 1 ],-                 let c | (i .&. n) == (j .&. n) = 0-                       | otherwise              = 255 ]--myInit :: IO Image-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   rowAlignment Unpack $= 1-   makeCheckImage checkImageSize 0x8 (\c -> Color3 c c c)--display ::  Image -> DisplayCallback-display pixelData = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 0 0)-   drawPixels checkImageSize pixelData-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   matrixMode $= Modelview 0-   loadIdentity--motion :: State -> MotionCallback-motion state (Position x y) = do-   Size _ height <- get windowSize-   let screenY = height - y-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 x screenY)-   z <- get (zoomFactor state)-   pixelZoom $= (z, z)-   copyPixels (Position 0 0) checkImageSize CopyColor-   pixelZoom $= (1, 1)-   flush--resetZoomFactor :: State -> IO ()-resetZoomFactor state = do-   zoomFactor state $= 1.0-   postRedisplay Nothing-   putStrLn "zoomFactor reset to 1.0"--incZoomFactor :: State -> GLfloat -> IO ()-incZoomFactor state inc = do-   zoomFactor state $~! (max 0.5 . min 3.0 . (+ inc))-   get (zoomFactor state) >>= putStrLn . ("zoomFactor is now " ++) . show--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char 'r')   Down _   _ = resetZoomFactor state-keyboard state (Char 'R')   Down _   _ = resetZoomFactor state-keyboard state (Char 'z')   Down _   _ = incZoomFactor   state   0.5-keyboard state (Char 'Z')   Down _   _ = incZoomFactor   state (-0.5)-keyboard _     (Char '\27') Down _   _ = exitWith ExitSuccess-keyboard _     _            _    _   _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   checkImage <- myInit-   displayCallback $= display checkImage-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   motionCallback $= Just (motion state)-   mainLoop
− examples/RedBook/Light.hs 
@@ -1,62 +0,0 @@-{--   Light.hs (adapted from light.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the use of the OpenGL lighting model. A sphere-   is drawn using a grey material characteristic. A single light source-   illuminates the object.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth--   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 50-   position (Light 0) $= Vertex4 1 1 1 0--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   renderObject Solid (Sphere' 1 20 16)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10-      else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Lines.hs 
@@ -1,88 +0,0 @@-{--   Lines.hs (adapted from lines.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates geometric primitives and their attributes.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--drawOneLine :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()-drawOneLine p1 p2 = renderPrimitive Lines $ do vertex p1; vertex p2--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   -- select white for all lines-   color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)--   -- in 1st row, 3 lines, each with a different stipple-   lineStipple $= Just (1, 0x0101)  --  dotted-   drawOneLine (Vertex2  50 125) (Vertex2 150 125)-   lineStipple $= Just (1, 0x00FF)  --  dashed-   drawOneLine (Vertex2 150 125) (Vertex2  50 125)-   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash-   drawOneLine (Vertex2 250 125) (Vertex2 350 125)--   -- in 2nd row, 3 wide lines, each with different stipple-   lineWidth $= 5.0-   lineStipple $= Just (1, 0x0101)  --  dotted-   drawOneLine (Vertex2  50 100) (Vertex2 150 100)-   lineStipple $= Just (1, 0x00FF)  --  dashed-   drawOneLine (Vertex2 150 100) (Vertex2 250 100)-   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash-   drawOneLine (Vertex2 250 100) (Vertex2 350 100)-   lineWidth $= 1.0--   -- in 3rd row, 6 lines, with dash/dot/dash stipple-   -- as part of a single connected line strip-   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash-   renderPrimitive LineStrip $ mapM_ vertex [ Vertex2 (50+(i*50)) (75 :: GLint) | i <- [0..6] ]--   -- in 4th row, 6 independent lines with same stipple-   sequence_ [ drawOneLine (Vertex2 (50+( i   *50)) 50)-                           (Vertex2 (50+((i+1)*50)) 50) | i <- [0..5] ]--   -- in 5th row, 1 line, with dash/dot/dash stipple-   -- and a stipple repeat factor of 5-   lineStipple $= Just (5, 0x1C47)  --  dash/dot/dash-   drawOneLine (Vertex2 50 25) (Vertex2 350 25)--   lineStipple $= Nothing-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   -- the following line is not in the original example, but it's good style...-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _ _ _ _ = return ()----  Request double buffer display mode.---  Register mouse input callback functions-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 400 150-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/MVArray.hs 
@@ -1,87 +0,0 @@-{--   MVArray.hs (adapted from mvarray.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates multiple vertex arrays, specifically the OpenGL-   routine multiDrawElements.--}--import Control.Monad ( unless )-import Data.List ( genericLength )-import Foreign ( Storable, Ptr, newArray )-import System.Exit ( exitFailure, exitWith, ExitCode(..) )-import Graphics.UI.GLUT--data MultiDrawInfo a = MultiDrawInfo (Ptr GLsizei) (Ptr (Ptr a)) GLsizei--makeMultiDrawInfo :: Storable a => [[a]] -> IO (MultiDrawInfo a)-makeMultiDrawInfo indicesLists = do-   count <- newArray $ map genericLength indicesLists-   indices <- newArray =<< mapM newArray indicesLists-   return $ MultiDrawInfo count indices (genericLength indicesLists)--setupPointer :: IO ()-setupPointer = do-   clientState VertexArray $= Enabled-   vertices <- newArray ([-      Vertex2  25 25,-      Vertex2  75 75,-      Vertex2 100 125,-      Vertex2 150  75,-      Vertex2 200 175,-      Vertex2 250 150,-      Vertex2 300 125,-      Vertex2 100 200,-      Vertex2 150 250,-      Vertex2 200 225,-      Vertex2 250 300,-      Vertex2 300 250 ] :: [Vertex2 GLint])-   arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 vertices--myInit :: IO (MultiDrawInfo GLubyte)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth-   setupPointer-   makeMultiDrawInfo [ [ 0, 1, 2, 3, 4, 5, 6 ],-                       [ 1, 7, 8, 9, 10, 11 ] ]--display :: MultiDrawInfo GLubyte -> DisplayCallback-display (MultiDrawInfo count indices primCount) = do-   clear [ ColorBuffer ]-   color (Color3 1 1 1 :: Color3 GLfloat)-   multiDrawElements LineStrip count UnsignedByte indices primCount-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   -- the following line is not in the original example, but it's good style...-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 350 350-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   exts <- get glExtensions-   unless ("GL_EXT_multi_draw_arrays" `elem` exts) $ do-      putStrLn "Sorry, this demo requires the GL_EXT_multi_draw_arrays extension."-      exitFailure-   multiDrawInfo <- myInit-   displayCallback $= display multiDrawInfo-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Material.hs 
@@ -1,149 +0,0 @@-{--   Material.hs (adapted from material.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the use of the GL lighting model. Several-   objects are drawn using different material characteristics. A single-   light source illuminates the objects.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Initialize z-buffer, projection matrix, light source, and lighting model.--- Do not specify a material property here.--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0.1 0.1 0-   depthFunc $= Just Less-   shadeModel $= Smooth--   ambient (Light 0) $= Color4 0 0 0 1-   diffuse (Light 0) $= Color4 1 1 1 1-   position (Light 0) $= Vertex4 0 3 2 0-   lightModelAmbient $= Color4 0.4 0.4 0.4 1-   lightModelLocalViewer $= Disabled--   lighting $= Enabled-   light (Light 0) $= Enabled---- Draw twelve spheres in 3 rows with 4 columns.--- The spheres in the first row have materials with no ambient reflection.--- The second row has materials with significant ambient reflection.--- The third row has materials with colored ambient reflection.------ The first column has materials with blue, diffuse reflection only.--- The second column has blue diffuse reflection, as well as specular--- reflection with a low shininess exponent.--- The third column has blue diffuse reflection, as well as specular--- reflection with a high shininess exponent (a more concentrated highlight).--- The fourth column has materials which also include an emissive component.------ translate is used to move spheres to their appropriate locations.--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]--   let draw :: GLfloat -> GLfloat -> Color4 GLfloat -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> Color4 GLfloat -> IO ()-       draw row column amb dif spc shi emi =-          preservingMatrix $ do-             translate (Vector3 (2.5 * (column - 2.5)) (3 * (2 - row)) 0)-             materialAmbient   Front $= amb-             materialDiffuse   Front $= dif-             materialSpecular  Front $= spc-             materialShininess Front $= shi-             materialEmission  Front $= emi-             renderObject Solid (Sphere' 1 16 16)--       noMat           = Color4 0 0 0 1-       matAmbient      = Color4 0.7 0.7 0.7 1-       matAmbientColor = Color4 0.8 0.8 0.2 1-       matDiffuse      = Color4 0.1 0.5 0.8 1-       matSpecular     = Color4 1 1 1 1-       noShininess     = 0-       lowShininess    = 5-       highShininess   = 100-       matEmission     = Color4 0.3 0.2 0.2 0--   -- draw sphere in first row, first column-   -- diffuse reflection only; no ambient or specular-   draw 1 1 noMat matDiffuse noMat noShininess noMat--   -- draw sphere in first row, second column-   -- diffuse and specular reflection; low shininess; no ambient-   draw 1 2 noMat matDiffuse matSpecular lowShininess noMat--   -- draw sphere in first row, third column-   -- diffuse and specular reflection; high shininess; no ambient-   draw 1 3 noMat matDiffuse matSpecular highShininess noMat--   -- draw sphere in first row, fourth column-   -- diffuse reflection; emission; no ambient or specular reflection-   draw 1 4 noMat matDiffuse noMat noShininess matEmission--   -- draw sphere in second row, first column-   -- ambient and diffuse reflection; no specular-   draw 2 1 matAmbient matDiffuse noMat noShininess noMat--   -- draw sphere in second row, second column-   -- ambient, diffuse and specular reflection; low shininess-   draw 2 2 matAmbient matDiffuse matSpecular lowShininess noMat--   -- draw sphere in second row, third column-   -- ambient, diffuse and specular reflection; high shininess-   draw 2 3 matAmbient matDiffuse matSpecular highShininess noMat--   -- draw sphere in second row, fourth column-   -- ambient and diffuse reflection; emission; no specular-   draw 2 4 matAmbient matDiffuse noMat noShininess matEmission--   -- draw sphere in third row, first column-   -- colored ambient and diffuse reflection; no specular-   draw 3 1 matAmbientColor matDiffuse noMat noShininess noMat--   -- draw sphere in third row, second column-   -- colored ambient, diffuse and specular reflection; low shininess-   draw 3 2 matAmbientColor matDiffuse matSpecular lowShininess noMat--   -- draw sphere in third row, third column-   -- colored ambient, diffuse and specular reflection; high shininess-   draw 3 3 matAmbientColor matDiffuse matSpecular highShininess noMat--   -- draw sphere in third row, fourth column-   -- colored ambient and diffuse reflection; emission; no specular-   draw 3 4 matAmbientColor matDiffuse noMat noShininess matEmission--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h * 2-      then ortho (-6) 6 (-3 * (hf * 2) / wf) (3 * (hf * 2) / wf) (-10) 10-      else ortho (-6 * wf / (hf * 2)) (6 * wf / (hf * 2)) (-3) 3 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 600 450-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Minmax.hs 
@@ -1,64 +0,0 @@-{--   Minmax.hs (adapted from minmax.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Determine the minimum and maximum values of a group of pixels. This-   demonstrates use of the minmax function.--}--import Foreign ( allocaArray, peekArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT-import ReadImage--myInit :: IO ()-myInit = do-   rowAlignment Unpack $= 1-   clearColor $= Color4 0 0 0 0-   minmax $= Just (RGB', PassThrough)--display :: Size -> PixelData a -> DisplayCallback-display size pixels = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()-   rasterPos2i (Vertex2 1 1)-   drawPixels size pixels-   flush--   [Color3 minR minG minB, Color3 maxR maxG maxB] <- allocaArray 2 $ \buf -> do-      getMinmax Reset (PixelData RGB UnsignedByte buf)-      peekArray 2 buf :: IO [Color3 GLubyte]-   putStrLn (" Red   : min = " ++ show minR ++ "   max = " ++ show maxR)-   putStrLn (" Green : min = " ++ show minG ++ "   max = " ++ show maxG)-   putStrLn (" Blue  : min = " ++ show minB ++ "   max = " ++ show maxB)--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, args) <- getArgsAndInitialize-   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= size-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display size pixels-   mainLoop
− examples/RedBook/Mipmap.hs 
@@ -1,97 +0,0 @@-{--   Mipmap.hs  (adapted from mipmap.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates using mipmaps for texture maps. To overtly show-   the effect of mipmaps, each mipmap reduction level has a solidly colored,-   contrasting texture image. Thus, the quadrilateral which is drawn is drawn-   with several different colors.--}--import Control.Monad ( when )-import Data.Maybe ( isJust, listToMaybe )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--makeImage :: Level -> TextureSize2D -> Color4 GLubyte -> IO ()-makeImage level size@(TextureSize2D w h) col =-   withArray (replicate (fromIntegral (w * h)) col) $-      texImage2D Nothing NoProxy level RGBA' size 0 . PixelData RGBA UnsignedByte--makeImages :: [Color4 GLubyte] -> IO ()-makeImages colors = sequence_ $ zipWith3 makeImage levels sizes colors-   where numLevels = length colors-         levels = [ 0 .. fromIntegral numLevels - 1 ]-         sizes = reverse (take numLevels [ TextureSize2D s s | s <- iterate (* 2) 1 ])--myInit :: IO (Maybe TextureObject)-myInit = do-   depthFunc $= Just Less-   shadeModel $= Flat--   translate (Vector3 0 0 (-3.6 :: GLfloat))-   rowAlignment Unpack $= 1--   exts <- get glExtensions-   mbTexName <- if "GL_EXT_texture_object" `elem` exts-                   then fmap listToMaybe $ genObjectNames 1-                   else return Nothing-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName--   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest)--   makeImages [ Color4 255 255   0 255,-                Color4 255   0 255 255,-                Color4 255   0   0 255,-                Color4   0 255   0 255,-                Color4   0   0 255 255,-                Color4 255 255 255 255 ]--   textureFunction $= Decal-   texture Texture2D $= Enabled-   return mbTexName--display :: Maybe TextureObject -> DisplayCallback-display mbTexName = do-   clear [ ColorBuffer, DepthBuffer ]-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName-   -- resolve overloading, not needed in "real" programs-   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (  -2) (-1)      0 )-      texCoord2f (TexCoord2 0 8); vertex3f (Vertex3 (  -2)   1       0 )-      texCoord2f (TexCoord2 8 8); vertex3f (Vertex3  2000    1  (-6000))-      texCoord2f (TexCoord2 8 0); vertex3f (Vertex3  2000  (-1) (-6000))-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30000-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 50 50-   createWindow progName-   texName <- myInit-   displayCallback $= display texName-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Model.hs 
@@ -1,86 +0,0 @@-{--   Model.hs (adapted from model.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates modeling transformations.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--drawTriangle :: IO ()-drawTriangle = do-   -- resolve overloading, not needed in "real" programs-   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()-   renderPrimitive LineLoop $ do-      vertex2f (Vertex2    0    25 )-      vertex2f (Vertex2   25  (-25))-      vertex2f (Vertex2 (-25) (-25))--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()-       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()-   color3f (Color3 1 1 1)--   loadIdentity-   color3f (Color3 1 1 1)-   drawTriangle--   lineStipple $= Just (1, 0xF0F0)-   loadIdentity-   translatef (Vector3 (-20) 0 0)-   drawTriangle--   lineStipple $= Just (1, 0xF00F)-   loadIdentity-   scalef 1.5 0.5 1.0-   drawTriangle--   lineStipple $= Just (1, 0x8888)-   loadIdentity-   rotatef 90 (Vector3 0 0 1)-   drawTriangle-   lineStipple $= Nothing--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-50) 50 (-50 * hf/wf) (50 * hf/wf) (-1) 1-      else ortho (-50 * wf/hf) (50 * wf/hf) (-50) 50 (-1) 1-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/MoveLight.hs 
@@ -1,85 +0,0 @@-{--   MoveLight.hs (adapted from movelight.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates when to issue lighting and transformation-   commands to render a model with a light which is moved by a-   modeling transformation (rotate or translate). The light position-   is reset after the modeling transformation is called. The eye-   position does not change.--   A sphere is drawn using a grey material characteristic. A single-   light source illuminates the object.--   Interaction: pressing the left mouse button alters the modeling-   transformation (x rotation) by 30 degrees. The scene is then-   redrawn with the light in a new position.--}--import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { spin :: IORef Int }--makeState :: IO State-makeState = do-   s <- newIORef 0-   return $ State { spin = s }--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth-   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)-      preservingMatrix $ do-         s <- get (spin state)-         rotate (fromIntegral s :: GLdouble) (Vector3 1 0 0)-         position (Light 0) $= Vertex4 0 0 1.5 1-         translate (Vector3 0 0 1.5 :: Vector3 GLdouble)-         lighting $= Disabled-         color (Color3 0 1 1 :: Color3 GLfloat)-         renderObject Wireframe (Cube 0.1)-         lighting $= Enabled-      renderObject Solid (Torus 0.275 0.85 8 15)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 40 (fromIntegral w / fromIntegral h) 1 20-   matrixMode $= Modelview 0-   loadIdentity--keyboardMouse :: State -> KeyboardMouseCallback-keyboardMouse state (MouseButton LeftButton) Down _ _ = do-   spin state $~ ((`mod` 360) . (+ 30))-   postRedisplay Nothing-keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyboardMouse _ _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboardMouse state)-   mainLoop
− examples/RedBook/MultiTex.hs 
@@ -1,109 +0,0 @@-{--   MultiTex.hs  (adapted from multitex.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--}--import Control.Monad ( unless )-import Foreign ( withArray )-import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--specifyTexture :: TextureSize2D -> (GLubyte -> GLubyte -> Color4 GLubyte) -> IO ()-specifyTexture size@(TextureSize2D w h) f =-   withArray [ f i j | i <- [ 0 .. fromIntegral w - 1 ],-                       j <- [ 0 .. fromIntegral h - 1] ] $-      texImage2D Nothing NoProxy 0 RGBA' size 0 . PixelData RGBA UnsignedByte--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less-   rowAlignment Unpack $= 1--   [texName0, texName1] <- genObjectNames 2-   textureBinding Texture2D $= Just texName0-   -- Note: We use much brighter colors than in the original example where-   -- everything was almost black.-   specifyTexture (TextureSize2D 32 32) (\i j -> Color4 (i*8) (j*8) ((i*j) `div` 4) 255)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)--   textureBinding Texture2D $= Just texName1-   specifyTexture (TextureSize2D 16 16) (\i j -> Color4 255 (i*16) (j*16) 255)-   textureFilter Texture2D $= ((Linear', Nothing), Linear')-   textureWrapMode Texture2D S $= (Repeated, ClampToEdge)-   textureWrapMode Texture2D T $= (Repeated, ClampToEdge)-   -- Use the two texture objects to define two texture units-   -- for use in multitexturing-   activeTexture $= TextureUnit 0-   texture Texture2D $= Enabled-   textureBinding Texture2D $= Just texName0-   textureFunction $= Replace-   matrixMode $= Texture-   loadIdentity-   translate (Vector3 0.5 0.5 (0 :: GLfloat))-   rotate (45 :: GLfloat) (Vector3 0 0 1)-   translate (Vector3 (-0.5) (-0.5) (0 :: GLfloat))-   matrixMode $= Modelview 0-   activeTexture $= TextureUnit 1-   texture Texture2D $= Enabled-   textureBinding Texture2D $= Just texName1-   textureFunction $= Modulate--display ::  DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   -- resolve overloading, not needed in "real" programs-   let multiTexCoord2f = multiTexCoord :: TextureUnit -> TexCoord2 GLfloat -> IO ()-       vertex2f = vertex :: Vertex2 GLfloat -> IO ()-   renderPrimitive Triangles $ do-      multiTexCoord2f (TextureUnit 0) (TexCoord2 0   0)-      multiTexCoord2f (TextureUnit 1) (TexCoord2 1   0)-      vertex2f (Vertex2 0 0)-      multiTexCoord2f (TextureUnit 0) (TexCoord2 0.5 1)-      multiTexCoord2f (TextureUnit 1) (TexCoord2 0.5 0)-      vertex2f (Vertex2 50 100)-      multiTexCoord2f (TextureUnit 0) (TexCoord2 1   0)-      multiTexCoord2f (TextureUnit 1) (TexCoord2 1   1)-      vertex2f (Vertex2 100 0)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D 0 100 0 (100*hf/wf)-      else ortho2D 0 (100*wf/hf) 0 100-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   exts <- get glExtensions-   unless ("GL_ARB_multitexture"   `elem` exts &&-           "GL_EXT_texture_object" `elem` exts) $ do-      putStrLn "Sorry, this demo requires the GL_ARB_multitexture and GL_EXT_texture_object extensions."-      exitFailure-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Multisamp.hs 
@@ -1,137 +0,0 @@-{--   Multisamp.hs (adapted from multisamp.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws shows how to use multisampling to draw anti-aliased-   geometric primitives. The same display list, a pinwheel of triangles and-   lines of varying widths, is rendered twice. Multisampling is enabled when the-   left side is drawn. Multisampling is disabled when the right side is drawn.--   Pressing the 'b' key toggles drawing of the checkerboard background.-   Antialiasing is sometimes easier to see when objects are rendered over a-   contrasting background.--}--import Control.Monad ( when )-import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { bgToggle :: IORef Bool }--makeState :: IO State-makeState = do-   b <- newIORef True-   return $ State { bgToggle = b }--data DisplayLists = DisplayLists { pinwheelList, backgroundList :: DisplayList }---- Print out state values related to multisampling. Create display list with--- "pinwheel" of lines and triangles.-myInit :: IO DisplayLists-myInit = do-   clearColor $= Color4 0 0 0 0-   sb <- get sampleBuffers-   putStrLn ("number of sample buffers is " ++ show sb)-   s <- get samples-   putStrLn ("number of samples is " ++ show s)--   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       vertex2f = vertex :: Vertex2 GLfloat -> IO ()--   p <- defineNewList Compile $ do-      flip mapM_ [ 0 .. 18 ] $ \i ->-         preservingMatrix $ do-            rotate (360 * fromIntegral i / 19 :: GLfloat) (Vector3 0 0 1)-            color3f (Color3 1 1 1)-            lineWidth $= fromIntegral ((i `mod` 3 :: Int) + 1)-            renderPrimitive Lines $ do-              vertex2f (Vertex2 0.25 0.05)-              vertex2f (Vertex2 0.9 0.2)-            color3f (Color3 0 1 1)-            renderPrimitive Triangles $ do-               vertex2f (Vertex2 0.25 0)-               vertex2f (Vertex2 0.9 0)-               vertex2f (Vertex2 0.875 0.1)--   b <- defineNewList Compile $ do-      color3f (Color3 1 0.5 0)-      renderPrimitive Quads $-         flip mapM_ [ 0 .. 15 ] $ \i ->-            flip mapM_ [ 0 .. 15 ] $ \j ->-               when (((i + j) `mod` 2 :: Int) == 0) $ do-                  let ii = fromIntegral i * 0.25-                      jj = fromIntegral j * 0.25-                  vertex2f (Vertex2 (-2.0  + ii) (-2.0  + jj))-                  vertex2f (Vertex2 (-2.0  + ii) (-1.75 + jj))-                  vertex2f (Vertex2 (-1.75 + ii) (-1.75 + jj))-                  vertex2f (Vertex2 (-1.75 + ii) (-2.0  + jj))--   return $ DisplayLists { pinwheelList = p, backgroundList = b }---- Draw two sets of primitives, so that you can compare the user of--- multisampling against its absence.------ This code enables antialiasing and draws one display list and disables and--- draws the other display list-display :: State -> DisplayLists -> DisplayCallback-display state displayLists = do-   clear [ ColorBuffer ]--   t <- get (bgToggle state)-   when t $-      callList (backgroundList displayLists)--   -- resolve overloading, not needed in "real" programs-   let translatef = translate :: Vector3 GLfloat -> IO ()--   multisample $= Enabled-   preservingMatrix $ do-      translatef (Vector3 (-1) 0 0)-      callList (pinwheelList displayLists)--   multisample $= Disabled-   preservingMatrix $ do-      translatef (Vector3 1 0 0)-      callList (pinwheelList displayLists)--   swapBuffers--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= 2 * h-      then ortho2D (-2) 2 (-2*hf/wf) (2*hf/wf)-      else ortho2D (-2*wf/hf) (2*wf/hf) (-2) 2-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'b'   -> do bgToggle state $~ not; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode, Multisampling ]-   initialWindowSize $= Size 600 300-   createWindow progName-   state <- makeState-   displayLists <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state displayLists-   mainLoop
− examples/RedBook/PickDepth.hs 
@@ -1,126 +0,0 @@-{--   PickDepth.hs (adapted from pickdepth.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Picking is demonstrated in this program. In rendering mode, three-   overlapping rectangles are drawn. When the left mouse button is pressed,-   selection mode is entered with the picking matrix. Rectangles which are drawn-   under the cursor position are "picked." Pay special attention to the depth-   value range, which is returned.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   depthFunc $= Just Less-   shadeModel $= Flat-   depthRange $= (0, 1)   -- The default z mapping---- The nine squares are drawn. Each square is given two names: one for the row--- and the other for the column on the grid. The color of each square is--- determined by its position on the grid, and the value in the board array.--- Note: In contrast to the the original example, we always give names to--- squares, regardless of the render mode. This simplifies the code a bit and--- is even suggested by the Red Book.---- The three rectangles are drawn, each with a different name. Note that each--- rectangle is drawn with a different z value. Note: In contrast to the the--- original example, we always give names to squares, regardless of the render--- mode. This simplifies the code a bit and is even suggested by the Red Book.-drawRects :: IO ()-drawRects = do-   -- resolve overloading, not needed in "real" programs-   let color3  = color :: Color3 GLfloat -> IO ()-       vertex3 = vertex :: Vertex3 GLint -> IO ()-   loadName (Name 1)-   renderPrimitive Quads $ do-      color3 (Color3 1.0 1.0 0.0)-      vertex3 (Vertex3 2 0 0)-      vertex3 (Vertex3 2 6 0)-      vertex3 (Vertex3 6 6 0)-      vertex3 (Vertex3 6 0 0)-   loadName (Name 2)-   renderPrimitive Quads $ do-      color3 (Color3 0.0 1.0 1.0)-      vertex3 (Vertex3 3 2 (-1))-      vertex3 (Vertex3 3 8 (-1))-      vertex3 (Vertex3 8 8 (-1))-      vertex3 (Vertex3 8 2 (-1))-   loadName (Name 3)-   renderPrimitive Quads $ do-      color3 (Color3 1.0 0.0 1.0)-      vertex3 (Vertex3 0 2 (-2))-      vertex3 (Vertex3 0 7 (-2))-      vertex3 (Vertex3 5 7 (-2))-      vertex3 (Vertex3 5 2 (-2))---- processHits prints the hit records.-processHits :: Maybe[HitRecord] -> IO ()-processHits Nothing = putStrLn "selection buffer overflow"-processHits (Just hitRecords) = do-   putStrLn ("hits = " ++ show (length hitRecords))-   flip mapM_ hitRecords $ \(HitRecord z1 z2 names) -> do-      putStrLn (" number of names for hit = " ++ show (length names))-      putStr   ("  z1 is " ++ show z1)-      putStrLn ("; z2 is " ++ show z2)-      putStr   "   the name is"-      sequence_ [ putStr (" " ++ show n) | Name n <- names ]-      putChar '\n'---- pickRects() sets up selection mode, name stack, and projection matrix for--- picking. Then the objects are drawn.--bufSize :: GLsizei-bufSize = 512--pickRects :: KeyboardMouseCallback-pickRects (MouseButton LeftButton) Down _ (Position x y) = do-   vp@(_, (Size _ height)) <- get viewport-   (_, maybeHitRecords) <- getHitRecords bufSize $-      withName (Name 0) $ do-         matrixMode $= Projection-         preservingMatrix $ do-            loadIdentity-            -- create 5x5 pixel picking region near cursor location-            pickMatrix (fromIntegral x, fromIntegral height - fromIntegral y) (5, 5) vp-            ortho 0 8 0 8 (-0.5) 2.5-            drawRects-         flush-   processHits maybeHitRecords-   postRedisplay Nothing-pickRects (Char '\27') Down _ _ = exitWith ExitSuccess-pickRects _            _    _ _ = return ()--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   drawRects-   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho 0 8 0 8 (-0.5) 2.5-   matrixMode $= Modelview 0-   loadIdentity---- Main Loop-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 200 200-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just pickRects-   mainLoop
− examples/RedBook/PickSquare.hs 
@@ -1,119 +0,0 @@-{--   PickSquare.hs (adapted from picksquare.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Use of multiple names and picking are demonstrated. A 3x3 grid of squares is-   drawn. When the left mouse button is pressed, all squares under the cursor-   position have their color changed.--}--import Data.Array ( Array, listArray, (!) )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--type Board = Array (GLint,GLint) (IORef Int)--data State = State { board :: Board }--makeState :: IO State-makeState = do-   refs <- sequence . replicate 9 . newIORef $ 0-   return $ State { board = listArray ((0,0),(2,2)) refs }---- Clear color value for every square on the board-myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0---- The nine squares are drawn. Each square is given two names: one for the row--- and the other for the column on the grid. The color of each square is--- determined by its position on the grid, and the value in the board array.--- Note: In contrast to the the original example, we always give names to--- squares, regardless of the render mode. This simplifies the code a bit and--- is even suggested by the Red Book.-drawSquares :: State -> IO ()-drawSquares state =-   flip mapM_ [ 0 .. 2 ] $ \i -> do-      loadName (Name (fromIntegral i))-      flip mapM_ [ 0 .. 2 ] $ \j ->-         withName (Name (fromIntegral j)) $ do-            val <- get (board state ! (i,j))-            -- resolve overloading, not needed in "real" programs-            let color3f = color :: Color3 GLfloat -> IO ()-            color3f (Color3 (fromIntegral i   / 3.0)-                            (fromIntegral j   / 3.0)-                            (fromIntegral val / 3.0))-            rect (Vertex2 i j) (Vertex2 (i + 1) (j + 1))---- processHits prints the hit records and updates the board array.-processHits :: Maybe[HitRecord] -> State -> IO ()-processHits Nothing _ = putStrLn "selection buffer overflow"-processHits (Just hitRecords) state = do-   putStrLn ("hits = " ++ show (length hitRecords))-   mapM_ (\(HitRecord z1 z2 names) -> do-      putStrLn (" number of names for this hit = " ++ show (length names))-      putStr   ("  z1 is " ++ show z1)-      putStrLn ("; z2 is " ++ show z2)-      putStr   "   names are"-      sequence_ [ putStr (" " ++ show n) | Name n <- names ]-      putChar '\n'-      let [i, j] = [ fromIntegral n | Name n <- names ]-      (board state ! (i,j)) $~ (\x -> (x + 1) `mod` 3))-      hitRecords---- pickSquares sets up selection mode, name stack, and projection matrix for--- picking. Then the objects are drawn.--bufSize :: GLsizei-bufSize = 512--pickSquares :: State -> KeyboardMouseCallback-pickSquares state (MouseButton LeftButton) Down _ (Position x y) = do-   vp@(_, (Size _ height)) <- get viewport-   (_, maybeHitRecords) <- getHitRecords bufSize $-      withName (Name 0) $ do-         matrixMode $= Projection-         preservingMatrix $ do-            loadIdentity-            -- create 5x5 pixel picking region near cursor location-            pickMatrix (fromIntegral x, fromIntegral height - fromIntegral y) (5, 5) vp-            ortho2D 0 3 0 3-            drawSquares state-         flush-   processHits maybeHitRecords state-   postRedisplay Nothing-pickSquares _ (Char '\27') Down _ _ = exitWith ExitSuccess-pickSquares _ _            _    _ _ = return ()--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   drawSquares state-   flush--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 3 0 3-   matrixMode $= Modelview 0-   loadIdentity---- Main Loop-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 100 100-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display state-   keyboardMouseCallback $= Just (pickSquares state)-   mainLoop
− examples/RedBook/Planet.hs 
@@ -1,83 +0,0 @@-{--   Planet.hs (adapted from planet.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program shows how to composite modeling transformations to draw-   translated and rotated models. Interaction: pressing the d and y keys-   (day and year) alters the rotation of the planet around the sun.--}--import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { year, day :: IORef GLint }--makeState :: IO State-makeState = do-   y <- newIORef 0-   d <- newIORef 0-   return $ State { year = y, day = d }--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-   color3f (Color3 1 1 1)--   preservingMatrix $ do-      renderObject Wireframe (Sphere' 1 20 16)   -- draw sun-      y <- get (year state)-      rotate (fromIntegral y :: GLfloat) (Vector3 0 1 0)-      translatef (Vector3 2 0 0)-      d <- get (day state)-      rotate (fromIntegral d :: GLfloat) (Vector3 0 1 0)-      renderObject Wireframe (Sphere' 0.2 10 8)  -- draw smaller planet--   swapBuffers--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 20-   matrixMode $= Modelview 0-   loadIdentity-   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case c of-   'd'   -> update day    10-   'D'   -> update day  (-10)-   'y'   -> update year   10-   'Y'   -> update year (-10)-   '\27' -> exitWith ExitSuccess-   _     -> return ()-   where update angle inc = do-            angle state $~ ((`mod` 360) . (+ inc))-            postRedisplay Nothing-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   mainLoop
− examples/RedBook/PointP.hs 
@@ -1,145 +0,0 @@-{--   PointP.hs (adapted from pointp.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates point parameters and their effect on point-   primitives. 250 points are randomly generated within a 10 by 10 by 40 region,-   centered at the origin. In some modes (including the default), points that-   are closer to the viewer will appear larger.--   Pressing the 'c', 'l', and 'q' keys switch the point parameters attenuation-   mode to constant, linear, or quadratic, respectively.--   Pressing the 'f' and 'b' keys move the viewer forward and backwards. In-   either linear or quadratic attenuation mode, the distance from the viewer to-   the point will change the size of the point primitive.--   Pressing the '+' and '-' keys will change the current point size. In this-   program, the point size is bounded, so it will not get less than 2, nor-   greater than the maximum returned by pointSizeRange.--}--import Control.Monad ( when, unless )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess), exitFailure )-import System.Random ( randomRIO )-import Graphics.UI.GLUT--type Attenuation = (GLfloat,GLfloat,GLfloat)--constant, linear, quadratic :: Attenuation-constant  = (1, 0,    0   )-linear    = (0, 0.12, 0   )-quadratic = (0, 0,    0.01)--data State = State { distance :: IORef GLfloat }--makeState :: IO State-makeState = do-   d <- newIORef (-10)-   return $ State { distance = d }--randomColor :: IO (Color3 GLfloat)-randomColor = do-   g <- randomRIO (0.5, 1)-   b <- randomRIO (0, 1)-   return $ Color3 1 g b--randomVertex :: IO (Vertex3 GLfloat)-randomVertex = do-   x <- randomRIO (-5, 5)-   y <- randomRIO (-5, 5)-   z <- randomRIO (-5, -45)-   return $ Vertex3 x y z--myInit :: IO DisplayList-myInit = do-   pointList <- defineNewList Compile $-      renderPrimitive Points $-         sequence_ $ replicate 250 $ do-            color =<< randomColor-            vertex =<< randomVertex--   depthFunc $= Just Less-   pointSmooth $= Enabled-   blend $= Enabled-   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)-   pointSize $= 7--   pointDistanceAttenuation $= linear-   pointFadeThresholdSize $= 2--   return pointList--display :: State -> DisplayList -> DisplayCallback-display state pointList = do-   clear [ ColorBuffer, DepthBuffer ]-   d <- get (distance state)-   loadIdentity-   translate (Vector3 0 0 d)-   callList pointList-   swapBuffers--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective  35 1 0.25 200-   matrixMode $= Modelview 0--setPointDistanceAttenuation :: Attenuation -> IO ()-setPointDistanceAttenuation att = do-   pointDistanceAttenuation $= att-   postRedisplay Nothing--incDistance :: State -> GLfloat -> IO ()-incDistance state inc = do-   distance state $~ (+ inc)-   postRedisplay Nothing--incPointSize :: GLfloat -> IO ()-incPointSize inc = do-   newPointSize <- fmap (+ inc) $ get pointSize-   (_,maxPointSize) <- get pointSizeRange-   when (2 <= newPointSize && newPointSize <= maxPointSize) $ do-      pointSize $= newPointSize-      postRedisplay Nothing--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case c of-   'c'   -> setPointDistanceAttenuation constant-   'l'   -> setPointDistanceAttenuation linear-   'q'   -> setPointDistanceAttenuation quadratic-   'b'   -> incDistance state (-0.5)-   'f'   -> incDistance state 0.5-   '+'   -> incPointSize 1-   '-'   -> incPointSize (-1)-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ RGBMode, DoubleBuffered, WithDepthBuffer, Multisampling ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName--   -- We have to do this *after* createWindow, otherwise we have no OpenGL-   -- context. Note that the original C example simply tests for OpenGL 1.4 at-   -- compile time, we do a runtime check for the needed extension.-   extensions <- get glExtensions-   unless ("GL_ARB_point_parameters" `elem` extensions) $ do-      putStrLn "Sorry, this demo requires the GL_ARB_point_parameters extension."-      exitFailure--   state <- makeState-   pointList <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state pointList-   mainLoop
− examples/RedBook/PolyOff.hs 
@@ -1,151 +0,0 @@-{--   PolyOff.hs (adapted from polyoff.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates polygon offset to draw a shaded polygon and its-   wireframe counterpart without ugly visual artifacts ("stitching").--}--import Control.Monad ( when )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess), exitFailure )-import Graphics.UI.GLUT--data State = State {-   spinX, spinY :: IORef GLfloat,-   tDist :: IORef GLfloat,-   polyFactor :: IORef GLfloat,-   polyUnits :: IORef GLfloat- }--makeState :: IO State-makeState = do-   x <- newIORef 0-   y <- newIORef 0-   t <- newIORef 0-   f <- newIORef 1-   u <- newIORef 1-   return $ State { spinX = x, spinY = y, tDist = t, polyFactor = f, polyUnits = u }---- display draws two spheres, one with a gray, diffuse material, the other--- sphere with a magenta material with a specular highlight.-display :: State -> DisplayList -> DisplayCallback-display state sphereList = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      t <- get (tDist state)-      translate (Vector3 0 0 t)-      x <- get (spinX state)-      rotate x (Vector3 1 0 0)-      y <- get (spinY state)-      rotate y (Vector3 0 1 0)--      materialAmbientAndDiffuse Front $= Color4 0.8 0.8 0.8 1-      materialSpecular Front $= Color4 0 0 0 1-      materialShininess Front $= 0-      lighting $= Enabled-      light (Light 0) $= Enabled-      polygonOffsetFill $= Enabled-      f <- get (polyFactor state)-      u <- get (polyUnits state)-      polygonOffset $= (f, u)-      callList sphereList-      polygonOffsetFill $= Disabled--      lighting $= Disabled-      light (Light 0) $= Disabled-      color (Color3 1 1 (1 :: GLfloat))-      polygonMode $= (Line, Line)-      callList sphereList-      polygonMode $= (Fill, Fill)--   flush---- specify initial properties--- create display list with sphere--- initialize lighting and depth buffer-gfxinit :: IO DisplayList-gfxinit = do-   clearColor $= Color4 0 0 0 1--   sphereList <- defineNewList Compile $-      renderObject Solid (Sphere' 1 20 12)--   depthFunc $= Just Less--   ambient (Light 0) $= Color4 0 0 0 1-   diffuse (Light 0) $= Color4 1 1 1 1-   specular (Light 0) $= Color4 1 1 1 1-   position (Light 0) $= Vertex4 1 1 1 0-   lightModelAmbient $= Color4 0.2 0.2 0.2 1--   return sphereList--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 (fromIntegral w / fromIntegral h) 1 10-   matrixMode $= Modelview 0-   loadIdentity-   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)--incSpin :: IORef GLfloat -> IO ()-incSpin spinRef = do-   let wrap n s = if s > n then s - n else s-   spinRef $~ (wrap 360 . (+ 5))-   postRedisplay Nothing--incDist :: State -> GLfloat -> IO ()-incDist state inc = do-   newDist <- fmap (+ inc) $ get (tDist state)-   when (-5 <= newDist && newDist <= 4) $ do-      tDist state $= newDist-      postRedisplay Nothing--incPoly :: String -> IORef GLfloat -> GLfloat -> IO ()-incPoly name polyRef inc = do-   polyRef $~ (+ inc)-   p <- get polyRef-   putStrLn (name ++ " is " ++ show p)-   postRedisplay Nothing--keyboardMouse :: State -> KeyboardMouseCallback-keyboardMouse state k Down _ _ = case k of-   (MouseButton LeftButton)   -> incSpin (spinX state)-   (MouseButton MiddleButton) -> incSpin (spinY state)-   (MouseButton RightButton)  -> exitWith ExitSuccess-   (Char 't')                 -> incDist state 0.5-   (Char 'T')                 -> incDist state (-0.5)-   (Char 'F')                 -> incPoly "polyFactor" (polyFactor state) 0.1-   (Char 'f')                 -> incPoly "polyFactor" (polyFactor state) (-0.1)-   (Char 'U')                 -> incPoly "polyUnits"  (polyUnits  state) 1-   (Char 'u')                 -> incPoly "polyUnits"  (polyUnits  state) (-1)-   _                          -> return ()-keyboardMouse _ _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   createWindow progName--   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   version <- get (majorMinor glVersion)-   when (version == (1,0)) $ do-      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."-      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure--   state <- makeState-   sphereList <- gfxinit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboardMouse state)-   displayCallback $= display state sphereList-   mainLoop
− examples/RedBook/Polys.hs 
@@ -1,84 +0,0 @@-{--   Polys.hs (adapted from polys.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates polygon stippling.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--fly :: IO GLpolygonstipple-fly = newPolygonStipple [-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,-   0x03, 0x80, 0x01, 0xC0, 0x06, 0xC0, 0x03, 0x60,-   0x04, 0x60, 0x06, 0x20, 0x04, 0x30, 0x0C, 0x20,-   0x04, 0x18, 0x18, 0x20, 0x04, 0x0C, 0x30, 0x20,-   0x04, 0x06, 0x60, 0x20, 0x44, 0x03, 0xC0, 0x22,-   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,-   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,-   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,-   0x66, 0x01, 0x80, 0x66, 0x33, 0x01, 0x80, 0xCC,-   0x19, 0x81, 0x81, 0x98, 0x0C, 0xC1, 0x83, 0x30,-   0x07, 0xe1, 0x87, 0xe0, 0x03, 0x3f, 0xfc, 0xc0,-   0x03, 0x31, 0x8c, 0xc0, 0x03, 0x33, 0xcc, 0xc0,-   0x06, 0x64, 0x26, 0x60, 0x0c, 0xcc, 0x33, 0x30,-   0x18, 0xcc, 0x33, 0x18, 0x10, 0xc4, 0x23, 0x08,-   0x10, 0x63, 0xC6, 0x08, 0x10, 0x30, 0x0c, 0x08,-   0x10, 0x18, 0x18, 0x08, 0x10, 0x00, 0x00, 0x08]--halftone :: IO GLpolygonstipple-halftone = newPolygonStipple . take 128 . cycle $ [-   0xAA, 0xAA, 0xAA, 0xAA, 0x55, 0x55, 0x55, 0x55]--display :: (GLpolygonstipple, GLpolygonstipple) -> DisplayCallback-display (flyStipple, halftoneStipple) = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       rectf = rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()-   color3f (Color3 1 1 1)--   -- draw one solid, unstippled rectangle,-   -- then two stippled rectangles-   rectf (Vertex2  25 25) (Vertex2 125 125)-   polygonStipple $= Just flyStipple-   rectf (Vertex2 125 25) (Vertex2 225 125)-   polygonStipple $= Just halftoneStipple-   rectf (Vertex2 225 25) (Vertex2 325 125)-   polygonStipple $= (Nothing :: Maybe GLpolygonstipple)--   flush--myInit :: IO (GLpolygonstipple, GLpolygonstipple)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   flyStipple <- fly-   halftoneStipple <- halftone-   return (flyStipple, halftoneStipple)--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0.0 (fromIntegral w) 0.0 (fromIntegral h)--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 350 150-   createWindow progName-   stipples <- myInit-   displayCallback $= display stipples-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Quadric.hs 
@@ -1,106 +0,0 @@-{--   Quadric.hs (adapted from quadric.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the use of the renderQuadric routine. Quadric-   objects are created with some quadric properties and errors are reported.-   Note that the cylinder has no top or bottom and the circle has a hole in it.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO (DisplayList, DisplayList, DisplayList, DisplayList)-myInit = do-   clearColor $= Color4 0 0 0 0--   materialAmbient Front $= Color4 0.5 0.5 0.5 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 50-   position (Light 0) $= Vertex4 1 1 1 0-   lightModelAmbient $= Color4 0.5 0.5 0.5 1--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less--   -- Create 4 display lists, each with a different quadric object.-   -- Different drawing styles and surface normal specifications-   -- are demonstrated.-   -- smooth shaded-   dl1 <- newQuadricDL (Just Smooth) FillStyle (Sphere 0.75 15 10)-   -- flat shaded-   dl2 <- newQuadricDL (Just Flat) FillStyle (Cylinder 0.5 0.3 1 15 5)-   -- all polygons wireframe-   dl3 <- newQuadricDL Nothing LineStyle (Disk 0.25 1 20 4)-   -- boundary only-   dl4 <- newQuadricDL Nothing SilhouetteStyle (PartialDisk 0 1 20 4 0 225)-   return (dl1, dl2, dl3, dl4)--newQuadricDL :: QuadricNormal -> QuadricDrawStyle -> QuadricPrimitive -> IO DisplayList-newQuadricDL n s p =-   defineNewList Compile $ do-      renderQuadric (QuadricStyle n NoTextureCoordinates Outside s) p-      reportErrors--display :: (DisplayList, DisplayList, DisplayList, DisplayList) -> DisplayCallback-display (dl1, dl2, dl3, dl4) = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      -- resolve overloading, not needed in "real" programs-      let translatef = translate :: Vector3 GLfloat -> IO ()-          rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()-          color3f = color :: Color3 GLfloat -> IO ()--      lighting $= Enabled-      shadeModel $= Smooth-      translatef (Vector3 (-1) (-1) 0)-      callList dl1--      shadeModel $= Flat-      translatef (Vector3 0 2 0)-      preservingMatrix $ do-         rotatef 300 (Vector3 1 0 0)-         callList dl2--      lighting $= Disabled-      color3f (Color3 0 1 1)-      translatef (Vector3 2 (-2) 0)-      callList dl3--      color3f (Color3 1 1 0)-      translatef (Vector3 0 2 0)-      callList dl4--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10) 10-      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10) 10-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   displayLists <- myInit-   displayCallback $= display displayLists-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/ReadImage.hs 
@@ -1,65 +0,0 @@-{--   ReadImage.hs (adapted from readImage.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   Support for reading a file of raw RGB data:-      4 bytes big-endian width-      4 bytes big-endian height-      width * height RGB byte triples--}--module ReadImage ( readImage ) where--import Data.Word ( Word8, Word32 )-import Control.Exception ( bracket )-import Control.Monad ( when )-import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose )-import System.IO.Error ( mkIOError, eofErrorType )-import Foreign ( Ptr, alloca, mallocBytes, Storable(..) )-import Graphics.UI.GLUT---- This is probably overkill, but anyway...-newtype Word32BigEndian = Word32BigEndian Word32--word32BigEndianToGLsizei :: Word32BigEndian -> GLsizei-word32BigEndianToGLsizei (Word32BigEndian x) = fromIntegral x--instance Storable Word32BigEndian where-   sizeOf ~(Word32BigEndian x) = sizeOf x-   alignment ~(Word32BigEndian x) = alignment x-   peek ptr = do-      let numBytes = sizeOf (undefined :: Word32BigEndian)-      bytes <- mapM (peekByteOff ptr) [ 0 ..  numBytes - 1 ] :: IO [Word8]-      let value = foldl (\val byte -> val * 256 + fromIntegral byte) 0 bytes-      return $ Word32BigEndian value-   poke = error ""---- This is the reason for all this stuff above...-readGLsizei :: Handle -> IO GLsizei-readGLsizei handle =-   alloca $ \buf -> do-      hGetBufFully handle buf (sizeOf (undefined :: Word32BigEndian))-      fmap word32BigEndianToGLsizei $ peek buf---- A handy variant of hGetBuf with additional error checking-hGetBufFully :: Handle -> Ptr a -> Int -> IO ()-hGetBufFully handle ptr numBytes = do-   bytesRead <- hGetBuf handle ptr numBytes-   when (bytesRead /= numBytes) $-      ioError $ mkIOError eofErrorType "hGetBufFully" (Just handle) Nothing---- Closing a file is nice, even when an error occurs during reading.-withBinaryFile :: FilePath -> (Handle -> IO a) -> IO a-withBinaryFile filePath = bracket (openBinaryFile filePath ReadMode) hClose--readImage :: FilePath -> IO (Size, PixelData a)-readImage filePath =-   withBinaryFile filePath $ \handle -> do-      width <- readGLsizei handle-      height <- readGLsizei handle-      let numBytes = fromIntegral (3 * width * height)-      buf <- mallocBytes numBytes-      hGetBufFully handle buf numBytes-      return (Size width height, PixelData RGB UnsignedByte buf)
− examples/RedBook/Robot.hs 
@@ -1,89 +0,0 @@-{--   Robot.hs (adapted from robot.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--  This program shows how to composite modeling transformations to draw-  translated and rotated hierarchical models. Interaction: pressing the s-  and e keys (shoulder and elbow) alters the rotation of the robot arm.--}--import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { shoulder, elbow :: IORef GLint }--makeState :: IO State-makeState = do-   s <- newIORef 0-   e <- newIORef 0-   return $ State { shoulder = s, elbow = e }--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let translatef = translate :: Vector3 GLfloat -> IO ()-       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()-   preservingMatrix $ do-      translatef (Vector3 (-1) 0 0)-      s <- get (shoulder state)-      rotate (fromIntegral s :: GLfloat) (Vector3 0 0 1)-      translatef (Vector3 1 0 0)-      preservingMatrix $ do-         scalef 2 0.4 1-         renderObject Wireframe (Cube 1)-      translatef (Vector3 1 0 0)-      e <- get (elbow state)-      rotate (fromIntegral e :: GLfloat) (Vector3 0 0 1)-      translatef (Vector3 1 0 0)-      preservingMatrix $ do-         scalef 2 0.4 1-         renderObject Wireframe (Cube 1)-   swapBuffers--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 65 (fromIntegral w / fromIntegral h) 1 20-   matrixMode $= Modelview 0-   loadIdentity-   -- resolve overloading, not needed in "real" programs-   let translatef = translate :: Vector3 GLfloat -> IO ()-   translatef (Vector3 0 0 (-5))--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case c of-   's'   -> update shoulder   5-   'S'   -> update shoulder (-5)-   'e'   -> update elbow      5-   'E'   -> update elbow    (-5)-   '\27' -> exitWith ExitSuccess-   _     -> return ()-   where update joint inc = do-            joint state $~ ((`mod` 360) . (+ inc))-            postRedisplay Nothing-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ DoubleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   mainLoop
− examples/RedBook/Scene.hs 
@@ -1,73 +0,0 @@-{--   Scene.hs (adapted from scene.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the use of the GL lighting model. Objects are-   drawn using a grey material characteristic. A single light source-   illuminates the objects.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Initialize material property and light source.-myInit :: IO ()-myInit = do-   ambient (Light 0) $= Color4 0 0 0 1-   diffuse (Light 0) $= Color4 1 1 1 1-   specular (Light 0) $= Color4 1 1 1 1-   -- light position is NOT default value-   position (Light 0) $= Vertex4  1 1 1 0--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (20 :: GLfloat) (Vector3 1 0 0)-      preservingMatrix $ do-         translate (Vector3 (-0.75) 0.5 (0 :: GLfloat))-         rotate (90 :: GLfloat) (Vector3 1 0 0)-         renderObject Solid (Torus 0.275 0.85 15 15)-      preservingMatrix $ do-         translate (Vector3 (-0.75) (-0.5) (0 :: GLfloat))-         rotate (270 :: GLfloat) (Vector3 1 0 0)-         renderObject Solid (Cone 1 2 15 15)-      preservingMatrix $ do-         translate (Vector3 0.75 0 (-1 :: GLfloat))-         renderObject Solid (Sphere' 1 15 15)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-2.5) 2.5 (-2.5 * hf/wf) (2.5 * hf/wf) (-10) 10-      else ortho (-2.5 * wf/hf) (2.5 * wf/hf) (-2.5) 2.5 (-10) 10-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Select.hs 
@@ -1,150 +0,0 @@-{--   Select.hs (adapted from select.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This is an illustration of the selection mode and name stack, which detects-   whether objects which collide with a viewing volume. First, four triangles-   and a rectangular box representing a viewing volume are drawn (drawScene-   routine). The green triangle and yellow triangles appear to lie within the-   viewing volume, but the red triangle appears to lie outside it. Then the-   selection mode is entered (selectObjects routine). Drawing to the screen-   ceases. To see if any collisions occur, the four triangles are called. In-   this example, the green triangle causes one hit with the name 1, and the-   yellow triangles cause one hit with the name 3.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- draw a triangle with vertices at (x1, y1), (x2, y2) and (x3, y3) at z units--- away from the origin.-drawTriangle ::-   Vertex2 GLfloat -> Vertex2 GLfloat -> Vertex2 GLfloat -> GLfloat -> IO ()-drawTriangle (Vertex2 x1 y1) (Vertex2 x2 y2) (Vertex2 x3 y3) z = do-   renderPrimitive Triangles $ mapM_ vertex [-      Vertex3 x1 y1 z,-      Vertex3 x2 y2 z,-      Vertex3 x3 y3 z]---- draw a rectangular box with these outer x, y, and z values-drawViewVolume :: Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()-drawViewVolume (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2) = do-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 1 1 1)-   renderPrimitive LineLoop $ mapM_ vertex [-      Vertex3 x1 y1 (-z1),-      Vertex3 x2 y1 (-z1),-      Vertex3 x2 y2 (-z1),-      Vertex3 x1 y2 (-z1)]--   renderPrimitive LineLoop $ mapM_ vertex [-      Vertex3 x1 y1 (-z2),-      Vertex3 x2 y1 (-z2),-      Vertex3 x2 y2 (-z2),-      Vertex3 x1 y2 (-z2)]--   renderPrimitive Lines $ mapM_ vertex [   -- 4 lines-      Vertex3 x1 y1 (-z1),-      Vertex3 x1 y1 (-z2),-      Vertex3 x1 y2 (-z1),-      Vertex3 x1 y2 (-z2),-      Vertex3 x2 y1 (-z1),-      Vertex3 x2 y1 (-z2),-      Vertex3 x2 y2 (-z1),-      Vertex3 x2 y2 (-z2)]---- drawScene draws 4 triangles and a wire frame which represents the viewing--- volume.-drawScene :: IO ()-drawScene = do-   matrixMode $= Projection-   loadIdentity-   perspective 40 (4/3) 1 100--   matrixMode $= Modelview 0-   loadIdentity-   lookAt (Vertex3 7.5 7.5 12.5) (Vertex3 2.5 2.5 (-5)) (Vector3 0 1 0)-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 0 1 0)   -- green triangle-   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)-   color3f (Color3 1 0 0)   -- red triangle-   drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)-   color3f (Color3 1 1 0)   -- yellow triangles-   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)-   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)-   drawViewVolume (Vertex3 0 0 0) (Vertex3 5 5 10)--processHits :: Maybe [HitRecord] -> IO ()-processHits Nothing = putStrLn "selection buffer overflow"-processHits (Just hitRecords) = do-   putStrLn ("hits = " ++ show (length hitRecords))-   mapM_ (\(HitRecord z1 z2 names) -> do-      putStrLn (" number of names for hit = " ++ show (length names))-      putStr   ("  z1 is " ++ show z1)-      putStrLn ("; z2 is " ++ show z2)-      putStr   "   the name is"-      sequence_ [ putStr (" " ++ show n) | Name n <- names ]-      putChar '\n')-      hitRecords---- selectObjects "draws" the triangles in selection mode, assigning names for--- the triangles. Note that the third and fourth triangles share one name, so--- that if either or both triangles intersects the viewing/clipping volume,--- only one hit will be registered.--bufSize :: GLsizei-bufSize = 512--selectObjects :: IO ()-selectObjects = do-   (_, maybeHitRecords) <- getHitRecords bufSize $ do-      withName (Name 0) $ do-         preservingMatrix $ do-            matrixMode $= Projection-            loadIdentity-            ortho 0 5 0 5 0 10-            matrixMode $= Modelview 0-            loadIdentity-            loadName (Name 1)-            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)-            loadName (Name 2)-            drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)-            loadName (Name 3)-            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)-            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)-      flush-   processHits maybeHitRecords--myInit :: IO ()-myInit = do-   depthFunc $= Just Less-   shadeModel $= Flat--display :: DisplayCallback-display = do-   clearColor $= Color4 0 0 0 0-   clear [ ColorBuffer, DepthBuffer ]-   drawScene-   selectObjects-   flush--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 200 200-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/ShadowMap.hs 
@@ -1,255 +0,0 @@-{--   ShadowMap.hs (adapted from shadowmap.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--}--import Control.Monad ( when, unless )-import Data.IORef ( IORef, newIORef )-import Foreign.Marshal.Array ( allocaArray )-import Foreign.Ptr ( nullPtr )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--shadowMapSize :: TextureSize2D-shadowMapSize = TextureSize2D 256 256--fovy, nearPlane, farPlane :: GLdouble-fovy      =  60-nearPlane =  10-farPlane  = 100--lightPos :: Vertex4 GLfloat-lightPos = Vertex4 25 25 25 1--lookat :: Vertex3 GLdouble-lookat   = Vertex3 0 0 0--up :: Vector3 GLdouble-up = Vector3 0 0 1--data State = State {-   angle      :: IORef GLdouble,-   torusAngle :: IORef GLfloat,-   showShadow :: IORef Bool,-   animate    :: IORef Bool,-   funcMode   :: IORef ComparisonFunction }--makeState :: IO State-makeState = do-   a <- newIORef 0-   t <- newIORef 0-   s <- newIORef False-   n <- newIORef True-   f <- newIORef Lequal-   return $ State { angle = a, torusAngle = t, showShadow = s,-                    animate = n, funcMode = f }--myInit :: IO ()-myInit = do-   texImage2D Nothing NoProxy 0 DepthComponent' shadowMapSize 0-              (PixelData DepthComponent UnsignedByte nullPtr)--   position (Light 0) $= lightPos-   let white = Color4 1 1 1 1-   specular (Light 0) $= white-   diffuse  (Light 0) $= white--   textureWrapMode Texture2D S $= (Repeated, ClampToEdge)-   textureWrapMode Texture2D T $= (Repeated, ClampToEdge)-   textureFilter Texture2D $= ((Linear', Nothing), Linear')-   textureCompareMode Texture2D $= Just Lequal-   depthTextureMode Texture2D $= Luminance'--   colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse)--   cullFace $= Just Back--   depthFunc $= Just Less-   light (Light 0) $= Enabled-   lighting $= Enabled-   texture Texture2D $= Enabled--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective fovy (fromIntegral w / fromIntegral h) nearPlane farPlane-   matrixMode $= Modelview 0--idle :: State -> IdleCallback-idle state = do-   angle state $~! (+ (pi / 10000))-   torusAngle state $~! (+ 0.1)-   postRedisplay Nothing--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = do-   case c of-      '\27' -> exitWith ExitSuccess-      't' ->-         texture Texture2D $~ \cap -> if cap == Enabled then Disabled else Enabled-      'm' -> do-         fm <- get (funcMode state)-         textureCompareMode Texture2D $~ maybe (Just fm) (const Nothing)-         compareMode <- get (textureCompareMode Texture2D)-         putStrLn ("Compare mode " ++ maybe "Off" (const "On") compareMode)-      'f' -> do-         funcMode state $~ \fm -> if fm == Lequal then Gequal else Lequal-         fm <- get (funcMode state)-         putStrLn ("Operator " ++ show fm)-         textureCompareMode Texture2D $~ maybe Nothing (const (Just fm))-      's' -> showShadow state $~ not-      'p' -> do-         animate state $~ not-         animate' <- get (animate state)-         idleCallback $= if animate' then Just (idle state) else Nothing-      _ -> return ()-   postRedisplay Nothing-keyboard _ _ _ _ _ = return ()--drawObjects :: GLfloat -> Bool -> IO ()-drawObjects torusAngle' shadowRender = do-   textureOn <- get (texture Texture2D)--   when shadowRender $-      texture Texture2D $= Disabled--   -- resolve overloading, not needed in "real" programs-   let normal3f = normal :: Normal3 GLfloat -> IO ()-       color3f = color :: Color3 GLfloat -> IO ()-       rectf = rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()--   unless shadowRender $ do-      normal3f (Normal3 0 0 1)-      color3f (Color3 1 1 1)-      rectf (Vertex2 (-20) (-20)) (Vertex2 20 20)--   preservingMatrix $ do-      translatef (Vector3 11 11 11)-      rotatef 54.73 (Vector3 (-5) 5 0)-      rotate torusAngle' (Vector3 1 0 0)-      color3f (Color3 1 0 0)-      renderObject Solid (Torus 1 4 8 36)--   preservingMatrix $ do-      translatef (Vector3 2 2 2)-      color3f (Color3 0 0 1)-      renderObject Solid (Cube 4)--   preservingMatrix $ do-      getLightPos Vector3 >>= translate-      color3f (Color3 1 1 1)-      renderObject Wireframe (Sphere' 0.5 6 6)--   when (shadowRender && textureOn == Enabled) $-      texture Texture2D $= Enabled--getLightPos :: (GLdouble -> GLdouble -> GLdouble -> a) -> IO a-getLightPos f = do-    Vertex4 x y z _ <- get (position (Light 0))-    return $ f (realToFrac x) (realToFrac y) (realToFrac z)--generateShadowMap :: GLfloat -> Bool -> IO ()-generateShadowMap torusAngle' showShadow' = do-   lightPos' <- getLightPos Vertex3-   let (TextureSize2D shadowMapWidth shadowMapHeight) = shadowMapSize-       shadowMapSize' = Size shadowMapWidth shadowMapHeight--   preservingViewport $ do-      viewport $= (Position 0 0, shadowMapSize')--      clear [ ColorBuffer, DepthBuffer ]--      matrixMode $= Projection-      preservingMatrix $ do-         loadIdentity-         perspective 80 1 10 1000-         matrixMode $= Modelview 0-         preservingMatrix $ do-            loadIdentity-            lookAt lightPos' lookat up-            drawObjects torusAngle' True-         matrixMode $= Projection-      matrixMode $= Modelview 0--      copyTexImage2D Nothing 0 DepthComponent' (Position 0 0) shadowMapSize 0--   when showShadow' $ do-      let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)-      allocaArray numShadowMapPixels $ \depthImage -> do-        let pixelData fmt = PixelData fmt Float depthImage :: PixelData GLfloat-        readPixels (Position 0 0) shadowMapSize' (pixelData DepthComponent)-        (_, Size viewPortWidth _) <- get viewport-        windowPos (Vertex2 (fromIntegral viewPortWidth / 2 :: GLfloat) 0)-        drawPixels shadowMapSize' (pixelData Luminance)-        swapBuffers---- Note: preservingViewport is not exception safe, but it doesn't matter here-preservingViewport :: IO a -> IO a-preservingViewport act = do-   v <- get viewport-   x <- act-   viewport $= v-   return x--generateTextureMatrix :: IO ()-generateTextureMatrix = do-   -- Set up projective texture matrix. We use the Modelview matrix stack and-   -- OpenGL matrix commands to make the matrix.-   m <- preservingMatrix $ do-      loadIdentity-      -- resolve overloading, not needed in "real" programs-      let translatef = translate :: Vector3 GLfloat -> IO ()-          scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()-      translatef (Vector3 0.5 0.5 0.0)-      scalef 0.5 0.5 1.0-      perspective 60 1 1 1000-      lightPos' <- getLightPos Vertex3-      lookAt lightPos' lookat up-      get (matrix (Just (Modelview 0)))--   [ sx, sy, sz, sw,-     tx, ty, tz, tw,-     rx, ry, rz, rw,-     qx, qy, qz, qw ] <- getMatrixComponents RowMajor (m :: GLmatrix GLdouble)--   textureGenMode S $= Just (ObjectLinear (Plane sx sy sz sw))-   textureGenMode T $= Just (ObjectLinear (Plane tx ty tz tw))-   textureGenMode R $= Just (ObjectLinear (Plane rx ry rz rw))-   textureGenMode Q $= Just (ObjectLinear (Plane qx qy qz qw))--display :: State -> DisplayCallback-display state = do-   let radius = 30-   torusAngle' <- get (torusAngle state)-   showShadow' <- get (showShadow state)-   generateShadowMap torusAngle' showShadow'-   generateTextureMatrix-   unless showShadow' $ do-      clear [ ColorBuffer, DepthBuffer ]-      preservingMatrix $ do-         angle' <- get (angle state)-         lookAt (Vertex3 (radius * cos angle') (radius * sin angle') 30) lookat up-         drawObjects torusAngle' False-      swapBuffers--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ RGBAMode, WithDepthBuffer, DoubleBuffered ]-   initialWindowSize $= Size 521 512-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   idleCallback $= Just (idle state)--   mainLoop
− examples/RedBook/Smooth.hs 
@@ -1,65 +0,0 @@-{--   Smooth.hs (adapted from smooth.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates smooth shading. A smooth shaded polygon is drawn in-   a 2-D projection.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth--triangle :: IO ()-triangle =-   -- resolve overloading, not needed in "real" programs-   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()-       color3f = color :: Color3 GLfloat -> IO ()-   in renderPrimitive Triangles $ do-      color3f (Color3 1 0 0)-      vertex2f (Vertex2 5 5)-      color3f (Color3 0 1 0)-      vertex2f (Vertex2 25 5)-      color3f (Color3 0 0 1)-      vertex2f (Vertex2 5 25)--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   triangle-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D 0 30 0 (30 * hf/wf)-      else ortho2D 0 (30 * wf/hf) 0 30-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Stencil.hs 
@@ -1,123 +0,0 @@-{--   Stencil.hs (adapted from stencil.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates use of the stencil buffer for masking-   nonrectangular regions. Whenever the window is redrawn, a value of 1 is drawn-   into a diamond-shaped region in the stencil buffer. Elsewhere in the stencil-   buffer, the value is 0. Then a blue sphere is drawn where the stencil value-   is 1, and yellow torii are drawn where the stencil value is not 1.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data DisplayLists = DisplayLists { yellowMat, blueMat :: DisplayList }--myInit :: IO DisplayLists-myInit = do-   y <- defineNewList Compile $ do-      materialDiffuse Front $= Color4 0.7 0.7 0 1-      materialSpecular Front $= Color4 1 1 1 1-      materialShininess Front $= 64--   b <- defineNewList Compile $ do-      materialDiffuse Front $= Color4 0.1 0.1 0.7 1-      materialSpecular Front $= Color4  0.1 1 1 1-      materialShininess Front $= 45--   position (Light 0) $= Vertex4 1 1 1 0--   light (Light 0) $= Enabled-   lighting $= Enabled-   depthFunc $= Just Less--   clearStencil $= 0-   stencilTest $= Enabled--   return $ DisplayLists { yellowMat = y, blueMat = b }---- Draw a sphere in a diamond-shaped section in the middle of a window with 2--- torii.-display :: DisplayLists -> DisplayCallback-display displayLists = do-   clear [ ColorBuffer, DepthBuffer ]--   -- draw blue sphere where the stencil is 1-   stencilFunc $= (Equal, 1, 1)-   stencilOp $= (OpKeep, OpKeep, OpKeep)-   callList (blueMat displayLists)-   renderObject Solid (Sphere' 0.5 15 15)--   -- resolve overloading, not needed in "real" programs-   let rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()--   -- draw the tori where the stencil is not 1-   stencilFunc $= (Notequal, 1, 1)-   preservingMatrix $ do-      rotatef 45 (Vector3 0 0 1)-      rotatef 45 (Vector3 0 1 0)-      callList (yellowMat displayLists)-      renderObject Solid (Torus 0.275 0.85 15 15)-      preservingMatrix $ do-         rotatef 90 (Vector3 1 0 0)-         renderObject Solid (Torus 0.275 0.85 15 15)--   flush---- Whenever the window is reshaped, redefine the coordinate system and redraw--- the stencil area.-reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)--   -- create a diamond shaped stencil area-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D (-3) 3 (-3*hf/wf) (3*hf/wf)-      else ortho2D (-3*wf/hf) (3*wf/hf) (-3) 3-   matrixMode $= Modelview 0-   loadIdentity--   -- resolve overloading, not needed in "real" programs-   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()--   clear [ StencilBuffer ]-   stencilFunc $= (Always, 1, 1)-   stencilOp $= (OpReplace, OpReplace, OpReplace)-   renderPrimitive Quads $ do-      vertex2f (Vertex2 (-1) 0)-      vertex2f (Vertex2 0 1)-      vertex2f (Vertex2 1 0)-      vertex2f (Vertex2 0 (-1))--   matrixMode $= Projection-   loadIdentity-   perspective 45 (wf/hf) 3 7-   matrixMode $= Modelview 0-   loadIdentity-   translatef (Vector3 0 0 (-5))--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop: Be certain to request stencil bits.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer, WithStencilBuffer ]-   initialWindowSize $= Size 400 400-   initialWindowPosition $= Position 100 100-   createWindow progName-   displayLists <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display displayLists-   mainLoop
− examples/RedBook/Stroke.hs 
@@ -1,127 +0,0 @@-{--   Stroke.hs (adapted from stroke.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates some characters of a stroke (vector) font. The-   characters are represented by display lists, which are given numbers which-   correspond to the ASCII values of the characters. Use of callLists is-   demonstrated.--}--import Data.List ( genericLength )-import Foreign.C.String ( castCharToCChar )-import Foreign.Marshal.Array ( withArray )-import Graphics.UI.GLUT-import System.Exit ( exitWith, ExitCode(ExitSuccess) )--aData, eData, pData, rData, sData :: [[Vertex2 GLfloat]]-aData = [-   [ Vertex2 0 0, Vertex2 0 9, Vertex2 1 10, Vertex2 4 10, Vertex2 5 9,-     Vertex2 5 0 ],-   [ Vertex2 0 5, Vertex2 5 5 ] ]--eData = [-   [ Vertex2 5 0, Vertex2 0 0, Vertex2 0 10, Vertex2 5 10 ],-   [ Vertex2 0 5, Vertex2 4 5 ] ]--pData = [-   [ Vertex2 0 0, Vertex2 0 10,  Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,-     Vertex2 4 5, Vertex2 0 5 ] ]--rData = [-   [ Vertex2 0 0, Vertex2 0 10,  Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,-     Vertex2 4 5, Vertex2 0 5 ],-   [ Vertex2 3 5, Vertex2 5 0 ] ]--sData = [-   [ Vertex2 0 1, Vertex2 1 0, Vertex2 4 0, Vertex2 5 1, Vertex2 5 4,-     Vertex2 4 5, Vertex2 1 5, Vertex2 0 6, Vertex2 0 9, Vertex2 1 10,-     Vertex2 4 10, Vertex2 5 9 ] ]--advance :: IO ()-advance = translate (Vector3 8 0 (0 :: GLfloat))---- drawLetter renders a letter with line segments given by the list of line--- strips.-drawLetter :: [[Vertex2 GLfloat]] -> IO ()-drawLetter lineStrips = do-   mapM_ (renderPrimitive LineStrip . mapM_ vertex) lineStrips-   advance--charToGLubyte :: Char -> GLubyte-charToGLubyte = fromIntegral . castCharToCChar--myInit :: IO ()-myInit = do-   shadeModel $= Flat--   (base@(DisplayList b):_) <- genObjectNames 128-   listBase $= base-   let charToDisplayList c = DisplayList (b + fromIntegral (charToGLubyte c))-   mapM_ (\(c, d) -> defineList (charToDisplayList c) Compile d)-         [ ('A', drawLetter aData),-           ('E', drawLetter eData),-           ('P', drawLetter pData),-           ('R', drawLetter rData),-           ('S', drawLetter sData),-           (' ', advance) ]--test1, test2 :: String-test1 = "A SPARE SERAPE APPEARS AS"-test2 = "APES PREPARE RARE PEPPERS"--printStrokedString :: String -> IO ()-printStrokedString s =-   withArray (map charToGLubyte s) $-      callLists (genericLength s) UnsignedByte--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]--   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()--   color3f (Color3 1 1 1)-   preservingMatrix $ do-      scalef 2 2 2-      translatef (Vector3 10 30 0)-      printStrokedString test1-   preservingMatrix $ do-      scalef 2 2 2-      translatef (Vector3 10 13 0)-      printStrokedString test2-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char c) Down _ _ = case c of-   ' '   -> postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ = return ()---- Main Loop: Open window with initial window size, title bar, RGBA display--- mode, and handle input events.-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 440 120-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   displayCallback $= display-   mainLoop
− examples/RedBook/SurfPoints.hs 
@@ -1,129 +0,0 @@-{--   SurfPoints.hs (adapted from surfpoints.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program is a modification of the earlier Surface.hs program. The-   vertex data are not directly rendered, but are instead passed to the-   callback function. The values of the tessellated vertices are printed-   out there.--   This program draws a NURBS surface in the shape of a symmetrical hill.-   The 'c' keyboard key allows you to toggle the visibility of the control-   points themselves. Note that some of the control points are hidden by-   the surface itself.--   NOTE: This example does NOT demonstrate the final NURBS API, it's currently-   just a test for the internals...--}--import Control.Monad ( when )-import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import Foreign.Marshal ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess), exitFailure )-import Graphics.UI.GLUT--data State = State { showPoints :: IORef Bool }--makeState :: IO State-makeState = do-   s <- newIORef False-   return $ State { showPoints = s }---- The control points of the surface form a small hill and--- range from -3 to +3 in x, y, and z.-ctlPoints :: [[Vertex3 GLfloat]]-ctlPoints =-   [ [ Vertex3 (2 * u - 3)-               (2 * v - 3)-               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)-     | v <- [ 0 .. 3 ] ]-   | u <- [ 0 .. 3 ]]--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   materialDiffuse Front $= Color4 0.7 0.7 0.7 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 100--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less-   autoNormal $= Enabled-   normalize $= Enabled------------------------------------------------------------------------------------display :: State -> DisplayCallback-display state = do-   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (330 :: GLfloat) (Vector3 1 0 0)-      scale 0.5 0.5 (0.5 :: GLfloat)--      withNURBSObj () $ \nurbsObj -> do-         setNURBSMode nurbsObj NURBSTessellator-         setSamplingMethod nurbsObj (PathLength 25)-         setDisplayMode' nurbsObj Fill'-         checkForNURBSError nurbsObj $-            withNURBSBeginCallback nurbsObj print $-               withNURBSVertexCallback nurbsObj print $-                  withNURBSNormalCallback nurbsObj print $-                     withNURBSEndCallback nurbsObj (putStrLn "end") $-                        nurbsBeginEndSurface nurbsObj $-                           withArray (concat ctlPoints) $ \cBuf ->-                              withArray knots $ \kBuf ->-                                 nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4--      s <- get (showPoints state)-      when s $ do-         pointSize $= 5-         lighting $= Disabled-         color (Color3 1 1 (0 :: GLfloat))-         renderPrimitive Points $-            mapM_ (mapM_ vertex) ctlPoints-         lighting $= Enabled--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 (fromIntegral w / fromIntegral h) 3 8-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-5 :: GLfloat))--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'c'   -> do showPoints state $~ not; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   version <- get (majorMinor gluVersion)-   when (version < (1,3)) $ do-      putStrLn "This program demonstrates a feature which is introduced in the"-      putStrLn "OpenGL Utility Library (GLU) Version 1.3."-      putStrLn "If your implementation of GLU has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display state-   keyboardMouseCallback $= Just (keyboard state)-   mainLoop
− examples/RedBook/Surface.hs 
@@ -1,112 +0,0 @@-{--   Surface.hs (adapted from surface.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws a NURBS surface in the shape of a symmetrical hill.-   The 'c' keyboard key allows you to toggle the visibility of the control-   points themselves. Note that some of the control points are hidden by-   the surface itself.--   NOTE: This example does NOT demonstrate the final NURBS API, it's currently-   just a test for the internals...--}--import Control.Monad ( when )-import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import Foreign.Marshal ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { showPoints :: IORef Bool }--makeState :: IO State-makeState = do-   s <- newIORef False-   return $ State { showPoints = s }---- The control points of the surface form a small hill and--- range from -3 to +3 in x, y, and z.-ctlPoints :: [[Vertex3 GLfloat]]-ctlPoints =-   [ [ Vertex3 (2 * u - 3)-               (2 * v - 3)-               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)-     | v <- [ 0 .. 3 ] ]-   | u <- [ 0 .. 3 ]]--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   materialDiffuse Front $= Color4 0.7 0.7 0.7 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 100--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less-   autoNormal $= Enabled-   normalize $= Enabled------------------------------------------------------------------------------------display :: State -> DisplayCallback-display state = do-   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (330 :: GLfloat) (Vector3 1 0 0)-      scale 0.5 0.5 (0.5 :: GLfloat)--      withNURBSObj () $ \nurbsObj -> do-         setSamplingMethod nurbsObj (PathLength 25)-         setDisplayMode' nurbsObj Fill'-         checkForNURBSError nurbsObj $-            nurbsBeginEndSurface nurbsObj $-               withArray (concat ctlPoints) $ \cBuf ->-                  withArray knots $ \kBuf ->-                     nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4--      s <- get (showPoints state)-      when s $ do-         pointSize $= 5-         lighting $= Disabled-         color (Color3 1 1 (0 :: GLfloat))-         renderPrimitive Points $-            mapM_ (mapM_ vertex) ctlPoints-         lighting $= Enabled--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 (fromIntegral w / fromIntegral h) 3 8-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-5 :: GLfloat))--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'c'   -> do showPoints state $~ not; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   state <- makeState-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display state-   keyboardMouseCallback $= Just (keyboard state)-   mainLoop
− examples/RedBook/Teapots.hs 
@@ -1,226 +0,0 @@-{--   Teapots.hs (adapted from teapots.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates lots of material properties. A single light-   source illuminates the objects.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Initialize depth buffer, projection matrix, light source, and lighting--- model. Do not specify a material property here.-myInit :: IO DisplayList-myInit = do-   ambient (Light 0) $= Color4 0 0 0 1-   diffuse (Light 0) $= Color4 1 1 1 1-   position (Light 0) $= Vertex4  0 3 3 0-   lightModelAmbient $= Color4 0.2 0.2 0.2 1-   lightModelLocalViewer $= Disabled--   frontFace $= CW-   lighting $= Enabled-   light (Light 0) $= Enabled-   autoNormal $= Enabled-   normalize $= Enabled-   depthFunc $= Just Less-   -- be efficient--make teapot display list-   defineNewList Compile $-      renderObject Solid (Teapot 1)---- Move object into position, specify the material properties, draw a teapot.-renderTeapot :: DisplayList -> Vector3 GLfloat -> Color4 GLfloat-             -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> IO ()-renderTeapot teapotList pos amb dif spec shine = do-   preservingMatrix $ do-      translate pos-      materialAmbient Front $= amb-      materialDiffuse Front $= dif-      materialSpecular Front $= spec-      materialShininess Front $= shine * 128-      callList teapotList---- 1st column: emerald, jade, obsidian, pearl, ruby, turquoise--- 2nd column: brass, bronze, chrome, copper, gold, silver--- 3rd column: black, cyan, green, red, white, yellow plastic--- 4th column: black, cyan, green, red, white, yellow rubber-display :: DisplayList -> DisplayCallback-display teapotList = do-   clear [ ColorBuffer, DepthBuffer ]-   renderTeapot teapotList-                (Vector3  2 17 0)-                (Color4 0.0215    0.1745      0.0215     1)-                (Color4 0.07568   0.61424     0.07568    1)-                (Color4 0.633     0.727811    0.633      1)-                0.6-   renderTeapot teapotList-                (Vector3  2 14 0)-                (Color4 0.135     0.2225      0.1575     1)-                (Color4 0.54      0.89        0.63       1)-                (Color4 0.316228  0.316228    0.316228   1)-                0.1-   renderTeapot teapotList-                (Vector3  2 11 0)-                (Color4 0.05375   0.05        0.06625    1)-                (Color4 0.18275   0.17        0.22525    1)-                (Color4 0.332741  0.328634    0.346435   1)-                0.3-   renderTeapot teapotList-                (Vector3  2  8 0)-                (Color4 0.25      0.20725     0.20725    1)-                (Color4 1         0.829       0.829      1)-                (Color4 0.296648  0.296648    0.296648   1)-                0.088-   renderTeapot teapotList-                (Vector3  2  5 0)-                (Color4 0.1745    0.01175     0.01175    1)-                (Color4 0.61424   0.04136     0.04136    1)-                (Color4 0.727811  0.626959    0.626959   1)-                0.6-   renderTeapot teapotList-                (Vector3  2  2 0)-                (Color4 0.1       0.18725     0.1745     1)-                (Color4 0.396     0.74151     0.69102    1)-                (Color4 0.297254  0.30829     0.306678   1)-                0.1-   renderTeapot teapotList-                (Vector3  6 17 0)-                (Color4 0.329412  0.223529    0.027451   1)-                (Color4 0.780392  0.568627    0.113725   1)-                (Color4 0.992157  0.941176    0.807843   1)-                0.21794872-   renderTeapot teapotList-                (Vector3  6 14 0)-                (Color4 0.2125    0.1275      0.054      1)-                (Color4 0.714     0.4284      0.18144    1)-                (Color4 0.393548  0.271906    0.166721   1)-                0.2-   renderTeapot teapotList-                (Vector3  6 11 0)-                (Color4 0.25      0.25        0.25       1)-                (Color4 0.4       0.4         0.4        1)-                (Color4 0.774597  0.774597    0.774597   1)-                0.6-   renderTeapot teapotList-                (Vector3  6  8 0)-                (Color4 0.19125   0.0735      0.0225     1)-                (Color4 0.7038    0.27048     0.0828     1)-                (Color4 0.256777  0.137622    0.086014   1)-                0.1-   renderTeapot teapotList-                (Vector3  6  5 0)-                (Color4 0.24725   0.1995      0.0745     1)-                (Color4 0.75164   0.60648     0.22648    1)-                (Color4 0.628281  0.555802    0.366065   1)-                0.4-   renderTeapot teapotList-                (Vector3  6  2 0)-                (Color4 0.19225   0.19225     0.19225    1)-                (Color4 0.50754   0.50754     0.50754    1)-                (Color4 0.508273  0.508273    0.508273   1)-                0.4-   renderTeapot teapotList-                (Vector3 10 17 0)-                (Color4 0         0           0          1)-                (Color4 0.01      0.01        0.01       1)-                (Color4 0.50      0.50        0.50       1)-                0.25-   renderTeapot teapotList-                (Vector3 10 14 0)-                (Color4 0          0.1        0.06       1)-                (Color4 0          0.50980392 0.50980392 1)-                (Color4 0.50196078 0.50196078 0.50196078 1)-                0.25-   renderTeapot teapotList-                (Vector3 10 11 0)-                (Color4 0         0           0          1)-                (Color4 0.1       0.35        0.1        1)-                (Color4 0.45      0.55        0.45       1)-                0.25-   renderTeapot teapotList-                (Vector3 10  8 0)-                (Color4 0         0           0          1)-                (Color4 0.5       0           0          1)-                (Color4 0.7       0.6         0.6        1)-                0.25-   renderTeapot teapotList-                (Vector3 10  5 0)-                (Color4 0         0           0          1)-                (Color4 0.55      0.55        0.55       1)-                (Color4 0.70      0.70        0.70       1)-                0.25-   renderTeapot teapotList-                (Vector3 10  2 0)-                (Color4 0         0           0          1)-                (Color4 0.5       0.5         0          1)-                (Color4 0.60      0.60        0.50       1)-                0.25-   renderTeapot teapotList-                (Vector3 14 17 0)-                (Color4 0.02      0.02        0.02       1)-                (Color4 0.01      0.01        0.01       1)-                (Color4 0.4       0.4         0.4        1)-                0.078125-   renderTeapot teapotList-                (Vector3 14 14 0)-                (Color4 0         0.05        0.05       1)-                (Color4 0.4       0.5         0.5        1)-                (Color4 0.04      0.7         0.7        1)-                0.078125-   renderTeapot teapotList-                (Vector3 14 11 0)-                (Color4 0         0.05        0          1)-                (Color4 0.4       0.5         0.4        1)-                (Color4 0.04      0.7         0.04       1)-                0.078125-   renderTeapot teapotList-                (Vector3 14  8 0)-                (Color4 0.05      0           0          1)-                (Color4 0.5       0.4         0.4        1)-                (Color4 0.7       0.04        0.04       1)-                0.078125-   renderTeapot teapotList-                (Vector3 14  5 0)-                (Color4 0.05      0.05        0.05       1)-                (Color4 0.5       0.5         0.5        1)-                (Color4 0.7       0.7         0.7        1)-                0.078125-   renderTeapot teapotList-                (Vector3 14  2 0)-                (Color4 0.05      0.05        0          1)-                (Color4 0.5       0.5         0.4        1)-                (Color4 0.7       0.7         0.04       1)-                0.078125-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho 0 16 0 (16 * hf/wf) (-10) 10-      else ortho 0 (16 * wf/hf) 0 16 (-10) 10-   matrixMode $= Modelview 0--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 600-   initialWindowPosition $= Position 50 50-   createWindow progName-   teapotList <- myInit-   reshapeCallback $= Just reshape-   displayCallback $= display teapotList-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Tess.hs 
@@ -1,117 +0,0 @@-{--   Tess.hs (adapted from tess.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates polygon tessellation. Two tesselated objects are-   drawn. The first is a rectangle with a triangular hole. The second is a-   smooth shaded, self-intersecting star.--   Note the exterior rectangle is drawn with its vertices in counter-clockwise-   order, but its interior clockwise. Note the combineCallback is needed for the-   self-intersecting star. Also note that removing the TessProperty for the-   star will make the interior unshaded (TessWindingOdd).--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--display :: [DisplayList] -> DisplayCallback-display displayLists = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-   color3f (Color3 1 1 1)-   mapM callList displayLists-   flush---- 'Float' is a dummy, any marshalable type would do-type DontCare = Float--rectangle :: ComplexContour DontCare-rectangle = ComplexContour [-   AnnotatedVertex (Vertex3  50  50 0) 0,-   AnnotatedVertex (Vertex3 200  50 0) 0,-   AnnotatedVertex (Vertex3 200 200 0) 0,-   AnnotatedVertex (Vertex3  50 200 0) 0 ]--tri :: ComplexContour DontCare-tri = ComplexContour [-   AnnotatedVertex (Vertex3  75  75 0) 0,-   AnnotatedVertex (Vertex3 125 175 0) 0,-   AnnotatedVertex (Vertex3 175  75 0) 0 ]--rectAndTri :: ComplexPolygon DontCare-rectAndTri = ComplexPolygon [ rectangle, tri ]--noOpCombiner :: Combiner DontCare-noOpCombiner _newVertex _weightedProperties = 0--star :: ComplexPolygon (Color3 GLclampf)-star = ComplexPolygon [-   ComplexContour [-      AnnotatedVertex (Vertex3 250  50 0) (Color3 1 0 1),-      AnnotatedVertex (Vertex3 325 200 0) (Color3 1 1 0),-      AnnotatedVertex (Vertex3 400  50 0) (Color3 0 1 1),-      AnnotatedVertex (Vertex3 250 150 0) (Color3 1 0 0),-      AnnotatedVertex (Vertex3 400 150 0) (Color3 0 1 0) ] ]--combineColors :: Combiner (Color3 GLclampf)-combineColors-   _newVertex-   (WeightedProperties-      (w0, Color3 r0 g0 b0)-      (w1, Color3 r1 g1 b1)-      (w2, Color3 r2 g2 b2)-      (w3, Color3 r3 g3 b3)) =-         Color3 (w0*r0 + w1*r1 + w2*r2 + w3*r3)-                (w0*g0 + w1*g1 + w2*g2 + w3*g3)-                (w0*b0 + w1*b1 + w2*b2 + w3*b3)--myInit :: IO [DisplayList]-myInit = do-   clearColor $= Color4 0 0 0 0--   rectAndTriList <- defineNewList Compile $-      drawSimplePolygon (\_ -> return ()) =<<-         tessellate TessWindingOdd 0 (Normal3 0 0 0) noOpCombiner rectAndTri--   starList <- defineNewList Compile $-      drawSimplePolygon color =<<-         tessellate TessWindingPositive 0 (Normal3 0 0 0) combineColors star--   return [ rectAndTriList, starList ]--drawSimplePolygon :: (v -> IO ()) -> SimplePolygon v -> IO ()-drawSimplePolygon colorHandler (SimplePolygon primitives) =-   flip mapM_ primitives $ \(Primitive primitiveMode vertices) ->-      renderPrimitive primitiveMode $-         flip mapM_ vertices $ \(AnnotatedVertex plainVertex col) -> do-            colorHandler col-            vertex plainVertex--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   createWindow progName-   displayLists <- myInit-   displayCallback $= display displayLists-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/TessWind.hs 
@@ -1,195 +0,0 @@-{--   TessWind.hs (adapted from tesswind.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the winding rule polygon tessellation property.-   Four tessellated objects are drawn, each with very different contours. When-   the w key is pressed, the objects are drawn with a different winding rule.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { currentWindingRule :: IORef TessWinding }--makeState :: IO State-makeState = do-   c <- newIORef TessWindingOdd-   return $ State { currentWindingRule = c }--type DisplayLists = (DisplayList, DisplayList, DisplayList, DisplayList)---- 'Float' is a dummy, any marshalable type would do-type DontCare = Float--rect1 :: ComplexContour DontCare-rect1 = ComplexContour [-   AnnotatedVertex (Vertex3  50  50 0) 0,-   AnnotatedVertex (Vertex3 300  50 0) 0,-   AnnotatedVertex (Vertex3 300 300 0) 0,-   AnnotatedVertex (Vertex3  50 300 0) 0 ]--rect2 :: ComplexContour DontCare-rect2 = ComplexContour [-   AnnotatedVertex (Vertex3 100 100 0) 0,-   AnnotatedVertex (Vertex3 250 100 0) 0,-   AnnotatedVertex (Vertex3 250 250 0) 0,-   AnnotatedVertex (Vertex3 100 250 0) 0 ]--rect3 :: ComplexContour DontCare-rect3 = ComplexContour [-   AnnotatedVertex (Vertex3 150 150 0) 0,-   AnnotatedVertex (Vertex3 200 150 0) 0,-   AnnotatedVertex (Vertex3 200 200 0) 0,-   AnnotatedVertex (Vertex3 150 200 0) 0 ]--rects1 :: ComplexPolygon DontCare-rects1 = ComplexPolygon [ rect1, rect2, rect3 ]--rects2 :: ComplexPolygon DontCare-rects2 = ComplexPolygon [-   rect1, reverseComplexContour rect2, reverseComplexContour rect3 ]--spiral :: ComplexPolygon DontCare-spiral = ComplexPolygon [-   ComplexContour [-      AnnotatedVertex (Vertex3 400 250 0) 0,-      AnnotatedVertex (Vertex3 400  50 0) 0,-      AnnotatedVertex (Vertex3  50  50 0) 0,-      AnnotatedVertex (Vertex3  50 400 0) 0,-      AnnotatedVertex (Vertex3 350 400 0) 0,-      AnnotatedVertex (Vertex3 350 100 0) 0,-      AnnotatedVertex (Vertex3 100 100 0) 0,-      AnnotatedVertex (Vertex3 100 350 0) 0,-      AnnotatedVertex (Vertex3 300 350 0) 0,-      AnnotatedVertex (Vertex3 300 150 0) 0,-      AnnotatedVertex (Vertex3 150 150 0) 0,-      AnnotatedVertex (Vertex3 150 300 0) 0,-      AnnotatedVertex (Vertex3 250 300 0) 0,-      AnnotatedVertex (Vertex3 250 200 0) 0,-      AnnotatedVertex (Vertex3 200 200 0) 0,-      AnnotatedVertex (Vertex3 200 250 0) 0 ] ]--quad1 :: ComplexContour DontCare-quad1 = ComplexContour [-   AnnotatedVertex (Vertex3  50 150 0) 0,-   AnnotatedVertex (Vertex3 350 150 0) 0,-   AnnotatedVertex (Vertex3 350 200 0) 0,-   AnnotatedVertex (Vertex3  50 200 0) 0 ]--quad2 :: ComplexContour DontCare-quad2 = ComplexContour [-   AnnotatedVertex (Vertex3 100 100 0) 0,-   AnnotatedVertex (Vertex3 300 100 0) 0,-   AnnotatedVertex (Vertex3 300 350 0) 0,-   AnnotatedVertex (Vertex3 100 350 0) 0 ]--tri :: ComplexContour DontCare-tri = ComplexContour [-   AnnotatedVertex (Vertex3 200  50 0) 0,-   AnnotatedVertex (Vertex3 250 300 0) 0,-   AnnotatedVertex (Vertex3 150 300 0) 0 ]--quadsAndTri :: ComplexPolygon DontCare-quadsAndTri = ComplexPolygon [ quad1, quad2, tri ]--reverseComplexContour :: ComplexContour DontCare -> ComplexContour DontCare-reverseComplexContour (ComplexContour avs) = ComplexContour (reverse avs)--makeNewLists :: State -> DisplayLists -> IO ()-makeNewLists state (dl1, dl2, dl3, dl4) = do-   windingRule <- get (currentWindingRule state)-   print windingRule   -- not in original program, but useful-   compileList windingRule dl1 rects1-   compileList windingRule dl2 rects2-   compileList windingRule dl3 spiral-   compileList windingRule dl4 quadsAndTri--compileList :: TessWinding -> DisplayList -> ComplexPolygon DontCare -> IO ()-compileList windingRule displayList complexPolygon =-   defineList displayList Compile $-      drawSimplePolygon =<<-         tessellate windingRule 0 (Normal3 0 0 0) noOpCombiner complexPolygon--noOpCombiner :: Combiner DontCare-noOpCombiner _newVertex _weightedProperties = 0--drawSimplePolygon :: SimplePolygon DontCare -> IO ()-drawSimplePolygon (SimplePolygon primitives) =-   flip mapM_ primitives $ \(Primitive primitiveMode vertices) ->-      renderPrimitive primitiveMode $-         flip mapM_ vertices $ \(AnnotatedVertex plainVertex _) ->-            vertex plainVertex--display :: DisplayLists -> DisplayCallback-display (dl1, dl2, dl3, dl4) = do-   clear [ ColorBuffer ]-   -- resolve overloading, not needed in "real" programs-   let color3f = color :: Color3 GLfloat -> IO ()-       translatef = translate :: Vector3 GLfloat -> IO ()-   color3f (Color3 1 1 1)-   preservingMatrix $ do-      callList dl1-      translatef (Vector3   0   500  0)-      callList dl2-      translatef (Vector3 500 (-500) 0)-      callList dl3-      translatef (Vector3   0   500  0)-      callList dl4-   flush--myInit :: State -> IO DisplayLists-myInit state = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   [dl1, dl2, dl3, dl4] <- genObjectNames 4-   let displayLists = (dl1, dl2, dl3, dl4)-   makeNewLists state displayLists-   return displayLists--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho2D 0 1000 0 (1000 * hf/wf)-      else ortho2D 0 (1000 * wf/hf) 0 1000-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: State -> DisplayLists -> KeyboardMouseCallback-keyboard state displayLists (Char c) Down _ _ = case toLower c of-   'w'   -> do currentWindingRule state $~ nextWindingRule-               makeNewLists state displayLists-               postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ _ = return ()--nextWindingRule :: TessWinding -> TessWinding-nextWindingRule r = case r of-   TessWindingOdd       -> TessWindingNonzero-   TessWindingNonzero   -> TessWindingPositive-   TessWindingPositive  -> TessWindingNegative-   TessWindingNegative  -> TessWindingAbsGeqTwo-   TessWindingAbsGeqTwo -> TessWindingOdd--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   createWindow progName-   state <- makeState-   displayLists <- myInit state-   displayCallback $= display displayLists-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state displayLists)-   mainLoop
− examples/RedBook/TexBind.hs 
@@ -1,108 +0,0 @@-{--   TexBind.hs  (adapted from texbind.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates using textureBinding by creating and managing-   two textures.--}--import Control.Monad ( when )-import Data.Bits ( (.&.) )-import Foreign ( withArray )-import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Create checkerboard image-checkImageSize :: TextureSize2D-checkImageSize = TextureSize2D 64 64--withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))-               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()-withCheckImage (TextureSize2D w h) n f act =-   withArray [ f c |-               i <- [ 0 .. w - 1 ],-               j <- [ 0 .. h - 1 ],-               let c | (i .&. n) == (j .&. n) = 0-                     | otherwise              = 255 ] $-   act . PixelData RGBA UnsignedByte--myInit :: IO (TextureObject, TextureObject)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less-   rowAlignment Unpack $= 1--   [texName0, texName1] <- genObjectNames 2-   textureBinding Texture2D $= Just texName0-   textureWrapMode Texture2D S $= (Repeated, Clamp)-   textureWrapMode Texture2D T $= (Repeated, Clamp)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   withCheckImage checkImageSize 0x08 (\c -> Color4 c c c 255) $-      texImage2D Nothing NoProxy 0  RGBA' checkImageSize 0--   textureBinding Texture2D $= Just texName1-   textureWrapMode Texture2D S $= (Repeated, Clamp)-   textureWrapMode Texture2D T $= (Repeated, Clamp)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   textureFunction $= Decal-   withCheckImage checkImageSize 0x10 (\c -> Color4 c 0 0 255) $-      texImage2D Nothing NoProxy 0  RGBA' checkImageSize 0-   texture Texture2D $= Enabled-   return (texName0, texName1)--display ::  (TextureObject, TextureObject) -> DisplayCallback-display (texName0, texName1) = do-   clear [ ColorBuffer, DepthBuffer ]-   -- resolve overloading, not needed in "real" programs-   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   textureBinding Texture2D $= Just texName0-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )-   textureBinding Texture2D $= Just texName1-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-3.6 :: GLfloat))--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   version <- get (majorMinor glVersion)-   when (version == (1,0)) $ do-      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."-      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure-   texNames <- myInit-   reshapeCallback $= Just reshape-   displayCallback $= display texNames-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/TexGen.hs 
@@ -1,132 +0,0 @@-{--   TexGen.hs  (adapted from texgen.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws a texture mapped teapot with automatically generated-   texture coordinates. The texture is rendered as stripes on the teapot.-   Initially, the object is drawn with texture coordinates based upon the-   object coordinates of the vertex and distance from the plane x = 0.-   Pressing the 'e' key changes the coordinate generation to eye coordinates-   of the vertex. Pressing the 'o' key switches it back to the object-   coordinates. Pressing the 's' key changes the plane to a slanted one-   (x + y + z = 0). Pressing the 'x' key switches it back to x = 0.--}--import Control.Monad ( when )-import Data.Char ( toLower )-import Data.Maybe ( isJust, listToMaybe )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--stripeImageWidth :: TextureSize1D-stripeImageWidth = TextureSize1D 32--xEqualZero, slanted :: Plane GLdouble-xEqualZero = Plane 1 0 0 0-slanted    = Plane 1 1 1 0--withStripeImage :: (PixelData (Color4 GLubyte) -> IO a) -> IO a-withStripeImage act =-   withArray [ Color4 (if j <= 4 then 255 else 0)-                      (if j >  4 then 255 else 0)-                      0-                      255-             | j <- [ 0 .. w - 1 ] ] $-      act . PixelData RGBA UnsignedByte-   where TextureSize1D w = stripeImageWidth--myInit :: IO (Maybe TextureObject)-myInit = do-   clearColor $= Color4 0 0 0 0-   depthFunc $= Just Less-   shadeModel $= Smooth-   rowAlignment Unpack $= 1--   exts <- get glExtensions-   mbTexName <- if "GL_EXT_texture_object" `elem` exts-                   then fmap listToMaybe $ genObjectNames 1-                   else return Nothing-   when (isJust mbTexName) $ textureBinding Texture1D $= mbTexName--   textureWrapMode Texture1D S $= (Repeated, Repeat)-   textureFilter Texture1D $= ((Linear', Nothing), Linear')-   withStripeImage $ texImage1D NoProxy 0  RGBA' stripeImageWidth 0--   textureFunction $= Modulate-   textureGenMode S $= Just (ObjectLinear xEqualZero)--   texture Texture1D $= Enabled-   lighting $= Enabled-   light (Light 0) $= Enabled-   autoNormal $= Enabled-   normalize $= Enabled-   frontFace $= CW-   cullFace $= Just Back-   materialShininess Front $= 64-   return mbTexName--display ::  Maybe TextureObject -> DisplayCallback-display mbTexName = do-   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (45 :: GLfloat) (Vector3 0 0 1)-      when (isJust mbTexName) $ textureBinding Texture1D $= mbTexName-      renderObject Solid (Teapot 2)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-3.5) 3.5 (-3.5*hf/wf) (3.5*hf/wf) (-3.5) 3.5-      else ortho (-3.5*wf/hf) (3.5*wf/hf) (-3.5) 3.5 (-3.5) 3.5-   matrixMode $= Modelview 0-   loadIdentity--keyboard :: KeyboardMouseCallback-keyboard (Char c) Down _ _ = case toLower c of-   'e'   -> setGenMode EyeLinear-   'o'   -> setGenMode ObjectLinear-   's'   -> setPlane slanted-   'x'   -> setPlane xEqualZero-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ = return ()--setGenMode :: (Plane GLdouble -> TextureGenMode) -> IO ()-setGenMode mode = do-   currentGenMode <- get (textureGenMode S)-   case currentGenMode of-      Just (EyeLinear    plane) -> textureGenMode S $= Just (mode plane)-      Just (ObjectLinear plane) -> textureGenMode S $= Just (mode plane)-      _ -> error "setGenMode: should never happen..."-   postRedisplay Nothing--setPlane :: Plane GLdouble -> IO ()-setPlane plane = do-   currentGenMode <- get (textureGenMode S)-   case currentGenMode of-      Just (EyeLinear    _) -> textureGenMode S $= Just (EyeLinear    plane)-      Just (ObjectLinear _) -> textureGenMode S $= Just (ObjectLinear plane)-      _ -> error "setPlane: should never happen..."-   postRedisplay Nothing--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 256 256-   initialWindowPosition $= Position 100 100-   createWindow progName-   mbTexName <- myInit-   displayCallback $= display mbTexName-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/TexProx.hs 
@@ -1,58 +0,0 @@-{--   TexProx.hs (adapted from texprox.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   The brief program illustrates use of texture proxies. This program only-   prints out some messages about whether certain size textures are supported-   and then exits.--}--import Control.Monad ( when )-import Foreign.Ptr ( nullPtr )-import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--myInit :: IO ()-myInit = do-   let check = do-          ok <- get (textureProxyOK (Left Texture2D) 0)-          putStrLn ("proxy allocation " ++ if ok then "succeeded" else "failed")--   texImage2D Nothing Proxy 0 RGBA8 (TextureSize2D 64 64) 0 (PixelData RGBA UnsignedByte nullPtr)-   check--   -- Note: We use a larger texture size here to demonstrate failure,-   -- modern graphic cards can handle the original size.-   texImage2D Nothing Proxy 0 RGBA16 (TextureSize2D 8192 8192) 0 (PixelData RGBA UnsignedShort nullPtr)-   check---display :: DisplayCallback-display = exitWith ExitSuccess--reshape :: ReshapeCallback-reshape size = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   version <- get (majorMinor glVersion)-   when (version == (1,0)) $ do-      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."-      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   mainLoop
− examples/RedBook/TexSub.hs 
@@ -1,120 +0,0 @@-{--   TexSub.hs  (adapted from texsub.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program texture maps a checkerboard image onto two rectangles. This-   program clamps the texture, if the texture coordinates fall outside 0.0-   and 1.0. If the s key is pressed, a texture subimage is used to alter the-   original texture. If the r key is pressed, the original texture is restored.--}--import Control.Monad ( when )-import Data.Char ( toLower )-import Data.Bits ( (.&.) )-import Foreign ( newArray )-import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--checkImageSize, subImageSize :: TextureSize2D-checkImageSize = TextureSize2D 64 64-subImageSize   = TextureSize2D 16 16--type Image = PixelData (Color4 GLubyte)--makeCheckImage ::-   TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte)) -> IO Image-makeCheckImage (TextureSize2D w h) n f =-   fmap (PixelData RGBA UnsignedByte) $-      newArray [ f c |-                 i <- [ 0 .. w - 1 ],-                 j <- [ 0 .. h - 1 ],-                 let c | (i .&. n) == (j .&. n) = 0-                       | otherwise              = 255 ]--myInit :: IO (TextureObject, Image, Image)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less--   checkImage <- makeCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255)-   subImage   <- makeCheckImage subImageSize   0x4 (\c -> Color4 c 0 0 255)-   rowAlignment Unpack $= 1--   [texName] <- genObjectNames 1-   textureBinding Texture2D $= Just texName--   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   texImage2D Nothing NoProxy 0  RGBA' checkImageSize 0 checkImage-   return (texName, checkImage, subImage)--display :: TextureObject -> DisplayCallback-display texName = do-   clear [ ColorBuffer, DepthBuffer ]-   texture Texture2D $= Enabled-   textureFunction $= Decal-   textureBinding Texture2D $= Just texName--   -- resolve overloading, not needed in "real" programs-   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )--      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )-      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))-      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))-   flush-   texture Texture2D $= Disabled--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-3.6 :: GLfloat))--keyboard :: TextureObject -> Image -> Image -> KeyboardMouseCallback-keyboard texName checkImage subImage (Char c) Down _ _ = case toLower c of-   's' -> do-      textureBinding Texture2D $= Just texName-      texSubImage2D Nothing 0 (TexturePosition2D 12 44) subImageSize subImage-      postRedisplay Nothing-   'r' -> do-      textureBinding Texture2D $= Just texName-      texImage2D Nothing NoProxy 0 RGBA' checkImageSize 0 checkImage-      postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _ -> return ()-keyboard _ _ _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   version <- get (majorMinor glVersion)-   when (version == (1,0)) $ do-      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."-      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure-   (texName, checkImage, subImage) <- myInit-   displayCallback $= display texName-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard texName checkImage subImage)-   mainLoop
− examples/RedBook/Texture3D.hs 
@@ -1,94 +0,0 @@-{--   Texture3D.hs  (adapted from texture3d.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates using a three-dimensional texture. It creates-   a 3D texture and then renders two rectangles with different texture-   coordinates to obtain different "slices" of the 3D texture.--}--import Control.Monad ( unless )-import Foreign ( withArray )-import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Create checkerboard image-imageSize :: TextureSize3D-imageSize = TextureSize3D 16 16 16--withImage :: (PixelData (Color3 GLubyte) -> IO ()) -> IO ()-withImage act =-   withArray [ Color3 (s * 17) (t * 17) (r * 17) |-               r <- [ 0 .. fromIntegral d - 1 ],-               t <- [ 0 .. fromIntegral h - 1 ],-               s <- [ 0 .. fromIntegral w - 1 ] ] $-   act . PixelData RGB UnsignedByte-   where (TextureSize3D w h d) = imageSize--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less-   rowAlignment Unpack $= 1--   [texName] <- genObjectNames 1-   textureBinding Texture3D $= Just texName-   textureWrapMode Texture3D S $= (Repeated, Clamp)-   textureWrapMode Texture3D T $= (Repeated, Clamp)-   textureWrapMode Texture3D R $= (Repeated, Clamp)-   textureFilter Texture3D $= ((Nearest, Nothing), Nearest)-   withImage $ texImage3D NoProxy 0  RGB' imageSize 0-   texture Texture3D $= Enabled--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   -- resolve overloading, not needed in "real" programs-   let texCoord3f = texCoord :: TexCoord3 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Quads $ do-      texCoord3f (TexCoord3 0 0 0); vertex3f (Vertex3 (-2.25) (-1) 0)-      texCoord3f (TexCoord3 0 1 0); vertex3f (Vertex3 (-2.25)   1  0)-      texCoord3f (TexCoord3 1 1 1); vertex3f (Vertex3 (-0.25)   1  0)-      texCoord3f (TexCoord3 1 0 1); vertex3f (Vertex3 (-0.25) (-1) 0)--      texCoord3f (TexCoord3 0 0 1); vertex3f (Vertex3   0.25  (-1) 0)-      texCoord3f (TexCoord3 0 1 1); vertex3f (Vertex3   0.25    1  0)-      texCoord3f (TexCoord3 1 1 0); vertex3f (Vertex3   2.25    1  0)-      texCoord3f (TexCoord3 1 0 0); vertex3f (Vertex3   2.25  (-1) 0)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-4 :: GLfloat))--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   exts <- get glExtensions-   unless ("GL_EXT_texture3D" `elem` exts) $ do-      putStrLn "Sorry, this demo requires the GL_EXT_texture3D extension."-      exitFailure-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/TextureSurf.hs 
@@ -1,99 +0,0 @@-{--   TextureSurf.hs (adapted from texturesurf.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program uses evaluators to generate a curved surface and automatically-   generated texture coordinates.--}--import Data.List ( transpose )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--ctrlPoints :: [[Vertex3 GLfloat]]-ctrlPoints = [-   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,-     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],-   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,-     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],-   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,-     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],-   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),-     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]--texPts :: [[TexCoord2 GLfloat]]-texPts = [-   [ TexCoord2 0 0, TexCoord2 0 1 ],-   [ TexCoord2 1 0, TexCoord2 1 1 ]]--display :: DisplayCallback-display = do-   clear [ ColorBuffer, DepthBuffer ]-   color (Color3 1 1 1 :: Color3 GLfloat)-   evalMesh2 Fill (0, 20) (0, 20)-   flush--imageSize :: TextureSize2D-imageSize = TextureSize2D 64 64--withImage :: (PixelData (Color3 GLubyte) -> IO ()) -> IO ()-withImage act =-   withArray [ Color3 (s (sin ti)) (s (cos (2 * tj))) (s (cos (ti + tj))) |-               i <- [ 0 .. fromIntegral w - 1 ],-               let ti = 2 * pi * i / fromIntegral w,-               j <- [ 0 .. fromIntegral h - 1 ],-               let tj = 2 * pi * j / fromIntegral h ] $-   act . PixelData RGB UnsignedByte-   where (TextureSize2D w h) = imageSize-         s :: Double -> GLubyte-         s x = truncate (127 * (1 + x))--myInit :: IO ()-myInit = do-   m <- newMap2 (0, 1) (0, 1) (transpose ctrlPoints)-   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)-   t <- newMap2 (0, 1) (0, 1) (transpose texPts)-   map2 $= Just (t :: GLmap2 TexCoord2 GLfloat)-   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))-   textureFunction $= Decal-   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   withImage $ texImage2D Nothing NoProxy 0 RGB' imageSize 0-   texture Texture2D $= Enabled-   depthFunc $= Just Less-   shadeModel $= Flat--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   let wf = fromIntegral w-       hf = fromIntegral h-   if w <= h-      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0-      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0-   matrixMode $= Modelview 0-   loadIdentity-   rotate (85 :: GLfloat) (Vector3 1 1 1)--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/Torus.hs 
@@ -1,93 +0,0 @@-{--   Torus.hs (adapted from torus.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2006 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates the creation of a display list.--}--import Data.Char ( toLower )-import Data.IORef ( IORef, newIORef )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--data State = State { spinX, spinY :: IORef GLfloat }--makeState :: IO State-makeState = do-   x <- newIORef 0-   y <- newIORef 0-   return $ State { spinX = x, spinY = y }--torus :: Int -> Int -> IO ()-torus numC numT = do-   let stepC = 2 * pi / fromIntegral numC :: GLfloat-       stepT = 2 * pi / fromIntegral numT-   flip mapM_ [ 0 .. numC - 1 ] $ \i ->-      renderPrimitive QuadStrip $-         flip mapM_ [ 0 .. numT ] $ \j ->-            flip mapM_ [ 1, 0 ] $ \k -> do-               let s = (fromIntegral ((i + k) `mod` numC) + 0.5) * stepC-                   t = (fromIntegral (      j `mod` numT)      ) * stepT-                   x = (1 + 0.1 * cos s) * cos t-                   y = (1 + 0.1 * cos s) * sin t-                   z =      0.1 * sin s-               vertex (Vertex3 x y z)--myInit :: IO DisplayList-myInit = do-   theTorus <- defineNewList Compile $-      torus 8 25-   shadeModel $= Flat-   clearColor $= Color4 0 0 0 0-   return theTorus--display :: State -> DisplayList -> DisplayCallback-display state theTorus = do-   clear [ ColorBuffer ]-   loadIdentity-   lookAt (Vertex3 0 0 10) (Vertex3 0 0 0) (Vector3 0 1 0)-   x <- get (spinX state)-   rotate x (Vector3 1 0 0)-   y <- get (spinY state)-   rotate y (Vector3 0 1 0)-   color (Color3 1 1 (1 :: GLfloat))-   callList theTorus-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective  30 (fromIntegral w / fromIntegral h) 1 100-   matrixMode $= Modelview 0--incSpin :: IORef GLfloat -> IO ()-incSpin spinRef = do-   let wrap n s = if s > n then s - n else s-   spinRef $~ (wrap 360 . (+ 30))-   postRedisplay Nothing--keyboard :: State -> KeyboardMouseCallback-keyboard state (Char c) Down _ _ = case toLower c of-   'x'   -> incSpin (spinX state)-   'y'   -> incSpin (spinY state)-   'i'   -> do spinX state $= 0; spinY state $= 0; postRedisplay Nothing-   '\27' -> exitWith ExitSuccess-   _     -> return ()-keyboard _ _ _ _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 200 200-   createWindow progName-   state <- makeState-   theTorus <- myInit-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboard state)-   displayCallback $= display state theTorus-   mainLoop
− examples/RedBook/Trim.hs 
@@ -1,107 +0,0 @@-{--   Trim.hs (adapted from trim.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program draws a NURBS surface in the shape of a symmetrical hill,-   using both a NURBS curve and pwl (piecewise linear) curve to trim part-   of the surface.--   NOTE: This example does NOT demonstrate the final NURBS API, it's currently-   just a test for the internals...--}--import Foreign.Marshal ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- The control points of the surface form a small hill and--- range from -3 to +3 in x, y, and z.-ctlPoints :: [[Vertex3 GLfloat]]-ctlPoints =-   [ [ Vertex3 (2 * u - 3)-               (2 * v - 3)-               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)-     | v <- [ 0 .. 3 ] ]-   | u <- [ 0 .. 3 ]]--myInit :: IO ()-myInit = do-   clearColor $= Color4 0 0 0 0-   materialDiffuse Front $= Color4 0.7 0.7 0.7 1-   materialSpecular Front $= Color4 1 1 1 1-   materialShininess Front $= 100--   lighting $= Enabled-   light (Light 0) $= Enabled-   depthFunc $= Just Less-   autoNormal $= Enabled-   normalize $= Enabled------------------------------------------------------------------------------------display :: DisplayCallback-display = do-   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]-       edgePt = -- counter clockwise-          [ Vertex2 0 0, Vertex2 1 0, Vertex2 1 1, Vertex2 0 1, Vertex2 0 0 ] :: [Vertex2 GLfloat]-       curvePt = -- clockwise-          [ Vertex2 0.25 0.5, Vertex2 0.25 0.75, Vertex2 0.75 0.75, Vertex2 0.75 0.5 ]  :: [Vertex2 GLfloat]-       curveKnots =-          [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]-       pwlPt = -- clockwise-          [Vertex2 0.75 0.5, Vertex2 0.5 0.25, Vertex2 0.25 0.5 ] :: [Vertex2 GLfloat]--   clear [ ColorBuffer, DepthBuffer ]-   preservingMatrix $ do-      rotate (330 :: GLfloat) (Vector3 1 0 0)-      scale 0.5 0.5 (0.5 :: GLfloat)--      withNURBSObj () $ \nurbsObj -> do-         setSamplingMethod nurbsObj (PathLength 25)-         setDisplayMode' nurbsObj Fill'-         checkForNURBSError nurbsObj $-            nurbsBeginEndSurface nurbsObj $-               withArray (concat ctlPoints) $ \cBuf ->-                  withArray knots $ \kBuf -> do-                     nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4-                     nurbsBeginEndTrim nurbsObj $-                        withArray edgePt $ \edgePtBuf ->-                           pwlCurve nurbsObj 5 edgePtBuf 2-                     nurbsBeginEndTrim nurbsObj $ do-                        withArray curveKnots $ \curveKnotsBuf ->-                           withArray curvePt $ \curvePtBuf ->-                              trimmingCurve nurbsObj 8 curveKnotsBuf 2 curvePtBuf 4-                        withArray pwlPt $ \pwlPtBuf ->-                           pwlCurve nurbsObj 3 pwlPtBuf 2--   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 (fromIntegral w / fromIntegral h) 3 8-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-5 :: GLfloat))--keyboard :: KeyboardMouseCallback-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()---- Main Loop-main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   myInit-   reshapeCallback $= Just reshape-   displayCallback $= display-   keyboardMouseCallback $= Just keyboard-   mainLoop
− examples/RedBook/UnProject.hs 
@@ -1,54 +0,0 @@-{--   UnProject.hs (adapted from unproject.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   When the left mouse button is pressed, this program reads the mouse-   position and determines two 3D points from which it was transformed.-   Very little is displayed.--}--import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT--display :: DisplayCallback-display = do-   clear [ ColorBuffer ]-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 45 (fromIntegral w / fromIntegral h) 1 100-   matrixMode $= Modelview 0-   loadIdentity--keyboardMouse :: KeyboardMouseCallback-keyboardMouse (MouseButton LeftButton)  Down _ (Position x y) = do-   v@(_, Size _ h) <- get viewport-   mvMatrix <- get (matrix (Just (Modelview 0))) :: IO (GLmatrix GLdouble)-   projMatrix <- get (matrix (Just Projection)) :: IO (GLmatrix GLdouble)-   let realY = h - y -1-   putStrLn ("Coordinates at cursor are (" ++ show x ++", " ++ show realY ++ ")")-   w0 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 0) mvMatrix projMatrix v-   putStrLn ("World coords at z=0.0 are " ++ show w0)-   w1 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 1) mvMatrix projMatrix v-   putStrLn ("World coords at z=1.0 are " ++ show w1)-keyboardMouse (MouseButton RightButton) Down _ _ = exitWith ExitSuccess-keyboardMouse (Char '\27')              Down _ _ = exitWith ExitSuccess-keyboardMouse _                         _    _ _ = return ()--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 500 500-   initialWindowPosition $= Position 100 100-   createWindow progName-   displayCallback $= display-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboardMouse-   mainLoop
− examples/RedBook/VArray.hs 
@@ -1,141 +0,0 @@-{--   VArray.hs (adapted from varray.c which is (c) Silicon Graphics, Inc.)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program demonstrates vertex arrays.--}--import Control.Monad ( when )-import Data.IORef ( IORef, newIORef )-import Foreign ( Ptr, newArray )-import System.Exit ( exitFailure, exitWith, ExitCode(..) )-import Graphics.UI.GLUT--data SetupMethod = Pointer | Interleaved-   deriving ( Eq, Bounded, Enum )--data DerefMethod = DrawArray | ArrayElement | DrawElements-   deriving ( Eq, Bounded, Enum )--makeVertices :: IO (Ptr (Vertex2 GLint))-makeVertices = newArray [-   Vertex2  25  25,-   Vertex2 100 325,-   Vertex2 175  25,-   Vertex2 175 325,-   Vertex2 250  25,-   Vertex2 325 325 ]--makeColors :: IO (Ptr (Color3 GLfloat))-makeColors = newArray [-   Color3 1.0  0.2  0.2,-   Color3 0.2  0.2  1.0,-   Color3 0.8  1.0  0.2,-   Color3 0.75 0.75 0.75,-   Color3 0.35 0.35 0.35,-   Color3 0.5  0.5  0.5 ]--makeIntertwined :: IO (Ptr GLfloat)-makeIntertwined = newArray [-   1.0, 0.2, 1.0, 100.0, 100.0, 0.0,-   1.0, 0.2, 0.2,   0.0, 200.0, 0.0,-   1.0, 1.0, 0.2, 100.0, 300.0, 0.0,-   0.2, 1.0, 0.2, 200.0, 300.0, 0.0,-   0.2, 1.0, 1.0, 300.0, 200.0, 0.0,-   0.2, 0.2, 1.0, 200.0, 100.0, 0.0 ]--makeIndices :: IO (Ptr GLuint)-makeIndices = newArray [ 0, 1, 3, 4 ]--data State = State {-   vertices    :: Ptr (Vertex2 GLint),-   colors      :: Ptr (Color3 GLfloat),-   intertwined :: Ptr GLfloat,-   indices     :: Ptr GLuint,-   setupMethod :: IORef SetupMethod,-   derefMethod :: IORef DerefMethod }--makeState :: IO State-makeState = do-   v <- makeVertices-   c <- makeColors-   i <- makeIntertwined-   n <- makeIndices-   s <- newIORef Pointer-   d <- newIORef DrawArray-   return $ State { vertices = v, colors = c, intertwined = i,-                    indices = n, setupMethod = s, derefMethod = d }--setup :: State -> IO ()-setup state = do-   s <- get (setupMethod state)-   case s of-      Pointer -> do-         clientState VertexArray $= Enabled-         clientState ColorArray $= Enabled-         arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 (vertices state)-         arrayPointer ColorArray $= VertexArrayDescriptor 3 Float 0 (colors state)-      Interleaved ->-         interleavedArrays C3fV3f 0 (intertwined state)--myInit :: State -> IO ()-myInit state = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Smooth-   setup state--display :: State -> DisplayCallback-display state = do-   clear [ ColorBuffer ]-   d <- get (derefMethod state)-   case d of-      DrawArray    -> drawArrays Triangles 0 6-      ArrayElement -> renderPrimitive Triangles $ mapM_ arrayElement [ 2, 3, 5 ]-      DrawElements -> drawElements Polygon 4 UnsignedInt (indices state)-   flush--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)-   -- the following line is not in the original example, but it's good style...-   matrixMode $= Modelview 0--keyboardMouse :: State -> KeyboardMouseCallback-keyboardMouse state (MouseButton LeftButton) Down _ _ = do-   setupMethod state $~ nextValue-   setup state-   postRedisplay Nothing-keyboardMouse state (MouseButton _) Down _ _ = do-   derefMethod state $~ nextValue-   postRedisplay Nothing-keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess-keyboardMouse _ _ _ _ _ = return ()--nextValue :: (Eq a, Bounded a, Enum a) => a -> a-nextValue x = if x == maxBound then minBound else succ x--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode ]-   initialWindowSize $= Size 350 350-   initialWindowPosition $= Position 100 100-   createWindow progName-   -- we have to do this *after* createWindow, otherwise we have no OpenGL context-   version <- get (majorMinor glVersion)-   when (version == (1,0)) $ do-      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."-      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"-      putStrLn "you may be able to modify this program to make it run."-      exitFailure-   state <- makeState-   myInit state-   displayCallback $= display state-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just (keyboardMouse state)-   mainLoop
− examples/RedBook/Wrap.hs 
@@ -1,114 +0,0 @@-{--   Wrap.hs  (adapted from wrap.c which is (c) Silicon Graphics, Inc)-   Copyright (c) Sven Panne 2002-2005 <sven.panne@aedion.de>-   This file is part of HOpenGL and distributed under a BSD-style license-   See the file libraries/GLUT/LICENSE--   This program texture maps a checkerboard image onto two rectangles. This-   program demonstrates the wrapping modes, if the texture coordinates fall-   outside 0.0 and 1.0. Interaction: Pressing the 's' and 'S' keys switch the-   wrapping between clamping and repeating for the s parameter. The 't' and 'T'-   keys control the wrapping for the t parameter.--   Texture objects are only used when GL_EXT_texture_object is supported.--}--import Control.Monad ( when )-import Data.Maybe ( isJust, listToMaybe )-import Data.Bits ( (.&.) )-import Foreign ( withArray )-import System.Exit ( exitWith, ExitCode(ExitSuccess) )-import Graphics.UI.GLUT---- Create checkerboard image-checkImageSize :: TextureSize2D-checkImageSize = TextureSize2D 64 64--withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))-               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()-withCheckImage (TextureSize2D w h) n f act =-   withArray [ f c |-               i <- [ 0 .. w - 1 ],-               j <- [ 0 .. h - 1 ],-               let c | (i .&. n) == (j .&. n) = 0-                     | otherwise              = 255 ] $-   act. PixelData RGBA UnsignedByte--myInit :: IO (Maybe TextureObject)-myInit = do-   clearColor $= Color4 0 0 0 0-   shadeModel $= Flat-   depthFunc $= Just Less-   rowAlignment Unpack $= 1--   exts <- get glExtensions-   mbTexName <- if "GL_EXT_texture_object" `elem` exts-                   then fmap listToMaybe $ genObjectNames 1-                   else return Nothing-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName--   textureWrapMode Texture2D S $= (Repeated, Repeat)-   textureWrapMode Texture2D T $= (Repeated, Repeat)-   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)-   withCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255) $-      texImage2D Nothing NoProxy 0  RGBA' checkImageSize 0-   return mbTexName--display ::  Maybe TextureObject -> DisplayCallback-display mbTexName = do-   clear [ ColorBuffer, DepthBuffer ]-   texture Texture2D $= Enabled-   textureFunction $= Decal-   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName--   -- resolve overloading, not needed in "real" programs-   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()-       vertex3f = vertex :: Vertex3 GLfloat -> IO ()-   renderPrimitive Quads $ do-      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 3); vertex3f (Vertex3 (-2.0)      1.0    0.0     )-      texCoord2f (TexCoord2 3 3); vertex3f (Vertex3   0.0       1.0    0.0     )-      texCoord2f (TexCoord2 3 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )--      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )-      texCoord2f (TexCoord2 0 3); vertex3f (Vertex3   1.0       1.0    0.0     )-      texCoord2f (TexCoord2 3 3); vertex3f (Vertex3   2.41421   1.0  (-1.41421))-      texCoord2f (TexCoord2 3 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))-   flush-   texture Texture2D $= Disabled--reshape :: ReshapeCallback-reshape size@(Size w h) = do-   viewport $= (Position 0 0, size)-   matrixMode $= Projection-   loadIdentity-   perspective 60 (fromIntegral w / fromIntegral h) 1 30-   matrixMode $= Modelview 0-   loadIdentity-   translate (Vector3 0 0 (-3.6 :: GLfloat))--keyboard :: KeyboardMouseCallback-keyboard (Char 's'  ) Down _ _ = setClamping S Clamp-keyboard (Char 'S'  ) Down _ _ = setClamping S Repeat-keyboard (Char 't'  ) Down _ _ = setClamping T Clamp-keyboard (Char 'T'  ) Down _ _ = setClamping T Repeat-keyboard (Char '\27') Down _ _ = exitWith ExitSuccess-keyboard _            _    _ _ = return ()--setClamping :: TextureCoordName -> Clamping -> IO ()-setClamping coord clamp = do-   textureWrapMode Texture2D coord $= (Repeated, clamp);-   postRedisplay Nothing--main :: IO ()-main = do-   (progName, _args) <- getArgsAndInitialize-   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]-   initialWindowSize $= Size 250 250-   initialWindowPosition $= Position 100 100-   createWindow progName-   mbTexName <- myInit-   displayCallback $= display mbTexName-   reshapeCallback $= Just reshape-   keyboardMouseCallback $= Just keyboard-   mainLoop
+ examples/RedBook4/00-README view
@@ -0,0 +1,189 @@+This file lists the programs that are referenced in the OpenGL Programming+Guide, Fourth Edition, by chapter. For each program, the version of OpenGL+that is required is listed with the program.++Chapter 1: Introduction to OpenGL++        Hello.hs        (1.0)+        Double.hs       (1.0)++Chapter 2: State Management and Drawing Geometric Objects++        Lines.hs        (1.0)+        Polys.hs        (1.0)+        VArray.hs       (1.1)+        MVArray.hs      (1.4)++Chapter 3: Viewing++        Cube.hs         (1.0)+        Model.hs        (1.0)+        Clip.hs         (1.0)+        Planet.hs       (1.0)+        Robot.hs        (1.0)+        UnProject.hs    (1.1)++Chapter 4: Color++        Smooth.hs       (1.0)++Chapter 5: Lighting++        Light.hs        (1.0)+        MoveLight.hs    (1.0)+        Material.hs     (1.0)+        ColorMat.hs     (1.1)+        Scene.hs        (1.0)++Chapter 6: Blending, Antialiasing, Fog, and Polygon Offset++        BlendEqn.hs     (1.3 or ARB_imaging_subset)+        Alpha.hs        (1.0)+        Alpha3D.hs      (1.1)+        AARGB.hs        (1.1)+        AAIndex.hs      (1.1)+        Multisamp.hs    (1.3)+        Fog.hs          (1.0)+        FogIndex.hs     (1.0)+        FogCoord.hs     (1.4)+        PointP.hs       (1.4)+        PolyOff.hs      (1.1)++Chapter 7: Display Lists++        Torus.hs        (1.0)+        DList.hs        (1.0)+        Stroke.hs       (1.0)++Chapter 8: Drawing Pixels, Bitmaps, Fonts, and Images++        DrawF.hs        (1.0)+        Font.hs         (1.0)+        Image.hs        (1.1)+        ColorTable.hs   (ARB_imaging_subset)+        Convolution.hs  (ARB_imaging_subset)+        ColorMatrix.hs  (ARB_imaging_subset)+        Histogram.hs    (ARB_imaging_subset)+        Minmax.hs       (ARB_imaging_subset)++Chapter 9: Texture Mapping++        Checker.hs      (1.0)+        TexSub.hs       (1.1)+        Texture3D.hs    (1.2)+        Mipmap.hs       (1.0)+        TexBind.hs      (1.1)+        TexGen.hs       (1.1)+        CubeMap.hs      (1.3)+        MultiTex.hs     (1.3 or ARB_multitexture)+        Combiner.hs     (1.3)+        ShadowMap.hs    (1.4)+        Wrap.hs         (1.0)+        TexProx.hs      (1.1)++Chapter 10: The Framebuffer++        Stencil.hs      (1.0)+        AccPersp.hs     (1.0)+        AccAnti.hs      (1.0)+        DOF.hs          (1.0)++Chapter 11: Tessellators and Quadrics++        Tess.hs         (1.1)+        TessWind.hs     (1.1)+        Quadric.hs      (1.1)++Chapter 12: Evaluators and NURBS++        BezCurve.hs     (1.1)+        BezSurf.hs      (1.1)+        BezMesh.hs      (1.1)+        TextureSurf.hs  (1.1)+        Surface.hs      (1.1)+        SurfPoints.hs   (1.2)+        Trim.hs         (1.1)++Chapter 13: Selection and Feedback++        Select.hs       (1.1)+        PickSquare.hs   (1.0)+        PickDepth.hs    (1.0)+        Feedback.hs     (1.0)++Chapter 14: Now That You Know++        <No programs included>++Color Plates:++        Teapots.hs      (1.1)++Some remarks regarding the style of the programs:++To ease comparisons, the Haskell programs in this directory try to stay as+close to the original examples in C as possible. Consequently, they should+not be considered as examples for the best way to implement things in+Haskell.++The Haskell OpenGL binding uses overloading quite extensively, which makes+its use quite flexible, e.g.:++   class Vertex a where+      vertex  ::     a -> IO ()+      vertexv :: Ptr a -> IO ()++This single class subsumes all 24 vertex specification calls in OpenGL's C+binding, i.e. glVertex{234}{sifd}[v](), with the help of the following+class and instances:++   class VertexComponent a  -- an opaque class++   VertexComponent GLshort+   VertexComponent GLint+   VertexComponent GLfloat+   VertexComponent GLdouble++   VertexComponent a => Vertex (Vertex2 a)+   VertexComponent a => Vertex (Vertex3 a)+   VertexComponent a => Vertex (Vertex4 a)++There is a small inconvenience with this when used in "toy" programs:+Haskell's numeric literals are overloaded, too, so the programmer's help is+needed to disambiguate the type of expressions like:++   vertex (Vertex3 0 0 1)++Let's assume we mean the equivalent of glVertex3f() here. One can either+use an explicitly typed helper function:++   let vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   in vertex3f (Vertex3 0 0 1)++This comes in handy when there are a lot of uses of vertex3f. An+alternative is to use a type annotation for the literal:++   vertex (Vertex3 0 0 (1 :: GLfloat))++or a type annotation for the vertex:++   vertex (Vertex3 0 0 1 :: Vertex3 GLfloat)++This is largely a matter of taste and normally not a problem in "real"+programs with type signatures for functions.++Sometimes different callbacks need to share some state, which is done via+global variables in the C examples. To achieve a unified presentation, all+Haskell examples use a `State' type for this purpose, which collects the+different parts of the global state, i.e. one or more IORefs. There are+alternatives for modeling this, which should be considered in own programs,+depending on the use cases:++ * Separate IORefs: This makes it explicit which parts of the program need+   which parts of the state.++ * A single IORef/MVar containing all the state: This enables one to change+   the whole state atomically, which is often quite handy in multithreaded+   programs.++ * A custom monad: This can hide all the state threading behind the scenes.
+ examples/RedBook4/AAIndex.hs view
@@ -0,0 +1,104 @@+{-+   AAIndex.hs (adapted from aaindex.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws shows how to draw anti-aliased lines in color index+   mode. It draws two diagonal lines to form an X; when 'r' is typed in the+   window, the lines are rotated in opposite directions.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { rotAngle :: IORef Int }++makeState :: IO State+makeState = do+   r <- newIORef 0+   return $ State { rotAngle = r }++rampSize, ramp1Start, ramp2Start :: GLint+rampSize = 16+ramp1Start = 32+ramp2Start = 48++-- Initialize antialiasing for color index mode, including loading a green color+-- ramp starting at ramp1Start, and a blue color ramp starting at ramp2Start.+-- The ramps must be a multiple of 16.+myInit :: IO ()+myInit = do+   flip mapM_ [ 0 .. rampSize - 1 ] $ \i -> do+      let shade = fromIntegral i / fromIntegral rampSize+      colorMapEntry (Index1 (ramp1Start + i)) $= Color3 0 shade 0+      colorMapEntry (Index1 (ramp2Start + i)) $= Color3 0 0 shade++   lineSmooth $= Enabled+   hint LineSmooth $= DontCare+   lineWidth $= 1.5++   clearIndex $= Index1 (fromIntegral ramp1Start)++-- Draw 2 diagonal lines to form an X+display :: State -> DisplayCallback+display state = do+   r <- get (rotAngle state)+   clear [ ColorBuffer ]++   -- resolve overloading, not needed in "real" programs+   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()++   index (Index1 ramp1Start)+   preservingMatrix $ do+      rotate (-(fromIntegral r :: GLfloat)) (Vector3 0 0 0.1)+      renderPrimitive Lines $ do+         vertex2f (Vertex2 (-0.5) 0.5)+         vertex2f (Vertex2 0.5 (-0.5))++   index (Index1 ramp2Start)+   preservingMatrix $ do+      rotate (fromIntegral r :: GLfloat) (Vector3 0 0 0.1)+      renderPrimitive Lines $ do+         vertex2f (Vertex2 0.5 0.5)+         vertex2f (Vertex2 (-0.5) (-0.5))++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D (-1) 1 (-1*hf/wf) (1*hf/wf)+      else ortho2D (-1*wf/hf) (1*wf/hf) (-1) 1+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'r'   -> do rotAngle state  $~ ((`mod` 360) . (+ 30)); postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++-- Main Loop+-- Open window with initial window size, title bar,+-- color index display mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, IndexMode ]+   initialWindowSize $= Size 200 200+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state+   mainLoop
+ examples/RedBook4/AARGB.hs view
@@ -0,0 +1,104 @@+{-+   AARGB.hs (adapted from aargb.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws shows how to draw anti-aliased lines. It draws two+   diagonal lines to form an X; when 'r' is typed in the window, the lines are+   rotated in opposite directions.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { rotAngle :: IORef Int }++makeState :: IO State+makeState = do+   r <- newIORef 0+   return $ State { rotAngle = r }++-- Initialize antialiasing for RGBA mode, including alpha blending, hint, and+-- line width. Print out implementation specific info on line width granularity+-- and width.+myInit :: IO ()+myInit = do+   g <- get smoothLineWidthGranularity+   putStrLn ("smoothLineWidthGranularity is " ++ show g)++   r <- get smoothLineWidthRange+   putStrLn ("smoothLineWidthRange is " ++ show r)++   lineSmooth $= Enabled++   blend $= Enabled+   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+   hint LineSmooth $= DontCare+   lineWidth $= 1.5++   clearColor $= Color4 0 0 0 0++-- Draw 2 diagonal lines to form an X+display :: State -> DisplayCallback+display state = do+   r <- get (rotAngle state)+   clear [ ColorBuffer ]++   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       vertex2f = vertex :: Vertex2 GLfloat -> IO ()++   color3f (Color3 0 1 0)+   preservingMatrix $ do+      rotate (-(fromIntegral r :: GLfloat)) (Vector3 0 0 0.1)+      renderPrimitive Lines $ do+         vertex2f (Vertex2 (-0.5) 0.5)+         vertex2f (Vertex2 0.5 (-0.5))++   color3f (Color3 0 0 1)+   preservingMatrix $ do+      rotate (fromIntegral r :: GLfloat) (Vector3 0 0 0.1)+      renderPrimitive Lines $ do+         vertex2f (Vertex2 0.5 0.5)+         vertex2f (Vertex2 (-0.5) (-0.5))++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D (-1) 1 (-1*hf/wf) (1*hf/wf)+      else ortho2D (-1*wf/hf) (1*wf/hf) (-1) 1+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'r'   -> do rotAngle state  $~ ((`mod` 360) . (+ 30)); postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++-- Main Loop+-- Open window with initial window size, title bar,+-- RGBA display mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 200 200+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state+   mainLoop
+ examples/RedBook4/AccAnti.hs view
@@ -0,0 +1,132 @@+{-+   AccAnti.hs (adapted from accanti.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Use the accumulation buffer to do full-scene antialiasing on a scene with+   orthographic parallel projection.+-}++import Data.List ( genericLength )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a+-- gaussian distribution around the origin. Use these to do model jittering for+-- scene anti-aliasing and view volume jittering for depth of field effects. Use+-- in conjunction with the accwindow routine.+j8 :: [Vector2 GLdouble]+j8 = [+   Vector2 (-0.334818)   0.435331 ,+   Vector2   0.286438  (-0.393495),+   Vector2   0.459462    0.141540 ,+   Vector2 (-0.414498) (-0.192829),+   Vector2 (-0.183790)   0.082102 ,+   Vector2 (-0.079263) (-0.317383),+   Vector2   0.102254    0.299133 ,+   Vector2   0.164216  (-0.054399) ]++-- Initialize lighting and other values.+myInit :: IO ()+myInit = do+   materialAmbient Front $= Color4 1 1 1 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 50+   position (Light 0) $= Vertex4 0 0 10 1+   lightModelAmbient $= Color4 0.2 0.2 0.2 1++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less+   shadeModel $= Flat++   clearColor $= Color4 0 0 0 0+   clearAccum $= Color4 0 0 0 0++displayObjects :: IO ()+displayObjects = do+   -- resolve overloading, not needed in "real" programs+   let translatef = translate :: Vector3 GLfloat -> IO ()+       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()++   preservingMatrix $ do+      rotatef 30 (Vector3 1 0 0)++      preservingMatrix $ do+         translatef (Vector3 (-0.80) 0.35 0)+         rotatef 100 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0.7 0.7 0 1+         renderObject Solid (Torus 0.275 0.85 16 16)++      preservingMatrix $ do+         translatef (Vector3 (-0.75) (-0.50) 0)+         rotatef 45 (Vector3 0 0 1)+         rotatef 45 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0 0.7 0.7 1+         renderObject Solid (Cube 1.5)++      preservingMatrix $ do+         translatef (Vector3 0.75 0.60 0)+         rotatef 30 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0.7 0 0.7 1+         renderObject Solid (Sphere' 1 16 16)++      preservingMatrix $ do+         translatef (Vector3 0.70 (-0.90) 0.25)+         materialDiffuse Front $= Color4 0.7 0.4 0.4 1+         renderObject Solid Octahedron++-- display draws 5 teapots into the accumulation buffer several times; each time+-- with a jittered perspective. The focal point is at z = 5.0, so the gold+-- teapot will stay in focus. The amount of jitter is adjusted by the magnitude+-- of the accPerspective jitter; in this example, 0.33. In this example, the+-- teapots are drawn 8 times.+display :: DisplayCallback+display = do+   (_, Size w h) <- get viewport+   clear [ AccumBuffer ]++   flip mapM_ j8 $ \(Vector2 x y) -> do+      clear [ ColorBuffer, DepthBuffer ]+      preservingMatrix $ do+         -- Note that 4.5 is the distance in world space between left and right+         -- and bottom and top. This formula converts fractional pixel movement+         -- to world coordinates.+         translate (Vector3 (x*4.5/fromIntegral w) (y*4.5/fromIntegral h) 0)+         displayObjects+      accum Accum (recip (genericLength j8))++   accum Return 1+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-2.25) 2.25 (-2.25*hf/wf) (2.25*hf/wf) (-10) 10+      else ortho (-2.25*wf/hf) (2.25*wf/hf) (-2.25) 2.25 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Be certain to request an accumulation buffer.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/AccPersp.hs view
@@ -0,0 +1,166 @@+{-+   AccPersp.hs (adapted from accpersp.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Use the accumulation buffer to do full-scene antialiasing on a scene with+   perspective projection, using the special routines accFrustum and+   accPerspective.+-}++import Data.List ( genericLength )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a+-- gaussian distribution around the origin. Use these to do model jittering for+-- scene anti-aliasing and view volume jittering for depth of field effects. Use+-- in conjunction with the accwindow routine.+j8 :: [Vector2 GLdouble]+j8 = [+   Vector2 (-0.334818)   0.435331 ,+   Vector2   0.286438  (-0.393495),+   Vector2   0.459462    0.141540 ,+   Vector2 (-0.414498) (-0.192829),+   Vector2 (-0.183790)   0.082102 ,+   Vector2 (-0.079263) (-0.317383),+   Vector2   0.102254    0.299133 ,+   Vector2   0.164216  (-0.054399) ]++-- The first 6 arguments are identical to the frustum call. pixD is anti-alias+-- jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD is+-- depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field+-- effects. focus is distance from eye to plane in focus. focus must be greater+-- than, but not equal to 0. Note that accFrustum calls translate. You will+-- probably want to insure that your ModelView matrix has been initialized to+-- identity before calling accFrustum.+accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble+           -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()+accFrustum left right bottom top zNear zFar+           (Vector2 pixDx pixDy) (Vector2 eyeDx eyeDy) focus = do+   (_, Size w h) <- get viewport++   let xWSize = right - left;+       yWSize = top - bottom;++       dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)+       dy = -(pixDy * yWSize / fromIntegral h + eyeDy * zNear / focus)++   matrixMode $= Projection+   loadIdentity+   frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 (-eyeDx) (-eyeDy) 0)++-- The first 4 arguments are identical to the perspective call. pixD is+-- anti-alias jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD+-- is depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field+-- effects. focus is distance from eye to plane in focus. focus must be greater+-- than, but not equal to 0. Note that accPerspective calls accFrustum.+accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble+               -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()+accPerspective fovY aspect zNear zFar  pixD eyeD focus = do+   let fov2 = ((fovY * pi) / 180) / 2++       top = zNear / (cos fov2 / sin fov2)+       bottom = -top++       right = top * aspect+       left = -right++   accFrustum left right bottom top zNear zFar pixD eyeD focus++-- Initialize lighting and other values.+myInit :: IO ()+myInit = do+   materialAmbient Front $= Color4 1 1 1 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 50+   position (Light 0) $= Vertex4 0 0 10 1+   lightModelAmbient $= Color4 0.2 0.2 0.2 1++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less+   shadeModel $= Flat++   clearColor $= Color4 0 0 0 0+   clearAccum $= Color4 0 0 0 0++displayObjects :: IO ()+displayObjects = do+   -- resolve overloading, not needed in "real" programs+   let translatef = translate :: Vector3 GLfloat -> IO ()+       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()++   preservingMatrix $ do+      translatef (Vector3 0 0 (-5))+      rotatef 30 (Vector3 1 0 0)++      preservingMatrix $ do+         translatef (Vector3 (-0.80) 0.35 0)+         rotatef 100 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0.7 0.7 0 1+         renderObject Solid (Torus 0.275 0.85 16 16)++      preservingMatrix $ do+         translatef (Vector3 (-0.75) (-0.50) 0)+         rotatef 45 (Vector3 0 0 1)+         rotatef 45 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0 0.7 0.7 1+         renderObject Solid (Cube 1.5)++      preservingMatrix $ do+         translatef (Vector3 0.75 0.60 0)+         rotatef 30 (Vector3 1 0 0)+         materialDiffuse Front $= Color4 0.7 0 0.7 1+         renderObject Solid (Sphere' 1 16 16)++      preservingMatrix $ do+         translatef (Vector3 0.70 (-0.90) 0.25)+         materialDiffuse Front $= Color4 0.7 0.4 0.4 1+         renderObject Solid Octahedron++-- display draws 5 teapots into the accumulation buffer several times; each time+-- with a jittered perspective. The focal point is at z = 5.0, so the gold+-- teapot will stay in focus. The amount of jitter is adjusted by the magnitude+-- of the accPerspective jitter; in this example, 0.33. In this example, the+-- teapots are drawn 8 times.+display :: DisplayCallback+display = do+   (_, Size w h) <- get viewport+   clear [ AccumBuffer ]++   flip mapM_ j8 $ \(Vector2 x y) -> do+      clear [ ColorBuffer, DepthBuffer ]+      accPerspective 50 (fromIntegral w / fromIntegral h) 1 15+                     (Vector2 x y) (Vector2 0 0) 1+      displayObjects+      accum Accum (recip (genericLength j8))++   accum Return 1+   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Be certain you request an accumulation buffer.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Alpha.hs view
@@ -0,0 +1,91 @@+{-+   Alpha.hs (adapted from alpha.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws several overlapping filled polygons to demonstrate the+   effect order has on alpha blending results. Use the 't' key to toggle the+   order of drawing polygons.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { leftFirst :: IORef Bool }++makeState :: IO State+makeState = do+   l <- newIORef True+   return $ State { leftFirst = l }++-- Initialize alpha blending function.+myInit :: IO ()+myInit = do+   blend $= Enabled+   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+   shadeModel $= Flat+   clearColor $= Color4 0 0 0 0++drawLeftTriangle :: IO ()+drawLeftTriangle =+   -- draw yellow triangle on LHS of screen+   renderPrimitive Triangles $ do+      color (Color4 1 1 0 (0.75 :: GLfloat))+      vertex (Vertex3 0.1 0.9 (0 :: GLfloat))+      vertex (Vertex3 0.1 0.1 (0 :: GLfloat))+      vertex (Vertex3 0.7 0.5 (0 :: GLfloat))++drawRightTriangle :: IO ()+drawRightTriangle =+   -- draw cyan triangle on RHS of screen+   renderPrimitive Triangles $ do+      color (Color4 0 1 1 (0.75 :: GLfloat))+      vertex (Vertex3 0.9 0.9 (0 :: GLfloat))+      vertex (Vertex3 0.3 0.5 (0 :: GLfloat))+      vertex (Vertex3 0.9 0.1 (0 :: GLfloat))++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   l <- get (leftFirst state)+   if l+      then do drawLeftTriangle; drawRightTriangle+      else do drawRightTriangle; drawLeftTriangle+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D 0 1 0 (hf/wf)+      else ortho2D 0 (wf/hf) 0 1++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   't'   -> do leftFirst state $~ not; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess   -- Escape key+   _     -> return ()+keyboard _ _ _ _ _ = return ()++-- Main Loop+-- Open window with initial window size, title bar, RGBA display mode, and+-- handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 200 200+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state+   mainLoop
+ examples/RedBook4/Alpha3D.hs view
@@ -0,0 +1,124 @@+{-+   Alpha3D.hs (adapted from alpha3D.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates how to intermix opaque and alpha blended polygons+   in the same scene, by using depthMask. Press the 'a' key to animate moving+   the transparent object through the opaque object.  Press the 'r' key to reset+   the scene.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++maxZ, minZ, zInc :: GLfloat+maxZ = 8+minZ = -8+zInc = 0.4++-- We don't animate via the idle callback, because this is way too fast on+-- modern computers. A timer with the delay below is used instead for redraw.+delay :: Timeout+delay = 100++data State = State { solidZ, transparentZ :: IORef GLfloat }++makeState :: IO State+makeState = do+   s <- newIORef maxZ+   t <- newIORef minZ+   return $ State { solidZ = s, transparentZ = t }++data DisplayLists = DisplayLists { sphereList, cubeList :: DisplayList }++myInit :: IO DisplayLists+myInit = do+   materialSpecular Front $= Color4 1 1 1 0.15+   materialShininess Front $= 100+   position (Light 0) $= Vertex4 0.5 0.5 1 0++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less++   s <- defineNewList Compile $ renderObject Solid (Sphere' 0.4 16 16)+   c <- defineNewList Compile $ renderObject Solid (Cube 0.6)+   return $ DisplayLists { sphereList = s, cubeList = c }++display :: State -> DisplayLists -> DisplayCallback+display state displayLists = do+   clear [ ColorBuffer, DepthBuffer ]++   preservingMatrix $ do+      s <- get (solidZ state)+      translate (Vector3 (-0.15) (-0.15) s)+      materialEmission Front $= Color4 0 0 0 1+      materialDiffuse Front $= Color4 0.75 0.75 0 1+      callList (sphereList displayLists)++   preservingMatrix $ do+      t <- get (transparentZ state)+      translate (Vector3 (0.15) (0.15) t)+      rotate (15 :: GLfloat) (Vector3 1 1 0)+      rotate (30 :: GLfloat) (Vector3 0 1 0)+      materialEmission Front $= Color4 0 0.3 0.3 0.6+      materialDiffuse Front $= Color4 0 0.8 0.8 0.6+      blend $= Enabled+      depthMask $= Disabled+      blendFunc $= (SrcAlpha, One)+      callList (cubeList displayLists)+      depthMask $= Enabled+      blend $= Disabled++   swapBuffers++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-1.5) 1.5 (-1.5*hf/wf) (1.5*hf/wf) (-10) 10+      else ortho (-1.5*wf/hf) (1.5*wf/hf) (-1.5) 1.5 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++animate :: State -> TimerCallback+animate state = do+   s <- get (solidZ state)+   t <- get (transparentZ state)+   if (s <= minZ || t >= maxZ)+      then idleCallback $= Nothing+      else do+         solidZ state $~ (+ (- zInc))+         transparentZ state $~ (+ zInc)+         addTimerCallback delay (animate state)+         postRedisplay Nothing++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'a'   -> do solidZ state $= maxZ; transparentZ state $= minZ; addTimerCallback delay (animate state)+   'r'   -> do solidZ state $= maxZ; transparentZ state $= minZ; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   -- The original C example uses single buffering, which flickers a lot.+   initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   state <- makeState+   displayLists <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state displayLists+   mainLoop
+ examples/RedBook4/BezCurve.hs view
@@ -0,0 +1,67 @@+{-+   BezCurve.hs (adapted from bezcurve.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program uses evaluators to draw a Bezier curve.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++ctrlPoints :: [Vertex3 GLfloat]+ctrlPoints = [ Vertex3 (-4)(-4) 0, Vertex3 (-2) 4 0,+               Vertex3   2 (-4) 0, Vertex3   4  4 0 ]++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   m <- newMap1 (0, 1) ctrlPoints+   map1 $= Just (m :: GLmap1 Vertex3 GLfloat)++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+   color3f (Color3 1 1 1)+   renderPrimitive LineStrip $+      mapM_ evalCoord1 [ i/30.0 :: GLfloat | i <- [0..30] ]+   -- The following code displays the control points as dots.+   pointSize $= 5+   color3f (Color3 1 1 0)+   renderPrimitive Points $+      mapM_ vertex ctrlPoints+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-5.0) 5.0 (-5.0*hf/wf) (5.0*hf/wf) (-5.0) 5.0+      else ortho (-5.0*wf/hf) (5.0*wf/hf) (-5.0) 5.0 (-5.0) 5.0+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/BezMesh.hs view
@@ -0,0 +1,84 @@+{-+   BezMesh.hs (adapted from bezmesh.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program renders a lighted, filled Bezier surface, using two-dimensional+   evaluators.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Data.List ( transpose )+import Graphics.UI.GLUT++ctrlPoints :: [[Vertex3 GLfloat]]+ctrlPoints = [+   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,+     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],+   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,+     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],+   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,+     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],+   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),+     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]++initlights :: IO ()+initlights = do+   lighting $= Enabled+   light (Light 0) $= Enabled++   ambient  (Light 0) $= Color4 0.2 0.2 0.2 1.0+   position (Light 0) $= Vertex4 0 0 2 1++   materialDiffuse   Front $= Color4 0.6 0.6 0.6 1.0+   materialSpecular  Front $= Color4 1.0 1.0 1.0 1.0+   materialShininess Front $= 50++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (85 :: GLfloat) (Vector3 1 1 1)+      evalMesh2 Fill (0, 20) (0, 20)+   flush++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   depthFunc $= Just Less+   m <- newMap2 (0, 1) (0, 1) (transpose ctrlPoints)+   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)+   autoNormal $= Enabled+   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))+   initlights  -- for lighted version only++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0+      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/BezSurf.hs view
@@ -0,0 +1,79 @@+{-+   BezSurf.hs (adapted from bezsurf.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program renders a wireframe Bezier surface, using two-dimensional+   evaluators.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++ctrlPoints :: [[Vertex3 GLfloat]]+ctrlPoints = [+   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,+     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],+   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,+     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],+   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,+     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],+   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),+     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]++-- Hey mom, look, it's C!  ;-)+for :: GLfloat -> GLfloat -> (GLfloat -> IO ()) -> IO ()+for s e f = mapM_ f [ i | i <- [ s, if s <= e then s + 1 else s - 1 .. e ] ]++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   color (Color3 1 1 1 :: Color3 GLfloat)+   preservingMatrix $ do+      rotate (85 :: GLfloat) (Vector3 1 1 1)+      for 0 8 $ \j -> do+         renderPrimitive LineStrip $ do+            for 0 30 $ \i -> evalCoord2 (i/30, j/ 8)+         renderPrimitive LineStrip $ do+            for 0 30 $ \i -> evalCoord2 (j/ 8, i/30)+   flush++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   m <- newMap2 (0, 1) (0, 1) ctrlPoints+   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)+   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))+   depthFunc $= Just Less+   shadeModel $= Flat++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0+      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/BlendEqn.hs view
@@ -0,0 +1,95 @@+{-+   BlendEqn.hs (adapted from blendeqn.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Demonstrate the different blending functions available with the OpenGL+   imaging subset. This program demonstrates use of blendEquation.++   The following keys change the selected blend equation function:++       'a'  ->  FuncAdd+       's'  ->  FuncSubtract+       'r'  ->  FuncReverseSubtract+       'm'  ->  Min+       'x'  ->  Max+-}++import Data.Char ( toLower )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 1 1 0 0+   blendFunc $= (One, One)+   blend $= Enabled++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]++   color (Color3 0 0 (1 :: GLfloat))+   rect (Vertex2 (-0.5) (-0.5)) (Vertex2 0.5 (0.5 :: GLfloat))++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   let aspect = fromIntegral w / fromIntegral h++   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   if aspect < 1+      then let aspect' = recip aspect+           in ortho (-aspect') aspect' (-1) 1 (-1) 1+      else ortho (-1) 1 (-aspect) aspect (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char c) Down _ _ = case toLower c of+   -- Colors are added as: (0, 0, 1) + (1, 1, 0) = (1, 1, 1)+   -- which will produce a white square on a yellow background.+   'a'   -> setBlendEquation FuncAdd++   -- Colors are subtracted as: (0, 0, 1) - (1, 1, 0) = (-1, -1, 1)+   -- which is clamped to (0, 0, 1), producing a blue square on a+   -- yellow background+   's'   -> setBlendEquation FuncSubtract++   -- Colors are subtracted as: (1, 1, 0) - (0, 0, 1) = (1, 1, -1)+   -- which is clamed to (1, 1, 0). This produces yellow for both+   -- the square and the background.+   'r'   -> setBlendEquation FuncReverseSubtract++   -- The minimum of each component is computed, as+   -- [min(0, 1), min(0, 1), min(1, 0)] which equates to (0, 0, 0).+   -- This will produce a black square on the yellow background.+   'm'   -> setBlendEquation Min++   -- The minimum of each component is computed, as+   -- [max(0, 1), max(0, 1), max(1, 0)] which equates to (1, 1, 1)+   -- This will produce a white square on the yellow background.+   'x'   -> setBlendEquation Max++   '\27' -> exitWith ExitSuccess+   _     -> return ()+   where setBlendEquation e = do+            blendEquation $= e+            postRedisplay Nothing+keyboard _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 512 512+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display+   mainLoop
+ examples/RedBook4/Checker.hs view
@@ -0,0 +1,101 @@+{-+   Checker.hs  (adapted from checker.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program texture maps a checkerboard image onto two rectangles.++   Texture objects are only used when GL_EXT_texture_object is supported.+-}++import Control.Monad ( when )+import Data.Maybe ( isJust )+import Data.Bits ( (.&.) )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Create checkerboard image+checkImageSize :: TextureSize2D+checkImageSize = TextureSize2D 64 64++withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))+               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()+withCheckImage (TextureSize2D w h) n f act =+   withArray [ f c |+               i <- [ 0 .. w - 1 ],+               j <- [ 0 .. h - 1 ],+               let c | (i .&. n) == (j .&. n) = 0+                     | otherwise              = 255 ] $+   act. PixelData RGBA UnsignedByte++myInit :: IO (Maybe TextureObject)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less+   rowAlignment Unpack $= 1++   exts <- get glExtensions+   mbTexName <- if "GL_EXT_texture_object" `elem` exts+                   then fmap Just genObjectName+                   else return Nothing+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName++   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   withCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255) $+      texImage2D Texture2D NoProxy 0  RGBA' checkImageSize 0+   return mbTexName++display ::  Maybe TextureObject -> DisplayCallback+display mbTexName = do+   clear [ ColorBuffer, DepthBuffer ]+   texture Texture2D $= Enabled+   textureFunction $= Decal+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName++   -- resolve overloading, not needed in "real" programs+   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )++      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))+   flush+   texture Texture2D $= Disabled++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-3.6 :: GLfloat))++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   mbTexName <- myInit+   displayCallback $= display mbTexName+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Clip.hs view
@@ -0,0 +1,63 @@+{-+   Clip.hs (adapted from clip.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates arbitrary clipping planes.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()+   color3f (Color3 1 1 1)++   preservingMatrix $ do+      translatef (Vector3 0 0 (-5))++      -- clip lower half -- y < 0+      clipPlane (ClipPlaneName 0) $= Just (Plane 0 1 0 0)+      -- clip left half -- x < 0+      clipPlane (ClipPlaneName 1) $= Just (Plane 1 0 0 0)++      rotatef 90 (Vector3 1 0 0)+      renderObject Wireframe (Sphere' 1 20 16)++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 20+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/ColorMat.hs view
@@ -0,0 +1,94 @@+{-+   Light.hs (adapted from light.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   After initialization, the program will be in ColorMaterial mode.+   Interaction: pressing the mouse buttons will change the diffuse+   reflection values.+-}++import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { r, g, b :: IORef GLfloat }++diffuseMaterial :: State -> IO (Color4 GLfloat)+diffuseMaterial state = do+   r' <- get (r state)+   g' <- get (g state)+   b' <- get (b state)+   return $ Color4 r' g' b' 1++makeState :: IO State+makeState = do+   r' <- newIORef 0.5+   g' <- newIORef 0.5+   b' <- newIORef 0.5+   return $ State { r = r', g = g', b = b' }++-- Initialize material property, light source, lighting model,+-- and depth buffer.+myInit :: State -> IO ()+myInit state = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth+   depthFunc $= Just Less+   dm <- diffuseMaterial state+   materialDiffuse Front $= dm+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 25+   position (Light 0) $= Vertex4 1 1 1 0+   lighting $= Enabled+   light (Light 0) $= Enabled+   colorMaterial $= Just (Front, Diffuse)++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   renderObject Solid (Sphere' 1 20 16)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10+      else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++keyboardMouse :: State -> KeyboardMouseCallback+keyboardMouse state (MouseButton button) Down _ _ = case button of+   LeftButton   -> update r+   MiddleButton -> update g+   RightButton  -> update b+   _ -> return ()+   where update component = do+            component state $~ inc+            dm <- diffuseMaterial state+            color dm+            postRedisplay Nothing+         inc x = let s = x + 0.1 in if s > 1 then 0 else s+keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess+keyboardMouse _ _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit state+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboardMouse state)+   mainLoop
+ examples/RedBook4/ColorMatrix.hs view
@@ -0,0 +1,65 @@+{-+   ColorMatrix.hs (adapted from colormatrix.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program uses the color matrix to exchange the color channels of an image.++     Red   -> Green+     Green -> Blue+     Blue  -> Red+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT+import ReadImage++myInit :: IO ()+myInit = do+   m <- newMatrix ColumnMajor [ 0, 1, 0, 0,+                                0, 0, 1, 0,+                                1, 0, 0, 0,+                                0, 0, 0, 1 ]+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0+   matrixMode $= Color+   matrix Nothing $= (m :: GLmatrix GLfloat)+   matrixMode $= Modelview 0++display :: Size -> PixelData a -> DisplayCallback+display size pixels = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 1 1)+   drawPixels size pixels+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= size+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display size pixels+   mainLoop
+ examples/RedBook4/ColorTable.hs view
@@ -0,0 +1,62 @@+{-+   ColorTable.hs (adapted from colortable.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Invert a passed block of pixels.  This program illustrates the use of the+   colorTable function.+-}++import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT+import ReadImage++myInit :: IO ()+myInit = do+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0+   -- Set up an inverse color table+   let tableSize = 256+       t = fromIntegral (tableSize - 1) :: GLubyte+   withArray [ Color3 i i i | i <- [ t, t - 1 .. 0 ] ] $ \buf ->+      colorTable NoProxy ColorTable RGB' tableSize (PixelData RGB UnsignedByte buf)+   colorTableStage ColorTableStage $= Enabled++display :: Size -> PixelData a -> DisplayCallback+display size pixels = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 1 1)+   drawPixels size pixels+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= size+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display size pixels+   mainLoop
+ examples/RedBook4/Combiner.hs view
@@ -0,0 +1,236 @@+{-+   Combiner.hs  (adapted from combiner.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program renders a variety of quads showing different effects of+   texture combiner functions.++   The first row renders an untextured polygon (so you can compare the+   fragment colors) and then the 2 textures.++   The second row shows several different combiner functions on a single+   texture: replace, modulate, add, add-signed, and subtract.++   The third row shows the interpolate combiner function on a single texture+   with a constant color/alpha value, varying the amount of interpolation.++   The fourth row uses multitexturing with two textures and different+   combiner functions.++   The fifth row are some combiner experiments: using the scaling factor and+   reversing the order of subtraction for a combination function.+-}++import Data.Bits ( (.&.) )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Create checkerboard image+imageSize :: TextureSize2D+imageSize = TextureSize2D 8 8++makeImage :: TextureSize2D -> (GLsizei -> GLsizei -> Color4 GLubyte)+               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()+makeImage (TextureSize2D w h) f act =+   withArray [ f i j |+               i <- [ 0 .. w - 1 ],+               j <- [ 0 .. h - 1 ] ] $+   act . PixelData RGBA UnsignedByte++myInit :: IO (TextureObject, TextureObject, DisplayList)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth++   rowAlignment Unpack $= 1++   [texName0, texName1] <- genObjectNames 2++   textureBinding Texture2D $= Just texName0+   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   -- horiz b & w stripes+   makeImage imageSize (\i _ -> let c = if i .&. 2 == 0 then 255 else 0 in Color4 c c c 255) $+      texImage2D Texture2D NoProxy 0  RGBA' imageSize 0++   textureBinding Texture2D $= Just texName1+   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   textureFunction $= Decal+   -- wider vertical 50% cyan and black stripes+   makeImage imageSize (\_ j -> let c = if j .&. 4 /= 0 then 128 else 0 in Color4 0 c c 255) $+      texImage2D Texture2D NoProxy 0  RGBA' imageSize 0++   -- smooth-shaded polygon with multiple texture coordinates+   let vert :: TexCoord2 GLfloat -> Color3 GLfloat -> Vertex3 GLfloat -> IO ()+       vert t c v = do+          multiTexCoord (TextureUnit 0) t+          multiTexCoord (TextureUnit 1) t+          color c+          vertex v++   dl <- defineNewList Compile $+      renderPrimitive Quads $ do+         vert (TexCoord2 0 0) (Color3 0.5 1   0.25) (Vertex3 0 0 0)+         vert (TexCoord2 0 2) (Color3 1   1   1   ) (Vertex3 0 1 0)+         vert (TexCoord2 2 2) (Color3 1   1   1   ) (Vertex3 1 1 0)+         vert (TexCoord2 2 0) (Color3 1   0.5 0.25) (Vertex3 1 0 0)++   return (texName0, texName1, dl)++display ::  (TextureObject, TextureObject, DisplayList) -> DisplayCallback+display (texName0, texName1, dl) = do+   clear [ ColorBuffer ]++   let drawAt :: GLfloat -> GLfloat -> IO ()+       drawAt x y = preservingMatrix $ do+                   translate (Vector3 x y 0)+                   callList dl++   -- untextured polygon -- see the "fragment" colors+   texture Texture2D $= Disabled+   drawAt 0 5++   texture Texture2D $= Enabled+   -- draw ordinary textured polys; 1 texture unit; combine mode disabled+   textureFunction $= Modulate+   textureBinding Texture2D $= Just texName0+   drawAt 1 5++   textureBinding Texture2D $= Just texName1+   drawAt 2 5++   -- different combine modes enabled; 1 texture unit+   -- defaults are:+   -- argRGB Arg0 $= Arg SrcColor CurrentUnit+   -- argRGB Arg1 $= Arg SrcColor Previous++   textureBinding Texture2D $= Just texName0+   textureFunction $= Combine+   combineRGB $= Replace'+   argRGB Arg0 $= Arg SrcColor CurrentUnit+   drawAt 1 4++   combineRGB $= Modulate'+   argRGB Arg1 $= Arg SrcColor Previous+   drawAt 2 4++   combineRGB $= AddUnsigned'+   drawAt 3 4++   combineRGB $= AddSigned+   drawAt 4 4++   combineRGB $= Subtract+   drawAt 5 4++   -- interpolate combine with constant color; 1 texture unit+   -- use different alpha values for constant color+   -- defaults are:+   -- argRGB Arg0 $= Arg SrcColor CurrentUnit+   -- argRGB Arg1 $= Arg SrcColor Previous+   -- argRGB Arg2 $= Arg SrcAlpha Constant++   constantColor $= Color4 0 0 0 0.2+   textureBinding Texture2D $= Just texName0+   textureFunction $= Combine+   combineRGB $= Interpolate+   argRGB Arg0 $= Arg SrcColor CurrentUnit+   argRGB Arg1 $= Arg SrcColor Previous+   argRGB Arg2 $= Arg SrcAlpha Constant+   drawAt 1 3++   constantColor $= Color4 0 0 0 0.4+   drawAt 2 3++   constantColor $= Color4 0 0 0 0.6+   drawAt 3 3++   constantColor $= Color4 0 0 0 0.8+   drawAt 4 3++   -- combine textures 0 & 1+   -- defaults are:+   -- argRGB Arg0 $= Arg SrcColor CurrentUnit+   -- argRGB Arg1 $= Arg SrcColor Previous++   activeTexture $= TextureUnit 0+   texture Texture2D $= Enabled+   textureBinding Texture2D $= Just texName0+   textureFunction $= Modulate++   activeTexture $= TextureUnit 1+   texture Texture2D $= Enabled+   textureBinding Texture2D $= Just texName1+   textureFunction $= Combine+   combineRGB $= Replace'+   drawAt 1 2++   -- try different combiner modes of texture unit 1+   combineRGB $= Modulate'+   drawAt 2 2++   combineRGB $= AddUnsigned'+   drawAt 3 2++   combineRGB $= AddSigned+   drawAt 4 2++   combineRGB $= Subtract+   drawAt 5 2++   -- some experiments++   -- see the effect of rgbScale+   rgbScale $= 2+   combineRGB $= Replace'+   drawAt 1 1++   combineRGB $= Modulate'+   drawAt 2 1+   rgbScale $= 1++   -- reverse the order of subtraction Arg1-Arg0++   textureFunction $= Combine+   combineRGB $= Subtract+   argRGB Arg0 $= Arg SrcColor Previous+   argRGB Arg1 $= Arg SrcColor CurrentUnit+   drawAt 5 1++   activeTexture $= TextureUnit 1   -- deactivate multitexturing+   texture Texture2D $= Disabled+   activeTexture $= TextureUnit 0   -- activate single texture unit++   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 7 0 7+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 400 400+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   texNamesAndDL <- myInit+   displayCallback $= display texNamesAndDL+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Convolution.hs view
@@ -0,0 +1,83 @@+{-+   Convolution.hs (adapted from convolution.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Use various 2D convolutions filters to find edges in an image.+-}++import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT+import ReadImage++data Filter = Filter String [GLfloat]++filterTable :: [(Key,Filter)]+filterTable = [+   (Char 'h', Filter "horizontal" [ 0, -1, 0,+                                    0,  1, 0,+                                    0,  0, 0 ]),++   (Char 'v', Filter "vertical" [ 0, 0, 0,+                                 -1, 1, 0,+                                  0, 0, 0 ]),++   (Char 'l', Filter "laplacian" [ -0.125, -0.125, -0.125,+                                   -0.125,  1.0  , -0.125,+                                   -0.125, -0.125, -0.125 ])]++setFilter :: Filter -> IO ()+setFilter (Filter filterName filterData) = do+   putStrLn ("Using the " ++ filterName ++ " filter")+   withArray filterData $ \buf ->+      convolutionFilter2D Luminance' (Size 3 3) (PixelData Luminance Float buf)++myInit :: IO ()+myInit = do+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0+   setFilter (snd (head filterTable))+   convolution Convolution2D $= Enabled++display :: Size -> PixelData a -> DisplayCallback+display size pixels = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 1 1)+   drawPixels size pixels+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard key          Down _ _ =+   maybe (return ())+         (\f -> do setFilter f; postRedisplay Nothing)+         (lookup key filterTable)+keyboard _            _    _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)+   initialDisplayMode $= [ SingleBuffered, RGBAMode ]+   initialWindowSize $= size+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display size pixels+   mainLoop
+ examples/RedBook4/Cube.hs view
@@ -0,0 +1,56 @@+{-+   Cube.hs (adapted from cube.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates a single modeling transformation, scale and a+   single viewing transformation, lookAt. A wireframe cube is rendered.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()+   color3f (Color3 1 1 1)+   loadIdentity   -- clear the matrix+   -- viewing transformation+   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)+   scalef 1 2 1   -- modeling transformation+   renderObject Wireframe (Cube 1)+   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   frustum (-1) 1 (-1) 1 1.5 20+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/CubeMap.hs view
@@ -0,0 +1,118 @@+{-+   CubeMap.hs  (adapted from CubeMap.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates cube map textures. Six different colored checker+   board textures are created and applied to a lit sphere.++   Pressing the 'f' and 'b' keys translate the viewer forward and backward.+-}++import Data.Bits ( (.&.) )+import Data.IORef ( IORef, newIORef )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { zTrans :: IORef GLfloat }++makeState :: IO State+makeState = do+   z <- newIORef 0+   return $ State { zTrans = z }++imageSize :: TextureSize2D+imageSize = TextureSize2D 4 4++withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))+               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()+withCheckImage (TextureSize2D w h) n f act =+   withArray [ f c |+               i <- [ 0 .. w - 1 ],+               j <- [ 0 .. h - 1 ],+               let c | (i .&. n) == (j .&. n) = 0+                     | otherwise              = 255 ] $+   act. PixelData RGBA UnsignedByte++makeImage :: TextureTargetCubeMapFace -> (GLubyte -> (Color4 GLubyte)) -> IO ()+makeImage target f =+   withCheckImage imageSize 0x1 f $+      texImage2D target NoProxy 0  RGBA' imageSize 0++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   depthFunc $= Just Less+   shadeModel $= Smooth++   rowAlignment Unpack $= 1+   textureWrapMode TextureCubeMap S $= (Repeated, Repeat)+   textureWrapMode TextureCubeMap T $= (Repeated, Repeat)+   textureWrapMode TextureCubeMap R $= (Repeated, Repeat)+   textureFilter TextureCubeMap $= ((Nearest, Nothing), Nearest)++   makeImage TextureCubeMapPositiveX (\c -> Color4   c c   c 255)+   makeImage TextureCubeMapNegativeX (\c -> Color4   0 c   c 255)+   makeImage TextureCubeMapPositiveY (\c -> Color4   c c   0 255)+   makeImage TextureCubeMapNegativeY (\c -> Color4 255 c   c 255)+   makeImage TextureCubeMapPositiveZ (\c -> Color4   c 0   c 255)+   makeImage TextureCubeMapNegativeZ (\c -> Color4   c c 255 255)++   textureGenMode S $= Just NormalMap+   textureGenMode T $= Just NormalMap+   textureGenMode R $= Just NormalMap++   textureFunction $= Modulate++   texture TextureCubeMap $= Enabled+   lighting $= Enabled+   light (Light 0) $= Enabled+   autoNormal $= Enabled+   normalize $= Enabled+   materialDiffuse Front $= Color4 1 1 1 1++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      z <- get (zTrans state)+      translate (Vector3 0 0 z)+      renderObject Solid (Sphere' 5 20 10)+   swapBuffers++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 40 (fromIntegral w / fromIntegral h) 1 300+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-20 :: GLfloat))++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char 'f')   Down _ _ = move state (-0.2)+keyboard state (Char 'b')   Down _ _ = move state   0.2+keyboard _     (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _     _            _    _ _ = return ()++move :: State -> GLfloat -> IO ()+move state inc = do+   zTrans state $~ (+ inc)+   postRedisplay Nothing++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 400 400+   initialWindowPosition $= Position 50 50+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   mainLoop
+ examples/RedBook4/DList.hs view
@@ -0,0 +1,85 @@+{-+   DList.hs (adapted from list.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates how to make and execute a+   display list.  Note that attributes, such as current+   color and matrix, are changed.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO DisplayList+myInit = do+   listName <- genObjectName+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       vertex2f = vertex :: Vertex2 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+   defineList listName Compile $ do+      color3f (Color3 1 0 0) -- current color red+      renderPrimitive Triangles $ do+         vertex2f (Vertex2 0 0)+         vertex2f (Vertex2 1 0)+         vertex2f (Vertex2 0 1)+      translatef (Vector3 1.5 0.0 0.0) -- move position+   shadeModel $= Flat+   return listName++drawLine :: IO ()+drawLine = do+   -- resolve overloading, not needed in "real" programs+   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()+   renderPrimitive Lines $ do+      vertex2f (Vertex2  0.0 0.5)+      vertex2f (Vertex2 15.0 0.5)++display :: DisplayList -> DisplayCallback+display listName = do+   -- NOTE: The following 'loadIdentity' is missing in the original+   -- example, but without it the translatef calls accumulate and+   -- the graphics wander out of the window after a few redraws...+   loadIdentity++   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+   color3f (Color3 0 1 0) -- current color green+   sequence_ (replicate 10 (callList listName)) -- draw 10 triangles+   drawLine -- is this line green? NO!+            -- where is the line drawn?+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D 0.0 2.0 (-0.5*hf/wf) (1.5*hf/wf)+      else ortho2D 0.0 (2.0*wf/hf) (-0.5) 1.5+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Open window with initial window size, title bar,+-- RGBA display mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 650 50+   _ <- createWindow progName+   listName <- myInit+   reshapeCallback $= Just reshape+   displayCallback $= display listName+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/DOF.hs view
@@ -0,0 +1,182 @@+{-+   DOF.hs (adapted from dof.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates use of the accumulation buffer to create an+   out-of-focus depth-of-field effect. The teapots are drawn several times into+   the accumulation buffer. The viewing volume is jittered, except at the focal+   point, where the viewing volume is at the same position, each time. In this+   case, the gold teapot remains in focus.+-}++import Data.List ( genericLength )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- j8 contains values in the range -.5 < x < .5, -.5 < y < .5, and have a+-- gaussian distribution around the origin. Use these to do model jittering for+-- scene anti-aliasing and view volume jittering for depth of field effects. Use+-- in conjunction with the accwindow routine.+j8 :: [Vector2 GLdouble]+j8 = [+   Vector2 (-0.334818)   0.435331 ,+   Vector2   0.286438  (-0.393495),+   Vector2   0.459462    0.141540 ,+   Vector2 (-0.414498) (-0.192829),+   Vector2 (-0.183790)   0.082102 ,+   Vector2 (-0.079263) (-0.317383),+   Vector2   0.102254    0.299133 ,+   Vector2   0.164216  (-0.054399) ]++-- The first 6 arguments are identical to the frustum call. pixD is anti-alias+-- jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD is+-- depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field+-- effects. focus is distance from eye to plane in focus. focus must be greater+-- than, but not equal to 0. Note that accFrustum calls translate. You will+-- probably want to insure that your ModelView matrix has been initialized to+-- identity before calling accFrustum.+accFrustum :: GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble -> GLdouble+           -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()+accFrustum left right bottom top zNear zFar+           (Vector2 pixDx pixDy) (Vector2 eyeDx eyeDy) focus = do+   (_, Size w h) <- get viewport++   let xWSize = right - left;+       yWSize = top - bottom;++       dx = -(pixDx * xWSize / fromIntegral w + eyeDx * zNear / focus)+       dy = -(pixDy * yWSize / fromIntegral h + eyeDy * zNear / focus)++   matrixMode $= Projection+   loadIdentity+   frustum (left + dx) (right + dx) (bottom + dy) (top + dy) zNear zFar+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 (-eyeDx) (-eyeDy) 0)++-- The first 4 arguments are identical to the perspective call. pixD is+-- anti-alias jitter in pixels. Use (Vector2 0 0) for no anti-alias jitter. eyeD+-- is depth-of field jitter in pixels. Use (Vector2 0 0) for no depth of field+-- effects. focus is distance from eye to plane in focus. focus must be greater+-- than, but not equal to 0. Note that accPerspective calls accFrustum.+accPerspective :: GLdouble -> GLdouble -> GLdouble -> GLdouble+               -> Vector2 GLdouble -> Vector2 GLdouble -> GLdouble -> IO ()+accPerspective fovY aspect zNear zFar  pixD eyeD focus = do+   let fov2 = ((fovY * pi) / 180) / 2++       top = zNear / (cos fov2 / sin fov2)+       bottom = -top++       right = top * aspect+       left = -right++   accFrustum left right bottom top zNear zFar pixD eyeD focus++myInit :: IO DisplayList+myInit = do+   ambient (Light 0) $= Color4 0 0 0 1+   diffuse (Light 0) $= Color4 1 1 1 1+   position (Light 0) $= Vertex4 0 3 3 0++   lightModelAmbient $= Color4 0.2 0.2 0.2 1+   lightModelLocalViewer $= Disabled++   frontFace $= CW+   lighting $= Enabled+   light (Light 0) $= Enabled+   autoNormal $= Enabled+   normalize $= Enabled+   depthFunc $= Just Less++   clearColor $= Color4 0 0 0 0+   clearAccum $= Color4 0 0 0 0+   -- make teapot display list+   defineNewList Compile $+      renderObject Solid (Teapot 0.5)++-- Move object into position, specify the material properties, draw a teapot.+renderTeapot :: DisplayList -> Vector3 GLfloat -> Color4 GLfloat+             -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> IO ()+renderTeapot teapotList pos amb dif spec shine =+   preservingMatrix $ do+      translate pos+      materialAmbient Front $= amb+      materialDiffuse Front $= dif+      materialSpecular Front $= spec+      materialShininess Front $= shine * 128+      callList teapotList++-- display draws 5 teapots into the accumulation buffer several times; each time+-- with a jittered perspective. The focal point is at z = 5.0, so the gold+-- teapot will stay in focus. The amount of jitter is adjusted by the magnitude+-- of the accPerspective jitter; in this example, 0.33. In this example, the+-- teapots are drawn 8 times.+display :: DisplayList -> DisplayCallback+display teapotList = do+   (_, Size w h) <- get viewport+   clear [ AccumBuffer ]++   flip mapM_ j8 $ \(Vector2 x y) -> do+      clear [ ColorBuffer, DepthBuffer ]+      accPerspective 45 (fromIntegral w / fromIntegral h) 1 15+                     (Vector2 0 0) (Vector2 (0.33 * x) (0.33 * y)) 5++      -- ruby, gold, silver, emerald, and cyan teapots+      renderTeapot teapotList+                   (Vector3 (-1.1) (-0.5) (-4.5))+                   (Color4 0.1745     0.01175    0.01175    1)+                   (Color4 0.61424    0.04136    0.04136    1)+                   (Color4 0.727811   0.626959   0.626959   1)+                   0.6+      renderTeapot teapotList+                   (Vector3 (-0.5) (-0.5) (-5.0))+                   (Color4 0.24725    0.1995     0.0745     1)+                   (Color4 0.75164    0.60648    0.22648    1)+                   (Color4 0.628281   0.555802   0.366065   1)+                   0.4+      renderTeapot teapotList+                   (Vector3   0.2  (-0.5) (-5.5))+                   (Color4 0.19225    0.19225    0.19225    1)+                   (Color4 0.50754    0.50754    0.50754    1)+                   (Color4 0.508273   0.508273   0.508273   1)+                   0.4+      renderTeapot teapotList+                   (Vector3   1.0  (-0.5) (-6.0))+                   (Color4 0.0215     0.1745     0.0215     1)+                   (Color4 0.07568    0.61424    0.07568    1)+                   (Color4 0.633      0.727811   0.633      1)+                   0.6+      renderTeapot teapotList+                   (Vector3   1.8  (-0.5) (-6.5))+                   (Color4 0.0        0.1        0.06       1)+                   (Color4 0.0        0.50980392 0.50980392 1)+                   (Color4 0.50196078 0.50196078 0.50196078 1)+                    0.25+      accum Accum (recip (genericLength j8))++   accum Return 1+   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Be certain you request an accumulation buffer.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithAccumBuffer, WithDepthBuffer ]+   initialWindowSize $= Size 400 400+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   teapotList <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display teapotList+   mainLoop
+ examples/RedBook4/Data/leeds.bin view

binary file changed (absent → 720605 bytes)

+ examples/RedBook4/Double.hs view
@@ -0,0 +1,76 @@+{-+   Double.hs (adapted from double.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This is a simple double buffered program.+   Pressing the left mouse button rotates the rectangle.+   Pressing the middle mouse button stops the rotation.+-}++import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { spin :: IORef GLfloat }++makeState :: IO State+makeState = do+   s <- newIORef 0+   return $ State { spin = s }++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   preservingMatrix $ do+      s <- get (spin state)+      rotate s (Vector3 0 0 1)+      color (Color3 1 1 1 :: Color3 GLfloat)+      rect (Vertex2 (-25) (-25)) (Vertex2 25 25 :: Vertex2 GLfloat)+   swapBuffers++spinDisplay :: State -> IdleCallback+spinDisplay state = do+   let wrap n s = if s > n then s - n else s+   spin state $~ (wrap 360 . (+ 2))+   postRedisplay Nothing++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho (-50) 50 (-50) 50 (-1) 1+   matrixMode $= Modelview 0+   loadIdentity++keyboardMouse :: State -> KeyboardMouseCallback+keyboardMouse state (MouseButton b) Down _ _ =+   idleCallback $= case b of+      LeftButton -> Just (spinDisplay state)+      _ -> Nothing+-- ESC not handled in the original example, but useful nevertheless+keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess+keyboardMouse _ _ _ _ _ = return ()++--  Request double buffer display mode.+--  Register mouse input callback functions+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboardMouse state)+   mainLoop
+ examples/RedBook4/DrawF.hs view
@@ -0,0 +1,62 @@+{-+   DrawF.hs  (adapted from drawf.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Draws the bitmapped letter F on the screen (several times).+   This demonstrates use of the bitmap call.+-}++import Foreign ( Ptr, newArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO (Ptr GLubyte)+myInit = do+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0+   newArray [+      0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,+      0xff, 0x00, 0xff, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,+      0xff, 0xc0, 0xff, 0xc0 ]++display :: Ptr GLubyte -> DisplayCallback+display rasters = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   color3f (Color3 1 1 1)+   rasterPos2i (Vertex2 20 20)+   sequence_ $ replicate 3 $+      bitmap (Size 10 12) (Vertex2 0 0) (Vector2 11 0) rasters+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop+-- Open window with initial window size, title bar,+-- RGBA display mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 100 100+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   rasters <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display rasters+   mainLoop
+ examples/RedBook4/Feedback.hs view
@@ -0,0 +1,77 @@+{-+   Feedback.hs (adapted from feedback.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates use of OpenGL feedback. First, a lighting+   environment is set up and a few lines are drawn. Then feedback mode is+   entered, and the same lines are drawn. The results in the feedback buffer are+   printed.+-}++import Control.Monad ( when )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Initialize lighting.+myInit :: IO ()+myInit = do+   lighting $= Enabled+   light (Light 0) $= Enabled++-- Draw a few lines and two points, one of which will be clipped. If in feedback+-- mode, a passthrough token is issued between each primitive+drawGeometry :: IO ()+drawGeometry = do+   mode <- get renderMode+   -- resolve overloading, not needed in "real" programs+   let normal3f = normal :: Normal3 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive LineStrip $ do+      normal3f (Normal3 0 0 1)+      vertex3f (Vertex3 30 30 0)+      vertex3f (Vertex3 50 60 0)+      vertex3f (Vertex3 70 40 0)+   when (mode == Feedback) $+      passThrough (PassThroughValue 1)+   renderPrimitive Points $+      vertex3f (Vertex3 (-100) (-100) (-100))   -- will be clipped+   when (mode == Feedback) $+      passThrough (PassThroughValue 2)+   renderPrimitive Points $ do+      normal3f (Normal3 0 0 1)+      vertex3f (Vertex3 50 50 0)+   flush   -- not in original example++printBuffer :: Maybe [FeedbackToken] -> IO ()+printBuffer = maybe (putStrLn "feedback buffer overflow") (mapM_ print)++display :: DisplayCallback+display = do+   matrixMode $= Projection+   loadIdentity+   ortho 0 100 0 100 0 1++   clearColor $= Color4 0 0 0 0+   clear [ ColorBuffer ]+   drawGeometry++   (_, tokens) <- getFeedbackTokens 1024 ThreeDColor drawGeometry+   printBuffer tokens++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 100 100+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Fog.hs view
@@ -0,0 +1,90 @@+{-+   Fog.hs (adapted from fog.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws 5 red spheres, each at a different z distance from the+   eye, in different types of fog. Pressing the f key chooses between 3 types+   of fog: exponential, exponential squared, and linear. In this program, there+   is a fixed density value, as well as fixed start and end values for the+   linear fog.+-}++import Data.Char ( toLower )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   depthFunc $= Just Less++   position (Light 0) $= Vertex4 0.5 0.5 3.0 0.0+   lighting $= Enabled+   light (Light 0) $= Enabled++   -- NOTE: The alpha values are missing from fog.c!+   materialAmbient   Front $= Color4 0.1745   0.01175  0.01175  1.0+   materialDiffuse   Front $= Color4 0.61424  0.04136  0.04136  1.0+   materialSpecular  Front $= Color4 0.727811 0.626959 0.626959 1.0+   materialShininess Front $= 0.6 * 128++   fog $= Enabled+   let c = Color4 0.5 0.5 0.5 1.0+   fogMode $= Exp 0.35+   fogColor $= c+   hint Fog $= DontCare+   clearColor $= c++renderSpehere :: Vector3 GLfloat -> IO ()+renderSpehere xyz =+   preservingMatrix $ do+      translate xyz+      renderObject Solid (Sphere' 0.4 16 16)++-- display draws 5 spheres at different z positions.+display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   mapM_ renderSpehere [ Vector3 x (-0.5) (-3 - x) | x <- [-2 .. 2] ]+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10.0) 10.0+      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10.0) 10.0+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char c) Down _ _ = case toLower c of+   'f'   -> do+      mode <- get fogMode+      case mode of+         Linear _ _    -> do fogMode $= Exp   0.35; putStrLn "Fog mode is Exp"+         Exp _         -> do fogMode $= Exp2  0.35; putStrLn "Fog mode is Exp2"+         Exp2 _        -> do fogMode $= Linear 1 5; putStrLn "Fog mode is Linear"+      postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, depth buffer, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display+   mainLoop
+ examples/RedBook4/FogCoord.hs view
@@ -0,0 +1,122 @@+{-+   FogCoord.hs (adapted from fogcoord.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the use of explicit fog coordinates. You can press+   the keyboard and change the fog coordinate value at any vertex. You can also+   switch between using explicit fog coordinates and the default fog generation+   mode.++   Pressing the 'f' and 'b' keys move the viewer forward and backwards. Pressing+   'c' initiates the default fog generation.  Pressing capital 'C' restores+   explicit fog coordinates.  Pressing '1', '2', '3', '8', '9', and '0' add or+   subtract from the fog coordinate values at one of the three vertices of the+   triangle.+-}++import Control.Monad ( when )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { f1, f2, f3 :: IORef (FogCoord1 GLfloat)   }++makeState :: IO State+makeState = do+   f1' <- newIORef (FogCoord1  1)+   f2' <- newIORef (FogCoord1  5)+   f3' <- newIORef (FogCoord1 10)+   return $ State { f1 = f1', f2 = f2', f3 = f3' }++-- Initialize fog+myInit :: IO ()+myInit = do+   let theFogColor = Color4 0 0.25 0.25 1+   fog $= Enabled+   fogMode $= Exp 0.25+   fogColor $= theFogColor+   hint Fog $= DontCare+   fogCoordSrc $= FogCoord+   clearColor $= theFogColor++drawTriangle :: State -> (State -> IORef (FogCoord1 GLfloat)) -> Vertex3 GLfloat -> IO ()+drawTriangle state f v = do+   fc <- get (f state)+   fogCoord fc+   vertex v++-- display draws a triangle at an angle.+display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]++   color (Color3 1 0.75 (0 :: GLfloat))+   renderPrimitive Triangles $ do+      drawTriangle state f1 (Vertex3   2  (-2)   0 )+      drawTriangle state f2 (Vertex3 (-2)   0  (-5))+      drawTriangle state f3 (Vertex3   0    2 (-10))++   swapBuffers++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 1 0.25 25+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-5 :: GLfloat))++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case c of+   'c'   -> setSrc FragmentDepth+   'C'   -> setSrc FogCoord+   '1'   -> inc f1   0.25+   '2'   -> inc f2   0.25+   '3'   -> inc f3   0.25+   '8'   -> inc f1 (-0.25)+   '9'   -> inc f2 (-0.25)+   '0'   -> inc f3 (-0.25)+   'b'   -> trans  (-0.25)+   'f'   -> trans    0.25+   '\27' -> exitWith ExitSuccess+   _     -> return ()+   where setSrc :: FogCoordSrc -> IO ()+         setSrc s = do+            fogCoordSrc $= s+            postRedisplay Nothing++         inc :: (State -> IORef (FogCoord1 GLfloat)) -> GLfloat -> IO ()+         inc f x = do+            FogCoord1 oldValue <- get (f state)+            let newValue = oldValue + x+            when (newValue > 0) $ do+               f state $= FogCoord1 newValue+               postRedisplay Nothing++         trans :: GLfloat -> IO ()+         trans x = do+            matrixMode $= Modelview 0+            translate (Vector3 0 0 x)+            postRedisplay Nothing+keyboard _ _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state+   mainLoop++
+ examples/RedBook4/FogIndex.hs view
@@ -0,0 +1,76 @@+{-+   FogIndex.hs (adapted from fogindex.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws 5 wireframe spheres, each at a different z distance from+   the eye, in linear fog.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Initialize color map and fog. Set screen clear color to end of color ramp.+numColors, rampStart :: GLint+numColors = 32+rampStart = 16++myInit :: IO ()+myInit = do+   depthFunc $= Just Less++   flip mapM_ [ 0 .. numColors - 1 ] $ \i -> do+      let shade = fromIntegral (numColors - i) / fromIntegral numColors+      colorMapEntry (Index1 (rampStart + i)) $= Color3 shade shade shade+   fog $= Enabled++   fogMode $= Linear 1 6+   fogIndex $= Index1 numColors+   hint Fog $= Nicest+   clearIndex $= Index1 (fromIntegral (numColors + rampStart - 1))++renderSpehere :: Vector3 GLfloat -> IO ()+renderSpehere xyz =+   preservingMatrix $ do+      translate xyz+      renderObject Wireframe (Sphere' 0.4 16 16)++-- display draws 5 spheres at different z positions.+display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   index (Index1 rampStart)+   mapM_ renderSpehere [ Vector3 x (-0.5) (-3 - x) | x <- [-2 .. 2] ]+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10.0) 10.0+      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10.0) 10.0+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, color index+-- display mode, depth buffer, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, IndexMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display+   mainLoop
+ examples/RedBook4/Font.hs view
@@ -0,0 +1,127 @@+{-+   Font.hs  (adapted from font.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Draws some text in a bitmapped font. Uses bitmap and other pixel routines.+   Also demonstrates use of display lists.+-}++import Control.Monad ( zipWithM_ )+import Data.List ( genericDrop, genericLength )+import Foreign.C.String ( castCharToCChar )+import Foreign.Marshal.Array ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++space :: [GLubyte]+space = [+     0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ]++letters :: [[GLubyte]]+letters = [+   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xff, 0xc3, 0xc3, 0xc3, 0x66, 0x3c, 0x18 ],+   [ 0x00, 0x00, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],+   [ 0x00, 0x00, 0x7e, 0xe7, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xe7, 0x7e ],+   [ 0x00, 0x00, 0xfc, 0xce, 0xc7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc7, 0xce, 0xfc ],+   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0xc0, 0xc0, 0xfc, 0xc0, 0xc0, 0xc0, 0xc0, 0xff ],+   [ 0x00, 0x00, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xfc, 0xc0, 0xc0, 0xc0, 0xff ],+   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xcf, 0xc0, 0xc0, 0xc0, 0xc0, 0xe7, 0x7e ],+   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xff, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],+   [ 0x00, 0x00, 0x7e, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x7e ],+   [ 0x00, 0x00, 0x7c, 0xee, 0xc6, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06, 0x06 ],+   [ 0x00, 0x00, 0xc3, 0xc6, 0xcc, 0xd8, 0xf0, 0xe0, 0xf0, 0xd8, 0xcc, 0xc6, 0xc3 ],+   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0 ],+   [ 0x00, 0x00, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xdb, 0xff, 0xff, 0xe7, 0xc3 ],+   [ 0x00, 0x00, 0xc7, 0xc7, 0xcf, 0xcf, 0xdf, 0xdb, 0xfb, 0xf3, 0xf3, 0xe3, 0xe3 ],+   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xe7, 0x7e ],+   [ 0x00, 0x00, 0xc0, 0xc0, 0xc0, 0xc0, 0xc0, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],+   [ 0x00, 0x00, 0x3f, 0x6e, 0xdf, 0xdb, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0x66, 0x3c ],+   [ 0x00, 0x00, 0xc3, 0xc6, 0xcc, 0xd8, 0xf0, 0xfe, 0xc7, 0xc3, 0xc3, 0xc7, 0xfe ],+   [ 0x00, 0x00, 0x7e, 0xe7, 0x03, 0x03, 0x07, 0x7e, 0xe0, 0xc0, 0xc0, 0xe7, 0x7e ],+   [ 0x00, 0x00, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0xff ],+   [ 0x00, 0x00, 0x7e, 0xe7, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],+   [ 0x00, 0x00, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],+   [ 0x00, 0x00, 0xc3, 0xe7, 0xff, 0xff, 0xdb, 0xdb, 0xc3, 0xc3, 0xc3, 0xc3, 0xc3 ],+   [ 0x00, 0x00, 0xc3, 0x66, 0x66, 0x3c, 0x3c, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3 ],+   [ 0x00, 0x00, 0x18, 0x18, 0x18, 0x18, 0x18, 0x18, 0x3c, 0x3c, 0x66, 0x66, 0xc3 ],+   [ 0x00, 0x00, 0xff, 0xc0, 0xc0, 0x60, 0x30, 0x7e, 0x0c, 0x06, 0x03, 0x03, 0xff ]]++charToGLubyte :: Char -> GLubyte+charToGLubyte = fromIntegral . castCharToCChar++makeRasterFont :: IO DisplayList+makeRasterFont = do+   rowAlignment Unpack $= 1++   fontDisplayLists@(fontOffset:_) <- genObjectNames 128+   let listsStartingWith ch = genericDrop (charToGLubyte ch) fontDisplayLists+       makeLetter dl letter =+          defineList dl Compile $+             withArray letter $+                bitmap (Size 8 13) (Vertex2 0 2) (Vector2 10 0)++   zipWithM_ makeLetter (listsStartingWith 'A') letters+   makeLetter (head (listsStartingWith ' ')) space+   return fontOffset++myInit :: IO DisplayList+myInit = do+   shadeModel $= Flat+   makeRasterFont++printString :: DisplayList -> String -> IO ()+printString fontOffset s =+   preservingAttrib [ ListAttributes ] $ do+      listBase $= fontOffset+      withArray (map charToGLubyte s) $+         callLists (genericLength s) UnsignedByte++-- Everything above this line could be in a library+-- that defines a font.  To make it work, you've got+-- to call makeRasterFont before you start making+-- calls to printString.+display :: DisplayList -> DisplayCallback+display fontOffset = do+   let white = Color3 1 1 1++   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   color3f white++   rasterPos2i (Vertex2 20 60)+   printString fontOffset "THE QUICK BROWN FOX JUMPS"+   rasterPos2i (Vertex2 20 40)+   printString fontOffset "OVER A LAZY DOG"+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop+-- Open window with initial window size, title bar,+-- RGBA display mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 300 100+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   fontOffset <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display fontOffset+   mainLoop
+ examples/RedBook4/Hello.hs view
@@ -0,0 +1,55 @@+{-+   Hello.hs (adapted from hello.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This is a simple, introductory OpenGL program.+-}++import Graphics.UI.GLUT++display :: DisplayCallback+display = do+   -- clear all pixels+   clear [ ColorBuffer ]++   -- draw white polygon (rectangle) with corners at+   -- (0.25, 0.25, 0.0) and (0.75, 0.75, 0.0)+   color (Color3 1.0 1.0 (1.0 :: GLfloat))+   -- resolve overloading, not needed in "real" programs+   let vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Polygon $ mapM_ vertex3f [+      Vertex3 0.25 0.25 0.0,+      Vertex3 0.75 0.25 0.0,+      Vertex3 0.75 0.75 0.0,+      Vertex3 0.25 0.75 0.0]++   -- don't wait!+   -- start processing buffered OpenGL routines+   flush++myInit :: IO ()+myInit = do+   -- select clearing color+   clearColor $= Color4 0 0 0 0++   -- initialize viewing values+   matrixMode $= Projection+   loadIdentity+   ortho 0 1 0 1 (-1) 1++-- Declare initial window size, position, and display mode (single buffer and+-- RGBA). Open window with "hello" in its title bar. Call initialization+-- routines. Register callback function to display graphics. Enter main loop and+-- process events.+main :: IO ()+main = do+   _ <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow "hello"+   myInit+   displayCallback $= display+   mainLoop
+ examples/RedBook4/Histogram.hs view
@@ -0,0 +1,85 @@+{-+   Histogram.hs (adapted from histogram.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Compute the histogram of the image.  This program illustrates the use of+   the histogram function.+-}++import Control.Monad ( zipWithM_ )+import Foreign ( allocaArray, peekArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT+import ReadImage++histogramSize :: Int+histogramSize = 256   -- Must be a power of 2++myInit :: IO ()+myInit = do+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0++   histogram NoProxy $= Just (fromIntegral histogramSize, RGB', PassThrough)++display :: Size -> PixelData a -> DisplayCallback+display size pixels = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 1 1)+   drawPixels size pixels++   values <- allocaArray histogramSize $ \buf -> do+      -- Note: The example in the Red Book uses GL_UNSIGNED_SHORT here,+      -- but we are more honest by using Short...+      getHistogram Reset (PixelData RGB Short buf)+      peekArray histogramSize buf++   -- Plot histogram+   zipWithM_ (plotHistogram values)+             [  Color3 1 0 0,         Color3 0 1 0,         Color3 0 0 1       ]+             [\(Color3 r _ _) -> r, \(Color3 _ g _) -> g, \(Color3 _ _ b) -> b ]+   flush++plotHistogram ::+   [Color3 GLshort] -> Color3 GLfloat -> (Color3 GLshort -> GLshort) -> IO ()+plotHistogram values c selectComponent =+   renderPrimitive LineStrip $ do+      color c+      zipWithM_ (\i h -> vertex (Vertex2 i (selectComponent h))) [ 0 .. ] values++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral histogramSize) 0 10000 (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char 's')   Down _ _ = do+   Just (width, format, sink) <- get (histogram NoProxy)+   let newSink = if sink == Sink then PassThrough else Sink+   histogram NoProxy $= Just (width, format, newSink)+   postRedisplay Nothing+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= size+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display size pixels+   mainLoop
+ examples/RedBook4/Image.hs view
@@ -0,0 +1,116 @@+{-+   Image.hs  (adapted from image.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates drawing pixels and shows the effect of+   drawPixels, copyPixels, and pixelZoom.++   Interaction: moving the mouse while pressing the mouse button will copy+   the image in the lower-left corner of the window to the mouse position,+   using the current pixel zoom factors. There is no attempt to prevent you+   from drawing over the original image. If you press the 'r' key, the+   original image and zoom factors are reset. If you press the 'z' or 'Z'+   keys, you change the zoom factors.+-}++import Data.Bits ( (.&.) )+import Data.IORef ( IORef, newIORef )+import Foreign ( newArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { zoomFactor :: IORef GLfloat }++makeState :: IO State+makeState = do+   z <- newIORef 1+   return $ State { zoomFactor = z }++-- Create checkerboard image+checkImageSize :: Size+checkImageSize = Size 64 64++type Image = PixelData (Color3 GLubyte)++makeCheckImage :: Size -> GLsizei -> (GLubyte -> (Color3 GLubyte)) -> IO Image+makeCheckImage (Size w h) n f =+   fmap (PixelData RGB UnsignedByte) $+      newArray [ f c |+                 i <- [ 0 .. w - 1 ],+                 j <- [ 0 .. h - 1 ],+                 let c | (i .&. n) == (j .&. n) = 0+                       | otherwise              = 255 ]++myInit :: IO Image+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   rowAlignment Unpack $= 1+   makeCheckImage checkImageSize 0x8 (\c -> Color3 c c c)++display ::  Image -> DisplayCallback+display pixelData = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 0 0)+   drawPixels checkImageSize pixelData+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   matrixMode $= Modelview 0+   loadIdentity++motion :: State -> MotionCallback+motion state (Position x y) = do+   Size _ height <- get windowSize+   let screenY = fromIntegral height - y+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 x screenY)+   z <- get (zoomFactor state)+   pixelZoom $= (z, z)+   copyPixels (Position 0 0) checkImageSize CopyColor+   pixelZoom $= (1, 1)+   flush++resetZoomFactor :: State -> IO ()+resetZoomFactor state = do+   zoomFactor state $= 1.0+   postRedisplay Nothing+   putStrLn "zoomFactor reset to 1.0"++incZoomFactor :: State -> GLfloat -> IO ()+incZoomFactor state inc = do+   zoomFactor state $~! (max 0.5 . min 3.0 . (+ inc))+   get (zoomFactor state) >>= putStrLn . ("zoomFactor is now " ++) . show++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char 'r')   Down _   _ = resetZoomFactor state+keyboard state (Char 'R')   Down _   _ = resetZoomFactor state+keyboard state (Char 'z')   Down _   _ = incZoomFactor   state   0.5+keyboard state (Char 'Z')   Down _   _ = incZoomFactor   state (-0.5)+keyboard _     (Char '\27') Down _   _ = exitWith ExitSuccess+keyboard _     _            _    _   _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   checkImage <- myInit+   displayCallback $= display checkImage+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   motionCallback $= Just (motion state)+   mainLoop
+ examples/RedBook4/Light.hs view
@@ -0,0 +1,62 @@+{-+   Light.hs (adapted from light.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the use of the OpenGL lighting model. A sphere+   is drawn using a grey material characteristic. A single light source+   illuminates the object.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth++   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 50+   position (Light 0) $= Vertex4 1 1 1 0++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   renderObject Solid (Sphere' 1 20 16)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-1.5) 1.5 (-1.5 * hf/wf) (1.5 * hf/wf) (-10) 10+      else ortho (-1.5 * wf/hf) (1.5 * wf/hf) (-1.5) 1.5 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Lines.hs view
@@ -0,0 +1,88 @@+{-+   Lines.hs (adapted from lines.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates geometric primitives and their attributes.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++drawOneLine :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()+drawOneLine p1 p2 = renderPrimitive Lines $ do vertex p1; vertex p2++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   -- select white for all lines+   color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)++   -- in 1st row, 3 lines, each with a different stipple+   lineStipple $= Just (1, 0x0101)  --  dotted+   drawOneLine (Vertex2  50 125) (Vertex2 150 125)+   lineStipple $= Just (1, 0x00FF)  --  dashed+   drawOneLine (Vertex2 150 125) (Vertex2  250 125)+   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash+   drawOneLine (Vertex2 250 125) (Vertex2 350 125)++   -- in 2nd row, 3 wide lines, each with different stipple+   lineWidth $= 5.0+   lineStipple $= Just (1, 0x0101)  --  dotted+   drawOneLine (Vertex2  50 100) (Vertex2 150 100)+   lineStipple $= Just (1, 0x00FF)  --  dashed+   drawOneLine (Vertex2 150 100) (Vertex2 250 100)+   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash+   drawOneLine (Vertex2 250 100) (Vertex2 350 100)+   lineWidth $= 1.0++   -- in 3rd row, 6 lines, with dash/dot/dash stipple+   -- as part of a single connected line strip+   lineStipple $= Just (1, 0x1C47)  --  dash/dot/dash+   renderPrimitive LineStrip $ mapM_ vertex [ Vertex2 (50+(i*50)) (75 :: GLint) | i <- [0..6] ]++   -- in 4th row, 6 independent lines with same stipple+   sequence_ [ drawOneLine (Vertex2 (50+( i   *50)) 50)+                           (Vertex2 (50+((i+1)*50)) 50) | i <- [0..5] ]++   -- in 5th row, 1 line, with dash/dot/dash stipple+   -- and a stipple repeat factor of 5+   lineStipple $= Just (5, 0x1C47)  --  dash/dot/dash+   drawOneLine (Vertex2 50 25) (Vertex2 350 25)++   lineStipple $= Nothing+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   -- the following line is not in the original example, but it's good style...+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _ _ _ _ = return ()++--  Request double buffer display mode.+--  Register mouse input callback functions+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 400 150+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/MVArray.hs view
@@ -0,0 +1,87 @@+{-+   MVArray.hs (adapted from mvarray.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates multiple vertex arrays, specifically the OpenGL+   routine multiDrawElements.+-}++import Control.Monad ( unless )+import Data.List ( genericLength )+import Foreign ( Storable, Ptr, newArray )+import System.Exit ( exitFailure, exitWith, ExitCode(..) )+import Graphics.UI.GLUT++data MultiDrawInfo a = MultiDrawInfo (Ptr GLsizei) (Ptr (Ptr a)) GLsizei++makeMultiDrawInfo :: Storable a => [[a]] -> IO (MultiDrawInfo a)+makeMultiDrawInfo indicesLists = do+   count <- newArray $ map genericLength indicesLists+   indices <- newArray =<< mapM newArray indicesLists+   return $ MultiDrawInfo count indices (genericLength indicesLists)++setupPointer :: IO ()+setupPointer = do+   clientState VertexArray $= Enabled+   vertices <- newArray ([+      Vertex2  25 25,+      Vertex2  75 75,+      Vertex2 100 125,+      Vertex2 150  75,+      Vertex2 200 175,+      Vertex2 250 150,+      Vertex2 300 125,+      Vertex2 100 200,+      Vertex2 150 250,+      Vertex2 200 225,+      Vertex2 250 300,+      Vertex2 300 250 ] :: [Vertex2 GLint])+   arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 vertices++myInit :: IO (MultiDrawInfo GLubyte)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth+   setupPointer+   makeMultiDrawInfo [ [ 0, 1, 2, 3, 4, 5, 6 ],+                       [ 1, 7, 8, 9, 10, 11 ] ]++display :: MultiDrawInfo GLubyte -> DisplayCallback+display (MultiDrawInfo count indices primCount) = do+   clear [ ColorBuffer ]+   color (Color3 1 1 1 :: Color3 GLfloat)+   multiDrawElements LineStrip count UnsignedByte indices primCount+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   -- the following line is not in the original example, but it's good style...+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 350 350+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   exts <- get glExtensions+   unless ("GL_EXT_multi_draw_arrays" `elem` exts) $ do+      putStrLn "Sorry, this demo requires the GL_EXT_multi_draw_arrays extension."+      exitFailure+   multiDrawInfo <- myInit+   displayCallback $= display multiDrawInfo+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Material.hs view
@@ -0,0 +1,149 @@+{-+   Material.hs (adapted from material.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the use of the GL lighting model. Several+   objects are drawn using different material characteristics. A single+   light source illuminates the objects.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Initialize z-buffer, projection matrix, light source, and lighting model.+-- Do not specify a material property here.++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0.1 0.1 0+   depthFunc $= Just Less+   shadeModel $= Smooth++   ambient (Light 0) $= Color4 0 0 0 1+   diffuse (Light 0) $= Color4 1 1 1 1+   position (Light 0) $= Vertex4 0 3 2 0+   lightModelAmbient $= Color4 0.4 0.4 0.4 1+   lightModelLocalViewer $= Disabled++   lighting $= Enabled+   light (Light 0) $= Enabled++-- Draw twelve spheres in 3 rows with 4 columns.+-- The spheres in the first row have materials with no ambient reflection.+-- The second row has materials with significant ambient reflection.+-- The third row has materials with colored ambient reflection.+--+-- The first column has materials with blue, diffuse reflection only.+-- The second column has blue diffuse reflection, as well as specular+-- reflection with a low shininess exponent.+-- The third column has blue diffuse reflection, as well as specular+-- reflection with a high shininess exponent (a more concentrated highlight).+-- The fourth column has materials which also include an emissive component.+--+-- translate is used to move spheres to their appropriate locations.++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]++   let draw :: GLfloat -> GLfloat -> Color4 GLfloat -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> Color4 GLfloat -> IO ()+       draw row column amb dif spc shi emi =+          preservingMatrix $ do+             translate (Vector3 (2.5 * (column - 2.5)) (3 * (2 - row)) 0)+             materialAmbient   Front $= amb+             materialDiffuse   Front $= dif+             materialSpecular  Front $= spc+             materialShininess Front $= shi+             materialEmission  Front $= emi+             renderObject Solid (Sphere' 1 16 16)++       noMat           = Color4 0 0 0 1+       matAmbient      = Color4 0.7 0.7 0.7 1+       matAmbientColor = Color4 0.8 0.8 0.2 1+       matDiffuse      = Color4 0.1 0.5 0.8 1+       matSpecular     = Color4 1 1 1 1+       noShininess     = 0+       lowShininess    = 5+       highShininess   = 100+       matEmission     = Color4 0.3 0.2 0.2 0++   -- draw sphere in first row, first column+   -- diffuse reflection only; no ambient or specular+   draw 1 1 noMat matDiffuse noMat noShininess noMat++   -- draw sphere in first row, second column+   -- diffuse and specular reflection; low shininess; no ambient+   draw 1 2 noMat matDiffuse matSpecular lowShininess noMat++   -- draw sphere in first row, third column+   -- diffuse and specular reflection; high shininess; no ambient+   draw 1 3 noMat matDiffuse matSpecular highShininess noMat++   -- draw sphere in first row, fourth column+   -- diffuse reflection; emission; no ambient or specular reflection+   draw 1 4 noMat matDiffuse noMat noShininess matEmission++   -- draw sphere in second row, first column+   -- ambient and diffuse reflection; no specular+   draw 2 1 matAmbient matDiffuse noMat noShininess noMat++   -- draw sphere in second row, second column+   -- ambient, diffuse and specular reflection; low shininess+   draw 2 2 matAmbient matDiffuse matSpecular lowShininess noMat++   -- draw sphere in second row, third column+   -- ambient, diffuse and specular reflection; high shininess+   draw 2 3 matAmbient matDiffuse matSpecular highShininess noMat++   -- draw sphere in second row, fourth column+   -- ambient and diffuse reflection; emission; no specular+   draw 2 4 matAmbient matDiffuse noMat noShininess matEmission++   -- draw sphere in third row, first column+   -- colored ambient and diffuse reflection; no specular+   draw 3 1 matAmbientColor matDiffuse noMat noShininess noMat++   -- draw sphere in third row, second column+   -- colored ambient, diffuse and specular reflection; low shininess+   draw 3 2 matAmbientColor matDiffuse matSpecular lowShininess noMat++   -- draw sphere in third row, third column+   -- colored ambient, diffuse and specular reflection; high shininess+   draw 3 3 matAmbientColor matDiffuse matSpecular highShininess noMat++   -- draw sphere in third row, fourth column+   -- colored ambient and diffuse reflection; emission; no specular+   draw 3 4 matAmbientColor matDiffuse noMat noShininess matEmission++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h * 2+      then ortho (-6) 6 (-3 * (hf * 2) / wf) (3 * (hf * 2) / wf) (-10) 10+      else ortho (-6 * wf / (hf * 2)) (6 * wf / (hf * 2)) (-3) 3 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 600 450+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Minmax.hs view
@@ -0,0 +1,64 @@+{-+   Minmax.hs (adapted from minmax.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Determine the minimum and maximum values of a group of pixels. This+   demonstrates use of the minmax function.+-}++import Foreign ( allocaArray, peekArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT+import ReadImage++myInit :: IO ()+myInit = do+   rowAlignment Unpack $= 1+   clearColor $= Color4 0 0 0 0+   minmax $= Just (RGB', PassThrough)++display :: Size -> PixelData a -> DisplayCallback+display size pixels = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let rasterPos2i = rasterPos :: Vertex2 GLint -> IO ()+   rasterPos2i (Vertex2 1 1)+   drawPixels size pixels+   flush++   [Color3 minR minG minB, Color3 maxR maxG maxB] <- allocaArray 2 $ \buf -> do+      getMinmax Reset (PixelData RGB UnsignedByte buf)+      peekArray 2 buf :: IO [Color3 GLubyte]+   putStrLn (" Red   : min = " ++ show minR ++ "   max = " ++ show maxR)+   putStrLn (" Green : min = " ++ show minG ++ "   max = " ++ show maxG)+   putStrLn (" Blue  : min = " ++ show minB ++ "   max = " ++ show maxB)++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 (fromIntegral w) 0 (fromIntegral h) (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, args) <- getArgsAndInitialize+   (size, pixels) <- readImage (if null args then "Data/leeds.bin" else head args)+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= size+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display size pixels+   mainLoop
+ examples/RedBook4/Mipmap.hs view
@@ -0,0 +1,97 @@+{-+   Mipmap.hs  (adapted from mipmap.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates using mipmaps for texture maps. To overtly show+   the effect of mipmaps, each mipmap reduction level has a solidly colored,+   contrasting texture image. Thus, the quadrilateral which is drawn is drawn+   with several different colors.+-}++import Control.Monad ( when )+import Data.Maybe ( isJust )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++makeImage :: Level -> TextureSize2D -> Color4 GLubyte -> IO ()+makeImage level size@(TextureSize2D w h) col =+   withArray (replicate (fromIntegral (w * h)) col) $+      texImage2D Texture2D NoProxy level RGBA' size 0 . PixelData RGBA UnsignedByte++makeImages :: [Color4 GLubyte] -> IO ()+makeImages colors = sequence_ $ zipWith3 makeImage levels sizes colors+   where numLevels = length colors+         levels = [ 0 .. fromIntegral numLevels - 1 ]+         sizes = reverse (take numLevels [ TextureSize2D s s | s <- iterate (* 2) 1 ])++myInit :: IO (Maybe TextureObject)+myInit = do+   depthFunc $= Just Less+   shadeModel $= Flat++   translate (Vector3 0 0 (-3.6 :: GLfloat))+   rowAlignment Unpack $= 1++   exts <- get glExtensions+   mbTexName <- if "GL_EXT_texture_object" `elem` exts+                   then fmap Just genObjectName+                   else return Nothing+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName++   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Just Nearest), Nearest)++   makeImages [ Color4 255 255   0 255,+                Color4 255   0 255 255,+                Color4 255   0   0 255,+                Color4   0 255   0 255,+                Color4   0   0 255 255,+                Color4 255 255 255 255 ]++   textureFunction $= Decal+   texture Texture2D $= Enabled+   return mbTexName++display :: Maybe TextureObject -> DisplayCallback+display mbTexName = do+   clear [ ColorBuffer, DepthBuffer ]+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName+   -- resolve overloading, not needed in "real" programs+   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (  -2) (-1)      0 )+      texCoord2f (TexCoord2 0 8); vertex3f (Vertex3 (  -2)   1       0 )+      texCoord2f (TexCoord2 8 8); vertex3f (Vertex3  2000    1  (-6000))+      texCoord2f (TexCoord2 8 0); vertex3f (Vertex3  2000  (-1) (-6000))+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30000+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 50 50+   _ <- createWindow progName+   texName <- myInit+   displayCallback $= display texName+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Model.hs view
@@ -0,0 +1,86 @@+{-+   Model.hs (adapted from model.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates modeling transformations.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++drawTriangle :: IO ()+drawTriangle = do+   -- resolve overloading, not needed in "real" programs+   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()+   renderPrimitive LineLoop $ do+      vertex2f (Vertex2    0    25 )+      vertex2f (Vertex2   25  (-25))+      vertex2f (Vertex2 (-25) (-25))++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()+       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()+   color3f (Color3 1 1 1)++   loadIdentity+   color3f (Color3 1 1 1)+   drawTriangle++   lineStipple $= Just (1, 0xF0F0)+   loadIdentity+   translatef (Vector3 (-20) 0 0)+   drawTriangle++   lineStipple $= Just (1, 0xF00F)+   loadIdentity+   scalef 1.5 0.5 1.0+   drawTriangle++   lineStipple $= Just (1, 0x8888)+   loadIdentity+   rotatef 90 (Vector3 0 0 1)+   drawTriangle+   lineStipple $= Nothing++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-50) 50 (-50 * hf/wf) (50 * hf/wf) (-1) 1+      else ortho (-50 * wf/hf) (50 * wf/hf) (-50) 50 (-1) 1+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/MoveLight.hs view
@@ -0,0 +1,85 @@+{-+   MoveLight.hs (adapted from movelight.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates when to issue lighting and transformation+   commands to render a model with a light which is moved by a+   modeling transformation (rotate or translate). The light position+   is reset after the modeling transformation is called. The eye+   position does not change.++   A sphere is drawn using a grey material characteristic. A single+   light source illuminates the object.++   Interaction: pressing the left mouse button alters the modeling+   transformation (x rotation) by 30 degrees. The scene is then+   redrawn with the light in a new position.+-}++import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { spin :: IORef Int }++makeState :: IO State+makeState = do+   s <- newIORef 0+   return $ State { spin = s }++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth+   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)+      preservingMatrix $ do+         s <- get (spin state)+         rotate (fromIntegral s :: GLdouble) (Vector3 1 0 0)+         position (Light 0) $= Vertex4 0 0 1.5 1+         translate (Vector3 0 0 1.5 :: Vector3 GLdouble)+         lighting $= Disabled+         color (Color3 0 1 1 :: Color3 GLfloat)+         renderObject Wireframe (Cube 0.1)+         lighting $= Enabled+      renderObject Solid (Torus 0.275 0.85 8 15)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 40 (fromIntegral w / fromIntegral h) 1 20+   matrixMode $= Modelview 0+   loadIdentity++keyboardMouse :: State -> KeyboardMouseCallback+keyboardMouse state (MouseButton LeftButton) Down _ _ = do+   spin state $~ ((`mod` 360) . (+ 30))+   postRedisplay Nothing+keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess+keyboardMouse _ _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboardMouse state)+   mainLoop
+ examples/RedBook4/MultiTex.hs view
@@ -0,0 +1,111 @@+{-+   MultiTex.hs  (adapted from multitex.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE+-}++import Control.Monad ( unless )+import Foreign ( withArray )+import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++specifyTexture :: TextureSize2D -> (GLubyte -> GLubyte -> Color4 GLubyte) -> IO ()+specifyTexture size@(TextureSize2D w h) f =+   withArray [ f i j | i <- [ 0 .. fromIntegral w - 1 ],+                       j <- [ 0 .. fromIntegral h - 1] ] $+      texImage2D Texture2D NoProxy 0 RGBA' size 0 . PixelData RGBA UnsignedByte++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less+   rowAlignment Unpack $= 1++   [texName0, texName1] <- genObjectNames 2+   textureBinding Texture2D $= Just texName0+   -- Note: We use much brighter colors than in the original example where+   -- everything was almost black.+   specifyTexture (TextureSize2D 32 32) (\i j -> Color4 (i*8) (j*8) ((i*j) `div` 4) 255)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)++   textureBinding Texture2D $= Just texName1+   specifyTexture (TextureSize2D 16 16) (\i j -> Color4 255 (i*16) (j*16) 255)+   textureFilter Texture2D $= ((Linear', Nothing), Linear')+   textureWrapMode Texture2D S $= (Repeated, ClampToEdge)+   textureWrapMode Texture2D T $= (Repeated, ClampToEdge)+   -- Use the two texture objects to define two texture units+   -- for use in multitexturing+   activeTexture $= TextureUnit 0+   texture Texture2D $= Enabled+   textureBinding Texture2D $= Just texName0+   textureFunction $= Replace+   matrixMode $= Texture+   loadIdentity+   translate (Vector3 0.5 0.5 (0 :: GLfloat))+   rotate (45 :: GLfloat) (Vector3 0 0 1)+   translate (Vector3 (-0.5) (-0.5) (0 :: GLfloat))+   matrixMode $= Modelview 0+   activeTexture $= TextureUnit 1+   texture Texture2D $= Enabled+   textureBinding Texture2D $= Just texName1+   textureFunction $= Modulate++display ::  DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   -- resolve overloading, not needed in "real" programs+   let multiTexCoord2f = multiTexCoord :: TextureUnit -> TexCoord2 GLfloat -> IO ()+       vertex2f = vertex :: Vertex2 GLfloat -> IO ()+   renderPrimitive Triangles $ do+      multiTexCoord2f (TextureUnit 0) (TexCoord2 0   0)+      multiTexCoord2f (TextureUnit 1) (TexCoord2 1   0)+      vertex2f (Vertex2 0 0)+      multiTexCoord2f (TextureUnit 0) (TexCoord2 0.5 1)+      multiTexCoord2f (TextureUnit 1) (TexCoord2 0.5 0)+      vertex2f (Vertex2 50 100)+      multiTexCoord2f (TextureUnit 0) (TexCoord2 1   0)+      multiTexCoord2f (TextureUnit 1) (TexCoord2 1   1)+      vertex2f (Vertex2 100 0)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D 0 100 0 (100*hf/wf)+      else ortho2D 0 (100*wf/hf) 0 100+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   unless (version >= (1, 3)) $ do+      exts <- get glExtensions+      unless ("GL_ARB_multitexture"   `elem` exts &&     -- part of 1.3 core+              "GL_EXT_texture_object" `elem` exts) $ do  -- part of 1.1 core+        putStrLn "Sorry, this demo requires the GL_ARB_multitexture and GL_EXT_texture_object extensions."+        exitFailure+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Multisamp.hs view
@@ -0,0 +1,137 @@+{-+   Multisamp.hs (adapted from multisamp.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws shows how to use multisampling to draw anti-aliased+   geometric primitives. The same display list, a pinwheel of triangles and+   lines of varying widths, is rendered twice. Multisampling is enabled when the+   left side is drawn. Multisampling is disabled when the right side is drawn.++   Pressing the 'b' key toggles drawing of the checkerboard background.+   Antialiasing is sometimes easier to see when objects are rendered over a+   contrasting background.+-}++import Control.Monad ( when )+import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { bgToggle :: IORef Bool }++makeState :: IO State+makeState = do+   b <- newIORef True+   return $ State { bgToggle = b }++data DisplayLists = DisplayLists { pinwheelList, backgroundList :: DisplayList }++-- Print out state values related to multisampling. Create display list with+-- "pinwheel" of lines and triangles.+myInit :: IO DisplayLists+myInit = do+   clearColor $= Color4 0 0 0 0+   sb <- get sampleBuffers+   putStrLn ("number of sample buffers is " ++ show sb)+   s <- get samples+   putStrLn ("number of samples is " ++ show s)++   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       vertex2f = vertex :: Vertex2 GLfloat -> IO ()++   p <- defineNewList Compile $ do+      flip mapM_ [ 0 .. 18 ] $ \i ->+         preservingMatrix $ do+            rotate (360 * fromIntegral i / 19 :: GLfloat) (Vector3 0 0 1)+            color3f (Color3 1 1 1)+            lineWidth $= fromIntegral ((i `mod` 3 :: Int) + 1)+            renderPrimitive Lines $ do+              vertex2f (Vertex2 0.25 0.05)+              vertex2f (Vertex2 0.9 0.2)+            color3f (Color3 0 1 1)+            renderPrimitive Triangles $ do+               vertex2f (Vertex2 0.25 0)+               vertex2f (Vertex2 0.9 0)+               vertex2f (Vertex2 0.875 0.1)++   b <- defineNewList Compile $ do+      color3f (Color3 1 0.5 0)+      renderPrimitive Quads $+         flip mapM_ [ 0 .. 15 ] $ \i ->+            flip mapM_ [ 0 .. 15 ] $ \j ->+               when (((i + j) `mod` 2 :: Int) == 0) $ do+                  let ii = fromIntegral i * 0.25+                      jj = fromIntegral j * 0.25+                  vertex2f (Vertex2 (-2.0  + ii) (-2.0  + jj))+                  vertex2f (Vertex2 (-2.0  + ii) (-1.75 + jj))+                  vertex2f (Vertex2 (-1.75 + ii) (-1.75 + jj))+                  vertex2f (Vertex2 (-1.75 + ii) (-2.0  + jj))++   return $ DisplayLists { pinwheelList = p, backgroundList = b }++-- Draw two sets of primitives, so that you can compare the user of+-- multisampling against its absence.+--+-- This code enables antialiasing and draws one display list and disables and+-- draws the other display list+display :: State -> DisplayLists -> DisplayCallback+display state displayLists = do+   clear [ ColorBuffer ]++   t <- get (bgToggle state)+   when t $+      callList (backgroundList displayLists)++   -- resolve overloading, not needed in "real" programs+   let translatef = translate :: Vector3 GLfloat -> IO ()++   multisample $= Enabled+   preservingMatrix $ do+      translatef (Vector3 (-1) 0 0)+      callList (pinwheelList displayLists)++   multisample $= Disabled+   preservingMatrix $ do+      translatef (Vector3 1 0 0)+      callList (pinwheelList displayLists)++   swapBuffers++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= 2 * h+      then ortho2D (-2) 2 (-2*hf/wf) (2*hf/wf)+      else ortho2D (-2*wf/hf) (2*wf/hf) (-2) 2+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'b'   -> do bgToggle state $~ not; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode, Multisampling ]+   initialWindowSize $= Size 600 300+   _ <- createWindow progName+   state <- makeState+   displayLists <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state displayLists+   mainLoop
+ examples/RedBook4/PickDepth.hs view
@@ -0,0 +1,126 @@+{-+   PickDepth.hs (adapted from pickdepth.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Picking is demonstrated in this program. In rendering mode, three+   overlapping rectangles are drawn. When the left mouse button is pressed,+   selection mode is entered with the picking matrix. Rectangles which are drawn+   under the cursor position are "picked." Pay special attention to the depth+   value range, which is returned.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   depthFunc $= Just Less+   shadeModel $= Flat+   depthRange $= (0, 1)   -- The default z mapping++-- The nine squares are drawn. Each square is given two names: one for the row+-- and the other for the column on the grid. The color of each square is+-- determined by its position on the grid, and the value in the board array.+-- Note: In contrast to the the original example, we always give names to+-- squares, regardless of the render mode. This simplifies the code a bit and+-- is even suggested by the Red Book.++-- The three rectangles are drawn, each with a different name. Note that each+-- rectangle is drawn with a different z value. Note: In contrast to the the+-- original example, we always give names to squares, regardless of the render+-- mode. This simplifies the code a bit and is even suggested by the Red Book.+drawRects :: IO ()+drawRects = do+   -- resolve overloading, not needed in "real" programs+   let color3  = color :: Color3 GLfloat -> IO ()+       vertex3 = vertex :: Vertex3 GLint -> IO ()+   loadName (Name 1)+   renderPrimitive Quads $ do+      color3 (Color3 1.0 1.0 0.0)+      vertex3 (Vertex3 2 0 0)+      vertex3 (Vertex3 2 6 0)+      vertex3 (Vertex3 6 6 0)+      vertex3 (Vertex3 6 0 0)+   loadName (Name 2)+   renderPrimitive Quads $ do+      color3 (Color3 0.0 1.0 1.0)+      vertex3 (Vertex3 3 2 (-1))+      vertex3 (Vertex3 3 8 (-1))+      vertex3 (Vertex3 8 8 (-1))+      vertex3 (Vertex3 8 2 (-1))+   loadName (Name 3)+   renderPrimitive Quads $ do+      color3 (Color3 1.0 0.0 1.0)+      vertex3 (Vertex3 0 2 (-2))+      vertex3 (Vertex3 0 7 (-2))+      vertex3 (Vertex3 5 7 (-2))+      vertex3 (Vertex3 5 2 (-2))++-- processHits prints the hit records.+processHits :: Maybe[HitRecord] -> IO ()+processHits Nothing = putStrLn "selection buffer overflow"+processHits (Just hitRecords) = do+   putStrLn ("hits = " ++ show (length hitRecords))+   flip mapM_ hitRecords $ \(HitRecord z1 z2 names) -> do+      putStrLn (" number of names for hit = " ++ show (length names))+      putStr   ("  z1 is " ++ show z1)+      putStrLn ("; z2 is " ++ show z2)+      putStr   "   the name is"+      sequence_ [ putStr (" " ++ show n) | Name n <- names ]+      putChar '\n'++-- pickRects() sets up selection mode, name stack, and projection matrix for+-- picking. Then the objects are drawn.++bufSize :: GLsizei+bufSize = 512++pickRects :: KeyboardMouseCallback+pickRects (MouseButton LeftButton) Down _ (Position x y) = do+   vp@(_, (Size _ height)) <- get viewport+   (_, maybeHitRecords) <- getHitRecords bufSize $+      withName (Name 0) $ do+         matrixMode $= Projection+         preservingMatrix $ do+            loadIdentity+            -- create 5x5 pixel picking region near cursor location+            pickMatrix (fromIntegral x, fromIntegral height - fromIntegral y) (5, 5) vp+            ortho 0 8 0 8 (-0.5) 2.5+            drawRects+         flush+   processHits maybeHitRecords+   postRedisplay Nothing+pickRects (Char '\27') Down _ _ = exitWith ExitSuccess+pickRects _            _    _ _ = return ()++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   drawRects+   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho 0 8 0 8 (-0.5) 2.5+   matrixMode $= Modelview 0+   loadIdentity++-- Main Loop+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 200 200+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just pickRects+   mainLoop
+ examples/RedBook4/PickSquare.hs view
@@ -0,0 +1,121 @@+{-+   PickSquare.hs (adapted from picksquare.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Use of multiple names and picking are demonstrated. A 3x3 grid of squares is+   drawn. When the left mouse button is pressed, all squares under the cursor+   position have their color changed.+-}++import Data.Array ( Array, listArray, (!) )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++type Board = Array (Int,Int) (IORef Int)++data State = State { board :: Board }++makeState :: IO State+makeState = do+   refs <- sequence . replicate 9 . newIORef $ 0+   return $ State { board = listArray ((0,0),(2,2)) refs }++-- Clear color value for every square on the board+myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0++-- The nine squares are drawn. Each square is given two names: one for the row+-- and the other for the column on the grid. The color of each square is+-- determined by its position on the grid, and the value in the board array.+-- Note: In contrast to the the original example, we always give names to+-- squares, regardless of the render mode. This simplifies the code a bit and+-- is even suggested by the Red Book.+drawSquares :: State -> IO ()+drawSquares state =+   flip mapM_ [ 0 .. 2 ] $ \i -> do+      loadName (Name (fromIntegral i))+      flip mapM_ [ 0 .. 2 ] $ \j ->+         withName (Name (fromIntegral j)) $ do+            val <- get (board state ! (i,j))+            -- resolve overloading, not needed in "real" programs+            let color3f = color :: Color3 GLfloat -> IO ()+            color3f (Color3 (fromIntegral i   / 3.0)+                            (fromIntegral j   / 3.0)+                            (fromIntegral val / 3.0))+            let vertex2i :: Int -> Int -> Vertex2 GLint+                vertex2i x y = Vertex2 (fromIntegral x) (fromIntegral y)+            rect (vertex2i i j) (vertex2i (i + 1) (j + 1))++-- processHits prints the hit records and updates the board array.+processHits :: Maybe[HitRecord] -> State -> IO ()+processHits Nothing _ = putStrLn "selection buffer overflow"+processHits (Just hitRecords) state = do+   putStrLn ("hits = " ++ show (length hitRecords))+   mapM_ (\(HitRecord z1 z2 names) -> do+      putStrLn (" number of names for this hit = " ++ show (length names))+      putStr   ("  z1 is " ++ show z1)+      putStrLn ("; z2 is " ++ show z2)+      putStr   "   names are"+      sequence_ [ putStr (" " ++ show n) | Name n <- names ]+      putChar '\n'+      let [i, j] = [ fromIntegral n | Name n <- names ]+      (board state ! (i,j)) $~ (\x -> (x + 1) `mod` 3))+      hitRecords++-- pickSquares sets up selection mode, name stack, and projection matrix for+-- picking. Then the objects are drawn.++bufSize :: GLsizei+bufSize = 512++pickSquares :: State -> KeyboardMouseCallback+pickSquares state (MouseButton LeftButton) Down _ (Position x y) = do+   vp@(_, (Size _ height)) <- get viewport+   (_, maybeHitRecords) <- getHitRecords bufSize $+      withName (Name 0) $ do+         matrixMode $= Projection+         preservingMatrix $ do+            loadIdentity+            -- create 5x5 pixel picking region near cursor location+            pickMatrix (fromIntegral x, fromIntegral height - fromIntegral y) (5, 5) vp+            ortho2D 0 3 0 3+            drawSquares state+         flush+   processHits maybeHitRecords state+   postRedisplay Nothing+pickSquares _ (Char '\27') Down _ _ = exitWith ExitSuccess+pickSquares _ _            _    _ _ = return ()++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   drawSquares state+   flush++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 3 0 3+   matrixMode $= Modelview 0+   loadIdentity++-- Main Loop+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 100 100+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display state+   keyboardMouseCallback $= Just (pickSquares state)+   mainLoop
+ examples/RedBook4/Planet.hs view
@@ -0,0 +1,83 @@+{-+   Planet.hs (adapted from planet.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program shows how to composite modeling transformations to draw+   translated and rotated models. Interaction: pressing the d and y keys+   (day and year) alters the rotation of the planet around the sun.+-}++import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { year, day :: IORef GLint }++makeState :: IO State+makeState = do+   y <- newIORef 0+   d <- newIORef 0+   return $ State { year = y, day = d }++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+   color3f (Color3 1 1 1)++   preservingMatrix $ do+      renderObject Wireframe (Sphere' 1 20 16)   -- draw sun+      y <- get (year state)+      rotate (fromIntegral y :: GLfloat) (Vector3 0 1 0)+      translatef (Vector3 2 0 0)+      d <- get (day state)+      rotate (fromIntegral d :: GLfloat) (Vector3 0 1 0)+      renderObject Wireframe (Sphere' 0.2 10 8)  -- draw smaller planet++   swapBuffers++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 20+   matrixMode $= Modelview 0+   loadIdentity+   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case c of+   'd'   -> update day    10+   'D'   -> update day  (-10)+   'y'   -> update year   10+   'Y'   -> update year (-10)+   '\27' -> exitWith ExitSuccess+   _     -> return ()+   where update angle inc = do+            angle state $~ ((`mod` 360) . (+ inc))+            postRedisplay Nothing+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   mainLoop
+ examples/RedBook4/PointP.hs view
@@ -0,0 +1,152 @@+{-+   PointP.hs (adapted from pointp.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates point parameters and their effect on point+   primitives. 250 points are randomly generated within a 10 by 10 by 40 region,+   centered at the origin. In some modes (including the default), points that+   are closer to the viewer will appear larger.++   Pressing the 'c', 'l', and 'q' keys switch the point parameters attenuation+   mode to constant, linear, or quadratic, respectively.++   Pressing the 'f' and 'b' keys move the viewer forward and backwards. In+   either linear or quadratic attenuation mode, the distance from the viewer to+   the point will change the size of the point primitive.++   Pressing the '+' and '-' keys will change the current point size. In this+   program, the point size is bounded, so it will not get less than 2, nor+   greater than the maximum returned by pointSizeRange.+-}++import Control.Monad ( when, unless )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess), exitFailure )+import System.Random ( randomRIO )+import Graphics.UI.GLUT++type Attenuation = (GLfloat,GLfloat,GLfloat)++constant, linear, quadratic :: Attenuation+constant  = (1, 0,    0   )+linear    = (0, 0.12, 0   )+quadratic = (0, 0,    0.01)++data State = State { distance :: IORef GLfloat }++makeState :: IO State+makeState = do+   d <- newIORef (-10)+   return $ State { distance = d }++-- CFloat has no Random instance, so we go via Float+randomGLfloat :: (GLfloat, GLfloat) -> IO GLfloat+randomGLfloat = fmap floatToGLfloat . randomRIO . fmapPair glFloatToFloat+  where fmapPair f (x, y) = (f x, f y)+        floatToGLfloat = realToFrac :: Float -> GLfloat+        glFloatToFloat = realToFrac :: GLfloat -> Float++randomColor :: IO (Color3 GLfloat)+randomColor = do+   g <- randomGLfloat (0.5, 1)+   b <- randomGLfloat (0, 1)+   return $ Color3 1 g b++randomVertex :: IO (Vertex3 GLfloat)+randomVertex = do+   x <- randomGLfloat (-5, 5)+   y <- randomGLfloat (-5, 5)+   z <- randomGLfloat (-5, -45)+   return $ Vertex3 x y z++myInit :: IO DisplayList+myInit = do+   pointList <- defineNewList Compile $+      renderPrimitive Points $+         sequence_ $ replicate 250 $ do+            color =<< randomColor+            vertex =<< randomVertex++   depthFunc $= Just Less+   pointSmooth $= Enabled+   blend $= Enabled+   blendFunc $= (SrcAlpha, OneMinusSrcAlpha)+   pointSize $= 7++   pointDistanceAttenuation $= linear+   pointFadeThresholdSize $= 2++   return pointList++display :: State -> DisplayList -> DisplayCallback+display state pointList = do+   clear [ ColorBuffer, DepthBuffer ]+   d <- get (distance state)+   loadIdentity+   translate (Vector3 0 0 d)+   callList pointList+   swapBuffers++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective  35 1 0.25 200+   matrixMode $= Modelview 0++setPointDistanceAttenuation :: Attenuation -> IO ()+setPointDistanceAttenuation att = do+   pointDistanceAttenuation $= att+   postRedisplay Nothing++incDistance :: State -> GLfloat -> IO ()+incDistance state inc = do+   distance state $~ (+ inc)+   postRedisplay Nothing++incPointSize :: GLfloat -> IO ()+incPointSize inc = do+   newPointSize <- fmap (+ inc) $ get pointSize+   (_,maxPointSize) <- get pointSizeRange+   when (2 <= newPointSize && newPointSize <= maxPointSize) $ do+      pointSize $= newPointSize+      postRedisplay Nothing++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case c of+   'c'   -> setPointDistanceAttenuation constant+   'l'   -> setPointDistanceAttenuation linear+   'q'   -> setPointDistanceAttenuation quadratic+   'b'   -> incDistance state (-0.5)+   'f'   -> incDistance state 0.5+   '+'   -> incPointSize 1+   '-'   -> incPointSize (-1)+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ RGBMode, DoubleBuffered, WithDepthBuffer, Multisampling ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName++   -- We have to do this *after* createWindow, otherwise we have no OpenGL+   -- context. Note that the original C example simply tests for OpenGL 1.4 at+   -- compile time, we do a runtime check for the needed extension.+   extensions <- get glExtensions+   unless ("GL_ARB_point_parameters" `elem` extensions) $ do+      putStrLn "Sorry, this demo requires the GL_ARB_point_parameters extension."+      exitFailure++   state <- makeState+   pointList <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state pointList+   mainLoop
+ examples/RedBook4/PolyOff.hs view
@@ -0,0 +1,151 @@+{-+   PolyOff.hs (adapted from polyoff.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates polygon offset to draw a shaded polygon and its+   wireframe counterpart without ugly visual artifacts ("stitching").+-}++import Control.Monad ( when )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess), exitFailure )+import Graphics.UI.GLUT++data State = State {+   spinX, spinY :: IORef GLfloat,+   tDist :: IORef GLfloat,+   polyFactor :: IORef GLfloat,+   polyUnits :: IORef GLfloat+ }++makeState :: IO State+makeState = do+   x <- newIORef 0+   y <- newIORef 0+   t <- newIORef 0+   f <- newIORef 1+   u <- newIORef 1+   return $ State { spinX = x, spinY = y, tDist = t, polyFactor = f, polyUnits = u }++-- display draws two spheres, one with a gray, diffuse material, the other+-- sphere with a magenta material with a specular highlight.+display :: State -> DisplayList -> DisplayCallback+display state sphereList = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      t <- get (tDist state)+      translate (Vector3 0 0 t)+      x <- get (spinX state)+      rotate x (Vector3 1 0 0)+      y <- get (spinY state)+      rotate y (Vector3 0 1 0)++      materialAmbientAndDiffuse Front $= Color4 0.8 0.8 0.8 1+      materialSpecular Front $= Color4 0 0 0 1+      materialShininess Front $= 0+      lighting $= Enabled+      light (Light 0) $= Enabled+      polygonOffsetFill $= Enabled+      f <- get (polyFactor state)+      u <- get (polyUnits state)+      polygonOffset $= (f, u)+      callList sphereList+      polygonOffsetFill $= Disabled++      lighting $= Disabled+      light (Light 0) $= Disabled+      color (Color3 1 1 (1 :: GLfloat))+      polygonMode $= (Line, Line)+      callList sphereList+      polygonMode $= (Fill, Fill)++   flush++-- specify initial properties+-- create display list with sphere+-- initialize lighting and depth buffer+gfxinit :: IO DisplayList+gfxinit = do+   clearColor $= Color4 0 0 0 1++   sphereList <- defineNewList Compile $+      renderObject Solid (Sphere' 1 20 12)++   depthFunc $= Just Less++   ambient (Light 0) $= Color4 0 0 0 1+   diffuse (Light 0) $= Color4 1 1 1 1+   specular (Light 0) $= Color4 1 1 1 1+   position (Light 0) $= Vertex4 1 1 1 0+   lightModelAmbient $= Color4 0.2 0.2 0.2 1++   return sphereList++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 (fromIntegral w / fromIntegral h) 1 10+   matrixMode $= Modelview 0+   loadIdentity+   lookAt (Vertex3 0 0 5) (Vertex3 0 0 0) (Vector3 0 1 0)++incSpin :: IORef GLfloat -> IO ()+incSpin spinRef = do+   let wrap n s = if s > n then s - n else s+   spinRef $~ (wrap 360 . (+ 5))+   postRedisplay Nothing++incDist :: State -> GLfloat -> IO ()+incDist state inc = do+   newDist <- fmap (+ inc) $ get (tDist state)+   when (-5 <= newDist && newDist <= 4) $ do+      tDist state $= newDist+      postRedisplay Nothing++incPoly :: String -> IORef GLfloat -> GLfloat -> IO ()+incPoly name polyRef inc = do+   polyRef $~ (+ inc)+   p <- get polyRef+   putStrLn (name ++ " is " ++ show p)+   postRedisplay Nothing++keyboardMouse :: State -> KeyboardMouseCallback+keyboardMouse state k Down _ _ = case k of+   (MouseButton LeftButton)   -> incSpin (spinX state)+   (MouseButton MiddleButton) -> incSpin (spinY state)+   (MouseButton RightButton)  -> exitWith ExitSuccess+   (Char 't')                 -> incDist state 0.5+   (Char 'T')                 -> incDist state (-0.5)+   (Char 'F')                 -> incPoly "polyFactor" (polyFactor state) 0.1+   (Char 'f')                 -> incPoly "polyFactor" (polyFactor state) (-0.1)+   (Char 'U')                 -> incPoly "polyUnits"  (polyUnits  state) 1+   (Char 'u')                 -> incPoly "polyUnits"  (polyUnits  state) (-1)+   _                          -> return ()+keyboardMouse _ _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   _ <- createWindow progName++   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   when (version == (1,0)) $ do+      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."+      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      exitFailure++   state <- makeState+   sphereList <- gfxinit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboardMouse state)+   displayCallback $= display state sphereList+   mainLoop
+ examples/RedBook4/Polys.hs view
@@ -0,0 +1,84 @@+{-+   Polys.hs (adapted from polys.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates polygon stippling.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++fly :: IO GLpolygonstipple+fly = newPolygonStipple [+   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+   0x03, 0x80, 0x01, 0xC0, 0x06, 0xC0, 0x03, 0x60,+   0x04, 0x60, 0x06, 0x20, 0x04, 0x30, 0x0C, 0x20,+   0x04, 0x18, 0x18, 0x20, 0x04, 0x0C, 0x30, 0x20,+   0x04, 0x06, 0x60, 0x20, 0x44, 0x03, 0xC0, 0x22,+   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,+   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,+   0x44, 0x01, 0x80, 0x22, 0x44, 0x01, 0x80, 0x22,+   0x66, 0x01, 0x80, 0x66, 0x33, 0x01, 0x80, 0xCC,+   0x19, 0x81, 0x81, 0x98, 0x0C, 0xC1, 0x83, 0x30,+   0x07, 0xe1, 0x87, 0xe0, 0x03, 0x3f, 0xfc, 0xc0,+   0x03, 0x31, 0x8c, 0xc0, 0x03, 0x33, 0xcc, 0xc0,+   0x06, 0x64, 0x26, 0x60, 0x0c, 0xcc, 0x33, 0x30,+   0x18, 0xcc, 0x33, 0x18, 0x10, 0xc4, 0x23, 0x08,+   0x10, 0x63, 0xC6, 0x08, 0x10, 0x30, 0x0c, 0x08,+   0x10, 0x18, 0x18, 0x08, 0x10, 0x00, 0x00, 0x08]++halftone :: IO GLpolygonstipple+halftone = newPolygonStipple . take 128 . cycle $ [+   0xAA, 0xAA, 0xAA, 0xAA, 0x55, 0x55, 0x55, 0x55]++display :: (GLpolygonstipple, GLpolygonstipple) -> DisplayCallback+display (flyStipple, halftoneStipple) = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       rectf = rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()+   color3f (Color3 1 1 1)++   -- draw one solid, unstippled rectangle,+   -- then two stippled rectangles+   rectf (Vertex2  25 25) (Vertex2 125 125)+   polygonStipple $= Just flyStipple+   rectf (Vertex2 125 25) (Vertex2 225 125)+   polygonStipple $= Just halftoneStipple+   rectf (Vertex2 225 25) (Vertex2 325 125)+   polygonStipple $= (Nothing :: Maybe GLpolygonstipple)++   flush++myInit :: IO (GLpolygonstipple, GLpolygonstipple)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   flyStipple <- fly+   halftoneStipple <- halftone+   return (flyStipple, halftoneStipple)++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0.0 (fromIntegral w) 0.0 (fromIntegral h)++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 350 150+   _ <- createWindow progName+   stipples <- myInit+   displayCallback $= display stipples+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Quadric.hs view
@@ -0,0 +1,106 @@+{-+   Quadric.hs (adapted from quadric.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the use of the renderQuadric routine. Quadric+   objects are created with some quadric properties and errors are reported.+   Note that the cylinder has no top or bottom and the circle has a hole in it.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO (DisplayList, DisplayList, DisplayList, DisplayList)+myInit = do+   clearColor $= Color4 0 0 0 0++   materialAmbient Front $= Color4 0.5 0.5 0.5 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 50+   position (Light 0) $= Vertex4 1 1 1 0+   lightModelAmbient $= Color4 0.5 0.5 0.5 1++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less++   -- Create 4 display lists, each with a different quadric object.+   -- Different drawing styles and surface normal specifications+   -- are demonstrated.+   -- smooth shaded+   dl1 <- newQuadricDL (Just Smooth) FillStyle (Sphere 0.75 15 10)+   -- flat shaded+   dl2 <- newQuadricDL (Just Flat) FillStyle (Cylinder 0.5 0.3 1 15 5)+   -- all polygons wireframe+   dl3 <- newQuadricDL Nothing LineStyle (Disk 0.25 1 20 4)+   -- boundary only+   dl4 <- newQuadricDL Nothing SilhouetteStyle (PartialDisk 0 1 20 4 0 225)+   return (dl1, dl2, dl3, dl4)++newQuadricDL :: QuadricNormal -> QuadricDrawStyle -> QuadricPrimitive -> IO DisplayList+newQuadricDL n s p =+   defineNewList Compile $ do+      renderQuadric (QuadricStyle n NoTextureCoordinates Outside s) p+      reportErrors++display :: (DisplayList, DisplayList, DisplayList, DisplayList) -> DisplayCallback+display (dl1, dl2, dl3, dl4) = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      -- resolve overloading, not needed in "real" programs+      let translatef = translate :: Vector3 GLfloat -> IO ()+          rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()+          color3f = color :: Color3 GLfloat -> IO ()++      lighting $= Enabled+      shadeModel $= Smooth+      translatef (Vector3 (-1) (-1) 0)+      callList dl1++      shadeModel $= Flat+      translatef (Vector3 0 2 0)+      preservingMatrix $ do+         rotatef 300 (Vector3 1 0 0)+         callList dl2++      lighting $= Disabled+      color3f (Color3 0 1 1)+      translatef (Vector3 2 (-2) 0)+      callList dl3++      color3f (Color3 1 1 0)+      translatef (Vector3 0 2 0)+      callList dl4++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-2.5) 2.5 (-2.5*hf/wf) (2.5*hf/wf) (-10) 10+      else ortho (-2.5*wf/hf) (2.5*wf/hf) (-2.5) 2.5 (-10) 10+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   displayLists <- myInit+   displayCallback $= display displayLists+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/ReadImage.hs view
@@ -0,0 +1,65 @@+{-+   ReadImage.hs (adapted from readImage.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   Support for reading a file of raw RGB data:+      4 bytes big-endian width+      4 bytes big-endian height+      width * height RGB byte triples+-}++module ReadImage ( readImage ) where++import Data.Word ( Word8, Word32 )+import Control.Exception ( bracket )+import Control.Monad ( when )+import System.IO ( Handle, IOMode(ReadMode), openBinaryFile, hGetBuf, hClose )+import System.IO.Error ( mkIOError, eofErrorType )+import Foreign ( Ptr, alloca, mallocBytes, Storable(..) )+import Graphics.UI.GLUT++-- This is probably overkill, but anyway...+newtype Word32BigEndian = Word32BigEndian Word32++word32BigEndianToGLsizei :: Word32BigEndian -> GLsizei+word32BigEndianToGLsizei (Word32BigEndian x) = fromIntegral x++instance Storable Word32BigEndian where+   sizeOf ~(Word32BigEndian x) = sizeOf x+   alignment ~(Word32BigEndian x) = alignment x+   peek ptr = do+      let numBytes = sizeOf (undefined :: Word32BigEndian)+      bytes <- mapM (peekByteOff ptr) [ 0 ..  numBytes - 1 ] :: IO [Word8]+      let value = foldl (\val byte -> val * 256 + fromIntegral byte) 0 bytes+      return $ Word32BigEndian value+   poke = error ""++-- This is the reason for all this stuff above...+readGLsizei :: Handle -> IO GLsizei+readGLsizei handle =+   alloca $ \buf -> do+      hGetBufFully handle buf (sizeOf (undefined :: Word32BigEndian))+      fmap word32BigEndianToGLsizei $ peek buf++-- A handy variant of hGetBuf with additional error checking+hGetBufFully :: Handle -> Ptr a -> Int -> IO ()+hGetBufFully handle ptr numBytes = do+   bytesRead <- hGetBuf handle ptr numBytes+   when (bytesRead /= numBytes) $+      ioError $ mkIOError eofErrorType "hGetBufFully" (Just handle) Nothing++-- Closing a file is nice, even when an error occurs during reading.+withBinaryFile :: FilePath -> (Handle -> IO a) -> IO a+withBinaryFile filePath = bracket (openBinaryFile filePath ReadMode) hClose++readImage :: FilePath -> IO (Size, PixelData a)+readImage filePath =+   withBinaryFile filePath $ \handle -> do+      width <- readGLsizei handle+      height <- readGLsizei handle+      let numBytes = fromIntegral (3 * width * height)+      buf <- mallocBytes numBytes+      hGetBufFully handle buf numBytes+      return (Size width height, PixelData RGB UnsignedByte buf)
+ examples/RedBook4/Robot.hs view
@@ -0,0 +1,89 @@+{-+   Robot.hs (adapted from robot.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++  This program shows how to composite modeling transformations to draw+  translated and rotated hierarchical models. Interaction: pressing the s+  and e keys (shoulder and elbow) alters the rotation of the robot arm.+-}++import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { shoulder, elbow :: IORef GLint }++makeState :: IO State+makeState = do+   s <- newIORef 0+   e <- newIORef 0+   return $ State { shoulder = s, elbow = e }++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let translatef = translate :: Vector3 GLfloat -> IO ()+       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()+   preservingMatrix $ do+      translatef (Vector3 (-1) 0 0)+      s <- get (shoulder state)+      rotate (fromIntegral s :: GLfloat) (Vector3 0 0 1)+      translatef (Vector3 1 0 0)+      preservingMatrix $ do+         scalef 2 0.4 1+         renderObject Wireframe (Cube 1)+      translatef (Vector3 1 0 0)+      e <- get (elbow state)+      rotate (fromIntegral e :: GLfloat) (Vector3 0 0 1)+      translatef (Vector3 1 0 0)+      preservingMatrix $ do+         scalef 2 0.4 1+         renderObject Wireframe (Cube 1)+   swapBuffers++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 65 (fromIntegral w / fromIntegral h) 1 20+   matrixMode $= Modelview 0+   loadIdentity+   -- resolve overloading, not needed in "real" programs+   let translatef = translate :: Vector3 GLfloat -> IO ()+   translatef (Vector3 0 0 (-5))++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case c of+   's'   -> update shoulder   5+   'S'   -> update shoulder (-5)+   'e'   -> update elbow      5+   'E'   -> update elbow    (-5)+   '\27' -> exitWith ExitSuccess+   _     -> return ()+   where update joint inc = do+            joint state $~ ((`mod` 360) . (+ inc))+            postRedisplay Nothing+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ DoubleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   mainLoop
+ examples/RedBook4/Scene.hs view
@@ -0,0 +1,73 @@+{-+   Scene.hs (adapted from scene.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the use of the GL lighting model. Objects are+   drawn using a grey material characteristic. A single light source+   illuminates the objects.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Initialize material property and light source.+myInit :: IO ()+myInit = do+   ambient (Light 0) $= Color4 0 0 0 1+   diffuse (Light 0) $= Color4 1 1 1 1+   specular (Light 0) $= Color4 1 1 1 1+   -- light position is NOT default value+   position (Light 0) $= Vertex4  1 1 1 0++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (20 :: GLfloat) (Vector3 1 0 0)+      preservingMatrix $ do+         translate (Vector3 (-0.75) 0.5 (0 :: GLfloat))+         rotate (90 :: GLfloat) (Vector3 1 0 0)+         renderObject Solid (Torus 0.275 0.85 15 15)+      preservingMatrix $ do+         translate (Vector3 (-0.75) (-0.5) (0 :: GLfloat))+         rotate (270 :: GLfloat) (Vector3 1 0 0)+         renderObject Solid (Cone 1 2 15 15)+      preservingMatrix $ do+         translate (Vector3 0.75 0 (-1 :: GLfloat))+         renderObject Solid (Sphere' 1 15 15)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-2.5) 2.5 (-2.5 * hf/wf) (2.5 * hf/wf) (-10) 10+      else ortho (-2.5 * wf/hf) (2.5 * wf/hf) (-2.5) 2.5 (-10) 10+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Select.hs view
@@ -0,0 +1,150 @@+{-+   Select.hs (adapted from select.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This is an illustration of the selection mode and name stack, which detects+   whether objects which collide with a viewing volume. First, four triangles+   and a rectangular box representing a viewing volume are drawn (drawScene+   routine). The green triangle and yellow triangles appear to lie within the+   viewing volume, but the red triangle appears to lie outside it. Then the+   selection mode is entered (selectObjects routine). Drawing to the screen+   ceases. To see if any collisions occur, the four triangles are called. In+   this example, the green triangle causes one hit with the name 1, and the+   yellow triangles cause one hit with the name 3.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- draw a triangle with vertices at (x1, y1), (x2, y2) and (x3, y3) at z units+-- away from the origin.+drawTriangle ::+   Vertex2 GLfloat -> Vertex2 GLfloat -> Vertex2 GLfloat -> GLfloat -> IO ()+drawTriangle (Vertex2 x1 y1) (Vertex2 x2 y2) (Vertex2 x3 y3) z = do+   renderPrimitive Triangles $ mapM_ vertex [+      Vertex3 x1 y1 z,+      Vertex3 x2 y2 z,+      Vertex3 x3 y3 z]++-- draw a rectangular box with these outer x, y, and z values+drawViewVolume :: Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()+drawViewVolume (Vertex3 x1 y1 z1) (Vertex3 x2 y2 z2) = do+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+   color3f (Color3 1 1 1)+   renderPrimitive LineLoop $ mapM_ vertex [+      Vertex3 x1 y1 (-z1),+      Vertex3 x2 y1 (-z1),+      Vertex3 x2 y2 (-z1),+      Vertex3 x1 y2 (-z1)]++   renderPrimitive LineLoop $ mapM_ vertex [+      Vertex3 x1 y1 (-z2),+      Vertex3 x2 y1 (-z2),+      Vertex3 x2 y2 (-z2),+      Vertex3 x1 y2 (-z2)]++   renderPrimitive Lines $ mapM_ vertex [   -- 4 lines+      Vertex3 x1 y1 (-z1),+      Vertex3 x1 y1 (-z2),+      Vertex3 x1 y2 (-z1),+      Vertex3 x1 y2 (-z2),+      Vertex3 x2 y1 (-z1),+      Vertex3 x2 y1 (-z2),+      Vertex3 x2 y2 (-z1),+      Vertex3 x2 y2 (-z2)]++-- drawScene draws 4 triangles and a wire frame which represents the viewing+-- volume.+drawScene :: IO ()+drawScene = do+   matrixMode $= Projection+   loadIdentity+   perspective 40 (4/3) 1 100++   matrixMode $= Modelview 0+   loadIdentity+   lookAt (Vertex3 7.5 7.5 12.5) (Vertex3 2.5 2.5 (-5)) (Vector3 0 1 0)+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+   color3f (Color3 0 1 0)   -- green triangle+   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)+   color3f (Color3 1 0 0)   -- red triangle+   drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)+   color3f (Color3 1 1 0)   -- yellow triangles+   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)+   drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)+   drawViewVolume (Vertex3 0 0 0) (Vertex3 5 5 10)++processHits :: Maybe [HitRecord] -> IO ()+processHits Nothing = putStrLn "selection buffer overflow"+processHits (Just hitRecords) = do+   putStrLn ("hits = " ++ show (length hitRecords))+   mapM_ (\(HitRecord z1 z2 names) -> do+      putStrLn (" number of names for hit = " ++ show (length names))+      putStr   ("  z1 is " ++ show z1)+      putStrLn ("; z2 is " ++ show z2)+      putStr   "   the name is"+      sequence_ [ putStr (" " ++ show n) | Name n <- names ]+      putChar '\n')+      hitRecords++-- selectObjects "draws" the triangles in selection mode, assigning names for+-- the triangles. Note that the third and fourth triangles share one name, so+-- that if either or both triangles intersects the viewing/clipping volume,+-- only one hit will be registered.++bufSize :: GLsizei+bufSize = 512++selectObjects :: IO ()+selectObjects = do+   (_, maybeHitRecords) <- getHitRecords bufSize $ do+      withName (Name 0) $ do+         preservingMatrix $ do+            matrixMode $= Projection+            loadIdentity+            ortho 0 5 0 5 0 10+            matrixMode $= Modelview 0+            loadIdentity+            loadName (Name 1)+            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-5)+            loadName (Name 2)+            drawTriangle (Vertex2 2 7) (Vertex2 3 7) (Vertex2 2.5 8) (-5)+            loadName (Name 3)+            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-1)+            drawTriangle (Vertex2 2 2) (Vertex2 3 2) (Vertex2 2.5 3) (-9)+      flush+   processHits maybeHitRecords++myInit :: IO ()+myInit = do+   depthFunc $= Just Less+   shadeModel $= Flat++display :: DisplayCallback+display = do+   clearColor $= Color4 0 0 0 0+   clear [ ColorBuffer, DepthBuffer ]+   drawScene+   selectObjects+   flush++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 200 200+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/ShadowMap.hs view
@@ -0,0 +1,255 @@+{-+   ShadowMap.hs (adapted from shadowmap.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE+-}++import Control.Monad ( when, unless )+import Data.IORef ( IORef, newIORef )+import Foreign.Marshal.Array ( allocaArray )+import Foreign.Ptr ( nullPtr )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++shadowMapSize :: TextureSize2D+shadowMapSize = TextureSize2D 256 256++fovy, nearPlane, farPlane :: GLdouble+fovy      =  60+nearPlane =  10+farPlane  = 100++lightPos :: Vertex4 GLfloat+lightPos = Vertex4 25 25 25 1++lookat :: Vertex3 GLdouble+lookat   = Vertex3 0 0 0++up :: Vector3 GLdouble+up = Vector3 0 0 1++data State = State {+   angle      :: IORef GLdouble,+   torusAngle :: IORef GLfloat,+   showShadow :: IORef Bool,+   animate    :: IORef Bool,+   funcMode   :: IORef ComparisonFunction }++makeState :: IO State+makeState = do+   a <- newIORef 0+   t <- newIORef 0+   s <- newIORef False+   n <- newIORef True+   f <- newIORef Lequal+   return $ State { angle = a, torusAngle = t, showShadow = s,+                    animate = n, funcMode = f }++myInit :: IO ()+myInit = do+   texImage2D Texture2D NoProxy 0 DepthComponent' shadowMapSize 0+              (PixelData DepthComponent UnsignedByte nullPtr)++   position (Light 0) $= lightPos+   let white = Color4 1 1 1 1+   specular (Light 0) $= white+   diffuse  (Light 0) $= white++   textureWrapMode Texture2D S $= (Repeated, ClampToEdge)+   textureWrapMode Texture2D T $= (Repeated, ClampToEdge)+   textureFilter Texture2D $= ((Linear', Nothing), Linear')+   textureCompareMode Texture2D $= Just Lequal+   depthTextureMode Texture2D $= Luminance'++   colorMaterial $= Just (FrontAndBack, AmbientAndDiffuse)++   cullFace $= Just Back++   depthFunc $= Just Less+   light (Light 0) $= Enabled+   lighting $= Enabled+   texture Texture2D $= Enabled++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective fovy (fromIntegral w / fromIntegral h) nearPlane farPlane+   matrixMode $= Modelview 0++idle :: State -> IdleCallback+idle state = do+   angle state $~! (+ (pi / 10000))+   torusAngle state $~! (+ 0.1)+   postRedisplay Nothing++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = do+   case c of+      '\27' -> exitWith ExitSuccess+      't' ->+         texture Texture2D $~ \cap -> if cap == Enabled then Disabled else Enabled+      'm' -> do+         fm <- get (funcMode state)+         textureCompareMode Texture2D $~ maybe (Just fm) (const Nothing)+         compareMode <- get (textureCompareMode Texture2D)+         putStrLn ("Compare mode " ++ maybe "Off" (const "On") compareMode)+      'f' -> do+         funcMode state $~ \fm -> if fm == Lequal then Gequal else Lequal+         fm <- get (funcMode state)+         putStrLn ("Operator " ++ show fm)+         textureCompareMode Texture2D $~ maybe Nothing (const (Just fm))+      's' -> showShadow state $~ not+      'p' -> do+         animate state $~ not+         animate' <- get (animate state)+         idleCallback $= if animate' then Just (idle state) else Nothing+      _ -> return ()+   postRedisplay Nothing+keyboard _ _ _ _ _ = return ()++drawObjects :: GLfloat -> Bool -> IO ()+drawObjects torusAngle' shadowRender = do+   textureOn <- get (texture Texture2D)++   when shadowRender $+      texture Texture2D $= Disabled++   -- resolve overloading, not needed in "real" programs+   let normal3f = normal :: Normal3 GLfloat -> IO ()+       color3f = color :: Color3 GLfloat -> IO ()+       rectf = rect :: Vertex2 GLfloat -> Vertex2 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+       rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()++   unless shadowRender $ do+      normal3f (Normal3 0 0 1)+      color3f (Color3 1 1 1)+      rectf (Vertex2 (-20) (-20)) (Vertex2 20 20)++   preservingMatrix $ do+      translatef (Vector3 11 11 11)+      rotatef 54.73 (Vector3 (-5) 5 0)+      rotate torusAngle' (Vector3 1 0 0)+      color3f (Color3 1 0 0)+      renderObject Solid (Torus 1 4 8 36)++   preservingMatrix $ do+      translatef (Vector3 2 2 2)+      color3f (Color3 0 0 1)+      renderObject Solid (Cube 4)++   preservingMatrix $ do+      getLightPos Vector3 >>= translate+      color3f (Color3 1 1 1)+      renderObject Wireframe (Sphere' 0.5 6 6)++   when (shadowRender && textureOn == Enabled) $+      texture Texture2D $= Enabled++getLightPos :: (GLdouble -> GLdouble -> GLdouble -> a) -> IO a+getLightPos f = do+    Vertex4 x y z _ <- get (position (Light 0))+    return $ f (realToFrac x) (realToFrac y) (realToFrac z)++generateShadowMap :: GLfloat -> Bool -> IO ()+generateShadowMap torusAngle' showShadow' = do+   lightPos' <- getLightPos Vertex3+   let (TextureSize2D shadowMapWidth shadowMapHeight) = shadowMapSize+       shadowMapSize' = Size shadowMapWidth shadowMapHeight++   preservingViewport $ do+      viewport $= (Position 0 0, shadowMapSize')++      clear [ ColorBuffer, DepthBuffer ]++      matrixMode $= Projection+      preservingMatrix $ do+         loadIdentity+         perspective 80 1 10 1000+         matrixMode $= Modelview 0+         preservingMatrix $ do+            loadIdentity+            lookAt lightPos' lookat up+            drawObjects torusAngle' True+         matrixMode $= Projection+      matrixMode $= Modelview 0++      copyTexImage2D Texture2D 0 DepthComponent' (Position 0 0) shadowMapSize 0++   when showShadow' $ do+      let numShadowMapPixels = fromIntegral (shadowMapWidth * shadowMapHeight)+      allocaArray numShadowMapPixels $ \depthImage -> do+        let pixelData fmt = PixelData fmt Float depthImage :: PixelData GLfloat+        readPixels (Position 0 0) shadowMapSize' (pixelData DepthComponent)+        (_, Size viewPortWidth _) <- get viewport+        windowPos (Vertex2 (fromIntegral viewPortWidth / 2 :: GLfloat) 0)+        drawPixels shadowMapSize' (pixelData Luminance)+        swapBuffers++-- Note: preservingViewport is not exception safe, but it doesn't matter here+preservingViewport :: IO a -> IO a+preservingViewport act = do+   v <- get viewport+   x <- act+   viewport $= v+   return x++generateTextureMatrix :: IO ()+generateTextureMatrix = do+   -- Set up projective texture matrix. We use the Modelview matrix stack and+   -- OpenGL matrix commands to make the matrix.+   m <- preservingMatrix $ do+      loadIdentity+      -- resolve overloading, not needed in "real" programs+      let translatef = translate :: Vector3 GLfloat -> IO ()+          scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()+      translatef (Vector3 0.5 0.5 0.0)+      scalef 0.5 0.5 1.0+      perspective 60 1 1 1000+      lightPos' <- getLightPos Vertex3+      lookAt lightPos' lookat up+      get (matrix (Just (Modelview 0)))++   [ sx, sy, sz, sw,+     tx, ty, tz, tw,+     rx, ry, rz, rw,+     qx, qy, qz, qw ] <- getMatrixComponents RowMajor (m :: GLmatrix GLdouble)++   textureGenMode S $= Just (ObjectLinear (Plane sx sy sz sw))+   textureGenMode T $= Just (ObjectLinear (Plane tx ty tz tw))+   textureGenMode R $= Just (ObjectLinear (Plane rx ry rz rw))+   textureGenMode Q $= Just (ObjectLinear (Plane qx qy qz qw))++display :: State -> DisplayCallback+display state = do+   let radius = 30+   torusAngle' <- get (torusAngle state)+   showShadow' <- get (showShadow state)+   generateShadowMap torusAngle' showShadow'+   generateTextureMatrix+   unless showShadow' $ do+      clear [ ColorBuffer, DepthBuffer ]+      preservingMatrix $ do+         angle' <- get (angle state)+         lookAt (Vertex3 (radius * cos angle') (radius * sin angle') 30) lookat up+         drawObjects torusAngle' False+      swapBuffers++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ RGBAMode, WithDepthBuffer, DoubleBuffered ]+   initialWindowSize $= Size 521 512+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   idleCallback $= Just (idle state)++   mainLoop
+ examples/RedBook4/Smooth.hs view
@@ -0,0 +1,65 @@+{-+   Smooth.hs (adapted from smooth.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates smooth shading. A smooth shaded polygon is drawn in+   a 2-D projection.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth++triangle :: IO ()+triangle =+   -- resolve overloading, not needed in "real" programs+   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()+       color3f = color :: Color3 GLfloat -> IO ()+   in renderPrimitive Triangles $ do+      color3f (Color3 1 0 0)+      vertex2f (Vertex2 5 5)+      color3f (Color3 0 1 0)+      vertex2f (Vertex2 25 5)+      color3f (Color3 0 0 1)+      vertex2f (Vertex2 5 25)++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   triangle+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D 0 30 0 (30 * hf/wf)+      else ortho2D 0 (30 * wf/hf) 0 30+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Stencil.hs view
@@ -0,0 +1,123 @@+{-+   Stencil.hs (adapted from stencil.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates use of the stencil buffer for masking+   nonrectangular regions. Whenever the window is redrawn, a value of 1 is drawn+   into a diamond-shaped region in the stencil buffer. Elsewhere in the stencil+   buffer, the value is 0. Then a blue sphere is drawn where the stencil value+   is 1, and yellow torii are drawn where the stencil value is not 1.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data DisplayLists = DisplayLists { yellowMat, blueMat :: DisplayList }++myInit :: IO DisplayLists+myInit = do+   y <- defineNewList Compile $ do+      materialDiffuse Front $= Color4 0.7 0.7 0 1+      materialSpecular Front $= Color4 1 1 1 1+      materialShininess Front $= 64++   b <- defineNewList Compile $ do+      materialDiffuse Front $= Color4 0.1 0.1 0.7 1+      materialSpecular Front $= Color4  0.1 1 1 1+      materialShininess Front $= 45++   position (Light 0) $= Vertex4 1 1 1 0++   light (Light 0) $= Enabled+   lighting $= Enabled+   depthFunc $= Just Less++   clearStencil $= 0+   stencilTest $= Enabled++   return $ DisplayLists { yellowMat = y, blueMat = b }++-- Draw a sphere in a diamond-shaped section in the middle of a window with 2+-- torii.+display :: DisplayLists -> DisplayCallback+display displayLists = do+   clear [ ColorBuffer, DepthBuffer ]++   -- draw blue sphere where the stencil is 1+   stencilFunc $= (Equal, 1, 1)+   stencilOp $= (OpKeep, OpKeep, OpKeep)+   callList (blueMat displayLists)+   renderObject Solid (Sphere' 0.5 15 15)++   -- resolve overloading, not needed in "real" programs+   let rotatef = rotate :: GLfloat -> Vector3 GLfloat -> IO ()++   -- draw the tori where the stencil is not 1+   stencilFunc $= (Notequal, 1, 1)+   preservingMatrix $ do+      rotatef 45 (Vector3 0 0 1)+      rotatef 45 (Vector3 0 1 0)+      callList (yellowMat displayLists)+      renderObject Solid (Torus 0.275 0.85 15 15)+      preservingMatrix $ do+         rotatef 90 (Vector3 1 0 0)+         renderObject Solid (Torus 0.275 0.85 15 15)++   flush++-- Whenever the window is reshaped, redefine the coordinate system and redraw+-- the stencil area.+reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)++   -- create a diamond shaped stencil area+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D (-3) 3 (-3*hf/wf) (3*hf/wf)+      else ortho2D (-3*wf/hf) (3*wf/hf) (-3) 3+   matrixMode $= Modelview 0+   loadIdentity++   -- resolve overloading, not needed in "real" programs+   let vertex2f = vertex :: Vertex2 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()++   clear [ StencilBuffer ]+   stencilFunc $= (Always, 1, 1)+   stencilOp $= (OpReplace, OpReplace, OpReplace)+   renderPrimitive Quads $ do+      vertex2f (Vertex2 (-1) 0)+      vertex2f (Vertex2 0 1)+      vertex2f (Vertex2 1 0)+      vertex2f (Vertex2 0 (-1))++   matrixMode $= Projection+   loadIdentity+   perspective 45 (wf/hf) 3 7+   matrixMode $= Modelview 0+   loadIdentity+   translatef (Vector3 0 0 (-5))++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop: Be certain to request stencil bits.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer, WithStencilBuffer ]+   initialWindowSize $= Size 400 400+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   displayLists <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display displayLists+   mainLoop
+ examples/RedBook4/Stroke.hs view
@@ -0,0 +1,127 @@+{-+   Stroke.hs (adapted from stroke.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates some characters of a stroke (vector) font. The+   characters are represented by display lists, which are given numbers which+   correspond to the ASCII values of the characters. Use of callLists is+   demonstrated.+-}++import Data.List ( genericLength )+import Foreign.C.String ( castCharToCChar )+import Foreign.Marshal.Array ( withArray )+import Graphics.UI.GLUT+import System.Exit ( exitWith, ExitCode(ExitSuccess) )++aData, eData, pData, rData, sData :: [[Vertex2 GLfloat]]+aData = [+   [ Vertex2 0 0, Vertex2 0 9, Vertex2 1 10, Vertex2 4 10, Vertex2 5 9,+     Vertex2 5 0 ],+   [ Vertex2 0 5, Vertex2 5 5 ] ]++eData = [+   [ Vertex2 5 0, Vertex2 0 0, Vertex2 0 10, Vertex2 5 10 ],+   [ Vertex2 0 5, Vertex2 4 5 ] ]++pData = [+   [ Vertex2 0 0, Vertex2 0 10,  Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,+     Vertex2 4 5, Vertex2 0 5 ] ]++rData = [+   [ Vertex2 0 0, Vertex2 0 10,  Vertex2 4 10, Vertex2 5 9, Vertex2 5 6,+     Vertex2 4 5, Vertex2 0 5 ],+   [ Vertex2 3 5, Vertex2 5 0 ] ]++sData = [+   [ Vertex2 0 1, Vertex2 1 0, Vertex2 4 0, Vertex2 5 1, Vertex2 5 4,+     Vertex2 4 5, Vertex2 1 5, Vertex2 0 6, Vertex2 0 9, Vertex2 1 10,+     Vertex2 4 10, Vertex2 5 9 ] ]++advance :: IO ()+advance = translate (Vector3 8 0 (0 :: GLfloat))++-- drawLetter renders a letter with line segments given by the list of line+-- strips.+drawLetter :: [[Vertex2 GLfloat]] -> IO ()+drawLetter lineStrips = do+   mapM_ (renderPrimitive LineStrip . mapM_ vertex) lineStrips+   advance++charToGLubyte :: Char -> GLubyte+charToGLubyte = fromIntegral . castCharToCChar++myInit :: IO ()+myInit = do+   shadeModel $= Flat++   (base@(DisplayList b):_) <- genObjectNames 128+   listBase $= base+   let charToDisplayList c = DisplayList (b + fromIntegral (charToGLubyte c))+   mapM_ (\(c, d) -> defineList (charToDisplayList c) Compile d)+         [ ('A', drawLetter aData),+           ('E', drawLetter eData),+           ('P', drawLetter pData),+           ('R', drawLetter rData),+           ('S', drawLetter sData),+           (' ', advance) ]++test1, test2 :: String+test1 = "A SPARE SERAPE APPEARS AS"+test2 = "APES PREPARE RARE PEPPERS"++printStrokedString :: String -> IO ()+printStrokedString s =+   withArray (map charToGLubyte s) $+      callLists (genericLength s) UnsignedByte++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]++   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       scalef = scale :: GLfloat -> GLfloat -> GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()++   color3f (Color3 1 1 1)+   preservingMatrix $ do+      scalef 2 2 2+      translatef (Vector3 10 30 0)+      printStrokedString test1+   preservingMatrix $ do+      scalef 2 2 2+      translatef (Vector3 10 13 0)+      printStrokedString test2+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char c) Down _ _ = case c of+   ' '   -> postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ = return ()++-- Main Loop: Open window with initial window size, title bar, RGBA display+-- mode, and handle input events.+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 440 120+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   displayCallback $= display+   mainLoop
+ examples/RedBook4/SurfPoints.hs view
@@ -0,0 +1,129 @@+{-+   SurfPoints.hs (adapted from surfpoints.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program is a modification of the earlier Surface.hs program. The+   vertex data are not directly rendered, but are instead passed to the+   callback function. The values of the tessellated vertices are printed+   out there.++   This program draws a NURBS surface in the shape of a symmetrical hill.+   The 'c' keyboard key allows you to toggle the visibility of the control+   points themselves. Note that some of the control points are hidden by+   the surface itself.++   NOTE: This example does NOT demonstrate the final NURBS API, it's currently+   just a test for the internals...+-}++import Control.Monad ( when )+import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import Foreign.Marshal ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { showPoints :: IORef Bool }++makeState :: IO State+makeState = do+   s <- newIORef False+   return $ State { showPoints = s }++-- The control points of the surface form a small hill and+-- range from -3 to +3 in x, y, and z.+ctlPoints :: [[Vertex3 GLfloat]]+ctlPoints =+   [ [ Vertex3 (2 * u - 3)+               (2 * v - 3)+               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)+     | v <- [ 0 .. 3 ] ]+   | u <- [ 0 .. 3 ]]++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   materialDiffuse Front $= Color4 0.7 0.7 0.7 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 100++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less+   autoNormal $= Enabled+   normalize $= Enabled++--------------------------------------------------------------------------------++display :: State -> DisplayCallback+display state = do+   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (330 :: GLfloat) (Vector3 1 0 0)+      scale 0.5 0.5 (0.5 :: GLfloat)++      withNURBSObj () $ \nurbsObj -> do+         setNURBSMode nurbsObj NURBSTessellator+         setSamplingMethod nurbsObj (PathLength 25)+         setDisplayMode' nurbsObj Fill'+         checkForNURBSError nurbsObj $+            withNURBSBeginCallback nurbsObj print $+               withNURBSVertexCallback nurbsObj print $+                  withNURBSNormalCallback nurbsObj print $+                     withNURBSEndCallback nurbsObj (putStrLn "end") $+                        nurbsBeginEndSurface nurbsObj $+                           withArray (concat ctlPoints) $ \cBuf ->+                              withArray knots $ \kBuf ->+                                 nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4++      s <- get (showPoints state)+      when s $ do+         pointSize $= 5+         lighting $= Disabled+         color (Color3 1 1 (0 :: GLfloat))+         renderPrimitive Points $+            mapM_ (mapM_ vertex) ctlPoints+         lighting $= Enabled++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 (fromIntegral w / fromIntegral h) 3 8+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-5 :: GLfloat))++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'c'   -> do showPoints state $~ not; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   version <- get (majorMinor gluVersion)+   when (version < (1,3)) $ do+      putStrLn "This program demonstrates a feature which is introduced in the"+      putStrLn "OpenGL Utility Library (GLU) Version 1.3."+      putStrLn "If your implementation of GLU has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      putStrLn "Continuing anyway..."+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display state+   keyboardMouseCallback $= Just (keyboard state)+   mainLoop
+ examples/RedBook4/Surface.hs view
@@ -0,0 +1,112 @@+{-+   Surface.hs (adapted from surface.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws a NURBS surface in the shape of a symmetrical hill.+   The 'c' keyboard key allows you to toggle the visibility of the control+   points themselves. Note that some of the control points are hidden by+   the surface itself.++   NOTE: This example does NOT demonstrate the final NURBS API, it's currently+   just a test for the internals...+-}++import Control.Monad ( when )+import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import Foreign.Marshal ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { showPoints :: IORef Bool }++makeState :: IO State+makeState = do+   s <- newIORef False+   return $ State { showPoints = s }++-- The control points of the surface form a small hill and+-- range from -3 to +3 in x, y, and z.+ctlPoints :: [[Vertex3 GLfloat]]+ctlPoints =+   [ [ Vertex3 (2 * u - 3)+               (2 * v - 3)+               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)+     | v <- [ 0 .. 3 ] ]+   | u <- [ 0 .. 3 ]]++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   materialDiffuse Front $= Color4 0.7 0.7 0.7 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 100++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less+   autoNormal $= Enabled+   normalize $= Enabled++--------------------------------------------------------------------------------++display :: State -> DisplayCallback+display state = do+   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (330 :: GLfloat) (Vector3 1 0 0)+      scale 0.5 0.5 (0.5 :: GLfloat)++      withNURBSObj () $ \nurbsObj -> do+         setSamplingMethod nurbsObj (PathLength 25)+         setDisplayMode' nurbsObj Fill'+         checkForNURBSError nurbsObj $+            nurbsBeginEndSurface nurbsObj $+               withArray (concat ctlPoints) $ \cBuf ->+                  withArray knots $ \kBuf ->+                     nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4++      s <- get (showPoints state)+      when s $ do+         pointSize $= 5+         lighting $= Disabled+         color (Color3 1 1 (0 :: GLfloat))+         renderPrimitive Points $+            mapM_ (mapM_ vertex) ctlPoints+         lighting $= Enabled++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 (fromIntegral w / fromIntegral h) 3 8+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-5 :: GLfloat))++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'c'   -> do showPoints state $~ not; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   state <- makeState+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display state+   keyboardMouseCallback $= Just (keyboard state)+   mainLoop
+ examples/RedBook4/Teapots.hs view
@@ -0,0 +1,226 @@+{-+   Teapots.hs (adapted from teapots.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates lots of material properties. A single light+   source illuminates the objects.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Initialize depth buffer, projection matrix, light source, and lighting+-- model. Do not specify a material property here.+myInit :: IO DisplayList+myInit = do+   ambient (Light 0) $= Color4 0 0 0 1+   diffuse (Light 0) $= Color4 1 1 1 1+   position (Light 0) $= Vertex4  0 3 3 0+   lightModelAmbient $= Color4 0.2 0.2 0.2 1+   lightModelLocalViewer $= Disabled++   frontFace $= CW+   lighting $= Enabled+   light (Light 0) $= Enabled+   autoNormal $= Enabled+   normalize $= Enabled+   depthFunc $= Just Less+   -- be efficient--make teapot display list+   defineNewList Compile $+      renderObject Solid (Teapot 1)++-- Move object into position, specify the material properties, draw a teapot.+renderTeapot :: DisplayList -> Vector3 GLfloat -> Color4 GLfloat+             -> Color4 GLfloat -> Color4 GLfloat -> GLfloat -> IO ()+renderTeapot teapotList pos amb dif spec shine = do+   preservingMatrix $ do+      translate pos+      materialAmbient Front $= amb+      materialDiffuse Front $= dif+      materialSpecular Front $= spec+      materialShininess Front $= shine * 128+      callList teapotList++-- 1st column: emerald, jade, obsidian, pearl, ruby, turquoise+-- 2nd column: brass, bronze, chrome, copper, gold, silver+-- 3rd column: black, cyan, green, red, white, yellow plastic+-- 4th column: black, cyan, green, red, white, yellow rubber+display :: DisplayList -> DisplayCallback+display teapotList = do+   clear [ ColorBuffer, DepthBuffer ]+   renderTeapot teapotList+                (Vector3  2 17 0)+                (Color4 0.0215    0.1745      0.0215     1)+                (Color4 0.07568   0.61424     0.07568    1)+                (Color4 0.633     0.727811    0.633      1)+                0.6+   renderTeapot teapotList+                (Vector3  2 14 0)+                (Color4 0.135     0.2225      0.1575     1)+                (Color4 0.54      0.89        0.63       1)+                (Color4 0.316228  0.316228    0.316228   1)+                0.1+   renderTeapot teapotList+                (Vector3  2 11 0)+                (Color4 0.05375   0.05        0.06625    1)+                (Color4 0.18275   0.17        0.22525    1)+                (Color4 0.332741  0.328634    0.346435   1)+                0.3+   renderTeapot teapotList+                (Vector3  2  8 0)+                (Color4 0.25      0.20725     0.20725    1)+                (Color4 1         0.829       0.829      1)+                (Color4 0.296648  0.296648    0.296648   1)+                0.088+   renderTeapot teapotList+                (Vector3  2  5 0)+                (Color4 0.1745    0.01175     0.01175    1)+                (Color4 0.61424   0.04136     0.04136    1)+                (Color4 0.727811  0.626959    0.626959   1)+                0.6+   renderTeapot teapotList+                (Vector3  2  2 0)+                (Color4 0.1       0.18725     0.1745     1)+                (Color4 0.396     0.74151     0.69102    1)+                (Color4 0.297254  0.30829     0.306678   1)+                0.1+   renderTeapot teapotList+                (Vector3  6 17 0)+                (Color4 0.329412  0.223529    0.027451   1)+                (Color4 0.780392  0.568627    0.113725   1)+                (Color4 0.992157  0.941176    0.807843   1)+                0.21794872+   renderTeapot teapotList+                (Vector3  6 14 0)+                (Color4 0.2125    0.1275      0.054      1)+                (Color4 0.714     0.4284      0.18144    1)+                (Color4 0.393548  0.271906    0.166721   1)+                0.2+   renderTeapot teapotList+                (Vector3  6 11 0)+                (Color4 0.25      0.25        0.25       1)+                (Color4 0.4       0.4         0.4        1)+                (Color4 0.774597  0.774597    0.774597   1)+                0.6+   renderTeapot teapotList+                (Vector3  6  8 0)+                (Color4 0.19125   0.0735      0.0225     1)+                (Color4 0.7038    0.27048     0.0828     1)+                (Color4 0.256777  0.137622    0.086014   1)+                0.1+   renderTeapot teapotList+                (Vector3  6  5 0)+                (Color4 0.24725   0.1995      0.0745     1)+                (Color4 0.75164   0.60648     0.22648    1)+                (Color4 0.628281  0.555802    0.366065   1)+                0.4+   renderTeapot teapotList+                (Vector3  6  2 0)+                (Color4 0.19225   0.19225     0.19225    1)+                (Color4 0.50754   0.50754     0.50754    1)+                (Color4 0.508273  0.508273    0.508273   1)+                0.4+   renderTeapot teapotList+                (Vector3 10 17 0)+                (Color4 0         0           0          1)+                (Color4 0.01      0.01        0.01       1)+                (Color4 0.50      0.50        0.50       1)+                0.25+   renderTeapot teapotList+                (Vector3 10 14 0)+                (Color4 0          0.1        0.06       1)+                (Color4 0          0.50980392 0.50980392 1)+                (Color4 0.50196078 0.50196078 0.50196078 1)+                0.25+   renderTeapot teapotList+                (Vector3 10 11 0)+                (Color4 0         0           0          1)+                (Color4 0.1       0.35        0.1        1)+                (Color4 0.45      0.55        0.45       1)+                0.25+   renderTeapot teapotList+                (Vector3 10  8 0)+                (Color4 0         0           0          1)+                (Color4 0.5       0           0          1)+                (Color4 0.7       0.6         0.6        1)+                0.25+   renderTeapot teapotList+                (Vector3 10  5 0)+                (Color4 0         0           0          1)+                (Color4 0.55      0.55        0.55       1)+                (Color4 0.70      0.70        0.70       1)+                0.25+   renderTeapot teapotList+                (Vector3 10  2 0)+                (Color4 0         0           0          1)+                (Color4 0.5       0.5         0          1)+                (Color4 0.60      0.60        0.50       1)+                0.25+   renderTeapot teapotList+                (Vector3 14 17 0)+                (Color4 0.02      0.02        0.02       1)+                (Color4 0.01      0.01        0.01       1)+                (Color4 0.4       0.4         0.4        1)+                0.078125+   renderTeapot teapotList+                (Vector3 14 14 0)+                (Color4 0         0.05        0.05       1)+                (Color4 0.4       0.5         0.5        1)+                (Color4 0.04      0.7         0.7        1)+                0.078125+   renderTeapot teapotList+                (Vector3 14 11 0)+                (Color4 0         0.05        0          1)+                (Color4 0.4       0.5         0.4        1)+                (Color4 0.04      0.7         0.04       1)+                0.078125+   renderTeapot teapotList+                (Vector3 14  8 0)+                (Color4 0.05      0           0          1)+                (Color4 0.5       0.4         0.4        1)+                (Color4 0.7       0.04        0.04       1)+                0.078125+   renderTeapot teapotList+                (Vector3 14  5 0)+                (Color4 0.05      0.05        0.05       1)+                (Color4 0.5       0.5         0.5        1)+                (Color4 0.7       0.7         0.7        1)+                0.078125+   renderTeapot teapotList+                (Vector3 14  2 0)+                (Color4 0.05      0.05        0          1)+                (Color4 0.5       0.5         0.4        1)+                (Color4 0.7       0.7         0.04       1)+                0.078125+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho 0 16 0 (16 * hf/wf) (-10) 10+      else ortho 0 (16 * wf/hf) 0 16 (-10) 10+   matrixMode $= Modelview 0++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 600+   initialWindowPosition $= Position 50 50+   _ <- createWindow progName+   teapotList <- myInit+   reshapeCallback $= Just reshape+   displayCallback $= display teapotList+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Tess.hs view
@@ -0,0 +1,117 @@+{-+   Tess.hs (adapted from tess.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates polygon tessellation. Two tesselated objects are+   drawn. The first is a rectangle with a triangular hole. The second is a+   smooth shaded, self-intersecting star.++   Note the exterior rectangle is drawn with its vertices in counter-clockwise+   order, but its interior clockwise. Note the combineCallback is needed for the+   self-intersecting star. Also note that removing the TessProperty for the+   star will make the interior unshaded (TessWindingOdd).+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++display :: [DisplayList] -> DisplayCallback+display displayLists = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+   color3f (Color3 1 1 1)+   mapM_ callList displayLists+   flush++-- 'Float' is a dummy, any marshalable type would do+type DontCare = Float++rectangle :: ComplexContour DontCare+rectangle = ComplexContour [+   AnnotatedVertex (Vertex3  50  50 0) 0,+   AnnotatedVertex (Vertex3 200  50 0) 0,+   AnnotatedVertex (Vertex3 200 200 0) 0,+   AnnotatedVertex (Vertex3  50 200 0) 0 ]++tri :: ComplexContour DontCare+tri = ComplexContour [+   AnnotatedVertex (Vertex3  75  75 0) 0,+   AnnotatedVertex (Vertex3 125 175 0) 0,+   AnnotatedVertex (Vertex3 175  75 0) 0 ]++rectAndTri :: ComplexPolygon DontCare+rectAndTri = ComplexPolygon [ rectangle, tri ]++noOpCombiner :: Combiner DontCare+noOpCombiner _newVertex _weightedProperties = 0++star :: ComplexPolygon (Color3 GLfloat)+star = ComplexPolygon [+   ComplexContour [+      AnnotatedVertex (Vertex3 250  50 0) (Color3 1 0 1),+      AnnotatedVertex (Vertex3 325 200 0) (Color3 1 1 0),+      AnnotatedVertex (Vertex3 400  50 0) (Color3 0 1 1),+      AnnotatedVertex (Vertex3 250 150 0) (Color3 1 0 0),+      AnnotatedVertex (Vertex3 400 150 0) (Color3 0 1 0) ] ]++combineColors :: Combiner (Color3 GLfloat)+combineColors+   _newVertex+   (WeightedProperties+      (w0, Color3 r0 g0 b0)+      (w1, Color3 r1 g1 b1)+      (w2, Color3 r2 g2 b2)+      (w3, Color3 r3 g3 b3)) =+         Color3 (w0*r0 + w1*r1 + w2*r2 + w3*r3)+                (w0*g0 + w1*g1 + w2*g2 + w3*g3)+                (w0*b0 + w1*b1 + w2*b2 + w3*b3)++myInit :: IO [DisplayList]+myInit = do+   clearColor $= Color4 0 0 0 0++   rectAndTriList <- defineNewList Compile $+      drawSimplePolygon (\_ -> return ()) =<<+         tessellate TessWindingOdd 0 (Normal3 0 0 0) noOpCombiner rectAndTri++   starList <- defineNewList Compile $+      drawSimplePolygon color =<<+         tessellate TessWindingPositive 0 (Normal3 0 0 0) combineColors star++   return [ rectAndTriList, starList ]++drawSimplePolygon :: (v -> IO ()) -> SimplePolygon v -> IO ()+drawSimplePolygon colorHandler (SimplePolygon primitives) =+   flip mapM_ primitives $ \(Primitive primitiveMode vertices) ->+      renderPrimitive primitiveMode $+         flip mapM_ vertices $ \(AnnotatedVertex plainVertex col) -> do+            colorHandler col+            vertex plainVertex++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   displayLists <- myInit+   displayCallback $= display displayLists+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/TessWind.hs view
@@ -0,0 +1,195 @@+{-+   TessWind.hs (adapted from tesswind.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the winding rule polygon tessellation property.+   Four tessellated objects are drawn, each with very different contours. When+   the w key is pressed, the objects are drawn with a different winding rule.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { currentWindingRule :: IORef TessWinding }++makeState :: IO State+makeState = do+   c <- newIORef TessWindingOdd+   return $ State { currentWindingRule = c }++type DisplayLists = (DisplayList, DisplayList, DisplayList, DisplayList)++-- 'Float' is a dummy, any marshalable type would do+type DontCare = Float++rect1 :: ComplexContour DontCare+rect1 = ComplexContour [+   AnnotatedVertex (Vertex3  50  50 0) 0,+   AnnotatedVertex (Vertex3 300  50 0) 0,+   AnnotatedVertex (Vertex3 300 300 0) 0,+   AnnotatedVertex (Vertex3  50 300 0) 0 ]++rect2 :: ComplexContour DontCare+rect2 = ComplexContour [+   AnnotatedVertex (Vertex3 100 100 0) 0,+   AnnotatedVertex (Vertex3 250 100 0) 0,+   AnnotatedVertex (Vertex3 250 250 0) 0,+   AnnotatedVertex (Vertex3 100 250 0) 0 ]++rect3 :: ComplexContour DontCare+rect3 = ComplexContour [+   AnnotatedVertex (Vertex3 150 150 0) 0,+   AnnotatedVertex (Vertex3 200 150 0) 0,+   AnnotatedVertex (Vertex3 200 200 0) 0,+   AnnotatedVertex (Vertex3 150 200 0) 0 ]++rects1 :: ComplexPolygon DontCare+rects1 = ComplexPolygon [ rect1, rect2, rect3 ]++rects2 :: ComplexPolygon DontCare+rects2 = ComplexPolygon [+   rect1, reverseComplexContour rect2, reverseComplexContour rect3 ]++spiral :: ComplexPolygon DontCare+spiral = ComplexPolygon [+   ComplexContour [+      AnnotatedVertex (Vertex3 400 250 0) 0,+      AnnotatedVertex (Vertex3 400  50 0) 0,+      AnnotatedVertex (Vertex3  50  50 0) 0,+      AnnotatedVertex (Vertex3  50 400 0) 0,+      AnnotatedVertex (Vertex3 350 400 0) 0,+      AnnotatedVertex (Vertex3 350 100 0) 0,+      AnnotatedVertex (Vertex3 100 100 0) 0,+      AnnotatedVertex (Vertex3 100 350 0) 0,+      AnnotatedVertex (Vertex3 300 350 0) 0,+      AnnotatedVertex (Vertex3 300 150 0) 0,+      AnnotatedVertex (Vertex3 150 150 0) 0,+      AnnotatedVertex (Vertex3 150 300 0) 0,+      AnnotatedVertex (Vertex3 250 300 0) 0,+      AnnotatedVertex (Vertex3 250 200 0) 0,+      AnnotatedVertex (Vertex3 200 200 0) 0,+      AnnotatedVertex (Vertex3 200 250 0) 0 ] ]++quad1 :: ComplexContour DontCare+quad1 = ComplexContour [+   AnnotatedVertex (Vertex3  50 150 0) 0,+   AnnotatedVertex (Vertex3 350 150 0) 0,+   AnnotatedVertex (Vertex3 350 200 0) 0,+   AnnotatedVertex (Vertex3  50 200 0) 0 ]++quad2 :: ComplexContour DontCare+quad2 = ComplexContour [+   AnnotatedVertex (Vertex3 100 100 0) 0,+   AnnotatedVertex (Vertex3 300 100 0) 0,+   AnnotatedVertex (Vertex3 300 350 0) 0,+   AnnotatedVertex (Vertex3 100 350 0) 0 ]++tri :: ComplexContour DontCare+tri = ComplexContour [+   AnnotatedVertex (Vertex3 200  50 0) 0,+   AnnotatedVertex (Vertex3 250 300 0) 0,+   AnnotatedVertex (Vertex3 150 300 0) 0 ]++quadsAndTri :: ComplexPolygon DontCare+quadsAndTri = ComplexPolygon [ quad1, quad2, tri ]++reverseComplexContour :: ComplexContour DontCare -> ComplexContour DontCare+reverseComplexContour (ComplexContour avs) = ComplexContour (reverse avs)++makeNewLists :: State -> DisplayLists -> IO ()+makeNewLists state (dl1, dl2, dl3, dl4) = do+   windingRule <- get (currentWindingRule state)+   print windingRule   -- not in original program, but useful+   compileList windingRule dl1 rects1+   compileList windingRule dl2 rects2+   compileList windingRule dl3 spiral+   compileList windingRule dl4 quadsAndTri++compileList :: TessWinding -> DisplayList -> ComplexPolygon DontCare -> IO ()+compileList windingRule displayList complexPolygon =+   defineList displayList Compile $+      drawSimplePolygon =<<+         tessellate windingRule 0 (Normal3 0 0 0) noOpCombiner complexPolygon++noOpCombiner :: Combiner DontCare+noOpCombiner _newVertex _weightedProperties = 0++drawSimplePolygon :: SimplePolygon DontCare -> IO ()+drawSimplePolygon (SimplePolygon primitives) =+   flip mapM_ primitives $ \(Primitive primitiveMode vertices) ->+      renderPrimitive primitiveMode $+         flip mapM_ vertices $ \(AnnotatedVertex plainVertex _) ->+            vertex plainVertex++display :: DisplayLists -> DisplayCallback+display (dl1, dl2, dl3, dl4) = do+   clear [ ColorBuffer ]+   -- resolve overloading, not needed in "real" programs+   let color3f = color :: Color3 GLfloat -> IO ()+       translatef = translate :: Vector3 GLfloat -> IO ()+   color3f (Color3 1 1 1)+   preservingMatrix $ do+      callList dl1+      translatef (Vector3   0   500  0)+      callList dl2+      translatef (Vector3 500 (-500) 0)+      callList dl3+      translatef (Vector3   0   500  0)+      callList dl4+   flush++myInit :: State -> IO DisplayLists+myInit state = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   [dl1, dl2, dl3, dl4] <- genObjectNames 4+   let displayLists = (dl1, dl2, dl3, dl4)+   makeNewLists state displayLists+   return displayLists++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho2D 0 1000 0 (1000 * hf/wf)+      else ortho2D 0 (1000 * wf/hf) 0 1000+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: State -> DisplayLists -> KeyboardMouseCallback+keyboard state displayLists (Char c) Down _ _ = case toLower c of+   'w'   -> do currentWindingRule state $~ nextWindingRule+               makeNewLists state displayLists+               postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ _ = return ()++nextWindingRule :: TessWinding -> TessWinding+nextWindingRule r = case r of+   TessWindingOdd       -> TessWindingNonzero+   TessWindingNonzero   -> TessWindingPositive+   TessWindingPositive  -> TessWindingNegative+   TessWindingNegative  -> TessWindingAbsGeqTwo+   TessWindingAbsGeqTwo -> TessWindingOdd++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   _ <- createWindow progName+   state <- makeState+   displayLists <- myInit state+   displayCallback $= display displayLists+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state displayLists)+   mainLoop
+ examples/RedBook4/TexBind.hs view
@@ -0,0 +1,108 @@+{-+   TexBind.hs  (adapted from texbind.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates using textureBinding by creating and managing+   two textures.+-}++import Control.Monad ( when )+import Data.Bits ( (.&.) )+import Foreign ( withArray )+import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Create checkerboard image+checkImageSize :: TextureSize2D+checkImageSize = TextureSize2D 64 64++withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))+               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()+withCheckImage (TextureSize2D w h) n f act =+   withArray [ f c |+               i <- [ 0 .. w - 1 ],+               j <- [ 0 .. h - 1 ],+               let c | (i .&. n) == (j .&. n) = 0+                     | otherwise              = 255 ] $+   act . PixelData RGBA UnsignedByte++myInit :: IO (TextureObject, TextureObject)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less+   rowAlignment Unpack $= 1++   [texName0, texName1] <- genObjectNames 2+   textureBinding Texture2D $= Just texName0+   textureWrapMode Texture2D S $= (Repeated, Clamp)+   textureWrapMode Texture2D T $= (Repeated, Clamp)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   withCheckImage checkImageSize 0x08 (\c -> Color4 c c c 255) $+      texImage2D Texture2D NoProxy 0  RGBA' checkImageSize 0++   textureBinding Texture2D $= Just texName1+   textureWrapMode Texture2D S $= (Repeated, Clamp)+   textureWrapMode Texture2D T $= (Repeated, Clamp)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   textureFunction $= Decal+   withCheckImage checkImageSize 0x10 (\c -> Color4 c 0 0 255) $+      texImage2D Texture2D NoProxy 0  RGBA' checkImageSize 0+   texture Texture2D $= Enabled+   return (texName0, texName1)++display ::  (TextureObject, TextureObject) -> DisplayCallback+display (texName0, texName1) = do+   clear [ ColorBuffer, DepthBuffer ]+   -- resolve overloading, not needed in "real" programs+   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   textureBinding Texture2D $= Just texName0+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )+   textureBinding Texture2D $= Just texName1+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-3.6 :: GLfloat))++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   when (version == (1,0)) $ do+      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."+      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      exitFailure+   texNames <- myInit+   reshapeCallback $= Just reshape+   displayCallback $= display texNames+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/TexGen.hs view
@@ -0,0 +1,132 @@+{-+   TexGen.hs  (adapted from texgen.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws a texture mapped teapot with automatically generated+   texture coordinates. The texture is rendered as stripes on the teapot.+   Initially, the object is drawn with texture coordinates based upon the+   object coordinates of the vertex and distance from the plane x = 0.+   Pressing the 'e' key changes the coordinate generation to eye coordinates+   of the vertex. Pressing the 'o' key switches it back to the object+   coordinates. Pressing the 's' key changes the plane to a slanted one+   (x + y + z = 0). Pressing the 'x' key switches it back to x = 0.+-}++import Control.Monad ( when )+import Data.Char ( toLower )+import Data.Maybe ( isJust )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++stripeImageWidth :: TextureSize1D+stripeImageWidth = TextureSize1D 32++xEqualZero, slanted :: Plane GLdouble+xEqualZero = Plane 1 0 0 0+slanted    = Plane 1 1 1 0++withStripeImage :: (PixelData (Color4 GLubyte) -> IO a) -> IO a+withStripeImage act =+   withArray [ Color4 (if j <= 4 then 255 else 0)+                      (if j >  4 then 255 else 0)+                      0+                      255+             | j <- [ 0 .. w - 1 ] ] $+      act . PixelData RGBA UnsignedByte+   where TextureSize1D w = stripeImageWidth++myInit :: IO (Maybe TextureObject)+myInit = do+   clearColor $= Color4 0 0 0 0+   depthFunc $= Just Less+   shadeModel $= Smooth+   rowAlignment Unpack $= 1++   exts <- get glExtensions+   mbTexName <- if "GL_EXT_texture_object" `elem` exts+                   then fmap Just genObjectName+                   else return Nothing+   when (isJust mbTexName) $ textureBinding Texture1D $= mbTexName++   textureWrapMode Texture1D S $= (Repeated, Repeat)+   textureFilter Texture1D $= ((Linear', Nothing), Linear')+   withStripeImage $ texImage1D Texture1D NoProxy 0  RGBA' stripeImageWidth 0++   textureFunction $= Modulate+   textureGenMode S $= Just (ObjectLinear xEqualZero)++   texture Texture1D $= Enabled+   lighting $= Enabled+   light (Light 0) $= Enabled+   autoNormal $= Enabled+   normalize $= Enabled+   frontFace $= CW+   cullFace $= Just Back+   materialShininess Front $= 64+   return mbTexName++display ::  Maybe TextureObject -> DisplayCallback+display mbTexName = do+   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (45 :: GLfloat) (Vector3 0 0 1)+      when (isJust mbTexName) $ textureBinding Texture1D $= mbTexName+      renderObject Solid (Teapot 2)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-3.5) 3.5 (-3.5*hf/wf) (3.5*hf/wf) (-3.5) 3.5+      else ortho (-3.5*wf/hf) (3.5*wf/hf) (-3.5) 3.5 (-3.5) 3.5+   matrixMode $= Modelview 0+   loadIdentity++keyboard :: KeyboardMouseCallback+keyboard (Char c) Down _ _ = case toLower c of+   'e'   -> setGenMode EyeLinear+   'o'   -> setGenMode ObjectLinear+   's'   -> setPlane slanted+   'x'   -> setPlane xEqualZero+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ = return ()++setGenMode :: (Plane GLdouble -> TextureGenMode) -> IO ()+setGenMode mode = do+   currentGenMode <- get (textureGenMode S)+   case currentGenMode of+      Just (EyeLinear    plane) -> textureGenMode S $= Just (mode plane)+      Just (ObjectLinear plane) -> textureGenMode S $= Just (mode plane)+      _ -> error "setGenMode: should never happen..."+   postRedisplay Nothing++setPlane :: Plane GLdouble -> IO ()+setPlane plane = do+   currentGenMode <- get (textureGenMode S)+   case currentGenMode of+      Just (EyeLinear    _) -> textureGenMode S $= Just (EyeLinear    plane)+      Just (ObjectLinear _) -> textureGenMode S $= Just (ObjectLinear plane)+      _ -> error "setPlane: should never happen..."+   postRedisplay Nothing++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 256 256+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   mbTexName <- myInit+   displayCallback $= display mbTexName+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/TexProx.hs view
@@ -0,0 +1,58 @@+{-+   TexProx.hs (adapted from texprox.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   The brief program illustrates use of texture proxies. This program only+   prints out some messages about whether certain size textures are supported+   and then exits.+-}++import Control.Monad ( when )+import Foreign.Ptr ( nullPtr )+import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++myInit :: IO ()+myInit = do+   let check = do+          ok <- get (textureProxyOK Texture2D 0)+          putStrLn ("proxy allocation " ++ if ok then "succeeded" else "failed")++   texImage2D Texture2D Proxy 0 RGBA8 (TextureSize2D 64 64) 0 (PixelData RGBA UnsignedByte nullPtr)+   check++   -- Note: We use a larger texture size here to demonstrate failure,+   -- modern graphic cards can handle the original size.+   texImage2D Texture2D Proxy 0 RGBA16 (TextureSize2D 8192 8192) 0 (PixelData RGBA UnsignedShort nullPtr)+   check+++display :: DisplayCallback+display = exitWith ExitSuccess++reshape :: ReshapeCallback+reshape size = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   when (version == (1,0)) $ do+      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."+      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      exitFailure+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   mainLoop
+ examples/RedBook4/TexSub.hs view
@@ -0,0 +1,120 @@+{-+   TexSub.hs  (adapted from texsub.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program texture maps a checkerboard image onto two rectangles. This+   program clamps the texture, if the texture coordinates fall outside 0.0+   and 1.0. If the s key is pressed, a texture subimage is used to alter the+   original texture. If the r key is pressed, the original texture is restored.+-}++import Control.Monad ( when )+import Data.Char ( toLower )+import Data.Bits ( (.&.) )+import Foreign ( newArray )+import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++checkImageSize, subImageSize :: TextureSize2D+checkImageSize = TextureSize2D 64 64+subImageSize   = TextureSize2D 16 16++type Image = PixelData (Color4 GLubyte)++makeCheckImage ::+   TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte)) -> IO Image+makeCheckImage (TextureSize2D w h) n f =+   fmap (PixelData RGBA UnsignedByte) $+      newArray [ f c |+                 i <- [ 0 .. w - 1 ],+                 j <- [ 0 .. h - 1 ],+                 let c | (i .&. n) == (j .&. n) = 0+                       | otherwise              = 255 ]++myInit :: IO (TextureObject, Image, Image)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less++   checkImage <- makeCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255)+   subImage   <- makeCheckImage subImageSize   0x4 (\c -> Color4 c 0 0 255)+   rowAlignment Unpack $= 1++   texName <- genObjectName+   textureBinding Texture2D $= Just texName++   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   texImage2D Texture2D NoProxy 0  RGBA' checkImageSize 0 checkImage+   return (texName, checkImage, subImage)++display :: TextureObject -> DisplayCallback+display texName = do+   clear [ ColorBuffer, DepthBuffer ]+   texture Texture2D $= Enabled+   textureFunction $= Decal+   textureBinding Texture2D $= Just texName++   -- resolve overloading, not needed in "real" programs+   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3 (-2.0)      1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   0.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )++      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 1); vertex3f (Vertex3   1.0       1.0    0.0     )+      texCoord2f (TexCoord2 1 1); vertex3f (Vertex3   2.41421   1.0  (-1.41421))+      texCoord2f (TexCoord2 1 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))+   flush+   texture Texture2D $= Disabled++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-3.6 :: GLfloat))++keyboard :: TextureObject -> Image -> Image -> KeyboardMouseCallback+keyboard texName checkImage subImage (Char c) Down _ _ = case toLower c of+   's' -> do+      textureBinding Texture2D $= Just texName+      texSubImage2D Texture2D 0 (TexturePosition2D 12 44) subImageSize subImage+      postRedisplay Nothing+   'r' -> do+      textureBinding Texture2D $= Just texName+      texImage2D Texture2D NoProxy 0 RGBA' checkImageSize 0 checkImage+      postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _ -> return ()+keyboard _ _ _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   when (version == (1,0)) $ do+      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."+      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      exitFailure+   (texName, checkImage, subImage) <- myInit+   displayCallback $= display texName+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard texName checkImage subImage)+   mainLoop
+ examples/RedBook4/Texture3D.hs view
@@ -0,0 +1,94 @@+{-+   Texture3D.hs  (adapted from texture3d.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates using a three-dimensional texture. It creates+   a 3D texture and then renders two rectangles with different texture+   coordinates to obtain different "slices" of the 3D texture.+-}++import Control.Monad ( unless )+import Foreign ( withArray )+import System.Exit ( exitFailure, exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Create checkerboard image+imageSize :: TextureSize3D+imageSize = TextureSize3D 16 16 16++withImage :: (PixelData (Color3 GLubyte) -> IO ()) -> IO ()+withImage act =+   withArray [ Color3 (s * 17) (t * 17) (r * 17) |+               r <- [ 0 .. fromIntegral d - 1 ],+               t <- [ 0 .. fromIntegral h - 1 ],+               s <- [ 0 .. fromIntegral w - 1 ] ] $+   act . PixelData RGB UnsignedByte+   where (TextureSize3D w h d) = imageSize++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less+   rowAlignment Unpack $= 1++   texName <- genObjectName+   textureBinding Texture3D $= Just texName+   textureWrapMode Texture3D S $= (Repeated, Clamp)+   textureWrapMode Texture3D T $= (Repeated, Clamp)+   textureWrapMode Texture3D R $= (Repeated, Clamp)+   textureFilter Texture3D $= ((Nearest, Nothing), Nearest)+   withImage $ texImage3D Texture3D NoProxy 0  RGB' imageSize 0+   texture Texture3D $= Enabled++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   -- resolve overloading, not needed in "real" programs+   let texCoord3f = texCoord :: TexCoord3 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Quads $ do+      texCoord3f (TexCoord3 0 0 0); vertex3f (Vertex3 (-2.25) (-1) 0)+      texCoord3f (TexCoord3 0 1 0); vertex3f (Vertex3 (-2.25)   1  0)+      texCoord3f (TexCoord3 1 1 1); vertex3f (Vertex3 (-0.25)   1  0)+      texCoord3f (TexCoord3 1 0 1); vertex3f (Vertex3 (-0.25) (-1) 0)++      texCoord3f (TexCoord3 0 0 1); vertex3f (Vertex3   0.25  (-1) 0)+      texCoord3f (TexCoord3 0 1 1); vertex3f (Vertex3   0.25    1  0)+      texCoord3f (TexCoord3 1 1 0); vertex3f (Vertex3   2.25    1  0)+      texCoord3f (TexCoord3 1 0 0); vertex3f (Vertex3   2.25  (-1) 0)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-4 :: GLfloat))++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   exts <- get glExtensions+   unless ("GL_EXT_texture3D" `elem` exts) $ do+      putStrLn "Sorry, this demo requires the GL_EXT_texture3D extension."+      exitFailure+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/TextureSurf.hs view
@@ -0,0 +1,99 @@+{-+   TextureSurf.hs (adapted from texturesurf.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program uses evaluators to generate a curved surface and automatically+   generated texture coordinates.+-}++import Data.List ( transpose )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++ctrlPoints :: [[Vertex3 GLfloat]]+ctrlPoints = [+   [ Vertex3 (-1.5) (-1.5)   4.0,  Vertex3 (-0.5) (-1.5)   2.0,+     Vertex3   0.5  (-1.5) (-1.0), Vertex3   1.5  (-1.5)   2.0 ],+   [ Vertex3 (-1.5) (-0.5)   1.0,  Vertex3 (-0.5) (-0.5)   3.0,+     Vertex3   0.5  (-0.5)   0.0,  Vertex3   1.5  (-0.5) (-1.0) ],+   [ Vertex3 (-1.5)   0.5    4.0,  Vertex3 (-0.5)   0.5    0.0,+     Vertex3   0.5    0.5    3.0,  Vertex3   1.5    0.5    4.0 ],+   [ Vertex3 (-1.5)   1.5  (-2.0), Vertex3 (-0.5)   1.5  (-2.0),+     Vertex3   0.5    1.5    0.0,  Vertex3   1.5    1.5  (-1.0) ]]++texPts :: [[TexCoord2 GLfloat]]+texPts = [+   [ TexCoord2 0 0, TexCoord2 0 1 ],+   [ TexCoord2 1 0, TexCoord2 1 1 ]]++display :: DisplayCallback+display = do+   clear [ ColorBuffer, DepthBuffer ]+   color (Color3 1 1 1 :: Color3 GLfloat)+   evalMesh2 Fill (0, 20) (0, 20)+   flush++imageSize :: TextureSize2D+imageSize = TextureSize2D 64 64++withImage :: (PixelData (Color3 GLubyte) -> IO ()) -> IO ()+withImage act =+   withArray [ Color3 (s (sin ti)) (s (cos (2 * tj))) (s (cos (ti + tj))) |+               i <- [ 0 .. fromIntegral w - 1 ],+               let ti = 2 * pi * i / fromIntegral w,+               j <- [ 0 .. fromIntegral h - 1 ],+               let tj = 2 * pi * j / fromIntegral h ] $+   act . PixelData RGB UnsignedByte+   where (TextureSize2D w h) = imageSize+         s :: Double -> GLubyte+         s x = truncate (127 * (1 + x))++myInit :: IO ()+myInit = do+   m <- newMap2 (0, 1) (0, 1) (transpose ctrlPoints)+   map2 $= Just (m :: GLmap2 Vertex3 GLfloat)+   t <- newMap2 (0, 1) (0, 1) (transpose texPts)+   map2 $= Just (t :: GLmap2 TexCoord2 GLfloat)+   mapGrid2 $= ((20, (0, 1)), (20, (0, 1 :: GLfloat)))+   textureFunction $= Decal+   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   withImage $ texImage2D Texture2D NoProxy 0 RGB' imageSize 0+   texture Texture2D $= Enabled+   depthFunc $= Just Less+   shadeModel $= Flat++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   let wf = fromIntegral w+       hf = fromIntegral h+   if w <= h+      then ortho (-4.0) 4.0 (-4.0*hf/wf) (4.0*hf/wf) (-4.0) 4.0+      else ortho (-4.0*wf/hf) (4.0*wf/hf) (-4.0) 4.0 (-4.0) 4.0+   matrixMode $= Modelview 0+   loadIdentity+   rotate (85 :: GLfloat) (Vector3 1 1 1)++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/Torus.hs view
@@ -0,0 +1,93 @@+{-+   Torus.hs (adapted from torus.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates the creation of a display list.+-}++import Data.Char ( toLower )+import Data.IORef ( IORef, newIORef )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++data State = State { spinX, spinY :: IORef GLfloat }++makeState :: IO State+makeState = do+   x <- newIORef 0+   y <- newIORef 0+   return $ State { spinX = x, spinY = y }++torus :: Int -> Int -> IO ()+torus numC numT = do+   let stepC = 2 * pi / fromIntegral numC :: GLfloat+       stepT = 2 * pi / fromIntegral numT+   flip mapM_ [ 0 .. numC - 1 ] $ \i ->+      renderPrimitive QuadStrip $+         flip mapM_ [ 0 .. numT ] $ \j ->+            flip mapM_ [ 1, 0 ] $ \k -> do+               let s = (fromIntegral ((i + k) `mod` numC) + 0.5) * stepC+                   t = (fromIntegral (      j `mod` numT)      ) * stepT+                   x = (1 + 0.1 * cos s) * cos t+                   y = (1 + 0.1 * cos s) * sin t+                   z =      0.1 * sin s+               vertex (Vertex3 x y z)++myInit :: IO DisplayList+myInit = do+   theTorus <- defineNewList Compile $+      torus 8 25+   shadeModel $= Flat+   clearColor $= Color4 0 0 0 0+   return theTorus++display :: State -> DisplayList -> DisplayCallback+display state theTorus = do+   clear [ ColorBuffer ]+   loadIdentity+   lookAt (Vertex3 0 0 10) (Vertex3 0 0 0) (Vector3 0 1 0)+   x <- get (spinX state)+   rotate x (Vector3 1 0 0)+   y <- get (spinY state)+   rotate y (Vector3 0 1 0)+   color (Color3 1 1 (1 :: GLfloat))+   callList theTorus+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective  30 (fromIntegral w / fromIntegral h) 1 100+   matrixMode $= Modelview 0++incSpin :: IORef GLfloat -> IO ()+incSpin spinRef = do+   let wrap n s = if s > n then s - n else s+   spinRef $~ (wrap 360 . (+ 30))+   postRedisplay Nothing++keyboard :: State -> KeyboardMouseCallback+keyboard state (Char c) Down _ _ = case toLower c of+   'x'   -> incSpin (spinX state)+   'y'   -> incSpin (spinY state)+   'i'   -> do spinX state $= 0; spinY state $= 0; postRedisplay Nothing+   '\27' -> exitWith ExitSuccess+   _     -> return ()+keyboard _ _ _ _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 200 200+   _ <- createWindow progName+   state <- makeState+   theTorus <- myInit+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboard state)+   displayCallback $= display state theTorus+   mainLoop
+ examples/RedBook4/Trim.hs view
@@ -0,0 +1,107 @@+{-+   Trim.hs (adapted from trim.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program draws a NURBS surface in the shape of a symmetrical hill,+   using both a NURBS curve and pwl (piecewise linear) curve to trim part+   of the surface.++   NOTE: This example does NOT demonstrate the final NURBS API, it's currently+   just a test for the internals...+-}++import Foreign.Marshal ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- The control points of the surface form a small hill and+-- range from -3 to +3 in x, y, and z.+ctlPoints :: [[Vertex3 GLfloat]]+ctlPoints =+   [ [ Vertex3 (2 * u - 3)+               (2 * v - 3)+               (if (u == 1 || u ==2) && (v == 1 || v == 2) then 3 else -3)+     | v <- [ 0 .. 3 ] ]+   | u <- [ 0 .. 3 ]]++myInit :: IO ()+myInit = do+   clearColor $= Color4 0 0 0 0+   materialDiffuse Front $= Color4 0.7 0.7 0.7 1+   materialSpecular Front $= Color4 1 1 1 1+   materialShininess Front $= 100++   lighting $= Enabled+   light (Light 0) $= Enabled+   depthFunc $= Just Less+   autoNormal $= Enabled+   normalize $= Enabled++--------------------------------------------------------------------------------++display :: DisplayCallback+display = do+   let knots = [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]+       edgePt = -- counter clockwise+          [ Vertex2 0 0, Vertex2 1 0, Vertex2 1 1, Vertex2 0 1, Vertex2 0 0 ] :: [Vertex2 GLfloat]+       curvePt = -- clockwise+          [ Vertex2 0.25 0.5, Vertex2 0.25 0.75, Vertex2 0.75 0.75, Vertex2 0.75 0.5 ]  :: [Vertex2 GLfloat]+       curveKnots =+          [ 0, 0, 0, 0, 1, 1, 1, 1 ] :: [GLfloat]+       pwlPt = -- clockwise+          [Vertex2 0.75 0.5, Vertex2 0.5 0.25, Vertex2 0.25 0.5 ] :: [Vertex2 GLfloat]++   clear [ ColorBuffer, DepthBuffer ]+   preservingMatrix $ do+      rotate (330 :: GLfloat) (Vector3 1 0 0)+      scale 0.5 0.5 (0.5 :: GLfloat)++      withNURBSObj () $ \nurbsObj -> do+         setSamplingMethod nurbsObj (PathLength 25)+         setDisplayMode' nurbsObj Fill'+         checkForNURBSError nurbsObj $+            nurbsBeginEndSurface nurbsObj $+               withArray (concat ctlPoints) $ \cBuf ->+                  withArray knots $ \kBuf -> do+                     nurbsSurface nurbsObj 8 kBuf 8 kBuf (4 * 3) 3 cBuf 4 4+                     nurbsBeginEndTrim nurbsObj $+                        withArray edgePt $ \edgePtBuf ->+                           pwlCurve nurbsObj 5 edgePtBuf 2+                     nurbsBeginEndTrim nurbsObj $ do+                        withArray curveKnots $ \curveKnotsBuf ->+                           withArray curvePt $ \curvePtBuf ->+                              trimmingCurve nurbsObj 8 curveKnotsBuf 2 curvePtBuf 4+                        withArray pwlPt $ \pwlPtBuf ->+                           pwlCurve nurbsObj 3 pwlPtBuf 2++   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 (fromIntegral w / fromIntegral h) 3 8+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-5 :: GLfloat))++keyboard :: KeyboardMouseCallback+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++-- Main Loop+main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   myInit+   reshapeCallback $= Just reshape+   displayCallback $= display+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook4/UnProject.hs view
@@ -0,0 +1,54 @@+{-+   UnProject.hs (adapted from unproject.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   When the left mouse button is pressed, this program reads the mouse+   position and determines two 3D points from which it was transformed.+   Very little is displayed.+-}++import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++display :: DisplayCallback+display = do+   clear [ ColorBuffer ]+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 45 (fromIntegral w / fromIntegral h) 1 100+   matrixMode $= Modelview 0+   loadIdentity++keyboardMouse :: KeyboardMouseCallback+keyboardMouse (MouseButton LeftButton)  Down _ (Position x y) = do+   v@(_, Size _ h) <- get viewport+   mvMatrix <- get (matrix (Just (Modelview 0))) :: IO (GLmatrix GLdouble)+   projMatrix <- get (matrix (Just Projection)) :: IO (GLmatrix GLdouble)+   let realY = fromIntegral h - y -1+   putStrLn ("Coordinates at cursor are (" ++ show x ++", " ++ show realY ++ ")")+   w0 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 0) mvMatrix projMatrix v+   putStrLn ("World coords at z=0.0 are " ++ show w0)+   w1 <- unProject (Vertex3 (fromIntegral x) (fromIntegral realY) 1) mvMatrix projMatrix v+   putStrLn ("World coords at z=1.0 are " ++ show w1)+keyboardMouse (MouseButton RightButton) Down _ _ = exitWith ExitSuccess+keyboardMouse (Char '\27')              Down _ _ = exitWith ExitSuccess+keyboardMouse _                         _    _ _ = return ()++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 500 500+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   displayCallback $= display+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboardMouse+   mainLoop
+ examples/RedBook4/VArray.hs view
@@ -0,0 +1,141 @@+{-+   VArray.hs (adapted from varray.c which is (c) Silicon Graphics, Inc.)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program demonstrates vertex arrays.+-}++import Control.Monad ( when )+import Data.IORef ( IORef, newIORef )+import Foreign ( Ptr, newArray )+import System.Exit ( exitFailure, exitWith, ExitCode(..) )+import Graphics.UI.GLUT++data SetupMethod = Pointer | Interleaved+   deriving ( Eq, Bounded, Enum )++data DerefMethod = DrawArray | ArrayElement | DrawElements+   deriving ( Eq, Bounded, Enum )++makeVertices :: IO (Ptr (Vertex2 GLint))+makeVertices = newArray [+   Vertex2  25  25,+   Vertex2 100 325,+   Vertex2 175  25,+   Vertex2 175 325,+   Vertex2 250  25,+   Vertex2 325 325 ]++makeColors :: IO (Ptr (Color3 GLfloat))+makeColors = newArray [+   Color3 1.0  0.2  0.2,+   Color3 0.2  0.2  1.0,+   Color3 0.8  1.0  0.2,+   Color3 0.75 0.75 0.75,+   Color3 0.35 0.35 0.35,+   Color3 0.5  0.5  0.5 ]++makeIntertwined :: IO (Ptr GLfloat)+makeIntertwined = newArray [+   1.0, 0.2, 1.0, 100.0, 100.0, 0.0,+   1.0, 0.2, 0.2,   0.0, 200.0, 0.0,+   1.0, 1.0, 0.2, 100.0, 300.0, 0.0,+   0.2, 1.0, 0.2, 200.0, 300.0, 0.0,+   0.2, 1.0, 1.0, 300.0, 200.0, 0.0,+   0.2, 0.2, 1.0, 200.0, 100.0, 0.0 ]++makeIndices :: IO (Ptr GLuint)+makeIndices = newArray [ 0, 1, 3, 4 ]++data State = State {+   vertices    :: Ptr (Vertex2 GLint),+   colors      :: Ptr (Color3 GLfloat),+   intertwined :: Ptr GLfloat,+   indices     :: Ptr GLuint,+   setupMethod :: IORef SetupMethod,+   derefMethod :: IORef DerefMethod }++makeState :: IO State+makeState = do+   v <- makeVertices+   c <- makeColors+   i <- makeIntertwined+   n <- makeIndices+   s <- newIORef Pointer+   d <- newIORef DrawArray+   return $ State { vertices = v, colors = c, intertwined = i,+                    indices = n, setupMethod = s, derefMethod = d }++setup :: State -> IO ()+setup state = do+   s <- get (setupMethod state)+   case s of+      Pointer -> do+         clientState VertexArray $= Enabled+         clientState ColorArray $= Enabled+         arrayPointer VertexArray $= VertexArrayDescriptor 2 Int 0 (vertices state)+         arrayPointer ColorArray $= VertexArrayDescriptor 3 Float 0 (colors state)+      Interleaved ->+         interleavedArrays C3fV3f 0 (intertwined state)++myInit :: State -> IO ()+myInit state = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Smooth+   setup state++display :: State -> DisplayCallback+display state = do+   clear [ ColorBuffer ]+   d <- get (derefMethod state)+   case d of+      DrawArray    -> drawArrays Triangles 0 6+      ArrayElement -> renderPrimitive Triangles $ mapM_ arrayElement [ 2, 3, 5 ]+      DrawElements -> drawElements Polygon 4 UnsignedInt (indices state)+   flush++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   ortho2D 0 (fromIntegral w) 0 (fromIntegral h)+   -- the following line is not in the original example, but it's good style...+   matrixMode $= Modelview 0++keyboardMouse :: State -> KeyboardMouseCallback+keyboardMouse state (MouseButton LeftButton) Down _ _ = do+   setupMethod state $~ nextValue+   setup state+   postRedisplay Nothing+keyboardMouse state (MouseButton _) Down _ _ = do+   derefMethod state $~ nextValue+   postRedisplay Nothing+keyboardMouse _ (Char '\27') Down _ _ = exitWith ExitSuccess+keyboardMouse _ _ _ _ _ = return ()++nextValue :: (Eq a, Bounded a, Enum a) => a -> a+nextValue x = if x == maxBound then minBound else succ x++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode ]+   initialWindowSize $= Size 350 350+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   -- we have to do this *after* createWindow, otherwise we have no OpenGL context+   version <- get (majorMinor glVersion)+   when (version == (1,0)) $ do+      putStrLn "This program demonstrates a feature which is not in OpenGL Version 1.0."+      putStrLn "If your implementation of OpenGL Version 1.0 has the right extensions,"+      putStrLn "you may be able to modify this program to make it run."+      exitFailure+   state <- makeState+   myInit state+   displayCallback $= display state+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just (keyboardMouse state)+   mainLoop
+ examples/RedBook4/Wrap.hs view
@@ -0,0 +1,114 @@+{-+   Wrap.hs  (adapted from wrap.c which is (c) Silicon Graphics, Inc)+   Copyright (c) Sven Panne 2002-2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file libraries/GLUT/LICENSE++   This program texture maps a checkerboard image onto two rectangles. This+   program demonstrates the wrapping modes, if the texture coordinates fall+   outside 0.0 and 1.0. Interaction: Pressing the 's' and 'S' keys switch the+   wrapping between clamping and repeating for the s parameter. The 't' and 'T'+   keys control the wrapping for the t parameter.++   Texture objects are only used when GL_EXT_texture_object is supported.+-}++import Control.Monad ( when )+import Data.Maybe ( isJust )+import Data.Bits ( (.&.) )+import Foreign ( withArray )+import System.Exit ( exitWith, ExitCode(ExitSuccess) )+import Graphics.UI.GLUT++-- Create checkerboard image+checkImageSize :: TextureSize2D+checkImageSize = TextureSize2D 64 64++withCheckImage :: TextureSize2D -> GLsizei -> (GLubyte -> (Color4 GLubyte))+               -> (PixelData (Color4 GLubyte) -> IO ()) -> IO ()+withCheckImage (TextureSize2D w h) n f act =+   withArray [ f c |+               i <- [ 0 .. w - 1 ],+               j <- [ 0 .. h - 1 ],+               let c | (i .&. n) == (j .&. n) = 0+                     | otherwise              = 255 ] $+   act. PixelData RGBA UnsignedByte++myInit :: IO (Maybe TextureObject)+myInit = do+   clearColor $= Color4 0 0 0 0+   shadeModel $= Flat+   depthFunc $= Just Less+   rowAlignment Unpack $= 1++   exts <- get glExtensions+   mbTexName <- if "GL_EXT_texture_object" `elem` exts+                   then fmap Just genObjectName+                   else return Nothing+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName++   textureWrapMode Texture2D S $= (Repeated, Repeat)+   textureWrapMode Texture2D T $= (Repeated, Repeat)+   textureFilter Texture2D $= ((Nearest, Nothing), Nearest)+   withCheckImage checkImageSize 0x8 (\c -> Color4 c c c 255) $+      texImage2D Texture2D NoProxy 0  RGBA' checkImageSize 0+   return mbTexName++display ::  Maybe TextureObject -> DisplayCallback+display mbTexName = do+   clear [ ColorBuffer, DepthBuffer ]+   texture Texture2D $= Enabled+   textureFunction $= Decal+   when (isJust mbTexName) $ textureBinding Texture2D $= mbTexName++   -- resolve overloading, not needed in "real" programs+   let texCoord2f = texCoord :: TexCoord2 GLfloat -> IO ()+       vertex3f = vertex :: Vertex3 GLfloat -> IO ()+   renderPrimitive Quads $ do+      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3 (-2.0)    (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 3); vertex3f (Vertex3 (-2.0)      1.0    0.0     )+      texCoord2f (TexCoord2 3 3); vertex3f (Vertex3   0.0       1.0    0.0     )+      texCoord2f (TexCoord2 3 0); vertex3f (Vertex3   0.0     (-1.0)   0.0     )++      texCoord2f (TexCoord2 0 0); vertex3f (Vertex3   1.0     (-1.0)   0.0     )+      texCoord2f (TexCoord2 0 3); vertex3f (Vertex3   1.0       1.0    0.0     )+      texCoord2f (TexCoord2 3 3); vertex3f (Vertex3   2.41421   1.0  (-1.41421))+      texCoord2f (TexCoord2 3 0); vertex3f (Vertex3   2.41421 (-1.0) (-1.41421))+   flush+   texture Texture2D $= Disabled++reshape :: ReshapeCallback+reshape size@(Size w h) = do+   viewport $= (Position 0 0, size)+   matrixMode $= Projection+   loadIdentity+   perspective 60 (fromIntegral w / fromIntegral h) 1 30+   matrixMode $= Modelview 0+   loadIdentity+   translate (Vector3 0 0 (-3.6 :: GLfloat))++keyboard :: KeyboardMouseCallback+keyboard (Char 's'  ) Down _ _ = setClamping S Clamp+keyboard (Char 'S'  ) Down _ _ = setClamping S Repeat+keyboard (Char 't'  ) Down _ _ = setClamping T Clamp+keyboard (Char 'T'  ) Down _ _ = setClamping T Repeat+keyboard (Char '\27') Down _ _ = exitWith ExitSuccess+keyboard _            _    _ _ = return ()++setClamping :: TextureCoordName -> Clamping -> IO ()+setClamping coord clamp = do+   textureWrapMode Texture2D coord $= (Repeated, clamp);+   postRedisplay Nothing++main :: IO ()+main = do+   (progName, _args) <- getArgsAndInitialize+   initialDisplayMode $= [ SingleBuffered, RGBMode, WithDepthBuffer ]+   initialWindowSize $= Size 250 250+   initialWindowPosition $= Position 100 100+   _ <- createWindow progName+   mbTexName <- myInit+   displayCallback $= display mbTexName+   reshapeCallback $= Just reshape+   keyboardMouseCallback $= Just keyboard+   mainLoop
+ examples/RedBook8/00-README view
@@ -0,0 +1,3 @@+This directory contains various examples from the book "OpenGL Programming+Guide: The Official Guide to Learning OpenGL, Version 4.3", 8th ed., by+Shreiner/Sellers/Kessenich/Licea-Kane.
+ examples/RedBook8/Chapter01/Triangles.hs view
@@ -0,0 +1,76 @@+{-+   Triangles.hs (adapted from triangles.cpp which is (c) The Red Book Authors.)+   Copyright (c) Sven Panne 2018 <svenpanne@gmail.com>+   This file is part of HOpenGL and distributed under a BSD-style license+   See the file GLUT/LICENSE++   Our first OpenGL program.+-}++import Control.Monad+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable+import Graphics.UI.GLUT+import Prelude hiding ( init )+import LoadShaders++bufferOffset :: Integral a => a -> Ptr b+bufferOffset = plusPtr nullPtr . fromIntegral++data Descriptor = Descriptor VertexArrayObject ArrayIndex NumArrayIndices++init :: IO Descriptor+init = do+  triangles <- genObjectName+  bindVertexArrayObject $= Just triangles++  let vertices = [+        Vertex2 (-0.90) (-0.90),  -- Triangle 1+        Vertex2   0.85  (-0.90),+        Vertex2 (-0.90)   0.85 ,+        Vertex2   0.90  (-0.85),  -- Triangle 2+        Vertex2   0.90    0.90 ,+        Vertex2 (-0.85)   0.90 ] :: [Vertex2 GLfloat]+      numVertices = length vertices+      vertexSize = sizeOf (head vertices)++  arrayBuffer <- genObjectName+  bindBuffer ArrayBuffer $= Just arrayBuffer+  withArray vertices $ \ptr -> do+    let size = fromIntegral (numVertices * vertexSize)+    bufferData ArrayBuffer $= (size, ptr, StaticDraw)++  program <- loadShaders [+     ShaderInfo VertexShader (FileSource "triangles.vert"),+     ShaderInfo FragmentShader (FileSource "triangles.frag")]+  currentProgram $= Just program++  let firstIndex = 0+      vPosition = AttribLocation 0+  vertexAttribPointer vPosition $=+    (ToFloat,+     VertexArrayDescriptor 2 Float 0 (bufferOffset (firstIndex * vertexSize)))+  vertexAttribArray vPosition $= Enabled++  return $+    Descriptor triangles (fromIntegral firstIndex) (fromIntegral numVertices)++display :: Descriptor -> DisplayCallback+display (Descriptor triangles firstIndex numVertices) = do+  clear [ ColorBuffer ]+  bindVertexArrayObject $= Just triangles+  drawArrays Triangles firstIndex numVertices+  flush++main :: IO ()+main = do+  (progName, _args) <- getArgsAndInitialize+  initialDisplayMode $= [ RGBAMode ]+  initialWindowSize $= Size 512 512+  initialContextVersion $= (4, 3)+  initialContextProfile $= [ CoreProfile ]+  _ <- createWindow progName+  descriptor <- init+  displayCallback $= display descriptor+  mainLoop
+ examples/RedBook8/Chapter01/triangles.frag view
@@ -0,0 +1,8 @@+#version 430 core++out vec4 fColor;+void+main()+{+   fColor = vec4(0.0, 0.0, 1.0, 1.0);+}
+ examples/RedBook8/Chapter01/triangles.vert view
@@ -0,0 +1,9 @@+#version 430 core++layout(location = 0) in vec4 vPosition;++void+main()+{+   gl_Position = vPosition;+}
+ examples/RedBook8/common/LoadShaders.hs view
@@ -0,0 +1,89 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  LoadShaders+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Utilities for shader handling, adapted from LoadShaders.cpp which is (c) The+-- Red Book Authors.+--+--------------------------------------------------------------------------------++module LoadShaders (+   ShaderSource(..), ShaderInfo(..), loadShaders+) where++import Control.Exception+import Control.Monad+import qualified Data.ByteString as B+import Graphics.UI.GLUT++--------------------------------------------------------------------------------++-- | The source of the shader source code.++data ShaderSource =+     ByteStringSource B.ByteString+     -- ^ The shader source code is directly given as a 'B.ByteString'.+   | StringSource String+     -- ^ The shader source code is directly given as a 'String'.+   | FileSource FilePath+     -- ^ The shader source code is located in the file at the given 'FilePath'.+   deriving ( Eq, Ord, Show )++getSource :: ShaderSource -> IO B.ByteString+getSource (ByteStringSource bs) = return bs+getSource (StringSource str) = return $ packUtf8 str+getSource (FileSource path) = B.readFile path++--------------------------------------------------------------------------------++-- | A description of a shader: The type of the shader plus its source code.++data ShaderInfo = ShaderInfo ShaderType ShaderSource+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++-- | Create a new program object from the given shaders, throwing an+-- 'IOException' if something goes wrong.++loadShaders :: [ShaderInfo] -> IO Program+loadShaders infos =+   createProgram `bracketOnError` deleteObjectName $ \program -> do+      loadCompileAttach program infos+      linkAndCheck program+      return program++linkAndCheck :: Program -> IO ()+linkAndCheck = checked linkProgram linkStatus programInfoLog "link"++loadCompileAttach :: Program -> [ShaderInfo] -> IO ()+loadCompileAttach _ [] = return ()+loadCompileAttach program (ShaderInfo shType source : infos) =+   createShader shType `bracketOnError` deleteObjectName $ \shader -> do+      src <- getSource source+      shaderSourceBS shader $= src+      compileAndCheck shader+      attachShader program shader+      loadCompileAttach program infos++compileAndCheck :: Shader -> IO ()+compileAndCheck = checked compileShader compileStatus shaderInfoLog "compile"++checked :: (t -> IO ())+        -> (t -> GettableStateVar Bool)+        -> (t -> GettableStateVar String)+        -> String+        -> t+        -> IO ()+checked action getStatus getInfoLog message object = do+   action object+   ok <- get (getStatus object)+   unless ok $ do+      infoLog <- get (getInfoLog object)+      fail (message ++ " log: " ++ infoLog)
− include/HsGLUT.h 
@@ -1,47 +0,0 @@-/* include/HsGLUT.h.  Generated from HsGLUT.h.in by configure.  */-/* ------------------------------------------------------------------------------ *- * Module      :  C support for Graphics.UI.GLUT.Fonts- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/GLUT/LICENSE)- *- * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * -------------------------------------------------------------------------- */--#ifndef HSGLUT_H-#define HSGLUT_H--/* Define to 1 if you have the <GL/glut.h> header file. */-#define HAVE_GL_GLUT_H 1--/* Define to 1 if you have the <windows.h> header file. */-/* #undef HAVE_WINDOWS_H */--/* Define to 1 if native OpenGL should be used on Mac OS X */-/* #undef USE_QUARTZ_OPENGL */--#ifdef USE_QUARTZ_OPENGL /* Mac OS X only */-#include <GLUT/glut.h>-#else-#if HAVE_WINDOWS_H-#include <windows.h>-#endif-#if HAVE_GL_GLUT_H-#include <GL/glut.h>-#else-#include "glut_local.h"-#endif-#endif--#if FREEGLUT-#include <GL/freeglut_ext.h>-#endif--extern void* hs_GLUT_marshalBitmapFont(int fontID);-extern void* hs_GLUT_marshalStrokeFont(int fontID);-extern void* hs_GLUT_getProcAddress(char *procName);--#endif
− include/HsGLUT.h.in 
@@ -1,46 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  C support for Graphics.UI.GLUT.Fonts- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/GLUT/LICENSE)- *- * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * -------------------------------------------------------------------------- */--#ifndef HSGLUT_H-#define HSGLUT_H--/* Define to 1 if you have the <GL/glut.h> header file. */-#undef HAVE_GL_GLUT_H--/* Define to 1 if you have the <windows.h> header file. */-#undef HAVE_WINDOWS_H--/* Define to 1 if native OpenGL should be used on Mac OS X */-#undef USE_QUARTZ_OPENGL--#ifdef USE_QUARTZ_OPENGL /* Mac OS X only */-#include <GLUT/glut.h>-#else-#if HAVE_WINDOWS_H-#include <windows.h>-#endif-#if HAVE_GL_GLUT_H-#include <GL/glut.h>-#else-#include "glut_local.h"-#endif-#endif--#if FREEGLUT-#include <GL/freeglut_ext.h>-#endif--extern void* hs_GLUT_marshalBitmapFont(int fontID);-extern void* hs_GLUT_marshalStrokeFont(int fontID);-extern void* hs_GLUT_getProcAddress(char *procName);--#endif
− include/HsGLUTConfig.h.in 
@@ -1,73 +0,0 @@-/* include/HsGLUTConfig.h.in.  Generated from configure.ac by autoheader.  */--/* C flags for GLUT, as a list of string literals. */-#undef GLUT_CFLAGS--/* Extra libraries for GLUT, as a list of string literals. */-#undef GLUT_EXTRA_LIBS--/* Framework flags for GLUT, as a list of string literals. */-#undef GLUT_FRAMEWORKS--/* Library flags for GLUT, as a list of string literals. */-#undef GLUT_LIBS--/* Define to 1 if you have the <GLUT/glut.h> header file. */-#undef HAVE_GLUT_GLUT_H--/* Define to 1 if you have the <GL/glut.h> header file. */-#undef HAVE_GL_GLUT_H--/* Define to 1 if you have the <inttypes.h> header file. */-#undef HAVE_INTTYPES_H--/* Define to 1 if you have the <memory.h> header file. */-#undef HAVE_MEMORY_H--/* Define to 1 if you have the <stdint.h> header file. */-#undef HAVE_STDINT_H--/* Define to 1 if you have the <stdlib.h> header file. */-#undef HAVE_STDLIB_H--/* Define to 1 if you have the <strings.h> header file. */-#undef HAVE_STRINGS_H--/* Define to 1 if you have the <string.h> header file. */-#undef HAVE_STRING_H--/* Define to 1 if you have the <sys/stat.h> header file. */-#undef HAVE_SYS_STAT_H--/* Define to 1 if you have the <sys/types.h> header file. */-#undef HAVE_SYS_TYPES_H--/* Define to 1 if you have the <unistd.h> header file. */-#undef HAVE_UNISTD_H--/* Define to 1 if you have the <windows.h> header file. */-#undef HAVE_WINDOWS_H--/* Define to the address where bug reports for this package should be sent. */-#undef PACKAGE_BUGREPORT--/* Define to the full name of this package. */-#undef PACKAGE_NAME--/* Define to the full name and version of this package. */-#undef PACKAGE_STRING--/* Define to the one symbol short name of this package. */-#undef PACKAGE_TARNAME--/* Define to the version of this package. */-#undef PACKAGE_VERSION--/* Define to 1 if you have the ANSI C header files. */-#undef STDC_HEADERS--/* Define to 1 if native OpenGL should be used on Mac OS X */-#undef USE_QUARTZ_OPENGL--/* Define to 1 if the X Window System is missing or not being used. */-#undef X_DISPLAY_MISSING
− include/HsGLUTExt.h 
@@ -1,29 +0,0 @@-/* ------------------------------------------------------------------------------ *- * Module      :  GLUT extension support for Graphics.UI.GLUT- * Copyright   :  (c) Sven Panne 2002-2005- * License     :  BSD-style (see the file libraries/OpenGL/LICENSE)- *- * Maintainer  :  sven.panne@aedion.de- * Stability   :  provisional- * Portability :  portable- *- * This header should only define preprocessor macros!- *- * -------------------------------------------------------------------------- */--#ifndef HSGLUTEXT_H-#define HSGLUTEXT_H--/* NOTE: The macro must immediately start with the foreign declaration,-   otherwise the magic mangler (hack_foreign) in the Hugs build system-   doesn't recognize it. */-#define EXTENSION_ENTRY(_saftey,_msg,_entry,_ty)			\-foreign import CALLCONV _saftey "dynamic" dyn_/**/_entry :: Graphics.UI.GLUT.Extensions.Invoker (_ty) ; \-_entry :: (_ty) ; \-_entry = dyn_/**/_entry ptr_/**/_entry ; \-ptr_/**/_entry :: FunPtr a ; \-ptr_/**/_entry = unsafePerformIO (Graphics.UI.GLUT.Extensions.getProcAddress (_msg) ("_entry")) ; \-{-# NOINLINE ptr_/**/_entry #-}--#endif
− install-sh 
@@ -1,295 +0,0 @@-#!/bin/sh-# install - install a program, script, or datafile--scriptversion=2003-09-24.23--# This originates from X11R5 (mit/util/scripts/install.sh), which was-# later released in X11R6 (xc/config/util/install.sh) with the-# following copyright and license.-#-# Copyright (C) 1994 X Consortium-#-# Permission is hereby granted, free of charge, to any person obtaining a copy-# of this software and associated documentation files (the "Software"), to-# deal in the Software without restriction, including without limitation the-# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or-# sell copies of the Software, and to permit persons to whom the Software is-# furnished to do so, subject to the following conditions:-#-# The above copyright notice and this permission notice shall be included in-# all copies or substantial portions of the Software.-#-# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE-# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN-# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC--# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.-#-# Except as contained in this notice, the name of the X Consortium shall not-# be used in advertising or otherwise to promote the sale, use or other deal--# ings in this Software without prior written authorization from the X Consor--# tium.-#-#-# FSF changes to this file are in the public domain.-#-# Calling this script install-sh is preferred over install.sh, to prevent-# `make' implicit rules from creating a file called install from it-# when there is no Makefile.-#-# This script is compatible with the BSD install script, but was written-# from scratch.  It can only install one file at a time, a restriction-# shared with many OS's install programs.--# set DOITPROG to echo to test this script--# Don't use :- since 4.3BSD and earlier shells don't like it.-doit="${DOITPROG-}"--# put in absolute paths if you don't have them in your path; or use env. vars.--mvprog="${MVPROG-mv}"-cpprog="${CPPROG-cp}"-chmodprog="${CHMODPROG-chmod}"-chownprog="${CHOWNPROG-chown}"-chgrpprog="${CHGRPPROG-chgrp}"-stripprog="${STRIPPROG-strip}"-rmprog="${RMPROG-rm}"-mkdirprog="${MKDIRPROG-mkdir}"--transformbasename=-transform_arg=-instcmd="$mvprog"-chmodcmd="$chmodprog 0755"-chowncmd=-chgrpcmd=-stripcmd=-rmcmd="$rmprog -f"-mvcmd="$mvprog"-src=-dst=-dir_arg=--usage="Usage: $0 [OPTION]... SRCFILE DSTFILE-   or: $0 -d DIR1 DIR2...--In the first form, install SRCFILE to DSTFILE, removing SRCFILE by default.-In the second, create the directory path DIR.--Options:--b=TRANSFORMBASENAME--c         copy source (using $cpprog) instead of moving (using $mvprog).--d         create directories instead of installing files.--g GROUP   $chgrp installed files to GROUP.--m MODE    $chmod installed files to MODE.--o USER    $chown installed files to USER.--s         strip installed files (using $stripprog).--t=TRANSFORM---help     display this help and exit.---version  display version info and exit.--Environment variables override the default commands:-  CHGRPPROG CHMODPROG CHOWNPROG CPPROG MKDIRPROG MVPROG RMPROG STRIPPROG-"--while test -n "$1"; do-  case $1 in-    -b=*) transformbasename=`echo $1 | sed 's/-b=//'`-        shift-        continue;;--    -c) instcmd=$cpprog-        shift-        continue;;--    -d) dir_arg=true-        shift-        continue;;--    -g) chgrpcmd="$chgrpprog $2"-        shift-        shift-        continue;;--    --help) echo "$usage"; exit 0;;--    -m) chmodcmd="$chmodprog $2"-        shift-        shift-        continue;;--    -o) chowncmd="$chownprog $2"-        shift-        shift-        continue;;--    -s) stripcmd=$stripprog-        shift-        continue;;--    -t=*) transformarg=`echo $1 | sed 's/-t=//'`-        shift-        continue;;--    --version) echo "$0 $scriptversion"; exit 0;;--    *)  if test -z "$src"; then-          src=$1-        else-          # this colon is to work around a 386BSD /bin/sh bug-          :-          dst=$1-        fi-        shift-        continue;;-  esac-done--if test -z "$src"; then-  echo "$0: no input file specified." >&2-  exit 1-fi--# Protect names starting with `-'.-case $src in-  -*) src=./$src ;;-esac--if test -n "$dir_arg"; then-  dst=$src-  src=--  if test -d "$dst"; then-    instcmd=:-    chmodcmd=-  else-    instcmd=$mkdirprog-  fi-else-  # Waiting for this to be detected by the "$instcmd $src $dsttmp" command-  # might cause directories to be created, which would be especially bad-  # if $src (and thus $dsttmp) contains '*'.-  if test ! -f "$src" && test ! -d "$src"; then-    echo "$0: $src does not exist." >&2-    exit 1-  fi--  if test -z "$dst"; then-    echo "$0: no destination specified." >&2-    exit 1-  fi--  # Protect names starting with `-'.-  case $dst in-    -*) dst=./$dst ;;-  esac--  # If destination is a directory, append the input filename; won't work-  # if double slashes aren't ignored.-  if test -d "$dst"; then-    dst=$dst/`basename "$src"`-  fi-fi--# This sed command emulates the dirname command.-dstdir=`echo "$dst" | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`--# Make sure that the destination directory exists.--# Skip lots of stat calls in the usual case.-if test ! -d "$dstdir"; then-  defaultIFS='-	'-  IFS="${IFS-$defaultIFS}"--  oIFS=$IFS-  # Some sh's can't handle IFS=/ for some reason.-  IFS='%'-  set - `echo "$dstdir" | sed -e 's@/@%@g' -e 's@^%@/@'`-  IFS=$oIFS--  pathcomp=--  while test $# -ne 0 ; do-    pathcomp=$pathcomp$1-    shift-    test -d "$pathcomp" || $mkdirprog "$pathcomp"-    pathcomp=$pathcomp/-  done-fi--if test -n "$dir_arg"; then-  $doit $instcmd "$dst" \-    && { test -z "$chowncmd" || $doit $chowncmd "$dst"; } \-    && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } \-    && { test -z "$stripcmd" || $doit $stripcmd "$dst"; } \-    && { test -z "$chmodcmd" || $doit $chmodcmd "$dst"; }--else-  # If we're going to rename the final executable, determine the name now.-  if test -z "$transformarg"; then-    dstfile=`basename "$dst"`-  else-    dstfile=`basename "$dst" $transformbasename \-             | sed $transformarg`$transformbasename-  fi--  # don't allow the sed command to completely eliminate the filename.-  test -z "$dstfile" && dstfile=`basename "$dst"`--  # Make a couple of temp file names in the proper directory.-  dsttmp=$dstdir/_inst.$$_-  rmtmp=$dstdir/_rm.$$_--  # Trap to clean up those temp files at exit.-  trap 'status=$?; rm -f "$dsttmp" "$rmtmp" && exit $status' 0-  trap '(exit $?); exit' 1 2 13 15--  # Move or copy the file name to the temp name-  $doit $instcmd "$src" "$dsttmp" &&--  # and set any options; do chmod last to preserve setuid bits.-  #-  # If any of these fail, we abort the whole thing.  If we want to-  # ignore errors from any of these, just make sure not to ignore-  # errors from the above "$doit $instcmd $src $dsttmp" command.-  #-  { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } \-    && { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } \-    && { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } \-    && { test -z "$chmodcmd" || $doit $chmodcmd "$dsttmp"; } &&--  # Now remove or move aside any old file at destination location.  We-  # try this two ways since rm can't unlink itself on some systems and-  # the destination file might be busy for other reasons.  In this case,-  # the final cleanup might fail but the new file should still install-  # successfully.-  {-    if test -f "$dstdir/$dstfile"; then-      $doit $rmcmd -f "$dstdir/$dstfile" 2>/dev/null \-      || $doit $mvcmd -f "$dstdir/$dstfile" "$rmtmp" 2>/dev/null \-      || {-	  echo "$0: cannot unlink or rename $dstdir/$dstfile" >&2-	  (exit 1); exit-      }-    else-      :-    fi-  } &&--  # Now rename the file to the real destination.-  $doit $mvcmd "$dsttmp" "$dstdir/$dstfile"-fi &&--# The final little trick to "correctly" pass the exit status to the exit trap.-{-  (exit 0); exit-}--# Local variables:-# eval: (add-hook 'write-file-hooks 'time-stamp)-# time-stamp-start: "scriptversion="-# time-stamp-format: "%:y-%02m-%02d.%02H"-# time-stamp-end: "$"-# End:
+ src/Graphics/UI/GLUT.hs view
@@ -0,0 +1,386 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A Haskell binding for GLUT, the OpenGL Utility Toolkit, a window system+-- independent toolkit for writing OpenGL programs. It includes support for+-- the extended functionality available in freeglut (see+-- <http://freeglut.sourceforge.net/>) and OpenGLUT (see+-- <http://openglut.sourceforge.net/>), too.+--+-----------------------------------------------------------------------------++module Graphics.UI.GLUT (+   -- * Legal stuff++   -- $LegalStuff++   -- * Introduction++   -- $Introduction++   -- ** Background++   -- $Background++   -- ** Design Philosophy++   -- $DesignPhilosophy++   -- ** API Versions++   -- $APIVersions++   -- ** Conventions++   -- $Conventions++   -- ** Terminology++   -- $Terminology++   module Graphics.Rendering.OpenGL,++   module Graphics.UI.GLUT.Initialization,+   module Graphics.UI.GLUT.Begin,+   module Graphics.UI.GLUT.Window,+   module Graphics.UI.GLUT.Overlay,+   module Graphics.UI.GLUT.Menu,+   module Graphics.UI.GLUT.Callbacks,+   module Graphics.UI.GLUT.Colormap,+   module Graphics.UI.GLUT.State,+   module Graphics.UI.GLUT.Fonts,+   module Graphics.UI.GLUT.Objects,+   module Graphics.UI.GLUT.Debugging,+   module Graphics.UI.GLUT.DeviceControl,+   module Graphics.UI.GLUT.GameMode+)  where++import Graphics.Rendering.OpenGL++import Graphics.UI.GLUT.Initialization+import Graphics.UI.GLUT.Begin+import Graphics.UI.GLUT.Window+import Graphics.UI.GLUT.Overlay+import Graphics.UI.GLUT.Menu+import Graphics.UI.GLUT.Callbacks+import Graphics.UI.GLUT.Colormap+import Graphics.UI.GLUT.State+import Graphics.UI.GLUT.Fonts+import Graphics.UI.GLUT.Objects+import Graphics.UI.GLUT.Debugging+import Graphics.UI.GLUT.DeviceControl+import Graphics.UI.GLUT.GameMode++-----------------------------------------------------------------------------+-- $LegalStuff+-- This documentation is heavily based on the man pages of Mark J. Kilgard\'s+-- GLUT library.+--+-- OpenGL is a trademark of Silicon Graphics, Inc.+-- X Window System is a trademark of X Consortium, Inc.+-- Spaceball is a registered trademark of Spatial Systems, Inc.+--+-- The author has taken care in preparation of this documentation but makes+-- no expressed or implied warranty of any kind and assumes no responsibility+-- for errors or omissions. No liability is assumed for incidental or+-- consequential damages in connection with or arising from the use of+-- information or programs contained herein.++-----------------------------------------------------------------------------+-- $Introduction+-- The OpenGL Utility Toolkit (GLUT) is a programming interface for writing+-- window system independent OpenGL programs. Currently there are+-- implementations for the X Window System, the Windows family, OS\/2, and Mac.+-- The toolkit supports the following functionality:+--+-- * Multiple windows for OpenGL rendering.+--+-- * Callback driven event processing.+--+-- * Sophisticated input devices.+--+-- * An /idle/ routine and timers.+--+-- * A simple, cascading pop-up menu facility.+--+-- * Utility routines to generate various solid and wire frame objects.+--+-- * Support for bitmap and stroke fonts.+--+-- * Miscellaneous window management functions, including managing overlays.+--+-- This documentation serves as both a specification and a programming guide.+-- If you are interested in a brief introduction to programming with GLUT,+-- have a look at the relevant parts of <http://www.opengl.org/> and the vast+-- amount of books on OpenGL, most of them use GLUT.+--+-- The remainder of this section describes GLUT\'s design philosophy and+-- usage model. The following sections specify the GLUT routines, grouped by+-- functionality. The final sections discuss usage advice and the logical+-- programmer visible state maintained by GLUT.++-----------------------------------------------------------------------------+-- $Background+-- One of the major accomplishments in the specification of OpenGL was+-- the isolation of window system dependencies from OpenGL\'s rendering+-- model. The result is that OpenGL is window system independent.+--+-- Window system operations such as the creation of a rendering window and the+-- handling of window system events are left to the native window system to+-- define. Necessary interactions between OpenGL and the window system such as+-- creating and binding an OpenGL context to a window are described separately+-- from the OpenGL specification in a window system dependent specification. For+-- example, the GLX specification describes the standard by which OpenGL+-- interacts with the X Window System.+--+-- The predecessor to OpenGL is IRIS GL. Unlike OpenGL, IRIS GL /does/+-- specify how rendering windows are created and manipulated. IRIS GL\'s+-- windowing interface is reasonably popular largely because it is simple to+-- use. IRIS GL programmers can worry about graphics programming without needing+-- to be an expert in programming the native window system. Experience also+-- demonstrated that IRIS GL\'s windowing interface was high-level enough that+-- it could be retargeted to different window systems. Silicon Graphics migrated+-- from NeWS to the X Window System without any major changes to IRIS GL\'s+-- basic windowing interface.+--+-- Removing window system operations from OpenGL is a sound decision because it+-- allows the OpenGL graphics system to be retargeted to various systems+-- including powerful but expensive graphics workstations as well as+-- mass-production graphics systems like video games, set-top boxes for+-- interactive television, and PCs.+--+-- Unfortunately, the lack of a window system interface for OpenGL is a gap in+-- OpenGL\'s utility. Learning native window system APIs such as the X Window+-- System\'s Xlib or Motif can be daunting. Even those familiar with+-- native window system APIs need to understand the interface that binds OpenGL+-- to the native window system. And when an OpenGL program is written using the+-- native window system interface, despite the portability of the program\'s+-- OpenGL rendering code, the program itself will be window system dependent.+--+-- Testing and documenting OpenGL\'s functionality lead to the development of+-- the @tk@ and @aux@ toolkits. The @aux@ toolkit is used in the examples found+-- in the /OpenGL Programming Guide/. Unfortunately, @aux@ has numerous+-- limitations and its utility is largely limited to toy programs. The @tk@+-- library has more functionality than @aux@ but was developed in an /ad hoc/+-- fashion and still lacks much important functionality that IRIS GL programmers+-- expect, like pop-up menus and overlays.+--+-- GLUT is designed to fill the need for a window system independent programming+-- interface for OpenGL programs. The interface is designed to be simple yet+-- still meet the needs of useful OpenGL programs. Features from the IRIS GL,+-- @aux@, and @tk@ interfaces are included to make it easy for programmers used+-- to these interfaces to develop programs for GLUT.++-----------------------------------------------------------------------------+-- $DesignPhilosophy+-- GLUT simplifies the implementation of programs using OpenGL rendering. The+-- GLUT application programming interface (API) requires very few routines to+-- display a graphics scene rendered using OpenGL. The GLUT API (like the OpenGL+-- API) is stateful. Most initial GLUT state is defined and the initial state is+-- reasonable for simple programs. The GLUT routines also take relatively few+-- parameters.+--+-- The GLUT API is (as much as reasonable) window system independent. For this+-- reason, GLUT does not return /any/ native window system handles, pointers, or+-- other data structures. More subtle window system dependencies such as+-- reliance on window system dependent fonts are avoided by GLUT; instead, GLUT+-- supplies its own (limited) set of fonts.+--+-- For programming ease, GLUT provides a simple menu sub-API. While the menuing+-- support is designed to be implemented as pop-up menus, GLUT gives window+-- system leeway to support the menu functionality in another manner (pull-down+-- menus for example).+--+-- Two of the most important pieces of GLUT state are the /current window/ and+-- /current menu/. Most window and menu routines affect the /current window/ or+-- /menu/ respectively. Most callbacks implicitly set the /current window/ and+-- /menu/ to the appropriate window or menu responsible for the callback. GLUT+-- is designed so that a program with only a single window and\/or menu will not+-- need to keep track of any window or menu identifiers. This greatly simplifies+-- very simple GLUT programs.+--+-- GLUT is designed for simple to moderately complex programs focused on OpenGL+-- rendering. GLUT implements its own event loop. For this reason, mixing GLUT+-- with other APIs that demand their own event handling structure may be+-- difficult. The advantage of a builtin event dispatch loop is simplicity.+--+-- GLUT contains routines for rendering fonts and geometric objects, however+-- GLUT makes no claims on the OpenGL display list name space. For this reason,+-- none of the GLUT rendering routines use OpenGL display lists. It is up to the+-- GLUT programmer to compile the output from GLUT rendering routines into+-- display lists if this is desired.+--+-- GLUT routines are logically organized into several sub-APIs according to+-- their functionality. The sub-APIs are:+--+-- * /Initialization:/ Command line processing, window system initialization,+--   and initial window creation state are controlled by these routines.+--+-- * /Beginning Event Processing:/ This routine enters GLUT\'s event processing+--   loop. This routine never returns, and it continuously calls GLUT callbacks+--   as necessary.+--+-- * /Window Management:/ These routines create and control windows.+--+-- * /Overlay Management:/ These routines establish and manage overlays for+--   windows.+--+-- * /Menu Management:/ These routines create and control pop-up menus.+--+-- * /Callback Registration:/ These routines register callbacks to be called by+--   the GLUT event processing loop.+--+-- * /Color Index Colormap Management:/ These routines allow the manipulation+--   of color index colormaps for windows.+--+-- * /State Retrieval:/ These routines allows programs to retrieve state from+--   GLUT.+--+-- * /Font Rendering:/ These routines allow rendering of stroke and bitmap+--   fonts.+--+-- * /Geometric Shape Rendering:/ These routines allow the rendering of 3D+--   geometric objects including spheres, cones, icosahedrons, and teapots.+--+-- * /Debugging:/ This routine reports any pending GL errors.+--+-- * /Device Control:/ These routines allow setting the key repeat and polling+--   the joystick.+--+-- * /Game Mode:/ These routines allow programs to enter\/leave a full-screen+--   mode with specified properties.++-- Note that the following item has been left out intentionally, its+-- implementation is too SGI-specific:+-- * /Video Resizing:/ These routines provide a means for doing swap or frame+--   synchronous resizing\/panning of the area that is to be magnified (or+--   passed through) to the output video resolution.++-----------------------------------------------------------------------------+-- $APIVersions+-- The GLUT API has undergone several revisions with increasing functionality.+-- This Haskell binding provides access to everything in API version 4,+-- although it is not yet officially finalized. Nevertheless, it provides very+-- useful things like handling full-screen modes and special keys.++-----------------------------------------------------------------------------+-- $Conventions+-- GLUT window and screen coordinates are expressed in pixels. The upper+-- left hand corner of the screen or a window is (0,0). X coordinates+-- increase in a rightward direction; Y coordinates increase in a+-- downward direction. Note: This is inconsistent with OpenGL\'s+-- coordinate scheme that generally considers the lower left hand+-- coordinate of a window to be at (0,0) but is consistent with most+-- popular window systems.++-----------------------------------------------------------------------------+-- $Terminology+-- A number of terms are used in a GLUT-specific manner throughout this+-- document. The GLUT meaning of these terms is independent of the window+-- system GLUT is used with. Here are GLUT-specific meanings for the+-- following GLUT-specific terms:+--+-- * /Callback:/ A programmer specified routine that can be registered with+--   GLUT to be called in response to a specific type of event. Also used to+-- refer to a specific callback routine being called.+--+-- * /Colormap:/ A mapping of pixel values to RGB color values. Used by color+--   index windows.+--+-- * /Dials and button box:/ A sophisticated input device consisting of a pad+--   of buttons and an array of rotating dials, often used by computer-aided+--   design programs.+--+-- * /Display mode:/ A set of OpenGL frame buffer capabilities that can be+--   attributed to a window.+--+-- * /Idle:/ A state when no window system events are received for processing+--   as callbacks and the idle callback, if one is registered, is called.+--+-- * /Layer in use:/ Either the normal plane or overlay. This per-window state+--   determines what frame buffer layer OpenGL commands affect.+--+-- * /Menu entry:/ A menu item that the user can select to trigger the menu+--   callback for the menu entry\'s value.+--+-- * /Menu item:/ Either a menu entry or a sub-menu trigger.+--+-- * /Modifiers:/ The Shift, Ctrl, and Alt keys that can be held down+--   simultaneously with a key or mouse button being pressed or released.+--+-- * /Multisampling:/ A technique for hardware antialiasing generally available+--   only on expensive 3D graphics hardware. Each pixel is composed of a number+--   of samples (each containing color and depth information). The samples are+--   averaged to determine the displayed pixel color value. Multisampling is+--   supported as an extension to OpenGL.+--+-- * /Normal plane:/ The default frame buffer layer where GLUT window state+--   resides; as opposed to the /overlay/.+--+-- * /Overlay:/ A frame buffer layer that can be displayed preferentially to+--   the /normal plane/ and supports transparency to display through to the+--   /normal plane/. Overlays are useful for rubber-banding effects, text+--   annotation, and other operations, to avoid damaging the normal plane frame+--   buffer state. Overlays require hardware support not present on all systems.+--+-- * /Pop:/ The act of forcing a window to the top of the stacking order for+--   sibling windows.+--+-- * /Pop-up menu:/ A menu that can be set to appear when a specified mouse+--   button is pressed in a window. A pop-menu consists of multiple menu items.+--+-- * /Push:/ The act of forcing a window to the bottom of the stacking order+--   for sibling windows.+--+-- * /Reshape:/ The act of changing the size or shape of the window.+--+-- * /Spaceball:/ A sophisticated 3D input device that provides six degrees of+--   freedom, three axes of rotation and three axes of translation. It also+--   supports a number of buttons. The device is a hand-sized ball attached to+--   a base. By cupping the ball with one\'s hand and applying torsional or+--   directional force on the ball, rotations and translationsare generated.+--+-- * /Stereo:/ A frame buffer capability providing left and right color buffers+--   for creating stereoscopic renderings. Typically, the user wears LCD+--   shuttered goggles synchronized with the alternating display on the screen+--   of the left and right color buffers.+--+-- * /Sub-menu:/ A menu cascaded from some sub-menu trigger.+--+-- * /Sub-menu trigger:/ A menu item that the user can enter to cascade another+--   pop-up menu.+--+-- * /Subwindow:/ A type of window that is the child window of a top-level+--   window or other subwindow. The drawing and visible region of a subwindow+--   is limited by its parent window.+--+-- * /Tablet:/ A precise 2D input device. Like a mouse, 2D coordinates are+--   returned. The absolute position of the tablet \"puck\" on the tablet is+--   returned. Tablets also support a number of buttons.+--+-- * /Timer:/ A callback that can be scheduled to be called in a specified+--   interval of time.+--+-- * /Top-level window:/ A window that can be placed, moved, resized, etc.+--   independently from other top-level windows by the user. Subwindows may+--   reside within a top-level window.+--+-- * /Window:/ A rectangular area for OpenGL rendering.+--+-- * /Window display state:/ One of shown, hidden, or iconified. A shown window+--   is potentially visible on the screen (it may be obscured by other windows+--   and not actually visible). A hidden window will never be visible. An+--   iconified window is not visible but could be made visible in response to+--   some user action like clicking on the window\'s corresponding icon.+--+-- * /Window system:/ A broad notion that refers to both the mechanism and+--   policy of the window system. For example, in the X Window System both the+--   window manager and the X server are integral to what GLUT considers the+--   window system.
+ src/Graphics/UI/GLUT/Begin.hs view
@@ -0,0 +1,100 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Begin+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- After a GLUT program has done initial setup such as creating windows and+-- menus, GLUT programs enter the GLUT event processing loop by calling+-- 'mainLoop' or handle events iteratively with 'mainLoopEvent'.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Begin (+   -- * Handling events+   mainLoop, mainLoopEvent, leaveMainLoop,++   -- * Controlling the behaviour when windows are closed+   ActionOnWindowClose(..), actionOnWindowClose+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( StateVar, makeStateVar )+import Foreign.C.Types ( CInt )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++-- | Enter the GLUT event processing loop; it will call as necessary any+-- callbacks that have been registered. This routine should be called at most+-- once in a GLUT program.++mainLoop :: MonadIO m => m ()+mainLoop = glutMainLoop++--------------------------------------------------------------------------------++-- | (/freeglut only/) Process one iteration's worth of events in its event loop.+-- This allows the application to control its own event loop and still use the+-- GLUT package.++mainLoopEvent :: MonadIO m => m ()+mainLoopEvent = glutMainLoopEvent++--------------------------------------------------------------------------------++-- | (/freeglut only/) Stop the event loop. If 'actionOnWindowClose' contains+-- 'Exit', the application will exit; otherwise control will return to the+-- function which called 'mainLoop'.+--+-- If the application has two nested calls to 'mainLoop' and calls+-- 'leaveMainLoop', the behaviour is undefined. It may leave only the inner+-- nested loop or it may leave both loops. If the reader has a strong preference+-- for one behaviour over the other he should contact the freeglut Programming+-- Consortium and ask for the code to be fixed.++leaveMainLoop :: MonadIO m => m ()+leaveMainLoop = glutLeaveMainLoop++--------------------------------------------------------------------------------++-- | The behaviour when the user closes a window.++data ActionOnWindowClose+   = -- | Exit the whole program when any window is closed or 'leaveMainLoop'+     -- is called (default).+     Exit+   | -- | Return from mainLoop when any window is closed.+     MainLoopReturns+   | -- | Return from mainLoop after the last window is closed.+     ContinueExecution+   deriving ( Eq, Ord, Show )++marshalActionOnWindowClose :: ActionOnWindowClose -> CInt+marshalActionOnWindowClose x = case x of+   Exit ->  glut_ACTION_EXIT+   MainLoopReturns -> glut_ACTION_GLUTMAINLOOP_RETURNS+   ContinueExecution -> glut_ACTION_CONTINUE_EXECUTION++unmarshalActionOnWindowClose :: CInt -> ActionOnWindowClose+unmarshalActionOnWindowClose x+   | x == glut_ACTION_EXIT = Exit+   | x == glut_ACTION_GLUTMAINLOOP_RETURNS = MainLoopReturns+   | x == glut_ACTION_CONTINUE_EXECUTION = ContinueExecution+   | otherwise = error ("unmarshalActionOnWindowClose: illegal value " ++ show x)++-----------------------------------------------------------------------------++-- | (/freeglut only/) Controls the behaviour when the user closes a window.++actionOnWindowClose :: StateVar ActionOnWindowClose+actionOnWindowClose =+   makeStateVar+      (simpleGet unmarshalActionOnWindowClose glut_ACTION_ON_WINDOW_CLOSE)+      (glutSetOption glut_ACTION_ON_WINDOW_CLOSE . marshalActionOnWindowClose)
+ src/Graphics/UI/GLUT/Callbacks.hs view
@@ -0,0 +1,47 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Callbacks+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+--+-- GLUT supports a number of callbacks to respond to events. There are three+-- types of callbacks: window, menu, and global. Window callbacks indicate when+-- to redisplay or reshape a window, when the visibility of the window changes,+-- and when input is available for the window. Menu callbacks are described in+-- "Graphics.UI.GLUT.Menu". The global callbacks manage the passing of time and+-- menu usage. The calling order of callbacks between different windows is+-- undefined.+--+-- Callbacks for input events should be delivered to the window the event occurs+-- in. Events should not propagate to parent windows.+--+-- A callback of type @Foo@ can registered by setting @fooCallback@ to 'Just'+-- the callback. Almost all callbacks can be de-registered by setting+-- the corresponding @fooCallback@ to 'Nothing', the only exceptions being+-- 'Graphics.UI.GLUT.Callbacks.Window.DisplayCallback' (can only be+-- re-registered) and 'Graphics.UI.GLUT.Callbacks.Global.TimerCallback' (can\'t+-- be unregistered).+--+-- /X Implementation Notes:/ The X GLUT implementation uses the X Input+-- extension to support sophisticated input devices: Spaceball, dial & button+-- box, and digitizing tablet. Because the X Input extension  does not mandate+-- how particular types of devices are advertised through the extension, it is+-- possible GLUT for X may not correctly support input devices that would+-- otherwise be of the correct type. The X GLUT implementation will support the+-- Silicon Graphics Spaceball, dial & button box, and digitizing tablet as+-- advertised through the X Input extension.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Callbacks (+   module Graphics.UI.GLUT.Callbacks.Window,+   module Graphics.UI.GLUT.Callbacks.Global+) where++import Graphics.UI.GLUT.Callbacks.Window+import Graphics.UI.GLUT.Callbacks.Global
+ src/Graphics/UI/GLUT/Callbacks/Global.hs view
@@ -0,0 +1,114 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Callbacks.Global+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Callbacks.Global (+   -- * Menu status callback+   MenuUsage(..), MenuStatusCallback, menuStatusCallback,++   -- * Idle callback+   IdleCallback, idleCallback,++   -- * Timer callbacks+   Timeout, TimerCallback, addTimerCallback+) where++import Control.Monad.Fix ( mfix )+import Data.StateVar ( SettableStateVar, makeSettableStateVar )+import Foreign.C.Types ( CInt )+import Graphics.Rendering.OpenGL ( Position(..) )++import Graphics.UI.GLUT.Callbacks.Registration+import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++data MenuUsage+   = NotInUse+   | InUse+   deriving ( Eq, Ord, Show )++unmarshalMenuUsage :: CInt -> MenuUsage+unmarshalMenuUsage x+   | x == glut_MENU_NOT_IN_USE = NotInUse+   | x == glut_MENU_IN_USE = InUse+   | otherwise = error ("unmarshalMenuUsage: illegal value " ++ show x)++type MenuStatusCallback  = MenuUsage -> Position -> IO ()++-- | Controls the global menu status callback so a GLUT program can determine+-- when a menu is in use or not. When a menu status callback is registered, it+-- will be called with the value 'InUse' when pop-up menus are in use by the+-- user; and the callback will be called with the value 'NotInUse' when pop-up+-- menus are no longer in use. Additionally, the location in window coordinates+-- of the button press that caused the menu to go into use, or the location where+-- the menu was released (maybe outside the window). Other callbacks continue to+-- operate (except mouse motion callbacks) when pop-up menus are in use so the+-- menu status callback allows a program to suspend animation or other tasks+-- when menus are in use. The cascading and unmapping of sub-menus from an+-- initial pop-up menu does not generate menu status callbacks. There is a+-- single menu status callback for GLUT.+--+-- When the menu status callback is called, the /current menu/ will be set to+-- the initial pop-up menu in both the 'InUse' and 'NotInUse' cases. The+-- /current window/ will be set to the window from which the initial menu was+-- popped up from, also in both cases.++menuStatusCallback :: SettableStateVar (Maybe MenuStatusCallback)+menuStatusCallback =+   makeSettableStateVar $+      setCallback MenuStatusCB glutMenuStatusFunc+                  (makeMenuStatusFunc . unmarshal)+   where unmarshal cb s x y =+            cb (unmarshalMenuUsage s)+               (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++type IdleCallback = IO ()++-- | Controls the global idle callback so a GLUT program can perform background+-- processing tasks or continuous animation when window system events are not+-- being received. If enabled, the idle callback is continuously called when+-- events are not being received. The /current window/ and /current menu/ will+-- not be changed before the idle callback. Programs with multiple windows+-- and\/or menus should explicitly set the /current window/ and\/or /current+-- menu/ and not rely on its current setting.+--+-- The amount of computation and rendering done in an idle callback should be+-- minimized to avoid affecting the program\'s interactive response. In general,+-- not more than a single frame of rendering should be done in an idle callback.++idleCallback :: SettableStateVar (Maybe IdleCallback)+idleCallback =+   makeSettableStateVar $ setCallback IdleCB glutIdleFunc makeIdleFunc++--------------------------------------------------------------------------------++-- | Timeout for the timer callback in milliseconds+type Timeout = Int++type TimerCallback  = IO ()++-- | Register a one-shot timer callback to be triggered after at least the given+-- amount of time. Multiple timer callbacks at same or differing times may be+-- registered simultaneously. There is no support for canceling a registered+-- callback.+--+-- The number of milliseconds is a lower bound on the time before the callback+-- is generated. GLUT attempts to deliver the timer callback as soon as possible+-- after the expiration of the callback\'s time interval.++addTimerCallback :: Timeout -> TimerCallback -> IO ()+addTimerCallback msecs timerCallback = do+   funPtr <- mfix (\self -> makeTimerFunc (\_ -> do registerForCleanup self+                                                    timerCallback))+   glutTimerFunc (fromIntegral msecs) funPtr 0
+ src/Graphics/UI/GLUT/Callbacks/Registration.hs view
@@ -0,0 +1,163 @@+{-# OPTIONS_GHC -fno-cse #-}++{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Callbacks.Registration+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Callbacks.Registration (+   CallbackType(..), registerForCleanup, setCallback, getCurrentWindow+) where++--------------------------------------------------------------------------------++import Control.Monad ( when )+import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef )+import qualified Data.Map as M+import Data.StateVar ( get )+import Foreign.Ptr ( FunPtr, nullFunPtr, freeHaskellFunPtr )+import System.IO.Unsafe ( unsafePerformIO )++import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Window++--------------------------------------------------------------------------------+-- No timer callback here, because they are one-shot and "self destroy"++data CallbackType+   = DisplayCB         | OverlayDisplayCB  | ReshapeCB+   | KeyboardCB        | KeyboardUpCB      | MouseCB+   | MotionCB          | PassiveMotionCB   | CrossingCB+   | VisibilityCB      | WindowStatusCB    | SpecialCB+   | SpecialUpCB       | SpaceballMotionCB | SpaceballRotateCB+   | SpaceballButtonCB | ButtonBoxCB       | DialsCB+   | TabletMotionCB    | TabletButtonCB    | JoystickCB+   | MenuStatusCB      | IdleCB+   -- freeglut-only callback types+   | CloseCB           | MouseWheelCB      | PositionCB+   | MultiEntryCB      | MultiMotionCB     | MultiButtonCB+   | MultiPassiveCB    | InitContextCB     | AppStatusCB+   deriving ( Eq, Ord )++isGlobal :: CallbackType -> Bool+isGlobal MenuStatusCB = True+isGlobal IdleCB       = True+isGlobal _            = False++--------------------------------------------------------------------------------+-- To uniquely identify a particular callback, the associated window is needed+-- for window callbacks.++data CallbackID = CallbackID (Maybe Window) CallbackType+   deriving ( Eq, Ord )++getCallbackID :: CallbackType -> IO CallbackID+getCallbackID callbackType = do+   maybeWindow <- if isGlobal callbackType+                     then return Nothing+                     else fmap Just $ getCurrentWindow "getCallbackID"+   return $ CallbackID maybeWindow callbackType++getCurrentWindow :: String -> IO Window+getCurrentWindow func = do+   win <- get currentWindow+   maybe (error (func ++ ": no current window")) return win++--------------------------------------------------------------------------------+-- This seems to be a common Haskell hack nowadays: A plain old global variable+-- with an associated mutator. Perhaps some language/library support is needed?++{-# NOINLINE theCallbackTable #-}+theCallbackTable :: IORef (CallbackTable a)+theCallbackTable = unsafePerformIO (newIORef emptyCallbackTable)++getCallbackTable :: IO (CallbackTable a)+getCallbackTable = readIORef theCallbackTable++modifyCallbackTable :: (CallbackTable a -> CallbackTable a) -> IO ()+modifyCallbackTable = modifyIORef theCallbackTable++--------------------------------------------------------------------------------++type CallbackTable a = M.Map CallbackID (FunPtr a)++emptyCallbackTable :: CallbackTable a+emptyCallbackTable = M.empty++lookupInCallbackTable :: CallbackID -> IO (Maybe (FunPtr a))+lookupInCallbackTable callbackID =+   fmap (M.lookup callbackID) getCallbackTable++deleteFromCallbackTable :: CallbackID -> IO ()+deleteFromCallbackTable callbackID =+   modifyCallbackTable (M.delete callbackID)++addToCallbackTable :: CallbackID -> FunPtr a -> IO ()+addToCallbackTable callbackID funPtr =+   modifyCallbackTable (M.insert callbackID funPtr)++--------------------------------------------------------------------------------+-- Another global mutable variable: The list of function pointers ready to be+-- freed by freeHaskellFunPtr++{-# NOINLINE theCleanupList #-}+theCleanupList :: IORef [FunPtr a]+theCleanupList = unsafePerformIO (newIORef [])++getCleanupList :: IO [FunPtr a]+getCleanupList = readIORef theCleanupList++setCleanupList :: [FunPtr a] -> IO ()+setCleanupList = writeIORef theCleanupList++--------------------------------------------------------------------------------+-- And yet another mutable (write-once) variable: A function pointer to a+-- callback which frees all function pointers on the cleanup list.++{-# NOINLINE theScavenger #-}+theScavenger :: IORef (FunPtr TimerFunc)+theScavenger = unsafePerformIO (newIORef =<< makeTimerFunc (\_ -> do+   cleanupList <- getCleanupList+   mapM_ freeHaskellFunPtr cleanupList+   setCleanupList []))++getScavenger :: IO (FunPtr TimerFunc)+getScavenger = readIORef theScavenger++--------------------------------------------------------------------------------+-- Here is the really cunning stuff: If an element is added to the cleanup list+-- when it is empty, register an immediate callback at GLUT to free the list as+-- soon as possible.++registerForCleanup :: FunPtr a -> IO ()+registerForCleanup funPtr = do+   oldCleanupList <- getCleanupList+   setCleanupList (funPtr : oldCleanupList)+   when (null oldCleanupList) $ do+        scavenger <- getScavenger+        glutTimerFunc 0 scavenger 0++--------------------------------------------------------------------------------++setCallback :: CallbackType -> (FunPtr a -> IO ()) -> (b -> IO (FunPtr a))+            -> Maybe b -> IO ()+setCallback callbackType registerAtGLUT makeCallback maybeCallback = do+   callbackID <- getCallbackID callbackType+   maybeOldFunPtr <- lookupInCallbackTable callbackID+   case maybeOldFunPtr of+      Nothing -> return ()+      Just oldFunPtr -> do registerForCleanup oldFunPtr+                           deleteFromCallbackTable callbackID+   case maybeCallback of+      Nothing -> registerAtGLUT nullFunPtr+      Just callback -> do newFunPtr <- makeCallback callback+                          addToCallbackTable callbackID newFunPtr+                          registerAtGLUT newFunPtr
+ src/Graphics/UI/GLUT/Callbacks/Window.hs view
@@ -0,0 +1,993 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Callbacks.Window+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Callbacks.Window (+   -- * Redisplay callbacks+   DisplayCallback, displayCallback, overlayDisplayCallback,++   -- * Reshape callback+   ReshapeCallback, reshapeCallback,++   -- * Position callback+   PositionCallback, positionCallback,++   -- * Callbacks for visibility changes+   Visibility(..), VisibilityCallback, visibilityCallback,+   WindowState(..), WindowStateCallback, windowStateCallback,++   -- * Window close callback+   CloseCallback, closeCallback,++   -- * Life cycle callbacks for mobile platforms+   InitContextCallback, initContextCallback,+   AppStatus(..), AppStatusCallback, appStatusCallback,++   -- * Keyboard callback+   KeyboardCallback, keyboardCallback, keyboardUpCallback,++   -- * Special callback+   SpecialCallback, specialCallback, specialUpCallback,++   -- * Mouse callback+   MouseCallback, mouseCallback,++   -- * Keyboard and mouse input callback+   Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..),+   KeyboardMouseCallback, keyboardMouseCallback,++   -- * Mouse wheel callback+   WheelNumber, WheelDirection, MouseWheelCallback, mouseWheelCallback,++   -- * Mouse movement callbacks+   MotionCallback, motionCallback, passiveMotionCallback,+   Crossing(..), CrossingCallback, crossingCallback,++   -- * Spaceball callback+   SpaceballMotion, SpaceballRotation, ButtonIndex, SpaceballInput(..),+   SpaceballCallback, spaceballCallback,++   -- * Dial & button box callback+   DialAndButtonBoxInput(..), DialIndex,+   DialAndButtonBoxCallback, dialAndButtonBoxCallback,++   -- * Tablet callback+   TabletPosition(..), TabletInput(..), TabletCallback, tabletCallback,++   -- * Joystick callback+   JoystickButtons(..), JoystickPosition(..),+   JoystickCallback, joystickCallback,++   -- * Multi-touch support+   TouchID,+   MultiMouseCallback, multiMouseCallback,+   MultiCrossingCallback, multiCrossingCallback,+   MultiMotionCallback, multiMotionCallback, multiPassiveMotionCallback++) where++import Data.Bits ( (.&.) )+import Data.Char ( chr )+import Data.Maybe ( fromJust )+import Data.StateVar ( SettableStateVar, makeSettableStateVar )+import Foreign.C.Types ( CInt, CUInt )+import Graphics.Rendering.OpenGL ( Position(..), Size(..) )++import Graphics.UI.GLUT.Callbacks.Registration+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.State+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | A display callback++type DisplayCallback = IO ()++-- | Controls the display callback for the /current window./ When GLUT determines+-- that the normal plane for the window needs to be redisplayed, the display+-- callback for the window is called. Before the callback, the /current window/+-- is set to the window needing to be redisplayed and (if no overlay display+-- callback is registered) the /layer in use/ is set to the normal plane. The+-- entire normal plane region should be redisplayed in response to the callback+-- (this includes ancillary buffers if your program depends on their state).+--+-- GLUT determines when the display callback should be triggered based on the+-- window\'s redisplay state. The redisplay state for a window can be either set+-- explicitly by calling 'Graphics.UI.GLUT.Window.postRedisplay' or implicitly+-- as the result of window damage reported by the window system. Multiple posted+-- redisplays for a window are coalesced by GLUT to minimize the number of+-- display callbacks called.+--+-- When an overlay is established for a window, but there is no overlay display+-- callback registered, the display callback is used for redisplaying both the+-- overlay and normal plane (that is, it will be called if either the redisplay+-- state or overlay redisplay state is set). In this case, the /layer in use/ is+-- not implicitly changed on entry to the display callback.+--+-- See 'overlayDisplayCallback' to understand how distinct callbacks for the+-- overlay and normal plane of a window may be established.+--+-- When a window is created, no display callback exists for the window. It is+-- the responsibility of the programmer to install a display callback for the+-- window before the window is shown. A display callback must be registered for+-- any window that is shown. If a window becomes displayed without a display+-- callback being registered, a fatal error occurs. There is no way to+-- \"deregister\" a display callback (though another callback routine can always+-- be registered).+--+-- Upon return from the display callback, the normal damaged state of the window+-- (see 'Graphics.UI.GLUT.State.damaged') is cleared. If there is no overlay+-- display callback registered the overlay damaged state of the window (see+-- 'Graphics.UI.GLUT.State.damaged') is also cleared.++displayCallback :: SettableStateVar DisplayCallback+displayCallback = makeSettableStateVar $+   setCallback DisplayCB glutDisplayFunc makeDisplayFunc . Just++--------------------------------------------------------------------------------++-- | Controls the overlay display callback for the /current window./ The overlay+-- display callback is functionally the same as the window\'s display callback+-- except that the overlay display callback is used to redisplay the window\'s+-- overlay.+--+-- When GLUT determines that the overlay plane for the window needs to be+-- redisplayed, the overlay display callback for the window is called. Before+-- the callback, the /current window/ is set to the window needing to be+-- redisplayed and the /layer in use/ is set to the overlay. The entire overlay+-- region should be redisplayed in response to the callback (this includes+-- ancillary buffers if your program depends on their state).+--+-- GLUT determines when the overlay display callback should be triggered based+-- on the window\'s overlay redisplay state. The overlay redisplay state for a+-- window can be either set explicitly by calling+-- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' or implicitly as the result+-- of window damage reported by the window system. Multiple posted overlay+-- redisplays for a window are coalesced by GLUT to minimize the number of+-- overlay display callbacks called.+--+-- Upon return from the overlay display callback, the overlay damaged state of+-- the window (see 'Graphics.UI.GLUT.State.damaged') is cleared.+--+-- Initially there is no overlay display callback registered when an overlay is+-- established. See 'displayCallback' to understand how the display callback+-- alone is used if an overlay display callback is not registered.++overlayDisplayCallback :: SettableStateVar (Maybe DisplayCallback)+overlayDisplayCallback = makeSettableStateVar $+   setCallback OverlayDisplayCB glutOverlayDisplayFunc makeOverlayDisplayFunc++--------------------------------------------------------------------------------++-- | A reshape callback++type ReshapeCallback = Size -> IO ()++-- | Controls the reshape callback for the /current window./ The reshape callback+-- is triggered when a window is reshaped. A reshape callback is also triggered+-- immediately before a window\'s first display callback after a window is+-- created or whenever an overlay for the window is established. The parameter+-- of the callback specifies the new window size in pixels. Before the callback,+-- the /current window/ is set to the window that has been reshaped.+--+-- If a reshape callback is not registered for a window or 'reshapeCallback' is+-- set to 'Nothing' (to deregister a previously registered callback), the+-- default reshape callback is used. This default callback will simply call+--+-- @+-- 'Graphics.Rendering.OpenGL.GL.CoordTrans.viewport' ('Graphics.Rendering.OpenGL.GL.CoordTrans.Position' 0 0) ('Graphics.Rendering.OpenGL.GL.CoordTrans.Size' /width/ /height/)+-- @+--+-- on the normal plane (and on the overlay if one exists).+--+-- If an overlay is established for the window, a single reshape callback is+-- generated. It is the callback\'s responsibility to update both the normal+-- plane and overlay for the window (changing the layer in use as necessary).+--+-- When a top-level window is reshaped, subwindows are not reshaped. It is up to+-- the GLUT program to manage the size and positions of subwindows within a+-- top-level window. Still, reshape callbacks will be triggered for subwindows+-- when their size is changed using 'Graphics.UI.GLUT.Window.windowSize'.++reshapeCallback :: SettableStateVar (Maybe ReshapeCallback)+reshapeCallback = makeSettableStateVar $+   setCallback ReshapeCB glutReshapeFunc (makeReshapeFunc . unmarshal)+   where unmarshal cb w h = cb (Size (fromIntegral w) (fromIntegral h))++--------------------------------------------------------------------------------++-- | A position callback++type PositionCallback = Position -> IO ()++-- | (/freeglut only/) Controls the position callback for the /current window./+-- The position callback for a window is called when the position of a window+-- changes.++positionCallback :: SettableStateVar (Maybe PositionCallback)+positionCallback = makeSettableStateVar $+   setCallback PositionCB glutPositionFunc (makePositionFunc . unmarshal)+   where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++-- | The visibility state of the /current window/++data Visibility+   = NotVisible -- ^ No part of the /current window/ is visible, i.e., until the+                --   window\'s visibility changes, all further rendering to the+                --   window is discarded.+   | Visible    -- ^ The /current window/ is totally or partially visible. GLUT+                --   considers a window visible if any pixel of the window is+                --   visible or any pixel of any descendant window is visible on+                --   the screen.+   deriving ( Eq, Ord, Show )++unmarshalVisibility :: CInt -> Visibility+unmarshalVisibility x+   | x == glut_NOT_VISIBLE = NotVisible+   | x == glut_VISIBLE = Visible+   | otherwise = error ("unmarshalVisibility: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | A visibility callback++type VisibilityCallback = Visibility -> IO ()++-- | Controls the visibility callback for the /current window./ The visibility+-- callback for a window is called when the visibility of a window changes.+--+-- If the visibility callback for a window is disabled and later re-enabled, the+-- visibility status of the window is undefined; any change in window visibility+-- will be reported, that is if you disable a visibility callback and re-enable+-- the callback, you are guaranteed the next visibility change will be reported.+--+-- Note that you can either use 'visibilityCallback' or 'windowStateCallback',+-- but not both, because the former is implemented via the latter.++visibilityCallback :: SettableStateVar (Maybe VisibilityCallback)+visibilityCallback = makeSettableStateVar $+   setCallback VisibilityCB glutVisibilityFunc+               (makeVisibilityFunc . unmarshal)+   where unmarshal cb  = cb . unmarshalVisibility++--------------------------------------------------------------------------------++-- | The window state of the /current window/++data WindowState+   = Unmapped          -- ^ The /current window/ is unmapped.+   | FullyRetained     -- ^ The /current window/ is unobscured.+   | PartiallyRetained -- ^ The /current window/ is partially obscured.+   | FullyCovered      -- ^ The /current window/ is fully obscured.+   deriving ( Eq, Ord, Show )++unmarshalWindowState :: CInt -> WindowState+unmarshalWindowState x+   | x == glut_HIDDEN = Unmapped+   | x == glut_FULLY_RETAINED = FullyRetained+   | x == glut_PARTIALLY_RETAINED = PartiallyRetained+   | x == glut_FULLY_COVERED = FullyCovered+   | otherwise = error ("unmarshalWindowState: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | A window state callback++type WindowStateCallback = WindowState -> IO ()++-- | Controls the window state callback for the+-- /current window./ The window state callback for a window is called when the+-- window state of a window changes.+--+-- If the window state callback for a window is disabled and later re-enabled,+-- the window state state of the window is undefined; any change in the window+-- state will be reported, that is if you disable a window state callback and+-- re-enable the callback, you are guaranteed the next window state change will+-- be reported.+--+-- Note that you can either use 'visibilityCallback' or 'windowStateCallback',+-- but not both, because the former is implemented via the latter.++windowStateCallback :: SettableStateVar (Maybe WindowStateCallback)+windowStateCallback = makeSettableStateVar $+   setCallback WindowStatusCB glutWindowStatusFunc+               (makeWindowStatusFunc . unmarshal)+   where unmarshal cb  = cb . unmarshalWindowState++--------------------------------------------------------------------------------++-- | A window close callback++type CloseCallback = IO ()++-- | Controls the window close callback for the /current window/.++closeCallback :: SettableStateVar (Maybe CloseCallback)+closeCallback = makeSettableStateVar $+   setCallback CloseCB glutCloseFunc makeCloseFunc++--------------------------------------------------------------------------------++-- | An initialize context callback++type InitContextCallback = IO ()++-- | (/freeglut only/) Controls the initialize context callback for the /current+-- window/.++initContextCallback :: SettableStateVar (Maybe InitContextCallback)+initContextCallback = makeSettableStateVar $+   setCallback InitContextCB glutInitContextFunc makeInitContextFunc++--------------------------------------------------------------------------------++-- | The application status of the /current window/++data AppStatus+   = AppStatusPause+   | AppStatusResume+   deriving ( Eq, Ord, Show )++unmarshalAppStatus :: CInt -> AppStatus+unmarshalAppStatus x+   | x == glut_APPSTATUS_PAUSE = AppStatusPause+   | x == glut_APPSTATUS_RESUME = AppStatusResume+   | otherwise = error ("unmarshalAppStatus: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | An application status callback++type AppStatusCallback = AppStatus -> IO ()++-- | Controls the application status callback for the /current window./++appStatusCallback :: SettableStateVar (Maybe AppStatusCallback)+appStatusCallback = makeSettableStateVar $+   setCallback AppStatusCB glutAppStatusFunc+               (makeAppStatusFunc . unmarshal)+   where unmarshal cb  = cb . unmarshalAppStatus++--------------------------------------------------------------------------------++-- | A keyboard callback++type KeyboardCallback = Char -> Position -> IO ()++setKeyboardCallback :: Maybe KeyboardCallback -> IO ()+setKeyboardCallback =+   setCallback KeyboardCB glutKeyboardFunc (makeKeyboardFunc . unmarshal)+   where unmarshal cb c x y = cb (chr (fromIntegral c))+                                 (Position (fromIntegral x) (fromIntegral y))++-- | Controls the keyboard callback for the /current window/. This is+-- activated only when a key is pressed.++keyboardCallback :: SettableStateVar (Maybe KeyboardCallback)+keyboardCallback = makeSettableStateVar setKeyboardCallback++--------------------------------------------------------------------------------++setKeyboardUpCallback :: Maybe KeyboardCallback -> IO ()+setKeyboardUpCallback =+   setCallback KeyboardUpCB glutKeyboardUpFunc+               (makeKeyboardUpFunc . unmarshal)+   where unmarshal cb c x y = cb (chr (fromIntegral c))+                                 (Position (fromIntegral x) (fromIntegral y))++-- | Controls the keyboard callback for the /current window/. This is+-- activated only when a key is released.++keyboardUpCallback :: SettableStateVar (Maybe KeyboardCallback)+keyboardUpCallback = makeSettableStateVar setKeyboardUpCallback++--------------------------------------------------------------------------------++-- | Special keys++data SpecialKey+   = KeyF1+   | KeyF2+   | KeyF3+   | KeyF4+   | KeyF5+   | KeyF6+   | KeyF7+   | KeyF8+   | KeyF9+   | KeyF10+   | KeyF11+   | KeyF12+   | KeyLeft+   | KeyUp+   | KeyRight+   | KeyDown+   | KeyPageUp+   | KeyPageDown+   | KeyHome+   | KeyEnd+   | KeyInsert+   | KeyNumLock+   | KeyBegin+   | KeyDelete+   | KeyShiftL+   | KeyShiftR+   | KeyCtrlL+   | KeyCtrlR+   | KeyAltL+   | KeyAltR+   | KeyUnknown Int -- ^ You should actually never encounter this value, it is+                    -- just here as a safeguard against future changes in the+                    -- native GLUT library.+   deriving ( Eq, Ord, Show )++unmarshalSpecialKey :: CInt -> SpecialKey+unmarshalSpecialKey x+   | x == glut_KEY_F1 = KeyF1+   | x == glut_KEY_F2 = KeyF2+   | x == glut_KEY_F3 = KeyF3+   | x == glut_KEY_F4 = KeyF4+   | x == glut_KEY_F5 = KeyF5+   | x == glut_KEY_F6 = KeyF6+   | x == glut_KEY_F7 = KeyF7+   | x == glut_KEY_F8 = KeyF8+   | x == glut_KEY_F9 = KeyF9+   | x == glut_KEY_F10 = KeyF10+   | x == glut_KEY_F11 = KeyF11+   | x == glut_KEY_F12 = KeyF12+   | x == glut_KEY_LEFT = KeyLeft+   | x == glut_KEY_UP = KeyUp+   | x == glut_KEY_RIGHT = KeyRight+   | x == glut_KEY_DOWN = KeyDown+   | x == glut_KEY_PAGE_UP = KeyPageUp+   | x == glut_KEY_PAGE_DOWN = KeyPageDown+   | x == glut_KEY_HOME = KeyHome+   | x == glut_KEY_END = KeyEnd+   | x == glut_KEY_INSERT = KeyInsert+   | x == glut_KEY_NUM_LOCK = KeyNumLock+   | x == glut_KEY_BEGIN = KeyBegin+   | x == glut_KEY_DELETE = KeyDelete+   | x == glut_KEY_SHIFT_L = KeyShiftL+   | x == glut_KEY_SHIFT_R = KeyShiftR+   | x == glut_KEY_CTRL_L = KeyCtrlL+   | x == glut_KEY_CTRL_R = KeyCtrlR+   | x == glut_KEY_ALT_L = KeyAltL+   | x == glut_KEY_ALT_R = KeyAltR+   | otherwise = KeyUnknown (fromIntegral x)++--------------------------------------------------------------------------------++-- | A special key callback++type SpecialCallback = SpecialKey -> Position -> IO ()++setSpecialCallback :: Maybe SpecialCallback -> IO ()+setSpecialCallback =+   setCallback SpecialCB glutSpecialFunc (makeSpecialFunc . unmarshal)+   where unmarshal cb k x y = cb (unmarshalSpecialKey k)+                                 (Position (fromIntegral x) (fromIntegral y))++-- | Controls the special key callback for the /current window/. This is+-- activated only when a special key is pressed.++specialCallback :: SettableStateVar (Maybe SpecialCallback)+specialCallback = makeSettableStateVar setSpecialCallback++--------------------------------------------------------------------------------++setSpecialUpCallback :: Maybe SpecialCallback -> IO ()+setSpecialUpCallback =+   setCallback SpecialUpCB glutSpecialUpFunc (makeSpecialUpFunc . unmarshal)+   where unmarshal cb k x y = cb (unmarshalSpecialKey k)+                                 (Position (fromIntegral x) (fromIntegral y))++-- | Controls the special key callback for the /current window/. This is+-- activated only when a special key is released.++specialUpCallback :: SettableStateVar (Maybe SpecialCallback)+specialUpCallback = makeSettableStateVar setSpecialUpCallback++--------------------------------------------------------------------------------++-- | The current state of a key or button++data KeyState+   = Down+   | Up+   deriving ( Eq, Ord, Show )++unmarshalKeyState :: CInt -> KeyState+unmarshalKeyState x+   | x == glut_DOWN = Down+   | x == glut_UP = Up+   | otherwise = error ("unmarshalKeyState: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | A mouse callback++type MouseCallback = MouseButton -> KeyState -> Position -> IO ()++setMouseCallback :: Maybe MouseCallback -> IO ()+setMouseCallback =+   setCallback MouseCB glutMouseFunc (makeMouseFunc . unmarshal)+   where unmarshal cb b s x y = cb (unmarshalMouseButton b)+                                   (unmarshalKeyState s)+                                   (Position (fromIntegral x) (fromIntegral y))++-- | Controls the mouse callback for the /current window/.++mouseCallback :: SettableStateVar (Maybe MouseCallback)+mouseCallback = makeSettableStateVar setMouseCallback++--------------------------------------------------------------------------------++-- | The state of the keyboard modifiers++data Modifiers = Modifiers { shift, ctrl, alt :: KeyState }+   deriving ( Eq, Ord, Show )++-- Could use fromBitfield + Enum/Bounded instances + marshalModifier instead...+unmarshalModifiers :: CInt -> Modifiers+unmarshalModifiers m = Modifiers {+   shift = if (m .&. glut_ACTIVE_SHIFT) /= 0 then Down else Up,+   ctrl  = if (m .&. glut_ACTIVE_CTRL ) /= 0 then Down else Up,+   alt   = if (m .&. glut_ACTIVE_ALT  ) /= 0 then Down else Up }++getModifiers :: IO Modifiers+getModifiers = fmap unmarshalModifiers glutGetModifiers++--------------------------------------------------------------------------------++-- | A generalized view of keys++data Key+   = Char Char+   | SpecialKey SpecialKey+   | MouseButton MouseButton+   deriving ( Eq, Ord, Show )++-- | A keyboard\/mouse callback++type KeyboardMouseCallback =+   Key -> KeyState -> Modifiers -> Position -> IO ()++-- | Controls the keyboard\/mouse callback for the /current window./ The+-- keyboard\/mouse callback for a window is called when the state of a key or+-- mouse button changes. The callback parameters indicate the new state of the+-- key\/button, the state of the keyboard modifiers, and the mouse location in+-- window relative coordinates.+--+-- Note that this is a convenience function that should not ordinarily be used+-- in conjunction with `keyboardCallback`, `keyboardUpCallback`,+-- `specialCallback`, `specialUpCallback`, or `mouseCallback`.++keyboardMouseCallback :: SettableStateVar (Maybe KeyboardMouseCallback)+keyboardMouseCallback = makeSettableStateVar setKeyboardMouseCallback++setKeyboardMouseCallback :: Maybe KeyboardMouseCallback -> IO ()+setKeyboardMouseCallback Nothing = do+   setKeyboardCallback   Nothing+   setKeyboardUpCallback Nothing+   setSpecialCallback    Nothing+   setSpecialUpCallback  Nothing+   setMouseCallback      Nothing+setKeyboardMouseCallback (Just cb) = do+   setKeyboardCallback   (Just (\c   p -> do m <- getModifiers+                                             cb (Char        c) Down m p))+   setKeyboardUpCallback (Just (\c   p -> do m <- getModifiers+                                             cb (Char        c) Up   m p))+   setSpecialCallback    (Just (\s   p -> do m <- getModifiers+                                             cb (SpecialKey  s) Down m p))+   setSpecialUpCallback  (Just (\s   p -> do m <- getModifiers+                                             cb (SpecialKey  s) Up   m p))+   setMouseCallback      (Just (\b s p -> do m <- getModifiers+                                             cb (MouseButton b) s    m p))++--------------------------------------------------------------------------------++type WheelNumber = Int++type WheelDirection = Int++type MouseWheelCallback = WheelNumber -> WheelDirection -> Position -> IO ()++-- | (/freeglut only/) Controls the mouse wheel callback for the+-- /current window./ The mouse wheel callback for a window is called when a+-- mouse wheel is used and the wheel number is greater than or equal to+-- 'Graphics.UI.GLUT.State.numMouseButtons'.++mouseWheelCallback :: SettableStateVar (Maybe MouseWheelCallback)+mouseWheelCallback = makeSettableStateVar $+   setCallback MouseWheelCB glutMouseWheelFunc (makeMouseWheelFunc . unmarshal)+   where unmarshal cb n d x y = cb (fromIntegral n) (fromIntegral d)+                                   (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++-- | A motion callback++type MotionCallback = Position -> IO ()++-- | Controls the motion callback for the /current window./ The motion callback+-- for a window is called when the mouse moves within the window while one or+-- more mouse buttons are pressed. The callback parameter indicates the mouse+-- location in window relative coordinates.++motionCallback :: SettableStateVar (Maybe MotionCallback)+motionCallback = makeSettableStateVar $+   setCallback MotionCB glutMotionFunc (makeMotionFunc . unmarshal)+   where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++-- | Controls the passive motion callback for the /current window./ The passive+-- motion callback for a window is called when the mouse moves within the window+-- while /no/ mouse buttons are pressed. The callback parameter indicates the+-- mouse location in window relative coordinates.++passiveMotionCallback :: SettableStateVar (Maybe MotionCallback)+passiveMotionCallback = makeSettableStateVar $+   setCallback PassiveMotionCB glutPassiveMotionFunc+               (makePassiveMotionFunc . unmarshal)+   where unmarshal cb x y = cb (Position (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++-- | The relation between the mouse pointer and the /current window/ has+-- changed.++data Crossing+   = WindowLeft    -- ^ The mouse pointer has left the /current window./+   | WindowEntered -- ^ The mouse pointer has entered the /current window./+   deriving ( Eq, Ord, Show )++unmarshalCrossing :: CInt -> Crossing+unmarshalCrossing x+   | x == glut_LEFT = WindowLeft+   | x == glut_ENTERED = WindowEntered+   | otherwise = error ("unmarshalCrossing: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | An enter\/leave callback++type CrossingCallback = Crossing -> IO ()++-- | Controls the mouse enter\/leave callback for the /current window./ Note+-- that some window systems may not generate accurate enter\/leave callbacks.+--+-- /X Implementation Notes:/ An X implementation of GLUT should generate+-- accurate enter\/leave callbacks.++crossingCallback :: SettableStateVar (Maybe CrossingCallback)+crossingCallback = makeSettableStateVar $+   setCallback CrossingCB glutEntryFunc (makeEntryFunc . unmarshal)+   where unmarshal cb = cb . unmarshalCrossing++--------------------------------------------------------------------------------++-- | Translation of the Spaceball along one axis, normalized to be in the range+-- of -1000 to +1000 inclusive++type SpaceballMotion = Int++-- | Rotation of the Spaceball along one axis, normalized to be in the range+-- of -1800 .. +1800 inclusive++type SpaceballRotation = Int++-- | The index of a specific buttons of an input device.++type ButtonIndex = Int++-- | The state of the Spaceball has changed.++data SpaceballInput+   = SpaceballMotion   SpaceballMotion SpaceballMotion SpaceballMotion+   | SpaceballRotation SpaceballRotation SpaceballRotation SpaceballRotation+   | SpaceballButton   ButtonIndex KeyState+   deriving ( Eq, Ord, Show )++-- | A SpaceballButton callback++type SpaceballCallback = SpaceballInput -> IO ()++-- | Controls the Spaceball callback for the /current window./ The Spaceball+-- callback for a window is called when the window has Spaceball input focus+-- (normally, when the mouse is in the window) and the user generates Spaceball+-- translations, rotations, or button presses. The number of available Spaceball+-- buttons can be determined with 'Graphics.UI.GLUT.State.numSpaceballButtons'.+--+-- Registering a Spaceball callback when a Spaceball device is not available has+-- no effect and is not an error. In this case, no Spaceball callbacks will be+-- generated.++spaceballCallback :: SettableStateVar (Maybe SpaceballCallback)+spaceballCallback = makeSettableStateVar setSpaceballCallback++setSpaceballCallback :: Maybe SpaceballCallback -> IO ()+setSpaceballCallback Nothing = do+   setSpaceballMotionCallback   Nothing+   setSpaceballRotationCallback Nothing+   setSpaceballButtonCallback   Nothing+setSpaceballCallback (Just cb) = do+   setSpaceballMotionCallback   (Just (\x y z -> cb (SpaceballMotion   x y z)))+   setSpaceballRotationCallback (Just (\x y z -> cb (SpaceballRotation x y z)))+   setSpaceballButtonCallback   (Just (\b s   -> cb (SpaceballButton   b s)))++--------------------------------------------------------------------------------++type SpaceballMotionCallback =+   SpaceballMotion -> SpaceballMotion -> SpaceballMotion -> IO ()++setSpaceballMotionCallback :: Maybe SpaceballMotionCallback -> IO ()+setSpaceballMotionCallback =+   setCallback SpaceballMotionCB glutSpaceballMotionFunc+               (makeSpaceballMotionFunc . unmarshal)+   where unmarshal cb x y z =+            cb (fromIntegral x) (fromIntegral y) (fromIntegral z)++--------------------------------------------------------------------------------++type SpaceballRotationCallback =+   SpaceballRotation -> SpaceballRotation -> SpaceballRotation -> IO ()++setSpaceballRotationCallback :: Maybe SpaceballRotationCallback -> IO ()+setSpaceballRotationCallback =+   setCallback SpaceballRotateCB glutSpaceballRotateFunc+               (makeSpaceballRotateFunc . unmarshal)+   where unmarshal cb x y z =+            cb (fromIntegral x) (fromIntegral y) (fromIntegral z)++--------------------------------------------------------------------------------++type SpaceballButtonCallback = ButtonIndex -> KeyState -> IO ()++setSpaceballButtonCallback :: Maybe SpaceballButtonCallback -> IO ()+setSpaceballButtonCallback =+   setCallback SpaceballButtonCB glutSpaceballButtonFunc+               (makeSpaceballButtonFunc . unmarshal)+   where unmarshal cb b s = cb (fromIntegral b) (unmarshalKeyState s)++--------------------------------------------------------------------------------++-- | The index of a specific dial of a dial and button box.++type DialIndex = Int++-- | The dial & button box state has changed.++data DialAndButtonBoxInput+   = DialAndButtonBoxButton ButtonIndex KeyState+   | DialAndButtonBoxDial   DialIndex Int+   deriving ( Eq, Ord, Show )++-- | A dial & button box callback++type DialAndButtonBoxCallback = DialAndButtonBoxInput -> IO ()++-- | Controls the dial & button box callback for the /current window./ The dial+-- & button box button callback for a window is called when the window has dial+-- & button box input focus (normally, when the mouse is in the window) and the+-- user generates dial & button box button presses or dial changes. The number+-- of available dial & button box buttons and dials can be determined with+-- 'Graphics.UI.GLUT.State.numDialsAndButtons'.+--+-- Registering a dial & button box callback when a dial & button box device is+-- not available is ineffectual and not an error. In this case, no dial & button+-- box button will be generated.++dialAndButtonBoxCallback :: SettableStateVar (Maybe DialAndButtonBoxCallback)+dialAndButtonBoxCallback = makeSettableStateVar setDialAndButtonBoxCallback++setDialAndButtonBoxCallback :: Maybe DialAndButtonBoxCallback -> IO ()+setDialAndButtonBoxCallback Nothing = do+   setButtonBoxCallback Nothing+   setDialsCallback     Nothing+setDialAndButtonBoxCallback (Just cb) = do+   setButtonBoxCallback (Just (\b s -> cb (DialAndButtonBoxButton b s)))+   setDialsCallback     (Just (\d x -> cb (DialAndButtonBoxDial   d x)))++--------------------------------------------------------------------------------++type ButtonBoxCallback = ButtonIndex -> KeyState -> IO ()++setButtonBoxCallback :: Maybe ButtonBoxCallback -> IO ()+setButtonBoxCallback =+   setCallback ButtonBoxCB glutButtonBoxFunc (makeButtonBoxFunc . unmarshal)+   where unmarshal cb b s = cb (fromIntegral b) (unmarshalKeyState s)++--------------------------------------------------------------------------------++type DialsCallback = DialIndex -> Int -> IO ()++setDialsCallback :: Maybe DialsCallback -> IO ()+setDialsCallback =+    setCallback DialsCB glutDialsFunc (makeDialsFunc . unmarshal)+    where unmarshal cb d x = cb (fromIntegral d) (fromIntegral x)++--------------------------------------------------------------------------------++-- | Absolute tablet position, with coordinates normalized to be in the range of+-- 0 to 2000 inclusive++data TabletPosition = TabletPosition Int Int+   deriving ( Eq, Ord, Show )++-- | The table state has changed.++data TabletInput+   = TabletMotion+   | TabletButton ButtonIndex KeyState+   deriving ( Eq, Ord, Show )++-- | A tablet callback++type TabletCallback = TabletInput -> TabletPosition -> IO ()++-- | Controls the tablet callback for the /current window./ The tablet callback+-- for a window is called when the window has tablet input focus (normally, when+-- the mouse is in the window) and the user generates tablet motion or button+-- presses. The number of available tablet buttons can be determined with+-- 'Graphics.UI.GLUT.State.numTabletButtons'.+--+-- Registering a tablet callback when a tablet device is not available is+-- ineffectual and not an error. In this case, no tablet callbacks will be+-- generated.++tabletCallback :: SettableStateVar (Maybe TabletCallback)+tabletCallback = makeSettableStateVar setTabletCallback++setTabletCallback :: Maybe TabletCallback -> IO ()+setTabletCallback Nothing = do+   setTabletMotionCallback Nothing+   setTabletButtonCallback Nothing+setTabletCallback (Just cb) = do+   setTabletMotionCallback (Just (\p     -> cb TabletMotion       p))+   setTabletButtonCallback (Just (\b s p -> cb (TabletButton b s) p))++--------------------------------------------------------------------------------++type TabletMotionCallback = TabletPosition -> IO ()++setTabletMotionCallback :: Maybe TabletMotionCallback -> IO ()+setTabletMotionCallback =+    setCallback TabletMotionCB glutTabletMotionFunc+                (makeTabletMotionFunc . unmarshal)+    where unmarshal cb x y =+             cb (TabletPosition (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++type TabletButtonCallback = ButtonIndex -> KeyState -> TabletPosition -> IO ()++setTabletButtonCallback :: Maybe TabletButtonCallback -> IO ()+setTabletButtonCallback =+    setCallback TabletButtonCB glutTabletButtonFunc+                (makeTabletButtonFunc . unmarshal)+    where unmarshal cb b s x y =+             cb (fromIntegral b) (unmarshalKeyState s)+                (TabletPosition (fromIntegral x) (fromIntegral y))++--------------------------------------------------------------------------------++-- | The state of the joystick buttons++data JoystickButtons = JoystickButtons {+   joystickButtonA, joystickButtonB,+   joystickButtonC, joystickButtonD :: KeyState }+   deriving ( Eq, Ord, Show )++-- Could use fromBitfield + Enum/Bounded instances + unmarshalJoystickButton+-- instead...+unmarshalJoystickButtons :: CUInt -> JoystickButtons+unmarshalJoystickButtons m = JoystickButtons {+   joystickButtonA = if (m .&. glut_JOYSTICK_BUTTON_A) /= 0 then Down else Up,+   joystickButtonB = if (m .&. glut_JOYSTICK_BUTTON_B) /= 0 then Down else Up,+   joystickButtonC = if (m .&. glut_JOYSTICK_BUTTON_C) /= 0 then Down else Up,+   joystickButtonD = if (m .&. glut_JOYSTICK_BUTTON_D) /= 0 then Down else Up }++--------------------------------------------------------------------------------++-- | Absolute joystick position, with coordinates normalized to be in the range+-- of -1000 to 1000 inclusive. The signs of the three axes mean the following:+--+-- * negative = left, positive = right+--+-- * negative = towards player, positive = away+--+-- * if available (e.g. rudder): negative = down, positive = up++data JoystickPosition = JoystickPosition Int Int Int+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++-- | A joystick callback++type JoystickCallback = JoystickButtons -> JoystickPosition -> IO ()++-- | Controls the joystick callback for the /current window./ The joystick+-- callback is called either due to polling of the joystick at the uniform timer+-- interval specified (if > 0) or in response to an explicit call of+-- 'Graphics.UI.GLUT.DeviceControl.forceJoystickCallback'.+--+-- /X Implementation Notes:/ Currently GLUT has no joystick support for X11.++-- joystickCallback :: SettableStateVar (Maybe JoystickCallback, PollRate)+joystickCallback :: SettableStateVar (Maybe (JoystickCallback, PollRate))+joystickCallback =+   makeSettableStateVar $ \maybeCBAndRate ->+      setCallback JoystickCB+                  (\f -> glutJoystickFunc f (fromIntegral (snd (fromJust maybeCBAndRate))))+                  (makeJoystickFunc . unmarshal)+                  (fmap fst maybeCBAndRate)+    where unmarshal cb b x y z = cb (unmarshalJoystickButtons b)+                                    (JoystickPosition (fromIntegral x)+                                                      (fromIntegral y)+                                                      (fromIntegral z))++--------------------------------------------------------------------------------++-- | A description where the multi-touch event is coming from, the freeglut+-- specs are very vague about the actual semantics. It contains the device ID+-- and\/or the cursor\/finger ID.++type TouchID = Int++-- | A multi-touch variant of 'MouseCallback'.++type MultiMouseCallback = TouchID -> MouseCallback++-- | (/freeglut only/) A multi-touch variant of 'mouseCallback'.++multiMouseCallback :: SettableStateVar (Maybe MultiMouseCallback)+multiMouseCallback = makeSettableStateVar $+   setCallback MultiButtonCB glutMultiButtonFunc (makeMultiButtonFunc . unmarshal)+   where unmarshal cb d x y b s = cb (fromIntegral d)+                                     (unmarshalMouseButton b)+                                     (unmarshalKeyState s)+                                     (Position (fromIntegral x) (fromIntegral y))++-- | A multi-touch variant of 'CrossingCallback'.++type MultiCrossingCallback = TouchID -> CrossingCallback++-- | (/freeglut only/) A multi-touch variant of 'crossingCallback'.++multiCrossingCallback :: SettableStateVar (Maybe MultiCrossingCallback)+multiCrossingCallback = makeSettableStateVar $+   setCallback MultiEntryCB glutMultiEntryFunc (makeMultiEntryFunc . unmarshal)+   where unmarshal cb d c = cb (fromIntegral d) (unmarshalCrossing c)++-- | A multi-touch variant of 'MotionCallback'.++type MultiMotionCallback = TouchID -> MotionCallback++-- | (/freeglut only/) A multi-touch variant of 'motionCallback'.++multiMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)+multiMotionCallback = makeSettableStateVar $+   setCallback MultiMotionCB glutMultiMotionFunc (makeMultiMotionFunc . unmarshal)+   where unmarshal cb d x y =+            cb (fromIntegral d) (Position (fromIntegral x) (fromIntegral y))++-- | (/freeglut only/) A multi-touch variant of 'passiveMotionCallback'.++multiPassiveMotionCallback :: SettableStateVar (Maybe MultiMotionCallback)+multiPassiveMotionCallback = makeSettableStateVar $+   setCallback MultiPassiveCB glutMultiPassiveFunc (makeMultiPassiveFunc . unmarshal)+   where unmarshal cb d x y =+            cb (fromIntegral d) (Position (fromIntegral x) (fromIntegral y))
+ src/Graphics/UI/GLUT/Colormap.hs view
@@ -0,0 +1,112 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Colormap+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- OpenGL supports both RGBA and color index rendering. The RGBA mode is+-- generally preferable to color index because more OpenGL rendering+-- capabilities are available and color index mode requires the loading of+-- colormap entries.+--+-- The GLUT color index state variables are used to read and write entries in a+-- window\'s color index colormap. Every GLUT color index window has its own+-- logical color index colormap. The size of a window\'s colormap can be+-- determined by reading 'numColorMapEntries'.+--+-- GLUT color index windows within a program can attempt to share colormap+-- resources by copying a single color index colormap to multiple windows using+-- 'copyColormap'. If possible GLUT will attempt to share the actual colormap.+-- While copying colormaps using 'copyColormap' can potentially allow sharing of+-- physical colormap resources, logically each window has its own colormap. So+-- changing a copied colormap of a window will force the duplication of the+-- colormap. For this reason, color index programs should generally load a+-- single color index colormap, copy it to all color index windows within the+-- program, and then not modify any colormap cells.+--+-- Use of multiple colormaps is likely to result in colormap installation+-- problems where some windows are displayed with an incorrect colormap due to+-- limitations on colormap resources.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Colormap (+   colorMapEntry,+   copyColormap,+   numColorMapEntries,+   transparentIndex+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( GettableStateVar, makeGettableStateVar, StateVar, makeStateVar )+import Foreign.C.Types ( CInt )+import Graphics.Rendering.OpenGL.GL.VertexSpec ( Index1(..), Color3(..) )+import Graphics.Rendering.OpenGL ( GLint, GLfloat )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | Controls the color index colormap entry of the /current window/\'s logical+-- colormap for the /layer in use/. The /layer in use/ of the /current window/+-- should be a color index window. The color index should be zero or greater and+-- less than the total number of colormap entries for the window (see+-- 'numColorMapEntries') and different from an overlay\'s transparent index (see+-- 'transparentIndex').+--+-- If the /layer in use/\'s colormap was copied by reference, setting a colormap+-- entry will force the duplication of the colormap.++colorMapEntry :: Index1 GLint -> StateVar (Color3 GLfloat)+colorMapEntry (Index1 cell) =+   makeStateVar (getColorMapEntry (fromIntegral cell))+                (setColorMapEntry (fromIntegral cell))++setColorMapEntry :: CInt -> Color3 GLfloat -> IO ()+setColorMapEntry cell (Color3 r g b) = glutSetColor cell r g b++getColorMapEntry :: CInt -> IO (Color3 GLfloat)+getColorMapEntry cell = do+   r <- glutGetColor cell glut_RED+   g <- glutGetColor cell glut_GREEN+   b <- glutGetColor cell glut_BLUE+   return $ Color3 r g b++--------------------------------------------------------------------------------++-- | Copy (lazily if possible to promote sharing) the logical colormap from a+-- specified window to the /current window/\'s /layer in use/. The copy will be+-- from the normal plane to the normal plane; or from the overlay to the overlay+-- (never across different layers). Once a colormap has been copied, avoid+-- setting cells in the colormap via 'colorMapEntry' since that will force an+-- actual copy of the colormap if it was previously copied by reference.+-- 'copyColormap' should only be called when both the /current window/ and the+-- specified window are color index windows.++copyColormap :: MonadIO m => Window -> m ()+copyColormap (Window win) = glutCopyColormap win++--------------------------------------------------------------------------------++-- | Contains the number of entries in the colormap of the /current window/\'s+-- current layer (0 in RGBA mode).++numColorMapEntries :: GettableStateVar GLint+numColorMapEntries =+   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_COLORMAP_SIZE++--------------------------------------------------------------------------------++-- | Contains the transparent color index of the overlay of the /current window/+-- or -1 if no overlay is in use.++transparentIndex :: GettableStateVar (Index1 GLint)+transparentIndex =+   makeGettableStateVar $+      layerGet (Index1 . fromIntegral) glut_TRANSPARENT_INDEX
+ src/Graphics/UI/GLUT/Debugging.hs view
@@ -0,0 +1,39 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Debugging+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This module contains a simple utility routine to report any pending GL+-- errors.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Debugging (+   reportErrors+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( get )+import Graphics.Rendering.OpenGL ( Error(..), errors )+import System.Environment ( getProgName )+import System.IO ( hPutStrLn, stderr )++--------------------------------------------------------------------------------++-- | Report any pending GL errors to stderr (which is typically the console).+-- If there are no pending errors, this routine does nothing. Note that the+-- error flags are reset after this action, i.e. there are no pending errors+-- left afterwards.++reportErrors :: MonadIO m => m ()+reportErrors = get errors >>= mapM_ reportError++reportError :: MonadIO m => Error -> m ()+reportError (Error _ msg) = liftIO $ do+   pn <- getProgName+   hPutStrLn stderr ("GLUT: Warning in " ++ pn ++ ": GL error: " ++ msg)
+ src/Graphics/UI/GLUT/DeviceControl.hs view
@@ -0,0 +1,124 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.DeviceControl+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT offers some routines for controlling the key repeat and polling the+-- joystick.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.DeviceControl (+   GlobalKeyRepeat(..), globalKeyRepeat,+   PerWindowKeyRepeat(..), perWindowKeyRepeat,+   forceJoystickCallback+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( StateVar, makeStateVar )+import Foreign.C.Types ( CInt )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++-- | The state of the global key repeat++data GlobalKeyRepeat+   = GlobalKeyRepeatOff+   | GlobalKeyRepeatOn+   | GlobalKeyRepeatDefault+   deriving ( Eq, Ord, Show )++marshalGlobalKeyRepeat :: GlobalKeyRepeat -> CInt+marshalGlobalKeyRepeat x = case x of+   GlobalKeyRepeatOff -> glut_KEY_REPEAT_OFF+   GlobalKeyRepeatOn -> glut_KEY_REPEAT_ON+   GlobalKeyRepeatDefault -> glut_KEY_REPEAT_DEFAULT++unmarshalGlobalKeyRepeat :: CInt -> GlobalKeyRepeat+unmarshalGlobalKeyRepeat x+   | x == glut_KEY_REPEAT_OFF = GlobalKeyRepeatOff+   | x == glut_KEY_REPEAT_ON = GlobalKeyRepeatOn+   | x == glut_KEY_REPEAT_DEFAULT = GlobalKeyRepeatDefault+   | otherwise = error ("unmarshalGlobalKeyRepeat: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | Controls the key repeat mode for the window system on a global basis if+-- possible. If supported by the window system, the key repeat can either be+-- disabled, enabled, or set to the window system\'s default key repeat state.+--+-- /X Implementation Notes:/ X11 sends @KeyPress@ events repeatedly when the+-- window system\'s global auto repeat is enabled. 'perWindowKeyRepeat' can+-- prevent these auto repeated keystrokes from being reported as keyboard or+-- special callbacks, but there is still some minimal overhead by the X server+-- to continually stream @KeyPress@ events to the GLUT application. The+-- 'globalKeyRepeat' state variable can be used to actually disable the global+-- sending of auto repeated @KeyPress@ events. Note that 'globalKeyRepeat'+-- affects the global window system auto repeat state so other applications+-- will not auto repeat if you disable auto repeat globally through+-- 'globalKeyRepeat'. GLUT applications using the X11 GLUT implementation+-- should disable key repeat with 'globalKeyRepeat' to disable key repeats most+-- efficiently, but are responsible for explicitly restoring the default key+-- repeat state on exit.+--+-- /Win32 Implementation Notes:/ The Win32 implementation of 'globalKeyRepeat'+-- does nothing. The 'perWindowKeyRepeat' can be used in the Win32 GLUT+-- implementation to ignore repeated keys on a per-window basis without changing+-- the global window system key repeat.++globalKeyRepeat :: StateVar GlobalKeyRepeat+globalKeyRepeat =+   makeStateVar (deviceGet unmarshalGlobalKeyRepeat glut_DEVICE_KEY_REPEAT)+                (glutSetKeyRepeat . marshalGlobalKeyRepeat)++--------------------------------------------------------------------------------++-- | The state of the per-window key repeat++data PerWindowKeyRepeat+   = PerWindowKeyRepeatOff+   | PerWindowKeyRepeatOn+   deriving ( Eq, Ord, Show )++marshalPerWindowKeyRepeat :: PerWindowKeyRepeat -> CInt+marshalPerWindowKeyRepeat x = case x of+   PerWindowKeyRepeatOn -> 0+   PerWindowKeyRepeatOff -> 1++unmarshalPerWindowKeyRepeat :: CInt -> PerWindowKeyRepeat+unmarshalPerWindowKeyRepeat x+   | x == 0 = PerWindowKeyRepeatOn+   | otherwise = PerWindowKeyRepeatOff++--------------------------------------------------------------------------------++-- | Controls if auto repeat keystrokes are reported to the /current window./+-- Ignoring auto repeated keystrokes is generally done in conjunction with using+-- the 'Graphics.UI.GLUT.Callbacks.Window.keyboardMouseCallback'. If you do+-- not ignore auto repeated keystrokes, your GLUT application will experience+-- repeated release\/press callbacks. Games using the keyboard will typically+-- want to ignore key repeat.++perWindowKeyRepeat :: StateVar PerWindowKeyRepeat+perWindowKeyRepeat =+   makeStateVar+      (deviceGet unmarshalPerWindowKeyRepeat glut_DEVICE_IGNORE_KEY_REPEAT)+      (glutIgnoreKeyRepeat . marshalPerWindowKeyRepeat)++--------------------------------------------------------------------------------++-- | Execute the joystick callback set by+-- 'Graphics.UI.GLUT.Callbacks.Window.joystickCallback' once (if one exists).+-- This is done in a synchronous fashion within the current context, i.e. when+-- 'forceJoystickCallback' returns, the callback will have already happened.++forceJoystickCallback :: MonadIO m => m ()+forceJoystickCallback = glutForceJoystickFunc
+ src/Graphics/UI/GLUT/Fonts.hs view
@@ -0,0 +1,128 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Fonts+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT supports two types of font rendering: stroke fonts, meaning each+-- character is rendered as a set of line segments; and bitmap fonts, where each+-- character is a bitmap generated with+-- 'Graphics.Rendering.OpenGL.GL.Bitmaps.bitmap'. Stroke fonts have the+-- advantage that because they are geometry, they can be arbitrarily scale and+-- rendered. Bitmap fonts are less flexible since they are rendered as bitmaps+-- but are usually faster than stroke fonts.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Fonts (+   Font(..), BitmapFont(..), StrokeFont(..),+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Char ( ord )+import Foreign.C.String ( withCString )+import Foreign.C.Types ( CInt )+import Foreign.Ptr ( castPtr )+import Graphics.Rendering.OpenGL ( GLint, GLfloat )++import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++class Font a where+   -- | Render the string in the named font, without using any display lists.+   -- Rendering a nonexistent character has no effect.+   --+   -- If the font is a bitmap font, 'renderString' automatically sets the OpenGL+   -- unpack pixel storage modes it needs appropriately and saves and restores+   -- the previous modes before returning. The generated call to+   -- 'Graphics.Rendering.OpenGL.GL.bitmap' will adjust the current raster+   -- position based on the width of the string.+   -- If the font is a stroke font,+   -- 'Graphics.Rendering.OpenGL.GL.CoordTrans.translate' is used to translate+   -- the current model view matrix to advance the width of the string.++   renderString :: MonadIO m => a -> String -> m ()++   -- | For a bitmap font, return the width in pixels of a string. For a stroke+   -- font, return the width in units. While the width of characters in a font+   -- may vary (though fixed width fonts do not vary), the maximum height+   -- characteristics of a particular font are fixed.++   stringWidth :: MonadIO m => a -> String -> m GLint++   -- | (/freeglut only/) For a bitmap font, return the maximum height of the+   -- characters in the given font measured in pixels. For a stroke font,+   -- return the height in units.++   fontHeight :: MonadIO m => a -> m GLfloat++instance Font BitmapFont where+   renderString = bitmapString+   stringWidth  = bitmapLength+   fontHeight   = bitmapHeight+++instance Font StrokeFont where+   renderString = strokeString+   stringWidth  = strokeLength+   fontHeight   = strokeHeight++--------------------------------------------------------------------------------++bitmapString :: MonadIO m => BitmapFont -> String -> m ()+bitmapString f s = do+   i <- marshalBitmapFont f+   mapM_ (\c -> withChar c (glutBitmapCharacter i)) s++withChar :: Char -> (CInt -> m a) -> m a+withChar c f = f . fromIntegral . ord $ c++--------------------------------------------------------------------------------++strokeString :: MonadIO m => StrokeFont -> String -> m ()+strokeString f s = do+   i <- marshalStrokeFont f+   mapM_ (\c -> withChar c (glutStrokeCharacter i)) s++--------------------------------------------------------------------------------++bitmapLength :: MonadIO m+             => BitmapFont -- ^ Bitmap font to use.+             -> String     -- ^ String to return width of (not confined to 8+                           --   bits).+             -> m GLint    -- ^ Width in pixels.+bitmapLength f s = liftIO $ do+   i <- marshalBitmapFont f+   fmap fromIntegral $ withCString s (glutBitmapLength i . castPtr)++--------------------------------------------------------------------------------++strokeLength :: MonadIO m+             => StrokeFont -- ^ Stroke font to use.+             -> String     -- ^ String to return width of (not confined to 8+                           --   bits).+             -> m GLint    -- ^ Width in units.+strokeLength f s = liftIO $ do+   i <- marshalStrokeFont f+   fmap fromIntegral $ withCString s (glutStrokeLength i . castPtr)++--------------------------------------------------------------------------------++bitmapHeight :: MonadIO m+             => BitmapFont -- ^ Bitmap font to use.+             -> m GLfloat  -- ^ Height in pixels.+bitmapHeight f = liftIO $ do+  i <- marshalBitmapFont f+  fromIntegral `fmap` glutBitmapHeight  i++--------------------------------------------------------------------------------++strokeHeight :: MonadIO m+             => StrokeFont -- ^ Stroke font to use.+             -> m GLfloat  -- ^ Height in units.+strokeHeight f = glutStrokeHeight =<< marshalStrokeFont f
+ src/Graphics/UI/GLUT/GameMode.hs view
@@ -0,0 +1,193 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.GameMode+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- In addition to the functionality offered by+-- 'Graphics.UI.GLUT.Window.fullScreen', GLUT offers an sub-API to change the+-- screen resolution, color depth, and refresh rate of the display for a single+-- full screen window. This mode of operation is called /game mode/, and is+-- restricted in various ways: No pop-up menus are allowed for this full screen+-- window, no other (sub-)windows can be created, and all other applications are+-- hidden.+--+-- /X Implementation Notes:/ Note that game mode is not fully supported in the+-- original GLUT for X, it is essentially the same as using+-- 'Graphics.UI.GLUT.Window.fullScreen'. The GLUT clone freeglut+-- (see <http://freeglut.sourceforge.net/>) does not have this restriction.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.GameMode (+   GameModeCapability(..), GameModeCapabilityDescription(..),+   gameModeCapabilities, enterGameMode, leaveGameMode,+   BitsPerPlane, RefreshRate, GameModeInfo(..), gameModeInfo,+   gameModeActive+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.List ( intersperse )+import Data.StateVar ( GettableStateVar, makeGettableStateVar+                     , SettableStateVar, makeSettableStateVar )+import Foreign.C.String ( withCString )+import Graphics.Rendering.OpenGL ( Size(..), GLenum )++import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | Capabilities for 'gameModeCapabilities'++data GameModeCapability+   = GameModeWidth         -- ^ Width of the screen resolution in pixels+   | GameModeHeight        -- ^ Height of the screen resolution in pixels+   | GameModeBitsPerPlane  -- ^ Color depth of the screen in bits+   | GameModeRefreshRate   -- ^ Refresh rate in Hertz+   | GameModeNum           -- ^ Match the Nth frame buffer configuration+                           --   compatible with the given capabilities+                           --   (numbering starts at 1)+   deriving ( Eq, Ord, Show )++gameModeCapabilityToString :: GameModeCapability -> String+gameModeCapabilityToString x = case x of+   GameModeWidth        -> "width"+   GameModeHeight       -> "height"+   GameModeBitsPerPlane -> "bpp"+   GameModeRefreshRate  -> "hertz"+   GameModeNum          -> "num"++-- | A single capability description for 'gameModeCapabilities'.++data GameModeCapabilityDescription = Where' GameModeCapability Relation Int+   deriving ( Eq, Ord, Show )++gameModeCapabilityDescriptionToString :: GameModeCapabilityDescription -> String+gameModeCapabilityDescriptionToString (Where' c r i) =+      gameModeCapabilityToString c ++ relationToString r ++ show i++--------------------------------------------------------------------------------++-- | Controls the /game mode/ to be used when 'enterGameMode' is called. It is+-- described by a list of zero or more capability descriptions, which are+-- translated into a set of criteria used to select the appropriate screen+-- configuration. The criteria are matched in strict left to right order of+-- precdence. That is, the first specified criterion (leftmost) takes precedence+-- over the later criteria for non-exact criteria+-- ('Graphics.UI.GLUT.Initialization.IsGreaterThan',+-- 'Graphics.UI.GLUT.Initialization.IsLessThan', etc.). Exact criteria+-- ('Graphics.UI.GLUT.Initialization.IsEqualTo',+-- 'Graphics.UI.GLUT.Initialization.IsNotEqualTo') must match exactly so+-- precedence is not relevant.+--+-- To determine which configuration will actually be tried by 'enterGameMode'+-- (if any), use 'gameModeInfo'.+--+-- Note that even for game mode the current values of+-- 'Graphics.UI.GLUT.Initialization.initialDisplayMode'or+-- 'Graphics.UI.GLUT.Initialization.initialDisplayCapabilities' will+-- determine which buffers are available, if double buffering is used or not,+-- etc.++gameModeCapabilities :: SettableStateVar [GameModeCapabilityDescription]+gameModeCapabilities = makeSettableStateVar $ \ds ->+   withCString (descriptionsToString ds) glutGameModeString++-- freeglut currently handles only simple game mode descriptions like "WxH:B@R",+-- so we try hard to use this format instead of the more general format allowed+-- by the "real" GLUT.+descriptionsToString :: [GameModeCapabilityDescription] -> String+descriptionsToString ds =+   let ws = [ x | Where' GameModeWidth        IsEqualTo x <- ds ]+       hs = [ x | Where' GameModeHeight       IsEqualTo x <- ds ]+       bs = [ x | Where' GameModeBitsPerPlane IsEqualTo x <- ds ]+       rs = [ x | Where' GameModeRefreshRate  IsEqualTo x <- ds ]+       allSimple = (length ws + length hs + length bs + length rs) == (length ds)+       dimensionsOK = (null ws) == (null hs)+   in if allSimple && dimensionsOK+         then simpleCapStr ws hs bs rs+         else generalCapStr ds++simpleCapStr :: [Int] -> [Int] -> [Int] -> [Int] -> String+simpleCapStr ws hs bs rs =+   showCap "" ws ++ showCap "x" hs ++ showCap ":" bs ++ showCap "@" rs+   where showCap _      []    = ""+         showCap prefix (x:_) = prefix ++ show x++generalCapStr :: [GameModeCapabilityDescription] -> String+generalCapStr =+   concat . intersperse " " . map gameModeCapabilityDescriptionToString++--------------------------------------------------------------------------------++-- | Enter /game mode/, trying to change resolution, refresh rate, etc., as+-- specified by the current value of 'gameModeCapabilities'. An identifier for+-- the game mode window and a flag, indicating if the display mode actually+-- changed, are returned. The game mode window is made the /current window/.+--+-- Re-entering /game mode/ is allowed, the previous game mode window gets+-- destroyed by this, and a new one is created.++enterGameMode :: MonadIO m => m (Window, Bool)+enterGameMode = do+   w <- glutEnterGameMode+   c <- getBool glut_GAME_MODE_DISPLAY_CHANGED+   return (Window w, c)++--------------------------------------------------------------------------------++-- | Leave /game mode/, restoring the old display mode and destroying the game+-- mode window.++leaveGameMode :: MonadIO m => m ()+leaveGameMode = glutLeaveGameMode++--------------------------------------------------------------------------------++-- | The color depth of the screen, measured in bits (e.g. 8, 16, 24, 32, ...)++type BitsPerPlane = Int++-- | The refresh rate of the screen, measured in Hertz (e.g. 60, 75, 100, ...)++type RefreshRate = Int++data GameModeInfo = GameModeInfo Size BitsPerPlane RefreshRate+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++-- | Return 'Just' the mode which would be tried by the next call to+-- 'enterGameMode'. Returns 'Nothing' if the mode requested by the current value+-- of 'gameModeCapabilities' is not possible, in which case 'enterGameMode'+-- would simply create a full screen window using the current mode.++gameModeInfo :: GettableStateVar (Maybe GameModeInfo)+gameModeInfo = makeGettableStateVar $ do+   possible <- getBool glut_GAME_MODE_POSSIBLE+   if possible+      then do+         w <- glutGameModeGet glut_GAME_MODE_WIDTH+         h <- glutGameModeGet glut_GAME_MODE_HEIGHT+         let size = Size (fromIntegral w) (fromIntegral h)+         b <- glutGameModeGet glut_GAME_MODE_PIXEL_DEPTH+         r <- glutGameModeGet glut_GAME_MODE_REFRESH_RATE+         return $ Just $ GameModeInfo size (fromIntegral b) (fromIntegral r)+      else return Nothing++getBool :: MonadIO m => GLenum -> m Bool+getBool x = do+  val <- glutGameModeGet x+  return $ val /= 0++--------------------------------------------------------------------------------++-- | Contains 'True' when the /game mode/ is active, 'False' otherwise.++gameModeActive :: GettableStateVar Bool+gameModeActive = makeGettableStateVar $ getBool glut_GAME_MODE_ACTIVE
+ src/Graphics/UI/GLUT/Initialization.hs view
@@ -0,0 +1,773 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Initialization+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Actions and state variables in this module are used to initialize GLUT state.+-- The primary initialization routine is 'initialize', which should only be+-- called exactly once in a GLUT program. No other GLUT or OpenGL actions should+-- be called before 'initialize', apart from getting or setting the state+-- variables in this module.+--+-- The reason is that these state variables can be used to set default window+-- initialization state that might be modified by the command processing done in+-- 'initialize'. For example, 'initialWindowSize' can be set to @('Size'+-- 400 400)@ before 'initialize' is called to indicate 400 by 400 is the+-- program\'s default window size. Setting the initial window size or position+-- before 'initialize' allows the GLUT program user to specify the initial size+-- or position using command line arguments.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Initialization (+   -- * Primary initialization+   initialize, getArgsAndInitialize, exit,++   -- * Initial window geometry+   initialWindowPosition, initialWindowSize,++   -- * Setting the initial display mode (I)+   DisplayMode(..), initialDisplayMode, displayModePossible,++   -- * Setting the initial display mode (II)+   DisplayCapability(..), Relation(..), DisplayCapabilityDescription(..),+   initialDisplayCapabilities,++   -- * Controlling the creation of rendering contexts+   RenderingContext(..), renderingContext,++   -- * Direct\/indirect rendering+   DirectRendering(..), directRendering,++   -- * OpenGL 3.x context support+   initialContextVersion, ContextFlag(..), initialContextFlags,+   ContextProfile(..), initialContextProfile+) where++import Control.Monad ( when )+import Control.Monad.IO.Class ( MonadIO(..) )+import Data.Bits ( Bits(..) )+import Data.List ( genericLength, intersperse, mapAccumR )+import Data.StateVar ( get, ($=), GettableStateVar, makeGettableStateVar+                     , SettableStateVar, makeSettableStateVar, StateVar, makeStateVar )+import Foreign.C.String ( peekCString, withCString )+import Foreign.C.Types ( CInt, CUInt )+import Foreign.Marshal.Array ( peekArray, withArray0 )+import Foreign.Marshal.Utils ( with, withMany )+import Foreign.Ptr ( nullPtr )+import Foreign.Storable ( peek )+import Graphics.Rendering.OpenGL ( Position(..), Size(..) )+import System.Environment ( getArgs, getProgName )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | Given the program name and command line arguments, initialize the GLUT+-- library and negotiate a session with the window system. During this+-- process, 'initialize' may cause the termination of the GLUT program with an+-- error message to the user if GLUT cannot be properly initialized.+-- Examples of this situation include the failure to connect to the window+-- system, the lack of window system support for OpenGL, and invalid command+-- line options.+--+-- 'initialize' also processes command line options, but the specific options+-- parsed are window system dependent. Any command line arguments which are+-- not GLUT-specific are returned.+--+-- /X Implementation Notes:/ The X Window System specific options parsed by+-- 'initialize' are as follows:+--+-- * @-display /DISPLAY/@: Specify the X server to connect to. If not specified,+--   the value of the @DISPLAY@ environment variable is used.+--+-- * @-geometry /WxH+X+Y/@: Determines where windows should be created on the+--   screen. The parameter following @-geometry@ should be formatted as a+--   standard X geometry specification. The effect of using this option is to+--   change the GLUT initial size and initial position the same as if+--   'initialWindowSize' or 'initialWindowPosition' were modified directly.+--+-- * @-iconic@: Requests all top-level windows be created in an iconic state.+--+-- * @-indirect@: Force the use of indirect OpenGL rendering contexts.+--+-- * @-direct@: Force the use of direct OpenGL rendering contexts (not all GLX+--   implementations support direct rendering contexts). A fatal error is+--   generated if direct rendering is not supported by the OpenGL+--   implementation. If neither @-indirect@ or @-direct@ are used to force a+--   particular behavior, GLUT will attempt to use direct rendering if+--   possible and otherwise fallback to indirect rendering.+--+-- * @-gldebug@: After processing callbacks and\/or events, call+--   'Graphics.UI.GLUT.Debugging.reportErrors' to check if there are any pending+--   OpenGL errors. Using this option is helpful in detecting OpenGL run-time+--   errors.+--+-- * @-sync@: Enable synchronous X protocol transactions. This option makes+--   it easier to track down potential X protocol errors.++initialize :: MonadIO m+           => String      -- ^ The program name.+           -> [String]    -- ^ The command line arguments+           -> m [String] -- ^ Non-GLUT command line arguments+initialize prog args = liftIO $+   with (1 + genericLength args) $ \argcBuf ->+   withMany withCString (prog : args) $ \argvPtrs ->+   withArray0 nullPtr argvPtrs $ \argvBuf -> do+   glutInit argcBuf argvBuf+   newArgc <- peek argcBuf+   newArgvPtrs <- peekArray (fromIntegral newArgc) argvBuf+   newArgv <- mapM peekCString newArgvPtrs+   return $ tail newArgv++-- | Convenience action: Initialize GLUT, returning the program name and any+-- non-GLUT command line arguments.++getArgsAndInitialize :: MonadIO m => m (String, [String])+getArgsAndInitialize = liftIO $ do+   prog <- getProgName+   args <- getArgs+   nonGLUTArgs <- initialize prog args+   return (prog, nonGLUTArgs)++-----------------------------------------------------------------------------++-- | (/freeglut only/) De-initialize GLUT. After this, one has to use+-- 'initialize' or 'getArgsAndInitialize' to initialize GLUT again.++exit :: MonadIO m => m ()+exit = glutExit++--------------------------------------------------------------------------------++-- | Controls the /initial window position/.  Windows created by+-- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with+-- the current /initial window position/. The initial value of the /initial+-- window position/ GLUT state is @'Position' (-1) (-1)@. If either the X or Y+-- component of the /initial window position/ is negative, the actual window+-- position is left to the window system to determine.+--+-- The intent of the /initial window position/ is to provide a suggestion to+-- the window system for a window\'s initial position. The window system is+-- not obligated to use this information. Therefore, GLUT programs should not+-- assume the window was created at the specified position.++initialWindowPosition :: StateVar Position+initialWindowPosition =+   makeStateVar getInitialWindowPosition setInitialWindowPosition++getInitialWindowPosition :: IO Position+getInitialWindowPosition = do+   x <- simpleGet fromIntegral glut_INIT_WINDOW_X+   y <- simpleGet fromIntegral glut_INIT_WINDOW_Y+   return $ Position x y++setInitialWindowPosition :: Position -> IO ()+setInitialWindowPosition (Position x y) =+    glutInitWindowPosition (fromIntegral x) (fromIntegral y)++--------------------------------------------------------------------------------++-- | Controls the /initial window size/.  Windows created by+-- 'Graphics.UI.GLUT.Window.createWindow' will be requested to be created with+-- the current /initial window size/. The initial value of the /initial window+-- size/ GLUT state is @'Size' 300 300@. If either the width or the height+-- component of the /initial window size/ is non-positive, the actual window+-- size is left to the window system to determine.+--+-- The intent of the /initial window size/ is to provide a suggestion to the+-- window system for a window\'s initial size. The window system is not+-- obligated to use this information. Therefore, GLUT programs should not+-- assume the window was created at the specified size. A GLUT program should+-- use the window\'s reshape callback to determine the true size of the+-- window.++initialWindowSize :: StateVar Size+initialWindowSize = makeStateVar getInitialWindowSize setInitialWindowSize++getInitialWindowSize :: IO Size+getInitialWindowSize = do+   w <- simpleGet fromIntegral glut_INIT_WINDOW_WIDTH+   h <- simpleGet fromIntegral glut_INIT_WINDOW_HEIGHT+   return $ Size w h++setInitialWindowSize :: Size -> IO ()+setInitialWindowSize (Size w h) =+   glutInitWindowSize (fromIntegral w) (fromIntegral h)++--------------------------------------------------------------------------------++-- | A single aspect of a window which is to be created, used in conjunction+-- with 'initialDisplayMode'.++data DisplayMode+   = RGBAMode+     -- ^ Select an RGBA mode window. This is the default if neither 'RGBAMode'+     -- nor 'IndexMode' are specified.+   | RGBMode+     -- ^ An alias for 'RGBAMode'.+   | IndexMode+     -- ^ Select a color index mode window. This overrides 'RGBAMode' if it is+     -- also specified.+   | LuminanceMode+     -- ^ Select a window with a \"luminance\" color model. This model provides+     -- the functionality of OpenGL\'s RGBA color model, but the green and blue+     -- components are not maintained in the frame buffer. Instead each pixel\'s+     -- red component is converted to an index between zero and+     --  'Graphics.UI.GLUT.Colormap.numColorMapEntries' and looked up in a+     -- per-window color map to determine the color of pixels within the window.+     -- The initial colormap of 'LuminanceMode' windows is initialized to be a+     -- linear gray ramp, but can be modified with GLUT\'s colormap actions.+     -- /Implementation Notes:/ 'LuminanceMode' is not supported on most OpenGL+     -- platforms.+   | WithAlphaComponent+     -- ^ Select a window with an alpha component to the color buffer(s).+   | WithAccumBuffer+     -- ^ Select a window with an accumulation buffer.+   | WithDepthBuffer+     -- ^ Select a window with a depth buffer.+   | WithStencilBuffer+     -- ^ Select a window with a stencil buffer.+   | WithAuxBuffers Int+     -- ^ (/freeglut only/) Select a window with /n/ (1 .. 4) auxiliary buffers.+     -- Any /n/ outside the range 1 .. 4 is a fatal error.+   | SingleBuffered+     -- ^ Select a single buffered window. This is the default if neither+     -- 'DoubleBuffered' nor 'SingleBuffered' are specified.+   | DoubleBuffered+     -- ^ Select a double buffered window. This overrides 'SingleBuffered' if it+     -- is also specified.+   | Multisampling+     -- ^ Select a window with multisampling support. If multisampling is not+     -- available, a non-multisampling window will automatically be chosen.+     -- Note: both the OpenGL client-side and server-side implementations must+     -- support the @GLX_SAMPLE_SGIS@ extension for multisampling to be+     -- available. Deprecated, use 'WithSamplesPerPixel'.+   | WithSamplesPerPixel Int+     -- ^ Select a window with multisampling, using the given samples per pixel.+   | Stereoscopic+     -- ^ Select a stereo window.+   | Captionless+     -- ^ Select a window without a caption (/freeglut only/).+   | Borderless+     -- ^ Select a window without any borders (/freeglut only/).+   | SRGBMode+     -- ^ Select an sRGB mode window (/freeglut only/).+   deriving ( Eq, Ord, Show )++marshalDisplayMode :: DisplayMode -> CUInt+marshalDisplayMode m = case m of+   RGBAMode -> glut_RGBA+   RGBMode -> glut_RGB+   IndexMode -> glut_INDEX+   LuminanceMode -> glut_LUMINANCE+   WithAlphaComponent -> glut_ALPHA+   WithAccumBuffer -> glut_ACCUM+   WithDepthBuffer -> glut_DEPTH+   WithStencilBuffer -> glut_STENCIL+   WithAuxBuffers 1 -> glut_AUX1+   WithAuxBuffers 2 -> glut_AUX2+   WithAuxBuffers 3 -> glut_AUX3+   WithAuxBuffers 4 -> glut_AUX4+   WithAuxBuffers n ->+      error ("marshalDisplayMode: illegal number of auxiliary buffers: " ++ show n)+   SingleBuffered -> glut_SINGLE+   DoubleBuffered -> glut_DOUBLE+   Multisampling -> glut_MULTISAMPLE+   WithSamplesPerPixel _ -> error ("marshalDisplayMode: this should not happen")+   Stereoscopic -> glut_STEREO+   Captionless -> glut_CAPTIONLESS+   Borderless -> glut_BORDERLESS+   SRGBMode -> glut_SRGB++--------------------------------------------------------------------------------++-- | Controls the /initial display mode/ used when creating top-level windows,+-- subwindows, and overlays to determine the OpenGL display mode for the+-- to-be-created window or overlay.+--+-- Note that 'RGBAMode' selects the RGBA color model, but it does not request any+-- bits of alpha (sometimes called an /alpha buffer/ or /destination alpha/)+-- be allocated. To request alpha, specify 'WithAlphaComponent'. The same+-- applies to 'LuminanceMode'.++initialDisplayMode :: StateVar [DisplayMode]+initialDisplayMode = makeStateVar getInitialDisplayMode setInitialDisplayMode++getInitialDisplayMode :: IO [DisplayMode]+getInitialDisplayMode = do+   mode <- simpleGet fromIntegral glut_INIT_DISPLAY_MODE+   let displayModes = i2dms (mode .&. complement glut_MULTISAMPLE)+   if mode .&. glut_MULTISAMPLE == 0+      then return displayModes+      else do+         n <- get samplesPerPixel+         return $ WithSamplesPerPixel n : displayModes++i2dms :: CUInt -> [DisplayMode]+i2dms bitfield | IndexMode `elem` modes || LuminanceMode `elem` modes = modes+               | otherwise = RGBAMode : modes+   where modes = i2dmsWithoutRGBA bitfield++i2dmsWithoutRGBA :: CUInt -> [DisplayMode]+i2dmsWithoutRGBA bitfield =+   [ c | c <- [ IndexMode, LuminanceMode, WithAlphaComponent,+                WithAccumBuffer, WithDepthBuffer, WithStencilBuffer,+                WithAuxBuffers 1, WithAuxBuffers 2, WithAuxBuffers 3,+                WithAuxBuffers 4, SingleBuffered, DoubleBuffered, Multisampling,+                Stereoscopic, Captionless, Borderless, SRGBMode ]+       , (bitfield .&. marshalDisplayMode c) /= 0 ]++setInitialDisplayMode :: [DisplayMode] -> IO ()+setInitialDisplayMode modes = do+   let (spps, transformedModes) = mapAccumR handleMultisampling [] modes+   mapM_ (samplesPerPixel $=) spps+   glutInitDisplayMode (toBitfield marshalDisplayMode transformedModes)++handleMultisampling :: [Int] -> DisplayMode -> ([Int], DisplayMode)+handleMultisampling spps (WithSamplesPerPixel spp) = (spp : spps, Multisampling)+handleMultisampling spps mode                      = (spps, mode)++toBitfield :: (Num b, Bits b) => (a -> b) -> [a] -> b+toBitfield marshal = foldl (.|.) 0 . map marshal++-- | Contains 'True' if the /current display mode/ is supported, 'False'+-- otherwise.++displayModePossible :: GettableStateVar Bool+displayModePossible =+   makeGettableStateVar $ simpleGet (/= 0) glut_DISPLAY_MODE_POSSIBLE++--------------------------------------------------------------------------------++samplesPerPixel :: StateVar Int+samplesPerPixel = makeStateVar getSamplesPerPixel setSamplesPerPixel++getSamplesPerPixel :: IO Int+getSamplesPerPixel = do+   m <- multisamplingSupported+   if m+      then simpleGet fromIntegral (fromIntegral glut_MULTISAMPLE)+      else return defaultSamplesPerPixels++defaultSamplesPerPixels :: Int+defaultSamplesPerPixels = 4++setSamplesPerPixel :: Int -> IO ()+setSamplesPerPixel spp = do+   m <- multisamplingSupported+   when m $+      glutSetOption (fromIntegral glut_MULTISAMPLE) (fromIntegral spp)++multisamplingSupported :: IO Bool+multisamplingSupported = isKnown "glutGetModeValues"++--------------------------------------------------------------------------------++-- | Capabilities for 'initialDisplayCapabilities', most of them are extensions+-- of the constructors of 'DisplayMode'.++data DisplayCapability+   = DisplayRGBA  -- ^ Number of bits of red, green, blue, and alpha in the RGBA+                  --   color buffer. Default is \"'IsAtLeast' @1@\" for red,+                  --   green, blue, and alpha capabilities, and \"'IsEqualTo'+                  --   @1@\" for the RGBA color model capability.+   | DisplayRGB   -- ^ Number of bits of red, green, and blue in the RGBA color+                  --   buffer and zero bits of alpha color buffer precision.+                  --   Default is \"'IsAtLeast' @1@\" for the red, green, and+                  --   blue capabilities, and \"'IsNotLessThan' @0@\" for alpha+                  --   capability, and \"'IsEqualTo' @1@\" for the RGBA color+                  --   model capability.+   | DisplayRed   -- ^ Red color buffer precision in bits. Default is+                  --   \"'IsAtLeast' @1@\".+   | DisplayGreen -- ^ Green color buffer precision in bits. Default is+                  --   \"'IsAtLeast' @1@\".+   | DisplayBlue  -- ^ Blue color buffer precision in bits. Default is+                  --   \"'IsAtLeast' @1@\".+   | DisplayIndex -- ^ Boolean if the color model is color index or not. True is+                  --   color index. Default is \"'IsAtLeast' @1@\".+   | DisplayBuffer -- ^ Number of bits in the color index color buffer. Default+                  --   is \"'IsAtLeast' @1@\".+   | DisplaySingle -- ^ Boolean indicate the color buffer is single buffered.+                  --   Default is \"'IsEqualTo' @1@\".+   | DisplayDouble -- ^ Boolean indicating if the color buffer is double+                  --   buffered. Default is \"'IsEqualTo' @1@\".+   | DisplayAccA  -- ^ Red, green, blue, and alpha accumulation buffer precision+                  --   in  bits. Default is \"'IsAtLeast' @1@\" for red, green,+                  --   blue, and alpha capabilities.+   | DisplayAcc   -- ^ Red, green, and green accumulation buffer precision in+                  --   bits and zero bits of alpha accumulation buffer precision.+                  --   Default is \"'IsAtLeast' @1@\" for red, green, and blue+                  --   capabilities, and \"'IsNotLessThan' @0@\" for the alpha+                  --   capability.+   | DisplayAlpha -- ^ Alpha color buffer precision in bits. Default is+                  --   \"'IsAtLeast' @1@\".+   | DisplayDepth -- ^ Number of bits of precsion in the depth buffer. Default+                  --   is \"'IsAtLeast' @12@\".+   | DisplayStencil -- ^ Number of bits in the stencil buffer. Default is+                  --   \"'IsNotLessThan' @1@\".+   | DisplaySamples -- ^ Indicates the number of multisamples to use based on+                  --   GLX\'s @SGIS_multisample@ extension (for antialiasing).+                  --   Default is \"'IsNotGreaterThan' @4@\". This default means+                  --   that a GLUT application can request multisampling if+                  --   available by simply specifying \"'With' 'DisplaySamples'\".+   | DisplayStereo -- ^ Boolean indicating the color buffer is supports+                  --   OpenGL-style stereo. Default is \"'IsEqualTo' @1@\".+   | DisplayLuminance -- ^ Number of bits of red in the RGBA and zero bits of green,+                  --   blue (alpha not specified) of color buffer precision.+                  --   Default is \"'IsAtLeast' @1@\" for the red capabilitis,+                  --   and \"'IsEqualTo' @0@\" for the green and blue+                  --   capabilities, and \"'IsEqualTo' @1@\" for the RGBA color+                  --   model capability, and, for X11, \"'IsEqualTo' @1@\" for+                  --   the 'DisplayXStaticGray' capability. SGI InfiniteReality (and+                  --   other future machines) support a 16-bit luminance (single+                  --   channel) display mode (an additional 16-bit alpha channel+                  --   can also be requested). The red channel maps to gray+                  --   scale and green and blue channels are not available. A+                  --   16-bit precision luminance display mode is often+                  --   appropriate for medical imaging applications. Do not+                  --   expect many machines to support extended precision+                  --   luminance display modes.+   | DisplayAux   -- ^ (/freeglut only/) Number of auxiliary buffers. Default is+                  --   \"'IsEqualTo' @1@\".+   | DisplayNum   -- ^ A special capability name indicating where the value+                  --   represents the Nth frame buffer configuration matching+                  --   the description string. When not specified,+                  --   'initialDisplayCapabilities' also uses the first+                  --   (best matching) configuration. 'Num' requires a relation+                  --   and numeric value.+   | DisplayConformant -- ^ Boolean indicating if the frame buffer configuration is+                  --   conformant or not. Conformance information is based on+                  --   GLX\'s @EXT_visual_rating@ extension if supported. If the+                  --   extension is not supported, all visuals are assumed+                  --   conformant. Default is \"'IsEqualTo' @1@\".+   | DisplaySlow  -- ^ Boolean indicating if the frame buffer configuration is+                  --   slow or not. Slowness information is based on GLX\'s+                  --   @EXT_visual_rating@ extension if supported. If the+                  --   extension is not supported, all visuals are assumed fast.+                  --   Note that slowness is a relative designation relative to+                  --   other frame buffer configurations available. The intent+                  --   of the slow capability is to help programs avoid frame+                  --   buffer configurations that are slower (but perhaps higher+                  --   precision) for the current machine. Default is+                  --   \"'IsAtLeast' @0@\". This default means that slow visuals+                  --   are used in preference to fast visuals, but fast visuals+                  --   will still be allowed.+   | DisplayWin32PFD -- ^ Only recognized on GLUT implementations for Win32, this+                  --   capability name matches the Win32 Pixel Format Descriptor+                  --   by number. 'DisplayWin32PFD' can only be used with 'Where'.+   | DisplayXVisual -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, this capability name matches the X visual ID by+                  --   number. 'DisplayXVisual' requires a relation and numeric value.+   | DisplayXStaticGray -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @StaticGray@.+                  --   Default is \"'IsEqualTo' @1@\".+   | DisplayXGrayScale -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @GrayScale@. Default+                  --   is \"'IsEqualTo' @1@\".+   | DisplayXStaticColor -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @StaticColor@.+                  --   Default is \"'IsEqualTo' @1@\".+   | DisplayXPseudoColor -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @PsuedoColor@.+                  --   Default is \"'IsEqualTo' @1@\".+   | DisplayXTrueColor -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @TrueColor@. Default+                  --   is \"'IsEqualTo' @1@\".+   | DisplayXDirectColor -- ^ Only recongized on GLUT implementations for the X Window+                  --   System, boolean indicating if the frame buffer+                  --   configuration\'s X visual is of type @DirectColor@.+                  --   Default is \"'IsEqualTo' @1@\".+   deriving ( Eq, Ord, Show )++displayCapabilityToString :: DisplayCapability -> String+displayCapabilityToString x = case x of+   DisplayRGBA         -> "rgba"+   DisplayRGB          -> "rgb"+   DisplayRed          -> "red"+   DisplayGreen        -> "green"+   DisplayBlue         -> "blue"+   DisplayIndex        -> "index"+   DisplayBuffer       -> "buffer"+   DisplaySingle       -> "single"+   DisplayDouble       -> "double"+   DisplayAccA         -> "acca"+   DisplayAcc          -> "acc"+   DisplayAlpha        -> "alpha"+   DisplayDepth        -> "depth"+   DisplayStencil      -> "stencil"+   DisplaySamples      -> "samples"+   DisplayStereo       -> "stereo"+   DisplayLuminance    -> "luminance"+   DisplayAux          -> "aux"+   DisplayNum          -> "num"+   DisplayConformant   -> "conformant"+   DisplaySlow         -> "slow"+   DisplayWin32PFD     -> "win32pfd"+   DisplayXVisual      -> "xvisual"+   DisplayXStaticGray  -> "xstaticgray"+   DisplayXGrayScale   -> "xgrayscale"+   DisplayXStaticColor -> "xstaticcolor"+   DisplayXPseudoColor -> "xpseudocolor"+   DisplayXTrueColor   -> "xtruecolor"+   DisplayXDirectColor -> "xdirectcolor"++-- | A single capability description for 'initialDisplayCapabilities'.++data DisplayCapabilityDescription+   = Where DisplayCapability Relation Int+     -- ^ A description of a capability with a specific relation to a numeric+     --   value.+   | With  DisplayCapability+     -- ^ When the relation and numeric value are not specified, each capability+     --   has a different default, see the different constructors of+     --   'DisplayCapability'.+   deriving ( Eq, Ord, Show )++displayCapabilityDescriptionToString ::  DisplayCapabilityDescription -> String+displayCapabilityDescriptionToString (Where c r i) =+   displayCapabilityToString c ++ relationToString r ++ show i+displayCapabilityDescriptionToString (With c) = displayCapabilityToString c++-- | Controls the /initial display mode/ used when creating top-level windows,+-- subwindows, and overlays to determine the OpenGL display mode for the+-- to-be-created window or overlay. It is described by a list of zero or more+-- capability descriptions, which are translated into a set of criteria used to+-- select the appropriate frame buffer configuration. The criteria are matched+-- in strict left to right order of precdence. That is, the first specified+-- criterion (leftmost) takes precedence over the later criteria for non-exact+-- criteria ('IsGreaterThan', 'IsLessThan', etc.). Exact criteria ('IsEqualTo',+-- 'IsNotEqualTo') must match exactly so precedence is not relevant.+--+-- Unspecified capability descriptions will result in unspecified criteria being+-- generated. These unspecified criteria help 'initialDisplayCapabilities'+-- behave sensibly with terse display mode descriptions.+--+-- Here is an example using 'initialDisplayCapabilities':+--+-- @+--    initialDisplayCapabilities $= [ With  DisplayRGB,+--                                    Where DisplayDepth IsAtLeast 16,+--                                    With  DisplaySamples,+--                                    Where DisplayStencil IsNotLessThan 2,+--                                    With  DisplayDouble ]+-- @+--+-- The above call requests a window with an RGBA color model (but requesting+-- no bits of alpha), a depth buffer with at least 16 bits of precision but+-- preferring more, multisampling if available, at least 2 bits of stencil+-- (favoring less stencil to more as long as 2 bits are available), and double+-- buffering.++initialDisplayCapabilities :: SettableStateVar [DisplayCapabilityDescription]+initialDisplayCapabilities =+   makeSettableStateVar $ \caps ->+      withCString+         (concat . intersperse " " . map displayCapabilityDescriptionToString $+          caps)+         glutInitDisplayString++-----------------------------------------------------------------------------++-- | How rendering context for new windows are created.++data RenderingContext+   = -- | Create a new context via @glXCreateContext@ or @wglCreateContext@+     --   (default).+     CreateNewContext+   | -- | Re-use the current rendering context.+     UseCurrentContext+   deriving ( Eq, Ord, Show )++marshalRenderingContext :: RenderingContext -> CInt+marshalRenderingContext CreateNewContext  = glut_CREATE_NEW_CONTEXT+marshalRenderingContext UseCurrentContext = glut_USE_CURRENT_CONTEXT++unmarshalRenderingContext :: CInt -> RenderingContext+unmarshalRenderingContext r+   | r == glut_CREATE_NEW_CONTEXT  = CreateNewContext+   | r == glut_USE_CURRENT_CONTEXT = UseCurrentContext+   | otherwise = error "unmarshalRenderingContext"++-----------------------------------------------------------------------------++-- | (/freeglut only/) Controls the creation of rendering contexts for new+-- windows.++renderingContext :: StateVar RenderingContext+renderingContext =+   makeStateVar+      (simpleGet unmarshalRenderingContext glut_RENDERING_CONTEXT)+      (glutSetOption glut_RENDERING_CONTEXT . marshalRenderingContext)++-----------------------------------------------------------------------------++-- | The kind of GLX rendering context used. Direct rendering provides a+-- performance advantage in some implementations. However, direct rendering+-- contexts cannot be shared outside a single process, and they may be unable+-- to render to GLX pixmaps.++data DirectRendering+   = -- | Rendering is always done through the X server. This corresponds to+     -- the command line argument @-indirect@, see 'initialize'.+     ForceIndirectContext+   | -- | Try to use direct rendering, silently using indirect rendering if this+     -- is not possible.+     AllowDirectContext+   | -- | Try to use direct rendering, issue a warning and use indirect+     -- rendering if this is not possible.+     TryDirectContext+   | -- | Try to use direct rendering, issue an error and terminate the program+     -- if this is not possible.This corresponds to the command line argument+     -- @-direct@, see 'initialize'.+     ForceDirectContext+   deriving ( Eq, Ord, Show )++marshalDirectRendering :: DirectRendering -> CInt+marshalDirectRendering x = case x of+   ForceIndirectContext -> glut_FORCE_INDIRECT_CONTEXT+   AllowDirectContext -> glut_ALLOW_DIRECT_CONTEXT+   TryDirectContext -> glut_TRY_DIRECT_CONTEXT+   ForceDirectContext -> glut_FORCE_DIRECT_CONTEXT++unmarshalDirectRendering :: CInt -> DirectRendering+unmarshalDirectRendering x+   | x == glut_FORCE_INDIRECT_CONTEXT = ForceIndirectContext+   | x == glut_ALLOW_DIRECT_CONTEXT = AllowDirectContext+   | x == glut_TRY_DIRECT_CONTEXT = TryDirectContext+   | x == glut_FORCE_DIRECT_CONTEXT = ForceDirectContext+   | otherwise = error ("unmarshalDirectRendering: illegal value " ++ show x)++-----------------------------------------------------------------------------++-- | (/freeglut on X11 only/) Controls which kind of rendering context is+-- created when a new one is required.++directRendering :: StateVar DirectRendering+directRendering =+   makeStateVar+      (simpleGet unmarshalDirectRendering glut_DIRECT_RENDERING)+      (glutSetOption glut_DIRECT_RENDERING . marshalDirectRendering)++-----------------------------------------------------------------------------++-- | (/freeglut only/) Controls the API major\/minor version of the OpenGL+-- context. If a version less than or equal to 2.1 is requested, the context+-- returned may implement any version no less than that requested and no+-- greater than 2.1. If version 3.0 is requested, the context returned must+-- implement exactly version 3.0. Versioning behavior once GL versions beyond+-- 3.0 are defined will be defined by an amendment to the OpenGL specification+-- to define dependencies on such GL versions.+--+-- 'Graphics.Rendering.OpenGL.GL.StringQueries.glVersion' and+-- 'Graphics.Rendering.OpenGL.GL.StringQueries.majorMinor' will return the+-- actual version supported by a context.+--+-- The default context version is (1, 0), which will typically return an+-- OpenGL 2.1 context, if one is available.++initialContextVersion :: StateVar (Int, Int)+initialContextVersion = makeStateVar getContextVersion setContextVersion++getContextVersion :: IO (Int, Int)+getContextVersion = do+   major <- simpleGet fromIntegral glut_INIT_MAJOR_VERSION+   minor <- simpleGet fromIntegral glut_INIT_MINOR_VERSION+   return (major, minor)++setContextVersion :: (Int, Int) -> IO ()+setContextVersion (major, minor) =+   glutInitContextVersion (fromIntegral major) (fromIntegral minor)++-----------------------------------------------------------------------------++-- | A flag affecting the rendering context to create, used in conjunction+-- with 'initialContextFlags'.++data ContextFlag+   = -- | Debug contexts are intended for use during application development,+     -- and provide additional runtime checking, validation, and logging+     -- functionality while possibly incurring performance penalties. The+     -- additional functionality provided by debug contexts may vary according+     -- to the implementation. In some cases a debug context may be identical+     -- to a non-debug context.+     DebugContext+   | -- | Forward-compatible contexts are defined only for OpenGL versions 3.0+     -- and later. They must not support functionality marked as /deprecated/+     -- by that version of the API, while a non-forward-compatible context must+     -- support all functionality in that version, deprecated or not.+     ForwardCompatibleContext+   deriving ( Eq, Ord, Show )++marshalContextFlag :: ContextFlag -> CInt+marshalContextFlag x = case x of+   DebugContext -> glut_DEBUG+   ForwardCompatibleContext -> glut_FORWARD_COMPATIBLE++-----------------------------------------------------------------------------++-- | (/freeglut only/) Controls the set of flags for the rendering context.++initialContextFlags :: StateVar [ContextFlag]+initialContextFlags = makeStateVar getContextFlags setContextFlags++getContextFlags :: IO [ContextFlag]+getContextFlags = simpleGet i2cfs glut_INIT_FLAGS++i2cfs :: CInt -> [ContextFlag]+i2cfs bitfield =+   [ c | c <- [ DebugContext, ForwardCompatibleContext ]+       , (fromIntegral bitfield .&. marshalContextFlag c) /= 0 ]++setContextFlags :: [ContextFlag] -> IO ()+setContextFlags = glutInitContextFlags . toBitfield marshalContextFlag+++-----------------------------------------------------------------------------++-- | An OpenGL API profile, affecting the rendering context to create, used+-- in conjunction with 'initialContextProfile'.++data ContextProfile+   = -- | The OpenGL /core/ profile, which all OpenGL 3.2 implementations+     -- are required to support.+      CoreProfile+   | -- | The OpenGL /compatibility/ profile, which is optional for OpenGL+     -- 3.2 implementations.+     CompatibilityProfile+   deriving ( Eq, Ord, Show )++marshalContextProfile :: ContextProfile -> CInt+marshalContextProfile x = case x of+   CoreProfile -> glut_CORE_PROFILE+   CompatibilityProfile -> glut_COMPATIBILITY_PROFILE++-----------------------------------------------------------------------------++-- | (/freeglut only/) Controls the set of profiles for the rendering context.++initialContextProfile :: StateVar [ContextProfile]+initialContextProfile = makeStateVar getContextProfiles setContextProfiles++getContextProfiles :: IO [ContextProfile]+getContextProfiles = simpleGet i2cps glut_INIT_PROFILE++i2cps :: CInt -> [ContextProfile]+i2cps bitfield =+   [ c | c <- [ CoreProfile, CompatibilityProfile ]+       , (fromIntegral bitfield .&. marshalContextProfile c) /= 0 ]++setContextProfiles :: [ContextProfile] -> IO ()+setContextProfiles = glutInitContextProfile . toBitfield marshalContextProfile
+ src/Graphics/UI/GLUT/Menu.hs view
@@ -0,0 +1,265 @@+{-# OPTIONS_GHC -fno-cse #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Menu+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT supports simple cascading pop-up menus. They are designed to let a user+-- select various modes within a program. The functionality is simple and+-- minimalistic and is meant to be that way. Do not mistake GLUT\'s pop-up menu+-- facility with an attempt to create a full-featured user interface.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Menu (+   Menu(..), MenuItem(..), MenuCallback, attachMenu,+   numMenuItems+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Control.Monad ( when, unless, zipWithM )+import Data.Array ( listArray, (!) )+import Data.IORef ( IORef, newIORef, readIORef, modifyIORef )+import qualified Data.Map as M+import Data.StateVar ( get, ($=), GettableStateVar, makeGettableStateVar+                     , StateVar, makeStateVar )+import Foreign.C.String ( withCString )+import Foreign.C.Types ( CInt )+import Foreign.Ptr ( freeHaskellFunPtr )+import System.IO.Unsafe ( unsafePerformIO )++import Graphics.UI.GLUT.Callbacks.Registration+import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | A menu is simply a list of menu items, possibly with an associated font.+data Menu+   = Menu [MenuItem]+   | MenuWithFont BitmapFont [MenuItem]++menuFont :: Menu -> Maybe BitmapFont+menuFont (Menu _) = Nothing+menuFont (MenuWithFont font _) = Just font++menuItems :: Menu -> [MenuItem]+menuItems (Menu items) = items+menuItems (MenuWithFont _ items) = items++-- | A single item within a menu can either be a plain menu entry or a sub-menu+-- entry, allowing for arbitrarily deep nested menus.+data MenuItem+   = MenuEntry String MenuCallback -- ^ A plain menu entry with an associated+                                   --   callback, which is triggered when the+                                   --   user selects the entry+   | SubMenu   String Menu         -- ^ A sub-menu, which is cascaded when the+                                   --   user selects the entry, allowing+                                   --   sub-menu entries to be selected++type MenuCallback = IO ()++-- | Create a new pop-up menu for the /current window,/ attaching it to the+-- given mouse button. A previously attached menu (if any), is detached before+-- and won\'t receive callbacks anymore.+--+-- It is illegal to call 'attachMenu' while any (sub-)menu is in use, i.e.+-- popped up.+--+-- /X Implementation Notes:/ If available, GLUT for X will take advantage of+-- overlay planes for implementing pop-up menus. The use of overlay planes can+-- eliminate display callbacks when pop-up menus are deactivated. The+-- @SERVER_OVERLAY_VISUALS@ convention is used to determine if overlay visuals+-- are available.++attachMenu :: MonadIO m => MouseButton -> Menu -> m ()+attachMenu mouseButton menu = liftIO $ do+   win <- getCurrentWindow "attachMenu"+   let hook = MenuHook win mouseButton+   detachMenu hook+   unless (null (menuItems menu)) $ do+      (_, destructor) <- traverseMenu menu+      addToMenuTable hook destructor+      attachMenu_ mouseButton++detachMenu :: MenuHook -> IO ()+detachMenu hook@(MenuHook _ mouseButton) = do+   maybeDestructor <- lookupInMenuTable hook+   case maybeDestructor of+      Nothing         -> return ()+      Just destructor -> do detachMenu_ mouseButton+                            destructor+   deleteFromMenuTable hook++traverseMenu :: Menu -> IO (MenuID, Destructor)+traverseMenu menu = do+   let items = menuItems menu+       callbackArray = listArray (1, length items) (map makeCallback items)+   cb <- makeMenuFunc (\i -> callbackArray ! (fromIntegral i))+   menuID <- glutCreateMenu cb+   maybe (return ()) (setMenuFont menuID) (menuFont menu)+   destructors <- zipWithM addMenuItem items [1..]+   let destructor = do sequence_ destructors+                       glutDestroyMenu menuID+                       freeHaskellFunPtr cb+   return (menuID, destructor)++makeCallback :: MenuItem -> MenuCallback+makeCallback (MenuEntry _ cb) = cb+makeCallback _ = error "shouldn't receive a callback for submenus"++addMenuItem :: MenuItem -> Value -> IO Destructor+addMenuItem (MenuEntry s _) v = do+   addMenuEntry s v+   return $ glutRemoveMenuItem 1+addMenuItem (SubMenu s m) _ = do+   (menuID, destructor) <- saveExcursion (traverseMenu m)+   addSubMenu s menuID+   return $ do glutRemoveMenuItem 1+               destructor++-- Perform an action, saving/restoring the current menu around it+saveExcursion :: IO a -> IO a+saveExcursion act = do+   menuID <- get currentMenu+   returnValue <- act+   when (isRealMenu menuID) $+      currentMenu $= menuID+   return returnValue++--------------------------------------------------------------------------------+-- This seems to be a common Haskell hack nowadays: A plain old global variable+-- with an associated mutator. Perhaps some language/library support is needed?++{-# NOINLINE theMenuTable #-}+theMenuTable :: IORef MenuTable+theMenuTable = unsafePerformIO (newIORef emptyMenuTable)++getMenuTable :: IO MenuTable+getMenuTable = readIORef theMenuTable++modifyMenuTable :: (MenuTable -> MenuTable) -> IO ()+modifyMenuTable = modifyIORef theMenuTable++--------------------------------------------------------------------------------+-- To facilitate cleanup, we have to keep track how to destroy menus which are+-- currently attached in a window to a mouse button.++data MenuHook = MenuHook Window MouseButton+   deriving ( Eq, Ord )++type Destructor = IO ()++type MenuTable = M.Map MenuHook Destructor++emptyMenuTable :: MenuTable+emptyMenuTable = M.empty++lookupInMenuTable :: MenuHook -> IO (Maybe Destructor)+lookupInMenuTable callbackID =+   fmap (M.lookup callbackID) getMenuTable++deleteFromMenuTable :: MenuHook -> IO ()+deleteFromMenuTable callbackID =+   modifyMenuTable (M.delete callbackID)++addToMenuTable :: MenuHook -> Destructor -> IO ()+addToMenuTable callbackID funPtr =+   modifyMenuTable (M.insert callbackID funPtr)++--------------------------------------------------------------------------------++type MenuID = CInt+type Value  = CInt++--------------------------------------------------------------------------------++-- | Controls the /current menu./ If no menus exist or the previous /current+-- menu/ was destroyed, a pseudo menu is returned.++currentMenu :: StateVar MenuID+currentMenu = makeStateVar glutGetMenu glutSetMenu++-- | Returns 'True' if the given menu identifier refers to a real menu, not+-- a pseudo one.++isRealMenu :: MenuID -> Bool+isRealMenu = (/= 0)++--------------------------------------------------------------------------------++-- | Add a menu entry to the bottom of the /current menu./ The given string will+-- be displayed for the newly added menu entry. If the menu entry is selected by+-- the user, the menu\'s callback will be called passing the given value as the+-- callback\'s parameter.++addMenuEntry :: String -> Value -> IO ()+addMenuEntry name value = withCString name $ \n -> glutAddMenuEntry n value++-- | Add a sub-menu trigger to the bottom of the /current menu./ The given+-- string will be displayed for the newly added sub-menu trigger. If the+-- sub-menu trigger is entered, the sub-menu specified by the given menu+-- identifier will be cascaded, allowing sub-menu menu items to be selected.++addSubMenu :: String -> MenuID -> IO ()+addSubMenu name menuID = withCString name $ \n -> glutAddSubMenu n menuID++--------------------------------------------------------------------------------++{- UNUSED+-- | Change the specified menu entry in the /current menu/ into a menu entry.+-- The given position determines which menu item should be changed and must be+-- between 1 (the topmost menu item) and+-- 'Graphics.UI.GLUT.State.getNumMenuItems' inclusive. The menu item to change+-- does not have to be a menu entry already. The given string will be displayed+-- for the newly changed menu entry. The given value will be returned to the+-- menu\'s callback if this menu entry is selected.++foreign import CALLCONV unsafe "glutChangeToMenuEntry" glutChangeToMenuEntry ::+   Item -> CString -> Value -> IO ()++-- | Change the specified menu item in the /current menu/ into a sub-menu+-- trigger. The  given position determines which menu item should be changed and+-- must be between 1 and 'Graphics.UI.GLUT.State.getNumMenuItems' inclusive. The+-- menu item to change does not have to be a sub-menu trigger already. The+-- given name will be displayed for the newly changed sub-menu trigger. The+-- given menu identifier names the sub-menu to cascade from the newly added+-- sub-menu trigger.++foreign import CALLCONV unsafe "glutChangeToSubMenu" glutChangeToSubMenu ::+   Item -> CString -> MenuID -> IO ()+-}++--------------------------------------------------------------------------------++-- | Attach a mouse button for the /current window/ to the identifier of the+-- /current menu./ By attaching a menu identifier to a button, the named menu+-- will be popped up when the user presses the specified button. Note that the+-- menu is attached to the button by identifier, not by reference.++attachMenu_ :: MouseButton -> IO ()+attachMenu_ = glutAttachMenu . marshalMouseButton++-- | Detach an attached mouse button from the /current window./++detachMenu_ :: MouseButton -> IO ()+detachMenu_ = glutDetachMenu . marshalMouseButton++--------------------------------------------------------------------------------++-- | Contains the number of menu items in the /current menu./++numMenuItems :: GettableStateVar Int+numMenuItems = makeGettableStateVar $ simpleGet fromIntegral glut_MENU_NUM_ITEMS++--------------------------------------------------------------------------------++setMenuFont :: MenuID -> BitmapFont -> IO ()+setMenuFont menuID font = glutSetMenuFont menuID =<< marshalBitmapFont font
+ src/Graphics/UI/GLUT/Objects.hs view
@@ -0,0 +1,183 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Objects+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT includes a number of routines for generating easily recognizable 3D+-- geometric objects. These routines reflect functionality available in the+-- @aux@ toolkit described in the /OpenGL Programmer\'s Guide/ and are included+-- in GLUT to allow the construction of simple GLUT programs that render+-- recognizable objects. These routines can be implemented as pure OpenGL+-- rendering routines. The routines do not generate display lists for the+-- objects they create. The routines generate normals appropriate for lighting+-- but do not generate texture coordinates (except for the solid teapot, teacup+-- and teaspoon). If VBOs should be used instead of the fixed function pipeline,+-- specify at least one of the attribute locations+-- 'Graphics.UI.GLUT.State.vertexAttribCoord3' or+-- 'Graphics.UI.GLUT.State.vertexAttribNormal'.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Objects (+   -- * Rendering flavour+   Flavour(..),++   -- * Object description+   Object(..),++   -- * Type synonyms+   Sides, Rings, NumLevels,++   -- * Rendering+   renderObject+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Foreign.C.Types ( CInt )+import Foreign.Marshal.Utils ( with )+import Foreign.Ptr ( Ptr, castPtr )+import Graphics.Rendering.OpenGL (+  Height, Radius, Slices, Stacks, Vertex3(..), GLdouble, GLint )++import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++-- | Flavour of object rendering++data Flavour+   = -- | Object is rendered as a solid with shading and surface normals.+     Solid+   | -- | Object is rendered as a wireframe without surface normals.+     Wireframe+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++-- | GLUT offers five types of objects:+--+-- *  The five Platonic solids, see+--    <http://mathworld.wolfram.com/PlatonicSolid.html>.+--+-- * A rhombic dodecahedron, see+--   <http://mathworld.wolfram.com/RhombicDodecahedron.html>.+--+-- * Approximations to rounded objects.+--+-- * The classic teaset modeled by Martin Newell in 1975. Both surface normals+--   and texture coordinates for the teaset are generated.+--+-- * A Sierpinski sponge, see+--   <http://mathworld.wolfram.com/Tetrix.html>.++data Object+   = -- | A cube centered at the modeling coordinates origin with sides of the+     --   given length.+     Cube Height+   | -- | A dodecahedron (12-sided regular solid) centered at the modeling+     --   coordinates origin with a radius of @sqrt 3@.+     Dodecahedron+   | -- | A icosahedron (20-sided regular solid) centered at the modeling+     --   coordinates origin with a radius of 1.0.+     Icosahedron+   | -- | Render a solid octahedron (8-sided regular solid) centered at the+     --   modeling coordinates origin with a radius of 1.0.+     Octahedron+   | -- | Render a solid tetrahedron (4-sided regular solid) centered at the+     --   modeling coordinates origin with a radius of @sqrt 3@.+     Tetrahedron+   | -- | (/freeglut only/) A rhombic dodecahedron whose corners are at most a+     -- distance of one from the origin. The rhombic dodecahedron has faces+     -- which are identical rhombi, but which have some vertices at which three+     -- faces meet and some vertices at which four faces meet. The length of+     -- each side is @(sqrt 3)\/2@. Vertices at which four faces meet are found+     -- at @(0, 0, +\/-1)@ and @(+\/-(sqrt 2)\/2, +\/-(sqrt 2)\/2, 0)@.+     RhombicDodecahedron+   | -- | A sphere centered at the modeling coordinates origin of the specified+     --   radius. The sphere is subdivided around the Z axis into slices+     --   (similar to lines of longitude) and along the Z axis into stacks+     --   (similar to lines of latitude).+     Sphere' Radius Slices Stacks+   | -- | A cone oriented along the Z axis. The base of the cone is placed at Z+     --   = 0, and the top at Z = the given height. The cone is subdivided+     --   around the Z axis into slices, and along the Z axis into stacks.+     Cone Radius Height Slices Stacks+   | -- |(/freeglut only/) A cylinder oriented along the Z axis. The base of the+     --  cylinder is placed at Z = 0, and the top at Z = the given height. The+     --  cylinder is subdivided around the Z axis into slices, and along the Z+     -- axis into stacks.+     Cylinder' Radius Height Slices Stacks+   | -- | A torus (doughnut) centered at the modeling coordinates origin+     -- whose axis is aligned with the Z axis. The torus is described by its+     -- inner and outer radius, the number of sides for each radial section,+     -- and the number of radial divisions (rings).+     Torus Radius Radius Sides Rings+   | -- | A teapot with a given relative size.+     Teapot Height+   | -- |(/freeglut only/) A teacup with a given relative size.+     Teacup Height+   | -- |(/freeglut only/) A teaspoon with a given relative size.+     Teaspoon Height+   | -- |(/freeglut only/) A Sierpinski sponge of a given level, where a level+     -- 0 sponge is the same as a 'Tetrahedron'.+     SierpinskiSponge NumLevels+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++type Sides     = GLint+type Rings     = GLint+type NumLevels = GLint++--------------------------------------------------------------------------------++-- | Render an object in the given flavour.++renderObject :: MonadIO m => Flavour -> Object -> m ()+renderObject Solid     (Cube h)             = glutSolidCube h+renderObject Wireframe (Cube h)             = glutWireCube  h+renderObject Solid     Dodecahedron         = glutSolidDodecahedron+renderObject Wireframe Dodecahedron         = glutWireDodecahedron+renderObject Solid     Icosahedron          = glutSolidIcosahedron+renderObject Wireframe Icosahedron          = glutWireIcosahedron+renderObject Solid     Octahedron           = glutSolidOctahedron+renderObject Wireframe Octahedron           = glutWireOctahedron+renderObject Solid     Tetrahedron          = glutSolidTetrahedron+renderObject Wireframe Tetrahedron          = glutWireTetrahedron+renderObject Solid     RhombicDodecahedron  = glutSolidRhombicDodecahedron+renderObject Wireframe RhombicDodecahedron  = glutWireRhombicDodecahedron+renderObject Solid     (Sphere' r s t)      = glutSolidSphere r s t+renderObject Wireframe (Sphere' r s t)      = glutWireSphere  r s t+renderObject Solid     (Cone r h s t)       = glutSolidCone r h s t+renderObject Wireframe (Cone r h s t)       = glutWireCone  r h s t+renderObject Solid     (Cylinder' r h s t)  = glutSolidCylinder r h s t+renderObject Wireframe (Cylinder' r h s t)  = glutWireCylinder r h s t+renderObject Solid     (Torus i o s r)      = glutSolidTorus i o s r+renderObject Wireframe (Torus i o s r)      = glutWireTorus  i o s r+renderObject Solid     (Teapot h)           = glutSolidTeapot h+renderObject Wireframe (Teapot h)           = glutWireTeapot  h+renderObject Solid     (Teacup h)           = glutSolidTeacup h+renderObject Wireframe (Teacup h)           = glutWireTeacup  h+renderObject Solid     (Teaspoon h)         = glutSolidTeaspoon h+renderObject Wireframe (Teaspoon h)         = glutWireTeaspoon  h+renderObject Solid     (SierpinskiSponge n) = solidSierpinskiSponge n+renderObject Wireframe (SierpinskiSponge n) = wireSierpinskiSponge n++--------------------------------------------------------------------------------++solidSierpinskiSponge :: MonadIO m => NumLevels -> m ()+solidSierpinskiSponge = sierpinskiSponge glutSolidSierpinskiSponge++wireSierpinskiSponge :: MonadIO m => NumLevels -> m ()+wireSierpinskiSponge = sierpinskiSponge glutWireSierpinskiSponge++-- for consistency, we hide the offset and scale on the Haskell side+sierpinskiSponge :: MonadIO m => (CInt -> Ptr GLdouble -> Height -> IO ()) -> NumLevels -> m ()+sierpinskiSponge f n = liftIO $+   with (Vertex3 0 0 0) $ \offsetBuf ->+      f (fromIntegral n) ((castPtr :: Ptr (Vertex3 GLdouble) -> Ptr GLdouble) offsetBuf) 1
+ src/Graphics/UI/GLUT/Overlay.hs view
@@ -0,0 +1,171 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Overlay+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- When  overlay hardware is available, GLUT provides a set of routines for+-- establishing, using, and removing an overlay for GLUT windows. When an+-- overlay is established, a separate OpenGL context is also established. A+-- window\'s overlay OpenGL state is kept distinct from the normal planes\'+-- OpenGL state.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Overlay (+   -- * Overlay creation and destruction+   hasOverlay, overlayPossible,++   -- * Showing and hiding an overlay+   overlayVisible,++   -- * Changing the /layer in use/+   Layer(..), layerInUse,++   -- * Re-displaying+   postOverlayRedisplay+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( GettableStateVar, makeGettableStateVar+                     , SettableStateVar, makeSettableStateVar+                     , StateVar, makeStateVar )+import Graphics.Rendering.OpenGL ( GLenum )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- | Controls the overlay for the /current window/. The requested display mode+-- for the overlay is determined by the /initial display mode/.+-- 'overlayPossible' can be used to determine if an overlay is possible for the+-- /current window/ with the current /initial display mode/. Do not attempt to+-- establish an overlay when one is not possible; GLUT will terminate the+-- program.+--+-- When 'hasOverlay' is set to 'True' when an overlay already exists, the+-- existing overlay is first removed, and then a new overlay is established. The+-- state of the old overlay\'s OpenGL context is discarded. Implicitly, the+-- window\'s /layer in use/ changes to the overlay immediately after the overlay+-- is established.+--+-- The initial display state of an overlay is shown, however the overlay is only+-- actually shown if the overlay\'s window is shown.+--+-- Setting 'hasOverlay' to 'False' is safe even if no overlay is currently+-- established, nothing happens in this case. Implicitly, the window\'s /layer+-- in use/ changes to the normal plane immediately once the overlay is removed.+--+-- If the program intends to re-establish the overlay later, it is typically+-- faster and less resource intensive to use 'overlayVisible' to simply change+-- the display status of the overlay.+--+-- /X Implementation Notes:/ GLUT for X uses the @SERVER_OVERLAY_VISUALS@+-- convention to determine if overlay visuals are available. While the+-- convention allows for opaque overlays (no transparency) and overlays with the+-- transparency specified as a bitmask, GLUT overlay management only provides+-- access to transparent pixel overlays.+--+-- Until RGBA overlays are better understood, GLUT only supports color index+-- overlays.++hasOverlay :: StateVar Bool+hasOverlay = makeStateVar getHasOverlay setHasOverlay++setHasOverlay :: Bool -> IO ()+setHasOverlay False = glutRemoveOverlay+setHasOverlay True  = glutEstablishOverlay++getHasOverlay :: IO Bool+getHasOverlay = layerGet (/= 0) glut_HAS_OVERLAY++--------------------------------------------------------------------------------++-- | Contains 'True' if an overlay could be established for the /current window/+-- given the current /initial display mode/. If it contains 'False', setting+-- 'hasOverlay' will fail with a fatal error.++overlayPossible :: GettableStateVar Bool+overlayPossible = makeGettableStateVar $ layerGet (/= 0) glut_OVERLAY_POSSIBLE++--------------------------------------------------------------------------------++-- | Controls the visibility of the overlay of the /current window/.+--+-- The effect of showing or hiding an overlay takes place immediately. Note that+-- setting 'overlayVisible' to 'True' will not actually display the overlay+-- unless the window is also shown (and even a shown window may be obscured by+-- other windows, thereby obscuring the overlay). It is typically faster and+-- less resource intensive to use the routines below to control the display+-- status of an overlay as opposed to removing and re-establishing the overlay.++overlayVisible :: SettableStateVar Bool+overlayVisible =+   makeSettableStateVar $ \flag ->+      if flag then glutShowOverlay else glutHideOverlay++--------------------------------------------------------------------------------++-- | The /layer in use/.+data Layer+   = Normal   -- ^ The normal plane.+   | Overlay  -- ^ The overlay.+   deriving ( Eq, Ord, Show )++marshalLayer :: Layer -> GLenum+marshalLayer x = case x of+   Normal -> glut_NORMAL+   Overlay -> glut_OVERLAY++unmarshalLayer :: GLenum -> Layer+unmarshalLayer x+   | x == glut_NORMAL  = Normal+   | x == glut_OVERLAY = Overlay+   | otherwise = error ("unmarshalLayer: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | Controls the per-window /layer in use/ for the /current window/, which can+-- either be the normal plane or the overlay. Selecting the overlay should only+-- be done if an overlay exists, however windows without an overlay may still+-- set the /layer in use/ to 'Normal'. OpenGL commands for the window are+-- directed to the current /layer in use/.++layerInUse :: StateVar Layer+layerInUse =+   makeStateVar getLayerInUse setLayerInUse++setLayerInUse :: Layer -> IO ()+setLayerInUse = glutUseLayer . marshalLayer++getLayerInUse :: IO Layer+getLayerInUse = layerGet (unmarshalLayer . fromIntegral) glut_LAYER_IN_USE++--------------------------------------------------------------------------------++-- | Mark the overlay of the given window (or the /current window/, if none is+-- supplied) as needing to be redisplayed. The next iteration through+-- 'Graphics.UI.GLUT.Begin.mainLoop', the window\'s overlay display callback+-- (or simply the display callback if no overlay display callback is registered)+-- will be called to redisplay the window\'s overlay plane. Multiple calls to+-- 'postOverlayRedisplay' before the next display callback opportunity (or+-- overlay display callback opportunity if one is registered) generate only a+-- single redisplay. 'postOverlayRedisplay' may be called within a window\'s+-- display or overlay display callback to re-mark that window for redisplay.+--+-- Logically, overlay damage notification for a window is treated as a+-- 'postOverlayRedisplay' on the damaged window. Unlike damage reported by the+-- window system, 'postOverlayRedisplay' will not set to true the overlay\'s+-- damaged status (see 'Graphics.UI.GLUT.State.damaged').+--+-- Also, see 'Graphics.UI.GLUT.Window.postRedisplay'.++postOverlayRedisplay :: MonadIO m => Maybe Window -> m ()+postOverlayRedisplay =+   maybe glutPostOverlayRedisplay (\(Window win) -> glutPostWindowOverlayRedisplay win)
+ src/Graphics/UI/GLUT/QueryUtils.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.QueryUtils+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module with utilities to query GLUT state.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.QueryUtils (+  Getter, simpleGet, layerGet, deviceGet+) where++import Foreign.C.Types ( CInt )+import Graphics.Rendering.OpenGL ( GLenum )++import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++type PrimGetter =                GLenum -> IO CInt+type Getter a   = (CInt -> a) -> GLenum -> IO a++makeGetter :: PrimGetter -> Getter a+makeGetter g f = fmap f . g++simpleGet, layerGet, deviceGet :: Getter a+simpleGet = makeGetter glutGet+layerGet  = makeGetter glutLayerGet+deviceGet = makeGetter glutDeviceGet
+ src/Graphics/UI/GLUT/Raw.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Raw+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A convenience module, combining all raw GLUT modules.+--+-----------------------------------------------------------------------------++module Graphics.UI.GLUT.Raw (+   module Graphics.UI.GLUT.Raw.Callbacks,+   module Graphics.UI.GLUT.Raw.Fonts,+   module Graphics.UI.GLUT.Raw.Functions,+   module Graphics.UI.GLUT.Raw.Tokens+) where++import Graphics.UI.GLUT.Raw.Callbacks+import Graphics.UI.GLUT.Raw.Fonts+import Graphics.UI.GLUT.Raw.Functions+import Graphics.UI.GLUT.Raw.Tokens
+ src/Graphics/UI/GLUT/Raw/Callbacks.hs view
@@ -0,0 +1,242 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Raw.Callbacks+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- All GLUT callbacks.+--+-----------------------------------------------------------------------------++module Graphics.UI.GLUT.Raw.Callbacks (+   AppStatusFunc, makeAppStatusFunc,+   ButtonBoxFunc, makeButtonBoxFunc,+   CloseFunc, makeCloseFunc,+   DialsFunc, makeDialsFunc,+   DisplayFunc, makeDisplayFunc,+   EntryFunc, makeEntryFunc,+   IdleFunc, makeIdleFunc,+   InitContextFunc, makeInitContextFunc,+   JoystickFunc, makeJoystickFunc,+   KeyboardFunc, makeKeyboardFunc,+   KeyboardUpFunc, makeKeyboardUpFunc,+   MenuDestroyFunc, makeMenuDestroyFunc,+   MenuFunc, makeMenuFunc,+   MenuStateFunc, makeMenuStateFunc,+   MenuStatusFunc, makeMenuStatusFunc,+   MotionFunc, makeMotionFunc,+   MouseFunc, makeMouseFunc,+   MouseWheelFunc, makeMouseWheelFunc,+   MultiButtonFunc, makeMultiButtonFunc,+   MultiEntryFunc, makeMultiEntryFunc,+   MultiMotionFunc, makeMultiMotionFunc,+   MultiPassiveFunc, makeMultiPassiveFunc,+   OverlayDisplayFunc, makeOverlayDisplayFunc,+   PassiveMotionFunc, makePassiveMotionFunc,+   PositionFunc, makePositionFunc,+   ReshapeFunc, makeReshapeFunc,+   SpaceballButtonFunc, makeSpaceballButtonFunc,+   SpaceballMotionFunc, makeSpaceballMotionFunc,+   SpaceballRotateFunc, makeSpaceballRotateFunc,+   SpecialFunc, makeSpecialFunc,+   SpecialUpFunc, makeSpecialUpFunc,+   TabletButtonFunc, makeTabletButtonFunc,+   TabletMotionFunc, makeTabletMotionFunc,+   TimerFunc, makeTimerFunc,+   VisibilityFunc, makeVisibilityFunc,+   WMCloseFunc, makeWMCloseFunc,+   WindowStatusFunc, makeWindowStatusFunc+) where++import Foreign.C.Types+import Foreign.Ptr++type AppStatusFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeAppStatusFunc :: AppStatusFunc -> IO (FunPtr AppStatusFunc)++type ButtonBoxFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeButtonBoxFunc :: ButtonBoxFunc -> IO (FunPtr ButtonBoxFunc)++type CloseFunc = IO ()++foreign import ccall "wrapper"+   makeCloseFunc :: CloseFunc -> IO (FunPtr CloseFunc)++type DialsFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeDialsFunc :: DialsFunc -> IO (FunPtr DialsFunc)++type DisplayFunc = IO ()++foreign import ccall "wrapper"+   makeDisplayFunc :: DisplayFunc -> IO (FunPtr DisplayFunc)++type EntryFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeEntryFunc :: EntryFunc -> IO (FunPtr EntryFunc)++type IdleFunc = IO ()++foreign import ccall "wrapper"+   makeIdleFunc :: IdleFunc -> IO (FunPtr IdleFunc)++type InitContextFunc = IO ()++foreign import ccall "wrapper"+   makeInitContextFunc :: InitContextFunc -> IO (FunPtr InitContextFunc)++type JoystickFunc = CUInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeJoystickFunc :: JoystickFunc -> IO (FunPtr JoystickFunc)++type KeyboardFunc = CUChar -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeKeyboardFunc :: KeyboardFunc -> IO (FunPtr KeyboardFunc)++type KeyboardUpFunc = CUChar -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeKeyboardUpFunc :: KeyboardUpFunc -> IO (FunPtr KeyboardUpFunc)++type MenuDestroyFunc = IO ()++foreign import ccall "wrapper"+   makeMenuDestroyFunc :: MenuDestroyFunc -> IO (FunPtr MenuDestroyFunc)++type MenuFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeMenuFunc :: MenuFunc -> IO (FunPtr MenuFunc)++type MenuStateFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeMenuStateFunc :: MenuStateFunc -> IO (FunPtr MenuStateFunc)++type MenuStatusFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMenuStatusFunc :: MenuStatusFunc -> IO (FunPtr MenuStatusFunc)++type MotionFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMotionFunc :: MotionFunc -> IO (FunPtr MotionFunc)++type MouseFunc = CInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMouseFunc :: MouseFunc -> IO (FunPtr MouseFunc)++type MouseWheelFunc = CInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMouseWheelFunc :: MouseWheelFunc -> IO (FunPtr MouseWheelFunc)++type MultiButtonFunc = CInt -> CInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMultiButtonFunc :: MultiButtonFunc -> IO (FunPtr MultiButtonFunc)++type MultiEntryFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMultiEntryFunc :: MultiEntryFunc -> IO (FunPtr MultiEntryFunc)++type MultiMotionFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMultiMotionFunc :: MultiMotionFunc -> IO (FunPtr MultiMotionFunc)++type MultiPassiveFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeMultiPassiveFunc :: MultiPassiveFunc -> IO (FunPtr MultiPassiveFunc)++type OverlayDisplayFunc = IO ()++foreign import ccall "wrapper"+   makeOverlayDisplayFunc :: OverlayDisplayFunc -> IO (FunPtr OverlayDisplayFunc)++type PassiveMotionFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makePassiveMotionFunc :: PassiveMotionFunc -> IO (FunPtr PassiveMotionFunc)++type PositionFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makePositionFunc :: PositionFunc -> IO (FunPtr PositionFunc)++type ReshapeFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeReshapeFunc :: ReshapeFunc -> IO (FunPtr ReshapeFunc)++type SpaceballButtonFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeSpaceballButtonFunc :: SpaceballButtonFunc -> IO (FunPtr SpaceballButtonFunc)++type SpaceballMotionFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeSpaceballMotionFunc :: SpaceballMotionFunc -> IO (FunPtr SpaceballMotionFunc)++type SpaceballRotateFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeSpaceballRotateFunc :: SpaceballRotateFunc -> IO (FunPtr SpaceballRotateFunc)++type SpecialFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeSpecialFunc :: SpecialFunc -> IO (FunPtr SpecialFunc)++type SpecialUpFunc = CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeSpecialUpFunc :: SpecialUpFunc -> IO (FunPtr SpecialUpFunc)++type TabletButtonFunc = CInt -> CInt -> CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeTabletButtonFunc :: TabletButtonFunc -> IO (FunPtr TabletButtonFunc)++type TabletMotionFunc = CInt -> CInt -> IO ()++foreign import ccall "wrapper"+   makeTabletMotionFunc :: TabletMotionFunc -> IO (FunPtr TabletMotionFunc)++type TimerFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeTimerFunc :: TimerFunc -> IO (FunPtr TimerFunc)++type VisibilityFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeVisibilityFunc :: VisibilityFunc -> IO (FunPtr VisibilityFunc)++type WMCloseFunc = IO ()++foreign import ccall "wrapper"+   makeWMCloseFunc :: WMCloseFunc -> IO (FunPtr WMCloseFunc)++type WindowStatusFunc = CInt -> IO ()++foreign import ccall "wrapper"+   makeWindowStatusFunc :: WindowStatusFunc -> IO (FunPtr WindowStatusFunc)
+ src/Graphics/UI/GLUT/Raw/Fonts.hs view
@@ -0,0 +1,92 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Raw.Fonts+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Our own functions to access font identifiers in a portable way.+--+-----------------------------------------------------------------------------++module Graphics.UI.GLUT.Raw.Fonts (+   BitmapFont(..), GLUTbitmapFont, marshalBitmapFont,+   StrokeFont(..), GLUTstrokeFont, marshalStrokeFont+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Foreign.C.Types+import Foreign.Ptr ( Ptr )++--------------------------------------------------------------------------------++-- | The bitmap fonts available in GLUT. The exact bitmap to be used is+-- defined by the standard X glyph bitmaps for the X font with the given name.++data BitmapFont+   = Fixed8By13   -- ^ A fixed width font with every character fitting in an 8+                  --   by 13 pixel rectangle.+                  --   (@-misc-fixed-medium-r-normal--13-120-75-75-C-80-iso8859-1@)+   | Fixed9By15   -- ^ A fixed width font with every character fitting in an 9+                  --   by 15 pixel rectangle.+                  --   (@-misc-fixed-medium-r-normal--15-140-75-75-C-90-iso8859-1@)+   | TimesRoman10 -- ^ A 10-point proportional spaced Times Roman font.+                  --   (@-adobe-times-medium-r-normal--10-100-75-75-p-54-iso8859-1@)+   | TimesRoman24 -- ^ A 24-point proportional spaced Times Roman font.+                  --   (@-adobe-times-medium-r-normal--24-240-75-75-p-124-iso8859-1@)+   | Helvetica10  -- ^ A 10-point proportional spaced Helvetica font.+                  --   (@-adobe-helvetica-medium-r-normal--10-100-75-75-p-56-iso8859-1@)+   | Helvetica12  -- ^ A 12-point proportional spaced Helvetica font.+                  --   (@-adobe-helvetica-medium-r-normal--12-120-75-75-p-67-iso8859-1@)+   | Helvetica18  -- ^ A 18-point proportional spaced Helvetica font.+                  --   (@-adobe-helvetica-medium-r-normal--18-180-75-75-p-98-iso8859-1@)+   deriving ( Eq, Ord, Show )++-- Alas, fonts in GLUT are not denoted by some integral value, but by opaque+-- pointers on the C side. Even worse: For WinDoze, they are simply small ints,+-- casted to void*, for other platforms addresses of global variables are used.+-- And all is done via ugly #ifdef-ed #defines... Aaaaargl! So the only portable+-- way is using integers on the Haskell side and doing the marshaling via some+-- small C wrappers around those macros. *sigh*+type GLUTbitmapFont = Ptr ()++marshalBitmapFont :: MonadIO m => BitmapFont -> m GLUTbitmapFont+marshalBitmapFont x = liftIO $ case x of+   Fixed8By13 -> hs_GLUT_marshalBitmapFont 0+   Fixed9By15 -> hs_GLUT_marshalBitmapFont 1+   TimesRoman10 -> hs_GLUT_marshalBitmapFont 2+   TimesRoman24 -> hs_GLUT_marshalBitmapFont 3+   Helvetica10 -> hs_GLUT_marshalBitmapFont 4+   Helvetica12 -> hs_GLUT_marshalBitmapFont 5+   Helvetica18 -> hs_GLUT_marshalBitmapFont 6++foreign import ccall unsafe "hs_GLUT_marshalBitmapFont"+   hs_GLUT_marshalBitmapFont :: CInt -> IO (Ptr a)++--------------------------------------------------------------------------------++-- | The stroke fonts available in GLUT.+data StrokeFont+   = Roman     -- ^ A proportionally spaced Roman Simplex font for ASCII+               --   characters 32 through 127. The maximum top character in the+               --   font is 119.05 units; the bottom descends 33.33 units.+   | MonoRoman -- ^ A mono-spaced spaced Roman Simplex font (same characters as+               --   'Roman') for ASCII characters 32 through 127. The maximum+               --   top character in the font is 119.05 units; the bottom+               --   descends 33.33 units. Each character is 104.76 units wide.+   deriving ( Eq, Ord, Show )++-- Same remarks as for GLUTbitmapFont+type GLUTstrokeFont = Ptr ()++marshalStrokeFont :: MonadIO m => StrokeFont -> m GLUTstrokeFont+marshalStrokeFont x = liftIO $ case x of+   Roman -> hs_GLUT_marshalStrokeFont 0+   MonoRoman -> hs_GLUT_marshalStrokeFont 1++foreign import ccall unsafe "hs_GLUT_marshalStrokeFont"+   hs_GLUT_marshalStrokeFont :: CInt -> IO (Ptr a)
+ src/Graphics/UI/GLUT/Raw/Functions.hs view
@@ -0,0 +1,2267 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Raw.Functions+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- All raw functions from GLUT and freeglut.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Raw.Functions (+   isKnown,++   glutAddMenuEntry,+   glutAddSubMenu,+   glutAppStatusFunc,+   glutAttachMenu,+   glutBitmapCharacter,+   glutBitmapHeight,+   glutBitmapLength,+   glutBitmapString,+   glutBitmapWidth,+   glutButtonBoxFunc,+   glutChangeToMenuEntry,+   glutChangeToSubMenu,+   glutCloseFunc,+   glutCopyColormap,+   glutCreateMenu,+   glutCreateSubWindow,+   glutCreateWindow,+   glutDestroyMenu,+   glutDestroyWindow,+   glutDetachMenu,+   glutDeviceGet,+   glutDialsFunc,+   glutDisplayFunc,+   glutEnterGameMode,+   glutEntryFunc,+   glutEstablishOverlay,+   glutExit,+   glutExtensionSupported,+   glutForceJoystickFunc,+   glutFullScreen,+   glutFullScreenToggle,+   glutGameModeGet,+   glutGameModeString,+   glutGet,+   glutGetColor,+   glutGetMenu,+   glutGetMenuData,+   glutGetModeValues,+   glutGetModifiers,+   glutGetProcAddress,+   glutGetWindow,+   glutGetWindowData,+   glutHideOverlay,+   glutHideWindow,+   glutIconifyWindow,+   glutIdleFunc,+   glutIgnoreKeyRepeat,+   glutInit,+   glutInitContextFlags,+   glutInitContextFunc,+   glutInitContextProfile,+   glutInitContextVersion,+   glutInitDisplayMode,+   glutInitDisplayString,+   glutInitWindowPosition,+   glutInitWindowSize,+   glutJoystickFunc,+   glutKeyboardFunc,+   glutKeyboardUpFunc,+   glutLayerGet,+   glutLeaveFullScreen,+   glutLeaveGameMode,+   glutLeaveMainLoop,+   glutMainLoop,+   glutMainLoopEvent,+   glutMenuDestroyFunc,+   glutMenuStateFunc,+   glutMenuStatusFunc,+   glutMotionFunc,+   glutMouseFunc,+   glutMouseWheelFunc,+   glutMultiButtonFunc,+   glutMultiEntryFunc,+   glutMultiMotionFunc,+   glutMultiPassiveFunc,+   glutOverlayDisplayFunc,+   glutPassiveMotionFunc,+   glutPopWindow,+   glutPositionFunc,+   glutPositionWindow,+   glutPostOverlayRedisplay,+   glutPostRedisplay,+   glutPostWindowOverlayRedisplay,+   glutPostWindowRedisplay,+   glutPushWindow,+   glutRemoveMenuItem,+   glutRemoveOverlay,+   glutReportErrors,+   glutReshapeFunc,+   glutReshapeWindow,+   glutSetColor,+   glutSetCursor,+   glutSetIconTitle,+   glutSetKeyRepeat,+   glutSetMenu,+   glutSetMenuData,+   glutSetMenuFont,+   glutSetOption,+   glutSetVertexAttribCoord3,+   glutSetVertexAttribNormal,+   glutSetVertexAttribTexCoord2,+   glutSetWindow,+   glutSetWindowData,+   glutSetWindowTitle,+   glutSetupVideoResizing,+   glutShowOverlay,+   glutShowWindow,+   glutSolidCone,+   glutSolidCube,+   glutSolidCylinder,+   glutSolidDodecahedron,+   glutSolidIcosahedron,+   glutSolidOctahedron,+   glutSolidRhombicDodecahedron,+   glutSolidSierpinskiSponge,+   glutSolidSphere,+   glutSolidTeacup,+   glutSolidTeapot,+   glutSolidTeaspoon,+   glutSolidTetrahedron,+   glutSolidTorus,+   glutSpaceballButtonFunc,+   glutSpaceballMotionFunc,+   glutSpaceballRotateFunc,+   glutSpecialFunc,+   glutSpecialUpFunc,+   glutStopVideoResizing,+   glutStrokeCharacter,+   glutStrokeHeight,+   glutStrokeLength,+   glutStrokeString,+   glutStrokeWidth,+   glutSwapBuffers,+   glutTabletButtonFunc,+   glutTabletMotionFunc,+   glutTimerFunc,+   glutUseLayer,+   glutVideoPan,+   glutVideoResize,+   glutVideoResizeGet,+   glutVisibilityFunc,+   glutWMCloseFunc,+   glutWarpPointer,+   glutWindowStatusFunc,+   glutWireCone,+   glutWireCube,+   glutWireCylinder,+   glutWireDodecahedron,+   glutWireIcosahedron,+   glutWireOctahedron,+   glutWireRhombicDodecahedron,+   glutWireSierpinskiSponge,+   glutWireSphere,+   glutWireTeacup,+   glutWireTeapot,+   glutWireTeaspoon,+   glutWireTetrahedron,+   glutWireTorus+) where++-- Make the foreign imports happy.+import Foreign.C.Types++import Control.Monad.IO.Class ( MonadIO(..) )+import Foreign.C.String ( withCString, CString )+import Foreign.Marshal.Error ( throwIf )+import Foreign.Ptr ( Ptr, FunPtr, nullFunPtr )+import Graphics.Rendering.OpenGL ( GLdouble, GLenum, GLfloat, GLint )+import System.IO.Unsafe ( unsafePerformIO )++import Graphics.UI.GLUT.Raw.Callbacks++--------------------------------------------------------------------------------++-- | Retrieve a GLUT API entry by name. Throws a userError when no entry with+-- the given name was found.+getAPIEntry :: String -> IO (FunPtr a)+getAPIEntry extensionEntry =+  throwIfNullFunPtr ("unknown GLUT entry " ++ extensionEntry) $+    getAPIEntryInternal extensionEntry++throwIfNullFunPtr :: String -> IO (FunPtr a) -> IO (FunPtr a)+throwIfNullFunPtr = throwIf (== nullFunPtr) . const++getAPIEntryInternal :: String -> IO (FunPtr a)+getAPIEntryInternal extensionEntry =+   withCString extensionEntry hs_GLUT_getProcAddress++isKnown :: MonadIO m => String -> m Bool+isKnown = liftIO . fmap (/= nullFunPtr) . getAPIEntryInternal++foreign import ccall unsafe "hs_GLUT_getProcAddress"+  hs_GLUT_getProcAddress :: CString -> IO (FunPtr a)++-- glutAddMenuEntry ------------------------------------------------------------++glutAddMenuEntry :: MonadIO m => Ptr CChar -> CInt -> m ()+glutAddMenuEntry v1 v2 = liftIO $ dyn_glutAddMenuEntry ptr_glutAddMenuEntry v1 v2++foreign import CALLCONV "dynamic" dyn_glutAddMenuEntry+  :: FunPtr (Ptr CChar -> CInt -> IO ())+  ->         Ptr CChar -> CInt -> IO ()++{-# NOINLINE ptr_glutAddMenuEntry #-}+ptr_glutAddMenuEntry :: FunPtr a+ptr_glutAddMenuEntry = unsafePerformIO $ getAPIEntry "glutAddMenuEntry"++-- glutAddSubMenu --------------------------------------------------------------++glutAddSubMenu :: MonadIO m => Ptr CChar -> CInt -> m ()+glutAddSubMenu v1 v2 = liftIO $ dyn_glutAddSubMenu ptr_glutAddSubMenu v1 v2++foreign import CALLCONV "dynamic" dyn_glutAddSubMenu+  :: FunPtr (Ptr CChar -> CInt -> IO ())+  ->         Ptr CChar -> CInt -> IO ()++{-# NOINLINE ptr_glutAddSubMenu #-}+ptr_glutAddSubMenu :: FunPtr a+ptr_glutAddSubMenu = unsafePerformIO $ getAPIEntry "glutAddSubMenu"++-- glutAppStatusFunc -----------------------------------------------------------++glutAppStatusFunc :: MonadIO m => FunPtr AppStatusFunc -> m ()+glutAppStatusFunc v1 = liftIO $ dyn_glutAppStatusFunc ptr_glutAppStatusFunc v1++foreign import CALLCONV "dynamic" dyn_glutAppStatusFunc+  :: FunPtr (FunPtr AppStatusFunc -> IO ())+  ->         FunPtr AppStatusFunc -> IO ()++{-# NOINLINE ptr_glutAppStatusFunc #-}+ptr_glutAppStatusFunc :: FunPtr a+ptr_glutAppStatusFunc = unsafePerformIO $ getAPIEntry "glutAppStatusFunc"++-- glutAttachMenu --------------------------------------------------------------++glutAttachMenu :: MonadIO m => CInt -> m ()+glutAttachMenu v1 = liftIO $ dyn_glutAttachMenu ptr_glutAttachMenu v1++foreign import CALLCONV "dynamic" dyn_glutAttachMenu+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutAttachMenu #-}+ptr_glutAttachMenu :: FunPtr a+ptr_glutAttachMenu = unsafePerformIO $ getAPIEntry "glutAttachMenu"++-- glutBitmapCharacter ---------------------------------------------------------++glutBitmapCharacter :: MonadIO m => Ptr a -> CInt -> m ()+glutBitmapCharacter v1 v2 = liftIO $ dyn_glutBitmapCharacter ptr_glutBitmapCharacter v1 v2++foreign import CALLCONV "dynamic" dyn_glutBitmapCharacter+  :: FunPtr (Ptr a -> CInt -> IO ())+  ->         Ptr a -> CInt -> IO ()++{-# NOINLINE ptr_glutBitmapCharacter #-}+ptr_glutBitmapCharacter :: FunPtr a+ptr_glutBitmapCharacter = unsafePerformIO $ getAPIEntry "glutBitmapCharacter"++-- glutBitmapHeight ------------------------------------------------------------++glutBitmapHeight :: MonadIO m => Ptr a -> m CInt+glutBitmapHeight v1 = liftIO $ dyn_glutBitmapHeight ptr_glutBitmapHeight v1++foreign import CALLCONV "dynamic" dyn_glutBitmapHeight+  :: FunPtr (Ptr a -> IO CInt)+  ->         Ptr a -> IO CInt++{-# NOINLINE ptr_glutBitmapHeight #-}+ptr_glutBitmapHeight :: FunPtr a+ptr_glutBitmapHeight = unsafePerformIO $ getAPIEntry "glutBitmapHeight"++-- glutBitmapLength ------------------------------------------------------------++glutBitmapLength :: MonadIO m => Ptr a -> Ptr CUChar -> m CInt+glutBitmapLength v1 v2 = liftIO $ dyn_glutBitmapLength ptr_glutBitmapLength v1 v2++foreign import CALLCONV "dynamic" dyn_glutBitmapLength+  :: FunPtr (Ptr a -> Ptr CUChar -> IO CInt)+  ->         Ptr a -> Ptr CUChar -> IO CInt++{-# NOINLINE ptr_glutBitmapLength #-}+ptr_glutBitmapLength :: FunPtr a+ptr_glutBitmapLength = unsafePerformIO $ getAPIEntry "glutBitmapLength"++-- glutBitmapString ------------------------------------------------------------++glutBitmapString :: MonadIO m => Ptr a -> Ptr CUChar -> m ()+glutBitmapString v1 v2 = liftIO $ dyn_glutBitmapString ptr_glutBitmapString v1 v2++foreign import CALLCONV "dynamic" dyn_glutBitmapString+  :: FunPtr (Ptr a -> Ptr CUChar -> IO ())+  ->         Ptr a -> Ptr CUChar -> IO ()++{-# NOINLINE ptr_glutBitmapString #-}+ptr_glutBitmapString :: FunPtr a+ptr_glutBitmapString = unsafePerformIO $ getAPIEntry "glutBitmapString"++-- glutBitmapWidth -------------------------------------------------------------++glutBitmapWidth :: MonadIO m => Ptr a -> CInt -> m CInt+glutBitmapWidth v1 v2 = liftIO $ dyn_glutBitmapWidth ptr_glutBitmapWidth v1 v2++foreign import CALLCONV "dynamic" dyn_glutBitmapWidth+  :: FunPtr (Ptr a -> CInt -> IO CInt)+  ->         Ptr a -> CInt -> IO CInt++{-# NOINLINE ptr_glutBitmapWidth #-}+ptr_glutBitmapWidth :: FunPtr a+ptr_glutBitmapWidth = unsafePerformIO $ getAPIEntry "glutBitmapWidth"++-- glutButtonBoxFunc -----------------------------------------------------------++glutButtonBoxFunc :: MonadIO m => FunPtr ButtonBoxFunc -> m ()+glutButtonBoxFunc v1 = liftIO $ dyn_glutButtonBoxFunc ptr_glutButtonBoxFunc v1++foreign import CALLCONV "dynamic" dyn_glutButtonBoxFunc+  :: FunPtr (FunPtr ButtonBoxFunc -> IO ())+  ->         FunPtr ButtonBoxFunc -> IO ()++{-# NOINLINE ptr_glutButtonBoxFunc #-}+ptr_glutButtonBoxFunc :: FunPtr a+ptr_glutButtonBoxFunc = unsafePerformIO $ getAPIEntry "glutButtonBoxFunc"++-- glutChangeToMenuEntry -------------------------------------------------------++glutChangeToMenuEntry :: MonadIO m => CInt -> Ptr CChar -> CInt -> m ()+glutChangeToMenuEntry v1 v2 v3 = liftIO $ dyn_glutChangeToMenuEntry ptr_glutChangeToMenuEntry v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutChangeToMenuEntry+  :: FunPtr (CInt -> Ptr CChar -> CInt -> IO ())+  ->         CInt -> Ptr CChar -> CInt -> IO ()++{-# NOINLINE ptr_glutChangeToMenuEntry #-}+ptr_glutChangeToMenuEntry :: FunPtr a+ptr_glutChangeToMenuEntry = unsafePerformIO $ getAPIEntry "glutChangeToMenuEntry"++-- glutChangeToSubMenu ---------------------------------------------------------++glutChangeToSubMenu :: MonadIO m => CInt -> Ptr CChar -> CInt -> m ()+glutChangeToSubMenu v1 v2 v3 = liftIO $ dyn_glutChangeToSubMenu ptr_glutChangeToSubMenu v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutChangeToSubMenu+  :: FunPtr (CInt -> Ptr CChar -> CInt -> IO ())+  ->         CInt -> Ptr CChar -> CInt -> IO ()++{-# NOINLINE ptr_glutChangeToSubMenu #-}+ptr_glutChangeToSubMenu :: FunPtr a+ptr_glutChangeToSubMenu = unsafePerformIO $ getAPIEntry "glutChangeToSubMenu"++-- glutCloseFunc ---------------------------------------------------------------++glutCloseFunc :: MonadIO m => FunPtr CloseFunc -> m ()+glutCloseFunc v1 = liftIO $ dyn_glutCloseFunc ptr_glutCloseFunc v1++foreign import CALLCONV "dynamic" dyn_glutCloseFunc+  :: FunPtr (FunPtr CloseFunc -> IO ())+  ->         FunPtr CloseFunc -> IO ()++{-# NOINLINE ptr_glutCloseFunc #-}+ptr_glutCloseFunc :: FunPtr a+ptr_glutCloseFunc = unsafePerformIO $ getAPIEntry "glutCloseFunc"++-- glutCopyColormap ------------------------------------------------------------++glutCopyColormap :: MonadIO m => CInt -> m ()+glutCopyColormap v1 = liftIO $ dyn_glutCopyColormap ptr_glutCopyColormap v1++foreign import CALLCONV "dynamic" dyn_glutCopyColormap+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutCopyColormap #-}+ptr_glutCopyColormap :: FunPtr a+ptr_glutCopyColormap = unsafePerformIO $ getAPIEntry "glutCopyColormap"++-- glutCreateMenu --------------------------------------------------------------++glutCreateMenu :: MonadIO m => FunPtr MenuFunc -> m CInt+glutCreateMenu v1 = liftIO $ dyn_glutCreateMenu ptr_glutCreateMenu v1++foreign import CALLCONV "dynamic" dyn_glutCreateMenu+  :: FunPtr (FunPtr MenuFunc -> IO CInt)+  ->         FunPtr MenuFunc -> IO CInt++{-# NOINLINE ptr_glutCreateMenu #-}+ptr_glutCreateMenu :: FunPtr a+ptr_glutCreateMenu = unsafePerformIO $ getAPIEntry "glutCreateMenu"++-- glutCreateSubWindow ---------------------------------------------------------++glutCreateSubWindow :: MonadIO m => CInt -> CInt -> CInt -> CInt -> CInt -> m CInt+glutCreateSubWindow v1 v2 v3 v4 v5 = liftIO $ dyn_glutCreateSubWindow ptr_glutCreateSubWindow v1 v2 v3 v4 v5++foreign import CALLCONV "dynamic" dyn_glutCreateSubWindow+  :: FunPtr (CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt)+  ->         CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt++{-# NOINLINE ptr_glutCreateSubWindow #-}+ptr_glutCreateSubWindow :: FunPtr a+ptr_glutCreateSubWindow = unsafePerformIO $ getAPIEntry "glutCreateSubWindow"++-- glutCreateWindow ------------------------------------------------------------++glutCreateWindow :: MonadIO m => Ptr CChar -> m CInt+glutCreateWindow v1 = liftIO $ dyn_glutCreateWindow ptr_glutCreateWindow v1++foreign import CALLCONV "dynamic" dyn_glutCreateWindow+  :: FunPtr (Ptr CChar -> IO CInt)+  ->         Ptr CChar -> IO CInt++{-# NOINLINE ptr_glutCreateWindow #-}+ptr_glutCreateWindow :: FunPtr a+ptr_glutCreateWindow = unsafePerformIO $ getAPIEntry "glutCreateWindow"++-- glutDestroyMenu -------------------------------------------------------------++glutDestroyMenu :: MonadIO m => CInt -> m ()+glutDestroyMenu v1 = liftIO $ dyn_glutDestroyMenu ptr_glutDestroyMenu v1++foreign import CALLCONV "dynamic" dyn_glutDestroyMenu+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutDestroyMenu #-}+ptr_glutDestroyMenu :: FunPtr a+ptr_glutDestroyMenu = unsafePerformIO $ getAPIEntry "glutDestroyMenu"++-- glutDestroyWindow -----------------------------------------------------------++glutDestroyWindow :: MonadIO m => CInt -> m ()+glutDestroyWindow v1 = liftIO $ dyn_glutDestroyWindow ptr_glutDestroyWindow v1++foreign import CALLCONV "dynamic" dyn_glutDestroyWindow+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutDestroyWindow #-}+ptr_glutDestroyWindow :: FunPtr a+ptr_glutDestroyWindow = unsafePerformIO $ getAPIEntry "glutDestroyWindow"++-- glutDetachMenu --------------------------------------------------------------++glutDetachMenu :: MonadIO m => CInt -> m ()+glutDetachMenu v1 = liftIO $ dyn_glutDetachMenu ptr_glutDetachMenu v1++foreign import CALLCONV "dynamic" dyn_glutDetachMenu+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutDetachMenu #-}+ptr_glutDetachMenu :: FunPtr a+ptr_glutDetachMenu = unsafePerformIO $ getAPIEntry "glutDetachMenu"++-- glutDeviceGet ---------------------------------------------------------------++glutDeviceGet :: MonadIO m => GLenum -> m CInt+glutDeviceGet v1 = liftIO $ dyn_glutDeviceGet ptr_glutDeviceGet v1++foreign import CALLCONV "dynamic" dyn_glutDeviceGet+  :: FunPtr (GLenum -> IO CInt)+  ->         GLenum -> IO CInt++{-# NOINLINE ptr_glutDeviceGet #-}+ptr_glutDeviceGet :: FunPtr a+ptr_glutDeviceGet = unsafePerformIO $ getAPIEntry "glutDeviceGet"++-- glutDialsFunc ---------------------------------------------------------------++glutDialsFunc :: MonadIO m => FunPtr DialsFunc -> m ()+glutDialsFunc v1 = liftIO $ dyn_glutDialsFunc ptr_glutDialsFunc v1++foreign import CALLCONV "dynamic" dyn_glutDialsFunc+  :: FunPtr (FunPtr DialsFunc -> IO ())+  ->         FunPtr DialsFunc -> IO ()++{-# NOINLINE ptr_glutDialsFunc #-}+ptr_glutDialsFunc :: FunPtr a+ptr_glutDialsFunc = unsafePerformIO $ getAPIEntry "glutDialsFunc"++-- glutDisplayFunc -------------------------------------------------------------++glutDisplayFunc :: MonadIO m => FunPtr DisplayFunc -> m ()+glutDisplayFunc v1 = liftIO $ dyn_glutDisplayFunc ptr_glutDisplayFunc v1++foreign import CALLCONV "dynamic" dyn_glutDisplayFunc+  :: FunPtr (FunPtr DisplayFunc -> IO ())+  ->         FunPtr DisplayFunc -> IO ()++{-# NOINLINE ptr_glutDisplayFunc #-}+ptr_glutDisplayFunc :: FunPtr a+ptr_glutDisplayFunc = unsafePerformIO $ getAPIEntry "glutDisplayFunc"++-- glutEnterGameMode -----------------------------------------------------------++glutEnterGameMode :: MonadIO m => m CInt+glutEnterGameMode = liftIO $ dyn_glutEnterGameMode ptr_glutEnterGameMode++foreign import CALLCONV "dynamic" dyn_glutEnterGameMode+  :: FunPtr (IO CInt)+  ->         IO CInt++{-# NOINLINE ptr_glutEnterGameMode #-}+ptr_glutEnterGameMode :: FunPtr a+ptr_glutEnterGameMode = unsafePerformIO $ getAPIEntry "glutEnterGameMode"++-- glutEntryFunc ---------------------------------------------------------------++glutEntryFunc :: MonadIO m => FunPtr EntryFunc -> m ()+glutEntryFunc v1 = liftIO $ dyn_glutEntryFunc ptr_glutEntryFunc v1++foreign import CALLCONV "dynamic" dyn_glutEntryFunc+  :: FunPtr (FunPtr EntryFunc -> IO ())+  ->         FunPtr EntryFunc -> IO ()++{-# NOINLINE ptr_glutEntryFunc #-}+ptr_glutEntryFunc :: FunPtr a+ptr_glutEntryFunc = unsafePerformIO $ getAPIEntry "glutEntryFunc"++-- glutEstablishOverlay --------------------------------------------------------++glutEstablishOverlay :: MonadIO m => m ()+glutEstablishOverlay = liftIO $ dyn_glutEstablishOverlay ptr_glutEstablishOverlay++foreign import CALLCONV "dynamic" dyn_glutEstablishOverlay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutEstablishOverlay #-}+ptr_glutEstablishOverlay :: FunPtr a+ptr_glutEstablishOverlay = unsafePerformIO $ getAPIEntry "glutEstablishOverlay"++-- glutExit --------------------------------------------------------------------++glutExit :: MonadIO m => m ()+glutExit = liftIO $ dyn_glutExit ptr_glutExit++foreign import CALLCONV "dynamic" dyn_glutExit+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutExit #-}+ptr_glutExit :: FunPtr a+ptr_glutExit = unsafePerformIO $ getAPIEntry "glutExit"++-- glutExtensionSupported ------------------------------------------------------++glutExtensionSupported :: MonadIO m => Ptr CChar -> m CInt+glutExtensionSupported v1 = liftIO $ dyn_glutExtensionSupported ptr_glutExtensionSupported v1++foreign import CALLCONV "dynamic" dyn_glutExtensionSupported+  :: FunPtr (Ptr CChar -> IO CInt)+  ->         Ptr CChar -> IO CInt++{-# NOINLINE ptr_glutExtensionSupported #-}+ptr_glutExtensionSupported :: FunPtr a+ptr_glutExtensionSupported = unsafePerformIO $ getAPIEntry "glutExtensionSupported"++-- glutForceJoystickFunc -------------------------------------------------------++glutForceJoystickFunc :: MonadIO m => m ()+glutForceJoystickFunc = liftIO $ dyn_glutForceJoystickFunc ptr_glutForceJoystickFunc++foreign import CALLCONV "dynamic" dyn_glutForceJoystickFunc+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutForceJoystickFunc #-}+ptr_glutForceJoystickFunc :: FunPtr a+ptr_glutForceJoystickFunc = unsafePerformIO $ getAPIEntry "glutForceJoystickFunc"++-- glutFullScreen --------------------------------------------------------------++glutFullScreen :: MonadIO m => m ()+glutFullScreen = liftIO $ dyn_glutFullScreen ptr_glutFullScreen++foreign import CALLCONV "dynamic" dyn_glutFullScreen+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutFullScreen #-}+ptr_glutFullScreen :: FunPtr a+ptr_glutFullScreen = unsafePerformIO $ getAPIEntry "glutFullScreen"++-- glutFullScreenToggle --------------------------------------------------------++glutFullScreenToggle :: MonadIO m => m ()+glutFullScreenToggle = liftIO $ dyn_glutFullScreenToggle ptr_glutFullScreenToggle++foreign import CALLCONV "dynamic" dyn_glutFullScreenToggle+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutFullScreenToggle #-}+ptr_glutFullScreenToggle :: FunPtr a+ptr_glutFullScreenToggle = unsafePerformIO $ getAPIEntry "glutFullScreenToggle"++-- glutGameModeGet -------------------------------------------------------------++glutGameModeGet :: MonadIO m => GLenum -> m CInt+glutGameModeGet v1 = liftIO $ dyn_glutGameModeGet ptr_glutGameModeGet v1++foreign import CALLCONV "dynamic" dyn_glutGameModeGet+  :: FunPtr (GLenum -> IO CInt)+  ->         GLenum -> IO CInt++{-# NOINLINE ptr_glutGameModeGet #-}+ptr_glutGameModeGet :: FunPtr a+ptr_glutGameModeGet = unsafePerformIO $ getAPIEntry "glutGameModeGet"++-- glutGameModeString ----------------------------------------------------------++glutGameModeString :: MonadIO m => Ptr CChar -> m ()+glutGameModeString v1 = liftIO $ dyn_glutGameModeString ptr_glutGameModeString v1++foreign import CALLCONV "dynamic" dyn_glutGameModeString+  :: FunPtr (Ptr CChar -> IO ())+  ->         Ptr CChar -> IO ()++{-# NOINLINE ptr_glutGameModeString #-}+ptr_glutGameModeString :: FunPtr a+ptr_glutGameModeString = unsafePerformIO $ getAPIEntry "glutGameModeString"++-- glutGet ---------------------------------------------------------------------++glutGet :: MonadIO m => GLenum -> m CInt+glutGet v1 = liftIO $ dyn_glutGet ptr_glutGet v1++foreign import CALLCONV "dynamic" dyn_glutGet+  :: FunPtr (GLenum -> IO CInt)+  ->         GLenum -> IO CInt++{-# NOINLINE ptr_glutGet #-}+ptr_glutGet :: FunPtr a+ptr_glutGet = unsafePerformIO $ getAPIEntry "glutGet"++-- glutGetColor ----------------------------------------------------------------++glutGetColor :: MonadIO m => CInt -> CInt -> m GLfloat+glutGetColor v1 v2 = liftIO $ dyn_glutGetColor ptr_glutGetColor v1 v2++foreign import CALLCONV "dynamic" dyn_glutGetColor+  :: FunPtr (CInt -> CInt -> IO GLfloat)+  ->         CInt -> CInt -> IO GLfloat++{-# NOINLINE ptr_glutGetColor #-}+ptr_glutGetColor :: FunPtr a+ptr_glutGetColor = unsafePerformIO $ getAPIEntry "glutGetColor"++-- glutGetMenu -----------------------------------------------------------------++glutGetMenu :: MonadIO m => m CInt+glutGetMenu = liftIO $ dyn_glutGetMenu ptr_glutGetMenu++foreign import CALLCONV "dynamic" dyn_glutGetMenu+  :: FunPtr (IO CInt)+  ->         IO CInt++{-# NOINLINE ptr_glutGetMenu #-}+ptr_glutGetMenu :: FunPtr a+ptr_glutGetMenu = unsafePerformIO $ getAPIEntry "glutGetMenu"++-- glutGetMenuData -------------------------------------------------------------++glutGetMenuData :: MonadIO m => m (Ptr a)+glutGetMenuData = liftIO $ dyn_glutGetMenuData ptr_glutGetMenuData++foreign import CALLCONV "dynamic" dyn_glutGetMenuData+  :: FunPtr (IO (Ptr a))+  ->         IO (Ptr a)++{-# NOINLINE ptr_glutGetMenuData #-}+ptr_glutGetMenuData :: FunPtr a+ptr_glutGetMenuData = unsafePerformIO $ getAPIEntry "glutGetMenuData"++-- glutGetModeValues -----------------------------------------------------------++glutGetModeValues :: MonadIO m => GLenum -> Ptr CInt -> m (Ptr CInt)+glutGetModeValues v1 v2 = liftIO $ dyn_glutGetModeValues ptr_glutGetModeValues v1 v2++foreign import CALLCONV "dynamic" dyn_glutGetModeValues+  :: FunPtr (GLenum -> Ptr CInt -> IO (Ptr CInt))+  ->         GLenum -> Ptr CInt -> IO (Ptr CInt)++{-# NOINLINE ptr_glutGetModeValues #-}+ptr_glutGetModeValues :: FunPtr a+ptr_glutGetModeValues = unsafePerformIO $ getAPIEntry "glutGetModeValues"++-- glutGetModifiers ------------------------------------------------------------++glutGetModifiers :: MonadIO m => m CInt+glutGetModifiers = liftIO $ dyn_glutGetModifiers ptr_glutGetModifiers++foreign import CALLCONV "dynamic" dyn_glutGetModifiers+  :: FunPtr (IO CInt)+  ->         IO CInt++{-# NOINLINE ptr_glutGetModifiers #-}+ptr_glutGetModifiers :: FunPtr a+ptr_glutGetModifiers = unsafePerformIO $ getAPIEntry "glutGetModifiers"++-- glutGetProcAddress ----------------------------------------------------------++glutGetProcAddress :: MonadIO m => Ptr CChar -> m (FunPtr a)+glutGetProcAddress v1 = liftIO $ dyn_glutGetProcAddress ptr_glutGetProcAddress v1++foreign import CALLCONV "dynamic" dyn_glutGetProcAddress+  :: FunPtr (Ptr CChar -> IO (FunPtr a))+  ->         Ptr CChar -> IO (FunPtr a)++{-# NOINLINE ptr_glutGetProcAddress #-}+ptr_glutGetProcAddress :: FunPtr a+ptr_glutGetProcAddress = unsafePerformIO $ getAPIEntry "glutGetProcAddress"++-- glutGetWindow ---------------------------------------------------------------++glutGetWindow :: MonadIO m => m CInt+glutGetWindow = liftIO $ dyn_glutGetWindow ptr_glutGetWindow++foreign import CALLCONV "dynamic" dyn_glutGetWindow+  :: FunPtr (IO CInt)+  ->         IO CInt++{-# NOINLINE ptr_glutGetWindow #-}+ptr_glutGetWindow :: FunPtr a+ptr_glutGetWindow = unsafePerformIO $ getAPIEntry "glutGetWindow"++-- glutGetWindowData -----------------------------------------------------------++glutGetWindowData :: MonadIO m => m (Ptr a)+glutGetWindowData = liftIO $ dyn_glutGetWindowData ptr_glutGetWindowData++foreign import CALLCONV "dynamic" dyn_glutGetWindowData+  :: FunPtr (IO (Ptr a))+  ->         IO (Ptr a)++{-# NOINLINE ptr_glutGetWindowData #-}+ptr_glutGetWindowData :: FunPtr a+ptr_glutGetWindowData = unsafePerformIO $ getAPIEntry "glutGetWindowData"++-- glutHideOverlay -------------------------------------------------------------++glutHideOverlay :: MonadIO m => m ()+glutHideOverlay = liftIO $ dyn_glutHideOverlay ptr_glutHideOverlay++foreign import CALLCONV "dynamic" dyn_glutHideOverlay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutHideOverlay #-}+ptr_glutHideOverlay :: FunPtr a+ptr_glutHideOverlay = unsafePerformIO $ getAPIEntry "glutHideOverlay"++-- glutHideWindow --------------------------------------------------------------++glutHideWindow :: MonadIO m => m ()+glutHideWindow = liftIO $ dyn_glutHideWindow ptr_glutHideWindow++foreign import CALLCONV "dynamic" dyn_glutHideWindow+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutHideWindow #-}+ptr_glutHideWindow :: FunPtr a+ptr_glutHideWindow = unsafePerformIO $ getAPIEntry "glutHideWindow"++-- glutIconifyWindow -----------------------------------------------------------++glutIconifyWindow :: MonadIO m => m ()+glutIconifyWindow = liftIO $ dyn_glutIconifyWindow ptr_glutIconifyWindow++foreign import CALLCONV "dynamic" dyn_glutIconifyWindow+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutIconifyWindow #-}+ptr_glutIconifyWindow :: FunPtr a+ptr_glutIconifyWindow = unsafePerformIO $ getAPIEntry "glutIconifyWindow"++-- glutIdleFunc ----------------------------------------------------------------++glutIdleFunc :: MonadIO m => FunPtr IdleFunc -> m ()+glutIdleFunc v1 = liftIO $ dyn_glutIdleFunc ptr_glutIdleFunc v1++foreign import CALLCONV "dynamic" dyn_glutIdleFunc+  :: FunPtr (FunPtr IdleFunc -> IO ())+  ->         FunPtr IdleFunc -> IO ()++{-# NOINLINE ptr_glutIdleFunc #-}+ptr_glutIdleFunc :: FunPtr a+ptr_glutIdleFunc = unsafePerformIO $ getAPIEntry "glutIdleFunc"++-- glutIgnoreKeyRepeat ---------------------------------------------------------++glutIgnoreKeyRepeat :: MonadIO m => CInt -> m ()+glutIgnoreKeyRepeat v1 = liftIO $ dyn_glutIgnoreKeyRepeat ptr_glutIgnoreKeyRepeat v1++foreign import CALLCONV "dynamic" dyn_glutIgnoreKeyRepeat+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutIgnoreKeyRepeat #-}+ptr_glutIgnoreKeyRepeat :: FunPtr a+ptr_glutIgnoreKeyRepeat = unsafePerformIO $ getAPIEntry "glutIgnoreKeyRepeat"++-- glutInit --------------------------------------------------------------------++glutInit :: MonadIO m => Ptr CInt -> Ptr (Ptr CChar) -> m ()+glutInit v1 v2 = liftIO $ dyn_glutInit ptr_glutInit v1 v2++foreign import CALLCONV "dynamic" dyn_glutInit+  :: FunPtr (Ptr CInt -> Ptr (Ptr CChar) -> IO ())+  ->         Ptr CInt -> Ptr (Ptr CChar) -> IO ()++{-# NOINLINE ptr_glutInit #-}+ptr_glutInit :: FunPtr a+ptr_glutInit = unsafePerformIO $ getAPIEntry "glutInit"++-- glutInitContextFlags --------------------------------------------------------++glutInitContextFlags :: MonadIO m => CInt -> m ()+glutInitContextFlags v1 = liftIO $ dyn_glutInitContextFlags ptr_glutInitContextFlags v1++foreign import CALLCONV "dynamic" dyn_glutInitContextFlags+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutInitContextFlags #-}+ptr_glutInitContextFlags :: FunPtr a+ptr_glutInitContextFlags = unsafePerformIO $ getAPIEntry "glutInitContextFlags"++-- glutInitContextFunc ---------------------------------------------------------++glutInitContextFunc :: MonadIO m => FunPtr InitContextFunc -> m ()+glutInitContextFunc v1 = liftIO $ dyn_glutInitContextFunc ptr_glutInitContextFunc v1++foreign import CALLCONV "dynamic" dyn_glutInitContextFunc+  :: FunPtr (FunPtr InitContextFunc -> IO ())+  ->         FunPtr InitContextFunc -> IO ()++{-# NOINLINE ptr_glutInitContextFunc #-}+ptr_glutInitContextFunc :: FunPtr a+ptr_glutInitContextFunc = unsafePerformIO $ getAPIEntry "glutInitContextFunc"++-- glutInitContextProfile ------------------------------------------------------++glutInitContextProfile :: MonadIO m => CInt -> m ()+glutInitContextProfile v1 = liftIO $ dyn_glutInitContextProfile ptr_glutInitContextProfile v1++foreign import CALLCONV "dynamic" dyn_glutInitContextProfile+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutInitContextProfile #-}+ptr_glutInitContextProfile :: FunPtr a+ptr_glutInitContextProfile = unsafePerformIO $ getAPIEntry "glutInitContextProfile"++-- glutInitContextVersion ------------------------------------------------------++glutInitContextVersion :: MonadIO m => CInt -> CInt -> m ()+glutInitContextVersion v1 v2 = liftIO $ dyn_glutInitContextVersion ptr_glutInitContextVersion v1 v2++foreign import CALLCONV "dynamic" dyn_glutInitContextVersion+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutInitContextVersion #-}+ptr_glutInitContextVersion :: FunPtr a+ptr_glutInitContextVersion = unsafePerformIO $ getAPIEntry "glutInitContextVersion"++-- glutInitDisplayMode ---------------------------------------------------------++glutInitDisplayMode :: MonadIO m => CUInt -> m ()+glutInitDisplayMode v1 = liftIO $ dyn_glutInitDisplayMode ptr_glutInitDisplayMode v1++foreign import CALLCONV "dynamic" dyn_glutInitDisplayMode+  :: FunPtr (CUInt -> IO ())+  ->         CUInt -> IO ()++{-# NOINLINE ptr_glutInitDisplayMode #-}+ptr_glutInitDisplayMode :: FunPtr a+ptr_glutInitDisplayMode = unsafePerformIO $ getAPIEntry "glutInitDisplayMode"++-- glutInitDisplayString -------------------------------------------------------++glutInitDisplayString :: MonadIO m => Ptr CChar -> m ()+glutInitDisplayString v1 = liftIO $ dyn_glutInitDisplayString ptr_glutInitDisplayString v1++foreign import CALLCONV "dynamic" dyn_glutInitDisplayString+  :: FunPtr (Ptr CChar -> IO ())+  ->         Ptr CChar -> IO ()++{-# NOINLINE ptr_glutInitDisplayString #-}+ptr_glutInitDisplayString :: FunPtr a+ptr_glutInitDisplayString = unsafePerformIO $ getAPIEntry "glutInitDisplayString"++-- glutInitWindowPosition ------------------------------------------------------++glutInitWindowPosition :: MonadIO m => CInt -> CInt -> m ()+glutInitWindowPosition v1 v2 = liftIO $ dyn_glutInitWindowPosition ptr_glutInitWindowPosition v1 v2++foreign import CALLCONV "dynamic" dyn_glutInitWindowPosition+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutInitWindowPosition #-}+ptr_glutInitWindowPosition :: FunPtr a+ptr_glutInitWindowPosition = unsafePerformIO $ getAPIEntry "glutInitWindowPosition"++-- glutInitWindowSize ----------------------------------------------------------++glutInitWindowSize :: MonadIO m => CInt -> CInt -> m ()+glutInitWindowSize v1 v2 = liftIO $ dyn_glutInitWindowSize ptr_glutInitWindowSize v1 v2++foreign import CALLCONV "dynamic" dyn_glutInitWindowSize+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutInitWindowSize #-}+ptr_glutInitWindowSize :: FunPtr a+ptr_glutInitWindowSize = unsafePerformIO $ getAPIEntry "glutInitWindowSize"++-- glutJoystickFunc ------------------------------------------------------------++glutJoystickFunc :: MonadIO m => FunPtr JoystickFunc -> CInt -> m ()+glutJoystickFunc v1 v2 = liftIO $ dyn_glutJoystickFunc ptr_glutJoystickFunc v1 v2++foreign import CALLCONV "dynamic" dyn_glutJoystickFunc+  :: FunPtr (FunPtr JoystickFunc -> CInt -> IO ())+  ->         FunPtr JoystickFunc -> CInt -> IO ()++{-# NOINLINE ptr_glutJoystickFunc #-}+ptr_glutJoystickFunc :: FunPtr a+ptr_glutJoystickFunc = unsafePerformIO $ getAPIEntry "glutJoystickFunc"++-- glutKeyboardFunc ------------------------------------------------------------++glutKeyboardFunc :: MonadIO m => FunPtr KeyboardFunc -> m ()+glutKeyboardFunc v1 = liftIO $ dyn_glutKeyboardFunc ptr_glutKeyboardFunc v1++foreign import CALLCONV "dynamic" dyn_glutKeyboardFunc+  :: FunPtr (FunPtr KeyboardFunc -> IO ())+  ->         FunPtr KeyboardFunc -> IO ()++{-# NOINLINE ptr_glutKeyboardFunc #-}+ptr_glutKeyboardFunc :: FunPtr a+ptr_glutKeyboardFunc = unsafePerformIO $ getAPIEntry "glutKeyboardFunc"++-- glutKeyboardUpFunc ----------------------------------------------------------++glutKeyboardUpFunc :: MonadIO m => FunPtr KeyboardUpFunc -> m ()+glutKeyboardUpFunc v1 = liftIO $ dyn_glutKeyboardUpFunc ptr_glutKeyboardUpFunc v1++foreign import CALLCONV "dynamic" dyn_glutKeyboardUpFunc+  :: FunPtr (FunPtr KeyboardUpFunc -> IO ())+  ->         FunPtr KeyboardUpFunc -> IO ()++{-# NOINLINE ptr_glutKeyboardUpFunc #-}+ptr_glutKeyboardUpFunc :: FunPtr a+ptr_glutKeyboardUpFunc = unsafePerformIO $ getAPIEntry "glutKeyboardUpFunc"++-- glutLayerGet ----------------------------------------------------------------++glutLayerGet :: MonadIO m => GLenum -> m CInt+glutLayerGet v1 = liftIO $ dyn_glutLayerGet ptr_glutLayerGet v1++foreign import CALLCONV "dynamic" dyn_glutLayerGet+  :: FunPtr (GLenum -> IO CInt)+  ->         GLenum -> IO CInt++{-# NOINLINE ptr_glutLayerGet #-}+ptr_glutLayerGet :: FunPtr a+ptr_glutLayerGet = unsafePerformIO $ getAPIEntry "glutLayerGet"++-- glutLeaveFullScreen ---------------------------------------------------------++glutLeaveFullScreen :: MonadIO m => m ()+glutLeaveFullScreen = liftIO $ dyn_glutLeaveFullScreen ptr_glutLeaveFullScreen++foreign import CALLCONV "dynamic" dyn_glutLeaveFullScreen+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutLeaveFullScreen #-}+ptr_glutLeaveFullScreen :: FunPtr a+ptr_glutLeaveFullScreen = unsafePerformIO $ getAPIEntry "glutLeaveFullScreen"++-- glutLeaveGameMode -----------------------------------------------------------++glutLeaveGameMode :: MonadIO m => m ()+glutLeaveGameMode = liftIO $ dyn_glutLeaveGameMode ptr_glutLeaveGameMode++foreign import CALLCONV "dynamic" dyn_glutLeaveGameMode+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutLeaveGameMode #-}+ptr_glutLeaveGameMode :: FunPtr a+ptr_glutLeaveGameMode = unsafePerformIO $ getAPIEntry "glutLeaveGameMode"++-- glutLeaveMainLoop -----------------------------------------------------------++glutLeaveMainLoop :: MonadIO m => m ()+glutLeaveMainLoop = liftIO $ dyn_glutLeaveMainLoop ptr_glutLeaveMainLoop++foreign import CALLCONV "dynamic" dyn_glutLeaveMainLoop+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutLeaveMainLoop #-}+ptr_glutLeaveMainLoop :: FunPtr a+ptr_glutLeaveMainLoop = unsafePerformIO $ getAPIEntry "glutLeaveMainLoop"++-- glutMainLoop ----------------------------------------------------------------++glutMainLoop :: MonadIO m => m ()+glutMainLoop = liftIO $ dyn_glutMainLoop ptr_glutMainLoop++foreign import CALLCONV "dynamic" dyn_glutMainLoop+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutMainLoop #-}+ptr_glutMainLoop :: FunPtr a+ptr_glutMainLoop = unsafePerformIO $ getAPIEntry "glutMainLoop"++-- glutMainLoopEvent -----------------------------------------------------------++glutMainLoopEvent :: MonadIO m => m ()+glutMainLoopEvent = liftIO $ dyn_glutMainLoopEvent ptr_glutMainLoopEvent++foreign import CALLCONV "dynamic" dyn_glutMainLoopEvent+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutMainLoopEvent #-}+ptr_glutMainLoopEvent :: FunPtr a+ptr_glutMainLoopEvent = unsafePerformIO $ getAPIEntry "glutMainLoopEvent"++-- glutMenuDestroyFunc ---------------------------------------------------------++glutMenuDestroyFunc :: MonadIO m => FunPtr MenuDestroyFunc -> m ()+glutMenuDestroyFunc v1 = liftIO $ dyn_glutMenuDestroyFunc ptr_glutMenuDestroyFunc v1++foreign import CALLCONV "dynamic" dyn_glutMenuDestroyFunc+  :: FunPtr (FunPtr MenuDestroyFunc -> IO ())+  ->         FunPtr MenuDestroyFunc -> IO ()++{-# NOINLINE ptr_glutMenuDestroyFunc #-}+ptr_glutMenuDestroyFunc :: FunPtr a+ptr_glutMenuDestroyFunc = unsafePerformIO $ getAPIEntry "glutMenuDestroyFunc"++-- glutMenuStateFunc -----------------------------------------------------------++glutMenuStateFunc :: MonadIO m => FunPtr MenuStateFunc -> m ()+glutMenuStateFunc v1 = liftIO $ dyn_glutMenuStateFunc ptr_glutMenuStateFunc v1++foreign import CALLCONV "dynamic" dyn_glutMenuStateFunc+  :: FunPtr (FunPtr MenuStateFunc -> IO ())+  ->         FunPtr MenuStateFunc -> IO ()++{-# NOINLINE ptr_glutMenuStateFunc #-}+ptr_glutMenuStateFunc :: FunPtr a+ptr_glutMenuStateFunc = unsafePerformIO $ getAPIEntry "glutMenuStateFunc"++-- glutMenuStatusFunc ----------------------------------------------------------++glutMenuStatusFunc :: MonadIO m => FunPtr MenuStatusFunc -> m ()+glutMenuStatusFunc v1 = liftIO $ dyn_glutMenuStatusFunc ptr_glutMenuStatusFunc v1++foreign import CALLCONV "dynamic" dyn_glutMenuStatusFunc+  :: FunPtr (FunPtr MenuStatusFunc -> IO ())+  ->         FunPtr MenuStatusFunc -> IO ()++{-# NOINLINE ptr_glutMenuStatusFunc #-}+ptr_glutMenuStatusFunc :: FunPtr a+ptr_glutMenuStatusFunc = unsafePerformIO $ getAPIEntry "glutMenuStatusFunc"++-- glutMotionFunc --------------------------------------------------------------++glutMotionFunc :: MonadIO m => FunPtr MotionFunc -> m ()+glutMotionFunc v1 = liftIO $ dyn_glutMotionFunc ptr_glutMotionFunc v1++foreign import CALLCONV "dynamic" dyn_glutMotionFunc+  :: FunPtr (FunPtr MotionFunc -> IO ())+  ->         FunPtr MotionFunc -> IO ()++{-# NOINLINE ptr_glutMotionFunc #-}+ptr_glutMotionFunc :: FunPtr a+ptr_glutMotionFunc = unsafePerformIO $ getAPIEntry "glutMotionFunc"++-- glutMouseFunc ---------------------------------------------------------------++glutMouseFunc :: MonadIO m => FunPtr MouseFunc -> m ()+glutMouseFunc v1 = liftIO $ dyn_glutMouseFunc ptr_glutMouseFunc v1++foreign import CALLCONV "dynamic" dyn_glutMouseFunc+  :: FunPtr (FunPtr MouseFunc -> IO ())+  ->         FunPtr MouseFunc -> IO ()++{-# NOINLINE ptr_glutMouseFunc #-}+ptr_glutMouseFunc :: FunPtr a+ptr_glutMouseFunc = unsafePerformIO $ getAPIEntry "glutMouseFunc"++-- glutMouseWheelFunc ----------------------------------------------------------++glutMouseWheelFunc :: MonadIO m => FunPtr MouseWheelFunc -> m ()+glutMouseWheelFunc v1 = liftIO $ dyn_glutMouseWheelFunc ptr_glutMouseWheelFunc v1++foreign import CALLCONV "dynamic" dyn_glutMouseWheelFunc+  :: FunPtr (FunPtr MouseWheelFunc -> IO ())+  ->         FunPtr MouseWheelFunc -> IO ()++{-# NOINLINE ptr_glutMouseWheelFunc #-}+ptr_glutMouseWheelFunc :: FunPtr a+ptr_glutMouseWheelFunc = unsafePerformIO $ getAPIEntry "glutMouseWheelFunc"++-- glutMultiButtonFunc ---------------------------------------------------------++glutMultiButtonFunc :: MonadIO m => FunPtr MultiButtonFunc -> m ()+glutMultiButtonFunc v1 = liftIO $ dyn_glutMultiButtonFunc ptr_glutMultiButtonFunc v1++foreign import CALLCONV "dynamic" dyn_glutMultiButtonFunc+  :: FunPtr (FunPtr MultiButtonFunc -> IO ())+  ->         FunPtr MultiButtonFunc -> IO ()++{-# NOINLINE ptr_glutMultiButtonFunc #-}+ptr_glutMultiButtonFunc :: FunPtr a+ptr_glutMultiButtonFunc = unsafePerformIO $ getAPIEntry "glutMultiButtonFunc"++-- glutMultiEntryFunc ----------------------------------------------------------++glutMultiEntryFunc :: MonadIO m => FunPtr MultiEntryFunc -> m ()+glutMultiEntryFunc v1 = liftIO $ dyn_glutMultiEntryFunc ptr_glutMultiEntryFunc v1++foreign import CALLCONV "dynamic" dyn_glutMultiEntryFunc+  :: FunPtr (FunPtr MultiEntryFunc -> IO ())+  ->         FunPtr MultiEntryFunc -> IO ()++{-# NOINLINE ptr_glutMultiEntryFunc #-}+ptr_glutMultiEntryFunc :: FunPtr a+ptr_glutMultiEntryFunc = unsafePerformIO $ getAPIEntry "glutMultiEntryFunc"++-- glutMultiMotionFunc ---------------------------------------------------------++glutMultiMotionFunc :: MonadIO m => FunPtr MultiMotionFunc -> m ()+glutMultiMotionFunc v1 = liftIO $ dyn_glutMultiMotionFunc ptr_glutMultiMotionFunc v1++foreign import CALLCONV "dynamic" dyn_glutMultiMotionFunc+  :: FunPtr (FunPtr MultiMotionFunc -> IO ())+  ->         FunPtr MultiMotionFunc -> IO ()++{-# NOINLINE ptr_glutMultiMotionFunc #-}+ptr_glutMultiMotionFunc :: FunPtr a+ptr_glutMultiMotionFunc = unsafePerformIO $ getAPIEntry "glutMultiMotionFunc"++-- glutMultiPassiveFunc --------------------------------------------------------++glutMultiPassiveFunc :: MonadIO m => FunPtr MultiPassiveFunc -> m ()+glutMultiPassiveFunc v1 = liftIO $ dyn_glutMultiPassiveFunc ptr_glutMultiPassiveFunc v1++foreign import CALLCONV "dynamic" dyn_glutMultiPassiveFunc+  :: FunPtr (FunPtr MultiPassiveFunc -> IO ())+  ->         FunPtr MultiPassiveFunc -> IO ()++{-# NOINLINE ptr_glutMultiPassiveFunc #-}+ptr_glutMultiPassiveFunc :: FunPtr a+ptr_glutMultiPassiveFunc = unsafePerformIO $ getAPIEntry "glutMultiPassiveFunc"++-- glutOverlayDisplayFunc ------------------------------------------------------++glutOverlayDisplayFunc :: MonadIO m => FunPtr OverlayDisplayFunc -> m ()+glutOverlayDisplayFunc v1 = liftIO $ dyn_glutOverlayDisplayFunc ptr_glutOverlayDisplayFunc v1++foreign import CALLCONV "dynamic" dyn_glutOverlayDisplayFunc+  :: FunPtr (FunPtr OverlayDisplayFunc -> IO ())+  ->         FunPtr OverlayDisplayFunc -> IO ()++{-# NOINLINE ptr_glutOverlayDisplayFunc #-}+ptr_glutOverlayDisplayFunc :: FunPtr a+ptr_glutOverlayDisplayFunc = unsafePerformIO $ getAPIEntry "glutOverlayDisplayFunc"++-- glutPassiveMotionFunc -------------------------------------------------------++glutPassiveMotionFunc :: MonadIO m => FunPtr PassiveMotionFunc -> m ()+glutPassiveMotionFunc v1 = liftIO $ dyn_glutPassiveMotionFunc ptr_glutPassiveMotionFunc v1++foreign import CALLCONV "dynamic" dyn_glutPassiveMotionFunc+  :: FunPtr (FunPtr PassiveMotionFunc -> IO ())+  ->         FunPtr PassiveMotionFunc -> IO ()++{-# NOINLINE ptr_glutPassiveMotionFunc #-}+ptr_glutPassiveMotionFunc :: FunPtr a+ptr_glutPassiveMotionFunc = unsafePerformIO $ getAPIEntry "glutPassiveMotionFunc"++-- glutPopWindow ---------------------------------------------------------------++glutPopWindow :: MonadIO m => m ()+glutPopWindow = liftIO $ dyn_glutPopWindow ptr_glutPopWindow++foreign import CALLCONV "dynamic" dyn_glutPopWindow+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutPopWindow #-}+ptr_glutPopWindow :: FunPtr a+ptr_glutPopWindow = unsafePerformIO $ getAPIEntry "glutPopWindow"++-- glutPositionFunc ------------------------------------------------------------++glutPositionFunc :: MonadIO m => FunPtr PositionFunc -> m ()+glutPositionFunc v1 = liftIO $ dyn_glutPositionFunc ptr_glutPositionFunc v1++foreign import CALLCONV "dynamic" dyn_glutPositionFunc+  :: FunPtr (FunPtr PositionFunc -> IO ())+  ->         FunPtr PositionFunc -> IO ()++{-# NOINLINE ptr_glutPositionFunc #-}+ptr_glutPositionFunc :: FunPtr a+ptr_glutPositionFunc = unsafePerformIO $ getAPIEntry "glutPositionFunc"++-- glutPositionWindow ----------------------------------------------------------++glutPositionWindow :: MonadIO m => CInt -> CInt -> m ()+glutPositionWindow v1 v2 = liftIO $ dyn_glutPositionWindow ptr_glutPositionWindow v1 v2++foreign import CALLCONV "dynamic" dyn_glutPositionWindow+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutPositionWindow #-}+ptr_glutPositionWindow :: FunPtr a+ptr_glutPositionWindow = unsafePerformIO $ getAPIEntry "glutPositionWindow"++-- glutPostOverlayRedisplay ----------------------------------------------------++glutPostOverlayRedisplay :: MonadIO m => m ()+glutPostOverlayRedisplay = liftIO $ dyn_glutPostOverlayRedisplay ptr_glutPostOverlayRedisplay++foreign import CALLCONV "dynamic" dyn_glutPostOverlayRedisplay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutPostOverlayRedisplay #-}+ptr_glutPostOverlayRedisplay :: FunPtr a+ptr_glutPostOverlayRedisplay = unsafePerformIO $ getAPIEntry "glutPostOverlayRedisplay"++-- glutPostRedisplay -----------------------------------------------------------++glutPostRedisplay :: MonadIO m => m ()+glutPostRedisplay = liftIO $ dyn_glutPostRedisplay ptr_glutPostRedisplay++foreign import CALLCONV "dynamic" dyn_glutPostRedisplay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutPostRedisplay #-}+ptr_glutPostRedisplay :: FunPtr a+ptr_glutPostRedisplay = unsafePerformIO $ getAPIEntry "glutPostRedisplay"++-- glutPostWindowOverlayRedisplay ----------------------------------------------++glutPostWindowOverlayRedisplay :: MonadIO m => CInt -> m ()+glutPostWindowOverlayRedisplay v1 = liftIO $ dyn_glutPostWindowOverlayRedisplay ptr_glutPostWindowOverlayRedisplay v1++foreign import CALLCONV "dynamic" dyn_glutPostWindowOverlayRedisplay+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutPostWindowOverlayRedisplay #-}+ptr_glutPostWindowOverlayRedisplay :: FunPtr a+ptr_glutPostWindowOverlayRedisplay = unsafePerformIO $ getAPIEntry "glutPostWindowOverlayRedisplay"++-- glutPostWindowRedisplay -----------------------------------------------------++glutPostWindowRedisplay :: MonadIO m => CInt -> m ()+glutPostWindowRedisplay v1 = liftIO $ dyn_glutPostWindowRedisplay ptr_glutPostWindowRedisplay v1++foreign import CALLCONV "dynamic" dyn_glutPostWindowRedisplay+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutPostWindowRedisplay #-}+ptr_glutPostWindowRedisplay :: FunPtr a+ptr_glutPostWindowRedisplay = unsafePerformIO $ getAPIEntry "glutPostWindowRedisplay"++-- glutPushWindow --------------------------------------------------------------++glutPushWindow :: MonadIO m => m ()+glutPushWindow = liftIO $ dyn_glutPushWindow ptr_glutPushWindow++foreign import CALLCONV "dynamic" dyn_glutPushWindow+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutPushWindow #-}+ptr_glutPushWindow :: FunPtr a+ptr_glutPushWindow = unsafePerformIO $ getAPIEntry "glutPushWindow"++-- glutRemoveMenuItem ----------------------------------------------------------++glutRemoveMenuItem :: MonadIO m => CInt -> m ()+glutRemoveMenuItem v1 = liftIO $ dyn_glutRemoveMenuItem ptr_glutRemoveMenuItem v1++foreign import CALLCONV "dynamic" dyn_glutRemoveMenuItem+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutRemoveMenuItem #-}+ptr_glutRemoveMenuItem :: FunPtr a+ptr_glutRemoveMenuItem = unsafePerformIO $ getAPIEntry "glutRemoveMenuItem"++-- glutRemoveOverlay -----------------------------------------------------------++glutRemoveOverlay :: MonadIO m => m ()+glutRemoveOverlay = liftIO $ dyn_glutRemoveOverlay ptr_glutRemoveOverlay++foreign import CALLCONV "dynamic" dyn_glutRemoveOverlay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutRemoveOverlay #-}+ptr_glutRemoveOverlay :: FunPtr a+ptr_glutRemoveOverlay = unsafePerformIO $ getAPIEntry "glutRemoveOverlay"++-- glutReportErrors ------------------------------------------------------------++glutReportErrors :: MonadIO m => m ()+glutReportErrors = liftIO $ dyn_glutReportErrors ptr_glutReportErrors++foreign import CALLCONV "dynamic" dyn_glutReportErrors+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutReportErrors #-}+ptr_glutReportErrors :: FunPtr a+ptr_glutReportErrors = unsafePerformIO $ getAPIEntry "glutReportErrors"++-- glutReshapeFunc -------------------------------------------------------------++glutReshapeFunc :: MonadIO m => FunPtr ReshapeFunc -> m ()+glutReshapeFunc v1 = liftIO $ dyn_glutReshapeFunc ptr_glutReshapeFunc v1++foreign import CALLCONV "dynamic" dyn_glutReshapeFunc+  :: FunPtr (FunPtr ReshapeFunc -> IO ())+  ->         FunPtr ReshapeFunc -> IO ()++{-# NOINLINE ptr_glutReshapeFunc #-}+ptr_glutReshapeFunc :: FunPtr a+ptr_glutReshapeFunc = unsafePerformIO $ getAPIEntry "glutReshapeFunc"++-- glutReshapeWindow -----------------------------------------------------------++glutReshapeWindow :: MonadIO m => CInt -> CInt -> m ()+glutReshapeWindow v1 v2 = liftIO $ dyn_glutReshapeWindow ptr_glutReshapeWindow v1 v2++foreign import CALLCONV "dynamic" dyn_glutReshapeWindow+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutReshapeWindow #-}+ptr_glutReshapeWindow :: FunPtr a+ptr_glutReshapeWindow = unsafePerformIO $ getAPIEntry "glutReshapeWindow"++-- glutSetColor ----------------------------------------------------------------++glutSetColor :: MonadIO m => CInt -> GLfloat -> GLfloat -> GLfloat -> m ()+glutSetColor v1 v2 v3 v4 = liftIO $ dyn_glutSetColor ptr_glutSetColor v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutSetColor+  :: FunPtr (CInt -> GLfloat -> GLfloat -> GLfloat -> IO ())+  ->         CInt -> GLfloat -> GLfloat -> GLfloat -> IO ()++{-# NOINLINE ptr_glutSetColor #-}+ptr_glutSetColor :: FunPtr a+ptr_glutSetColor = unsafePerformIO $ getAPIEntry "glutSetColor"++-- glutSetCursor ---------------------------------------------------------------++glutSetCursor :: MonadIO m => CInt -> m ()+glutSetCursor v1 = liftIO $ dyn_glutSetCursor ptr_glutSetCursor v1++foreign import CALLCONV "dynamic" dyn_glutSetCursor+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutSetCursor #-}+ptr_glutSetCursor :: FunPtr a+ptr_glutSetCursor = unsafePerformIO $ getAPIEntry "glutSetCursor"++-- glutSetIconTitle ------------------------------------------------------------++glutSetIconTitle :: MonadIO m => Ptr CChar -> m ()+glutSetIconTitle v1 = liftIO $ dyn_glutSetIconTitle ptr_glutSetIconTitle v1++foreign import CALLCONV "dynamic" dyn_glutSetIconTitle+  :: FunPtr (Ptr CChar -> IO ())+  ->         Ptr CChar -> IO ()++{-# NOINLINE ptr_glutSetIconTitle #-}+ptr_glutSetIconTitle :: FunPtr a+ptr_glutSetIconTitle = unsafePerformIO $ getAPIEntry "glutSetIconTitle"++-- glutSetKeyRepeat ------------------------------------------------------------++glutSetKeyRepeat :: MonadIO m => CInt -> m ()+glutSetKeyRepeat v1 = liftIO $ dyn_glutSetKeyRepeat ptr_glutSetKeyRepeat v1++foreign import CALLCONV "dynamic" dyn_glutSetKeyRepeat+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutSetKeyRepeat #-}+ptr_glutSetKeyRepeat :: FunPtr a+ptr_glutSetKeyRepeat = unsafePerformIO $ getAPIEntry "glutSetKeyRepeat"++-- glutSetMenu -----------------------------------------------------------------++glutSetMenu :: MonadIO m => CInt -> m ()+glutSetMenu v1 = liftIO $ dyn_glutSetMenu ptr_glutSetMenu v1++foreign import CALLCONV "dynamic" dyn_glutSetMenu+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutSetMenu #-}+ptr_glutSetMenu :: FunPtr a+ptr_glutSetMenu = unsafePerformIO $ getAPIEntry "glutSetMenu"++-- glutSetMenuData -------------------------------------------------------------++glutSetMenuData :: MonadIO m => Ptr a -> m ()+glutSetMenuData v1 = liftIO $ dyn_glutSetMenuData ptr_glutSetMenuData v1++foreign import CALLCONV "dynamic" dyn_glutSetMenuData+  :: FunPtr (Ptr a -> IO ())+  ->         Ptr a -> IO ()++{-# NOINLINE ptr_glutSetMenuData #-}+ptr_glutSetMenuData :: FunPtr a+ptr_glutSetMenuData = unsafePerformIO $ getAPIEntry "glutSetMenuData"++-- glutSetMenuFont -------------------------------------------------------------++glutSetMenuFont :: MonadIO m => CInt -> Ptr a -> m ()+glutSetMenuFont v1 v2 = liftIO $ dyn_glutSetMenuFont ptr_glutSetMenuFont v1 v2++foreign import CALLCONV "dynamic" dyn_glutSetMenuFont+  :: FunPtr (CInt -> Ptr a -> IO ())+  ->         CInt -> Ptr a -> IO ()++{-# NOINLINE ptr_glutSetMenuFont #-}+ptr_glutSetMenuFont :: FunPtr a+ptr_glutSetMenuFont = unsafePerformIO $ getAPIEntry "glutSetMenuFont"++-- glutSetOption ---------------------------------------------------------------++glutSetOption :: MonadIO m => GLenum -> CInt -> m ()+glutSetOption v1 v2 = liftIO $ dyn_glutSetOption ptr_glutSetOption v1 v2++foreign import CALLCONV "dynamic" dyn_glutSetOption+  :: FunPtr (GLenum -> CInt -> IO ())+  ->         GLenum -> CInt -> IO ()++{-# NOINLINE ptr_glutSetOption #-}+ptr_glutSetOption :: FunPtr a+ptr_glutSetOption = unsafePerformIO $ getAPIEntry "glutSetOption"++-- glutSetVertexAttribCoord3 ---------------------------------------------------++glutSetVertexAttribCoord3 :: MonadIO m => GLint -> m ()+glutSetVertexAttribCoord3 v1 = liftIO $ dyn_glutSetVertexAttribCoord3 ptr_glutSetVertexAttribCoord3 v1++foreign import CALLCONV "dynamic" dyn_glutSetVertexAttribCoord3+  :: FunPtr (GLint -> IO ())+  ->         GLint -> IO ()++{-# NOINLINE ptr_glutSetVertexAttribCoord3 #-}+ptr_glutSetVertexAttribCoord3 :: FunPtr a+ptr_glutSetVertexAttribCoord3 = unsafePerformIO $ getAPIEntry "glutSetVertexAttribCoord3"++-- glutSetVertexAttribNormal ---------------------------------------------------++glutSetVertexAttribNormal :: MonadIO m => GLint -> m ()+glutSetVertexAttribNormal v1 = liftIO $ dyn_glutSetVertexAttribNormal ptr_glutSetVertexAttribNormal v1++foreign import CALLCONV "dynamic" dyn_glutSetVertexAttribNormal+  :: FunPtr (GLint -> IO ())+  ->         GLint -> IO ()++{-# NOINLINE ptr_glutSetVertexAttribNormal #-}+ptr_glutSetVertexAttribNormal :: FunPtr a+ptr_glutSetVertexAttribNormal = unsafePerformIO $ getAPIEntry "glutSetVertexAttribNormal"++-- glutSetVertexAttribTexCoord2 ------------------------------------------------++glutSetVertexAttribTexCoord2 :: MonadIO m => GLint -> m ()+glutSetVertexAttribTexCoord2 v1 = liftIO $ dyn_glutSetVertexAttribTexCoord2 ptr_glutSetVertexAttribTexCoord2 v1++foreign import CALLCONV "dynamic" dyn_glutSetVertexAttribTexCoord2+  :: FunPtr (GLint -> IO ())+  ->         GLint -> IO ()++{-# NOINLINE ptr_glutSetVertexAttribTexCoord2 #-}+ptr_glutSetVertexAttribTexCoord2 :: FunPtr a+ptr_glutSetVertexAttribTexCoord2 = unsafePerformIO $ getAPIEntry "glutSetVertexAttribTexCoord2"++-- glutSetWindow ---------------------------------------------------------------++glutSetWindow :: MonadIO m => CInt -> m ()+glutSetWindow v1 = liftIO $ dyn_glutSetWindow ptr_glutSetWindow v1++foreign import CALLCONV "dynamic" dyn_glutSetWindow+  :: FunPtr (CInt -> IO ())+  ->         CInt -> IO ()++{-# NOINLINE ptr_glutSetWindow #-}+ptr_glutSetWindow :: FunPtr a+ptr_glutSetWindow = unsafePerformIO $ getAPIEntry "glutSetWindow"++-- glutSetWindowData -----------------------------------------------------------++glutSetWindowData :: MonadIO m => Ptr a -> m ()+glutSetWindowData v1 = liftIO $ dyn_glutSetWindowData ptr_glutSetWindowData v1++foreign import CALLCONV "dynamic" dyn_glutSetWindowData+  :: FunPtr (Ptr a -> IO ())+  ->         Ptr a -> IO ()++{-# NOINLINE ptr_glutSetWindowData #-}+ptr_glutSetWindowData :: FunPtr a+ptr_glutSetWindowData = unsafePerformIO $ getAPIEntry "glutSetWindowData"++-- glutSetWindowTitle ----------------------------------------------------------++glutSetWindowTitle :: MonadIO m => Ptr CChar -> m ()+glutSetWindowTitle v1 = liftIO $ dyn_glutSetWindowTitle ptr_glutSetWindowTitle v1++foreign import CALLCONV "dynamic" dyn_glutSetWindowTitle+  :: FunPtr (Ptr CChar -> IO ())+  ->         Ptr CChar -> IO ()++{-# NOINLINE ptr_glutSetWindowTitle #-}+ptr_glutSetWindowTitle :: FunPtr a+ptr_glutSetWindowTitle = unsafePerformIO $ getAPIEntry "glutSetWindowTitle"++-- glutSetupVideoResizing ------------------------------------------------------++glutSetupVideoResizing :: MonadIO m => m ()+glutSetupVideoResizing = liftIO $ dyn_glutSetupVideoResizing ptr_glutSetupVideoResizing++foreign import CALLCONV "dynamic" dyn_glutSetupVideoResizing+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSetupVideoResizing #-}+ptr_glutSetupVideoResizing :: FunPtr a+ptr_glutSetupVideoResizing = unsafePerformIO $ getAPIEntry "glutSetupVideoResizing"++-- glutShowOverlay -------------------------------------------------------------++glutShowOverlay :: MonadIO m => m ()+glutShowOverlay = liftIO $ dyn_glutShowOverlay ptr_glutShowOverlay++foreign import CALLCONV "dynamic" dyn_glutShowOverlay+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutShowOverlay #-}+ptr_glutShowOverlay :: FunPtr a+ptr_glutShowOverlay = unsafePerformIO $ getAPIEntry "glutShowOverlay"++-- glutShowWindow --------------------------------------------------------------++glutShowWindow :: MonadIO m => m ()+glutShowWindow = liftIO $ dyn_glutShowWindow ptr_glutShowWindow++foreign import CALLCONV "dynamic" dyn_glutShowWindow+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutShowWindow #-}+ptr_glutShowWindow :: FunPtr a+ptr_glutShowWindow = unsafePerformIO $ getAPIEntry "glutShowWindow"++-- glutSolidCone ---------------------------------------------------------------++glutSolidCone :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutSolidCone v1 v2 v3 v4 = liftIO $ dyn_glutSolidCone ptr_glutSolidCone v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutSolidCone+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutSolidCone #-}+ptr_glutSolidCone :: FunPtr a+ptr_glutSolidCone = unsafePerformIO $ getAPIEntry "glutSolidCone"++-- glutSolidCube ---------------------------------------------------------------++glutSolidCube :: MonadIO m => GLdouble -> m ()+glutSolidCube v1 = liftIO $ dyn_glutSolidCube ptr_glutSolidCube v1++foreign import CALLCONV "dynamic" dyn_glutSolidCube+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutSolidCube #-}+ptr_glutSolidCube :: FunPtr a+ptr_glutSolidCube = unsafePerformIO $ getAPIEntry "glutSolidCube"++-- glutSolidCylinder -----------------------------------------------------------++glutSolidCylinder :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutSolidCylinder v1 v2 v3 v4 = liftIO $ dyn_glutSolidCylinder ptr_glutSolidCylinder v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutSolidCylinder+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutSolidCylinder #-}+ptr_glutSolidCylinder :: FunPtr a+ptr_glutSolidCylinder = unsafePerformIO $ getAPIEntry "glutSolidCylinder"++-- glutSolidDodecahedron -------------------------------------------------------++glutSolidDodecahedron :: MonadIO m => m ()+glutSolidDodecahedron = liftIO $ dyn_glutSolidDodecahedron ptr_glutSolidDodecahedron++foreign import CALLCONV "dynamic" dyn_glutSolidDodecahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSolidDodecahedron #-}+ptr_glutSolidDodecahedron :: FunPtr a+ptr_glutSolidDodecahedron = unsafePerformIO $ getAPIEntry "glutSolidDodecahedron"++-- glutSolidIcosahedron --------------------------------------------------------++glutSolidIcosahedron :: MonadIO m => m ()+glutSolidIcosahedron = liftIO $ dyn_glutSolidIcosahedron ptr_glutSolidIcosahedron++foreign import CALLCONV "dynamic" dyn_glutSolidIcosahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSolidIcosahedron #-}+ptr_glutSolidIcosahedron :: FunPtr a+ptr_glutSolidIcosahedron = unsafePerformIO $ getAPIEntry "glutSolidIcosahedron"++-- glutSolidOctahedron ---------------------------------------------------------++glutSolidOctahedron :: MonadIO m => m ()+glutSolidOctahedron = liftIO $ dyn_glutSolidOctahedron ptr_glutSolidOctahedron++foreign import CALLCONV "dynamic" dyn_glutSolidOctahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSolidOctahedron #-}+ptr_glutSolidOctahedron :: FunPtr a+ptr_glutSolidOctahedron = unsafePerformIO $ getAPIEntry "glutSolidOctahedron"++-- glutSolidRhombicDodecahedron ------------------------------------------------++glutSolidRhombicDodecahedron :: MonadIO m => m ()+glutSolidRhombicDodecahedron = liftIO $ dyn_glutSolidRhombicDodecahedron ptr_glutSolidRhombicDodecahedron++foreign import CALLCONV "dynamic" dyn_glutSolidRhombicDodecahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSolidRhombicDodecahedron #-}+ptr_glutSolidRhombicDodecahedron :: FunPtr a+ptr_glutSolidRhombicDodecahedron = unsafePerformIO $ getAPIEntry "glutSolidRhombicDodecahedron"++-- glutSolidSierpinskiSponge ---------------------------------------------------++glutSolidSierpinskiSponge :: MonadIO m => CInt -> Ptr GLdouble -> GLdouble -> m ()+glutSolidSierpinskiSponge v1 v2 v3 = liftIO $ dyn_glutSolidSierpinskiSponge ptr_glutSolidSierpinskiSponge v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutSolidSierpinskiSponge+  :: FunPtr (CInt -> Ptr GLdouble -> GLdouble -> IO ())+  ->         CInt -> Ptr GLdouble -> GLdouble -> IO ()++{-# NOINLINE ptr_glutSolidSierpinskiSponge #-}+ptr_glutSolidSierpinskiSponge :: FunPtr a+ptr_glutSolidSierpinskiSponge = unsafePerformIO $ getAPIEntry "glutSolidSierpinskiSponge"++-- glutSolidSphere -------------------------------------------------------------++glutSolidSphere :: MonadIO m => GLdouble -> GLint -> GLint -> m ()+glutSolidSphere v1 v2 v3 = liftIO $ dyn_glutSolidSphere ptr_glutSolidSphere v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutSolidSphere+  :: FunPtr (GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutSolidSphere #-}+ptr_glutSolidSphere :: FunPtr a+ptr_glutSolidSphere = unsafePerformIO $ getAPIEntry "glutSolidSphere"++-- glutSolidTeacup -------------------------------------------------------------++glutSolidTeacup :: MonadIO m => GLdouble -> m ()+glutSolidTeacup v1 = liftIO $ dyn_glutSolidTeacup ptr_glutSolidTeacup v1++foreign import CALLCONV "dynamic" dyn_glutSolidTeacup+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutSolidTeacup #-}+ptr_glutSolidTeacup :: FunPtr a+ptr_glutSolidTeacup = unsafePerformIO $ getAPIEntry "glutSolidTeacup"++-- glutSolidTeapot -------------------------------------------------------------++glutSolidTeapot :: MonadIO m => GLdouble -> m ()+glutSolidTeapot v1 = liftIO $ dyn_glutSolidTeapot ptr_glutSolidTeapot v1++foreign import CALLCONV "dynamic" dyn_glutSolidTeapot+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutSolidTeapot #-}+ptr_glutSolidTeapot :: FunPtr a+ptr_glutSolidTeapot = unsafePerformIO $ getAPIEntry "glutSolidTeapot"++-- glutSolidTeaspoon -----------------------------------------------------------++glutSolidTeaspoon :: MonadIO m => GLdouble -> m ()+glutSolidTeaspoon v1 = liftIO $ dyn_glutSolidTeaspoon ptr_glutSolidTeaspoon v1++foreign import CALLCONV "dynamic" dyn_glutSolidTeaspoon+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutSolidTeaspoon #-}+ptr_glutSolidTeaspoon :: FunPtr a+ptr_glutSolidTeaspoon = unsafePerformIO $ getAPIEntry "glutSolidTeaspoon"++-- glutSolidTetrahedron --------------------------------------------------------++glutSolidTetrahedron :: MonadIO m => m ()+glutSolidTetrahedron = liftIO $ dyn_glutSolidTetrahedron ptr_glutSolidTetrahedron++foreign import CALLCONV "dynamic" dyn_glutSolidTetrahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSolidTetrahedron #-}+ptr_glutSolidTetrahedron :: FunPtr a+ptr_glutSolidTetrahedron = unsafePerformIO $ getAPIEntry "glutSolidTetrahedron"++-- glutSolidTorus --------------------------------------------------------------++glutSolidTorus :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutSolidTorus v1 v2 v3 v4 = liftIO $ dyn_glutSolidTorus ptr_glutSolidTorus v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutSolidTorus+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutSolidTorus #-}+ptr_glutSolidTorus :: FunPtr a+ptr_glutSolidTorus = unsafePerformIO $ getAPIEntry "glutSolidTorus"++-- glutSpaceballButtonFunc -----------------------------------------------------++glutSpaceballButtonFunc :: MonadIO m => FunPtr SpaceballButtonFunc -> m ()+glutSpaceballButtonFunc v1 = liftIO $ dyn_glutSpaceballButtonFunc ptr_glutSpaceballButtonFunc v1++foreign import CALLCONV "dynamic" dyn_glutSpaceballButtonFunc+  :: FunPtr (FunPtr SpaceballButtonFunc -> IO ())+  ->         FunPtr SpaceballButtonFunc -> IO ()++{-# NOINLINE ptr_glutSpaceballButtonFunc #-}+ptr_glutSpaceballButtonFunc :: FunPtr a+ptr_glutSpaceballButtonFunc = unsafePerformIO $ getAPIEntry "glutSpaceballButtonFunc"++-- glutSpaceballMotionFunc -----------------------------------------------------++glutSpaceballMotionFunc :: MonadIO m => FunPtr SpaceballMotionFunc -> m ()+glutSpaceballMotionFunc v1 = liftIO $ dyn_glutSpaceballMotionFunc ptr_glutSpaceballMotionFunc v1++foreign import CALLCONV "dynamic" dyn_glutSpaceballMotionFunc+  :: FunPtr (FunPtr SpaceballMotionFunc -> IO ())+  ->         FunPtr SpaceballMotionFunc -> IO ()++{-# NOINLINE ptr_glutSpaceballMotionFunc #-}+ptr_glutSpaceballMotionFunc :: FunPtr a+ptr_glutSpaceballMotionFunc = unsafePerformIO $ getAPIEntry "glutSpaceballMotionFunc"++-- glutSpaceballRotateFunc -----------------------------------------------------++glutSpaceballRotateFunc :: MonadIO m => FunPtr SpaceballRotateFunc -> m ()+glutSpaceballRotateFunc v1 = liftIO $ dyn_glutSpaceballRotateFunc ptr_glutSpaceballRotateFunc v1++foreign import CALLCONV "dynamic" dyn_glutSpaceballRotateFunc+  :: FunPtr (FunPtr SpaceballRotateFunc -> IO ())+  ->         FunPtr SpaceballRotateFunc -> IO ()++{-# NOINLINE ptr_glutSpaceballRotateFunc #-}+ptr_glutSpaceballRotateFunc :: FunPtr a+ptr_glutSpaceballRotateFunc = unsafePerformIO $ getAPIEntry "glutSpaceballRotateFunc"++-- glutSpecialFunc -------------------------------------------------------------++glutSpecialFunc :: MonadIO m => FunPtr SpecialFunc -> m ()+glutSpecialFunc v1 = liftIO $ dyn_glutSpecialFunc ptr_glutSpecialFunc v1++foreign import CALLCONV "dynamic" dyn_glutSpecialFunc+  :: FunPtr (FunPtr SpecialFunc -> IO ())+  ->         FunPtr SpecialFunc -> IO ()++{-# NOINLINE ptr_glutSpecialFunc #-}+ptr_glutSpecialFunc :: FunPtr a+ptr_glutSpecialFunc = unsafePerformIO $ getAPIEntry "glutSpecialFunc"++-- glutSpecialUpFunc -----------------------------------------------------------++glutSpecialUpFunc :: MonadIO m => FunPtr SpecialUpFunc -> m ()+glutSpecialUpFunc v1 = liftIO $ dyn_glutSpecialUpFunc ptr_glutSpecialUpFunc v1++foreign import CALLCONV "dynamic" dyn_glutSpecialUpFunc+  :: FunPtr (FunPtr SpecialUpFunc -> IO ())+  ->         FunPtr SpecialUpFunc -> IO ()++{-# NOINLINE ptr_glutSpecialUpFunc #-}+ptr_glutSpecialUpFunc :: FunPtr a+ptr_glutSpecialUpFunc = unsafePerformIO $ getAPIEntry "glutSpecialUpFunc"++-- glutStopVideoResizing -------------------------------------------------------++glutStopVideoResizing :: MonadIO m => m ()+glutStopVideoResizing = liftIO $ dyn_glutStopVideoResizing ptr_glutStopVideoResizing++foreign import CALLCONV "dynamic" dyn_glutStopVideoResizing+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutStopVideoResizing #-}+ptr_glutStopVideoResizing :: FunPtr a+ptr_glutStopVideoResizing = unsafePerformIO $ getAPIEntry "glutStopVideoResizing"++-- glutStrokeCharacter ---------------------------------------------------------++glutStrokeCharacter :: MonadIO m => Ptr a -> CInt -> m ()+glutStrokeCharacter v1 v2 = liftIO $ dyn_glutStrokeCharacter ptr_glutStrokeCharacter v1 v2++foreign import CALLCONV "dynamic" dyn_glutStrokeCharacter+  :: FunPtr (Ptr a -> CInt -> IO ())+  ->         Ptr a -> CInt -> IO ()++{-# NOINLINE ptr_glutStrokeCharacter #-}+ptr_glutStrokeCharacter :: FunPtr a+ptr_glutStrokeCharacter = unsafePerformIO $ getAPIEntry "glutStrokeCharacter"++-- glutStrokeHeight ------------------------------------------------------------++glutStrokeHeight :: MonadIO m => Ptr a -> m GLfloat+glutStrokeHeight v1 = liftIO $ dyn_glutStrokeHeight ptr_glutStrokeHeight v1++foreign import CALLCONV "dynamic" dyn_glutStrokeHeight+  :: FunPtr (Ptr a -> IO GLfloat)+  ->         Ptr a -> IO GLfloat++{-# NOINLINE ptr_glutStrokeHeight #-}+ptr_glutStrokeHeight :: FunPtr a+ptr_glutStrokeHeight = unsafePerformIO $ getAPIEntry "glutStrokeHeight"++-- glutStrokeLength ------------------------------------------------------------++glutStrokeLength :: MonadIO m => Ptr a -> Ptr CUChar -> m CInt+glutStrokeLength v1 v2 = liftIO $ dyn_glutStrokeLength ptr_glutStrokeLength v1 v2++foreign import CALLCONV "dynamic" dyn_glutStrokeLength+  :: FunPtr (Ptr a -> Ptr CUChar -> IO CInt)+  ->         Ptr a -> Ptr CUChar -> IO CInt++{-# NOINLINE ptr_glutStrokeLength #-}+ptr_glutStrokeLength :: FunPtr a+ptr_glutStrokeLength = unsafePerformIO $ getAPIEntry "glutStrokeLength"++-- glutStrokeString ------------------------------------------------------------++glutStrokeString :: MonadIO m => Ptr a -> Ptr CUChar -> m ()+glutStrokeString v1 v2 = liftIO $ dyn_glutStrokeString ptr_glutStrokeString v1 v2++foreign import CALLCONV "dynamic" dyn_glutStrokeString+  :: FunPtr (Ptr a -> Ptr CUChar -> IO ())+  ->         Ptr a -> Ptr CUChar -> IO ()++{-# NOINLINE ptr_glutStrokeString #-}+ptr_glutStrokeString :: FunPtr a+ptr_glutStrokeString = unsafePerformIO $ getAPIEntry "glutStrokeString"++-- glutStrokeWidth -------------------------------------------------------------++glutStrokeWidth :: MonadIO m => Ptr a -> CInt -> m CInt+glutStrokeWidth v1 v2 = liftIO $ dyn_glutStrokeWidth ptr_glutStrokeWidth v1 v2++foreign import CALLCONV "dynamic" dyn_glutStrokeWidth+  :: FunPtr (Ptr a -> CInt -> IO CInt)+  ->         Ptr a -> CInt -> IO CInt++{-# NOINLINE ptr_glutStrokeWidth #-}+ptr_glutStrokeWidth :: FunPtr a+ptr_glutStrokeWidth = unsafePerformIO $ getAPIEntry "glutStrokeWidth"++-- glutSwapBuffers -------------------------------------------------------------++glutSwapBuffers :: MonadIO m => m ()+glutSwapBuffers = liftIO $ dyn_glutSwapBuffers ptr_glutSwapBuffers++foreign import CALLCONV "dynamic" dyn_glutSwapBuffers+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutSwapBuffers #-}+ptr_glutSwapBuffers :: FunPtr a+ptr_glutSwapBuffers = unsafePerformIO $ getAPIEntry "glutSwapBuffers"++-- glutTabletButtonFunc --------------------------------------------------------++glutTabletButtonFunc :: MonadIO m => FunPtr TabletButtonFunc -> m ()+glutTabletButtonFunc v1 = liftIO $ dyn_glutTabletButtonFunc ptr_glutTabletButtonFunc v1++foreign import CALLCONV "dynamic" dyn_glutTabletButtonFunc+  :: FunPtr (FunPtr TabletButtonFunc -> IO ())+  ->         FunPtr TabletButtonFunc -> IO ()++{-# NOINLINE ptr_glutTabletButtonFunc #-}+ptr_glutTabletButtonFunc :: FunPtr a+ptr_glutTabletButtonFunc = unsafePerformIO $ getAPIEntry "glutTabletButtonFunc"++-- glutTabletMotionFunc --------------------------------------------------------++glutTabletMotionFunc :: MonadIO m => FunPtr TabletMotionFunc -> m ()+glutTabletMotionFunc v1 = liftIO $ dyn_glutTabletMotionFunc ptr_glutTabletMotionFunc v1++foreign import CALLCONV "dynamic" dyn_glutTabletMotionFunc+  :: FunPtr (FunPtr TabletMotionFunc -> IO ())+  ->         FunPtr TabletMotionFunc -> IO ()++{-# NOINLINE ptr_glutTabletMotionFunc #-}+ptr_glutTabletMotionFunc :: FunPtr a+ptr_glutTabletMotionFunc = unsafePerformIO $ getAPIEntry "glutTabletMotionFunc"++-- glutTimerFunc ---------------------------------------------------------------++glutTimerFunc :: MonadIO m => CUInt -> FunPtr TimerFunc -> CInt -> m ()+glutTimerFunc v1 v2 v3 = liftIO $ dyn_glutTimerFunc ptr_glutTimerFunc v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutTimerFunc+  :: FunPtr (CUInt -> FunPtr TimerFunc -> CInt -> IO ())+  ->         CUInt -> FunPtr TimerFunc -> CInt -> IO ()++{-# NOINLINE ptr_glutTimerFunc #-}+ptr_glutTimerFunc :: FunPtr a+ptr_glutTimerFunc = unsafePerformIO $ getAPIEntry "glutTimerFunc"++-- glutUseLayer ----------------------------------------------------------------++glutUseLayer :: MonadIO m => GLenum -> m ()+glutUseLayer v1 = liftIO $ dyn_glutUseLayer ptr_glutUseLayer v1++foreign import CALLCONV "dynamic" dyn_glutUseLayer+  :: FunPtr (GLenum -> IO ())+  ->         GLenum -> IO ()++{-# NOINLINE ptr_glutUseLayer #-}+ptr_glutUseLayer :: FunPtr a+ptr_glutUseLayer = unsafePerformIO $ getAPIEntry "glutUseLayer"++-- glutVideoPan ----------------------------------------------------------------++glutVideoPan :: MonadIO m => CInt -> CInt -> CInt -> CInt -> m ()+glutVideoPan v1 v2 v3 v4 = liftIO $ dyn_glutVideoPan ptr_glutVideoPan v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutVideoPan+  :: FunPtr (CInt -> CInt -> CInt -> CInt -> IO ())+  ->         CInt -> CInt -> CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutVideoPan #-}+ptr_glutVideoPan :: FunPtr a+ptr_glutVideoPan = unsafePerformIO $ getAPIEntry "glutVideoPan"++-- glutVideoResize -------------------------------------------------------------++glutVideoResize :: MonadIO m => CInt -> CInt -> CInt -> CInt -> m ()+glutVideoResize v1 v2 v3 v4 = liftIO $ dyn_glutVideoResize ptr_glutVideoResize v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutVideoResize+  :: FunPtr (CInt -> CInt -> CInt -> CInt -> IO ())+  ->         CInt -> CInt -> CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutVideoResize #-}+ptr_glutVideoResize :: FunPtr a+ptr_glutVideoResize = unsafePerformIO $ getAPIEntry "glutVideoResize"++-- glutVideoResizeGet ----------------------------------------------------------++glutVideoResizeGet :: MonadIO m => GLenum -> m CInt+glutVideoResizeGet v1 = liftIO $ dyn_glutVideoResizeGet ptr_glutVideoResizeGet v1++foreign import CALLCONV "dynamic" dyn_glutVideoResizeGet+  :: FunPtr (GLenum -> IO CInt)+  ->         GLenum -> IO CInt++{-# NOINLINE ptr_glutVideoResizeGet #-}+ptr_glutVideoResizeGet :: FunPtr a+ptr_glutVideoResizeGet = unsafePerformIO $ getAPIEntry "glutVideoResizeGet"++-- glutVisibilityFunc ----------------------------------------------------------++glutVisibilityFunc :: MonadIO m => FunPtr VisibilityFunc -> m ()+glutVisibilityFunc v1 = liftIO $ dyn_glutVisibilityFunc ptr_glutVisibilityFunc v1++foreign import CALLCONV "dynamic" dyn_glutVisibilityFunc+  :: FunPtr (FunPtr VisibilityFunc -> IO ())+  ->         FunPtr VisibilityFunc -> IO ()++{-# NOINLINE ptr_glutVisibilityFunc #-}+ptr_glutVisibilityFunc :: FunPtr a+ptr_glutVisibilityFunc = unsafePerformIO $ getAPIEntry "glutVisibilityFunc"++-- glutWMCloseFunc -------------------------------------------------------------++glutWMCloseFunc :: MonadIO m => FunPtr WMCloseFunc -> m ()+glutWMCloseFunc v1 = liftIO $ dyn_glutWMCloseFunc ptr_glutWMCloseFunc v1++foreign import CALLCONV "dynamic" dyn_glutWMCloseFunc+  :: FunPtr (FunPtr WMCloseFunc -> IO ())+  ->         FunPtr WMCloseFunc -> IO ()++{-# NOINLINE ptr_glutWMCloseFunc #-}+ptr_glutWMCloseFunc :: FunPtr a+ptr_glutWMCloseFunc = unsafePerformIO $ getAPIEntry "glutWMCloseFunc"++-- glutWarpPointer -------------------------------------------------------------++glutWarpPointer :: MonadIO m => CInt -> CInt -> m ()+glutWarpPointer v1 v2 = liftIO $ dyn_glutWarpPointer ptr_glutWarpPointer v1 v2++foreign import CALLCONV "dynamic" dyn_glutWarpPointer+  :: FunPtr (CInt -> CInt -> IO ())+  ->         CInt -> CInt -> IO ()++{-# NOINLINE ptr_glutWarpPointer #-}+ptr_glutWarpPointer :: FunPtr a+ptr_glutWarpPointer = unsafePerformIO $ getAPIEntry "glutWarpPointer"++-- glutWindowStatusFunc --------------------------------------------------------++glutWindowStatusFunc :: MonadIO m => FunPtr WindowStatusFunc -> m ()+glutWindowStatusFunc v1 = liftIO $ dyn_glutWindowStatusFunc ptr_glutWindowStatusFunc v1++foreign import CALLCONV "dynamic" dyn_glutWindowStatusFunc+  :: FunPtr (FunPtr WindowStatusFunc -> IO ())+  ->         FunPtr WindowStatusFunc -> IO ()++{-# NOINLINE ptr_glutWindowStatusFunc #-}+ptr_glutWindowStatusFunc :: FunPtr a+ptr_glutWindowStatusFunc = unsafePerformIO $ getAPIEntry "glutWindowStatusFunc"++-- glutWireCone ----------------------------------------------------------------++glutWireCone :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutWireCone v1 v2 v3 v4 = liftIO $ dyn_glutWireCone ptr_glutWireCone v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutWireCone+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutWireCone #-}+ptr_glutWireCone :: FunPtr a+ptr_glutWireCone = unsafePerformIO $ getAPIEntry "glutWireCone"++-- glutWireCube ----------------------------------------------------------------++glutWireCube :: MonadIO m => GLdouble -> m ()+glutWireCube v1 = liftIO $ dyn_glutWireCube ptr_glutWireCube v1++foreign import CALLCONV "dynamic" dyn_glutWireCube+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutWireCube #-}+ptr_glutWireCube :: FunPtr a+ptr_glutWireCube = unsafePerformIO $ getAPIEntry "glutWireCube"++-- glutWireCylinder ------------------------------------------------------------++glutWireCylinder :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutWireCylinder v1 v2 v3 v4 = liftIO $ dyn_glutWireCylinder ptr_glutWireCylinder v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutWireCylinder+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutWireCylinder #-}+ptr_glutWireCylinder :: FunPtr a+ptr_glutWireCylinder = unsafePerformIO $ getAPIEntry "glutWireCylinder"++-- glutWireDodecahedron --------------------------------------------------------++glutWireDodecahedron :: MonadIO m => m ()+glutWireDodecahedron = liftIO $ dyn_glutWireDodecahedron ptr_glutWireDodecahedron++foreign import CALLCONV "dynamic" dyn_glutWireDodecahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutWireDodecahedron #-}+ptr_glutWireDodecahedron :: FunPtr a+ptr_glutWireDodecahedron = unsafePerformIO $ getAPIEntry "glutWireDodecahedron"++-- glutWireIcosahedron ---------------------------------------------------------++glutWireIcosahedron :: MonadIO m => m ()+glutWireIcosahedron = liftIO $ dyn_glutWireIcosahedron ptr_glutWireIcosahedron++foreign import CALLCONV "dynamic" dyn_glutWireIcosahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutWireIcosahedron #-}+ptr_glutWireIcosahedron :: FunPtr a+ptr_glutWireIcosahedron = unsafePerformIO $ getAPIEntry "glutWireIcosahedron"++-- glutWireOctahedron ----------------------------------------------------------++glutWireOctahedron :: MonadIO m => m ()+glutWireOctahedron = liftIO $ dyn_glutWireOctahedron ptr_glutWireOctahedron++foreign import CALLCONV "dynamic" dyn_glutWireOctahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutWireOctahedron #-}+ptr_glutWireOctahedron :: FunPtr a+ptr_glutWireOctahedron = unsafePerformIO $ getAPIEntry "glutWireOctahedron"++-- glutWireRhombicDodecahedron -------------------------------------------------++glutWireRhombicDodecahedron :: MonadIO m => m ()+glutWireRhombicDodecahedron = liftIO $ dyn_glutWireRhombicDodecahedron ptr_glutWireRhombicDodecahedron++foreign import CALLCONV "dynamic" dyn_glutWireRhombicDodecahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutWireRhombicDodecahedron #-}+ptr_glutWireRhombicDodecahedron :: FunPtr a+ptr_glutWireRhombicDodecahedron = unsafePerformIO $ getAPIEntry "glutWireRhombicDodecahedron"++-- glutWireSierpinskiSponge ----------------------------------------------------++glutWireSierpinskiSponge :: MonadIO m => CInt -> Ptr GLdouble -> GLdouble -> m ()+glutWireSierpinskiSponge v1 v2 v3 = liftIO $ dyn_glutWireSierpinskiSponge ptr_glutWireSierpinskiSponge v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutWireSierpinskiSponge+  :: FunPtr (CInt -> Ptr GLdouble -> GLdouble -> IO ())+  ->         CInt -> Ptr GLdouble -> GLdouble -> IO ()++{-# NOINLINE ptr_glutWireSierpinskiSponge #-}+ptr_glutWireSierpinskiSponge :: FunPtr a+ptr_glutWireSierpinskiSponge = unsafePerformIO $ getAPIEntry "glutWireSierpinskiSponge"++-- glutWireSphere --------------------------------------------------------------++glutWireSphere :: MonadIO m => GLdouble -> GLint -> GLint -> m ()+glutWireSphere v1 v2 v3 = liftIO $ dyn_glutWireSphere ptr_glutWireSphere v1 v2 v3++foreign import CALLCONV "dynamic" dyn_glutWireSphere+  :: FunPtr (GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutWireSphere #-}+ptr_glutWireSphere :: FunPtr a+ptr_glutWireSphere = unsafePerformIO $ getAPIEntry "glutWireSphere"++-- glutWireTeacup --------------------------------------------------------------++glutWireTeacup :: MonadIO m => GLdouble -> m ()+glutWireTeacup v1 = liftIO $ dyn_glutWireTeacup ptr_glutWireTeacup v1++foreign import CALLCONV "dynamic" dyn_glutWireTeacup+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutWireTeacup #-}+ptr_glutWireTeacup :: FunPtr a+ptr_glutWireTeacup = unsafePerformIO $ getAPIEntry "glutWireTeacup"++-- glutWireTeapot --------------------------------------------------------------++glutWireTeapot :: MonadIO m => GLdouble -> m ()+glutWireTeapot v1 = liftIO $ dyn_glutWireTeapot ptr_glutWireTeapot v1++foreign import CALLCONV "dynamic" dyn_glutWireTeapot+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutWireTeapot #-}+ptr_glutWireTeapot :: FunPtr a+ptr_glutWireTeapot = unsafePerformIO $ getAPIEntry "glutWireTeapot"++-- glutWireTeaspoon ------------------------------------------------------------++glutWireTeaspoon :: MonadIO m => GLdouble -> m ()+glutWireTeaspoon v1 = liftIO $ dyn_glutWireTeaspoon ptr_glutWireTeaspoon v1++foreign import CALLCONV "dynamic" dyn_glutWireTeaspoon+  :: FunPtr (GLdouble -> IO ())+  ->         GLdouble -> IO ()++{-# NOINLINE ptr_glutWireTeaspoon #-}+ptr_glutWireTeaspoon :: FunPtr a+ptr_glutWireTeaspoon = unsafePerformIO $ getAPIEntry "glutWireTeaspoon"++-- glutWireTetrahedron ---------------------------------------------------------++glutWireTetrahedron :: MonadIO m => m ()+glutWireTetrahedron = liftIO $ dyn_glutWireTetrahedron ptr_glutWireTetrahedron++foreign import CALLCONV "dynamic" dyn_glutWireTetrahedron+  :: FunPtr (IO ())+  ->         IO ()++{-# NOINLINE ptr_glutWireTetrahedron #-}+ptr_glutWireTetrahedron :: FunPtr a+ptr_glutWireTetrahedron = unsafePerformIO $ getAPIEntry "glutWireTetrahedron"++-- glutWireTorus ---------------------------------------------------------------++glutWireTorus :: MonadIO m => GLdouble -> GLdouble -> GLint -> GLint -> m ()+glutWireTorus v1 v2 v3 v4 = liftIO $ dyn_glutWireTorus ptr_glutWireTorus v1 v2 v3 v4++foreign import CALLCONV "dynamic" dyn_glutWireTorus+  :: FunPtr (GLdouble -> GLdouble -> GLint -> GLint -> IO ())+  ->         GLdouble -> GLdouble -> GLint -> GLint -> IO ()++{-# NOINLINE ptr_glutWireTorus #-}+ptr_glutWireTorus :: FunPtr a+ptr_glutWireTorus = unsafePerformIO $ getAPIEntry "glutWireTorus"+
+ src/Graphics/UI/GLUT/Raw/Tokens.hs view
@@ -0,0 +1,643 @@+{-# OPTIONS_HADDOCK hide #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Raw.Tokens+-- Copyright   :  (c) Sven Panne 2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- All tokens from GLUT and freeglut.+--+-----------------------------------------------------------------------------++module Graphics.UI.GLUT.Raw.Tokens where++import Foreign.C.Types ( CInt, CUInt )+import Graphics.Rendering.OpenGL ( GLenum )++glut_ACCUM :: CUInt+glut_ACCUM = 0x0004++glut_ACTION_CONTINUE_EXECUTION :: CInt+glut_ACTION_CONTINUE_EXECUTION = 2++glut_ACTION_EXIT :: CInt+glut_ACTION_EXIT = 0++glut_ACTION_GLUTMAINLOOP_RETURNS :: CInt+glut_ACTION_GLUTMAINLOOP_RETURNS = 1++glut_ACTION_ON_WINDOW_CLOSE :: GLenum+glut_ACTION_ON_WINDOW_CLOSE = 0x01F9++glut_ACTIVE_ALT :: CInt+glut_ACTIVE_ALT = 0x0004++glut_ACTIVE_CTRL :: CInt+glut_ACTIVE_CTRL = 0x0002++glut_ACTIVE_SHIFT :: CInt+glut_ACTIVE_SHIFT = 0x0001++glut_ALLOW_DIRECT_CONTEXT :: CInt+glut_ALLOW_DIRECT_CONTEXT = 1++glut_ALPHA :: CUInt+glut_ALPHA = 0x0008++glut_APPSTATUS_PAUSE :: CInt+glut_APPSTATUS_PAUSE = 0x0001++glut_APPSTATUS_RESUME :: CInt+glut_APPSTATUS_RESUME = 0x0002++glut_AUX :: GLenum+glut_AUX = 0x1000++glut_AUX1 :: CUInt+glut_AUX1 = 0x1000++glut_AUX2 :: CUInt+glut_AUX2 = 0x2000++glut_AUX3 :: CUInt+glut_AUX3 = 0x4000++glut_AUX4 :: CUInt+glut_AUX4 = 0x8000++glut_BLUE :: CInt+glut_BLUE = 0x0002++glut_BORDERLESS :: CUInt+glut_BORDERLESS = 0x0800++glut_CAPTIONLESS :: CUInt+glut_CAPTIONLESS = 0x0400++glut_CORE_PROFILE :: CInt+glut_CORE_PROFILE = 0x0001++glut_COMPATIBILITY_PROFILE :: CInt+glut_COMPATIBILITY_PROFILE = 0x0002++glut_CREATE_NEW_CONTEXT :: CInt+glut_CREATE_NEW_CONTEXT = 0++glut_CURSOR_BOTTOM_LEFT_CORNER :: CInt+glut_CURSOR_BOTTOM_LEFT_CORNER = 0x0013++glut_CURSOR_BOTTOM_RIGHT_CORNER :: CInt+glut_CURSOR_BOTTOM_RIGHT_CORNER = 0x0012++glut_CURSOR_BOTTOM_SIDE :: CInt+glut_CURSOR_BOTTOM_SIDE = 0x000D++glut_CURSOR_CROSSHAIR :: CInt+glut_CURSOR_CROSSHAIR = 0x0009++glut_CURSOR_CYCLE :: CInt+glut_CURSOR_CYCLE = 0x0005++glut_CURSOR_DESTROY :: CInt+glut_CURSOR_DESTROY = 0x0003++glut_CURSOR_FULL_CROSSHAIR :: CInt+glut_CURSOR_FULL_CROSSHAIR = 0x0066++glut_CURSOR_HELP :: CInt+glut_CURSOR_HELP = 0x0004++glut_CURSOR_INFO :: CInt+glut_CURSOR_INFO = 0x0002++glut_CURSOR_INHERIT :: CInt+glut_CURSOR_INHERIT = 0x0064++glut_CURSOR_LEFT_ARROW :: CInt+glut_CURSOR_LEFT_ARROW = 0x0001++glut_CURSOR_LEFT_RIGHT :: CInt+glut_CURSOR_LEFT_RIGHT = 0x000B++glut_CURSOR_LEFT_SIDE :: CInt+glut_CURSOR_LEFT_SIDE = 0x000E++glut_CURSOR_NONE :: CInt+glut_CURSOR_NONE = 0x0065++glut_CURSOR_RIGHT_ARROW :: CInt+glut_CURSOR_RIGHT_ARROW = 0x0000++glut_CURSOR_RIGHT_SIDE :: CInt+glut_CURSOR_RIGHT_SIDE = 0x000F++glut_CURSOR_SPRAY :: CInt+glut_CURSOR_SPRAY = 0x0006++glut_CURSOR_TEXT :: CInt+glut_CURSOR_TEXT = 0x0008++glut_CURSOR_TOP_LEFT_CORNER :: CInt+glut_CURSOR_TOP_LEFT_CORNER = 0x0010++glut_CURSOR_TOP_RIGHT_CORNER :: CInt+glut_CURSOR_TOP_RIGHT_CORNER = 0x0011++glut_CURSOR_TOP_SIDE :: CInt+glut_CURSOR_TOP_SIDE = 0x000C++glut_CURSOR_UP_DOWN :: CInt+glut_CURSOR_UP_DOWN = 0x000A++glut_CURSOR_WAIT :: CInt+glut_CURSOR_WAIT = 0x0007++glut_DEBUG :: CInt+glut_DEBUG = 0x0001++glut_DEPTH :: CUInt+glut_DEPTH = 0x0010++glut_DEVICE_IGNORE_KEY_REPEAT :: GLenum+glut_DEVICE_IGNORE_KEY_REPEAT = 0x0262++glut_DEVICE_KEY_REPEAT :: GLenum+glut_DEVICE_KEY_REPEAT = 0x0263++glut_DIRECT_RENDERING :: GLenum+glut_DIRECT_RENDERING = 0x01FE++glut_DISPLAY_MODE_POSSIBLE :: GLenum+glut_DISPLAY_MODE_POSSIBLE = 0x0190++glut_DOUBLE :: CUInt+glut_DOUBLE = 0x0002++glut_DOWN :: CInt+glut_DOWN = 0x0000++glut_ELAPSED_TIME :: GLenum+glut_ELAPSED_TIME = 0x02BC++glut_ENTERED :: CInt+glut_ENTERED = 0x0001++glut_FORCE_DIRECT_CONTEXT :: CInt+glut_FORCE_DIRECT_CONTEXT = 3++glut_FORCE_INDIRECT_CONTEXT :: CInt+glut_FORCE_INDIRECT_CONTEXT = 0++glut_FORWARD_COMPATIBLE :: CInt+glut_FORWARD_COMPATIBLE = 0x0002++glut_FULLY_COVERED :: CInt+glut_FULLY_COVERED = 0x0003++glut_FULLY_RETAINED :: CInt+glut_FULLY_RETAINED = 0x0001++glut_FULL_SCREEN :: GLenum+glut_FULL_SCREEN = 0x01FF++glut_GAME_MODE_ACTIVE :: GLenum+glut_GAME_MODE_ACTIVE = 0x0000++glut_GAME_MODE_DISPLAY_CHANGED :: GLenum+glut_GAME_MODE_DISPLAY_CHANGED = 0x0006++glut_GAME_MODE_HEIGHT :: GLenum+glut_GAME_MODE_HEIGHT = 0x0003++glut_GAME_MODE_PIXEL_DEPTH :: GLenum+glut_GAME_MODE_PIXEL_DEPTH = 0x0004++glut_GAME_MODE_POSSIBLE :: GLenum+glut_GAME_MODE_POSSIBLE = 0x0001++glut_GAME_MODE_REFRESH_RATE :: GLenum+glut_GAME_MODE_REFRESH_RATE = 0x0005++glut_GAME_MODE_WIDTH :: GLenum+glut_GAME_MODE_WIDTH = 0x0002++glut_GEOMETRY_VISUALIZE_NORMALS :: GLenum+glut_GEOMETRY_VISUALIZE_NORMALS = 0x0205++glut_GREEN :: CInt+glut_GREEN = 0x0001++glut_HAS_DIAL_AND_BUTTON_BOX :: GLenum+glut_HAS_DIAL_AND_BUTTON_BOX = 0x025B++glut_HAS_JOYSTICK :: GLenum+glut_HAS_JOYSTICK = 0x0264++glut_HAS_KEYBOARD :: GLenum+glut_HAS_KEYBOARD = 0x0258++glut_HAS_MOUSE :: GLenum+glut_HAS_MOUSE = 0x0259++glut_HAS_OVERLAY :: GLenum+glut_HAS_OVERLAY = 0x0322++glut_HAS_SPACEBALL :: GLenum+glut_HAS_SPACEBALL = 0x025A++glut_HAS_TABLET :: GLenum+glut_HAS_TABLET = 0x025C++glut_HIDDEN :: CInt+glut_HIDDEN = 0x0000++glut_INDEX :: CUInt+glut_INDEX = 0x0001++glut_INIT_DISPLAY_MODE :: GLenum+glut_INIT_DISPLAY_MODE = 0x01F8++glut_INIT_FLAGS :: GLenum+glut_INIT_FLAGS = 0x0202++glut_INIT_MAJOR_VERSION :: GLenum+glut_INIT_MAJOR_VERSION = 0x0200++glut_INIT_MINOR_VERSION :: GLenum+glut_INIT_MINOR_VERSION = 0x0201++glut_INIT_PROFILE :: GLenum+glut_INIT_PROFILE = 0x0203++glut_INIT_STATE :: GLenum+glut_INIT_STATE = 0x007C++glut_INIT_WINDOW_HEIGHT :: GLenum+glut_INIT_WINDOW_HEIGHT = 0x01F7++glut_INIT_WINDOW_WIDTH :: GLenum+glut_INIT_WINDOW_WIDTH = 0x01F6++glut_INIT_WINDOW_X :: GLenum+glut_INIT_WINDOW_X = 0x01F4++glut_INIT_WINDOW_Y :: GLenum+glut_INIT_WINDOW_Y = 0x01F5++glut_JOYSTICK_AXES :: GLenum+glut_JOYSTICK_AXES = 0x0267++glut_JOYSTICK_BUTTONS :: GLenum+glut_JOYSTICK_BUTTONS = 0x0266++glut_JOYSTICK_BUTTON_A :: CUInt+glut_JOYSTICK_BUTTON_A = 0x0001++glut_JOYSTICK_BUTTON_B :: CUInt+glut_JOYSTICK_BUTTON_B = 0x0002++glut_JOYSTICK_BUTTON_C :: CUInt+glut_JOYSTICK_BUTTON_C = 0x0004++glut_JOYSTICK_BUTTON_D :: CUInt+glut_JOYSTICK_BUTTON_D = 0x0008++glut_JOYSTICK_POLL_RATE :: GLenum+glut_JOYSTICK_POLL_RATE = 0x0268++glut_KEY_ALT_L :: CInt+glut_KEY_ALT_L = 0x0074++glut_KEY_ALT_R :: CInt+glut_KEY_ALT_R = 0x0075++glut_KEY_BEGIN :: CInt+glut_KEY_BEGIN = 0x006E++glut_KEY_CTRL_L :: CInt+glut_KEY_CTRL_L = 0x0072++glut_KEY_CTRL_R :: CInt+glut_KEY_CTRL_R = 0x0073++glut_KEY_DELETE :: CInt+glut_KEY_DELETE = 0x006F++glut_KEY_DOWN :: CInt+glut_KEY_DOWN = 0x0067++glut_KEY_END :: CInt+glut_KEY_END = 0x006B++glut_KEY_F1 :: CInt+glut_KEY_F1 = 0x0001++glut_KEY_F10 :: CInt+glut_KEY_F10 = 0x000A++glut_KEY_F11 :: CInt+glut_KEY_F11 = 0x000B++glut_KEY_F12 :: CInt+glut_KEY_F12 = 0x000C++glut_KEY_F2 :: CInt+glut_KEY_F2 = 0x0002++glut_KEY_F3 :: CInt+glut_KEY_F3 = 0x0003++glut_KEY_F4 :: CInt+glut_KEY_F4 = 0x0004++glut_KEY_F5 :: CInt+glut_KEY_F5 = 0x0005++glut_KEY_F6 :: CInt+glut_KEY_F6 = 0x0006++glut_KEY_F7 :: CInt+glut_KEY_F7 = 0x0007++glut_KEY_F8 :: CInt+glut_KEY_F8 = 0x0008++glut_KEY_F9 :: CInt+glut_KEY_F9 = 0x0009++glut_KEY_HOME :: CInt+glut_KEY_HOME = 0x006A++glut_KEY_INSERT :: CInt+glut_KEY_INSERT = 0x006C++glut_KEY_LEFT :: CInt+glut_KEY_LEFT = 0x0064++glut_KEY_NUM_LOCK :: CInt+glut_KEY_NUM_LOCK = 0x006D++glut_KEY_PAGE_DOWN :: CInt+glut_KEY_PAGE_DOWN = 0x0069++glut_KEY_PAGE_UP :: CInt+glut_KEY_PAGE_UP = 0x0068++glut_KEY_REPEAT_DEFAULT :: CInt+glut_KEY_REPEAT_DEFAULT = 0x0002++glut_KEY_REPEAT_OFF :: CInt+glut_KEY_REPEAT_OFF = 0x0000++glut_KEY_REPEAT_ON :: CInt+glut_KEY_REPEAT_ON = 0x0001++glut_KEY_RIGHT :: CInt+glut_KEY_RIGHT = 0x0066++glut_KEY_SHIFT_L :: CInt+glut_KEY_SHIFT_L = 0x0070++glut_KEY_SHIFT_R :: CInt+glut_KEY_SHIFT_R = 0x0071++glut_KEY_UP :: CInt+glut_KEY_UP = 0x0065++glut_LAYER_IN_USE :: GLenum+glut_LAYER_IN_USE = 0x0321++glut_LEFT :: CInt+glut_LEFT = 0x0000++glut_LEFT_BUTTON :: CInt+glut_LEFT_BUTTON = 0x0000++glut_LUMINANCE :: CUInt+glut_LUMINANCE = 0x0200++glut_MENU_IN_USE :: CInt+glut_MENU_IN_USE = 0x0001++glut_MENU_NOT_IN_USE :: CInt+glut_MENU_NOT_IN_USE = 0x0000++glut_MENU_NUM_ITEMS :: GLenum+glut_MENU_NUM_ITEMS = 0x012C++glut_MIDDLE_BUTTON :: CInt+glut_MIDDLE_BUTTON = 0x0001++glut_MULTISAMPLE :: CUInt+glut_MULTISAMPLE = 0x0080++glut_NORMAL :: GLenum+glut_NORMAL = 0x0000++glut_NORMAL_DAMAGED :: GLenum+glut_NORMAL_DAMAGED = 0x0324++glut_NOT_VISIBLE :: CInt+glut_NOT_VISIBLE = 0x0000++glut_NUM_BUTTON_BOX_BUTTONS :: GLenum+glut_NUM_BUTTON_BOX_BUTTONS = 0x025F++glut_NUM_DIALS :: GLenum+glut_NUM_DIALS = 0x0260++glut_NUM_MOUSE_BUTTONS :: GLenum+glut_NUM_MOUSE_BUTTONS = 0x025D++glut_NUM_SPACEBALL_BUTTONS :: GLenum+glut_NUM_SPACEBALL_BUTTONS = 0x025E++glut_NUM_TABLET_BUTTONS :: GLenum+glut_NUM_TABLET_BUTTONS = 0x0261++glut_OVERLAY :: GLenum+glut_OVERLAY = 0x0001++glut_OVERLAY_DAMAGED :: GLenum+glut_OVERLAY_DAMAGED = 0x0325++glut_OVERLAY_POSSIBLE :: GLenum+glut_OVERLAY_POSSIBLE = 0x0320++glut_OWNS_JOYSTICK :: GLenum+glut_OWNS_JOYSTICK = 0x0265++glut_PARTIALLY_RETAINED :: CInt+glut_PARTIALLY_RETAINED = 0x0002++glut_RED :: CInt+glut_RED = 0x0000++glut_RENDERING_CONTEXT :: GLenum+glut_RENDERING_CONTEXT = 0x01FD++glut_RGB :: CUInt+glut_RGB = 0x0000++glut_RGBA :: CUInt+glut_RGBA = 0x0000++glut_RIGHT_BUTTON :: CInt+glut_RIGHT_BUTTON = 0x0002++glut_SCREEN_HEIGHT :: GLenum+glut_SCREEN_HEIGHT = 0x00C9++glut_SCREEN_HEIGHT_MM :: GLenum+glut_SCREEN_HEIGHT_MM = 0x00CB++glut_SCREEN_WIDTH :: GLenum+glut_SCREEN_WIDTH = 0x00C8++glut_SCREEN_WIDTH_MM :: GLenum+glut_SCREEN_WIDTH_MM = 0x00CA++glut_SINGLE :: CUInt+glut_SINGLE = 0x0000++glut_SKIP_STALE_MOTION_EVENTS :: GLenum+glut_SKIP_STALE_MOTION_EVENTS = 0x0204++glut_SRGB :: CUInt+glut_SRGB = 0x1000++glut_STENCIL :: CUInt+glut_STENCIL = 0x0020++glut_STEREO :: CUInt+glut_STEREO = 0x0100++glut_TRANSPARENT_INDEX :: GLenum+glut_TRANSPARENT_INDEX = 0x0323++glut_TRY_DIRECT_CONTEXT :: CInt+glut_TRY_DIRECT_CONTEXT = 2++glut_UP :: CInt+glut_UP = 0x0001++glut_USE_CURRENT_CONTEXT :: CInt+glut_USE_CURRENT_CONTEXT = 1++glut_VERSION :: GLenum+glut_VERSION = 0x01FC++glut_VIDEO_RESIZE_HEIGHT :: GLenum+glut_VIDEO_RESIZE_HEIGHT = 0x038D++glut_VIDEO_RESIZE_HEIGHT_DELTA :: GLenum+glut_VIDEO_RESIZE_HEIGHT_DELTA = 0x0389++glut_VIDEO_RESIZE_IN_USE :: GLenum+glut_VIDEO_RESIZE_IN_USE = 0x0385++glut_VIDEO_RESIZE_POSSIBLE :: GLenum+glut_VIDEO_RESIZE_POSSIBLE = 0x0384++glut_VIDEO_RESIZE_WIDTH :: GLenum+glut_VIDEO_RESIZE_WIDTH = 0x038C++glut_VIDEO_RESIZE_WIDTH_DELTA :: GLenum+glut_VIDEO_RESIZE_WIDTH_DELTA = 0x0388++glut_VIDEO_RESIZE_X :: GLenum+glut_VIDEO_RESIZE_X = 0x038A++glut_VIDEO_RESIZE_X_DELTA :: GLenum+glut_VIDEO_RESIZE_X_DELTA = 0x0386++glut_VIDEO_RESIZE_Y :: GLenum+glut_VIDEO_RESIZE_Y = 0x038B++glut_VIDEO_RESIZE_Y_DELTA :: GLenum+glut_VIDEO_RESIZE_Y_DELTA = 0x0387++glut_VISIBLE :: CInt+glut_VISIBLE = 0x0001++glut_WINDOW_ACCUM_ALPHA_SIZE :: GLenum+glut_WINDOW_ACCUM_ALPHA_SIZE = 0x0072++glut_WINDOW_ACCUM_BLUE_SIZE :: GLenum+glut_WINDOW_ACCUM_BLUE_SIZE = 0x0071++glut_WINDOW_ACCUM_GREEN_SIZE :: GLenum+glut_WINDOW_ACCUM_GREEN_SIZE = 0x0070++glut_WINDOW_ACCUM_RED_SIZE :: GLenum+glut_WINDOW_ACCUM_RED_SIZE = 0x006F++glut_WINDOW_ALPHA_SIZE :: GLenum+glut_WINDOW_ALPHA_SIZE = 0x006E++glut_WINDOW_BLUE_SIZE :: GLenum+glut_WINDOW_BLUE_SIZE = 0x006D++glut_WINDOW_BORDER_WIDTH :: GLenum+glut_WINDOW_BORDER_WIDTH = 0x01FA++glut_WINDOW_BUFFER_SIZE :: GLenum+glut_WINDOW_BUFFER_SIZE = 0x0068++glut_WINDOW_COLORMAP_SIZE :: GLenum+glut_WINDOW_COLORMAP_SIZE = 0x0077++glut_WINDOW_CURSOR :: GLenum+glut_WINDOW_CURSOR = 0x007A++glut_WINDOW_DEPTH_SIZE :: GLenum+glut_WINDOW_DEPTH_SIZE = 0x006A++glut_WINDOW_DOUBLEBUFFER :: GLenum+glut_WINDOW_DOUBLEBUFFER = 0x0073++glut_WINDOW_FORMAT_ID :: GLenum+glut_WINDOW_FORMAT_ID = 0x007B++glut_WINDOW_GREEN_SIZE :: GLenum+glut_WINDOW_GREEN_SIZE = 0x006C++glut_WINDOW_HEADER_HEIGHT :: GLenum+glut_WINDOW_HEADER_HEIGHT = 0x01FB++glut_WINDOW_HEIGHT :: GLenum+glut_WINDOW_HEIGHT = 0x0067++glut_WINDOW_NUM_CHILDREN :: GLenum+glut_WINDOW_NUM_CHILDREN = 0x0076++glut_WINDOW_NUM_SAMPLES :: GLenum+glut_WINDOW_NUM_SAMPLES = 0x0078++glut_WINDOW_PARENT :: GLenum+glut_WINDOW_PARENT = 0x0075++glut_WINDOW_RED_SIZE :: GLenum+glut_WINDOW_RED_SIZE = 0x006B++glut_WINDOW_RGBA :: GLenum+glut_WINDOW_RGBA = 0x0074++glut_WINDOW_STENCIL_SIZE :: GLenum+glut_WINDOW_STENCIL_SIZE = 0x0069++glut_WINDOW_STEREO :: GLenum+glut_WINDOW_STEREO = 0x0079++glut_WINDOW_WIDTH :: GLenum+glut_WINDOW_WIDTH = 0x0066++glut_WINDOW_X :: GLenum+glut_WINDOW_X = 0x0064++glut_WINDOW_Y :: GLenum+glut_WINDOW_Y = 0x0065
+ src/Graphics/UI/GLUT/State.hs view
@@ -0,0 +1,448 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.State+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT maintains a considerable amount of programmer visible state. Some (but+-- not all) of this state may be directly retrieved.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.State (+   -- * State of all windows+   windowBorderWidth, windowHeaderHeight, skipStaleMotionEvents,++   -- * State of the /current window/++   -- ** Framebuffer state+   rgba,+   BufferDepth, rgbaBufferDepths, colorBufferDepth,+   doubleBuffered, stereo,+   accumBufferDepths, depthBufferDepth, stencilBufferDepth,+   SampleCount, sampleCount, formatID,++   -- ** Full screen state+   fullScreenMode,++   -- ** Object rendering state+   geometryVisualizeNormals,++   -- ** Vertex attribute state+   vertexAttribCoord3, vertexAttribNormal, vertexAttribTexCoord2,++   -- ** Layer state+   damaged,++   -- * Timing+   elapsedTime,++   -- * Device information++   -- $DeviceInformation+   screenSize, screenSizeMM,+   hasKeyboard,+   ButtonCount, numMouseButtons,+   numSpaceballButtons,+   DialCount, numDialsAndButtons,+   numTabletButtons,+   AxisCount, PollRate, joystickInfo,+   supportedNumAuxBuffers, supportedSamplesPerPixel,++   -- * GLUT information+   glutVersion, initState+) where++import Control.Monad ( unless )+import Data.StateVar ( GettableStateVar, makeGettableStateVar+                     , SettableStateVar, makeSettableStateVar+                     , StateVar, makeStateVar )+import Foreign.C.Types ( CInt )+import Foreign.Marshal.Alloc ( alloca )+import Foreign.Marshal.Array ( peekArray )+import Foreign.Storable ( peek )+import Graphics.Rendering.OpenGL ( AttribLocation(..), Size(..), GLenum, GLint )++import Graphics.UI.GLUT.Overlay+import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Window++--------------------------------------------------------------------------------++-- | Contains 'True' when the current layer of the /current window/ is in RGBA+-- mode, 'False' means color index mode.++rgba :: GettableStateVar Bool+rgba = makeGettableStateVar$ simpleGet i2b glut_WINDOW_RGBA++-- | Bit depth of a buffer++type BufferDepth = Int++-- | Contains the number of red, green, blue, and alpha bits in the color buffer+-- of the /current window\'s/ current layer (0 in color index mode).++rgbaBufferDepths ::+   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)+rgbaBufferDepths = makeGettableStateVar $ do+   r <- simpleGet fromIntegral glut_WINDOW_RED_SIZE+   g <- simpleGet fromIntegral glut_WINDOW_GREEN_SIZE+   b <- simpleGet fromIntegral glut_WINDOW_BLUE_SIZE+   a <- simpleGet fromIntegral glut_WINDOW_ALPHA_SIZE+   return (r, g, b, a)++-- | Contains the total number of bits in the color buffer of the /current+-- window\'s/ current layer. For an RGBA layer, this is the sum of the red,+-- green, blue, and alpha bits. For an color index layer, this is the number+-- of bits of the color indexes.++colorBufferDepth :: GettableStateVar BufferDepth+colorBufferDepth =+   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_BUFFER_SIZE++-- | Contains 'True' when the current layer of the /current window/ is double+-- buffered, 'False' otherwise.++doubleBuffered :: GettableStateVar Bool+doubleBuffered = makeGettableStateVar $ simpleGet i2b glut_WINDOW_DOUBLEBUFFER++-- | Contains 'True' when the current layer of the /current window/ is stereo,+-- 'False' otherwise.++stereo :: GettableStateVar Bool+stereo = makeGettableStateVar $ simpleGet i2b glut_WINDOW_STEREO++-- | Contains the number of red, green, blue, and alpha bits in the accumulation+-- buffer of the /current window\'s/ current layer (0 in color index mode).++accumBufferDepths ::+   GettableStateVar (BufferDepth, BufferDepth, BufferDepth, BufferDepth)+accumBufferDepths = makeGettableStateVar $ do+   r <- simpleGet fromIntegral glut_WINDOW_ACCUM_RED_SIZE+   g <- simpleGet fromIntegral glut_WINDOW_ACCUM_GREEN_SIZE+   b <- simpleGet fromIntegral glut_WINDOW_ACCUM_BLUE_SIZE+   a <- simpleGet fromIntegral glut_WINDOW_ACCUM_ALPHA_SIZE+   return (r, g, b, a)++-- | Contains the number of bits in the depth buffer of the /current window\'s/+-- current layer.++depthBufferDepth :: GettableStateVar BufferDepth+depthBufferDepth =+   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_DEPTH_SIZE++-- | Contains the number of bits in the stencil buffer of the /current+-- window\'s/ current layer.++stencilBufferDepth :: GettableStateVar BufferDepth+stencilBufferDepth =+   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_STENCIL_SIZE++-- | Number of samples for multisampling++type SampleCount = Int++-- | Contains the number of samples for multisampling for the /current window./++sampleCount :: GettableStateVar SampleCount+sampleCount =+   makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_NUM_SAMPLES++-- | Contains the window system dependent format ID for the current layer of the+-- /current window/. On X11 GLUT implementations, this is the X visual ID. On+-- Win32 GLUT implementations, this is the Win32 Pixel Format Descriptor number.+-- This value is returned for debugging, benchmarking, and testing ease.++formatID :: GettableStateVar Int+formatID = makeGettableStateVar $ simpleGet fromIntegral glut_WINDOW_FORMAT_ID++--------------------------------------------------------------------------------++-- | (/freeglut only/) Contains 'True' if the /current window/ is in full screen+-- mode, 'False' otherwise.++fullScreenMode :: StateVar Bool+fullScreenMode = makeStateVar getFullScreenMode setFullScreenMode++getFullScreenMode :: IO Bool+getFullScreenMode = simpleGet i2b glut_FULL_SCREEN++setFullScreenMode :: Bool -> IO ()+setFullScreenMode newMode = do+   oldMode <- getFullScreenMode+   unless (newMode == oldMode) fullScreenToggle++--------------------------------------------------------------------------------++-- | (/freeglut only/) Controls if vectors representing the normals should be+-- drawn, too, when objects are drawn.++geometryVisualizeNormals :: StateVar Bool+geometryVisualizeNormals =+   makeStateVar+      (simpleGet i2b glut_GEOMETRY_VISUALIZE_NORMALS)+      (glutSetOption glut_GEOMETRY_VISUALIZE_NORMALS . b2i)+++--------------------------------------------------------------------------------++-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both+-- contain 'Nothing', the fixed function pipeline is used to draw+-- objects. Otherwise VBOs are used and the coordinates are passed via 'Just'+-- this attribute location (for a vec3).++vertexAttribCoord3 :: SettableStateVar (Maybe AttribLocation)+vertexAttribCoord3 = setVertexAttribWith glutSetVertexAttribCoord3++setVertexAttribWith :: (GLint -> IO ()) -> SettableStateVar (Maybe AttribLocation)+setVertexAttribWith f = makeSettableStateVar $ f . getLocation+   where getLocation = maybe (-1) (\(AttribLocation l) -> fromIntegral l)++-- | (/freeglut only/) If 'vertexAttribCoord3' and 'vertexAttribNormal' both+-- contain 'Nothing', the fixed function pipeline is used to draw+-- objects. Otherwise VBOs are used and the normals are passed via 'Just' this+-- attribute location (for a vec3).++vertexAttribNormal :: SettableStateVar (Maybe AttribLocation)+vertexAttribNormal = setVertexAttribWith glutSetVertexAttribNormal++-- | (/freeglut only/) If VBOs are used to draw objects (controlled via+-- 'vertexAttribCoord3' and 'vertexAttribNormal'), the texture coordinates are+-- passed via 'Just' this attribute location (for a vec2).++vertexAttribTexCoord2 :: SettableStateVar (Maybe AttribLocation)+vertexAttribTexCoord2 = setVertexAttribWith glutSetVertexAttribTexCoord2++--------------------------------------------------------------------------------++-- | Contains the number of milliseconds since+-- 'Graphics.UI.GLUT.Initialization.initialize' was called.++elapsedTime :: GettableStateVar Int+elapsedTime = makeGettableStateVar $ simpleGet fromIntegral glut_ELAPSED_TIME++--------------------------------------------------------------------------------++-- | Contains 'True' if the given plane of the /current window/ has been+-- damaged (by window system activity) since the last display callback was+-- triggered. Calling 'Graphics.UI.GLUT.Window.postRedisplay' or+-- 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay' will not set this 'True'.++damaged :: Layer -> GettableStateVar Bool+damaged l = makeGettableStateVar $ layerGet isDamaged (marshalDamagedLayer l)+   where isDamaged d = d /= 0 && d /= -1+         marshalDamagedLayer x = case x of+            Normal -> glut_NORMAL_DAMAGED+            Overlay -> glut_OVERLAY_DAMAGED++--------------------------------------------------------------------------------++-- $DeviceInformation+-- If a device is not available, the following state variables contain+-- 'Nothing', otherwise they return 'Just' the specific device information.+-- Only a screen is always assumed.++--------------------------------------------------------------------------------++-- | The size of the screen in pixels.++screenSize :: GettableStateVar Size+screenSize =+   makeGettableStateVar $ do+      wpx <- simpleGet fromIntegral glut_SCREEN_WIDTH+      hpx <- simpleGet fromIntegral glut_SCREEN_HEIGHT+      return $ Size wpx hpx++-- | The size of the screen in millimeters.++screenSizeMM :: GettableStateVar Size+screenSizeMM =+   makeGettableStateVar $ do+      wmm <- simpleGet fromIntegral glut_SCREEN_WIDTH_MM+      hmm <- simpleGet fromIntegral glut_SCREEN_HEIGHT_MM+      return $ Size wmm hmm++--------------------------------------------------------------------------------++-- | Contains 'True' if a keyboard is present, 'False' otherwise.++hasKeyboard :: GettableStateVar Bool+hasKeyboard = makeGettableStateVar $ deviceGet i2b glut_HAS_KEYBOARD++--------------------------------------------------------------------------------++-- | Number of buttons of an input device++type ButtonCount = Int++-- | Contains 'Just' the number of buttons of an attached mouse or 'Nothing' if+-- there is none.++numMouseButtons :: GettableStateVar (Maybe ButtonCount)+numMouseButtons =+   getDeviceInfo glut_HAS_MOUSE $+      deviceGet fromIntegral glut_NUM_MOUSE_BUTTONS++--------------------------------------------------------------------------------++-- | Contains 'Just' the number of buttons of the attached Spaceball or 'Nothing'+-- if there is none.++numSpaceballButtons :: GettableStateVar (Maybe ButtonCount)+numSpaceballButtons =+   getDeviceInfo glut_HAS_SPACEBALL $+      deviceGet fromIntegral glut_NUM_SPACEBALL_BUTTONS++--------------------------------------------------------------------------------++-- | Number of dials of a dial and button box++type DialCount = Int++-- | Contains 'Just' the number of dials and buttons of an attached dial &+-- button box or 'Nothing' if there is none.++numDialsAndButtons :: GettableStateVar (Maybe (DialCount, ButtonCount))+numDialsAndButtons =+   getDeviceInfo glut_HAS_DIAL_AND_BUTTON_BOX $ do+      d <- deviceGet fromIntegral glut_NUM_DIALS+      b <- deviceGet fromIntegral glut_NUM_BUTTON_BOX_BUTTONS+      return (d, b)++--------------------------------------------------------------------------------++-- | Contains 'Just' the number of buttons of an attached tablet or 'Nothing' if+-- there is none.++numTabletButtons :: GettableStateVar (Maybe ButtonCount)+numTabletButtons =+   getDeviceInfo glut_HAS_TABLET $+      deviceGet fromIntegral glut_NUM_TABLET_BUTTONS++--------------------------------------------------------------------------------++-- | Number of axes of a joystick++type AxisCount = Int++-- | The a rate at which a joystick is polled (in milliseconds)++type PollRate = Int++-- | Contains 'Just' the number of buttons of an attached joystick, the number+-- of joystick axes, and the rate at which the joystick is polled. Contains+-- 'Nothing' if there is no joystick attached.++joystickInfo :: GettableStateVar (Maybe (ButtonCount, PollRate, AxisCount))+joystickInfo =+   getDeviceInfo glut_HAS_JOYSTICK $ do+      b <- deviceGet fromIntegral glut_JOYSTICK_BUTTONS+      a <- deviceGet fromIntegral glut_JOYSTICK_AXES+      r <- deviceGet fromIntegral glut_JOYSTICK_POLL_RATE+      return (b, a, r)++-----------------------------------------------------------------------------++-- | (/freeglut only/) Contains a list of the number of auxiliary buffers+-- supported, in increasing order.++supportedNumAuxBuffers :: GettableStateVar [Int]+supportedNumAuxBuffers = getModeValues glut_AUX++-- | (/freeglut only/) Contains a list of the number of samples per pixel+-- supported for multisampling, in increasing order.++supportedSamplesPerPixel :: GettableStateVar [SampleCount]+supportedSamplesPerPixel = getModeValues (fromIntegral glut_MULTISAMPLE)++getModeValues :: Integral a => GLenum -> GettableStateVar [a]+getModeValues what = makeGettableStateVar $+   alloca $ \sizeBuffer -> do+      valuesBuffer <- glutGetModeValues what sizeBuffer+      size <- peek sizeBuffer+      fmap (map fromIntegral) $ peekArray (fromIntegral size) valuesBuffer++--------------------------------------------------------------------------------+-- Convenience (un-)marshalers++i2b :: CInt -> Bool+i2b = (/= 0)++b2i :: Bool ->  CInt+b2i False = 0+b2i True = 1++--------------------------------------------------------------------------------++getDeviceInfo :: GLenum -> IO a -> GettableStateVar (Maybe a)+getDeviceInfo dev act =+   makeGettableStateVar $ do+      hasDevice <- deviceGet i2b dev+      if hasDevice then fmap Just act else return Nothing++-----------------------------------------------------------------------------++-- | Contains version of GLUT in the form of+-- @/flavour/ /major/./minor/./patchlevel/@, where @/flavour/@ is one of+-- @GLUT@, @freeglut@ or @OpenGLUT@.++glutVersion :: GettableStateVar String+glutVersion = makeGettableStateVar $ do+   let isGLUT = not `fmap` isKnown "glutSetOption"+       isFreeglut = not `fmap` isKnown "glutSetWindowStayOnTop"+       showVersionPart x = shows (x `mod` 100)+       showVersion v = showVersionPart (v `div` 10000) . showChar '.' .+                       showVersionPart (v `div`   100) . showChar '.' .+                       showVersionPart  v+   g <- isGLUT+   if g+      then return "GLUT 3.7"   -- ToDo: just guessing+      else do f <- isFreeglut+              v <- simpleGet id glut_VERSION+              let prefix = if f then "freeglut" else "OpenGLUT"+              return $ showString prefix . showChar ' ' . showVersion v $ ""++-----------------------------------------------------------------------------++-- | (/freeglut only/) Contains the thickness of the sizing border around the+-- perimeter of a window that can be resized, in pixels.++windowBorderWidth :: GettableStateVar Int+windowBorderWidth =+   makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_BORDER_WIDTH)++-----------------------------------------------------------------------------++-- | (/freeglut only/) Contains the height of the header\/caption area of a+-- window in pixels.++windowHeaderHeight :: GettableStateVar Int+windowHeaderHeight =+   makeGettableStateVar (simpleGet fromIntegral glut_WINDOW_HEADER_HEIGHT)++-----------------------------------------------------------------------------++-- | (/freeglut on X11 only/) Controls if all but the last motion event should+-- be discarded.++skipStaleMotionEvents :: StateVar Bool+skipStaleMotionEvents =+   makeStateVar+      (simpleGet i2b glut_SKIP_STALE_MOTION_EVENTS)+      (glutSetOption glut_SKIP_STALE_MOTION_EVENTS . b2i)++-----------------------------------------------------------------------------++-- | (/freeglut only/) Contains 'True' if GLUT has been initialized +-- with 'Graphics.UI.GLUT.Initialization.initialize' or+-- 'Graphics.UI.GLUT.Initialization.getArgsAndInitialize' has and not yet+-- been de-initialized with 'Graphics.UI.GLUT.Initialization.exit'. Contains+-- 'False' otherwise.++initState :: GettableStateVar Bool+initState = makeGettableStateVar$ simpleGet i2b glut_INIT_STATE
+ src/Graphics/UI/GLUT/Types.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_HADDOCK hide #-}+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Types+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- This is a purely internal module with miscellaneous types which don\'t really+-- have a good place elsewhere.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Types (+   Window(..),                               -- constructor used only internally+   Relation(..),+   relationToString,                         -- used only internally+   MouseButton(..),+   marshalMouseButton, unmarshalMouseButton  -- used only internally+) where++import Foreign.C.Types+import Graphics.UI.GLUT.Raw++--------------------------------------------------------------------------------++-- | An opaque identifier for a top-level window or a subwindow.++newtype Window = Window CInt+   deriving ( Eq, Ord, Show )++--------------------------------------------------------------------------------++-- | A relation between a 'Graphics.UI.GLUT.Initialization.DisplayCapability'+-- and a numeric value.++data Relation+   = IsEqualTo        -- ^ Equal.+   | IsNotEqualTo     -- ^ Not equal.+   | IsLessThan       -- ^ Less than and preferring larger difference (the least+                      --   is best).+   | IsNotGreaterThan -- ^ Less than or equal and preferring larger difference+                      --   (the least is best).+   | IsGreaterThan    -- ^ Greater than and preferring larger differences (the+                      --   most is best).+   | IsAtLeast        -- ^ Greater than or equal and preferring more instead of+                      --   less. This relation is useful for allocating+                      --   resources like color precision or depth buffer+                      --   precision where the maximum precision is generally+                      --   preferred. Contrast with 'IsNotLessThan' relation.+   | IsNotLessThan    -- ^ Greater than or equal but preferring less instead of+                      --   more. This relation is useful for allocating+                      --   resources such as stencil bits or auxillary color+                      --   buffers where you would rather not over-allocate.+   deriving ( Eq, Ord, Show )++relationToString :: Relation -> String+relationToString IsEqualTo        = "="+relationToString IsNotEqualTo     = "!="+relationToString IsLessThan       = "<"+relationToString IsNotGreaterThan = "<="+relationToString IsGreaterThan    = ">"+relationToString IsAtLeast        = ">="+relationToString IsNotLessThan    = "~"++--------------------------------------------------------------------------------++-- | Mouse buttons, including a wheel++data MouseButton+   = LeftButton+   | MiddleButton+   | RightButton+   | WheelUp+   | WheelDown+   | AdditionalButton Int+   deriving ( Eq, Ord, Show )++marshalMouseButton :: MouseButton -> CInt+marshalMouseButton x = case x of+   LeftButton -> glut_LEFT_BUTTON+   MiddleButton -> glut_MIDDLE_BUTTON+   RightButton -> glut_RIGHT_BUTTON+   WheelUp -> glut_WHEEL_UP+   WheelDown -> glut_WHEEL_DOWN+   AdditionalButton b -> fromIntegral b++unmarshalMouseButton :: CInt -> MouseButton+unmarshalMouseButton x+   | x == glut_LEFT_BUTTON = LeftButton+   | x == glut_MIDDLE_BUTTON = MiddleButton+   | x == glut_RIGHT_BUTTON = RightButton+   | x == glut_WHEEL_UP = WheelUp+   | x == glut_WHEEL_DOWN = WheelDown+   | otherwise = AdditionalButton (fromIntegral x)++glut_WHEEL_UP :: CInt+glut_WHEEL_UP = 3++glut_WHEEL_DOWN :: CInt+glut_WHEEL_DOWN = 4
+ src/Graphics/UI/GLUT/Window.hs view
@@ -0,0 +1,506 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Graphics.UI.GLUT.Window+-- Copyright   :  (c) Sven Panne 2002-2018+-- License     :  BSD3+--+-- Maintainer  :  Sven Panne <svenpanne@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- GLUT supports two types of windows: top-level windows and subwindows. Both+-- types support OpenGL rendering and GLUT callbacks. There is a single+-- identifier space for both types of windows.+--+--------------------------------------------------------------------------------++module Graphics.UI.GLUT.Window (+   -- * Window identifiers+   Window,++   -- * Creating and destroying (sub-)windows++   -- $CreatingAndDestroyingSubWindows+   createWindow, createSubWindow, destroyWindow,+   parentWindow, numSubWindows,++   -- * Manipulating the /current window/+   currentWindow,++   -- * Re-displaying and double buffer management+   postRedisplay, swapBuffers,++   -- * Changing the window geometry++   -- $ChangingTheWindowGeometry+   windowPosition, windowSize, fullScreen, fullScreenToggle, leaveFullScreen,++   -- * Manipulating the stacking order++   -- $ManipulatingTheStackingOrder+   pushWindow, popWindow,++   -- * Managing a window\'s display status+   WindowStatus(..), windowStatus,++   -- * Changing the window\/icon title++   -- $ChangingTheWindowIconTitle+   windowTitle, iconTitle,++   -- * Cursor management+   Cursor(..), cursor, pointerPosition+) where++import Control.Monad.IO.Class ( MonadIO(..) )+import Data.StateVar ( GettableStateVar, makeGettableStateVar+                     , SettableStateVar, makeSettableStateVar+                     , StateVar, makeStateVar )+import Foreign.C.String ( withCString )+import Foreign.C.Types ( CInt )+import Graphics.Rendering.OpenGL ( Position(..), Size(..) )++import Graphics.UI.GLUT.QueryUtils+import Graphics.UI.GLUT.Raw+import Graphics.UI.GLUT.Types++--------------------------------------------------------------------------------++-- $CreatingAndDestroyingSubWindows+-- Each created window has a unique associated OpenGL context. State changes to+-- a window\'s associated OpenGL context can be done immediately after the+-- window is created.+--+-- The /display state/ of a window is initially for the window to be shown. But+-- the window\'s /display state/ is not actually acted upon until+-- 'Graphics.UI.GLUT.Begin.mainLoop' is entered. This means until+-- 'Graphics.UI.GLUT.Begin.mainLoop' is called, rendering to a created window is+-- ineffective because the window can not yet be displayed.+--+-- The value returned by 'createWindow' and 'createSubWindow' is a unique+-- identifier for the window, which can be used with 'currentWindow'.++-- | Create a top-level window. The given name will be provided to the window+-- system as the window\'s name. The intent is that the window system will label+-- the window with the name.Implicitly, the /current window/ is set to the newly+-- created window.+--+-- /X Implementation Notes:/ The proper X Inter-Client Communication Conventions+-- Manual (ICCCM) top-level properties are established. The @WM_COMMAND@+-- property that lists the command line used to invoke the GLUT program is only+-- established for the first window created.++createWindow+   :: MonadIO m+   => String   -- ^ The window name+   -> m Window -- ^ The identifier for the newly created window+createWindow name = liftIO $ fmap Window $ withCString name glutCreateWindow++--------------------------------------------------------------------------------++-- | Create a subwindow of the identified window with the given relative+-- position and size. Implicitly, the /current window/ is set to the+-- newly created subwindow. Subwindows can be nested arbitrarily deep.++createSubWindow+   :: MonadIO m+   => Window   -- ^ Identifier of the subwindow\'s parent window.+   -> Position -- ^ Window position in pixels relative to parent window\'s+               --   origin.+   -> Size     -- ^ Window size in pixels+   -> m Window -- ^ The identifier for the newly created subwindow+createSubWindow (Window win) (Position x y) (Size w h) = do+   s <- glutCreateSubWindow win+                            (fromIntegral x) (fromIntegral y)+                            (fromIntegral w) (fromIntegral h)+   return $ Window s++--------------------------------------------------------------------------------++-- | Contains the /current window\'s/ parent. If the /current window/ is a+-- top-level window, 'Nothing' is returned.++parentWindow :: GettableStateVar (Maybe Window)+parentWindow =+   makeGettableStateVar $+      getWindow (simpleGet Window glut_WINDOW_PARENT)++--------------------------------------------------------------------------------++-- | Contains the number of subwindows the /current window/ has, not counting+-- children of children.++numSubWindows :: GettableStateVar Int+numSubWindows =+   makeGettableStateVar $+      simpleGet fromIntegral glut_WINDOW_NUM_CHILDREN++--------------------------------------------------------------------------------++-- | Destroy the specified window and the window\'s associated OpenGL context,+-- logical colormap (if the window is color index), and overlay and related+-- state (if an overlay has been established). Any subwindows of the destroyed+-- window are also destroyed by 'destroyWindow'. If the specified window was the+-- /current window/, the /current window/ becomes invalid ('currentWindow' will+-- contain 'Nothing').++destroyWindow :: MonadIO m => Window -> m ()+destroyWindow (Window win) = glutDestroyWindow win++--------------------------------------------------------------------------------++-- | Controls the /current window/. It does /not/ affect the /layer in use/ for+-- the window; this is done using 'Graphics.UI.GLUT.Overlay.layerInUse'.+-- Contains 'Nothing' if no windows exist or the previously /current window/ was+-- destroyed. Setting the /current window/ to 'Nothing' is a no-op.++currentWindow :: StateVar (Maybe Window)+currentWindow =+   makeStateVar+      (getWindow (fmap Window glutGetWindow))+      (maybe (return ()) (\(Window win) -> glutSetWindow win))++getWindow :: IO Window -> IO (Maybe Window)+getWindow act = do+   win <- act+   return $ if win == Window 0 then Nothing else Just win++--------------------------------------------------------------------------------++-- | Mark the normal plane of given window (or the /current window/, if none+-- is supplied) as needing to be redisplayed. The next iteration through+-- 'Graphics.UI.GLUT.Begin.mainLoop', the window\'s display callback will be+-- called to redisplay the window\'s normal plane. Multiple calls to+-- 'postRedisplay' before the next display callback opportunity generates only a+-- single redisplay callback. 'postRedisplay' may be called within a window\'s+-- display or overlay display callback to re-mark that window for redisplay.+--+-- Logically, normal plane damage notification for a window is treated as a+-- 'postRedisplay' on the damaged window. Unlike damage reported by the window+-- system, 'postRedisplay' will /not/ set to true the normal plane\'s damaged+-- status (see 'Graphics.UI.GLUT.State.damaged').+--+-- Also, see 'Graphics.UI.GLUT.Overlay.postOverlayRedisplay'.++postRedisplay :: MonadIO m => Maybe Window -> m ()+postRedisplay = maybe glutPostRedisplay (\(Window win) -> glutPostWindowRedisplay win)++-- | Mark the normal plane of the given window as needing to be redisplayed,+-- otherwise the same as 'postRedisplay'.+--+-- The advantage of this routine is that it saves the cost of using+-- 'currentWindow' (entailing an expensive OpenGL context switch), which is+-- particularly useful when multiple windows need redisplays posted at the same+-- time.++--------------------------------------------------------------------------------++-- | Perform a buffer swap on the /layer in use/ for the /current window/.+-- Specifically, 'swapBuffers' promotes the contents of the back buffer of the+-- /layer in use/ of the /current window/ to become the contents of the front+-- buffer. The contents of the back buffer then become undefined. The update+-- typically takes place during the vertical retrace of the monitor, rather than+-- immediately after 'swapBuffers' is called.+--+-- An implicit 'Graphics.Rendering.OpenGL.GL.FlushFinish.flush' is done by+-- 'swapBuffers' before it returns. Subsequent OpenGL commands can be issued+-- immediately after calling 'swapBuffers', but are not executed until the+-- buffer exchange is completed.+--+-- If the /layer in use/ is not double buffered, 'swapBuffers' has no effect.++swapBuffers :: MonadIO m => m ()+swapBuffers = glutSwapBuffers++--------------------------------------------------------------------------------++-- $ChangingTheWindowGeometry+-- Note that the requests by 'windowPosition', 'windowSize', and 'fullScreen'+-- are not processed immediately. A request is executed after returning to the+-- main event loop. This allows multiple requests to the same window to be+-- coalesced.+--+-- 'windowPosition' and 'windowSize' requests on a window will disable the full+-- screen status of the window.++--------------------------------------------------------------------------------++-- | Controls the position of the /current window/. For top-level windows,+-- parameters of 'Position' are pixel offsets from the screen origin. For+-- subwindows, the parameters are pixel offsets from the window\'s parent window+-- origin.+--+-- In the case of top-level windows, setting 'windowPosition' is considered only+-- a request for positioning the window. The window system is free to apply its+-- own policies to top-level window placement. The intent is that top-level+-- windows should be repositioned according to the value of 'windowPosition'.++windowPosition :: StateVar Position+windowPosition = makeStateVar getWindowPosition setWindowPosition++setWindowPosition :: Position -> IO ()+setWindowPosition (Position x y) =+   glutPositionWindow (fromIntegral x) (fromIntegral y)++getWindowPosition :: IO Position+getWindowPosition = do+   x <- simpleGet fromIntegral glut_WINDOW_X+   y <- simpleGet fromIntegral glut_WINDOW_Y+   return $ Position x y++--------------------------------------------------------------------------------++-- | Controls the size of the /current window/. The parameters of 'Size' are+-- size extents in pixels. The width and height must be positive values.+--+-- In the case of top-level windows, setting 'windowSize' is considered only a+-- request for sizing the window. The window system is free to apply its own+-- policies to top-level window sizing. The intent is that top-level windows+-- should be reshaped according to the value of 'windowSize'. Whether a reshape+-- actually takes effect and, if so, the reshaped dimensions are reported to the+-- program by a reshape callback.++windowSize :: StateVar Size+windowSize = makeStateVar getWindowSize setWindowSize++setWindowSize :: Size -> IO ()+setWindowSize (Size w h) =+   glutReshapeWindow (fromIntegral w) (fromIntegral h)++getWindowSize :: IO Size+getWindowSize = do+   w <- simpleGet fromIntegral glut_WINDOW_WIDTH+   h <- simpleGet fromIntegral glut_WINDOW_HEIGHT+   return $ Size w h++--------------------------------------------------------------------------------++-- | Request that the /current window/ be made full screen. The exact semantics+-- of what full screen means may vary by window system. The intent is to make+-- the window as large as possible and disable any window decorations or borders+-- added the window system. The window width and height are not guaranteed to be+-- the same as the screen width and height, but that is the intent of making a+-- window full screen.+--+-- 'fullScreen' is defined to work only on top-level windows.+--+-- /X Implementation Notes:/ In the X implementation of GLUT, full screen is+-- implemented by sizing and positioning the window to cover the entire screen+-- and posting the @_MOTIF_WM_HINTS@ property on the window requesting+-- absolutely no decorations. Non-Motif window managers may not respond to+-- @_MOTIF_WM_HINTS@.++fullScreen :: MonadIO m => m ()+fullScreen = glutFullScreen++--------------------------------------------------------------------------------++-- | (/freeglut only/) Toggle between windowed and full screen mode.++fullScreenToggle :: MonadIO m => m ()+fullScreenToggle = glutFullScreenToggle++--------------------------------------------------------------------------------++-- | (/freeglut only/) If we are in full screen mode, resize the current window+-- back to its original size.++leaveFullScreen :: MonadIO m => m ()+leaveFullScreen = glutLeaveFullScreen++--------------------------------------------------------------------------------++-- $ManipulatingTheStackingOrder+-- 'pushWindow' and 'popWindow' work on both top-level windows and subwindows.+-- The effect of pushing and popping windows does not take place immediately.+-- Instead the push or pop is saved for execution upon return to the GLUT event+-- loop. Subsequent pop or push requests on a window replace the previously+-- saved request for that window. The effect of pushing and popping top-level+-- windows is subject to the window system\'s policy for restacking windows.++-- | Change the stacking order of the /current window/ relative to its siblings+-- (lowering it).++pushWindow :: MonadIO m => m ()+pushWindow = glutPushWindow++-- | Change the stacking order of the /current window/ relative to its siblings,+-- bringing the /current window/ closer to the top.++popWindow :: MonadIO m => m ()+popWindow = glutPopWindow++--------------------------------------------------------------------------------++-- | The display status of a window.++data WindowStatus+   = Shown+   | Hidden+   | Iconified+   deriving ( Eq, Ord, Show )++-- | Controls the display status of the /current window/.+--+-- Note that the effect of showing, hiding, and iconifying windows does not take+-- place immediately. Instead the requests are saved for execution upon return+-- to the GLUT event loop. Subsequent show, hide, or iconification requests on a+-- window replace the previously saved request for that window. The effect of+-- hiding, showing, or iconifying top-level windows is subject to the window+-- system\'s policy for displaying windows. Subwindows can\'t be iconified.++windowStatus :: SettableStateVar WindowStatus+windowStatus = makeSettableStateVar setStatus+   where setStatus Shown     = glutShowWindow+         setStatus Hidden    = glutHideWindow+         setStatus Iconified = glutIconifyWindow++--------------------------------------------------------------------------------++-- $ChangingTheWindowIconTitle+-- 'windowTitle' and 'iconTitle' should be set only when the /current+-- window/ is a top-level window. Upon creation of a top-level window, the+-- window and icon names are determined by the name given to 'createWindow'.+-- Once created, setting 'windowTitle' and 'iconTitle' can change the window and+-- icon names respectively of top-level windows. Each call requests the window+-- system change the title appropriately. Requests are not buffered or+-- coalesced. The policy by which the window and icon name are displayed is+-- window system dependent.++-- | Controls the window title of the /current top-level window/.++windowTitle :: SettableStateVar String+windowTitle =+   makeSettableStateVar $ \name ->+      withCString name glutSetWindowTitle++-- | Controls the icon title of the /current top-level window/.++iconTitle :: SettableStateVar String+iconTitle =+   makeSettableStateVar $ \name ->+      withCString name glutSetIconTitle++--------------------------------------------------------------------------------++-- | The different cursor images GLUT supports.++data Cursor+   = RightArrow        -- ^ Arrow pointing up and to the right.+   | LeftArrow         -- ^ Arrow pointing up and to the left.+   | Info              -- ^ Pointing hand.+   | Destroy           -- ^ Skull & cross bones.+   | Help              -- ^ Question mark.+   | Cycle             -- ^ Arrows rotating in a circle.+   | Spray             -- ^ Spray can.+   | Wait              -- ^ Wrist watch.+   | Text              -- ^ Insertion point cursor for text.+   | Crosshair         -- ^ Simple cross-hair.+   | UpDown            -- ^ Bi-directional pointing up & down.+   | LeftRight         -- ^ Bi-directional pointing left & right.+   | TopSide           -- ^ Arrow pointing to top side.+   | BottomSide        -- ^ Arrow pointing to bottom side.+   | LeftSide          -- ^ Arrow pointing to left side.+   | RightSide         -- ^ Arrow pointing to right side.+   | TopLeftCorner     -- ^ Arrow pointing to top-left corner.+   | TopRightCorner    -- ^ Arrow pointing to top-right corner.+   | BottomRightCorner -- ^ Arrow pointing to bottom-left corner.+   | BottomLeftCorner  -- ^ Arrow pointing to bottom-right corner.+   | Inherit           -- ^ Use parent\'s cursor.+   | None              -- ^ Invisible cursor.+   | FullCrosshair     -- ^ Full-screen cross-hair cursor (if possible, otherwise 'Crosshair').+   deriving ( Eq, Ord, Show )++marshalCursor :: Cursor -> CInt+marshalCursor x = case x of+   RightArrow -> glut_CURSOR_RIGHT_ARROW+   LeftArrow -> glut_CURSOR_LEFT_ARROW+   Info -> glut_CURSOR_INFO+   Destroy -> glut_CURSOR_DESTROY+   Help -> glut_CURSOR_HELP+   Cycle -> glut_CURSOR_CYCLE+   Spray -> glut_CURSOR_SPRAY+   Wait -> glut_CURSOR_WAIT+   Text -> glut_CURSOR_TEXT+   Crosshair -> glut_CURSOR_CROSSHAIR+   UpDown -> glut_CURSOR_UP_DOWN+   LeftRight -> glut_CURSOR_LEFT_RIGHT+   TopSide -> glut_CURSOR_TOP_SIDE+   BottomSide -> glut_CURSOR_BOTTOM_SIDE+   LeftSide -> glut_CURSOR_LEFT_SIDE+   RightSide -> glut_CURSOR_RIGHT_SIDE+   TopLeftCorner -> glut_CURSOR_TOP_LEFT_CORNER+   TopRightCorner -> glut_CURSOR_TOP_RIGHT_CORNER+   BottomRightCorner -> glut_CURSOR_BOTTOM_RIGHT_CORNER+   BottomLeftCorner -> glut_CURSOR_BOTTOM_LEFT_CORNER+   Inherit -> glut_CURSOR_INHERIT+   None -> glut_CURSOR_NONE+   FullCrosshair -> glut_CURSOR_FULL_CROSSHAIR++unmarshalCursor :: CInt -> Cursor+unmarshalCursor x+   | x == glut_CURSOR_RIGHT_ARROW = RightArrow+   | x == glut_CURSOR_LEFT_ARROW = LeftArrow+   | x == glut_CURSOR_INFO = Info+   | x == glut_CURSOR_DESTROY = Destroy+   | x == glut_CURSOR_HELP = Help+   | x == glut_CURSOR_CYCLE = Cycle+   | x == glut_CURSOR_SPRAY = Spray+   | x == glut_CURSOR_WAIT = Wait+   | x == glut_CURSOR_TEXT = Text+   | x == glut_CURSOR_CROSSHAIR = Crosshair+   | x == glut_CURSOR_UP_DOWN = UpDown+   | x == glut_CURSOR_LEFT_RIGHT = LeftRight+   | x == glut_CURSOR_TOP_SIDE = TopSide+   | x == glut_CURSOR_BOTTOM_SIDE = BottomSide+   | x == glut_CURSOR_LEFT_SIDE = LeftSide+   | x == glut_CURSOR_RIGHT_SIDE = RightSide+   | x == glut_CURSOR_TOP_LEFT_CORNER = TopLeftCorner+   | x == glut_CURSOR_TOP_RIGHT_CORNER = TopRightCorner+   | x == glut_CURSOR_BOTTOM_RIGHT_CORNER = BottomRightCorner+   | x == glut_CURSOR_BOTTOM_LEFT_CORNER = BottomLeftCorner+   | x == glut_CURSOR_INHERIT = Inherit+   | x == glut_CURSOR_NONE = None+   | x == glut_CURSOR_FULL_CROSSHAIR = FullCrosshair+   | otherwise = error ("unmarshalCursor: illegal value " ++ show x)++--------------------------------------------------------------------------------++-- | Change the cursor image of the /current window/. Each call requests the+-- window system change the cursor appropriately. The cursor image when a window+-- is created is 'Inherit'. The exact cursor images used are implementation+-- dependent. The intent is for the image to convey the meaning of the cursor+-- name. For a top-level window, 'Inherit' uses the default window system+-- cursor.+--+-- /X Implementation Notes:/ GLUT for X uses SGI\'s @_SGI_CROSSHAIR_CURSOR@+-- convention to access a full-screen cross-hair cursor if possible.++cursor :: StateVar Cursor+cursor = makeStateVar getCursor setCursor++setCursor :: Cursor -> IO ()+setCursor = glutSetCursor . marshalCursor++getCursor :: IO Cursor+getCursor = simpleGet unmarshalCursor glut_WINDOW_CURSOR++--------------------------------------------------------------------------------++-- | Setting 'pointerPosition' warps the window system\'s pointer to a new+-- location relative to the origin of the /current window/ by the specified+-- pixel offset, which may be negative. The warp is done immediately.+--+-- If the pointer would be warped outside the screen\'s frame buffer region, the+-- location will be clamped to the nearest screen edge. The window system is+-- allowed to further constrain the pointer\'s location in window system+-- dependent ways.+--+-- Good advice from Xlib\'s @XWarpPointer@ man page: \"There is seldom any+-- reason for calling this function. The pointer should normally be left to the+-- user.\"++pointerPosition :: SettableStateVar Position+pointerPosition =+   makeSettableStateVar $ \(Position x y) ->+      glutWarpPointer (fromIntegral x) (fromIntegral y)