lace_opengl_0.1.0_672a6415/source/lean/geometry/opengl-primitive.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
with
     openGL.Tasks,
     GL.Binding,
     ada.unchecked_Deallocation;

package body openGL.Primitive
is
   ---------
   --  Forge
   --

   procedure define (Self : in out Item;   Kind : in facet_Kind)
   is
   begin
      Self.facet_Kind := Kind;
   end define;


   procedure free (Self : in out View)
   is
      procedure deallocate is new ada.Unchecked_Deallocation (Primitive.item'Class,
                                                              Primitive.view);
   begin
      Self.destroy;
      deallocate (Self);
   end free;


   --------------
   --  Attributes
   --

   function Texture (Self : in Item) return openGL.Texture.Object
   is
   begin
      return Self.Texture;
   end Texture;


   procedure Texture_is (Self : in out Item;   Now : in openGL.Texture.Object)
   is
   begin
      Self.Texture := Now;
   end Texture_is;



   function Bounds (self : in Item) return openGL.Bounds
   is
   begin
      return Self.Bounds;
   end Bounds;


   procedure Bounds_are (Self : in out Item;   Now : in openGL.Bounds)
   is
   begin
      Self.Bounds := Now;
   end Bounds_are;



   function is_Transparent (self : in Item) return Boolean
   is
   begin
      return Self.is_Transparent;
   end is_Transparent;


   procedure is_Transparent (Self : in out Item;   Now : in Boolean := True)
   is
   begin
      Self.is_Transparent := Now;
   end is_Transparent;


   --------------
   --- Operations
   --

   procedure render (Self : in out Item)
   is
      use GL,
          GL.Binding;
   begin
      Tasks.check;

      if Self.line_Width /= unused_line_Width
      then
         glLineWidth (glFloat (Self.line_Width));
      end if;
   end render;


end openGL.Primitive;