Changeset 20174 for lang/haskell

Timestamp:

09/29/08 00:06:16 (2 months ago)

Author:

mokehehe

Message:

画像のカラーキー設定
終了時に読み込んだ画像の解放

Location:

lang/haskell/nario

Files:

• Main.hs (modified) (2 diffs)
• Util.hs (modified) (1 diff)

lang/haskell/nario/Main.hs

@@ -12 +12 @@
 import Field
 import Util
+import Const
 
 wndTitle = "delayed-stream test"
@@ -88 +89 @@
 process :: [[SDLKey]] -> IO [Scr]
 process kss = do
-        imgres <- loadImageResource
+        imgres <- loadImageResource images
         st <- initialState
-        return $ map (\scr -> scr imgres) $ loop [] st kss
+        let scrs = map (\scr -> scr imgres) $ loop [] st kss
+        return $ scrs ++ [(\sur -> do {releaseImageResource imgres})]
         where
                 loop :: [SDLKey] -> GameState -> [[SDLKey]] -> [(ImageResource -> Scr)]

lang/haskell/nario/Util.hs

@@ -73 +73 @@
 
 -- 画像リソース読み込み
-loadImageResource :: IO ImageResource
-loadImageResource = mapM load images
+loadImageResource :: [ImageType] -> IO ImageResource
+loadImageResource = mapM load
         where
                 load imgtype = do
                         sur <- loadBMP $ ("data/img/" ++) $ imageFn imgtype
---                      colorKey <- mapRGB (surfacePixelFormat sur) $ Color r g b a
-                        let colorKey = 0xff00ff
-                        setColorKey sur [SRCCOLORKEY] colorKey
-                        return (imgtype, sur)
-                r = 255
-                g = 0
-                b = 255
-                a = 255
+                        setNuki sur
+                        converted <- displayFormat sur
+                        freeSurface sur
+                        return (imgtype, converted)
 
+                setNuki sur = do
+                        let fmt = surfacePixelFormat sur
+                        if not $ null $ pfPalette fmt
+                                then setColorKey sur [SRCCOLORKEY] 0 >> return ()       -- パレット０番目をぬき色に
+                                else return ()
+
+releaseImageResource :: ImageResource -> IO ()
+releaseImageResource = mapM_ (\(t, sur) -> freeSurface sur)
 
 getImageSurface :: ImageResource -> ImageType -> Surface