sig
type renderer
type buf
type attr
type prim
type tex
module Buf :
sig
type usage =
[ `Dynamic_copy
| `Dynamic_draw
| `Dynamic_read
| `Static_copy
| `Static_draw
| `Static_read
| `Stream_copy
| `Stream_draw
| `Stream_read ]
val pp_usage : Format.formatter -> Lit.Buf.usage -> unit
type ('a, 'b) init =
[ `Cpu of Gg.Ba.scalar_type * int
| `Float16 of (int, Bigarray.int16_unsigned_elt) Gg.bigarray
| `Float32 of (float, Bigarray.float32_elt) Gg.bigarray
| `Float64 of (float, Bigarray.float64_elt) Gg.bigarray
| `Gpu of Gg.Ba.scalar_type * int
| `Int16 of (int, Bigarray.int16_signed_elt) Gg.bigarray
| `Int32 of (int32, Bigarray.int32_elt) Gg.bigarray
| `Int64 of (int64, Bigarray.int64_elt) Gg.bigarray
| `Int8 of (int, Bigarray.int8_signed_elt) Gg.bigarray
| `UInt16 of (int, Bigarray.int16_unsigned_elt) Gg.bigarray
| `UInt32 of (int32, Bigarray.int32_elt) Gg.bigarray
| `UInt64 of (int64, Bigarray.int64_elt) Gg.bigarray
| `UInt8 of (int, Bigarray.int8_unsigned_elt) Gg.bigarray ]
type t = Lit.buf
val create :
?cpu_autorelease:bool ->
?usage:Lit.Buf.usage -> ('a, 'b) Lit.Buf.init -> Lit.buf
val usage : Lit.buf -> Lit.Buf.usage
val scalar_type : Lit.buf -> Gg.Ba.scalar_type
val pp : Format.formatter -> Lit.buf -> unit
val gpu_count : Lit.buf -> int
val gpu_exists : Lit.buf -> bool
val gpu_upload : Lit.buf -> bool
val set_gpu_upload : Lit.buf -> bool -> unit
val sync_gpu_to_cpu : Lit.renderer -> Lit.buf -> unit
val gpu_map :
Lit.renderer ->
[ `R | `RW | `W ] ->
Lit.buf -> ('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray
val gpu_unmap : Lit.renderer -> Lit.buf -> unit
val cpu_count : Lit.buf -> int
val cpu_exists : Lit.buf -> bool
val cpu :
Lit.buf ->
('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray option
val cpu_buffer : Lit.buf -> Gg.buffer option
val get_cpu :
Lit.buf -> ('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray
val get_cpu_buffer : Lit.buf -> Gg.buffer
val set_cpu : Lit.buf -> ('a, 'b) Gg.bigarray option -> unit
val set_cpu_buffer : Lit.buf -> Gg.buffer option -> unit
val cpu_autorelease : Lit.buf -> bool
val set_cpu_autorelease : Lit.buf -> bool -> unit
val sync_cpu_to_gpu : Lit.renderer -> Lit.buf -> unit
end
module Attr :
sig
type t = Lit.attr
val create :
?normalize:bool ->
?stride:int ->
?first:int -> string -> dim:int -> Lit.Buf.t -> Lit.Attr.t
val name : Lit.attr -> string
val dim : Lit.attr -> int
val buf : Lit.attr -> Lit.Buf.t
val stride : Lit.attr -> int
val first : Lit.attr -> int
val normalize : Lit.attr -> bool
val rename : Lit.attr -> string -> Lit.attr
val pp : Format.formatter -> Lit.attr -> unit
val vertex : string
val normal : string
val color : string
val tex : string
val texn : int -> string
end
module Prim :
sig
type kind =
[ `Line_loop
| `Line_strip
| `Line_strip_adjacency
| `Lines
| `Lines_adjacency
| `Points
| `Triangle_fan
| `Triangle_strip
| `Triangle_strip_adjacency
| `Triangles
| `Triangles_adjacency ]
val pp_kind : Format.formatter -> Lit.Prim.kind -> unit
type t = Lit.prim
val create :
?tr:Gg.M4.t ->
?name:string ->
?first:int ->
?count:int ->
?index:Lit.Buf.t -> Lit.Prim.kind -> Lit.attr list -> Lit.prim
val kind : Lit.prim -> Lit.Prim.kind
val name : Lit.prim -> string
val index : Lit.prim -> Lit.Buf.t option
val first : Lit.prim -> int
val count : Lit.prim -> int option
val count_now : Lit.prim -> int
val tr : Lit.prim -> Gg.M4.t
val pp : Format.formatter -> Lit.prim -> unit
val attrs : Lit.prim -> Lit.attr list
val iter : (Lit.attr -> unit) -> Lit.prim -> unit
val fold : ('a -> Lit.attr -> 'a) -> 'a -> Lit.prim -> 'a
val mem : Lit.prim -> string -> bool
val find : Lit.prim -> string -> Lit.attr option
val get : Lit.prim -> string -> Lit.attr
end
module Tex :
sig
type wrap = [ `Clamp_to_edge | `Mirrored_repeat | `Repeat ]
val pp_wrap : Format.formatter -> Lit.Tex.wrap -> unit
type mag_filter = [ `Linear | `Nearest ]
val pp_mag_filter : Format.formatter -> Lit.Tex.mag_filter -> unit
type min_filter =
[ `Linear
| `Linear_mipmap_linear
| `Linear_mipmap_nearest
| `Nearest
| `Nearest_mipmap_linear
| `Nearest_mipmap_nearest ]
val pp_min_filter : Format.formatter -> Lit.Tex.min_filter -> unit
type kind = [ `Buffer | `D1 | `D2 | `D2_ms | `D3 | `D3_ms ]
val pp_kind : Format.formatter -> Lit.Tex.kind -> unit
type sample_format =
[ `D1 of Gg.Ba.scalar_type * bool
| `D2 of Gg.Ba.scalar_type * bool
| `D3 of Gg.Ba.scalar_type * bool
| `D4 of Gg.Ba.scalar_type * bool
| `Depth of [ `Float32 | `UInt16 | `UInt24 ]
| `Depth_stencil of [ `Float32_UInt8 | `UInt24_UInt8 ]
| `SRGB of [ `UInt8 ]
| `SRGBA of [ `UInt8 ]
| `Stencil of [ `UInt8 ] ]
val pp_sample_format :
Format.formatter -> Lit.Tex.sample_format -> unit
type init =
[ `Buffer of Lit.Tex.sample_format * Lit.Buf.t
| `D1 of Lit.Tex.sample_format * float * Lit.Buf.t option
| `D2 of Lit.Tex.sample_format * Gg.size2 * Lit.Buf.t option
| `D2_ms of Lit.Tex.sample_format * Gg.size2 * int * bool
| `D3 of Lit.Tex.sample_format * Gg.size3 * Lit.Buf.t option
| `D3_ms of Lit.Tex.sample_format * Gg.size3 * int * bool ]
val pp_init : Format.formatter -> Lit.Tex.init -> unit
val init_of_raster :
?buf:bool ->
?cpu_autorelease:bool ->
?usage:Lit.Buf.usage ->
?kind:Lit.Tex.kind ->
?sample_format:Lit.Tex.sample_format ->
?norm:bool -> Gg.raster -> Lit.Tex.init
type t = Lit.tex
val nil : Lit.tex
val create :
?wrap_s:Lit.Tex.wrap ->
?wrap_t:Lit.Tex.wrap ->
?wrap_r:Lit.Tex.wrap ->
?mipmaps:bool ->
?min_filter:Lit.Tex.min_filter ->
?mag_filter:Lit.Tex.mag_filter ->
?buf_autorelease:bool -> Lit.Tex.init -> Lit.tex
val sample_format : Lit.tex -> Lit.Tex.sample_format
val kind : Lit.tex -> Lit.Tex.kind
val size2 : Lit.tex -> Gg.size2
val size3 : Lit.tex -> Gg.size3
val buf : Lit.tex -> Lit.Buf.t option
val set_buf : Lit.tex -> Lit.Buf.t option -> unit
val buf_autorelease : Lit.tex -> bool
val set_buf_autorelease : Lit.tex -> bool -> unit
val gpu_update : Lit.tex -> bool
val set_gpu_update : Lit.tex -> bool -> unit
val wrap_s : Lit.tex -> Lit.Tex.wrap
val wrap_t : Lit.tex -> Lit.Tex.wrap
val wrap_r : Lit.tex -> Lit.Tex.wrap
val mipmaps : Lit.tex -> bool
val min_filter : Lit.tex -> Lit.Tex.min_filter
val mag_filter : Lit.tex -> Lit.Tex.mag_filter
val multisample : Lit.tex -> int * bool
val pp : Format.formatter -> Lit.tex -> unit
end
type 'a uniform
type prog
type effect
module Uniform :
sig
type 'a t = 'a Lit.uniform
val name : 'a Lit.Uniform.t -> string
val value : 'a Lit.Uniform.t -> 'a
val set_value : 'a Lit.Uniform.t -> 'a -> 'a Lit.Uniform.t
val v : 'a Lit.Uniform.t -> 'a -> 'a Lit.Uniform.t
val set_to_model_to_world : Gg.m4 Lit.Uniform.t -> Gg.m4 Lit.Uniform.t
val is_value_builtin : 'a Lit.uniform -> bool
val pp : Format.formatter -> 'a Lit.uniform -> unit
val bool : string -> bool -> bool Lit.uniform
val int : string -> int -> int Lit.uniform
val float : string -> float -> float Lit.uniform
val v2 : string -> Gg.v2 -> Gg.v2 Lit.uniform
val v3 : string -> Gg.v3 -> Gg.v3 Lit.uniform
val v4 : string -> Gg.v4 -> Gg.v4 Lit.uniform
val m2 : string -> Gg.m2 -> Gg.m2 Lit.uniform
val m3 : string -> Gg.m3 -> Gg.m3 Lit.uniform
val m4 : string -> Gg.m4 -> Gg.m4 Lit.uniform
val tex : string -> Lit.tex -> Lit.tex Lit.uniform
val model_to_world : string -> Gg.m4 Lit.uniform
val model_to_view : string -> Gg.m4 Lit.uniform
val model_to_clip : string -> Gg.m4 Lit.uniform
val model_normal_to_view : string -> Gg.m3 Lit.uniform
val world_to_view : string -> Gg.m4 Lit.uniform
val world_to_clip : string -> Gg.m4 Lit.uniform
val view_to_clip : string -> Gg.m4 Lit.uniform
val viewport_o : string -> Gg.v2 Lit.uniform
val viewport_size : string -> Gg.v2 Lit.uniform
type builtin =
[ `Model_normal_to_view
| `Model_to_clip
| `Model_to_view
| `Model_to_world
| `View_to_clip
| `Viewport_o
| `Viewport_size
| `World_to_clip
| `World_to_view ]
type value_untyped =
[ `Bool of bool
| `Builtin of Lit.Uniform.builtin
| `Float of float
| `Int of int
| `M2 of Gg.m2
| `M3 of Gg.m3
| `M4 of Gg.m4
| `Tex of Lit.tex
| `V2 of Gg.v2
| `V3 of Gg.v3
| `V4 of Gg.v4 ]
type set
val empty : Lit.Uniform.set
val is_empty : Lit.Uniform.set -> bool
val add : Lit.Uniform.set -> 'a Lit.uniform -> Lit.Uniform.set
val ( + ) : Lit.Uniform.set -> 'a Lit.uniform -> Lit.Uniform.set
val mem_named : Lit.Uniform.set -> string -> bool
val find :
Lit.Uniform.set -> 'a Lit.uniform -> Lit.Uniform.value_untyped option
val find_named :
Lit.Uniform.set -> string -> Lit.Uniform.value_untyped option
val get :
Lit.Uniform.set -> 'a Lit.uniform -> Lit.Uniform.value_untyped
val get_named : Lit.Uniform.set -> string -> Lit.Uniform.value_untyped
val fold :
('a -> string -> Lit.Uniform.value_untyped -> 'a) ->
'a -> Lit.Uniform.set -> 'a
val pp_set : Format.formatter -> Lit.Uniform.set -> unit
end
module Prog :
sig
type loc = [ `Loc of string * int | `Unknown ]
val pp_loc : Format.formatter -> Lit.Prog.loc -> unit
type insert
val insert : ?loc:Lit.Prog.loc -> string -> Lit.Prog.insert
type lang = [ `GLSL of int | `GLSL_ES of int ]
type shader_stage =
[ `Compute
| `Fragment
| `Geometry
| `Tess_control
| `Tess_evaluation
| `Vertex ]
val pp_shader_stage : Format.formatter -> Lit.Prog.shader_stage -> unit
type shader
val shader :
?lang:Lit.Prog.lang ->
?loc:Lit.Prog.loc ->
?inserts:Lit.Prog.insert list ->
Lit.Prog.shader_stage -> string -> Lit.Prog.shader
val stage : Lit.Prog.shader -> Lit.Prog.shader_stage
val loc : Lit.Prog.shader -> Lit.Prog.loc
val lang : Lit.Prog.shader -> Lit.Prog.lang option
type source = string * (int * string) list
val source : ?lang:Lit.Prog.lang -> Lit.Prog.shader -> Lit.Prog.source
type t = Lit.prog
val create :
?name:string ->
?uset:Lit.Uniform.set -> Lit.Prog.shader list -> Lit.prog
val name : Lit.prog -> string
val uniforms : Lit.prog -> Lit.Uniform.set
val shaders : Lit.prog -> Lit.Prog.shader list
end
module Effect :
sig
type raster_face_cull = [ `Back | `Front ]
type raster = {
raster_face_cull : Lit.Effect.raster_face_cull option;
raster_multisample : bool;
}
val raster_default : Lit.Effect.raster
type depth_test =
[ `Always
| `Equal
| `Gequal
| `Greater
| `Lequal
| `Less
| `Nequal
| `Never ]
type depth = {
depth_test : Lit.Effect.depth_test option;
depth_write : bool;
depth_offset : float * float;
}
val depth_default : Lit.Effect.depth
type blend_mul =
[ `Cst
| `Cst_a
| `Dst
| `Dst_a
| `One
| `One_minus_cst
| `One_minus_cst_a
| `One_minus_dst
| `One_minus_dst_a
| `One_minus_src
| `One_minus_src1
| `One_minus_src1_a
| `One_minus_src_a
| `Src
| `Src1
| `Src1_a
| `Src_a
| `Src_a_saturate
| `Zero ]
type blend_eq =
[ `Add of Lit.Effect.blend_mul * Lit.Effect.blend_mul
| `Max
| `Min
| `Rev_sub of Lit.Effect.blend_mul * Lit.Effect.blend_mul
| `Sub of Lit.Effect.blend_mul * Lit.Effect.blend_mul ]
val blend_eq_default : Lit.Effect.blend_eq
type blend = {
blend : bool;
blend_rgb : Lit.Effect.blend_eq;
blend_a : Lit.Effect.blend_eq;
blend_cst : Gg.color;
}
val blend_default : Lit.Effect.blend
val blend_alpha : Lit.Effect.blend
type t = Lit.effect
val create :
?raster:Lit.Effect.raster ->
?depth:Lit.Effect.depth ->
?blend:Lit.Effect.blend ->
?uniforms:Lit.Uniform.set -> Lit.prog -> Lit.effect
val prog : Lit.effect -> Lit.prog
val uniforms : Lit.effect -> Lit.Uniform.set
val get_uniform :
Lit.effect -> 'a Lit.uniform -> Lit.Uniform.value_untyped
val set_uniform : Lit.effect -> 'a Lit.uniform -> 'a -> unit
val raster : Lit.effect -> Lit.Effect.raster
val depth : Lit.effect -> Lit.Effect.depth
val blend : Lit.effect -> Lit.Effect.blend
end
type view
type fbuf
module View :
sig
type t = Lit.view
val create :
?tr:Gg.m4 -> ?proj:Gg.m4 -> ?viewport:Gg.box2 -> unit -> Lit.View.t
val tr : Lit.view -> Gg.m4
val set_tr : Lit.view -> Gg.m4 -> unit
val proj : Lit.view -> Gg.m4
val set_proj : Lit.view -> Gg.m4 -> unit
val viewport : Lit.view -> Gg.box2
val set_viewport : Lit.view -> Gg.box2 -> unit
val viewport_of_surface : Lit.view -> Gg.p2 -> Gg.p2
val viewport_of_ndc : Lit.view -> Gg.p2 -> Gg.p2
val surface_of_viewport : Lit.view -> Gg.p2 -> Gg.p2
val surface_of_ndc : Lit.view -> Gg.p2 -> Gg.p2
val ndc_of_viewport : Lit.view -> Gg.p2 -> Gg.p2
val ndc_of_surface : Lit.view -> Gg.p2 -> Gg.p2
type fov = [ `H of float | `V of float ]
val persp :
fov:Lit.View.fov -> aspect:float -> near:float -> far:float -> Gg.m4
val look : ?up:Gg.v3 -> at:Gg.p3 -> from:Gg.p3 -> unit -> Gg.m4
end
module Fbuf :
sig
type clears = {
clear_color : Gg.color option;
clear_depth : float option;
clear_stencil : int option;
}
val clears_default : Lit.Fbuf.clears
module Rbuf :
sig
type t
val create :
?multisample:int ->
Gg.size2 -> Lit.Tex.sample_format -> Lit.Fbuf.Rbuf.t
val multisample : Lit.Fbuf.Rbuf.t -> int option
val size2 : Lit.Fbuf.Rbuf.t -> Gg.size2
val sample_format : Lit.Fbuf.Rbuf.t -> Lit.Tex.sample_format
end
type image =
[ `Rbuf of Lit.Fbuf.Rbuf.t
| `Tex of int * Lit.tex
| `Tex_layer of int * int * Lit.tex ]
type attachement =
[ `Color of int * Lit.Fbuf.image
| `Depth of Lit.Fbuf.image
| `Depth_stencil of Lit.Fbuf.image
| `Stencil of Lit.Fbuf.image ]
type t = Lit.fbuf
val default : Lit.fbuf
val create :
?clears:Lit.Fbuf.clears -> Lit.Fbuf.attachement list -> Lit.fbuf
val attachements : Lit.fbuf -> Lit.Fbuf.attachement list
val is_multisample : Lit.fbuf -> bool
val clears : Lit.fbuf -> Lit.Fbuf.clears
val set_clears : Lit.fbuf -> Lit.Fbuf.clears -> unit
val clear : Lit.renderer -> Lit.fbuf -> unit
type status =
[ `Complete
| `Incomplete_attachement
| `Incomplete_draw_buffer
| `Incomplete_layer_targets
| `Incomplete_missing_attachement
| `Incomplete_multisample
| `Incomplete_read_buffer
| `Undefined
| `Unknown of int
| `Unsupported ]
val pp_status : Format.formatter -> Lit.Fbuf.status -> unit
val status : Lit.renderer -> Lit.fbuf -> Lit.Fbuf.status
type read =
[ `Color_b of int
| `Color_g of int
| `Color_r of int
| `Color_rgb of int
| `Color_rgba of int
| `Depth
| `Depth_stencil
| `Stencil ]
val read :
?first:int ->
?w_stride:int ->
Lit.renderer ->
Lit.fbuf -> Lit.Fbuf.read -> Gg.box2 -> Lit.buf -> unit
type blit_buffer = [ `Color | `Depth | `Stencil ]
type blit_filter = [ `Linear | `Nearest ]
val blit :
?filter:Lit.Fbuf.blit_filter ->
Lit.renderer ->
Lit.Fbuf.blit_buffer list ->
src:Lit.fbuf -> Gg.box2 -> dst:Lit.fbuf -> Gg.box2 -> unit
end
type op = {
count : int;
effect : Lit.effect;
uniforms : Lit.Uniform.set;
tr : Gg.m4;
prim : Lit.prim;
}
module Renderer :
sig
module Log :
sig
type compiler_msg =
[ `Msg of string | `Msg_loc of string * Lit.Prog.loc * string ]
val pp_compiler_msg :
Format.formatter -> Lit.Renderer.Log.compiler_msg -> unit
type compiler_msg_parser =
string ->
[ `Loc of string * int * int * string | `Unparsed of string ]
val compiler_msg_parser_default :
Lit.Renderer.Log.compiler_msg_parser
val compiler_msg_parser_raw : Lit.Renderer.Log.compiler_msg_parser
type msg =
[ `Compiler of Lit.Renderer.Log.compiler_msg list
| `Linker of string list
| `Missing_attr of Lit.prim * string
| `Msg of string
| `Unsupported_shaders of Lit.prog * Lit.Prog.shader list ]
val pp_msg : Format.formatter -> Lit.Renderer.Log.msg -> unit
type level = [ `Debug | `Error ]
type t = Lit.Renderer.Log.level -> Lit.Renderer.Log.msg -> unit
val of_formatter : Format.formatter -> Lit.Renderer.Log.t
end
module Cap :
sig
val shader_stages : Lit.renderer -> Lit.Prog.shader_stage list
val max_samples : Lit.renderer -> int
val max_tex_size : Lit.renderer -> int
val max_render_buffer_size : Lit.renderer -> int
type gl_version =
[ `GL of int * int * int | `GLES of int * int * int | `Unknown ]
val pp_gl_version :
Format.formatter -> Lit.Renderer.Cap.gl_version -> unit
val gl_version : Lit.renderer -> Lit.Renderer.Cap.gl_version
val glsl_version : Lit.renderer -> Lit.Renderer.Cap.gl_version
val gl_renderer : Lit.renderer -> string
val gl_vendor : Lit.renderer -> string
val pp_gl_synopsis : Format.formatter -> Lit.renderer -> unit
end
val nop : Lit.op
val op :
?count:int ->
?uniforms:Lit.Uniform.set ->
?tr:Gg.m4 -> Lit.effect -> Lit.prim -> Lit.op
val add_op : Lit.renderer -> Lit.op -> unit
val size : Lit.renderer -> Gg.size2
val set_size : Lit.renderer -> Gg.size2 -> unit
val view : Lit.renderer -> Lit.View.t
val set_view : Lit.renderer -> Lit.View.t -> unit
val fbuf : Lit.renderer -> Lit.fbuf
val set_fbuf : Lit.renderer -> Lit.fbuf -> unit
val render : ?clear:bool -> Lit.renderer -> unit
module Private :
sig
module BInfo :
sig
type t
val create :
unit ->
('a -> Lit.Renderer.Private.BInfo.t) *
(Lit.Renderer.Private.BInfo.t -> 'a option)
val none : Lit.Renderer.Private.BInfo.t
end
module Buf :
sig
type usage =
[ `Dynamic_copy
| `Dynamic_draw
| `Dynamic_read
| `Static_copy
| `Static_draw
| `Static_read
| `Stream_copy
| `Stream_draw
| `Stream_read ]
val pp_usage : Format.formatter -> usage -> unit
type ('a, 'b) init =
[ `Cpu of Gg.Ba.scalar_type * int
| `Float16 of
(int, Bigarray.int16_unsigned_elt) Gg.bigarray
| `Float32 of (float, Bigarray.float32_elt) Gg.bigarray
| `Float64 of (float, Bigarray.float64_elt) Gg.bigarray
| `Gpu of Gg.Ba.scalar_type * int
| `Int16 of (int, Bigarray.int16_signed_elt) Gg.bigarray
| `Int32 of (int32, Bigarray.int32_elt) Gg.bigarray
| `Int64 of (int64, Bigarray.int64_elt) Gg.bigarray
| `Int8 of (int, Bigarray.int8_signed_elt) Gg.bigarray
| `UInt16 of (int, Bigarray.int16_unsigned_elt) Gg.bigarray
| `UInt32 of (int32, Bigarray.int32_elt) Gg.bigarray
| `UInt64 of (int64, Bigarray.int64_elt) Gg.bigarray
| `UInt8 of (int, Bigarray.int8_unsigned_elt) Gg.bigarray ]
type t = buf
val create :
?cpu_autorelease:bool -> ?usage:usage -> ('a, 'b) init -> buf
val usage : buf -> usage
val scalar_type : buf -> Gg.Ba.scalar_type
val pp : Format.formatter -> buf -> unit
val gpu_count : buf -> int
val gpu_exists : buf -> bool
val gpu_upload : buf -> bool
val set_gpu_upload : buf -> bool -> unit
val sync_gpu_to_cpu : renderer -> buf -> unit
val gpu_map :
renderer ->
[ `R | `RW | `W ] ->
buf -> ('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray
val gpu_unmap : renderer -> buf -> unit
val cpu_count : buf -> int
val cpu_exists : buf -> bool
val cpu :
buf ->
('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray option
val cpu_buffer : buf -> Gg.buffer option
val get_cpu :
buf -> ('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray
val get_cpu_buffer : buf -> Gg.buffer
val set_cpu : buf -> ('a, 'b) Gg.bigarray option -> unit
val set_cpu_buffer : buf -> Gg.buffer option -> unit
val cpu_autorelease : buf -> bool
val set_cpu_autorelease : buf -> bool -> unit
val sync_cpu_to_gpu : renderer -> buf -> unit
type bigarray_any =
Ba :
('a, 'b) Gg.bigarray -> Lit.Renderer.Private.Buf.bigarray_any
val create_bigarray_any :
Gg.Ba.scalar_type ->
int -> Lit.Renderer.Private.Buf.bigarray_any
val gpu_byte_count : Lit.buf -> int
val set_gpu_count : Lit.buf -> int -> unit
val set_gpu_exists : Lit.buf -> bool -> unit
val cpu_byte_count : Lit.buf -> int
val cpu_p :
Lit.buf -> Lit.Renderer.Private.Buf.bigarray_any option
val set_cpu_p :
Lit.buf -> Lit.Renderer.Private.Buf.bigarray_any -> unit
val check_ba_scalar_type :
Lit.buf -> ('a, 'b) Gg.Ba.ba_scalar_type -> unit
val binfo : Lit.buf -> Lit.Renderer.Private.BInfo.t
val set_binfo : Lit.buf -> Lit.Renderer.Private.BInfo.t -> unit
end
module Attr :
sig
type t = attr
val create :
?normalize:bool ->
?stride:int -> ?first:int -> string -> dim:int -> Buf.t -> t
val name : attr -> string
val dim : attr -> int
val buf : attr -> Buf.t
val stride : attr -> int
val first : attr -> int
val normalize : attr -> bool
val rename : attr -> string -> attr
val pp : Format.formatter -> attr -> unit
val vertex : string
val normal : string
val color : string
val tex : string
val texn : int -> string
end
module Prim :
sig
type kind =
[ `Line_loop
| `Line_strip
| `Line_strip_adjacency
| `Lines
| `Lines_adjacency
| `Points
| `Triangle_fan
| `Triangle_strip
| `Triangle_strip_adjacency
| `Triangles
| `Triangles_adjacency ]
val pp_kind : Format.formatter -> kind -> unit
type t = prim
val create :
?tr:Gg.M4.t ->
?name:string ->
?first:int ->
?count:int -> ?index:Buf.t -> kind -> attr list -> prim
val kind : prim -> kind
val name : prim -> string
val index : prim -> Buf.t option
val first : prim -> int
val count : prim -> int option
val count_now : prim -> int
val tr : prim -> Gg.M4.t
val pp : Format.formatter -> prim -> unit
val attrs : prim -> attr list
val iter : (attr -> unit) -> prim -> unit
val fold : ('a -> attr -> 'a) -> 'a -> prim -> 'a
val mem : prim -> string -> bool
val find : prim -> string -> attr option
val get : prim -> string -> attr
val binfo : Lit.prim -> Lit.Renderer.Private.BInfo.t
val set_binfo :
Lit.prim -> Lit.Renderer.Private.BInfo.t -> unit
end
module Tex :
sig
type wrap = [ `Clamp_to_edge | `Mirrored_repeat | `Repeat ]
val pp_wrap : Format.formatter -> wrap -> unit
type mag_filter = [ `Linear | `Nearest ]
val pp_mag_filter : Format.formatter -> mag_filter -> unit
type min_filter =
[ `Linear
| `Linear_mipmap_linear
| `Linear_mipmap_nearest
| `Nearest
| `Nearest_mipmap_linear
| `Nearest_mipmap_nearest ]
val pp_min_filter : Format.formatter -> min_filter -> unit
type kind = [ `Buffer | `D1 | `D2 | `D2_ms | `D3 | `D3_ms ]
val pp_kind : Format.formatter -> kind -> unit
type sample_format =
[ `D1 of Gg.Ba.scalar_type * bool
| `D2 of Gg.Ba.scalar_type * bool
| `D3 of Gg.Ba.scalar_type * bool
| `D4 of Gg.Ba.scalar_type * bool
| `Depth of [ `Float32 | `UInt16 | `UInt24 ]
| `Depth_stencil of [ `Float32_UInt8 | `UInt24_UInt8 ]
| `SRGB of [ `UInt8 ]
| `SRGBA of [ `UInt8 ]
| `Stencil of [ `UInt8 ] ]
val pp_sample_format :
Format.formatter -> sample_format -> unit
type init =
[ `Buffer of sample_format * Buf.t
| `D1 of sample_format * float * Buf.t option
| `D2 of sample_format * Gg.size2 * Buf.t option
| `D2_ms of sample_format * Gg.size2 * int * bool
| `D3 of sample_format * Gg.size3 * Buf.t option
| `D3_ms of sample_format * Gg.size3 * int * bool ]
val pp_init : Format.formatter -> init -> unit
val init_of_raster :
?buf:bool ->
?cpu_autorelease:bool ->
?usage:Buf.usage ->
?kind:kind ->
?sample_format:sample_format ->
?norm:bool -> Gg.raster -> init
type t = tex
val nil : tex
val create :
?wrap_s:wrap ->
?wrap_t:wrap ->
?wrap_r:wrap ->
?mipmaps:bool ->
?min_filter:min_filter ->
?mag_filter:mag_filter ->
?buf_autorelease:bool -> init -> tex
val sample_format : tex -> sample_format
val kind : tex -> kind
val size2 : tex -> Gg.size2
val size3 : tex -> Gg.size3
val buf : tex -> Buf.t option
val set_buf : tex -> Buf.t option -> unit
val buf_autorelease : tex -> bool
val set_buf_autorelease : tex -> bool -> unit
val gpu_update : tex -> bool
val set_gpu_update : tex -> bool -> unit
val wrap_s : tex -> wrap
val wrap_t : tex -> wrap
val wrap_r : tex -> wrap
val mipmaps : tex -> bool
val min_filter : tex -> min_filter
val mag_filter : tex -> mag_filter
val multisample : tex -> int * bool
val pp : Format.formatter -> tex -> unit
val binfo : Lit.tex -> Lit.Renderer.Private.BInfo.t
val set_binfo : Lit.tex -> Lit.Renderer.Private.BInfo.t -> unit
end
module Prog :
sig
type loc = [ `Loc of string * int | `Unknown ]
val pp_loc : Format.formatter -> loc -> unit
type insert
val insert : ?loc:loc -> string -> insert
type lang = [ `GLSL of int | `GLSL_ES of int ]
type shader_stage =
[ `Compute
| `Fragment
| `Geometry
| `Tess_control
| `Tess_evaluation
| `Vertex ]
val pp_shader_stage : Format.formatter -> shader_stage -> unit
type shader = Prog.shader
val shader :
?lang:lang ->
?loc:loc ->
?inserts:insert list -> shader_stage -> string -> shader
val stage : shader -> shader_stage
val loc : shader -> loc
val lang : shader -> lang option
type source = string * (int * string) list
val source : ?lang:lang -> shader -> source
type t = prog
val create :
?name:string -> ?uset:Uniform.set -> shader list -> prog
val name : prog -> string
val uniforms : prog -> Uniform.set
val shaders : prog -> shader list
val binfo : Lit.prog -> Lit.Renderer.Private.BInfo.t
val set_binfo :
Lit.prog -> Lit.Renderer.Private.BInfo.t -> unit
end
module Effect :
sig
type raster_face_cull = [ `Back | `Front ]
type raster =
Effect.raster = {
raster_face_cull : raster_face_cull option;
raster_multisample : bool;
}
val raster_default : raster
type depth_test =
[ `Always
| `Equal
| `Gequal
| `Greater
| `Lequal
| `Less
| `Nequal
| `Never ]
type depth =
Effect.depth = {
depth_test : depth_test option;
depth_write : bool;
depth_offset : float * float;
}
val depth_default : depth
type blend_mul =
[ `Cst
| `Cst_a
| `Dst
| `Dst_a
| `One
| `One_minus_cst
| `One_minus_cst_a
| `One_minus_dst
| `One_minus_dst_a
| `One_minus_src
| `One_minus_src1
| `One_minus_src1_a
| `One_minus_src_a
| `Src
| `Src1
| `Src1_a
| `Src_a
| `Src_a_saturate
| `Zero ]
type blend_eq =
[ `Add of blend_mul * blend_mul
| `Max
| `Min
| `Rev_sub of blend_mul * blend_mul
| `Sub of blend_mul * blend_mul ]
val blend_eq_default : blend_eq
type blend =
Effect.blend = {
blend : bool;
blend_rgb : blend_eq;
blend_a : blend_eq;
blend_cst : Gg.color;
}
val blend_default : blend
val blend_alpha : blend
type t = effect
val create :
?raster:raster ->
?depth:depth ->
?blend:blend -> ?uniforms:Uniform.set -> prog -> effect
val prog : effect -> prog
val uniforms : effect -> Uniform.set
val get_uniform : effect -> 'a uniform -> Uniform.value_untyped
val set_uniform : effect -> 'a uniform -> 'a -> unit
val raster : effect -> raster
val depth : effect -> depth
val blend : effect -> blend
val binfo : Lit.effect -> Lit.Renderer.Private.BInfo.t
val set_binfo :
Lit.effect -> Lit.Renderer.Private.BInfo.t -> unit
end
module Fbuf :
sig
module Rbuf :
sig
type t = Fbuf.Rbuf.t
val create :
?multisample:int -> Gg.size2 -> Tex.sample_format -> t
val multisample : t -> int option
val size2 : t -> Gg.size2
val sample_format : t -> Tex.sample_format
val binfo : t -> Lit.Renderer.Private.BInfo.t
val set_binfo : t -> Lit.Renderer.Private.BInfo.t -> unit
end
type clears = {
clear_color : Gg.color option;
clear_depth : float option;
clear_stencil : int option;
}
val clears_default : clears
type image =
[ `Rbuf of Rbuf.t
| `Tex of int * tex
| `Tex_layer of int * int * tex ]
type attachement =
[ `Color of int * image
| `Depth of image
| `Depth_stencil of image
| `Stencil of image ]
type t = fbuf
val default : fbuf
val create : ?clears:clears -> attachement list -> fbuf
val attachements : fbuf -> attachement list
val is_multisample : fbuf -> bool
val clears : fbuf -> clears
val set_clears : fbuf -> clears -> unit
val clear : renderer -> fbuf -> unit
type status =
[ `Complete
| `Incomplete_attachement
| `Incomplete_draw_buffer
| `Incomplete_layer_targets
| `Incomplete_missing_attachement
| `Incomplete_multisample
| `Incomplete_read_buffer
| `Undefined
| `Unknown of int
| `Unsupported ]
val pp_status : Format.formatter -> status -> unit
val status : renderer -> fbuf -> status
type read =
[ `Color_b of int
| `Color_g of int
| `Color_r of int
| `Color_rgb of int
| `Color_rgba of int
| `Depth
| `Depth_stencil
| `Stencil ]
val read :
?first:int ->
?w_stride:int ->
renderer -> fbuf -> read -> Gg.box2 -> buf -> unit
type blit_buffer = [ `Color | `Depth | `Stencil ]
type blit_filter = [ `Linear | `Nearest ]
val blit :
?filter:blit_filter ->
renderer ->
blit_buffer list ->
src:fbuf -> Gg.box2 -> dst:fbuf -> Gg.box2 -> unit
val binfo : Lit.fbuf -> Lit.Renderer.Private.BInfo.t
val set_binfo :
Lit.fbuf -> Lit.Renderer.Private.BInfo.t -> unit
end
module Log :
sig
type compiler_msg =
[ `Msg of string | `Msg_loc of string * Prog.loc * string ]
val pp_compiler_msg : Format.formatter -> compiler_msg -> unit
type compiler_msg_parser =
string ->
[ `Loc of string * int * int * string | `Unparsed of string ]
val compiler_msg_parser_default : compiler_msg_parser
val compiler_msg_parser_raw : compiler_msg_parser
type msg =
[ `Compiler of compiler_msg list
| `Linker of string list
| `Missing_attr of prim * string
| `Msg of string
| `Unsupported_shaders of prog * Prog.shader list ]
val pp_msg : Format.formatter -> msg -> unit
type level = [ `Debug | `Error ]
type t = level -> msg -> unit
val of_formatter : Format.formatter -> t
val split_string : char -> string -> string list
val lines : string -> string list
val compiler_msg :
string ->
compiler_msg_parser ->
(int * string) list -> [> `Compiler of compiler_msg list ]
end
module Cap :
sig
val parse_version : string -> (int * int * int) option
type t = {
c_shader_stages : Lit.Renderer.Private.Prog.shader_stage list;
c_max_samples : int;
c_max_tex_size : int;
c_max_render_buffer_size : int;
c_gl_version : Lit.Renderer.Cap.gl_version;
c_glsl_version : Lit.Renderer.Cap.gl_version;
c_gl_renderer : string;
c_gl_vendor : string;
}
end
end
module type T =
sig
type t
module BCap :
sig val caps : Lit.Renderer.T.t -> Lit.Renderer.Private.Cap.t end
module BBuf :
sig
val sync_cpu_to_gpu : Lit.Renderer.T.t -> Lit.buf -> unit
val sync_gpu_to_cpu : Lit.Renderer.T.t -> Lit.buf -> unit
val gpu_map :
Lit.Renderer.T.t ->
[ `R | `RW | `W ] ->
Lit.buf ->
('a, 'b) Gg.Ba.ba_scalar_type -> ('a, 'b) Gg.bigarray
val gpu_unmap : Lit.Renderer.T.t -> Lit.buf -> unit
end
module BFbuf :
sig
val clear : Lit.Renderer.T.t -> Lit.fbuf -> unit
val status : Lit.Renderer.T.t -> Lit.fbuf -> Lit.Fbuf.status
val read :
Lit.Renderer.T.t ->
Lit.fbuf ->
Lit.Fbuf.read ->
Gg.box2 ->
first:int -> w_stride:int option -> Lit.buf -> unit
val blit :
Lit.Renderer.T.t ->
Lit.Fbuf.blit_filter ->
Lit.Fbuf.blit_buffer list ->
src:Lit.fbuf -> Gg.box2 -> dst:Lit.fbuf -> Gg.box2 -> unit
end
val name : string
val create :
?compiler_msg_parser:Lit.Renderer.Log.compiler_msg_parser ->
Lit.Renderer.Log.t -> debug:bool -> Gg.size2 -> Lit.Renderer.T.t
val size : Lit.Renderer.T.t -> Gg.size2
val set_size : Lit.Renderer.T.t -> Gg.size2 -> unit
val view : Lit.Renderer.T.t -> Lit.View.t
val set_view : Lit.Renderer.T.t -> Lit.View.t -> unit
val fbuf : Lit.Renderer.T.t -> Lit.fbuf
val set_fbuf : Lit.Renderer.T.t -> Lit.fbuf -> unit
val add_op : Lit.Renderer.T.t -> Lit.op -> unit
val render : Lit.Renderer.T.t -> clear:bool -> unit
val release : Lit.Renderer.T.t -> unit
end
type t = Lit.renderer
val create :
?compiler_msg_parser:Lit.Renderer.Log.compiler_msg_parser ->
?log:Lit.Renderer.Log.t ->
?debug:bool ->
size:Gg.size2 -> (module Lit.Renderer.T) -> Lit.renderer
val release : Lit.renderer -> unit
end
end