TimePiece-0.0.1: Image.hs

module Image where
import Internals (setScreenWidth, setScreenHeight, getDataFileName)
import Cache
import Point
import Zoom
import Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.TTF as TTF
import qualified Graphics.UI.SDL.Image as SDLImage
import qualified Graphics.UI.SDL.Rotozoomer as SDLRotozoomer

initSDL :: (Surface -> IO a) -> IO ()
initSDL f = SDL.withInit [InitTimer, InitAudio, InitVideo] $ do 
    info    <- getVideoInfo
    let w = videoInfoWidth info
        h = videoInfoHeight info
    setScreenWidth w 
    setScreenHeight h
    screen  <- setVideoMode w h 32
        [AnyFormat, Fullscreen, HWAccel, HWSurface, DoubleBuf]
    TTF.init
    f screen
    TTF.quit

blitTile :: (Show a) => X -> Y -> Surface -> a -> Zoom -> (Point, Int) -> IO Bool
blitTile xOff yOff canvas seed z (MkPoint x y, sz) = do
    img <- loadImageSized (show seed, (sz * 9) *** z)
    let x'  = x * 9 + xOff
        y'  = y * 12 + yOff
        pos = Just (Rect (x' ~~~ z) (y' ||| z) 0 0)
    blitSurface img Nothing canvas pos

{-# NOINLINE _loadImage #-}
_loadImage :: Cache FilePath Surface
_loadImage = initCache newCache
loadImage :: FilePath -> IO Surface
loadImage = cache _loadImage SDLImage.load

{-# NOINLINE _loadImageSized #-}
_loadImageSized :: Cache (String, Int) Surface
_loadImageSized = initCache newCache
loadImageSized :: (String, Int) -> IO Surface
loadImageSized = cache _loadImageSized $ \(fn, sz) -> do
    -- Round to nearest multiples of 10
    img <- getDataFileName $ fn ++ "/" ++ show ((sz + 9) `div` 10) ++ "0.png"
    src <- loadImage img
    let r = (fromIntegral sz + 0.5) / fromIntegral srcWidth
        srcWidth = SDL.surfaceGetWidth src
    if srcWidth == sz
        then return src
        else SDLRotozoomer.zoom src r r True