Hugh Rayner wrote:

Hi, I'm using ghc OpenGL on a MacOS X box,

Which Haskell system are you using exactly (GHC or Hugs? Which version? Did you build it for yourself?)

and everything is working fine, except that I have no idea how to load textures,

Alas, the OpenGL binding shipped with GHC 6.2.1 (built from GHC's STABLE CVS branch) doesn't support any texturing.

and I can't find any examples anywhere on the internet that load textures except ones using the old API.

Does anyone have an example I could look at?

The main branch of the fptools CVS repository, where the next major versions of GHC, Hugs and NHC get their libraries from, has complete support for OpenGL 1.5 (only NURBS support is still missing). All texturing examples from the Red Book have been ported, too, I've attached a few to this mail to provide a feeling of the "flavour" of the binding. Haddock docs of the libraries in the main branch are available at: http://haskell.org/HOpenGL/newAPI/ I don't have access to a MacOS box, so I can't provide you with a binary snapshot of the bleeding edge versions of GHC and/or Hugs. Perhaps somebody on this list can help (Wolfgang?). Another route would be building GHC and/or Hugs for yourself, just add "--enable-hopengl" at the configuration stage. Perhaps the stuff at http://darwinports.opendarwin.org./ might be of some help, too. Cheers, S. {- Checker.hs (adapted from checker.c which is (c) Silicon Graphics, Inc) Copyright (c) Sven Panne 2002-2004 <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 ( liftM, 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 liftM 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 {- Texture3D.hs (adapted from texture3d.c which is (c) Silicon Graphics, Inc) Copyright (c) Sven Panne 2002-2004 <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 {- Combiner.hs (adapted from combiner.c which is (c) Silicon Graphics, Inc) Copyright (c) Sven Panne 2002-2004 <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 Control.Monad ( liftM ) import Data.Bits ( (.&.) ) import Data.Maybe ( fromJust ) 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 <- liftM fromJust $ 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