module Graphics.Rendering.Ombra.Texture (
Texture,
mkTexture,
mkTextureFloat,
mkTextureRaw,
Filter(..),
setFilter,
colorTex
) where
import Data.Hashable
import Data.Vect.Float
import Graphics.Rendering.Ombra.Backend (GLES)
import Graphics.Rendering.Ombra.Color
import Graphics.Rendering.Ombra.Internal.GL hiding (Texture)
import Graphics.Rendering.Ombra.Texture.Internal
mkTexture :: GLES
=> Int
-> Int
-> [Color]
-> Texture
mkTexture w h ps = TextureImage . TexturePixels ps Linear Linear
(fromIntegral w)
(fromIntegral h)
$ hash (w, h, take (w * h) ps)
mkTextureRaw :: GLES
=> Int
-> Int
-> UInt8Array
-> Int
-> Texture
mkTextureRaw w h arr pxhash = TextureImage $ TextureRaw arr Linear Linear
(fromIntegral w)
(fromIntegral h)
$ hash (w, h, pxhash)
mkTextureFloat :: GLES
=> Int
-> Int
-> [Vec4]
-> Texture
mkTextureFloat w h vs = TextureImage . TextureFloat ps Linear Linear
(fromIntegral w)
(fromIntegral h)
$ hash (w, h, take (w * h * 4) ps)
where ps = vs >>= \(Vec4 x y z w) -> [x, y, z, w]
setFilter :: Filter -> Filter -> Texture -> Texture
setFilter min mag (TextureImage (TexturePixels c _ _ w h s)) =
TextureImage (TexturePixels c min mag w h s)
setFilter min mag (TextureImage (TextureRaw c _ _ w h s)) =
TextureImage (TextureRaw c min mag w h s)
setFilter min mag (TextureImage (TextureFloat c _ _ w h s)) =
TextureImage (TextureFloat c min mag w h s)
setFilter _ _ t = t
colorTex :: GLES => Color -> Texture
colorTex c = mkTexture 1 1 [ c ]