module Image where
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
import Zoom
import Cache
import Paths
import Point
initSDL :: (Surface -> Int -> Int -> IO a) -> IO ()
initSDL f = SDL.withInit [InitTimer, InitAudio, InitVideo] $ do
info <- getVideoInfo
let w = videoInfoWidth info
h = videoInfoHeight info
screen <- setVideoMode w h 32
[AnyFormat, Fullscreen, HWAccel, HWSurface, DoubleBuf]
TTF.init
f screen w h
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
_loadImage :: Cache FilePath Surface
_loadImage = initCache newCache
loadImage :: FilePath -> IO Surface
loadImage = cache _loadImage SDLImage.load
_loadImageSized :: Cache (String, Int) Surface
_loadImageSized = initCache newCache
loadImageSized :: (String, Int) -> IO Surface
loadImageSized = cache _loadImageSized $ \(fn, sz) -> do
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