packages feed

Eternal10Seconds-0.1: Resource.hs

module Resource where

import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.Mixer as SDLMixer

-- リソース
data Resource = Resource {
    imageResource :: [Image],
    soundResource :: [Sound]
}

addImageResource :: Resource -> String -> IO Resource
addImageResource res filename = let imgRes = imageResource res in
    if lookup filename imgRes /= Nothing then return res else do
    img <- newImage filename
    return res { imageResource = (img:imgRes) }

addSoundResource :: Resource -> String -> IO Resource
addSoundResource res filename = let sndRes = soundResource res in
    if lookup filename sndRes /= Nothing then return res else do
    snd <- newSound filename
    return res { soundResource = (snd:sndRes) }

-- 画像
type Image = (String, SDL.Surface)

newImage :: String -> IO Image
newImage filename = do
    -- putStrLn $ "loading " ++ filename
    surface <- SDL.loadBMP filename
    pixel <- SDL.mapRGB (SDL.surfaceGetPixelFormat surface) 0 255 0
    SDL.setColorKey surface [SDL.SrcColorKey, SDL.RLEAccel] pixel
    display <- SDL.displayFormat surface
    return (filename, display)

-- 画像ファイルの一区画
type PaintTip = (String, Maybe SDL.Rect)

-- 画像と描画先
type Paint = (PaintTip, Maybe SDL.Rect)

renderPaint :: Resource -> SDL.Surface -> Paint -> IO Bool
renderPaint res surf ((filename, r1), r2) = let
    (Just imgSurf) = lookup filename (imageResource res) in do
    SDL.blitSurface imgSurf r1 surf r2

-- 音声
type Sound = (String, SDLMixer.Chunk)

newSound :: String -> IO Sound
newSound filename = do
    -- putStrLn $ "loading " ++ filename
    chunk <- SDLMixer.loadWAV filename
    return (filename, chunk)

playSound :: Resource -> String -> Int -> IO ()
playSound res filename times = let
    (Just chunk) = lookup filename (soundResource res) in do
    SDLMixer.playChannel (-1) chunk times
    return ()

haltSound :: IO ()
haltSound = SDLMixer.haltChannel (-1)