Permalink
Browse files

fix stb image loader

  • Loading branch information...
1 parent 94c010b commit b23b2589479e73100d8b3106324d5ce38e5fe38c @csabahruska committed Mar 20, 2012
Showing with 12 additions and 9 deletions.
  1. +1 −1 GPipeFPSMaterial.hs
  2. +1 −1 GPipeFPSRender.hs
  3. +6 −3 GPipeUtils.hs
  4. +1 −1 Main.hs
  5. +3 −3 fpsDemo.hs
View
@@ -144,7 +144,7 @@ defaultStageAttrs = StageAttrs
fixAttribOrder ca = ca
{ caDeformVertexes = reverse $ caDeformVertexes ca
- , caStages = take 1 $ reverse $ map fixStage $ caStages ca
+ , caStages = reverse $ map fixStage $ caStages ca
}
where
fixStage sa = sa
View
@@ -183,7 +183,7 @@ renderSurfaces time' time worldProjection faces = V.foldl' (foldl' (\fb (_,fun)
#define LIGHTMAP_WHITEIMAGE -2
#define LIGHTMAP_NONE -1
-}
-imageRenderer lmidx txName = shaderRenderer $ defaultCommonAttrs {caStages = sa:if lmidx < 0 then [] else {-saLM:-}[]}
+imageRenderer lmidx txName = shaderRenderer $ defaultCommonAttrs {caStages = sa:if lmidx < 0 then [] else saLM:[]}
where
sa = defaultStageAttrs
{ saTexture = ST_Map txName
View
@@ -5,7 +5,7 @@ import Control.Monad
import Foreign
import Data.IORef
import Codec.Image.STB
-import Data.Bitmap.Pure (bitmapToByteString)
+--import Data.Bitmap.Pure (withBitmap)
import Data.Bitmap.IO
import Foreign.Ptr
import Graphics.GPipe
@@ -34,10 +34,13 @@ addAlpha s = SB.pack $ go $ SB.unpack s
go (r:g:b:xs) = r:g:b:a:go xs
go _ = []
+bitmapToByteString :: PixelComponent t => IOBitmap t -> SB.ByteString
+bitmapToByteString b = unsafePerformIO $ withIOBitmap b $ \_ _ _ p -> SB.packCStringLen (castPtr p,bitmapSizeInBytes b)
+
textureFromByteString :: Bool -> Int -> Int -> Int -> SB.ByteString -> Texture2D RGBAFormat
textureFromByteString mipmap c w h s = unsafePerformIO $ do
bm <- case c of
- 3 -> SB.useAsCString (addAlpha s) $ \p -> copyBitmapFromPtr (w,h) 4 0 (castPtr p) Nothing :: IO (Bitmap Word8)
+ 3 -> SB.useAsCString (addAlpha s) $ \p -> copyBitmapFromPtr (w,h) 4 0 (castPtr p) Nothing :: IO (IOBitmap Word8)
4 -> SB.useAsCString s $ \p -> copyBitmapFromPtr (w,h) 4 0 (castPtr p) Nothing
_ -> error "unsupported texture format!"
let sizes x y = if nx == 0 || ny == 0 then [] else (nx,ny):sizes nx ny
@@ -68,7 +71,7 @@ textureFromFile mipmap name = unsafePerformIO $ do
Right img -> do
putStrLn ("Load texture: " ++ name)
let (w,h) = bitmapSize img
- tx = textureFromByteString mipmap (bitmapNChannels img) w h (bitmapToByteString img)
+ tx = textureFromByteString mipmap (bitmapNChannels img) w h (bitmapToByteString $ unsafeThawBitmap img)
writeIORef textureCache $ T.insertIfAbsent namesb tx ic
return $ Just $ seq tx tx
View
@@ -5,7 +5,7 @@ import Binary.Fast
import Codec.Image.STB
import Control.Applicative
import Control.Monad
-import Data.Bitmap
+import Data.Bitmap.Pure
import Data.ByteString.Char8 (ByteString)
import Data.Vect
import FRP.Elerea.Param
View
@@ -73,10 +73,10 @@ main = do
--bsp <- B.loadBSP "fps/maps/ct3ctf2.bsp"
--bsp <- B.loadBSP "fps/maps/q3ctf2.bsp"
--bsp <- B.loadBSP "fps/maps/q3dm1.bsp"
- --bsp <- B.loadBSP "fps/maps/q3dm6.bsp"
+ bsp <- B.loadBSP "fps/maps/q3dm7.bsp"
--bsp <- B.loadBSP "fps/maps/q3dm3.bsp"
- bsp <- B.loadBSP "fps/maps/q3dm11.bsp"
- --bsp <- B.loadBSP "fps/maps/q3dm17.bsp"
+ --bsp <- B.loadBSP "fps/maps/q3dm11.bsp"
+ --bsp <- B.loadBSP "fps/maps/q3dm4.bsp"
--bsp <- B.loadBSP "fps/maps/q3dm18.bsp"
--bsp <- B.loadBSP "fps/maps/q3tourney6.bsp"
--bsp <- B.loadBSP "fps/maps/q3tourney3.bsp"

0 comments on commit b23b258

Please sign in to comment.