module Graphics.SceneGraph.Textures where
import Graphics.UI.GLUT
import Graphics.SceneGraph.ReadImage (readImage)
import Monad (when)
import Graphics.SceneGraph.TGA
import Data.Word
import Foreign.Marshal.Alloc
getAndCreateTextures :: [String] -> IO [Maybe TextureObject]
getAndCreateTextures fileNames = do
fileNamesExts <- return (map (++".tga") fileNames)
texData <- mapM readImageC fileNamesExts
texObjs <- mapM createTexture texData
return texObjs
getAndCreateTexture :: String -> IO (Maybe TextureObject)
getAndCreateTexture fileName = do
texData <- readImageC (fileName++".tga")
texObj <- createTexture texData
return texObj
readImageC :: String -> IO (Maybe (Size, PixelData Word8))
readImageC path = catch (readTga path) (\err -> do
print ("missing texture: "++path)
return Nothing)
createTexture :: (Maybe (Size, PixelData a)) -> IO (Maybe TextureObject)
createTexture (Just ((Size x y), pixels@(PixelData t1 t2 ptr))) = do
[texName] <- genObjectNames 1
textureBinding Texture2D $= Just texName
build2DMipmaps Texture2D RGBA' (fromIntegral x) (fromIntegral y) pixels
textureFilter Texture2D $= ((Linear', Just Nearest), Linear')
textureFunction $= Modulate
free ptr
return (Just texName)
createTexture Nothing = return Nothing