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