TextureBench.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Graphics.GPipe.TextureBench (suite) where

import           Criterion.Main              (Benchmark, bench, bgroup, whnfIO)

import           Graphics.GPipe.Texture

import qualified Codec.Picture               as Pic
import           Graphics.GPipe              (Format (SRGB8), V2 (..), V3 (..))
import           Graphics.GPipe.Context      (runContextT)
import qualified Graphics.GPipe.Context.GLFW as GLFW


benchWriteTexture2D :: V2 Int -> IO Int
benchWriteTexture2D size@(V2 w h) =
    let pixels = [ V3 (fromIntegral x) (fromIntegral y) 0 :: V3 Pic.Pixel8
                 | y <- [0..h], x <- [0..w]] in
    runContextT GLFW.defaultHandleConfig $ do
        tex <- newTexture2D SRGB8 size maxBound -- JPG converts to SRGB
        writeTexture2D tex 0 0 size pixels
        return $ texture2DLevels tex


suite :: IO Benchmark
suite = return $ bgroup "Texture"
    [ bgroup "writeTexture2D"
        [ bench "100x100"   $ whnfIO (benchWriteTexture2D (V2 100 100))
        , bench "1000x1000" $ whnfIO (benchWriteTexture2D (V2 1000 1000))
        ]
    ]