module Gelatin.GL.Compiler where
import Control.Lens hiding (op)
import Control.Monad ((>=>))
import Data.Bits ((.|.))
import qualified Data.Vector.Unboxed as V
import Graphics.GL.Core33
import Graphics.GL.Types
import Linear as L
import Gelatin
import Gelatin.GL.Common
import Gelatin.GL.Renderer
type V2V4 = (V2 Float, V4 Float)
type ColorPictureData = PictureData GLuint (V2 Float, V4 Float)
type ColorPictureT = PictureT GLuint (V2 Float, V4 Float)
type ColorPicture = ColorPictureT Identity
type V2V2 = (V2 Float, V2 Float)
type TexturePictureData = PictureData GLuint (V2 Float, V2 Float)
type TexturePictureT = PictureT GLuint (V2 Float, V2 Float)
type TexturePicture = TexturePictureT Identity
rgbaCompiler :: Rez
-> GeometryCompiler V2V4 (V2 Float) Float Raster
rgbaCompiler Rez{..} = GeometryCompiler s l
where s VertexTriangles =
uncurry (colorRenderer rezContext rezShader GL_TRIANGLES) . V.unzip
s VertexStrip =
uncurry (colorRenderer rezContext rezShader GL_TRIANGLE_STRIP) . V.unzip
s VertexFan =
uncurry (colorRenderer rezContext rezShader GL_TRIANGLE_FAN) . V.unzip
s VertexBeziers =
uncurry (colorBezRenderer rezContext rezShader) . V.unzip
l Stroke{..} =
uncurry (colorPolylineRenderer rezContext rezShader strokeWidth
strokeFeather strokeLineCaps) . V.unzip
uvCompiler :: Rez -> GeometryCompiler V2V2 (V2 Float) Float Raster
uvCompiler Rez{..} = GeometryCompiler s l
where s VertexTriangles =
uncurry (textureRenderer rezContext rezShader GL_TRIANGLES) . V.unzip
s VertexStrip =
uncurry (textureRenderer rezContext rezShader GL_TRIANGLE_STRIP) . V.unzip
s VertexFan =
uncurry (textureRenderer rezContext rezShader GL_TRIANGLE_FAN) . V.unzip
s VertexBeziers =
uncurry (textureBezRenderer rezContext rezShader) . V.unzip
l Stroke{..} =
uncurry (texPolylineRenderer rezContext rezShader strokeWidth
strokeFeather strokeLineCaps) . V.unzip
applyOption :: (c, rs -> IO ()) -> RenderingOption -> (c, rs -> IO ())
applyOption (c, r) StencilMaskOption = (c, \rs -> stencilMask (r rs) (r rs))
glV2V4Compiler :: Rez -> BackendCompiler V2V4 (V2 Float) Float Raster
glV2V4Compiler rz = BackendComp
{ backendCompApplyOption = applyOption
, backendCompCompiler = rgbaCompiler rz
}
glV2V2Compiler :: Rez -> BackendCompiler V2V2 (V2 Float) Float Raster
glV2V2Compiler rz = BackendComp
{ backendCompApplyOption = applyOption
, backendCompCompiler = uvCompiler rz
}
glOps :: Rez -> IO () -> IO [a] -> BackendOps GLuint a
glOps Rez{..} windowUpdate getEvents = BackendOps
{ backendOpGetFramebufferSize = uncurry V2 <$> ctxFramebufferSize rezContext
, backendOpGetWindowSize = uncurry V2 <$> ctxWindowSize rezContext
, backendOpClearWindow = do
(fbw,fbh) <- ctxFramebufferSize rezContext
glViewport 0 0 (fromIntegral fbw) (fromIntegral fbh)
glClear $ GL_COLOR_BUFFER_BIT .|. GL_DEPTH_BUFFER_BIT
, backendOpUpdateWindow = windowUpdate
, backendOpSetClearColor = \(V4 r g b a) -> glClearColor r g b a
, backendOpAllocTexture = loadImage >=> \case
Nothing -> return Nothing
Just (sz, tex) -> return $ Just (tex, sz)
, backendOpBindTextures = bindTexsAround
, backendOpGetEvents = getEvents
}