[HOpenGL] Texture problem

Andre W B Furtado awfurtado@uol.com.br
Tue, 11 Dec 2001 16:13:13 -0200


This is a multi-part message in MIME format.

------=_NextPart_000_005A_01C1825E.BC240B20
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit

> Hmmm, GL stuff should be completely independent from GLUT, so it should
> work either way. Furthermore, generating a texture name simply reserves
> an integer internally (at least in Mesa and SI) and has nothing to do
> with windows at all. Could you send me a *small* test program and some
> info about your setup?

Ok, here you have it (attached). In this program, I create two TextureNames:
one before creating the window ("texBefore") and another after creating the
window ("texAfter"). When I call the same function to draw both textures,
only "texAfter" is drawn.

-- Andre

------=_NextPart_000_005A_01C1825E.BC240B20
Content-Type: application/octet-stream;
	name="tst.hs"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
	filename="tst.hs"

module Main where

import GLUT
import GL
import Bits((.&.))
import Monad(liftM)

-----------------------------------------------------------------------
-- this was taken from the Red Book example "checker.hs":
checkImageWidth, checkImageHeight :: GLsizei
checkImageWidth  = 64
checkImageHeight = 64

myInit :: IO TextureName
myInit = do
   clearColor (Color4 0.0 0.0 0.0 0.0)
   pixelStore Unpack (Alignment 1)
   texName <- liftM head (genTextures 1)
   bindTexture Texture2d texName
   mapM_ (texParameter Texture2d) [
      TextureWrap S Repeat,
      TextureWrap T Repeat,
      TextureFilters Nearest Nearest ]
   withArray [ Color4 c c c 255 |
               i <- [ 0 .. checkImageHeight - 1 ],
               j <- [ 0 .. checkImageWidth  - 1 ],
               let c | (i .&. 0x8) == (j .&. 0x8) = 0 :: GLubyte
                     | otherwise                  = 255 ] $
      texImage2D Texture2d 0 GL.Rgba' checkImageWidth checkImageHeight 0 .
      PixelDescriptor GL.Rgba UnsignedByte . castPtr
   return texName
-----------------------------------------------------------------------

main :: IO ()
main = do
	texBefore <- myInit
	startGL texBefore
	
startGL :: TextureName -> IO ()
startGL texBefore = do
	GLUT.init Nothing
	createWindow "test" (return ()) [ GLUT.Double, GLUT.Rgba ]
                (Just (WindowPosition 0 0))
                (Just (WindowSize     300 300))
        texAfter <- myInit
	displayFunc (display texBefore texAfter)
	mainLoop
	
display :: TextureName -> TextureName -> DisplayAction
display texBefore texAfter  = do
	clear [ColorBufferBit]
	enable Texture2d'
	color (Color3 1.0 1.0 1.0 :: Color3 GLfloat)
	
	loadIdentity
	translate (Vector3 0.0 0.0 (0.0 :: GLfloat) )
	drawTex texBefore
	
	loadIdentity
	translate (Vector3 0.5 0.0 (0.0 :: GLfloat) )
	drawTex texAfter
	
	disable Texture2d'
	swapBuffers
	flush

drawTex	:: TextureName -> IO ()
drawTex tex = do
	let texCoord2 :: GLfloat -> GLfloat -> IO ()
       	    texCoord2 x y = texCoord (TexCoord2 x y)
       	    vertex3 :: GLfloat -> GLfloat -> GLfloat -> IO ()
       	    vertex3 x y z = vertex (Vertex3 x y z)	
	bindTexture Texture2d tex
	beginEnd Quads $ do
      		texCoord2 0.0 0.0;  vertex3 0.0 0.0 0.0
		texCoord2 1.0 0.0;  vertex3 0.3 0.0 0.0
      		texCoord2 1.0 1.0;  vertex3 0.3 0.3 0.0
		texCoord2 0.0 1.0;  vertex3 0.0 0.3 0.0
------=_NextPart_000_005A_01C1825E.BC240B20--