with openGL.Errors, openGL.Buffer, openGL.Tasks, GL.Binding, ada.unchecked_Deallocation; package body openGL.Primitive.long_indexed is --------- --- Forge -- procedure define (Self : in out Item; Kind : in facet_Kind; Indices : in long_Indices) is use Buffer.long_indices.Forge; buffer_Indices : aliased long_Indices := [Indices'Range => <>]; begin for Each in buffer_Indices'Range loop buffer_Indices (Each) := Indices (Each) - 1; -- Adjust indices to zero-based-indexing for GL. end loop; Self.facet_Kind := Kind; Self.Indices := new Buffer.long_indices.Object' (to_Buffer (buffer_Indices'Access, Usage => Buffer.static_Draw)); end define; function new_Primitive (Kind : in facet_Kind; Indices : in long_Indices) return Primitive.long_indexed.view is Self : constant View := new Item; begin define (Self.all, Kind, Indices); return Self; end new_Primitive; overriding procedure destroy (Self : in out Item) is procedure free is new ada.unchecked_Deallocation (Buffer.long_indices.Object'Class, Buffer.long_indices.view); begin Buffer.destroy (Self.Indices.all); free (Self.Indices); end destroy; -------------- -- Attributes -- procedure Indices_are (Self : in out Item; Now : in long_Indices) is use Buffer.long_indices; buffer_Indices : aliased long_Indices := [Now'Range => <>]; begin for Each in buffer_Indices'Range loop buffer_Indices (Each) := Now (Each) - 1; -- Adjust indices to zero-based-indexing for GL. end loop; Self.Indices.set (to => buffer_Indices); end Indices_are; -------------- -- Operations -- overriding procedure render (Self : in out Item) is use GL, GL.Binding; begin Tasks.check; openGL.Primitive.item (Self).render; -- Do base class render. Self.Indices.enable; glDrawElements (Thin (Self.facet_Kind), gl.GLint (Self.Indices.Length), GL_UNSIGNED_INT, null); Errors.log; end render; end openGL.Primitive.long_indexed;