perspective :: Float  -- Near plane clipping distance (always positive).
            -> Float  -- Far plane clipping distance (always positive).
            -> Float  -- Field of view of the y axis, in radians.
            -> Float  -- Aspect ratio, i.e. screen's width/height.
            -> Mat 4 4 Float

lookat :: Vec 3 Float  -- Camera position.
       -> Vec 3 Float  -- Target position.
       -> Vec 3 Float  -- Upward direction.
       -> Mat 4 4 Float

rotMatrixX, rotMatrixY, rotMatrixZ :: Float -> Mat 4 4 Float

texture2D :: Sampler      -- texture data source with sampling setting
          -> Vec 2 Float  -- 2D texture coordinate
          -> Vec 4 Float  -- texture's pixel

-- Frame operations
imageFrame (emptyColorImage COLOR, ...)
overlay BACKGROUND_FRAME FOREGROUND_FRAME

-- Stream transformers
fetch "objectArrayName" (Attribute "VERTEX_ATTRIBUTE_1", Attribute "VERTEX_ATTRIBUTE_2", ...)
mapPrimitives VERTEX_SHADER_FUNCTION
rasterPrimitives RASTERIZATION_CONTEXT INTERPOLATION
filterFragments FRAGMENT_FILTER_FUNCTION
mapFragments FRAGMENT_SHADER_FUNCTION
accumulateWith ACCUMULATION_CONTEXT

-- Pipeline input
Uniform "UNIFORM_NAME"
Texture2DSlot "TEXTURE_NAME"

-- hello.lc
makeFrame (time :: Float)
          (texture :: Texture)
          (prims :: PrimitiveStream Triangle (Vec 2 Float, Vec 2 Float))

    = imageFrame ((emptyColorImage (V4 0 0 0.4 1)))
  `overlay`
      prims
    & mapPrimitives (\(p,uv) -> (rotMatrixZ time *. (V4 p%x p%y (-1) 1), uv))
    & rasterizePrimitives (TriangleCtx CullNone PolygonFill NoOffset LastVertex) ((Smooth))
    & mapFragments (\((uv)) -> ((texture2D (Sampler PointFilter MirroredRepeat texture) uv)))
    & accumulateWith ((ColorOp NoBlending (V4 True True True True)))

main = renderFrame $
   makeFrame (Uniform "time")
             (Texture2DSlot "diffuseTexture")
             (fetch "objects" (Attribute "position", Attribute "uv"))

{-# LANGUAGE PackageImports, LambdaCase, OverloadedStrings #-}
import "GLFW-b" Graphics.UI.GLFW as GLFW
import qualified Data.Map as Map
import qualified Data.Vector as V

import LambdaCube.GL as LambdaCubeGL -- renderer
import LambdaCube.GL.Mesh as LambdaCubeGL

import Codec.Picture as Juicy

import Data.Aeson
import qualified Data.ByteString as SB

----------------------------------------------------
--  See:  http://lambdacube3d.com/getting-started
----------------------------------------------------

main :: IO ()
main = do
    win <- initWindow "LambdaCube 3D DSL Hello World" 640 640

    -- setup render data
    let inputSchema = makeSchema $ do
          defObjectArray "objects" Triangles $ do
            "position"  @: Attribute_V2F
            "uv"        @: Attribute_V2F
          defUniforms $ do
            "time"           @: Float
            "diffuseTexture" @: FTexture2D

    storage <- LambdaCubeGL.allocStorage inputSchema

    -- upload geometry to GPU and add to pipeline input
    LambdaCubeGL.uploadMeshToGPU triangleA >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []
    LambdaCubeGL.uploadMeshToGPU triangleB >>= LambdaCubeGL.addMeshToObjectArray storage "objects" []

    -- load image and upload texture
    Right img <- Juicy.readImage "logo.png"
    textureData <- LambdaCubeGL.uploadTexture2DToGPU img

    -- allocate GL pipeline
    Just pipelineDesc <- decodeStrict <$> SB.readFile "hello.json"
    renderer <- LambdaCubeGL.allocRenderer pipelineDesc
    LambdaCubeGL.setStorage renderer storage >>= \case -- check schema compatibility
      Just err -> putStrLn err
      Nothing  -> loop
        where loop = do
                -- update graphics input
                GLFW.getWindowSize win >>= \(w,h) ->
                  LambdaCubeGL.setScreenSize storage (fromIntegral w) (fromIntegral h)
                LambdaCubeGL.updateUniforms storage $ do
                  "diffuseTexture" @= return textureData
                  "time" @= do
                              Just t <- GLFW.getTime
                              return (realToFrac t :: Float)
                -- render
                LambdaCubeGL.renderFrame renderer
                GLFW.swapBuffers win
                GLFW.pollEvents

                let keyIsPressed k = fmap (==KeyState'Pressed) $ GLFW.getKey win k
                escape <- keyIsPressed Key'Escape
                if escape then return () else loop

    LambdaCubeGL.disposeRenderer renderer
    LambdaCubeGL.disposeStorage storage
    GLFW.destroyWindow win
    GLFW.terminate

-- geometry data: triangles
triangleA :: LambdaCubeGL.Mesh
triangleA = Mesh
    { mAttributes   = Map.fromList
        [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 1 (-1), V2 (-1) (-1)])
        , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 1, V2 0 0])
        ]
    , mPrimitive    = P_Triangles
    }

triangleB :: LambdaCubeGL.Mesh
triangleB = Mesh
    { mAttributes   = Map.fromList
        [ ("position",  A_V2F $ V.fromList [V2 1 1, V2 (-1) (-1), V2 (-1) 1])
        , ("uv",        A_V2F $ V.fromList [V2 1 1, V2 0 0, V2 1 0])
        ]
    , mPrimitive    = P_Triangles
    }

initWindow :: String -> Int -> Int -> IO Window
initWindow title width height = do
    GLFW.init
    GLFW.defaultWindowHints
    mapM_ GLFW.windowHint
      [ WindowHint'ContextVersionMajor 3
      , WindowHint'ContextVersionMinor 3
      , WindowHint'OpenGLProfile OpenGLProfile'Core
      , WindowHint'OpenGLForwardCompat True
      ]
    Just win <- GLFW.createWindow width height title Nothing Nothing
    GLFW.makeContextCurrent $ Just win
    return win