365 lines
8.7 KiB
Ada
365 lines
8.7 KiB
Ada
with
|
|
openGL.Tasks,
|
|
|
|
GL.Pointers,
|
|
GL.lean,
|
|
|
|
ada.Characters.latin_1,
|
|
interfaces.C.Strings;
|
|
|
|
|
|
package body openGL.Program
|
|
is
|
|
use gl.lean,
|
|
Interfaces;
|
|
|
|
compiling_in_debug_Mode : constant Boolean := True;
|
|
|
|
type Shader_view is access all Shader.item'Class;
|
|
|
|
|
|
--------------
|
|
-- Parameters
|
|
--
|
|
|
|
procedure Program_is (Self : in out Parameters; Now : in openGL.Program.view)
|
|
is
|
|
begin
|
|
Self.Program := Now;
|
|
end Program_is;
|
|
|
|
|
|
function Program (Self : in Parameters) return openGL.Program.view
|
|
is
|
|
begin
|
|
return Self.Program;
|
|
end Program;
|
|
|
|
|
|
---------
|
|
--- Forge
|
|
--
|
|
|
|
procedure define (Self : in out Item; use_vertex_Shader : in Shader.view;
|
|
use_fragment_Shader : in Shader.view)
|
|
is
|
|
begin
|
|
Tasks.check;
|
|
|
|
Self.gl_Program := glCreateProgram;
|
|
|
|
glAttachShader (Self.gl_Program, use_vertex_Shader.gl_Shader);
|
|
glAttachShader (Self.gl_Program, use_fragment_Shader.gl_Shader);
|
|
|
|
Self. vertex_Shader := use_vertex_Shader;
|
|
Self.fragment_Shader := use_fragment_Shader;
|
|
|
|
glLinkProgram (Self.gl_Program);
|
|
|
|
declare
|
|
use type C.int;
|
|
Status : aliased gl.glInt;
|
|
begin
|
|
glGetProgramiv (Self.gl_Program,
|
|
GL_LINK_STATUS,
|
|
Status'unchecked_Access);
|
|
|
|
if Status = 0
|
|
then
|
|
declare
|
|
link_Log : constant String := Self.ProgramInfoLog;
|
|
begin
|
|
Self.destroy;
|
|
raise Error with "Program link error ~ " & link_Log;
|
|
end;
|
|
end if;
|
|
end;
|
|
|
|
if compiling_in_debug_Mode
|
|
then
|
|
glValidateProgram (Self.gl_Program);
|
|
end if;
|
|
end define;
|
|
|
|
|
|
|
|
procedure define (Self : in out Item; use_vertex_Shader_File : in String;
|
|
use_fragment_Shader_File : in String)
|
|
is
|
|
use openGL.Shader;
|
|
the_vertex_Shader : constant Shader_view := new openGL.Shader.item;
|
|
the_fragment_Shader : constant Shader_view := new openGL.Shader.item;
|
|
begin
|
|
the_vertex_Shader .define (openGL.Shader.vertex, use_vertex_Shader_File);
|
|
the_fragment_Shader.define (openGL.Shader.fragment, use_fragment_Shader_File);
|
|
|
|
Self.define ( the_vertex_Shader.all'Access,
|
|
the_fragment_Shader.all'Access);
|
|
end define;
|
|
|
|
|
|
|
|
procedure destroy (Self : in out Item)
|
|
is
|
|
begin
|
|
Tasks.check;
|
|
glDeleteProgram (Self.gl_Program);
|
|
end destroy;
|
|
|
|
|
|
--------------
|
|
-- Attributes
|
|
--
|
|
|
|
function Attribute (Self : access Item'Class; Named : in String) return openGL.Attribute.view
|
|
is
|
|
begin
|
|
for Each in 1 .. Self.attribute_Count
|
|
loop
|
|
if Self.Attributes (Each).Name = Named
|
|
then
|
|
return Self.Attributes (Each);
|
|
end if;
|
|
end loop;
|
|
|
|
raise Error with "'" & Named & "' is not a valid program attribute.";
|
|
end Attribute;
|
|
|
|
|
|
|
|
function attribute_Location (Self : access Item'Class; Named : in String) return gl.GLuint
|
|
is
|
|
use gl.Pointers;
|
|
use type gl.GLint;
|
|
|
|
attribute_Name : C.strings.chars_ptr := C.Strings.new_String (Named & ada.characters.Latin_1.NUL);
|
|
|
|
begin
|
|
Tasks.check;
|
|
|
|
declare
|
|
gl_Location : constant gl.GLint := glGetAttribLocation (Self.gl_Program,
|
|
to_GLchar_access (attribute_Name));
|
|
begin
|
|
if gl_Location = -1
|
|
then
|
|
raise Error with "Requested attribute '" & Named & "' has no gl location in program.";
|
|
end if;
|
|
|
|
C.Strings.free (attribute_Name);
|
|
|
|
return gl.GLuint (gl_Location);
|
|
end;
|
|
end attribute_Location;
|
|
|
|
|
|
|
|
function is_defined (Self : in Item'Class) return Boolean
|
|
is
|
|
use type a_gl_Program;
|
|
begin
|
|
return Self.gl_Program /= 0;
|
|
end is_defined;
|
|
|
|
|
|
|
|
function ProgramInfoLog (Self : in Item) return String
|
|
is
|
|
use C, GL;
|
|
|
|
info_log_Length : aliased glInt := 0;
|
|
chars_Written : aliased glSizei := 0;
|
|
|
|
begin
|
|
Tasks.check;
|
|
|
|
glGetProgramiv (Self.gl_Program,
|
|
GL_INFO_LOG_LENGTH,
|
|
info_log_Length'unchecked_Access);
|
|
|
|
if info_log_Length = 0 then
|
|
return "";
|
|
end if;
|
|
|
|
declare
|
|
use GL.Pointers;
|
|
info_Log : aliased C.char_array := C.char_array' [1 .. C.size_t (info_log_Length) => <>];
|
|
info_Log_ptr : constant C.strings.chars_ptr := C.strings.to_chars_ptr (info_Log'unchecked_Access);
|
|
begin
|
|
glGetProgramInfoLog (Self.gl_Program,
|
|
glSizei (info_log_Length),
|
|
chars_Written'unchecked_Access,
|
|
to_GLchar_access (info_Log_ptr));
|
|
return C.to_Ada (info_Log);
|
|
end;
|
|
end ProgramInfoLog;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.bool
|
|
is
|
|
the_Variable : Variable.uniform.bool;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.int
|
|
is
|
|
the_Variable : Variable.uniform.int;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.float
|
|
is
|
|
the_Variable : Variable.uniform.float;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.vec2
|
|
is
|
|
the_Variable : Variable.uniform.vec2;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.vec3
|
|
is
|
|
the_Variable : Variable.uniform.vec3;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.vec4
|
|
is
|
|
the_Variable : Variable.uniform.vec4;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.mat3
|
|
is
|
|
the_Variable : Variable.uniform.mat3;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.mat4
|
|
is
|
|
the_Variable : Variable.uniform.mat4;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
function uniform_Variable (Self : access Item'Class; Named : in String) return Variable.uniform.sampler2D
|
|
is
|
|
the_Variable : Variable.uniform.sampler2D;
|
|
begin
|
|
the_Variable.define (Self, Named);
|
|
return the_Variable;
|
|
end uniform_Variable;
|
|
|
|
|
|
--------------
|
|
-- Operations
|
|
--
|
|
|
|
procedure add (Self : in out Item; Attribute : in openGL.Attribute.view)
|
|
is
|
|
begin
|
|
Self.attribute_Count := Self.attribute_Count + 1;
|
|
Self.Attributes (Self.attribute_Count) := Attribute;
|
|
end add;
|
|
|
|
|
|
|
|
procedure enable (Self : in out Item)
|
|
is
|
|
use type gl.GLuint;
|
|
begin
|
|
Tasks.check;
|
|
|
|
if Self.gl_Program = 0
|
|
then
|
|
Item'Class (Self).define; -- TODO: This appears to do nothing.
|
|
end if;
|
|
|
|
glUseProgram (self.gl_Program);
|
|
end enable;
|
|
|
|
|
|
|
|
procedure enable_Attributes (Self : in Item)
|
|
is
|
|
begin
|
|
for Each in 1 .. Self.attribute_Count
|
|
loop
|
|
Self.Attributes (Each).enable;
|
|
end loop;
|
|
end enable_Attributes;
|
|
|
|
|
|
|
|
procedure mvp_Transform_is (Self : in out Item; Now : in Matrix_4x4)
|
|
is
|
|
begin
|
|
Self.mvp_Transform := Now;
|
|
end mvp_Transform_is;
|
|
|
|
|
|
|
|
procedure Scale_is (Self : in out Item; Now : in Vector_3)
|
|
is
|
|
begin
|
|
Self.Scale := Now;
|
|
end Scale_is;
|
|
|
|
|
|
|
|
procedure set_Uniforms (Self : in Item)
|
|
is
|
|
the_mvp_Uniform : constant Variable.uniform.mat4 := Self.uniform_Variable ("mvp_Transform");
|
|
the_scale_Uniform : constant Variable.uniform.vec3 := Self.uniform_Variable ("Scale");
|
|
begin
|
|
the_mvp_Uniform .Value_is (Self.mvp_Transform);
|
|
the_scale_Uniform.Value_is (Self.Scale);
|
|
end set_Uniforms;
|
|
|
|
|
|
|
|
-- Privvy
|
|
--
|
|
|
|
function gl_Program (Self : in Item) return a_gl_Program
|
|
is
|
|
begin
|
|
return Self.gl_Program;
|
|
end gl_Program;
|
|
|
|
|
|
end openGL.Program;
|