├── .gitattributes ├── .gitignore ├── CHANGELOG ├── COPYING ├── README.md ├── opengl-glfw ├── alire.lock ├── alire.toml ├── opengl-glfw.gpr └── src │ ├── glfw-api.ads │ ├── glfw-enums.ads │ ├── glfw-errors.adb │ ├── glfw-errors.ads │ ├── glfw-input-joysticks.adb │ ├── glfw-input-joysticks.ads │ ├── glfw-input-keys.ads │ ├── glfw-input-mouse.adb │ ├── glfw-input-mouse.ads │ ├── glfw-input.adb │ ├── glfw-input.ads │ ├── glfw-monitors.adb │ ├── glfw-monitors.ads │ ├── glfw-windows-clipboard.adb │ ├── glfw-windows-clipboard.ads │ ├── glfw-windows-context.adb │ ├── glfw-windows-context.ads │ ├── glfw-windows-hints.adb │ ├── glfw-windows-hints.ads │ ├── glfw-windows.adb │ ├── glfw-windows.ads │ ├── glfw.adb │ └── glfw.ads ├── opengl-images ├── alire.lock ├── alire.toml ├── opengl-images.gpr └── src │ ├── gl-images.adb │ └── gl-images.ads ├── opengl-text ├── alire.lock ├── alire.toml ├── opengl-text.gpr └── src │ ├── gl-text-utf8.adb │ ├── gl-text-utf8.ads │ ├── gl-text.adb │ └── gl-text.ads ├── opengl ├── alire.lock ├── alire.toml ├── generate.gpr ├── opengl.gpr └── src │ ├── generated │ ├── gl-api-doubles.ads │ ├── gl-api-ints.ads │ ├── gl-api-shorts.ads │ ├── gl-api-singles.ads │ ├── gl-api-uints.ads │ ├── gl-api.ads │ └── gl-load_function_pointers.adb │ ├── generator │ ├── generate.adb │ ├── specs.adb │ ├── specs.ads │ ├── tokenization.adb │ └── tokenization.ads │ ├── implementation │ ├── auto_exceptions │ │ └── gl-raise_exception_on_opengl_error.adb │ ├── gl-algebra.adb │ ├── gl-api-subprogram_reference.ads │ ├── gl-attributes.adb │ ├── gl-blending.adb │ ├── gl-buffers.adb │ ├── gl-context.adb │ ├── gl-culling.adb │ ├── gl-debug.adb │ ├── gl-enums-getter.adb │ ├── gl-enums-getter.ads │ ├── gl-enums-indexes.adb │ ├── gl-enums-indexes.ads │ ├── gl-enums-queries.ads │ ├── gl-enums-textures.ads │ ├── gl-enums.ads │ ├── gl-errors.adb │ ├── gl-files.adb │ ├── gl-fixed-lighting.adb │ ├── gl-fixed-matrix.adb │ ├── gl-fixed-textures.adb │ ├── gl-fixed.adb │ ├── gl-framebuffer.adb │ ├── gl-helpers.adb │ ├── gl-helpers.ads │ ├── gl-immediate.adb │ ├── gl-load_function_pointers.ads │ ├── gl-low_level-enums.ads │ ├── gl-low_level.ads │ ├── gl-matrices.adb │ ├── gl-objects-buffers.adb │ ├── gl-objects-framebuffers.adb │ ├── gl-objects-lists.adb │ ├── gl-objects-programs.adb │ ├── gl-objects-queries.adb │ ├── gl-objects-renderbuffers.adb │ ├── gl-objects-shaders.adb │ ├── gl-objects-textures-targets.adb │ ├── gl-objects-textures-with_1d_loader.adb │ ├── gl-objects-textures-with_2d_loader.adb │ ├── gl-objects-textures-with_3d_loader.adb │ ├── gl-objects-textures.adb │ ├── gl-objects-vertex_arrays.adb │ ├── gl-objects.adb │ ├── gl-pixels.adb │ ├── gl-raster.adb │ ├── gl-rasterization.adb │ ├── gl-tessellation.adb │ ├── gl-toggles.adb │ ├── gl-uniforms.adb │ ├── gl-vectors.adb │ ├── gl-window.adb │ ├── gl.adb │ └── no_auto_exceptions │ │ └── gl-raise_exception_on_opengl_error.adb │ ├── interface │ ├── gl-algebra.ads │ ├── gl-attributes.ads │ ├── gl-blending.ads │ ├── gl-buffers.ads │ ├── gl-context.ads │ ├── gl-culling.ads │ ├── gl-debug.ads │ ├── gl-errors.ads │ ├── gl-files.ads │ ├── gl-fixed-lighting.ads │ ├── gl-fixed-matrix.ads │ ├── gl-fixed-textures.ads │ ├── gl-fixed.ads │ ├── gl-framebuffer.ads │ ├── gl-immediate.ads │ ├── gl-matrices.ads │ ├── gl-objects-buffers.ads │ ├── gl-objects-framebuffers.ads │ ├── gl-objects-lists.ads │ ├── gl-objects-programs.ads │ ├── gl-objects-queries.ads │ ├── gl-objects-renderbuffers.ads │ ├── gl-objects-shaders-lists.ads │ ├── gl-objects-shaders.ads │ ├── gl-objects-textures-targets.ads │ ├── gl-objects-textures-with_1d_loader.ads │ ├── gl-objects-textures-with_2d_loader.ads │ ├── gl-objects-textures-with_3d_loader.ads │ ├── gl-objects-textures.ads │ ├── gl-objects-vertex_arrays.ads │ ├── gl-objects.ads │ ├── gl-pixels.ads │ ├── gl-raster.ads │ ├── gl-rasterization.ads │ ├── gl-tessellation.ads │ ├── gl-toggles.ads │ ├── gl-types-colors.ads │ ├── gl-types.ads │ ├── gl-uniforms.ads │ ├── gl-vectors.ads │ ├── gl-window.ads │ └── gl.ads │ ├── mac │ ├── gl-api-mac_os_x.adb │ ├── gl-api-mac_os_x.ads │ ├── gl-api-subprogram_reference.adb │ └── gl-cgl.ads │ ├── specs │ ├── gl-api-doubles.spec │ ├── gl-api-ints.spec │ ├── gl-api-shorts.spec │ ├── gl-api-singles.spec │ ├── gl-api-uints.spec │ └── gl-api.spec │ ├── windows │ ├── gl-api-subprogram_reference.adb │ └── gl-wgl.ads │ └── x11 │ ├── gl-api-subprogram_reference.adb │ └── gl-glx.ads └── tests ├── ada2012-black.png ├── ada2012-color.jpg ├── alire.lock ├── alire.toml ├── all_tests.gpr ├── opengl-glfw-test.gpr ├── opengl-images-test.gpr ├── opengl-test.gpr ├── opengl-text-test.gpr ├── src ├── gl │ ├── gl_test-context.adb │ ├── gl_test-debugging.adb │ ├── gl_test-framebuffers.adb │ ├── gl_test-immediate.adb │ ├── gl_test-opengl3-fragment.glsl │ ├── gl_test-opengl3-vertex.glsl │ ├── gl_test-opengl3.adb │ ├── gl_test-shaders-fragment.glsl │ ├── gl_test-shaders-vertex.glsl │ ├── gl_test-shaders.adb │ └── gl_test-vbos.adb ├── glfw3 │ ├── glfw_test-clipboard.adb │ ├── glfw_test-monitors.adb │ ├── glfw_test-mouse.adb │ ├── glfw_test-windows.adb │ ├── glfw_test.adb │ └── glfw_test.ads ├── images │ ├── images_test_jpg.adb │ └── images_test_png.adb ├── shared │ ├── gl_test-display_backend.adb │ ├── gl_test-display_backend.ads │ └── gl_test.ads └── text │ ├── text_test-basic-fragment.glsl │ ├── text_test-basic-vertex.glsl │ ├── text_test-basic.adb │ └── text_test.ads └── texgyreadventor-regular.otf /.gitattributes: -------------------------------------------------------------------------------- 1 | *.spec linguist-language=Ada -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | lib 2 | obj 3 | bin 4 | .DS_Store 5 | .#*# 6 | *~ 7 | *.exe 8 | gnatinspect.db 9 | opengl/generated/WrapperList.md 10 | *.dll 11 | *-loc.xml 12 | alire 13 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2017 Felix Krause 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /opengl-glfw/alire.lock: -------------------------------------------------------------------------------- 1 | # THIS IS A MACHINE-GENERATED FILE. DO NOT EDIT MANUALLY. 2 | 3 | [solution] 4 | [solution.context] 5 | solved = true 6 | [[solution.state]] 7 | crate = "libglfw3" 8 | fulfilment = "hinted" 9 | pinned = false 10 | transitivity = "direct" 11 | versions = "^3" 12 | [[solution.state]] 13 | crate = "openglada" 14 | fulfilment = "solved" 15 | pinned = false 16 | transitivity = "direct" 17 | versions = "~0.9.0" 18 | [solution.state.release] 19 | authors = [ 20 | "Felix Krause", 21 | ] 22 | description = "Thick Ada binding for OpenGL" 23 | licenses = "MIT" 24 | maintainers = [ 25 | "Felix Krause ", 26 | ] 27 | maintainers-logins = [ 28 | "flyx", 29 | ] 30 | name = "openglada" 31 | project-files = [ 32 | "opengl.gpr", 33 | ] 34 | version = "0.9.0" 35 | website = "http://flyx.github.io/OpenGLAda/" 36 | [solution.state.release.gpr-externals] 37 | Auto_Exceptions = [ 38 | "enabled", 39 | "disabled", 40 | ] 41 | Mode = [ 42 | "debug", 43 | "release", 44 | ] 45 | [solution.state.release.gpr-set-externals] 46 | Windowing_System = "quartz" 47 | [solution.state.release.origin] 48 | hashes = [ 49 | "sha512:4deb7effa92ea06c1fc9595700223b8169a85c15c4caf78221d2cfa95205260b5ba6d132d070b3f25d07549a6c9a8cde3b6405631a7d1ff487af8292c44a10e2", 50 | ] 51 | url = "https://github.com/flyx/OpenGLAda/releases/download/v0.9.0/openglada-0.9.0.tgz" 52 | 53 | -------------------------------------------------------------------------------- /opengl-glfw/alire.toml: -------------------------------------------------------------------------------- 1 | name = "openglada_glfw" 2 | description = "GLFW binding for use with OpenGLAda" 3 | version = "0.9.0" 4 | website = "http://flyx.github.io/OpenGLAda/" 5 | authors = ["Felix Krause"] 6 | licenses = "MIT" 7 | maintainers = ["Felix Krause "] 8 | maintainers-logins = ["flyx"] 9 | project-files = ["opengl-glfw.gpr"] 10 | tags = ["opengl", "glfw", "binding", "gui"] 11 | 12 | [[depends-on]] 13 | openglada = "~0.9.0" 14 | libglfw3 = "^3.3" 15 | -------------------------------------------------------------------------------- /opengl-glfw/opengl-glfw.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | 3 | library project OpenGL.Glfw is 4 | for Languages use ("ada"); 5 | 6 | for Library_Name use "GlfwAda"; 7 | for Library_Kind use OpenGL'Library_Kind; 8 | 9 | GLFW_Sources := ("src"); 10 | 11 | Default_GLFW_Linker_Param := ""; 12 | case OpenGL.Windowing_System is 13 | when "windows" => 14 | Default_GLFW_Linker_Param := "-lglfw3"; 15 | when "x11" | "quartz" => 16 | Default_GLFW_Linker_Param := "-lglfw"; 17 | end case; 18 | 19 | GLFW_Lib := external ("GLFW_Linker_Param", Default_GLFW_Linker_Param); 20 | 21 | for Source_Dirs use GLFW_Sources; 22 | for Object_Dir use "obj"; 23 | for Library_Dir use "lib"; 24 | 25 | package Ide renames OpenGL.Ide; 26 | package Builder renames OpenGL.Builder; 27 | package Compiler renames OpenGL.Compiler; 28 | 29 | package Linker is 30 | case OpenGL.Windowing_System is 31 | when "quartz" => 32 | for Linker_Options use 33 | (GLFW_Lib, "-Wl,-framework,Cocoa,-framework,IOKit"); 34 | when "windows" => 35 | for Linker_Options use (GLFW_Lib, "-lwinmm", "-lgdi32"); 36 | when "x11" => 37 | -- -lX11 is already set in opengl.gpr 38 | for Linker_Options use 39 | (GLFW_Lib, "-pthread", "-lm", "-lXcursor", "-lXxf86vm", 40 | "-lXrandr", "-lXinerama", "-lXi", "-ldl"); 41 | end case; 42 | end Linker; 43 | 44 | package Binder renames OpenGL.Binder; 45 | end OpenGL.Glfw; 46 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-errors.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C.Strings; 5 | 6 | with Glfw.API; 7 | 8 | package body Glfw.Errors is 9 | 10 | Cur_Callback : Callback := null; 11 | 12 | procedure Raw_Handler (Code : Kind; 13 | Description : Interfaces.C.Strings.chars_ptr); 14 | pragma Convention (C, Raw_Handler); 15 | 16 | procedure Raw_Handler (Code : Kind; 17 | Description : Interfaces.C.Strings.chars_ptr) is 18 | begin 19 | if Cur_Callback /= null then 20 | Cur_Callback.all (Code, Interfaces.C.Strings.Value (Description)); 21 | end if; 22 | end Raw_Handler; 23 | 24 | procedure Set_Callback (Handler : Callback) is 25 | Previous : API.Error_Callback; 26 | pragma Warnings (Off, Previous); 27 | begin 28 | Cur_Callback := Handler; 29 | if Handler = null then 30 | Previous := API.Set_Error_Callback (null); 31 | else 32 | Previous := API.Set_Error_Callback (Raw_Handler'Access); 33 | end if; 34 | end Set_Callback; 35 | 36 | end Glfw.Errors; 37 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-errors.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw.Errors is 5 | type Kind is (Not_Initialized, 6 | No_Current_Context, 7 | Invalid_Enum, 8 | Invalid_Value, 9 | Out_Of_Memory, 10 | API_Unavailable, 11 | Version_Unavailable, 12 | Platform_Error, 13 | Format_Unavailable); 14 | for Kind use (Not_Initialized => 16#00010001#, 15 | No_Current_Context => 16#00010002#, 16 | Invalid_Enum => 16#00010003#, 17 | Invalid_Value => 16#00010004#, 18 | Out_Of_Memory => 16#00010005#, 19 | API_Unavailable => 16#00010006#, 20 | Version_Unavailable => 16#00010007#, 21 | Platform_Error => 16#00010008#, 22 | Format_Unavailable => 16#00010009#); 23 | for Kind'Size use Interfaces.C.int'Size; 24 | 25 | type Callback is access procedure (Error : Kind; Description : String); 26 | 27 | procedure Set_Callback (Handler : Callback); 28 | end Glfw.Errors; 29 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input-joysticks.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.API; 5 | 6 | package body Glfw.Input.Joysticks is 7 | 8 | function Index (Source : Joystick) return Joystick_Index is 9 | begin 10 | return Enums.Joystick_ID'Pos (Source.Raw_Index) + 1; 11 | end Index; 12 | 13 | procedure Set_Index (Target : in out Joystick; Value : Joystick_Index) is 14 | begin 15 | Target.Raw_Index := Enums.Joystick_ID'Val (Value - 1); 16 | end Set_Index; 17 | 18 | function Present (Source : Joystick) return Boolean is 19 | begin 20 | return Boolean (API.Joystick_Present (Source.Raw_Index)); 21 | end Present; 22 | 23 | function Positions (Source : Joystick) return Axis_Positions is 24 | Count : aliased Interfaces.C.int; 25 | Raw : constant API.Axis_Position_List_Pointers.Pointer 26 | := API.Get_Joystick_Axes (Source.Raw_Index, Count'Access); 27 | begin 28 | return API.Axis_Position_List_Pointers.Value 29 | (Raw, Interfaces.C.ptrdiff_t (Count)); 30 | end Positions; 31 | 32 | function Button_States (Source : Joystick) return Joystick_Button_States is 33 | Count : aliased Interfaces.C.int; 34 | Raw : constant API.Joystick_Button_State_List_Pointers.Pointer 35 | := API.Get_Joystick_Buttons (Source.Raw_Index, Count'Access); 36 | begin 37 | return API.Joystick_Button_State_List_Pointers.Value 38 | (Raw, Interfaces.C.ptrdiff_t (Count)); 39 | end Button_States; 40 | 41 | end Glfw.Input.Joysticks; 42 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input-joysticks.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with Glfw.Enums; 5 | 6 | package Glfw.Input.Joysticks is 7 | use type Interfaces.C.C_float; 8 | 9 | -- GLFW supports up to 16 joysticks; they are indexed from 1 to 16. 10 | type Joystick_Index is range 1 .. 16; 11 | 12 | -- A Joystick object will link to the first joystick by default. 13 | type Joystick is tagged private; 14 | 15 | type Axis_Position is new Interfaces.C.C_float range -1.0 .. 1.0; 16 | type Axis_Positions is array (Positive range <>) of aliased Axis_Position; 17 | 18 | type Joystick_Button_State is new Button_State; 19 | type Joystick_Button_States is array (Positive range <>) of 20 | aliased Joystick_Button_State; 21 | 22 | function Index (Source : Joystick) return Joystick_Index; 23 | procedure Set_Index (Target : in out Joystick; Value : Joystick_Index); 24 | 25 | function Present (Source : Joystick) return Boolean; 26 | 27 | function Positions (Source : Joystick) return Axis_Positions; 28 | function Button_States (Source : Joystick) return Joystick_Button_States; 29 | 30 | private 31 | type Joystick is tagged record 32 | Raw_Index : Enums.Joystick_ID := Enums.Joystick_1; 33 | end record; 34 | 35 | for Joystick_Button_State'Size use Interfaces.C.char'Size; 36 | end Glfw.Input.Joysticks; 37 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input-mouse.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.API; 5 | 6 | package body Glfw.Input.Mouse is 7 | 8 | function Raw_Motion_Supported return Boolean is 9 | begin 10 | return Boolean (API.Raw_Mouse_Motion_Supported); 11 | end Raw_Motion_Supported; 12 | 13 | end Glfw.Input.Mouse; 14 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input-mouse.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw.Input.Mouse is 5 | 6 | type Button is new Interfaces.C.int range 0 .. 7; 7 | 8 | type Enter_Action is (Leaving, Entering); 9 | 10 | type Cursor_Mode is (Normal, Hidden, Disabled); 11 | 12 | Left_Button : constant := 0; 13 | Right_Button : constant := 1; 14 | Middle_Button : constant := 2; 15 | 16 | subtype Coordinate is Interfaces.C.double; 17 | subtype Scroll_Offset is Interfaces.C.double; 18 | 19 | function Raw_Motion_Supported return Boolean; 20 | 21 | private 22 | for Button'Size use Interfaces.C.int'Size; 23 | 24 | for Enter_Action use (Leaving => 0, 25 | Entering => 1); 26 | for Enter_Action'Size use C.int'Size; 27 | 28 | for Cursor_Mode use (Normal => 16#34001#, 29 | Hidden => 16#34002#, 30 | Disabled => 16#34003#); 31 | for Cursor_Mode'Size use Interfaces.C.int'Size; 32 | end Glfw.Input.Mouse; 33 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.API; 5 | 6 | package body Glfw.Input is 7 | 8 | procedure Poll_Events renames API.Poll_Events; 9 | 10 | procedure Wait_For_Events renames API.Wait_Events; 11 | 12 | end Glfw.Input; 13 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-input.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw.Input is 5 | type Button_State is (Released, Pressed); 6 | 7 | type Sticky_Toggle is (Sticky_Keys, Sticky_Mouse_Buttons); 8 | 9 | procedure Poll_Events; 10 | procedure Wait_For_Events; 11 | private 12 | for Button_State use (Released => 0, Pressed => 1); 13 | for Button_State'Size use Interfaces.C.int'Size; 14 | 15 | for Sticky_Toggle use (Sticky_Keys => 16#33002#, 16 | Sticky_Mouse_Buttons => 16#33003#); 17 | for Sticky_Toggle'Size use Interfaces.C.int'Size; 18 | 19 | -- just so we can implement them with rename 20 | pragma Convention (C, Poll_Events); 21 | pragma Convention (C, Wait_For_Events); 22 | 23 | end Glfw.Input; 24 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-monitors.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with System; 5 | 6 | package Glfw.Monitors is 7 | 8 | type Event is (Connected, Disconnected); 9 | 10 | type Video_Mode is record 11 | Width, Height : Interfaces.C.int; 12 | Red_Bits, Green_Bits, Blue_Bits : Interfaces.C.int; 13 | Refresh_Rate : Interfaces.C.int; 14 | end record; 15 | 16 | type Gamma_Value_Array is array (Positive range <>) of aliased 17 | Interfaces.C.unsigned_short; 18 | 19 | type Gamma_Ramp (Size : Positive) is record 20 | Red, Green, Blue : Gamma_Value_Array (1 .. Size); 21 | end record; 22 | 23 | type Monitor is tagged private; 24 | 25 | No_Monitor : constant Monitor; 26 | 27 | type Monitor_List is array (Positive range <>) of Monitor; 28 | type Video_Mode_List is array (Positive range <>) of aliased Video_Mode; 29 | 30 | pragma Convention (C, Video_Mode); 31 | pragma Convention (C, Video_Mode_List); 32 | 33 | function Monitors return Monitor_List; 34 | function Primary_Monitor return Monitor; 35 | 36 | procedure Get_Position (Object : Monitor; X, Y : out Integer); 37 | procedure Get_Physical_Size (Object : Monitor; Width, Height : out Integer); 38 | function Name (Object : Monitor) return String; 39 | function Video_Modes (Object : Monitor) return Video_Mode_List; 40 | function Current_Video_Mode (Object : Monitor) return Video_Mode; 41 | procedure Set_Gamma (Object : Monitor; Gamma : Float); 42 | function Current_Gamma_Ramp (Object : Monitor) return Gamma_Ramp; 43 | procedure Set_Gamma_Ramp (Object : Monitor; Value : Gamma_Ramp); 44 | 45 | -- used internally 46 | function Raw_Pointer (Object : Monitor) return System.Address; 47 | private 48 | type Monitor is tagged record 49 | Handle : System.Address; 50 | end record; 51 | 52 | No_Monitor : constant Monitor := (Handle => System.Null_Address); 53 | 54 | for Event use (Connected => 16#00040001#, 55 | Disconnected => 16#00040002#); 56 | for Event'Size use Interfaces.C.int'Size; 57 | 58 | 59 | end Glfw.Monitors; 60 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-windows-clipboard.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C.Strings; 5 | 6 | with Glfw.API; 7 | 8 | package body Glfw.Windows.Clipboard is 9 | 10 | function Get (Object : not null access Window'Class) return String is 11 | use type Interfaces.C.Strings.chars_ptr; 12 | 13 | Raw : constant Interfaces.C.Strings.chars_ptr 14 | := API.Get_Clipboard_String (Object.Handle); 15 | begin 16 | if Raw = Interfaces.C.Strings.Null_Ptr then 17 | raise Operation_Exception with "Could not get clipboard string"; 18 | end if; 19 | return Interfaces.C.Strings.Value (Raw); 20 | end Get; 21 | 22 | procedure Set (Object : not null access Window'Class; Value : String) is 23 | begin 24 | API.Set_Clipboard_String (Object.Handle, Interfaces.C.To_C (Value)); 25 | end Set; 26 | 27 | end Glfw.Windows.Clipboard; 28 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-windows-clipboard.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw.Windows.Clipboard is 5 | -- strings are UTF-8 encoded 6 | 7 | function Get (Object : not null access Window'Class) return String; 8 | 9 | procedure Set (Object : not null access Window'Class; Value : String); 10 | end Glfw.Windows.Clipboard; 11 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-windows-context.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.API; 5 | with Glfw.Enums; 6 | 7 | package body Glfw.Windows.Context is 8 | 9 | procedure Make_Current (Window : access Glfw.Windows.Window'Class) is 10 | begin 11 | if not Window.Initialized then 12 | -- null is accepted to detach the current context, but an uninitialized 13 | -- window *should* lead to an exception instead of detaching the 14 | -- context, so we handle this here 15 | raise Operation_Exception with "Window not initialized"; 16 | end if; 17 | if Window = null then 18 | API.Make_Context_Current (System.Null_Address); 19 | else 20 | API.Make_Context_Current (Window.Handle); 21 | end if; 22 | end Make_Current; 23 | 24 | function Current return access Glfw.Windows.Window'Class is 25 | use type System.Address; 26 | 27 | Raw : constant System.Address := API.Get_Current_Context; 28 | begin 29 | if Raw = System.Null_Address then 30 | return null; 31 | else 32 | return Window_Ptr (Raw); 33 | end if; 34 | end Current; 35 | 36 | procedure Swap_Buffers (Window : not null access Glfw.Windows.Window'Class) is 37 | begin 38 | API.Swap_Buffers (Window.Handle); 39 | end Swap_Buffers; 40 | 41 | procedure Set_Swap_Interval (Value : Swap_Interval) renames 42 | API.Swap_Interval; 43 | 44 | function Client_API (Window : not null access Glfw.Windows.Window'Class) 45 | return API_Kind is 46 | begin 47 | return API.Get_Window_Attrib (Window.Handle, Enums.Client_API); 48 | end Client_API; 49 | 50 | function Profile (Window : not null access Glfw.Windows.Window'Class) 51 | return OpenGL_Profile_Kind is 52 | begin 53 | return API.Get_Window_Attrib (Window.Handle, Enums.OpenGL_Profile); 54 | end Profile; 55 | 56 | procedure Get_Context_Version 57 | (Window : not null access Glfw.Windows.Window'Class; 58 | Major : out Positive; 59 | Minor, Revision : out Natural) is 60 | begin 61 | Major := Positive (Interfaces.C.int'( 62 | (API.Get_Window_Attrib (Window.Handle, Enums.Context_Version_Major)))); 63 | Minor := Natural (Interfaces.C.int'( 64 | (API.Get_Window_Attrib (Window.Handle, Enums.Context_Version_Minor)))); 65 | Revision := Natural (Interfaces.C.int'( 66 | (API.Get_Window_Attrib (Window.Handle, Enums.Context_Revision)))); 67 | end Get_Context_Version; 68 | 69 | function Is_Forward_Compat 70 | (Window : not null access Glfw.Windows.Window'Class) return Boolean is 71 | begin 72 | return Boolean (Bool'(API.Get_Window_Attrib 73 | (Window.Handle, Enums.OpenGL_Forward_Compat))); 74 | end Is_Forward_Compat; 75 | 76 | function Is_Debug_Context 77 | (Window : not null access Glfw.Windows.Window'Class) return Boolean is 78 | begin 79 | return Boolean (Bool'(API.Get_Window_Attrib 80 | (Window.Handle, Enums.OpenGL_Debug_Context))); 81 | end Is_Debug_Context; 82 | 83 | function Robustness (Window : not null access Glfw.Windows.Window'Class) 84 | return Robustness_Kind is 85 | begin 86 | return API.Get_Window_Attrib (Window.Handle, Enums.Context_Robustness); 87 | end Robustness; 88 | 89 | end Glfw.Windows.Context; 90 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-windows-context.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw.Windows.Context is 5 | 6 | type OpenGL_Profile_Kind is (System_Default, Core_Profile, Compat_Profile); 7 | type API_Kind is (OpenGL, OpenGL_ES); 8 | type Robustness_Kind is (No_Robustness, No_Reset_Notification, 9 | Lose_Context_On_Reset); 10 | 11 | subtype Swap_Interval is Interfaces.C.int; 12 | 13 | procedure Make_Current (Window : access Glfw.Windows.Window'Class); 14 | 15 | function Current return access Glfw.Windows.Window'Class; 16 | 17 | procedure Swap_Buffers (Window : not null access Glfw.Windows.Window'Class); 18 | 19 | procedure Set_Swap_Interval (Value : Swap_Interval); 20 | 21 | function Client_API (Window : not null access Glfw.Windows.Window'Class) 22 | return API_Kind; 23 | 24 | function Profile (Window : not null access Glfw.Windows.Window'Class) 25 | return OpenGL_Profile_Kind; 26 | 27 | procedure Get_Context_Version 28 | (Window : not null access Glfw.Windows.Window'Class; 29 | Major : out Positive; 30 | Minor, Revision : out Natural); 31 | 32 | function Is_Forward_Compat 33 | (Window : not null access Glfw.Windows.Window'Class) return Boolean; 34 | 35 | function Is_Debug_Context 36 | (Window : not null access Glfw.Windows.Window'Class) return Boolean; 37 | 38 | function Robustness (Window : not null access Glfw.Windows.Window'Class) 39 | return Robustness_Kind; 40 | 41 | private 42 | for OpenGL_Profile_Kind use (System_Default => 0, 43 | Core_Profile => 16#32001#, 44 | Compat_Profile => 16#32002#); 45 | for OpenGL_Profile_Kind'Size use Interfaces.C.int'Size; 46 | 47 | for API_Kind use (OpenGL => 16#30001#, 48 | OpenGL_ES => 16#30002#); 49 | for API_Kind'Size use Interfaces.C.int'Size; 50 | 51 | for Robustness_Kind use (No_Robustness => 0, 52 | No_Reset_Notification => 16#31001#, 53 | Lose_Context_On_Reset => 16#31002#); 54 | for Robustness_Kind'Size use Interfaces.C.int'Size; 55 | 56 | -- implemented with renames 57 | pragma Convention (C, Set_Swap_Interval); 58 | end Glfw.Windows.Context; 59 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw-windows-hints.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.Windows.Context; 5 | 6 | package Glfw.Windows.Hints is 7 | 8 | procedure Reset_To_Defaults; 9 | 10 | ----------------------------------------------------------------------------- 11 | -- Window related 12 | ----------------------------------------------------------------------------- 13 | 14 | procedure Set_Resizable (Value : Boolean); 15 | procedure Set_Visible (Value : Boolean); 16 | procedure Set_Decorated (Value : Boolean); 17 | procedure Set_Focused (Value : Boolean); 18 | procedure Set_Auto_Iconify (Value : Boolean); 19 | procedure Set_Floating (Value : Boolean); 20 | procedure Set_Maximized (Value : Boolean); 21 | procedure Set_Center_Cursor (Value : Boolean); 22 | procedure Set_Transparent_Framebuffer (Value : Boolean); 23 | procedure Set_Focus_On_Show (Value : Boolean); 24 | procedure Set_Scale_To_Monitor (Value : Boolean); 25 | 26 | ----------------------------------------------------------------------------- 27 | -- Framebuffer related 28 | ----------------------------------------------------------------------------- 29 | 30 | procedure Set_Color_Bits (Red, Green, Blue, Alpha : Natural); 31 | 32 | procedure Set_Depth_Bits (Value : Natural); 33 | procedure Set_Stencil_Bits (Value : Natural); 34 | 35 | procedure Set_Accumulation_Bits (Red, Green, Blue, Alpha : Natural); 36 | 37 | procedure Set_Aux_Buffers (Value : Natural); 38 | 39 | procedure Set_Stereo (Value : Boolean); 40 | 41 | procedure Set_Samples (Value : Natural); 42 | 43 | procedure Set_SRGB_Capable (Value : Boolean); 44 | 45 | procedure Set_Doublebuffer (Value : Boolean); 46 | 47 | ----------------------------------------------------------------------------- 48 | -- Monitor related 49 | ----------------------------------------------------------------------------- 50 | 51 | procedure Set_Refresh_Rate (Value : Natural); 52 | 53 | ----------------------------------------------------------------------------- 54 | -- Context related 55 | ----------------------------------------------------------------------------- 56 | 57 | procedure Set_Client_API (Value : Context.API_Kind); 58 | 59 | procedure Set_Minimum_OpenGL_Version (Major : Positive; Minor : Natural); 60 | 61 | procedure Set_Robustness (Value : Context.Robustness_Kind); 62 | 63 | procedure Set_Forward_Compat (Value : Boolean); 64 | 65 | procedure Set_Debug_Context (Value : Boolean); 66 | 67 | procedure Set_Profile (Value : Context.OpenGL_Profile_Kind); 68 | private 69 | -- to be able to use renames 70 | pragma Convention (C, Reset_To_Defaults); 71 | end Glfw.Windows.Hints; 72 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.API; 5 | 6 | with Interfaces.C.Strings; 7 | 8 | package body Glfw is 9 | use type Interfaces.C.int; 10 | 11 | procedure Init is 12 | begin 13 | if API.Init = 0 then 14 | raise Initialization_Exception; 15 | end if; 16 | end Init; 17 | 18 | procedure Shutdown is 19 | begin 20 | API.Glfw_Terminate; 21 | end Shutdown; 22 | 23 | procedure Version (Major, Minor, Rev : out Natural) is 24 | Raw_Major, Raw_Minor, Raw_Rev : C.int; 25 | begin 26 | API.Get_Version (Raw_Major, Raw_Minor, Raw_Rev); 27 | Major := Natural (Raw_Major); 28 | Minor := Natural (Raw_Minor); 29 | Rev := Natural (Raw_Rev); 30 | end Version; 31 | 32 | function Version_String return String is 33 | begin 34 | return Interfaces.C.Strings.Value (API.Get_Version_String); 35 | end Version_String; 36 | 37 | function Time return Seconds is 38 | begin 39 | return API.Get_Time; 40 | end Time; 41 | 42 | procedure Set_Time (Value : Seconds) is 43 | begin 44 | API.Set_Time (Value); 45 | end Set_Time; 46 | 47 | function Extension_Supported (Name : String) return Boolean is 48 | begin 49 | return Boolean (API.Extension_Supported (Interfaces.C.To_C (Name))); 50 | end Extension_Supported; 51 | 52 | end Glfw; 53 | -------------------------------------------------------------------------------- /opengl-glfw/src/glfw.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C; 5 | 6 | package Glfw is 7 | 8 | subtype Seconds is Interfaces.C.double; 9 | 10 | subtype Size is Interfaces.C.int range 0 .. Interfaces.C.int'Last; 11 | 12 | Initialization_Exception : exception; 13 | Operation_Exception : exception; 14 | 15 | -- for convenience, besides executing GLFW's init procedures, this also calls 16 | -- GL.Init. 17 | procedure Init; 18 | 19 | -- because terminate is a keyword in Ada 20 | procedure Shutdown; 21 | 22 | procedure Version (Major, Minor, Rev : out Natural); 23 | 24 | function Version_String return String; 25 | 26 | 27 | function Time return Seconds; 28 | 29 | procedure Set_Time (Value : Seconds); 30 | 31 | 32 | function Extension_Supported (Name : String) return Boolean; 33 | 34 | private 35 | package C renames Interfaces.C; 36 | 37 | type Bool is new Boolean; 38 | 39 | for Bool use (False => 0, True => 1); 40 | for Bool'Size use C.int'Size; 41 | pragma Convention (C, Bool); 42 | 43 | end Glfw; 44 | -------------------------------------------------------------------------------- /opengl-images/alire.lock: -------------------------------------------------------------------------------- 1 | # THIS IS A MACHINE-GENERATED FILE. DO NOT EDIT MANUALLY. 2 | 3 | [solution] 4 | [solution.context] 5 | solved = true 6 | [[solution.state]] 7 | crate = "gid" 8 | fulfilment = "solved" 9 | pinned = false 10 | transitivity = "direct" 11 | versions = "^9.0.0" 12 | [solution.state.release] 13 | authors = [ 14 | "Gautier de Montmollin", 15 | ] 16 | description = "Decoding a broad variety of image formats" 17 | licenses = "MIT" 18 | maintainers = [ 19 | "fabien.chouteau@gmail.com", 20 | ] 21 | maintainers-logins = [ 22 | "zertovitch", 23 | "Fabien-Chouteau", 24 | ] 25 | name = "gid" 26 | project-files = [ 27 | "gid.gpr", 28 | ] 29 | version = "9.0.0" 30 | [solution.state.release.gpr-externals] 31 | Build_Mode = [ 32 | "Debug", 33 | "Fast_but_checked", 34 | "Fast", 35 | "Small", 36 | "Smallest", 37 | "Profiling", 38 | ] 39 | [solution.state.release.origin] 40 | hashes = [ 41 | "sha512:17722960f65382ce49dfde2ebe24b2adf1cd007ea9f170ec51d35c4a654ac78ddc3c1ba500e764e0c793d6f6aabb2c82a804a5570deb36a199f5b216c2c372e7", 42 | ] 43 | url = "https://sourceforge.net/projects/gen-img-dec/files/gid_009.zip" 44 | [[solution.state]] 45 | crate = "openglada" 46 | fulfilment = "solved" 47 | pinned = false 48 | transitivity = "direct" 49 | versions = "~0.9.0" 50 | [solution.state.release] 51 | authors = [ 52 | "Felix Krause", 53 | ] 54 | description = "Thick Ada binding for OpenGL" 55 | licenses = "MIT" 56 | maintainers = [ 57 | "Felix Krause ", 58 | ] 59 | maintainers-logins = [ 60 | "flyx", 61 | ] 62 | name = "openglada" 63 | project-files = [ 64 | "opengl.gpr", 65 | ] 66 | version = "0.9.0" 67 | website = "http://flyx.github.io/OpenGLAda/" 68 | [solution.state.release.gpr-externals] 69 | Auto_Exceptions = [ 70 | "enabled", 71 | "disabled", 72 | ] 73 | Mode = [ 74 | "debug", 75 | "release", 76 | ] 77 | [solution.state.release.gpr-set-externals] 78 | Windowing_System = "quartz" 79 | [solution.state.release.origin] 80 | hashes = [ 81 | "sha512:4deb7effa92ea06c1fc9595700223b8169a85c15c4caf78221d2cfa95205260b5ba6d132d070b3f25d07549a6c9a8cde3b6405631a7d1ff487af8292c44a10e2", 82 | ] 83 | url = "https://github.com/flyx/OpenGLAda/releases/download/v0.9.0/openglada-0.9.0.tgz" 84 | 85 | -------------------------------------------------------------------------------- /opengl-images/alire.toml: -------------------------------------------------------------------------------- 1 | name = "openglada_images" 2 | description = "Image loading library for OpenGLAda" 3 | version = "0.9.0" 4 | website = "http://flyx.github.io/OpenGLAda/" 5 | authors = ["Felix Krause"] 6 | licenses = "MIT" 7 | maintainers = ["Felix Krause "] 8 | maintainers-logins = ["flyx"] 9 | project-files = ["opengl-images.gpr"] 10 | tags = ["opengl", "rendering", "graphics"] 11 | 12 | [[depends-on]] 13 | gid = "^9.0.0" 14 | openglada = "~0.9.0" 15 | -------------------------------------------------------------------------------- /opengl-images/opengl-images.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "gid"; 3 | 4 | library project OpenGL.Images is 5 | for Languages use ("ada"); 6 | for Library_Name use "OpenGLAda_Images"; 7 | for Source_Dirs use ("src"); 8 | for Object_Dir use "obj"; 9 | for Library_Dir use "lib"; 10 | 11 | package Builder renames OpenGL.Builder; 12 | package Compiler renames OpenGL.Compiler; 13 | package Binder renames OpenGL.Binder; 14 | end OpenGL.Images; 15 | -------------------------------------------------------------------------------- /opengl-images/src/gl-images.ads: -------------------------------------------------------------------------------- 1 | with Ada.Streams; 2 | with GL.Objects.Textures; 3 | with GL.Pixels; 4 | 5 | package GL.Images is 6 | -- This procedure loads the contents of the given Source to the given 7 | -- texture object. 8 | -- The texture object will be initialized if it is uninitialized. 9 | -- The texture's image is created with the given internal format. 10 | -- 11 | -- The image type is determined from its signature. TGA images do not have a 12 | -- signature, so if the source contains TGA data, you need to set Try_TGA to 13 | -- True. 14 | -- 15 | -- If the given Texture_Format contains components with more than 8 bits, 16 | -- the image is loaded with 16-bit components before it is given to OpenGL. 17 | procedure Load_Image_To_Texture ( 18 | Source : in out Ada.Streams.Root_Stream_Type'Class; 19 | Texture : in out GL.Objects.Textures.Texture'Class; 20 | Texture_Format : GL.Pixels.Internal_Format; 21 | Try_TGA : Boolean := False); 22 | 23 | -- Like Load_Image_To_Texture, but takes the path to a file as input. 24 | procedure Load_File_To_Texture ( 25 | Path : String; 26 | Texture : in out GL.Objects.Textures.Texture'Class; 27 | Texture_Format : GL.Pixels.Internal_Format; 28 | Try_TGA : Boolean := False); 29 | end GL.Images; -------------------------------------------------------------------------------- /opengl-text/alire.lock: -------------------------------------------------------------------------------- 1 | # THIS IS A MACHINE-GENERATED FILE. DO NOT EDIT MANUALLY. 2 | 3 | [solution] 4 | [solution.context] 5 | solved = true 6 | [[solution.state]] 7 | crate = "freetypeada" 8 | fulfilment = "solved" 9 | pinned = false 10 | transitivity = "direct" 11 | versions = "~0.1.0" 12 | [solution.state.release] 13 | authors = [ 14 | "Felix Krause", 15 | ] 16 | description = "Thick binding to the FreeType library" 17 | licenses = "MIT" 18 | maintainers = [ 19 | "Felix Krause ", 20 | ] 21 | maintainers-logins = [ 22 | "flyx", 23 | ] 24 | name = "freetypeada" 25 | project-files = [ 26 | "freetype.gpr", 27 | ] 28 | tags = [ 29 | "fonts", 30 | "rendering", 31 | ] 32 | version = "0.1.0" 33 | website = "https://github.com/flyx/FreeTypeAda" 34 | [solution.state.release.gpr-set-externals] 35 | FreeType_Linker_Param = "-lfreetype" 36 | [solution.state.release.origin] 37 | commit = "4fd90f573dc83a9b23e462520a60eb6a8dd92878" 38 | url = "git+https://github.com/flyx/FreeTypeAda.git" 39 | [[solution.state]] 40 | crate = "openglada" 41 | fulfilment = "solved" 42 | pinned = false 43 | transitivity = "direct" 44 | versions = "~0.9.0" 45 | [solution.state.release] 46 | authors = [ 47 | "Felix Krause", 48 | ] 49 | description = "Thick Ada binding for OpenGL" 50 | licenses = "MIT" 51 | maintainers = [ 52 | "Felix Krause ", 53 | ] 54 | maintainers-logins = [ 55 | "flyx", 56 | ] 57 | name = "openglada" 58 | project-files = [ 59 | "opengl.gpr", 60 | ] 61 | version = "0.9.0" 62 | website = "http://flyx.github.io/OpenGLAda/" 63 | [solution.state.release.gpr-externals] 64 | Auto_Exceptions = [ 65 | "enabled", 66 | "disabled", 67 | ] 68 | Mode = [ 69 | "debug", 70 | "release", 71 | ] 72 | [solution.state.release.gpr-set-externals] 73 | Windowing_System = "quartz" 74 | [solution.state.release.origin] 75 | hashes = [ 76 | "sha512:4deb7effa92ea06c1fc9595700223b8169a85c15c4caf78221d2cfa95205260b5ba6d132d070b3f25d07549a6c9a8cde3b6405631a7d1ff487af8292c44a10e2", 77 | ] 78 | url = "https://github.com/flyx/OpenGLAda/releases/download/v0.9.0/openglada-0.9.0.tgz" 79 | 80 | -------------------------------------------------------------------------------- /opengl-text/alire.toml: -------------------------------------------------------------------------------- 1 | name = "openglada_text" 2 | description = "Text rendering library for OpenGLAda" 3 | version = "0.9.0" 4 | website = "http://flyx.github.io/OpenGLAda/" 5 | authors = ["Felix Krause"] 6 | licenses = "MIT" 7 | maintainers = ["Felix Krause "] 8 | maintainers-logins = ["flyx"] 9 | project-files = ["opengl-text.gpr"] 10 | tags = ["opengl", "rendering", "fonts"] 11 | 12 | [[depends-on]] 13 | openglada = "~0.9.0" 14 | freetypeada = "~0.1.0" 15 | 16 | -------------------------------------------------------------------------------- /opengl-text/opengl-text.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "freetype"; 3 | 4 | library project OpenGL.Text is 5 | for Languages use ("ada"); 6 | for Library_Name use "OpenGLAda_Text"; 7 | for Source_Dirs use ("src"); 8 | for Object_Dir use "obj"; 9 | for Library_Dir use "lib"; 10 | 11 | package Builder renames OpenGL.Builder; 12 | package Compiler renames OpenGL.Compiler; 13 | package Binder renames OpenGL.Binder; 14 | end OpenGL.Text; 15 | -------------------------------------------------------------------------------- /opengl-text/src/gl-text-utf8.adb: -------------------------------------------------------------------------------- 1 | package body GL.Text.UTF8 is 2 | type Byte is mod 2**8; 3 | 4 | subtype Surrogate_Halves is UTF8_Code_Point range 16#D800# .. 16#DFFF#; 5 | 6 | procedure Read (Buffer : String; Position : in out Positive; 7 | Result : out UTF8_Code_Point) is 8 | Cur : Byte := Character'Pos (Buffer (Position)); 9 | Additional_Bytes : Positive; 10 | begin 11 | if (Cur and 2#10000000#) = 0 then 12 | Result := UTF8_Code_Point (Cur); 13 | Position := Position + 1; 14 | return; 15 | elsif (Cur and 2#01000000#) = 0 then 16 | raise Rendering_Error with "Encoding error at code point starting byte" 17 | & Position'Img; 18 | elsif (Cur and 2#00100000#) = 0 then 19 | Additional_Bytes := 1; 20 | Result := UTF8_Code_Point (Cur and 2#00011111#) * 2**6; 21 | elsif (Cur and 2#00010000#) = 0 then 22 | Additional_Bytes := 2; 23 | Result := UTF8_Code_Point (Cur and 2#00001111#) * 2**12; 24 | elsif (Cur and 2#00001000#) = 0 then 25 | Additional_Bytes := 3; 26 | Result := UTF8_Code_Point (Cur and 2#00000111#) * 2**18; 27 | else 28 | raise Rendering_Error with "Encoding error at code point starting byte" 29 | & Position'Img; 30 | end if; 31 | for Index in 1 .. Additional_Bytes loop 32 | Cur := Character'Pos (Buffer (Position + Index)); 33 | if (Cur and 2#11000000#) /= 2#10000000# then 34 | raise Rendering_Error with 35 | "Encoding error at code point continuation byte" & 36 | Positive'Image (Position + Index); 37 | end if; 38 | Result := Result + UTF8_Code_Point (Cur and 2#00111111#) * 39 | 2**(6 * (Additional_Bytes - Index)); 40 | end loop; 41 | if Result in Surrogate_Halves then 42 | raise Rendering_Error with 43 | "Surrogate half not valid in UTF-8 at position" & Position'Img; 44 | end if; 45 | Position := Position + Additional_Bytes + 1; 46 | end Read; 47 | end GL.Text.UTF8; 48 | -------------------------------------------------------------------------------- /opengl-text/src/gl-text-utf8.ads: -------------------------------------------------------------------------------- 1 | private package GL.Text.UTF8 is 2 | type Code_Point is mod 2**32; 3 | subtype UTF8_Code_Point is Code_Point range 0 .. 16#10FFFF#; 4 | 5 | procedure Read (Buffer : String; Position : in out Positive; 6 | Result : out UTF8_Code_Point); 7 | end GL.Text.UTF8; 8 | -------------------------------------------------------------------------------- /opengl/alire.lock: -------------------------------------------------------------------------------- 1 | # THIS IS A MACHINE-GENERATED FILE. DO NOT EDIT MANUALLY. 2 | 3 | [solution] 4 | [solution.context] 5 | solved = true 6 | 7 | -------------------------------------------------------------------------------- /opengl/alire.toml: -------------------------------------------------------------------------------- 1 | name = "openglada" 2 | description = "Thick Ada binding for OpenGL" 3 | version = "0.9.0" 4 | website = "http://flyx.github.io/OpenGLAda/" 5 | authors = ["Felix Krause"] 6 | licenses = "MIT" 7 | maintainers = ["Felix Krause "] 8 | maintainers-logins = ["flyx"] 9 | project-files = ["opengl.gpr"] 10 | tags = ["opengl", "binding", "rendering", "graphics"] 11 | 12 | [[depends-on]] 13 | [depends-on."case(os)".linux] 14 | libx11 = "^1" 15 | 16 | [gpr-externals] 17 | Auto_Exceptions = ["enabled", "disabled"] 18 | Mode = ["debug", "release"] 19 | 20 | [gpr-set-externals."case(os)"] 21 | linux = { Windowing_System = "x11" } 22 | macos = { Windowing_System = "quartz" } 23 | windows = { Windowing_System = "windows" } 24 | -------------------------------------------------------------------------------- /opengl/generate.gpr: -------------------------------------------------------------------------------- 1 | project Generate is 2 | -- this project compiles the generator used to autogenerate the OpenGL API 3 | -- imports. 4 | 5 | for Main use ("generate.adb"); 6 | for Source_Dirs use ("src/generator"); 7 | for Object_Dir use "obj"; 8 | for Library_Dir use "lib"; 9 | for Exec_Dir use "bin"; 10 | 11 | package Compiler is 12 | for Default_Switches ("Ada") use ("-gnat12", "-gnatwa"); 13 | end Compiler; 14 | end Generate; -------------------------------------------------------------------------------- /opengl/opengl.gpr: -------------------------------------------------------------------------------- 1 | library project OpenGL is 2 | ----------------------------------------------------------------------------- 3 | -- Scenario variables 4 | ----------------------------------------------------------------------------- 5 | 6 | -- Different operating systems need different linker 7 | -- flags. Moreover, some features (such as WGL, GLX, 8 | -- CGL) are only available on one specific platform. 9 | -- Supported values: 10 | -- * windows : Microsoft Windows 11 | -- * x11 : X Window System 12 | -- * quartz : Quartz Compositor (OS X) 13 | type Windowing_System_Type is 14 | ("windows", "x11", "quartz"); 15 | -- has a default so that the project can be opened in GPS. 16 | Windowing_System : Windowing_System_Type 17 | := external ("Windowing_System", "quartz"); 18 | 19 | type Mode_Type is ("debug", "release"); 20 | Mode : Mode_Type := external ("Mode", "debug"); 21 | 22 | type Toggle_Type is ("enabled", "disabled"); 23 | Auto_Exceptions : Toggle_Type := external ("Auto_Exceptions", "enabled"); 24 | 25 | type Library_Kinds is ("static", "relocatable"); 26 | Given_Library_Kind : Library_Kinds := external ("Library_Type", "static"); 27 | 28 | ----------------------------------------------------------------------------- 29 | -- Global configuration 30 | ----------------------------------------------------------------------------- 31 | 32 | for Languages use ("ada"); 33 | for Library_Name use "OpenGLAda"; 34 | 35 | OpenGL_Sources := ("src/interface", 36 | "src/implementation", 37 | "src/generated"); 38 | case Windowing_System is 39 | when "windows" => OpenGL_Sources := OpenGL_Sources & "src/windows"; 40 | when "x11" => OpenGL_Sources := OpenGL_Sources & "src/x11"; 41 | when "quartz" => OpenGL_Sources := OpenGL_Sources & "src/mac"; 42 | end case; 43 | 44 | case Auto_Exceptions is 45 | when "enabled" => OpenGL_Sources := 46 | OpenGL_Sources & "src/implementation/auto_exceptions"; 47 | when "disabled" => OpenGL_Sources := 48 | OpenGL_Sources & "src/implementation/no_auto_exceptions"; 49 | end case; 50 | 51 | for Source_Dirs use OpenGL_Sources; 52 | for Object_Dir use "obj"; 53 | for Library_Dir use "lib"; 54 | for Library_Kind use Given_Library_Kind; 55 | 56 | ----------------------------------------------------------------------------- 57 | -- Packages 58 | ----------------------------------------------------------------------------- 59 | 60 | package Ide is 61 | for Vcs_Kind use "Git"; 62 | end Ide; 63 | 64 | package Builder is 65 | case Mode is 66 | when "debug" => 67 | for Global_Compilation_Switches ("ada") use ("-s", "-g"); 68 | when "release" => 69 | for Global_Compilation_Switches ("ada") use ("-s"); 70 | end case; 71 | end Builder; 72 | 73 | package Compiler is 74 | Base_Switches := ("-gnat12", "-gnatwa", "-gnatwl", "-gnatwe", "-gnatwV", 75 | "-fstack-check", "-gnaty3abcefhiklmNprt"); 76 | case Mode is 77 | when "debug" => 78 | for Default_Switches ("ada") use Base_Switches & ("-E"); 79 | when "release" => 80 | for Default_Switches ("ada") use Base_Switches & ("-O3", "-gnatn2"); 81 | end case; 82 | end Compiler; 83 | 84 | package Linker is 85 | case Windowing_System is 86 | when "windows" => 87 | for Linker_Options use ("-lOpenGL32", "-lGdi32"); 88 | when "x11" => 89 | for Linker_Options use ("-lGL", "-lX11"); 90 | when "quartz" => 91 | for Linker_Options use 92 | ("-Wl,-framework,OpenGL,-framework,CoreFoundation"); 93 | end case; 94 | end Linker; 95 | 96 | package Binder is 97 | for Default_Switches ("ada") use ("-Es"); 98 | end Binder; 99 | 100 | end OpenGL; 101 | -------------------------------------------------------------------------------- /opengl/src/generated/gl-api-doubles.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | -- Autogenerated by Generate, do not edit 4 | package GL.API.Doubles is 5 | pragma Preelaborate; 6 | Vertex_Attrib1 : T1; 7 | Vertex_Attrib2 : T2; 8 | Vertex_Attrib2v : T3; 9 | Vertex_Attrib3 : T4; 10 | Vertex_Attrib3v : T5; 11 | Vertex_Attrib4 : T6; 12 | Vertex_Attrib4v : T7; 13 | end GL.API.Doubles; 14 | -------------------------------------------------------------------------------- /opengl/src/generated/gl-api-ints.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | -- Autogenerated by Generate, do not edit 4 | package GL.API.Ints is 5 | pragma Preelaborate; 6 | Uniform1 : T8; 7 | Uniform1v : T9; 8 | Uniform2 : T10; 9 | Uniform2v : T11; 10 | Uniform3 : T12; 11 | Uniform3v : T13; 12 | Uniform4 : T14; 13 | Uniform4v : T15; 14 | Uniform_Matrix2 : T16; 15 | Uniform_Matrix3 : T17; 16 | Uniform_Matrix4 : T18; 17 | Vertex_Attrib1 : T19; 18 | Vertex_Attrib2 : T20; 19 | Vertex_Attrib2v : T21; 20 | Vertex_Attrib3 : T22; 21 | Vertex_Attrib3v : T23; 22 | Vertex_Attrib4 : T24; 23 | Vertex_Attrib4v : T25; 24 | end GL.API.Ints; 25 | -------------------------------------------------------------------------------- /opengl/src/generated/gl-api-shorts.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | -- Autogenerated by Generate, do not edit 4 | package GL.API.Shorts is 5 | pragma Preelaborate; 6 | Vertex_Attrib1 : T26; 7 | Vertex_Attrib2 : T27; 8 | Vertex_Attrib2v : T28; 9 | Vertex_Attrib3 : T29; 10 | Vertex_Attrib3v : T30; 11 | Vertex_Attrib4 : T31; 12 | Vertex_Attrib4v : T32; 13 | end GL.API.Shorts; 14 | -------------------------------------------------------------------------------- /opengl/src/generated/gl-api-singles.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | -- Autogenerated by Generate, do not edit 4 | package GL.API.Singles is 5 | pragma Preelaborate; 6 | Uniform1 : T33; 7 | Uniform1v : T34; 8 | Uniform2 : T35; 9 | Uniform2v : T36; 10 | Uniform3 : T37; 11 | Uniform3v : T38; 12 | Uniform4 : T39; 13 | Uniform4v : T40; 14 | Uniform_Matrix2 : T41; 15 | Uniform_Matrix3 : T42; 16 | Uniform_Matrix4 : T43; 17 | Vertex_Attrib1 : T44; 18 | Vertex_Attrib2 : T45; 19 | Vertex_Attrib2v : T46; 20 | Vertex_Attrib3 : T47; 21 | Vertex_Attrib3v : T48; 22 | Vertex_Attrib4 : T49; 23 | Vertex_Attrib4v : T50; 24 | end GL.API.Singles; 25 | -------------------------------------------------------------------------------- /opengl/src/generated/gl-api-uints.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | -- Autogenerated by Generate, do not edit 4 | package GL.API.UInts is 5 | pragma Preelaborate; 6 | Uniform1 : T51; 7 | Uniform1v : T52; 8 | Uniform2 : T53; 9 | Uniform2v : T54; 10 | Uniform3 : T55; 11 | Uniform3v : T56; 12 | Uniform4 : T57; 13 | Uniform4v : T58; 14 | Uniform_Matrix2 : T59; 15 | Uniform_Matrix3 : T60; 16 | Uniform_Matrix4 : T61; 17 | Vertex_Attrib1 : T62; 18 | Vertex_Attrib2 : T63; 19 | Vertex_Attrib2v : T64; 20 | Vertex_Attrib3 : T65; 21 | Vertex_Attrib3v : T66; 22 | Vertex_Attrib4 : T67; 23 | Vertex_Attrib4v : T68; 24 | end GL.API.UInts; 25 | -------------------------------------------------------------------------------- /opengl/src/generator/generate.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Command_Line; 5 | with Ada.Containers.Indefinite_Vectors; 6 | with Ada.Directories; use Ada.Directories; 7 | with Ada.Exceptions; use Ada.Exceptions; 8 | with Ada.Text_IO; 9 | 10 | with Specs; 11 | 12 | procedure Generate is 13 | Proc : Specs.Processor; 14 | 15 | package Spec_Vectors is new Ada.Containers.Indefinite_Vectors 16 | (Positive, String); 17 | 18 | Spec_Paths : Spec_Vectors.Vector; 19 | package Path_Sorting is new Spec_Vectors.Generic_Sorting; 20 | 21 | Source_Folder : constant String := "src/specs"; 22 | Target_Folder : constant String := "src/generated"; 23 | Interface_Folder : constant String := "src/interface"; 24 | 25 | procedure Process_File (Directory_Entry : in Directory_Entry_Type) is 26 | Path : constant String := Full_Name (Directory_Entry); 27 | begin 28 | Ada.Text_IO.Put_Line ("Processing " & Path & " ..."); 29 | Spec_Paths.Append (Path); 30 | Ada.Text_IO.Put_Line ("Done processing " & Path & " ."); 31 | end Process_File; 32 | 33 | begin 34 | Search (Source_Folder, "*.spec", (Ordinary_File => True, others => False), 35 | Process_File'Access); 36 | Path_Sorting.Sort (Spec_Paths); 37 | for Path of Spec_Paths loop 38 | Specs.Parse_File (Proc, Path); 39 | end loop; 40 | 41 | Create_Path (Target_Folder); 42 | declare 43 | use type Specs.Spec; 44 | Cur : Specs.Spec := Specs.First (Proc); 45 | begin 46 | while Cur /= Specs.No_Spec loop 47 | Specs.Write_API (Proc, Cur, Target_Folder); 48 | Cur := Specs.Next (Proc, Cur); 49 | end loop; 50 | end; 51 | Specs.Write_Init (Proc, Target_Folder); 52 | Specs.Write_Wrapper_Table (Proc, Target_Folder, Interface_Folder); 53 | exception when Error : Specs.Parsing_Error => 54 | Ada.Text_IO.Put_Line (Exception_Message (Error)); 55 | Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure); 56 | end Generate; 57 | -------------------------------------------------------------------------------- /opengl/src/generator/specs.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with Ada.Containers.Vectors; 5 | private with Ada.Containers.Indefinite_Vectors; 6 | private with Ada.Strings.Unbounded; 7 | 8 | package Specs is 9 | -- This package implements parsing and applying .spec files. 10 | -- These are used to easily generate parts of the low-level OpenGL 11 | -- binding code. This package is not part of the OpenGLAda API nor 12 | -- implementation - it is only used for generating part of its 13 | -- source code. 14 | 15 | type Processor is limited private; 16 | type Spec is private; 17 | 18 | No_Spec : constant Spec; 19 | Parsing_Error : exception; 20 | 21 | procedure Parse_File (Proc : in out Processor; Path : String); 22 | 23 | function First (Proc : Processor) return Spec; 24 | 25 | function Next (Proc : Processor; Cur : Spec) return Spec; 26 | 27 | procedure Write_API (Proc : Processor; Cur : Spec; 28 | Dir_Path : String); 29 | 30 | procedure Write_Init (Proc : Processor; Dir_Path : String); 31 | 32 | procedure Write_Wrapper_Table (Proc : Processor; 33 | Dir_Path, Interface_Folder : String); 34 | private 35 | use Ada.Strings.Unbounded; 36 | 37 | type Param_Mode is 38 | (Mode_In, Mode_Out, Mode_In_Out, Mode_Access, Mode_Access_Constant); 39 | 40 | package String_Lists is new Ada.Containers.Indefinite_Vectors 41 | (Positive, String); 42 | 43 | type Parameter is record 44 | Mode : Param_Mode; 45 | Names : String_Lists.Vector; 46 | Type_Name : Unbounded_String; 47 | end record; 48 | 49 | package Param_Lists is new Ada.Containers.Vectors 50 | (Positive, Parameter); 51 | 52 | type Signature is record 53 | Params : Param_Lists.Vector; 54 | Return_Type : Unbounded_String; 55 | end record; 56 | 57 | package Sig_Lists is new Ada.Containers.Vectors (Positive, Signature); 58 | 59 | type Body_Item_Kind is (Copy, Static, Dynamic); 60 | 61 | type Body_Item (Kind : Body_Item_Kind) is record 62 | case Kind is 63 | when Copy => To_Copy : Unbounded_String; 64 | when Static => 65 | S_Name, S_GL_Name : Unbounded_String; 66 | Sigs : Sig_Lists.Vector; 67 | when Dynamic => 68 | D_Name, D_GL_Name : Unbounded_String; 69 | Sig_Id : Positive; 70 | end case; 71 | end record; 72 | 73 | package Item_Lists is 74 | new Ada.Containers.Indefinite_Vectors (Positive, Body_Item); 75 | 76 | package Wrapper_Lists is new Ada.Containers.Indefinite_Vectors 77 | (Positive, String_Lists.Vector, String_Lists."="); 78 | 79 | type Spec_Data is record 80 | Name, File_Base_Name : Unbounded_String; 81 | Withs : String_Lists.Vector; 82 | Uses : String_Lists.Vector; 83 | Items : Item_Lists.Vector; 84 | Wrappers : Wrapper_Lists.Vector; 85 | end record; 86 | 87 | type Spec is new Natural; 88 | subtype Valid_Spec is Spec range 1 .. Spec'Last; 89 | 90 | No_Spec : constant Spec := 0; 91 | 92 | package Spec_Lists is new Ada.Containers.Vectors (Valid_Spec, Spec_Data); 93 | 94 | type Processor is record 95 | Dynamic_Subprogram_Types : Sig_Lists.Vector; 96 | List : Spec_Lists.Vector; 97 | end record; 98 | end Specs; -------------------------------------------------------------------------------- /opengl/src/generator/tokenization.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Containers.Indefinite_Hashed_Maps; 5 | with Ada.Strings.Hash; 6 | 7 | package Tokenization is 8 | type Tokenizer (<>) is limited private; 9 | 10 | type Symbol_Id is new Positive; 11 | 12 | type Token_Kind is (Identifier, Numeric_Literal, String_Literal, 13 | Delimiter, Comment, Stream_End); 14 | 15 | type Token (Length : Natural; Kind : Token_Kind) is limited record 16 | Content : String (1 .. Length); 17 | Start : Positive; 18 | case Kind is 19 | when Identifier => 20 | Id : Symbol_Id; 21 | when others => null; 22 | end case; 23 | end record; 24 | 25 | Tokenization_Error : exception; 26 | 27 | function Tokenize (File_Path : String) return Tokenizer; 28 | 29 | function Next (Object : in out Tokenizer) return Token; 30 | 31 | function Paren_Depth (Object : Tokenizer) return Natural; 32 | 33 | function Line (Object : Tokenizer) return Positive; 34 | function Column (Object : Tokenizer) return Positive; 35 | 36 | function To_String (T : Token) return String; 37 | 38 | function Input_Substring (Object: Tokenizer; From, To : Token) return String; 39 | 40 | function Is_Keyword (Id : Symbol_Id) return Boolean; 41 | 42 | function Copy (T : Token) return Token; 43 | 44 | procedure Register_Symbol (Object : in out Tokenizer; Symbol : String; 45 | New_Id : out Symbol_Id); 46 | 47 | Keyword_Access : constant Symbol_Id := 1; 48 | Keyword_Constant : constant Symbol_Id := 2; 49 | Keyword_Dynamic : constant Symbol_Id := 3; 50 | Keyword_End : constant Symbol_Id := 4; 51 | Keyword_Function : constant Symbol_Id := 5; 52 | Keyword_In : constant Symbol_Id := 6; 53 | Keyword_Is : constant Symbol_Id := 7; 54 | Keyword_Out : constant Symbol_Id := 8; 55 | Keyword_Package : constant Symbol_Id := 9; 56 | Keyword_Pragma : constant Symbol_Id := 10; 57 | Keyword_Procedure : constant Symbol_Id := 11; 58 | Keyword_Return : constant Symbol_Id := 12; 59 | Keyword_Spec : constant Symbol_Id := 13; 60 | Keyword_Static : constant Symbol_Id := 14; 61 | Keyword_Subtype : constant Symbol_Id := 15; 62 | Keyword_Type : constant Symbol_Id := 16; 63 | Keyword_Use : constant Symbol_Id := 17; 64 | Keyword_With : constant Symbol_Id := 18; 65 | Keyword_Wrapper : constant Symbol_Id := 19; 66 | private 67 | function Case_Insensitive_Hash (S : String) return Ada.Containers.Hash_Type; 68 | function Case_Insensitive_Equals (Left, Right : String) return Boolean; 69 | 70 | package String_Indexer is new Ada.Containers.Indefinite_Hashed_Maps 71 | (String, Symbol_Id, Case_Insensitive_Hash, Case_Insensitive_Equals); 72 | 73 | type Tokenizer (Length : Positive) is record 74 | Input : String (1 .. Length); 75 | Pos : Positive; 76 | Symbol_Table : String_Indexer.Map; 77 | Depth : Natural; 78 | Cur_Line, Cur_Column, Prev_Line, Prev_Column : Positive; 79 | end record; 80 | 81 | end Tokenization; -------------------------------------------------------------------------------- /opengl/src/implementation/auto_exceptions/gl-raise_exception_on_opengl_error.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Errors; 5 | 6 | separate (GL) 7 | procedure Raise_Exception_On_OpenGL_Error is 8 | begin 9 | case Errors.Error_Flag is 10 | when Errors.Invalid_Operation => raise Errors.Invalid_Operation_Error; 11 | when Errors.Invalid_Value => raise Errors.Invalid_Value_Error; 12 | when Errors.Invalid_Framebuffer_Operation => 13 | raise Errors.Invalid_Framebuffer_Operation_Error; 14 | when Errors.Out_Of_Memory => raise Errors.Out_Of_Memory_Error; 15 | when Errors.Stack_Overflow => raise Errors.Stack_Overflow_Error; 16 | when Errors.Stack_Underflow => raise Errors.Stack_Underflow_Error; 17 | when Errors.Invalid_Enum => raise Errors.Internal_Error; 18 | when Errors.No_Error => null; 19 | end case; 20 | exception 21 | when Constraint_Error => raise Errors.Internal_Error; 22 | end Raise_Exception_On_OpenGL_Error; 23 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-algebra.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Algebra is 5 | 6 | function To_Vector2 (Vector : Vector3) return Vector2 is 7 | begin 8 | return Vector2'(Vector (X), Vector (Y)); 9 | end To_Vector2; 10 | 11 | function To_Vector2 (Vector : Vector4) return Vector2 is 12 | begin 13 | return Vector2'(Vector (X), Vector (Y)); 14 | end To_Vector2; 15 | 16 | function To_Vector3 (Vector : Vector2) return Vector3 is 17 | begin 18 | return Vector3'(Vector (X), Vector (Y), Null_Value); 19 | end To_Vector3; 20 | 21 | function To_Vector3 (Vector : Vector4) return Vector3 is 22 | begin 23 | return Vector3'(Vector (X), Vector (Y), Vector (Z)); 24 | end To_Vector3; 25 | 26 | function To_Vector4 (Vector : Vector2) return Vector4 is 27 | begin 28 | return Vector4'(Vector (X), Vector (Y), Null_Value, One_Value); 29 | end To_Vector4; 30 | 31 | function To_Vector4 (Vector : Vector3) return Vector4 is 32 | begin 33 | return Vector4'(Vector (X), Vector (Y), Vector (Z), One_Value); 34 | end To_Vector4; 35 | 36 | function Cross_Product (Left, Right : Vector3) return Vector3 is 37 | begin 38 | return (Left (Y) * Right (Z) - Left (Z) * Right (Y), 39 | Left (Z) * Right (X) - Left (X) * Right (Z), 40 | Left (X) * Right (Y) - Left (Y) * Right (X)); 41 | end Cross_Product; 42 | 43 | end GL.Algebra; 44 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-api-subprogram_reference.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | function GL.API.Subprogram_Reference (Function_Name : String) 5 | return System.Address; 6 | pragma Preelaborate (GL.API.Subprogram_Reference); 7 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-culling.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums.Getter; 6 | 7 | package body GL.Culling is 8 | 9 | procedure Set_Front_Face (Face : Orientation) renames API.Front_Face; 10 | 11 | function Front_Face return Orientation is 12 | Ret : aliased Orientation; 13 | begin 14 | API.Get_Orientation (Enums.Getter.Front_Face, Ret'Access); 15 | Raise_Exception_On_OpenGL_Error; 16 | return Ret; 17 | end Front_Face; 18 | 19 | procedure Set_Cull_Face (Selector : Face_Selector) renames API.Cull_Face; 20 | 21 | function Cull_Face return Face_Selector is 22 | Ret : aliased Face_Selector; 23 | begin 24 | API.Get_Face_Selector (Enums.Getter.Cull_Face_Mode, Ret'Access); 25 | Raise_Exception_On_OpenGL_Error; 26 | return Ret; 27 | end Cull_Face; 28 | 29 | end GL.Culling; 30 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-enums-getter.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2018 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Enums.Getter is 7 | use Types; 8 | 9 | function Get_Max (Getter_Param : Parameter) return Types.Int is 10 | Max : aliased Int; 11 | begin 12 | API.Get_Integer (Getter_Param, Max'Access); 13 | return Max - 1; 14 | end Get_Max; 15 | end GL.Enums.Getter; -------------------------------------------------------------------------------- /opengl/src/implementation/gl-enums-indexes.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Enums.Indexes is 5 | function Representation (Value : Index) return Int is 6 | begin 7 | return Min_Representation + Value; 8 | end Representation; 9 | 10 | function Value (Representation : Int) return Index is 11 | begin 12 | return Representation - Min_Representation; 13 | end Value; 14 | end GL.Enums.Indexes; 15 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-enums-indexes.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | with GL.Enums.Getter; 6 | 7 | generic 8 | Min_Representation : Types.Int; 9 | Getter_Param : Enums.Getter.Parameter; 10 | package GL.Enums.Indexes is 11 | pragma Preelaborate; 12 | 13 | use GL.Types; 14 | 15 | Max : constant Int := Getter.Get_Max (Getter_Param); 16 | 17 | subtype Index is Int range 0 .. Max; 18 | 19 | function Representation (Value : Index) return Int; 20 | 21 | function Value (Representation : Int) return Index; 22 | 23 | end GL.Enums.Indexes; -------------------------------------------------------------------------------- /opengl/src/implementation/gl-enums-queries.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with GL.Low_Level; 5 | 6 | package GL.Enums.Queries is 7 | pragma Preelaborate; 8 | 9 | -- Texture_Kind is declared in GL.Low_Level.Enums to be accessible for 10 | -- OpenCLAda 11 | 12 | type Parameter is (Time_Elapsed, Samples_Passed, Any_Samples_Passed, 13 | Transform_Feedback_Primitives_Written); 14 | 15 | -- needs to be declared here because of subtypes 16 | for Parameter use (Time_Elapsed => 16#88BF#, 17 | Samples_Passed => 16#8914#, 18 | Any_Samples_Passed => 16#8C2F#, 19 | Transform_Feedback_Primitives_Written => 16#8C88#); 20 | for Parameter'Size use Low_Level.Enum'Size; 21 | 22 | private 23 | 24 | end GL.Enums.Queries; 25 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-errors.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Errors is 7 | function Error_Flag return Error_Code renames API.Get_Error; 8 | end GL.Errors; 9 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-files.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Directories; 5 | with Ada.Direct_IO; 6 | with Ada.Unchecked_Deallocation; 7 | 8 | with Interfaces.C.Strings; 9 | 10 | with GL.API; 11 | with GL.Types; 12 | 13 | package body GL.Files is 14 | use GL.Types; 15 | 16 | procedure Load_Shader_Source_From_File (Object : Objects.Shaders.Shader; 17 | File_Name : String) is 18 | procedure Free is new Ada.Unchecked_Deallocation 19 | (C.char_array, C.Strings.char_array_access); 20 | 21 | File_Size : constant Int := Int (Ada.Directories.Size (File_Name)); 22 | 23 | -- File string *without* null termination 24 | subtype File_String is C.char_array (1 .. C.size_t (File_Size)); 25 | 26 | package File_String_IO is new Ada.Direct_IO (File_String); 27 | 28 | File : File_String_IO.File_Type; 29 | Raw_Contents : C.Strings.char_array_access 30 | := new C.char_array (1 .. C.size_t (File_Size + 1)); 31 | begin 32 | File_String_IO.Open (File, Mode => File_String_IO.In_File, 33 | Name => File_Name); 34 | File_String_IO.Read (File, 35 | Item => Raw_Contents.all (1 .. C.size_t (File_Size))); 36 | File_String_IO.Close (File); 37 | Raw_Contents.all (C.size_t (File_Size + 1)) := C.nul; 38 | API.Shader_Source (Object.Raw_Id, 1, 39 | (1 => Raw_Contents (1)'Unchecked_Access), 40 | (1 => File_Size)); 41 | Free (Raw_Contents); 42 | Raise_Exception_On_OpenGL_Error; 43 | end Load_Shader_Source_From_File; 44 | 45 | end GL.Files; 46 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-fixed-matrix.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Fixed.Matrix is 7 | 8 | procedure Apply_Frustum (Stack : Matrix_Stack; 9 | Left, Right, Bottom, Top, Near, Far : Double) is 10 | begin 11 | API.Matrix_Mode (Stack.Mode); 12 | API.Frustum (Left, Right, Bottom, Top, Near, Far); 13 | Raise_Exception_On_OpenGL_Error; 14 | end Apply_Frustum; 15 | 16 | procedure Apply_Orthogonal (Stack : Matrix_Stack; 17 | Left, Right, Bottom, Top, Near, Far : Double) is 18 | begin 19 | API.Matrix_Mode (Stack.Mode); 20 | API.Ortho (Left, Right, Bottom, Top, Near, Far); 21 | Raise_Exception_On_OpenGL_Error; 22 | end Apply_Orthogonal; 23 | 24 | procedure Load_Identity (Stack : Matrix_Stack) is 25 | begin 26 | API.Matrix_Mode (Stack.Mode); 27 | API.Load_Identity; 28 | Raise_Exception_On_OpenGL_Error; 29 | end Load_Identity; 30 | 31 | procedure Load_Matrix (Stack : Matrix_Stack; Value : Matrix4) is 32 | begin 33 | API.Matrix_Mode (Stack.Mode); 34 | API.Load_Matrix (Value); 35 | Raise_Exception_On_OpenGL_Error; 36 | end Load_Matrix; 37 | 38 | procedure Apply_Multiplication (Stack : Matrix_Stack; Factor : Matrix4) is 39 | begin 40 | API.Matrix_Mode (Stack.Mode); 41 | API.Mult_Matrix (Factor); 42 | Raise_Exception_On_OpenGL_Error; 43 | end Apply_Multiplication; 44 | 45 | procedure Apply_Multiplication (Stack : Matrix_Stack; Factor : Double) is 46 | begin 47 | API.Matrix_Mode (Stack.Mode); 48 | API.Mult_Matrix (Identity4 * Factor); 49 | Raise_Exception_On_OpenGL_Error; 50 | end Apply_Multiplication; 51 | 52 | procedure Push (Stack : Matrix_Stack) is 53 | begin 54 | API.Matrix_Mode (Stack.Mode); 55 | API.Push_Matrix; 56 | Raise_Exception_On_OpenGL_Error; 57 | end Push; 58 | 59 | procedure Pop (Stack : Matrix_Stack) is 60 | begin 61 | API.Matrix_Mode (Stack.Mode); 62 | API.Pop_Matrix; 63 | Raise_Exception_On_OpenGL_Error; 64 | end Pop; 65 | 66 | procedure Apply_Rotation (Stack : Matrix_Stack; Angle : Double; 67 | Axis : Vector3) is 68 | begin 69 | API.Matrix_Mode (Stack.Mode); 70 | API.Rotate (Angle, Axis (X), Axis (Y), Axis (Z)); 71 | Raise_Exception_On_OpenGL_Error; 72 | end Apply_Rotation; 73 | 74 | procedure Apply_Rotation (Stack : Matrix_Stack; Angle, X, Y, Z : Double) is 75 | begin 76 | API.Matrix_Mode (Stack.Mode); 77 | API.Rotate (Angle, X, Y, Z); 78 | Raise_Exception_On_OpenGL_Error; 79 | end Apply_Rotation; 80 | 81 | procedure Apply_Scaling (Stack : Matrix_Stack; X, Y, Z : Double) is 82 | begin 83 | API.Matrix_Mode (Stack.Mode); 84 | API.Scale (X, Y, Z); 85 | Raise_Exception_On_OpenGL_Error; 86 | end Apply_Scaling; 87 | 88 | procedure Apply_Translation (Stack : Matrix_Stack; Along : Vector3) is 89 | begin 90 | API.Matrix_Mode (Stack.Mode); 91 | API.Translate (Along (X), Along (Y), Along (Z)); 92 | Raise_Exception_On_OpenGL_Error; 93 | end Apply_Translation; 94 | 95 | procedure Apply_Translation (Stack : Matrix_Stack; X, Y, Z : Double) is 96 | begin 97 | API.Matrix_Mode (Stack.Mode); 98 | API.Translate (X, Y, Z); 99 | Raise_Exception_On_OpenGL_Error; 100 | end Apply_Translation; 101 | end GL.Fixed.Matrix; 102 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-fixed.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | -- Fixed function pipeline. Deprecated in OpenGL 3.0. 7 | package body GL.Fixed is 8 | procedure Set_Vertex_Pointer (Length : Vertex_Length; 9 | Stride, Offset : Size) is 10 | 11 | begin 12 | API.Vertex_Pointer (Int (Length), Double_Type, 13 | Stride, Offset); 14 | Raise_Exception_On_OpenGL_Error; 15 | end Set_Vertex_Pointer; 16 | 17 | procedure Set_Color_Pointer (Stride, Offset : Size) is 18 | begin 19 | API.Color_Pointer (4, Single_Type, Stride, 20 | Int (Offset)); 21 | Raise_Exception_On_OpenGL_Error; 22 | end Set_Color_Pointer; 23 | 24 | procedure Enable (Capability : Client_Side_Capability) is 25 | begin 26 | API.Enable_Client_State (Capability); 27 | Raise_Exception_On_OpenGL_Error; 28 | end Enable; 29 | 30 | procedure Disable (Capability : Client_Side_Capability) is 31 | begin 32 | API.Disable_Client_State (Capability); 33 | Raise_Exception_On_OpenGL_Error; 34 | end Disable; 35 | end GL.Fixed; 36 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-framebuffer.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums.Getter; 6 | 7 | package body GL.Framebuffer is 8 | 9 | procedure Set_Clamp_Read_Color (Enabled : Boolean) is 10 | begin 11 | API.Clamp_Color (Enums.Clamp_Read_Color, Low_Level.Bool (Enabled)); 12 | end Set_Clamp_Read_Color; 13 | 14 | procedure Set_Read_Buffer (Value : Read_Buffer_Selector) is 15 | begin 16 | API.Read_Buffer (Value); 17 | Raise_Exception_On_OpenGL_Error; 18 | end Set_Read_Buffer; 19 | 20 | function Read_Buffer return Read_Buffer_Selector is 21 | Ret : aliased Read_Buffer_Selector; 22 | begin 23 | API.Get_Read_Buffer_Selector (Enums.Getter.Read_Buffer, Ret'Access); 24 | Raise_Exception_On_OpenGL_Error; 25 | return Ret; 26 | end Read_Buffer; 27 | 28 | procedure Read_Pixels (X, Y : Int; 29 | Width, Height : Size; 30 | Format : Pixels.Framebuffer_Format; 31 | Data_Type : Pixels.Data_Type; 32 | Data : out Array_Type) is 33 | begin 34 | API.Read_Pixels 35 | (X, Y, Width, Height, Format, Data_Type, Data (Data'First)'Address); 36 | Raise_Exception_On_OpenGL_Error; 37 | end Read_Pixels; 38 | 39 | procedure Set_Logic_Op_Mode (Value : Logic_Op) is 40 | begin 41 | API.Logic_Op (Value); 42 | Raise_Exception_On_OpenGL_Error; 43 | end Set_Logic_Op_Mode; 44 | 45 | function Logic_Op_Mode return Logic_Op is 46 | Ret : aliased Logic_Op; 47 | begin 48 | API.Get_Logic_Op (Enums.Getter.Logic_Op_Mode, Ret'Access); 49 | Raise_Exception_On_OpenGL_Error; 50 | return Ret; 51 | end Logic_Op_Mode; 52 | 53 | end GL.Framebuffer; 54 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-helpers.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Helpers is 5 | 6 | function Float_Array (Value : Colors.Color) return Single_Array is 7 | use GL.Types.Colors; 8 | begin 9 | return Single_Array'(1 => Value (R), 10 | 2 => Value (G), 11 | 3 => Value (B), 12 | 4 => Value (A)); 13 | end Float_Array; 14 | 15 | function Color (Value : Single_Array) return Colors.Color is 16 | use GL.Types.Colors; 17 | begin 18 | return Colors.Color'(R => Value (1), G => Value (2), B => Value (3), 19 | A => Value (4)); 20 | end Color; 21 | 22 | end GL.Helpers; 23 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-helpers.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types.Colors; 5 | 6 | private package GL.Helpers is 7 | pragma Preelaborate; 8 | 9 | use GL.Types; 10 | 11 | function Float_Array (Value : Colors.Color) return Single_Array; 12 | function Color (Value : Single_Array) return Colors.Color; 13 | 14 | end GL.Helpers; 15 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-load_function_pointers.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | procedure GL.Load_Function_Pointers; 5 | pragma Preelaborate (GL.Load_Function_Pointers); 6 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-low_level.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | package GL.Low_Level is 7 | pragma Preelaborate; 8 | 9 | use GL.Types; 10 | 11 | -- This package contains some low-level types that are used by the raw C 12 | -- interface of the OpenGL API. They are converted to types that are easier 13 | -- to handle by the wrapper and thus are not needed for using the wrapper. 14 | -- However, they might be used by other APIs that use OpenGL and thus are 15 | -- exposed publicly here. 16 | 17 | 18 | -- Boolean with the representation used by the OpenGL API (unsigned char). 19 | -- Is converted to a standard Boolean by the wrapper. 20 | type Bool is new Boolean; 21 | 22 | -- This type is never used directly. However, enumerations refer to it for 23 | -- defining their Size attribute. 24 | subtype Enum is C.unsigned; 25 | 26 | -- Bitfields are usually converted to a record with Boolean fields in the 27 | -- wrapper. However, for interacting with the OpenGL library, these records 28 | -- are converted back to the raw Bitfield type (by means of 29 | -- Unchecked_Conversion). Using the record directly with the C interface 30 | -- requires it to have the C_Pass_By_Value conversion, which for some reason 31 | -- breaks linking on Windows with StdCall convention (possibly a GNAT bug). 32 | subtype Bitfield is C.unsigned; 33 | 34 | -- These types totally are not pointers. No idea why they are named like this. 35 | subtype IntPtr is C.long; 36 | subtype SizeIPtr is C.long; 37 | 38 | type Char_Access_Array is array (Size range <>) of access C.char; 39 | 40 | -- used in API calls 41 | type Size_Access is access all Types.Size; 42 | type Bool_Access is access all Bool; 43 | subtype Zero is Int range 0 .. 0; 44 | private 45 | for Bool use (False => 0, True => 1); 46 | for Bool'Size use C.unsigned_char'Size; 47 | 48 | pragma Convention (C, Size_Access); 49 | pragma Convention (C, Bool_Access); 50 | pragma Convention (C, Char_Access_Array); 51 | end GL.Low_Level; 52 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-matrices.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Matrices is 5 | function "+" (Left, Right : Matrix) return Matrix is 6 | Return_Matrix : Matrix; 7 | begin 8 | for Column in Index_Type loop 9 | for Row in Index_Type loop 10 | Return_Matrix (Column, Row) := 11 | Left (Column, Row) + Right (Column, Row); 12 | end loop; 13 | end loop; 14 | return Return_Matrix; 15 | end "+"; 16 | 17 | function "-" (Left, Right : Matrix) return Matrix is 18 | Return_Matrix : Matrix; 19 | begin 20 | for Column in Index_Type loop 21 | for Row in Index_Type loop 22 | Return_Matrix (Column, Row) := 23 | Left (Column, Row) - Right (Column, Row); 24 | end loop; 25 | end loop; 26 | return Return_Matrix; 27 | end "-"; 28 | 29 | function "-" (Left : Matrix) return Matrix is 30 | Ret : Matrix; 31 | begin 32 | for Column in Index_Type loop 33 | for Row in Index_Type loop 34 | Ret (Column, Row) := -Left (Column, Row); 35 | end loop; 36 | end loop; 37 | return Ret; 38 | end "-"; 39 | 40 | function "*" (Left, Right : Matrix) return Matrix is 41 | Element : Element_Type; 42 | Return_Matrix : Matrix; 43 | begin 44 | for Column in Index_Type loop 45 | for Row in Index_Type loop 46 | for X in Index_Type loop 47 | if X = Index_Type'First then 48 | Element := Left (X, Row) * Right (Column, X); 49 | else 50 | Element := Element + Left (X, Row) * Right (Column, X); 51 | end if; 52 | end loop; 53 | Return_Matrix (Column, Row) := Element; 54 | end loop; 55 | end loop; 56 | return Return_Matrix; 57 | end "*"; 58 | 59 | function "*" (Left : Matrix; Right : Vector_Type) return Vector_Type is 60 | Return_Vector : Vector_Type; 61 | begin 62 | for Row in Index_Type loop 63 | for Column in Index_Type loop 64 | if Column = Index_Type'First then 65 | Return_Vector (Row) := Left (Column, Row) * Right (Column); 66 | else 67 | Return_Vector (Row) 68 | := Return_Vector (Row) + Left (Column, Row) * Right (Column); 69 | end if; 70 | end loop; 71 | end loop; 72 | return Return_Vector; 73 | end "*"; 74 | 75 | function "*" (Left : Matrix; Right : Element_Type) return Matrix is 76 | Return_Matrix : Matrix; 77 | begin 78 | for Column in Index_Type loop 79 | for Row in Index_Type loop 80 | Return_Matrix (Column, Row) := Left (Column, Row) * Right; 81 | end loop; 82 | end loop; 83 | return Return_Matrix; 84 | end "*"; 85 | 86 | function "*" (Left : Element_Type; Right : Matrix) return Matrix is 87 | begin 88 | return Right * Left; 89 | end "*"; 90 | 91 | function Transpose (Subject : Matrix) return Matrix is 92 | Ret : Matrix; 93 | begin 94 | for Column in Index_Type loop 95 | for Row in Index_Type loop 96 | Ret (Column, Row) := Subject (Row, Column); 97 | end loop; 98 | end loop; 99 | return Ret; 100 | end Transpose; 101 | end GL.Matrices; 102 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-lists.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Objects.Lists is 5 | 6 | function Create (Raw : UInt_Array) return List is 7 | begin 8 | return List'(Count => Raw'Length, Contents => Raw); 9 | end Create; 10 | 11 | function First (Object : List) return Cursor is 12 | begin 13 | if Object.Count = 0 then 14 | return No_Element; 15 | else 16 | return Cursor'(Object => Object'Unchecked_Access, Index => 1); 17 | end if; 18 | end First; 19 | 20 | function Last (Object : List) return Cursor is 21 | begin 22 | if Object.Count = 0 then 23 | return No_Element; 24 | else 25 | return Cursor'(Object => Object'Unchecked_Access, 26 | Index => Object.Contents'Length); 27 | end if; 28 | end Last; 29 | 30 | function Next (Current : Cursor) return Cursor is 31 | begin 32 | if Current = No_Element then 33 | raise Constraint_Error; 34 | elsif Current.Index = Current.Object.Contents'Length then 35 | return No_Element; 36 | else 37 | return Cursor'(Current.Object, Current.Index + 1); 38 | end if; 39 | end Next; 40 | 41 | function Previous (Current : Cursor) return Cursor is 42 | begin 43 | if Current = No_Element then 44 | raise Constraint_Error; 45 | elsif Current.Index = 1 then 46 | return No_Element; 47 | else 48 | return Cursor'(Current.Object, Current.Index - 1); 49 | end if; 50 | end Previous; 51 | 52 | function Has_Next (Current : Cursor) return Boolean is 53 | begin 54 | return Current /= No_Element and then 55 | Current.Index /= Current.Object.Contents'Length; 56 | end Has_Next; 57 | 58 | function Has_Previous (Current : Cursor) return Boolean is 59 | begin 60 | return Current /= No_Element and then Current.Index /= 1; 61 | end Has_Previous; 62 | 63 | function Element (Current : Cursor) return Object_Type is 64 | begin 65 | if Current = No_Element then 66 | raise Constraint_Error; 67 | else 68 | return Generate_From_Id (Current.Object.Contents (Current.Index)); 69 | end if; 70 | end Element; 71 | 72 | end GL.Objects.Lists; 73 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-queries.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Objects.Queries is 7 | 8 | procedure Begin_Query (Target : GL.Low_Level.Enums.Query_Param; 9 | Object : Query_Object) is 10 | begin 11 | API.Begin_Query (Target, Object.Reference.GL_Id); 12 | Raise_Exception_On_OpenGL_Error; 13 | end Begin_Query; 14 | 15 | procedure End_Query (Target : GL.Low_Level.Enums.Query_Param) is 16 | begin 17 | API.End_Query (Target); 18 | Raise_Exception_On_OpenGL_Error; 19 | end End_Query; 20 | 21 | procedure Begin_Query_Indexed (Target : GL.Low_Level.Enums.Query_Param; 22 | Index : UInt; Object : Query_Object) is 23 | begin 24 | API.Begin_Query_Indexed (Target, Index, Object.Reference.GL_Id); 25 | Raise_Exception_On_OpenGL_Error; 26 | end Begin_Query_Indexed; 27 | 28 | procedure End_Query_Indexed (Target : GL.Low_Level.Enums.Query_Param; 29 | Index : UInt) is 30 | begin 31 | API.End_Query_Indexed (Target, Index); 32 | Raise_Exception_On_OpenGL_Error; 33 | end End_Query_Indexed; 34 | 35 | procedure Get_Query_Object 36 | (Object : Query_Object; Pname : GL.Low_Level.Enums.Query_Results; 37 | Params : out UInt) is 38 | begin 39 | API.Get_Query_Object (Object.Reference.GL_Id, Pname, Params); 40 | Raise_Exception_On_OpenGL_Error; 41 | end Get_Query_Object; 42 | 43 | overriding 44 | procedure Internal_Create_Id (Object : Query_Object; Id : out UInt) is 45 | pragma Unreferenced (Object); 46 | begin 47 | API.Gen_Queries (1, Id); 48 | Raise_Exception_On_OpenGL_Error; 49 | end Internal_Create_Id; 50 | 51 | overriding 52 | procedure Internal_Release_Id (Object : Query_Object; Id : UInt) is 53 | pragma Unreferenced (Object); 54 | begin 55 | API.Delete_Queries (1, (1 => Id)); 56 | Raise_Exception_On_OpenGL_Error; 57 | end Internal_Release_Id; 58 | 59 | function Is_Query (Query : Query_Object) return Boolean is 60 | begin 61 | return API.Is_Query (Raw_Id (Query)); 62 | end Is_Query; 63 | 64 | procedure Query_Counter (Object : Query_Object; 65 | Target : Low_Level.Enums.Query_Param) is 66 | begin 67 | API.Query_Counter (Object.Reference.GL_Id, Target); 68 | Raise_Exception_On_OpenGL_Error; 69 | end Query_Counter; 70 | 71 | end GL.Objects.Queries; 72 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-shaders.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums; 6 | 7 | package body GL.Objects.Shaders is 8 | 9 | procedure Set_Source (Subject : Shader; Source : String) is 10 | C_Source : C.char_array := C.To_C (Source); 11 | begin 12 | API.Shader_Source (Subject.Reference.GL_Id, 1, 13 | (1 => C_Source (0)'Unchecked_Access), 14 | (1 => Source'Length)); 15 | Raise_Exception_On_OpenGL_Error; 16 | end Set_Source; 17 | 18 | function Source (Subject : Shader) return String is 19 | Source_Length : Size := 0; 20 | begin 21 | API.Get_Shader_Param (Subject.Reference.GL_Id, 22 | Enums.Shader_Source_Length, Source_Length); 23 | Raise_Exception_On_OpenGL_Error; 24 | if Source_Length = 0 then 25 | return ""; 26 | else 27 | declare 28 | Shader_Source : String (1 .. Integer (Source_Length)); 29 | begin 30 | API.Get_Shader_Source (Subject.Reference.GL_Id, Source_Length, 31 | Source_Length, Shader_Source); 32 | Raise_Exception_On_OpenGL_Error; 33 | return Shader_Source (1 .. Integer (Source_Length)); 34 | end; 35 | end if; 36 | end Source; 37 | 38 | procedure Compile (Subject : Shader) is 39 | begin 40 | API.Compile_Shader (Subject.Reference.GL_Id); 41 | Raise_Exception_On_OpenGL_Error; 42 | end Compile; 43 | 44 | procedure Release_Shader_Compiler is 45 | begin 46 | API.Release_Shader_Compiler.all; 47 | end Release_Shader_Compiler; 48 | 49 | function Compile_Status (Subject : Shader) return Boolean is 50 | Value : Int := 0; 51 | begin 52 | API.Get_Shader_Param (Subject.Reference.GL_Id, Enums.Compile_Status, 53 | Value); 54 | Raise_Exception_On_OpenGL_Error; 55 | return Value /= 0; 56 | end Compile_Status; 57 | 58 | function Info_Log (Subject : Shader) return String is 59 | Log_Length : Size := 0; 60 | begin 61 | API.Get_Shader_Param (Subject.Reference.GL_Id, 62 | Enums.Info_Log_Length, Log_Length); 63 | Raise_Exception_On_OpenGL_Error; 64 | if Log_Length = 0 then 65 | return ""; 66 | else 67 | declare 68 | Info_Log : String (1 .. Integer (Log_Length)); 69 | begin 70 | API.Get_Shader_Info_Log (Subject.Reference.GL_Id, Log_Length, 71 | Log_Length, Info_Log); 72 | Raise_Exception_On_OpenGL_Error; 73 | return Info_Log (1 .. Integer (Log_Length)); 74 | end; 75 | end if; 76 | end Info_Log; 77 | 78 | overriding 79 | procedure Internal_Create_Id (Object : Shader; Id : out UInt) is 80 | begin 81 | Id := API.Create_Shader (Object.Kind); 82 | Raise_Exception_On_OpenGL_Error; 83 | end Internal_Create_Id; 84 | 85 | overriding 86 | procedure Internal_Release_Id (Object : Shader; Id : UInt) is 87 | pragma Unreferenced (Object); 88 | begin 89 | API.Delete_Shader (Id); 90 | Raise_Exception_On_OpenGL_Error; 91 | end Internal_Release_Id; 92 | 93 | function Create_From_Id (Id : UInt) return Shader is 94 | Kind : Shader_Type := Shader_Type'First; 95 | begin 96 | API.Get_Shader_Type (Id, Enums.Shader_Type, Kind); 97 | Raise_Exception_On_OpenGL_Error; 98 | return Object : Shader (Kind) do 99 | Object.Set_Raw_Id (Id, False); 100 | end return; 101 | end Create_From_Id; 102 | 103 | end GL.Objects.Shaders; 104 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-textures-targets.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums.Textures; 6 | 7 | package body GL.Objects.Textures.Targets is 8 | 9 | function Buffer_Offset (Object : Texture_Buffer_Target; 10 | Level : Mipmap_Level) return Size is 11 | Ret : Size; 12 | begin 13 | API.Get_Tex_Level_Parameter_Size (Object.Kind, Level, 14 | Enums.Textures.Buffer_Offset, Ret); 15 | Raise_Exception_On_OpenGL_Error; 16 | return Ret; 17 | end Buffer_Offset; 18 | 19 | function Buffer_Size (Object : Texture_Buffer_Target; 20 | Level : Mipmap_Level) return Size is 21 | Ret : Size; 22 | begin 23 | API.Get_Tex_Level_Parameter_Size (Object.Kind, Level, 24 | Enums.Textures.Buffer_Size, Ret); 25 | Raise_Exception_On_OpenGL_Error; 26 | return Ret; 27 | end Buffer_Size; 28 | 29 | function Target_From_Kind (Kind : Low_Level.Enums.Texture_Kind) 30 | return not null access constant Texture_Proxy'Class is 31 | begin 32 | case Kind is 33 | when GL.Low_Level.Enums.Texture_1D => return Texture_1D'Access; 34 | when GL.Low_Level.Enums.Texture_2D => return Texture_2D'Access; 35 | when GL.Low_Level.Enums.Texture_3D => return Texture_3D'Access; 36 | when GL.Low_Level.Enums.Proxy_Texture_1D => 37 | return Texture_1D_Proxy'Access; 38 | when GL.Low_Level.Enums.Proxy_Texture_2D => 39 | return Texture_2D_Proxy'Access; 40 | when GL.Low_Level.Enums.Proxy_Texture_3D => 41 | return Texture_3D_Proxy'Access; 42 | when GL.Low_Level.Enums.Proxy_Texture_Cube_Map => 43 | return Texture_Cube_Map_Proxy'Access; 44 | when GL.Low_Level.Enums.Texture_Cube_Map => 45 | return Texture_Cube_Map'Access; 46 | when GL.Low_Level.Enums.Texture_Cube_Map_Positive_X => 47 | return Texture_Cube_Map_Positive_X'Access; 48 | when GL.Low_Level.Enums.Texture_Cube_Map_Negative_X => 49 | return Texture_Cube_Map_Negative_X'Access; 50 | when GL.Low_Level.Enums.Texture_Cube_Map_Positive_Y => 51 | return Texture_Cube_Map_Positive_Y'Access; 52 | when GL.Low_Level.Enums.Texture_Cube_Map_Negative_Y => 53 | return Texture_Cube_Map_Negative_Y'Access; 54 | when GL.Low_Level.Enums.Texture_Cube_Map_Positive_Z => 55 | return Texture_Cube_Map_Positive_Z'Access; 56 | when GL.Low_Level.Enums.Texture_Cube_Map_Negative_Z => 57 | return Texture_Cube_Map_Negative_Z'Access; 58 | when GL.Low_Level.Enums.Texture_1D_Array | 59 | GL.Low_Level.Enums.Texture_2D_Array | 60 | GL.Low_Level.Enums.Proxy_Texture_1D_Array | 61 | GL.Low_Level.Enums.Proxy_Texture_2D_Array => 62 | raise Not_Implemented_Exception with Kind'Img; 63 | when GL.Low_Level.Enums.Texture_Buffer => 64 | return Texture_Buffer'Access; 65 | end case; 66 | end Target_From_Kind; 67 | 68 | end GL.Objects.Textures.Targets; 69 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-textures-with_1d_loader.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with System; 5 | 6 | with GL.API; 7 | 8 | package body GL.Objects.Textures.With_1D_Loader is 9 | 10 | procedure Load_Empty_Texture (Object : Target; 11 | Level : Mipmap_Level; 12 | Internal_Format : Pixels.Internal_Format; 13 | Width : Types.Size) is 14 | begin 15 | API.Tex_Image_1D (Texture_Proxy (Object).Kind, Level, Internal_Format, 16 | Width, 0, 17 | Format_For_Loading_Empty_Texture (Internal_Format), 18 | Pixels.Data_Type'First, 19 | Image_Source (System.Null_Address)); 20 | Raise_Exception_On_OpenGL_Error; 21 | end Load_Empty_Texture; 22 | 23 | procedure Load_From_Data (Object : Fillable_Target; 24 | Level : Mipmap_Level; 25 | Internal_Format : Pixels.Internal_Format; 26 | Width : Types.Size; 27 | Source_Format : Pixels.Data_Format; 28 | Source_Type : Pixels.Data_Type; 29 | Source : Image_Source) is 30 | begin 31 | API.Tex_Image_1D (Texture_Proxy (Object).Kind, Level, Internal_Format, 32 | Width, 0, Source_Format, Source_Type, Source); 33 | Raise_Exception_On_OpenGL_Error; 34 | end Load_From_Data; 35 | 36 | procedure Load_Sub_Image_From_Data 37 | (Object : Fillable_Target; 38 | Level : Mipmap_Level; 39 | X_Offset, Y_Offset : Int; 40 | Width, Height : Size; 41 | Format : Pixels.Data_Format; 42 | Data_Type : Pixels.Data_Type; 43 | Source : Image_Source) is 44 | begin 45 | API.Tex_Sub_Image_1D (Texture_Proxy (Object).Kind, Level, X_Offset, Y_Offset, 46 | Width, Height, Format, Data_Type, Source); 47 | Raise_Exception_On_OpenGL_Error; 48 | end Load_Sub_Image_From_Data; 49 | 50 | procedure Load_Compressed 51 | (Object : Fillable_Target; 52 | Level : Mipmap_Level; 53 | Internal_Format : Pixels.Internal_Format; 54 | Width, Image_Size : Types.Size; 55 | Source : Image_Source) is 56 | begin 57 | API.Compressed_Tex_Image_1D 58 | (Texture_Proxy (Object).Kind, Level, Internal_Format, Width, 0, 59 | Image_Size, Source); 60 | Raise_Exception_On_OpenGL_Error; 61 | end Load_Compressed; 62 | 63 | procedure Storage (Object : Target; Levels : Types.Size; 64 | Internal_Format : Pixels.Internal_Format; 65 | Width : Types.Size) is 66 | begin 67 | API.Tex_Storage_1D (Texture_Proxy (Object).Kind, Levels, Internal_Format, 68 | Width); 69 | Raise_Exception_On_OpenGL_Error; 70 | end Storage; 71 | 72 | end GL.Objects.Textures.With_1D_Loader; 73 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-textures-with_2d_loader.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with System; 5 | 6 | with GL.API; 7 | 8 | package body GL.Objects.Textures.With_2D_Loader is 9 | 10 | procedure Load_Empty_Texture (Object : Target; 11 | Level : Mipmap_Level; 12 | Internal_Format : Pixels.Internal_Format; 13 | Width, Height : Types.Size) is 14 | begin 15 | API.Tex_Image_2D (Texture_Proxy (Object).Kind, Level, Internal_Format, 16 | Width, Height, 0, 17 | Format_For_Loading_Empty_Texture (Internal_Format), 18 | Pixels.Data_Type'First, 19 | Image_Source (System.Null_Address)); 20 | Raise_Exception_On_OpenGL_Error; 21 | end Load_Empty_Texture; 22 | 23 | procedure Load_From_Data (Object : Fillable_Target; 24 | Level : Mipmap_Level; 25 | Internal_Format : Pixels.Internal_Format; 26 | Width, Height : Types.Size; 27 | Source_Format : Pixels.Data_Format; 28 | Source_Type : Pixels.Data_Type; 29 | Source : Image_Source) is 30 | begin 31 | API.Tex_Image_2D (Texture_Proxy (Object).Kind, Level, Internal_Format, 32 | Width, Height, 0, Source_Format, Source_Type, Source); 33 | Raise_Exception_On_OpenGL_Error; 34 | end Load_From_Data; 35 | 36 | procedure Load_Sub_Image_From_Data 37 | (Object : Fillable_Target; 38 | Level : Mipmap_Level; 39 | X_Offset, Y_Offset : Int; 40 | Width, Height : Size; 41 | Format : Pixels.Data_Format; 42 | Data_Type : Pixels.Data_Type; 43 | Source : Image_Source) is 44 | begin 45 | API.Tex_Sub_Image_2D (Texture_Proxy (Object).Kind, Level, X_Offset, Y_Offset, 46 | Width, Height, Format, Data_Type, Source); 47 | Raise_Exception_On_OpenGL_Error; 48 | end Load_Sub_Image_From_Data; 49 | 50 | procedure Load_Compressed 51 | (Object : Fillable_Target; 52 | Level : Mipmap_Level; 53 | Internal_Format : Pixels.Internal_Format; 54 | Width, Height, Image_Size : Types.Size; 55 | Source : Image_Source) is 56 | begin 57 | API.Compressed_Tex_Image_2D 58 | (Texture_Proxy (Object).Kind, Level, Internal_Format, Width, Height, 0, 59 | Image_Size, Source); 60 | Raise_Exception_On_OpenGL_Error; 61 | end Load_Compressed; 62 | 63 | procedure Storage (Object : Target; Number_Of_Levels : Types.Size; 64 | Internal_Format : Pixels.Internal_Format; 65 | Width, Height : Types.Size) is 66 | begin 67 | API.Tex_Storage_2D (Texture_Proxy (Object).Kind, Number_Of_Levels, Internal_Format, 68 | Width, Height); 69 | Raise_Exception_On_OpenGL_Error; 70 | end Storage; 71 | end GL.Objects.Textures.With_2D_Loader; 72 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-textures-with_3d_loader.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with System; 5 | 6 | with GL.API; 7 | 8 | package body GL.Objects.Textures.With_3D_Loader is 9 | 10 | procedure Load_Empty_Texture (Object : Target; 11 | Level : Mipmap_Level; 12 | Internal_Format : Pixels.Internal_Format; 13 | Width, Height, Depth : Types.Size) is 14 | begin 15 | API.Tex_Image_3D (Texture_Proxy (Object).Kind, Level, Internal_Format, 16 | Width, Height, Depth, 0, 17 | Format_For_Loading_Empty_Texture (Internal_Format), 18 | Pixels.Data_Type'First, 19 | Image_Source (System.Null_Address)); 20 | Raise_Exception_On_OpenGL_Error; 21 | end Load_Empty_Texture; 22 | 23 | procedure Load_From_Data (Object : Fillable_Target; 24 | Level : Mipmap_Level; 25 | Internal_Format : Pixels.Internal_Format; 26 | Width, Height, Depth : Types.Size; 27 | Source_Format : Pixels.Data_Format; 28 | Source_Type : Pixels.Data_Type; 29 | Source : Image_Source) is 30 | begin 31 | API.Tex_Image_3D (Texture_Proxy (Object).Kind, Level, Internal_Format, 32 | Width, Height, Depth, 0, Source_Format, Source_Type, 33 | Source); 34 | Raise_Exception_On_OpenGL_Error; 35 | end Load_From_Data; 36 | 37 | procedure Load_Sub_Image_From_Data 38 | (Object : Fillable_Target; 39 | Level : Mipmap_Level; 40 | X_Offset, Y_Offset : Int; 41 | Width, Height : Size; 42 | Format : Pixels.Data_Format; 43 | Data_Type : Pixels.Data_Type; 44 | Source : Image_Source) is 45 | begin 46 | API.Tex_Sub_Image_3D (Texture_Proxy (Object).Kind, Level, X_Offset, Y_Offset, 47 | Width, Height, Format, Data_Type, Source); 48 | Raise_Exception_On_OpenGL_Error; 49 | end Load_Sub_Image_From_Data; 50 | 51 | procedure Load_Compressed 52 | (Object : Fillable_Target; 53 | Level : Mipmap_Level; 54 | Internal_Format : Pixels.Internal_Format; 55 | Width, Height, Depth, Image_Size : Types.Size; 56 | Source : Image_Source) is 57 | begin 58 | API.Compressed_Tex_Image_3D 59 | (Texture_Proxy (Object).Kind, Level, Internal_Format, Width, Height, 60 | Depth, 0, Image_Size, Source); 61 | Raise_Exception_On_OpenGL_Error; 62 | end Load_Compressed; 63 | 64 | procedure Storage (Object : Target; Levels : Types.Size; 65 | Internal_Format : Pixels.Internal_Format; 66 | Width, Height, Depth : Types.Size) is 67 | begin 68 | API.Tex_Storage_3D (Texture_Proxy (Object).Kind, Levels, Internal_Format, 69 | Width, Height, Depth); 70 | Raise_Exception_On_OpenGL_Error; 71 | end Storage; 72 | end GL.Objects.Textures.With_3D_Loader; 73 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects-vertex_arrays.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Objects.Vertex_Arrays is 7 | 8 | Current_Object : Vertex_Array_Object := Null_Array_Object; 9 | 10 | procedure Bind (Object : Vertex_Array_Object) is 11 | begin 12 | if Object.Reference = null then 13 | API.Bind_Vertex_Array (0); 14 | Current_Object := Null_Array_Object; 15 | elsif Object /= Current_Array_Object then 16 | API.Bind_Vertex_Array (Object.Reference.GL_Id); 17 | Current_Object := Object; 18 | end if; 19 | Raise_Exception_On_OpenGL_Error; 20 | end Bind; 21 | 22 | procedure Draw_Arrays (Mode : Connection_Mode; First, Count : Size) is 23 | begin 24 | API.Draw_Arrays (Mode, First, Count); 25 | Raise_Exception_On_OpenGL_Error; 26 | end Draw_Arrays; 27 | 28 | procedure Draw_Arrays_Instanced (Mode : Connection_Mode; 29 | First, Count, Instances : Size) is 30 | begin 31 | API.Draw_Arrays_Instanced (Mode, First, Count, Instances); 32 | Raise_Exception_On_OpenGL_Error; 33 | end Draw_Arrays_Instanced; 34 | 35 | procedure Set_Primitive_Restart_Index (Index : UInt) is 36 | begin 37 | API.Primitive_Restart_Index (Index); 38 | Raise_Exception_On_OpenGL_Error; 39 | end Set_Primitive_Restart_Index; 40 | 41 | overriding 42 | procedure Internal_Create_Id (Object : Vertex_Array_Object; Id : out UInt) is 43 | pragma Unreferenced (Object); 44 | begin 45 | API.Gen_Vertex_Arrays (1, Id); 46 | Raise_Exception_On_OpenGL_Error; 47 | end Internal_Create_Id; 48 | 49 | overriding 50 | procedure Internal_Release_Id (Object : Vertex_Array_Object; Id : UInt) is 51 | pragma Unreferenced (Object); 52 | begin 53 | API.Delete_Vertex_Arrays (1, (1 => Id)); 54 | Raise_Exception_On_OpenGL_Error; 55 | end Internal_Release_Id; 56 | 57 | function Current_Array_Object return Vertex_Array_Object is 58 | begin 59 | return Current_Object; 60 | end Current_Array_Object; 61 | end GL.Objects.Vertex_Arrays; 62 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-objects.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Unchecked_Deallocation; 5 | 6 | package body GL.Objects is 7 | 8 | procedure Initialize_Id (Object : in out GL_Object) is 9 | New_Id : UInt; 10 | begin 11 | -- may raise exception; therefore we call it before actually making 12 | -- changes to the holder. 13 | GL_Object'Class (Object).Internal_Create_Id (New_Id); 14 | 15 | Object.Clear; 16 | Object.Reference := 17 | new GL_Object_Reference'(GL_Id => New_Id, Reference_Count => 1, 18 | Is_Owner => True); 19 | end Initialize_Id; 20 | 21 | overriding procedure Adjust (Object : in out GL_Object) is 22 | begin 23 | if Object.Reference /= null and then 24 | Object.Reference.Reference_Count > 0 then 25 | Object.Reference.Reference_Count := 26 | Object.Reference.Reference_Count + 1; 27 | end if; 28 | end Adjust; 29 | 30 | overriding procedure Finalize (Object : in out GL_Object) is 31 | procedure Free is new Ada.Unchecked_Deallocation 32 | (Object => GL_Object_Reference, Name => GL_Object_Reference_Access); 33 | Reference : GL_Object_Reference_Access := Object.Reference; 34 | begin 35 | Object.Reference := null; 36 | if Reference /= null and then Reference.Reference_Count > 0 then 37 | -- Reference_Count = 0 means that the holder recides in global memory 38 | Reference.Reference_Count := Reference.Reference_Count - 1; 39 | if Reference.Reference_Count = 0 then 40 | if Reference.Is_Owner then 41 | begin 42 | GL_Object'Class (Object).Internal_Release_Id 43 | (Reference.GL_Id); 44 | exception 45 | when others => 46 | -- cannot let this escape as we're in a Finalize call and 47 | -- thus that error cannot be properly catched. Chances are 48 | -- that if the destructor fails, the context already has 49 | -- vanished and thus we do not need to worry about 50 | -- anything. 51 | null; 52 | end; 53 | end if; 54 | Free (Reference); 55 | end if; 56 | end if; 57 | end Finalize; 58 | 59 | function Initialized (Object : GL_Object) return Boolean is 60 | begin 61 | return Object.Reference /= null; 62 | end Initialized; 63 | 64 | function Raw_Id (Object : GL_Object) return UInt is 65 | begin 66 | return Object.Reference.GL_Id; 67 | end Raw_Id; 68 | 69 | procedure Set_Raw_Id (Object : in out GL_Object; Id : UInt; 70 | Owned : Boolean := True) is 71 | begin 72 | Object.Finalize; 73 | -- must create a new holder object for this ID. therefore, we are 74 | -- dropping the reference to the old ID. 75 | 76 | Object.Reference := 77 | new GL_Object_Reference'(GL_Id => Id, Reference_Count => 1, 78 | Is_Owner => Owned); 79 | end Set_Raw_Id; 80 | 81 | function "=" (Left, Right : GL_Object) return Boolean is 82 | begin 83 | return Left.Reference = Right.Reference; 84 | end "="; 85 | 86 | procedure Clear (Object : in out GL_Object) renames Finalize; 87 | 88 | end GL.Objects; 89 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-raster.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Raster is 7 | procedure Set_Pos (Position : Vector2) is 8 | begin 9 | API.Raster_Pos2 (Position); 10 | end Set_Pos; 11 | 12 | procedure Set_Pos (Position : Vector3) is 13 | begin 14 | API.Raster_Pos3 (Position); 15 | end Set_Pos; 16 | 17 | procedure Set_Pos (Position : Vector4) is 18 | begin 19 | API.Raster_Pos4 (Position); 20 | end Set_Pos; 21 | end GL.Raster; 22 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-rasterization.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Culling; 6 | with GL.Enums.Getter; 7 | 8 | package body GL.Rasterization is 9 | 10 | procedure Set_Line_Width (Value : Single) is 11 | begin 12 | API.Line_Width (Value); 13 | Raise_Exception_On_OpenGL_Error; 14 | end Set_Line_Width; 15 | 16 | function Line_Width return Single is 17 | Ret : aliased Single; 18 | begin 19 | API.Get_Single (Enums.Getter.Line_Width, Ret'Access); 20 | Raise_Exception_On_OpenGL_Error; 21 | return Ret; 22 | end Line_Width; 23 | 24 | function Aliased_Line_Width_Range return Line_Width_Range is 25 | Ret : Singles.Vector2 := (others => <>); 26 | begin 27 | API.Get_Single_Vec2 (Enums.Getter.Aliased_Line_Width_Range, Ret); 28 | Raise_Exception_On_OpenGL_Error; 29 | return Ret; 30 | end Aliased_Line_Width_Range; 31 | 32 | function Smooth_Line_Width_Range return Line_Width_Range is 33 | Ret : Singles.Vector2 := (others => <>); 34 | begin 35 | API.Get_Single_Vec2 (Enums.Getter.Smooth_Line_Width_Range, Ret); 36 | Raise_Exception_On_OpenGL_Error; 37 | return Ret; 38 | end Smooth_Line_Width_Range; 39 | 40 | function Smooth_Line_Width_Granularity return Single is 41 | Ret : aliased Single; 42 | begin 43 | API.Get_Single (Enums.Getter.Smooth_Line_Width_Granularity, Ret'Access); 44 | Raise_Exception_On_OpenGL_Error; 45 | return Ret; 46 | end Smooth_Line_Width_Granularity; 47 | 48 | procedure Set_Polygon_Mode (Value : Polygon_Mode_Type) is 49 | begin 50 | API.Polygon_Mode (Culling.Front_And_Back, Value); 51 | Raise_Exception_On_OpenGL_Error; 52 | end Set_Polygon_Mode; 53 | 54 | function Polygon_Mode return Polygon_Mode_Type is 55 | Ret : aliased Polygon_Mode_Type; 56 | begin 57 | API.Get_Polygon_Mode (Enums.Getter.Polygon_Mode, Ret'Access); 58 | Raise_Exception_On_OpenGL_Error; 59 | return Ret; 60 | end Polygon_Mode; 61 | 62 | procedure Set_Polygon_Offset (Factor, Units : Single := 0.0) is 63 | begin 64 | API.Set_Polygon_Offset (Factor, Units); 65 | Raise_Exception_On_OpenGL_Error; 66 | end Set_Polygon_Offset; 67 | 68 | procedure Set_Point_Size (Value : Single) is 69 | begin 70 | API.Set_Point_Size (Value); 71 | Raise_Exception_On_OpenGL_Error; 72 | end Set_Point_Size; 73 | 74 | function Point_Size return Single is 75 | Ret : aliased Single := 0.0; 76 | begin 77 | API.Get_Single (Enums.Getter.Point_Size, Ret'Access); 78 | Raise_Exception_On_OpenGL_Error; 79 | return Ret; 80 | end Point_Size; 81 | 82 | function Point_Size_Range return Singles.Vector2 is 83 | Ret : Singles.Vector2 := Singles.Vector2'(0.0, 0.0); 84 | begin 85 | API.Get_Single_Vec2 (Enums.Getter.Point_Size_Range, Ret); 86 | Raise_Exception_On_OpenGL_Error; 87 | return Ret; 88 | end Point_Size_Range; 89 | 90 | function Point_Size_Granularity return Single is 91 | Ret : aliased Single := 0.0; 92 | begin 93 | API.Get_Single (Enums.Getter.Point_Size_Granularity, Ret'Access); 94 | Raise_Exception_On_OpenGL_Error; 95 | return Ret; 96 | end Point_Size_Granularity; 97 | 98 | procedure Set_Point_Fade_Threshold_Size (Value : Single) is 99 | begin 100 | API.Set_Point_Parameter_Single (Enums.Fade_Threshold_Size, Value); 101 | Raise_Exception_On_OpenGL_Error; 102 | end Set_Point_Fade_Threshold_Size; 103 | 104 | function Point_Fade_Threshold_Size return Single is 105 | Ret : aliased Single := 0.0; 106 | begin 107 | API.Get_Single (Enums.Getter.Point_Fade_Threshold_Size, Ret'Access); 108 | Raise_Exception_On_OpenGL_Error; 109 | return Ret; 110 | end Point_Fade_Threshold_Size; 111 | 112 | end GL.Rasterization; 113 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-tessellation.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums; 6 | 7 | package body GL.Tessellation is 8 | 9 | procedure Set_Patch_Vertices (Value : Int) is 10 | begin 11 | API.Set_Patch_Parameter_Int (Enums.Vertices, Value); 12 | end Set_Patch_Vertices; 13 | 14 | procedure Set_Patch_Default_Inner_Level (Values : Single_Array) is 15 | begin 16 | API.Set_Patch_Parameter_Float_Array (Enums.Default_Inner_Level, Values); 17 | end Set_Patch_Default_Inner_Level; 18 | 19 | procedure Set_Patch_Default_Outer_Level (Values : Single_Array) is 20 | begin 21 | API.Set_Patch_Parameter_Float_Array (Enums.Default_Outer_Level, Values); 22 | end Set_Patch_Default_Outer_Level; 23 | end GL.Tessellation; 24 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-toggles.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | 6 | package body GL.Toggles is 7 | procedure Enable (Subject : Toggle) is 8 | begin 9 | API.Enable (Subject); 10 | Raise_Exception_On_OpenGL_Error; 11 | end Enable; 12 | 13 | procedure Disable (Subject : Toggle) is 14 | begin 15 | API.Disable (Subject); 16 | Raise_Exception_On_OpenGL_Error; 17 | end Disable; 18 | 19 | procedure Set (Subject : Toggle; Value : Toggle_State) is 20 | begin 21 | if Value = Disabled then 22 | API.Disable (Subject); 23 | else 24 | API.Enable (Subject); 25 | end if; 26 | Raise_Exception_On_OpenGL_Error; 27 | end Set; 28 | 29 | function State (Subject : Toggle) return Toggle_State is 30 | Value : constant Low_Level.Bool := API.Is_Enabled (Subject); 31 | begin 32 | Raise_Exception_On_OpenGL_Error; 33 | if Value then 34 | return Enabled; 35 | else 36 | return Disabled; 37 | end if; 38 | end State; 39 | end GL.Toggles; -------------------------------------------------------------------------------- /opengl/src/implementation/gl-vectors.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.Vectors is 5 | function "+" (Left, Right : Vector) return Vector is 6 | Ret : Vector; 7 | begin 8 | for I in Index_Type'Range loop 9 | Ret (I) := Left (I) + Right (I); 10 | end loop; 11 | return Ret; 12 | end "+"; 13 | 14 | function "-" (Left, Right : Vector) return Vector is 15 | Ret : Vector; 16 | begin 17 | for I in Index_Type'Range loop 18 | Ret (I) := Left (I) - Right (I); 19 | end loop; 20 | return Ret; 21 | end "-"; 22 | 23 | function "-" (Left : Vector) return Vector is 24 | Ret : Vector; 25 | begin 26 | for I in Index_Type loop 27 | Ret (I) := -Left (I); 28 | end loop; 29 | return Ret; 30 | end "-"; 31 | 32 | function "*" (Left : Vector; Right : Element_Type) return Vector is 33 | Ret : Vector; 34 | begin 35 | for I in Index_Type'Range loop 36 | Ret (I) := Left (I) * Right; 37 | end loop; 38 | return Ret; 39 | end "*"; 40 | 41 | function "*" (Left : Element_Type; Right : Vector) return Vector is 42 | begin 43 | return Right * Left; 44 | end "*"; 45 | 46 | function "/" (Left : Vector; Right : Element_Type) return Vector is 47 | Ret : Vector; 48 | begin 49 | for I in Index_Type'Range loop 50 | Ret (I) := Left (I) / Right; 51 | end loop; 52 | return Ret; 53 | end "/"; 54 | 55 | function Dot_Product (Left, Right : Vector) return Element_Type is 56 | Ret : Element_Type; 57 | begin 58 | Ret := Left (Left'First) * Right (Right'First); 59 | for Index in Index_Type'Succ (Index_Type'First) .. Index_Type'Last loop 60 | Ret := Ret + Left (Index) * Right (Index); 61 | end loop; 62 | return Ret; 63 | end Dot_Product; 64 | 65 | end GL.Vectors; 66 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl-window.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Enums.Getter; 6 | 7 | package body GL.Window is 8 | 9 | procedure Set_Viewport (X, Y : Int; Width, Height : Size) is 10 | begin 11 | GL.API.Viewport (X, Y, Width, Height); 12 | Raise_Exception_On_OpenGL_Error; 13 | end Set_Viewport; 14 | 15 | procedure Get_Viewport (X, Y : out Int; Width, Height : out Size) is 16 | Ret : Ints.Vector4; 17 | begin 18 | API.Get_Int_Vec4 (Enums.Getter.Viewport, Ret); 19 | Raise_Exception_On_OpenGL_Error; 20 | X := Ret (GL.X); 21 | Y := Ret (GL.Y); 22 | Width := Size (Ret (Z)); 23 | Height := Size (Ret (W)); 24 | end Get_Viewport; 25 | 26 | procedure Set_Depth_Range (Near, Far : Double) is 27 | begin 28 | API.Depth_Range (Near, Far); 29 | Raise_Exception_On_OpenGL_Error; 30 | end Set_Depth_Range; 31 | 32 | procedure Get_Depth_Range (Near, Far : out Double) is 33 | Ret : Doubles.Vector2; 34 | begin 35 | API.Get_Double_Vec2 (Enums.Getter.Depth_Range, Ret); 36 | Raise_Exception_On_OpenGL_Error; 37 | Near := Ret (X); 38 | Far := Ret (Y); 39 | end Get_Depth_Range; 40 | 41 | end GL.Window; 42 | -------------------------------------------------------------------------------- /opengl/src/implementation/gl.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.API; 5 | with GL.Load_Function_Pointers; 6 | 7 | package body GL is 8 | 9 | procedure Init renames GL.Load_Function_Pointers; 10 | 11 | procedure Flush is 12 | begin 13 | API.Flush; 14 | end Flush; 15 | 16 | procedure Finish is 17 | begin 18 | API.Finish; 19 | end Finish; 20 | 21 | -- implementation depends on whether Auto_Exceptions has been enabled. 22 | procedure Raise_Exception_On_OpenGL_Error is separate; 23 | end GL; 24 | -------------------------------------------------------------------------------- /opengl/src/implementation/no_auto_exceptions/gl-raise_exception_on_opengl_error.adb: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- Copyright (c) 2012, Felix Krause 3 | -- 4 | -- Permission to use, copy, modify, and/or distribute this software for any 5 | -- purpose with or without fee is hereby granted, provided that the above 6 | -- copyright notice and this permission notice appear in all copies. 7 | -- 8 | -- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | -- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | -- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | -- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | -- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | -- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | -- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | -------------------------------------------------------------------------------- 16 | 17 | separate (GL) 18 | procedure Raise_Exception_On_OpenGL_Error is 19 | begin 20 | null; 21 | end Raise_Exception_On_OpenGL_Error; 22 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-blending.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Buffers; 5 | with GL.Types.Colors; 6 | 7 | private with GL.Low_Level; 8 | 9 | package GL.Blending is 10 | pragma Preelaborate; 11 | 12 | type Blend_Factor is (Zero, One, Src_Color, One_Minus_Src_Color, Src_Alpha, 13 | One_Minus_Src_Alpha, Dst_Alpha, One_Minus_Dst_Alpha, 14 | Dst_Color, One_Minus_Dst_Color, Src_Alpha_Saturate, 15 | Constant_Color, One_Minus_Constant_Color, 16 | Constant_Alpha, One_Minus_Constant_Alpha, Src1_Alpha, 17 | Src1_Color, One_Minus_Src1_Color, 18 | One_Minus_Src1_Alpha); 19 | 20 | type Equation is (Func_Add, Min, Max, Func_Subtract, Func_Reverse_Substract); 21 | 22 | procedure Set_Blend_Func (Src_Factor, Dst_Factor : Blend_Factor); 23 | procedure Set_Blend_Func (Draw_Buffer : Buffers.Draw_Buffer_Index; 24 | Src_Factor, Dst_Factor : Blend_Factor); 25 | 26 | procedure Set_Blend_Func_Separate (Src_RGB, Dst_RGB, Src_Alpha, Dst_Alpha 27 | : Blend_Factor); 28 | procedure Set_Blend_Func_Separate (Draw_Buffer : Buffers.Draw_Buffer_Index; 29 | Src_RGB, Dst_RGB, Src_Alpha, Dst_Alpha 30 | : Blend_Factor); 31 | 32 | function Blend_Func_Src_RGB return Blend_Factor; 33 | function Blend_Func_Src_Alpha return Blend_Factor; 34 | function Blend_Func_Dst_RGB return Blend_Factor; 35 | function Blend_Func_Dst_Alpha return Blend_Factor; 36 | 37 | procedure Set_Blend_Color (Value : Types.Colors.Color); 38 | function Blend_Color return Types.Colors.Color; 39 | 40 | procedure Set_Blend_Equation (Value : Equation); 41 | procedure Set_Blend_Equation (Draw_Buffer : Buffers.Draw_Buffer_Index; 42 | Value : Equation); 43 | 44 | procedure Set_Blend_Equation_Separate (RGB, Alpha : Equation); 45 | procedure Set_Blend_Equation_Separate 46 | (Draw_Buffer : Buffers.Draw_Buffer_Index; RGB, Alpha : Equation); 47 | 48 | function Blend_Equation_RGB return Equation; 49 | function Blend_Equation_Alpha return Equation; 50 | 51 | private 52 | for Blend_Factor use (Zero => 0, 53 | One => 1, 54 | Src_Color => 16#0300#, 55 | One_Minus_Src_Color => 16#0301#, 56 | Src_Alpha => 16#0302#, 57 | One_Minus_Src_Alpha => 16#0303#, 58 | Dst_Alpha => 16#0304#, 59 | One_Minus_Dst_Alpha => 16#0305#, 60 | Dst_Color => 16#0306#, 61 | One_Minus_Dst_Color => 16#0307#, 62 | Src_Alpha_Saturate => 16#0308#, 63 | Constant_Color => 16#8001#, 64 | One_Minus_Constant_Color => 16#8002#, 65 | Constant_Alpha => 16#8003#, 66 | One_Minus_Constant_Alpha => 16#8004#, 67 | Src1_Alpha => 16#8589#, 68 | Src1_Color => 16#88F9#, 69 | One_Minus_Src1_Color => 16#88FA#, 70 | One_Minus_Src1_Alpha => 16#88FB#); 71 | for Blend_Factor'Size use Low_Level.Enum'Size; 72 | 73 | for Equation use (Func_Add => 16#8006#, 74 | Min => 16#8007#, 75 | Max => 16#8008#, 76 | Func_Subtract => 16#800A#, 77 | Func_Reverse_Substract => 16#800B#); 78 | for Equation'Size use Low_Level.Enum'Size; 79 | end GL.Blending; 80 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-context.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Strings.Unbounded; 5 | 6 | with GL.Types; 7 | 8 | package GL.Context is 9 | pragma Preelaborate; 10 | 11 | use GL.Types; 12 | 13 | type String_List is array (Positive range <>) of 14 | Ada.Strings.Unbounded.Unbounded_String; 15 | 16 | Null_String_List : constant String_List := (2 .. 1 => <>); 17 | 18 | -- these two require OpenGL 3: 19 | function Major_Version return Int; 20 | function Minor_Version return Int; 21 | 22 | -- legacy (deprecated in OpenGL 3) 23 | function Version_String return String; 24 | 25 | function Vendor return String; 26 | 27 | function Renderer return String; 28 | 29 | -- uses OpenGL 3 interface if available, otherwise old interface 30 | function Extensions return String_List; 31 | function Has_Extension (Name : String) return Boolean; 32 | 33 | function Primary_Shading_Language_Version return String; 34 | 35 | -- available since OpenGL 4.3: 36 | function Supported_Shading_Language_Versions return String_List; 37 | function Supports_Shading_Language_Version (Name : String) return Boolean; 38 | end GL.Context; 39 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-culling.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | private with GL.Low_Level; 7 | 8 | package GL.Culling is 9 | pragma Preelaborate; 10 | 11 | type Face_Selector is (Front, Back, Front_And_Back); 12 | 13 | use GL.Types; 14 | 15 | procedure Set_Front_Face (Face : Orientation); 16 | function Front_Face return Orientation; 17 | 18 | procedure Set_Cull_Face (Selector : Face_Selector); 19 | function Cull_Face return Face_Selector; 20 | 21 | private 22 | 23 | for Face_Selector use (Front => 16#0404#, 24 | Back => 16#0405#, 25 | Front_And_Back => 16#0408#); 26 | for Face_Selector'Size use Low_Level.Enum'Size; 27 | 28 | pragma Convention (StdCall, Set_Cull_Face); 29 | pragma Convention (StdCall, Set_Front_Face); 30 | end GL.Culling; 31 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-errors.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with GL.Low_Level; 5 | 6 | package GL.Errors is 7 | -- not Pure because Error_Flag can change with each call 8 | pragma Preelaborate; 9 | 10 | -- The behavior of this package depends on the scenario variable 11 | -- Auto_Exceptions. If enabled, every call to OpenGL will be followed by 12 | -- a call to glGetError, and if an error flag is set, the corresponding 13 | -- exception will be raised. 14 | -- 15 | -- If disabled, the user has to check manually for the OpenGL error flag by 16 | -- calling Error_Flag. 17 | 18 | type Error_Code is (No_Error, Invalid_Enum, Invalid_Value, Invalid_Operation, 19 | Stack_Overflow, Stack_Underflow, Out_Of_Memory, 20 | Invalid_Framebuffer_Operation); 21 | 22 | Invalid_Operation_Error : exception; 23 | Out_Of_Memory_Error : exception; 24 | Invalid_Value_Error : exception; 25 | Stack_Overflow_Error : exception; 26 | Stack_Underflow_Error : exception; 27 | Invalid_Framebuffer_Operation_Error : exception; 28 | 29 | Internal_Error : exception; 30 | 31 | function Error_Flag return Error_Code; 32 | 33 | private 34 | for Error_Code use (No_Error => 0, 35 | Invalid_Enum => 16#0500#, 36 | Invalid_Value => 16#0501#, 37 | Invalid_Operation => 16#0502#, 38 | Stack_Overflow => 16#0503#, 39 | Stack_Underflow => 16#0504#, 40 | Out_Of_Memory => 16#0505#, 41 | Invalid_Framebuffer_Operation => 16#0506#); 42 | for Error_Code'Size use Low_Level.Enum'Size; 43 | 44 | -- because we'll just use renames 45 | pragma Convention (StdCall, Error_Flag); 46 | end GL.Errors; 47 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-files.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Objects.Shaders; 5 | 6 | -- This package is an addition to the original OpenGL API and simplifies 7 | -- the handling of ressources located in files, like shader sources. 8 | package GL.Files is 9 | 10 | procedure Load_Shader_Source_From_File (Object : Objects.Shaders.Shader; 11 | File_Name : String); 12 | 13 | end GL.Files; 14 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-fixed-lighting.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types.Colors; 5 | 6 | private with GL.Low_Level; 7 | private with GL.Toggles; 8 | 9 | package GL.Fixed.Lighting is 10 | pragma Preelaborate; 11 | 12 | type Color_Control is (Single_Color, Separate_Specular_Color); 13 | type Shade_Model is (Flat, Smooth); 14 | 15 | ---------------------------------------------------------------------------- 16 | -- Global Lighting Configuration -- 17 | ---------------------------------------------------------------------------- 18 | 19 | procedure Enable_Lighting; 20 | procedure Disable_Lighting; 21 | function Lighting_Enabled return Boolean; 22 | 23 | procedure Enable_Local_Viewer; 24 | procedure Disable_Local_Viewer; 25 | function Local_Viewer_Enabled return Boolean; 26 | 27 | procedure Enable_Two_Side; 28 | procedure Disable_Two_Side; 29 | function Two_Side_Enabled return Boolean; 30 | 31 | procedure Set_Global_Ambient_Light (Value : Colors.Color); 32 | function Global_Ambient_Light return Colors.Color; 33 | 34 | procedure Set_Color_Control (Value : Color_Control); 35 | function Current_Color_Control return Color_Control; 36 | 37 | procedure Set_Shade_Model (Value : Shade_Model); 38 | function Current_Shade_Model return Shade_Model; 39 | 40 | ---------------------------------------------------------------------------- 41 | -- Light Objects -- 42 | ---------------------------------------------------------------------------- 43 | 44 | type Light_Object (<>) is tagged private; 45 | type Light_Index is range 0 .. 7; 46 | 47 | procedure Enable (Source : Light_Object); 48 | procedure Disable (Source : Light_Object); 49 | function Enabled (Source : Light_Object) return Boolean; 50 | 51 | procedure Set_Ambient (Source : Light_Object; Color : Colors.Color); 52 | function Ambient (Source : Light_Object) return Colors.Color; 53 | 54 | procedure Set_Diffuse (Source : Light_Object; Color : Colors.Color); 55 | function Diffuse (Source : Light_Object) return Colors.Color; 56 | 57 | procedure Set_Specular (Source : Light_Object; Color : Colors.Color); 58 | function Specular (Source : Light_Object) return Colors.Color; 59 | 60 | procedure Set_Position (Source : Light_Object; 61 | Position : Types.Singles.Vector4); 62 | function Position (Source : Light_Object) return Types.Singles.Vector4; 63 | 64 | procedure Set_Spot_Direction (Source : Light_Object; 65 | Direction : Types.Singles.Vector3); 66 | function Spot_Direction (Source : Light_Object) return Types.Singles.Vector3; 67 | 68 | -- TBD: spot exponent, spot cutoff, attenduation 69 | 70 | function Light (Index : Light_Index) return Light_Object; 71 | 72 | private 73 | type Light_Object (Identifier : Toggles.Toggle) is tagged null record; 74 | 75 | for Color_Control use (Single_Color => 16#81F9#, 76 | Separate_Specular_Color => 16#81FA#); 77 | for Color_Control'Size use Low_Level.Enum'Size; 78 | 79 | for Shade_Model use (Flat => 16#1D00#, 80 | Smooth => 16#1D01#); 81 | for Shade_Model'Size use Low_Level.Enum'Size; 82 | 83 | end GL.Fixed.Lighting; 84 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-fixed-matrix.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | private with GL.Enums; 7 | 8 | -- Matrix stack API. This API is deprecated as of OpenGL 3.0. 9 | package GL.Fixed.Matrix is 10 | 11 | use GL.Types.Doubles; 12 | 13 | type Matrix_Stack (<>) is tagged private; 14 | 15 | Modelview : constant Matrix_Stack; 16 | Projection : constant Matrix_Stack; 17 | Texture : constant Matrix_Stack; 18 | Color : constant Matrix_Stack; 19 | 20 | procedure Apply_Frustum (Stack : Matrix_Stack; 21 | Left, Right, Bottom, Top, Near, Far : Double); 22 | procedure Apply_Orthogonal (Stack : Matrix_Stack; 23 | Left, Right, Bottom, Top, Near, Far : Double); 24 | 25 | procedure Load_Identity (Stack : Matrix_Stack); 26 | procedure Load_Matrix (Stack : Matrix_Stack; Value : Matrix4); 27 | 28 | procedure Apply_Multiplication (Stack : Matrix_Stack; Factor : Matrix4); 29 | procedure Apply_Multiplication (Stack : Matrix_Stack; Factor : Double); 30 | 31 | procedure Push (Stack : Matrix_Stack); 32 | procedure Pop (Stack : Matrix_Stack); 33 | 34 | procedure Apply_Rotation (Stack : Matrix_Stack; Angle : Double; 35 | Axis : Vector3); 36 | procedure Apply_Rotation (Stack : Matrix_Stack; Angle, X, Y, Z : Double); 37 | 38 | procedure Apply_Scaling (Stack : Matrix_Stack; X, Y, Z : Double); 39 | 40 | procedure Apply_Translation (Stack : Matrix_Stack; Along : Vector3); 41 | procedure Apply_Translation (Stack : Matrix_Stack; X, Y, Z : Double); 42 | 43 | private 44 | type Matrix_Stack (Mode : Enums.Matrix_Mode) is tagged null record; 45 | 46 | Modelview : constant Matrix_Stack := Matrix_Stack'(Mode => Enums.Modelview); 47 | Projection : constant Matrix_Stack := Matrix_Stack'(Mode => Enums.Projection); 48 | Texture : constant Matrix_Stack := Matrix_Stack'(Mode => Enums.Texture); 49 | Color : constant Matrix_Stack := Matrix_Stack'(Mode => Enums.Color); 50 | end GL.Fixed.Matrix; 51 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-fixed-textures.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Low_Level; 5 | with GL.Types.Colors; 6 | 7 | package GL.Fixed.Textures is 8 | pragma Preelaborate; 9 | 10 | type Texture_Function is (Add, Blend, Replace, Modulate, Decal, Combine); 11 | type Combine_Function is (Add, Replace, Modulate, Subtract, Add_Signed, 12 | Interpolate, Dot3_RGB, Dot3_RGBA); 13 | 14 | -- needs to be declared here because of following subtype declaration 15 | for Combine_Function use (Add => 16#0104#, 16 | Replace => 16#1E01#, 17 | Modulate => 16#2100#, 18 | Subtract => 16#84E7#, 19 | Add_Signed => 16#8574#, 20 | Interpolate => 16#8575#, 21 | Dot3_RGB => 16#86AE#, 22 | Dot3_RGBA => 16#86AF#); 23 | for Combine_Function'Size use Low_Level.Enum'Size; 24 | 25 | subtype Alpha_Combine_Function is Combine_Function range Add .. Interpolate; 26 | 27 | type Source_Kind is (Texture, Constant_Src, Primary_Color, Previous); 28 | 29 | subtype Scaling_Factor is Double range 1.0 .. 4.0; 30 | 31 | type Source_Index is range 0 .. 2; 32 | 33 | procedure Set_Tex_Function (Func : Texture_Function); 34 | function Tex_Function return Texture_Function; 35 | 36 | procedure Set_RGB_Combine (Func : Combine_Function); 37 | function RGB_Combine return Combine_Function; 38 | 39 | procedure Set_Alpha_Combine (Func : Alpha_Combine_Function); 40 | function Alpha_Combine return Alpha_Combine_Function; 41 | 42 | procedure Set_RGB_Source (Source : Source_Kind; Index : Source_Index); 43 | function RGB_Source (Index : Source_Index) return Source_Kind; 44 | 45 | procedure Set_Alpha_Source (Source : Source_Kind; Index : Source_Index); 46 | function Alpha_Source (Index : Source_Index) return Source_Kind; 47 | 48 | procedure Set_RGB_Scale (Value : Scaling_Factor); 49 | function RGB_Scale return Scaling_Factor; 50 | 51 | procedure Set_Alpha_Scale (Value : Scaling_Factor); 52 | function Alpha_Scale return Scaling_Factor; 53 | 54 | procedure Set_LoD_Bias (Value : Double); 55 | function LoD_Bias return Double; 56 | 57 | procedure Set_Env_Color (Value : Colors.Color); 58 | function Env_Color return Colors.Color; 59 | 60 | procedure Toggle_Point_Sprite_Coord_Replace (Enabled : Boolean); 61 | function Point_Sprite_Coord_Replace return Boolean; 62 | 63 | private 64 | for Texture_Function use (Add => 16#0104#, 65 | Blend => 16#0BE2#, 66 | Replace => 16#1E01#, 67 | Modulate => 16#2100#, 68 | Decal => 16#2101#, 69 | Combine => 16#8570#); 70 | for Texture_Function'Size use Low_Level.Enum'Size; 71 | 72 | for Source_Kind use (Texture => 16#1702#, 73 | Constant_Src => 16#8576#, 74 | Primary_Color => 16#8577#, 75 | Previous => 16#8578#); 76 | for Source_Kind'Size use Low_Level.Enum'Size; 77 | 78 | end GL.Fixed.Textures; 79 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-fixed.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | private with GL.Low_Level; 7 | 8 | -- Fixed function pipeline. Deprecated in OpenGL 3.0. 9 | package GL.Fixed is 10 | pragma Preelaborate; 11 | 12 | use GL.Types; 13 | 14 | subtype Vertex_Length is Positive range 2 .. 4; 15 | 16 | type Client_Side_Capability is (Vertex_Array, Normal_Array, Color_Array, 17 | Index_Array, Texture_Coord_Array, 18 | Edge_Flag_Array, Fog_Coord_Array, 19 | Secondary_Color_Array); 20 | 21 | procedure Set_Vertex_Pointer (Length : Vertex_Length; Stride, Offset : Size); 22 | procedure Set_Color_Pointer (Stride, Offset : Size); 23 | 24 | procedure Enable (Capability : Client_Side_Capability); 25 | procedure Disable (Capability : Client_Side_Capability); 26 | 27 | private 28 | for Client_Side_Capability use (Vertex_Array => 16#8074#, 29 | Normal_Array => 16#8075#, 30 | Color_Array => 16#8076#, 31 | Index_Array => 16#8077#, 32 | Texture_Coord_Array => 16#8078#, 33 | Edge_Flag_Array => 16#8079#, 34 | Fog_Coord_Array => 16#8457#, 35 | Secondary_Color_Array => 16#845E#); 36 | for Client_Side_Capability'Size use Low_Level.Enum'Size; 37 | end GL.Fixed; 38 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-framebuffer.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Buffers; 5 | with GL.Pixels; 6 | with GL.Types; 7 | 8 | private with GL.Low_Level; 9 | 10 | package GL.Framebuffer is 11 | pragma Preelaborate; 12 | 13 | use GL.Types; 14 | 15 | type Logic_Op is (Clear, And_Op, And_Reverse, Copy, And_Inverted, Noop, 16 | Xor_Op, Or_Op, Nor, Equiv, Invert, Or_Reverse, 17 | Copy_Inverted, Or_Inverted, Nand, Set); 18 | 19 | subtype Read_Buffer_Selector is Buffers.Color_Buffer_Selector range 20 | Buffers.None .. Buffers.Right; 21 | 22 | -- this package provides functionality the works implicitly on the current 23 | -- framebuffer. for working with framebuffer objects, 24 | -- see GL.Objects.Framebuffers. 25 | 26 | procedure Set_Clamp_Read_Color (Enabled : Boolean); 27 | 28 | procedure Set_Read_Buffer (Value : Read_Buffer_Selector); 29 | function Read_Buffer return Read_Buffer_Selector; 30 | 31 | generic 32 | type Element_Type is private; 33 | type Index_Type is (<>); 34 | type Array_Type is array (Index_Type range <>) of aliased Element_Type; 35 | procedure Read_Pixels (X, Y : Int; Width, Height : Size; 36 | Format : Pixels.Framebuffer_Format; 37 | Data_Type : Pixels.Data_Type; Data : out Array_Type); 38 | 39 | procedure Set_Logic_Op_Mode (Value : Logic_Op); 40 | function Logic_Op_Mode return Logic_Op; 41 | private 42 | for Logic_Op use (Clear => 16#1500#, 43 | And_Op => 16#1501#, 44 | And_Reverse => 16#1502#, 45 | Copy => 16#1503#, 46 | And_Inverted => 16#1504#, 47 | Noop => 16#1505#, 48 | Xor_Op => 16#1506#, 49 | Or_Op => 16#1507#, 50 | Nor => 16#1508#, 51 | Equiv => 16#1509#, 52 | Invert => 16#150A#, 53 | Or_Reverse => 16#150B#, 54 | Copy_Inverted => 16#150C#, 55 | Or_Inverted => 16#150D#, 56 | Nand => 16#150E#, 57 | Set => 16#150F#); 58 | for Logic_Op'Size use Low_Level.Enum'Size; 59 | end GL.Framebuffer; 60 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-immediate.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Finalization; 5 | 6 | with GL.Types.Colors; 7 | 8 | -- This package provides functions to directly insert vertices, colors, normals 9 | -- etc. into the pipeline. Note that these functions have been deprecated with 10 | -- OpenGL 3, you should use VBOs instead. 11 | package GL.Immediate is 12 | pragma Preelaborate; 13 | 14 | use GL.Types; 15 | use GL.Types.Doubles; 16 | 17 | type Input_Token (<>) is new Ada.Finalization.Limited_Controlled with private; 18 | 19 | overriding procedure Finalize (Token : in out Input_Token); 20 | 21 | function Start (Mode : Connection_Mode) return Input_Token; 22 | 23 | procedure Add_Vertex (Token : Input_Token; Vertex : Vector2); 24 | procedure Add_Vertex (Token : Input_Token; Vertex : Vector3); 25 | procedure Add_Vertex (Token : Input_Token; Vertex : Vector4); 26 | 27 | procedure Set_Color (Value : Colors.Color); 28 | function Current_Color return Colors.Color; 29 | 30 | procedure Set_Secondary_Color (Value : Colors.Color); 31 | function Current_Secondary_Color return Colors.Color; 32 | 33 | procedure Set_Fog_Distance (Value : Double); 34 | function Current_Fog_Distance return Double; 35 | 36 | procedure Set_Normal (Value : Vector3); 37 | function Current_Normal return Vector3; 38 | 39 | procedure Set_Texture_Coordinates (Value : Vector2); 40 | procedure Set_Texture_Coordinates (Value : Vector3); 41 | procedure Set_Texture_Coordinates (Value : Vector4); 42 | function Current_Texture_Coordinates return Vector4; 43 | 44 | 45 | private 46 | type Input_Token (Mode : Connection_Mode) is 47 | new Ada.Finalization.Limited_Controlled with record 48 | Finalized : Boolean := True; 49 | end record; 50 | end GL.Immediate; 51 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-matrices.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Index_Type is (<>); 6 | type Element_Type is private; 7 | with function "+" (Left, Right : Element_Type) return Element_Type is <>; 8 | with function "-" (Left, Right : Element_Type) return Element_Type is <>; 9 | with function "-" (Left : Element_Type) return Element_Type is <>; 10 | with function "*" (Left, Right : Element_Type) return Element_Type is <>; 11 | -- not needed currently 12 | --with function "/" (Left, Right : Element_Type) return Element_Type is <>; 13 | type Vector_Type is array (Index_Type) of aliased Element_Type; 14 | package GL.Matrices is 15 | pragma Preelaborate; 16 | 17 | -- this matrix is column-major (i.e. the first index defines the column, 18 | -- the second index defines the row). 19 | -- this is important for interoperability with GLSL. 20 | type Matrix is array (Index_Type, Index_Type) of aliased Element_Type; 21 | 22 | function "+" (Left, Right : Matrix) return Matrix; 23 | function "-" (Left, Right : Matrix) return Matrix; 24 | function "-" (Left : Matrix) return Matrix; 25 | 26 | -- This is not element-wise but mathematical matrix multiplication. 27 | function "*" (Left, Right : Matrix) return Matrix; 28 | 29 | function "*" (Left : Matrix; Right : Vector_Type) return Vector_Type; 30 | 31 | function "*" (Left : Matrix; Right : Element_Type) return Matrix; 32 | function "*" (Left : Element_Type; Right : Matrix) return Matrix; 33 | 34 | function Transpose (Subject : Matrix) return Matrix; 35 | 36 | pragma Inline ("+"); 37 | pragma Inline ("-"); 38 | pragma Inline ("*"); 39 | pragma Inline (Transpose); 40 | 41 | pragma Convention (C, Matrix); 42 | end GL.Matrices; 43 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-lists.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Object_Type (<>) is new GL_Object with private; 6 | with function Generate_From_Id (Id : UInt) return Object_Type; 7 | package GL.Objects.Lists is 8 | pragma Preelaborate; 9 | 10 | type List (<>) is tagged private; 11 | 12 | type Cursor is private; 13 | 14 | No_Element : constant Cursor; 15 | 16 | function Create (Raw : UInt_Array) return List; 17 | 18 | function First (Object : List) return Cursor; 19 | function Last (Object : List) return Cursor; 20 | 21 | function Next (Current : Cursor) return Cursor; 22 | function Previous (Current : Cursor) return Cursor; 23 | 24 | function Has_Next (Current : Cursor) return Boolean; 25 | function Has_Previous (Current : Cursor) return Boolean; 26 | 27 | function Element (Current : Cursor) return Object_Type; 28 | 29 | private 30 | type List (Count : Size) is tagged record 31 | Contents : UInt_Array (1 .. Count); 32 | end record; 33 | 34 | type List_Access is access constant List; 35 | 36 | type Cursor is record 37 | Object : List_Access; 38 | Index : Size; 39 | end record; 40 | 41 | No_Element : constant Cursor := Cursor'(null, 0); 42 | 43 | end GL.Objects.Lists; 44 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-queries.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Low_Level.Enums; 5 | 6 | package GL.Objects.Queries is 7 | pragma Preelaborate; 8 | 9 | type Query_Object is new GL_Object with private; 10 | 11 | Default_Query : constant Query_Object; 12 | 13 | procedure Begin_Query (Target : GL.Low_Level.Enums.Query_Param; 14 | Object : Query_Object); 15 | 16 | procedure End_Query (Target : GL.Low_Level.Enums.Query_Param); 17 | 18 | procedure Begin_Query_Indexed (Target : GL.Low_Level.Enums.Query_Param; 19 | Index : UInt; Object : Query_Object); 20 | 21 | procedure End_Query_Indexed (Target : GL.Low_Level.Enums.Query_Param; 22 | Index : UInt); 23 | 24 | procedure Get_Query_Object (Object : Query_Object; 25 | Pname : GL.Low_Level.Enums.Query_Results; 26 | Params : out UInt); 27 | 28 | function Is_Query (Query : Query_Object) return Boolean; 29 | 30 | procedure Query_Counter (Object : Query_Object; 31 | Target : Low_Level.Enums.Query_Param); 32 | private 33 | 34 | type Query_Object is new GL_Object with null record; 35 | 36 | overriding 37 | procedure Internal_Create_Id (Object : Query_Object; Id : out UInt); 38 | 39 | overriding 40 | procedure Internal_Release_Id (Object : Query_Object; Id : UInt); 41 | 42 | Default_Query : constant Query_Object := Query_Object'( 43 | Ada.Finalization.Controlled with 44 | Reference => Reference_To_Null_Object'Access); 45 | end GL.Objects.Queries; 46 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-renderbuffers.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Pixels; 5 | 6 | with GL.Low_Level.Enums; 7 | 8 | package GL.Objects.Renderbuffers is 9 | pragma Preelaborate; 10 | 11 | type Renderbuffer_Target (<>) is tagged limited private; 12 | 13 | procedure Allocate (Object : Renderbuffer_Target; 14 | Format : Pixels.Internal_Format; 15 | Width, Height : Size; 16 | Samples : Size := 0); 17 | 18 | function Width (Object : Renderbuffer_Target) return Size; 19 | function Height (Object : Renderbuffer_Target) return Size; 20 | function Internal_Format (Object : Renderbuffer_Target) 21 | return Pixels.Internal_Format; 22 | function Red_Size (Object : Renderbuffer_Target) return Size; 23 | function Green_Size (Object : Renderbuffer_Target) return Size; 24 | function Blue_Size (Object : Renderbuffer_Target) return Size; 25 | function Alpha_Size (Object : Renderbuffer_Target) return Size; 26 | function Depth_Size (Object : Renderbuffer_Target) return Size; 27 | function Stencil_Size (Object : Renderbuffer_Target) return Size; 28 | 29 | function Raw_Kind (Object : Renderbuffer_Target) 30 | return Low_Level.Enums.Renderbuffer_Kind; 31 | 32 | Active_Renderbuffer : constant Renderbuffer_Target; 33 | 34 | type Renderbuffer is new GL_Object with private; 35 | 36 | procedure Bind (Target : Renderbuffer_Target; Object : Renderbuffer'Class); 37 | 38 | function Current (Target : Renderbuffer_Target) return Renderbuffer'Class; 39 | 40 | No_Renderbuffer : constant Renderbuffer; 41 | private 42 | 43 | type Renderbuffer is new GL_Object with null record; 44 | 45 | overriding 46 | procedure Internal_Create_Id (Object : Renderbuffer; Id : out UInt); 47 | 48 | overriding 49 | procedure Internal_Release_Id (Object : Renderbuffer; Id : UInt); 50 | 51 | type Renderbuffer_Target (Kind : Low_Level.Enums.Renderbuffer_Kind) is 52 | tagged limited null record; 53 | 54 | Active_Renderbuffer : constant Renderbuffer_Target 55 | := Renderbuffer_Target'(Kind => Low_Level.Enums.Renderbuffer); 56 | 57 | No_Renderbuffer : constant Renderbuffer := 58 | Renderbuffer'(Ada.Finalization.Controlled with Reference => 59 | Reference_To_Null_Object'Access); 60 | end GL.Objects.Renderbuffers; 61 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-shaders-lists.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Objects.Lists; 5 | 6 | package GL.Objects.Shaders.Lists is 7 | new GL.Objects.Lists (Shader, Create_From_Id); 8 | pragma Preelaborate (GL.Objects.Shaders.Lists); 9 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-shaders.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with GL.Low_Level; 5 | 6 | package GL.Objects.Shaders is 7 | pragma Preelaborate; 8 | 9 | type Shader_Type is (Fragment_Shader, Vertex_Shader, Geometry_Shader, 10 | Tess_Evaluation_Shader, Tess_Control_Shader); 11 | 12 | type Shader (Kind : Shader_Type) is new GL_Object with private; 13 | 14 | procedure Set_Source (Subject : Shader; Source : String); 15 | function Source (Subject : Shader) return String; 16 | 17 | procedure Compile (Subject : Shader); 18 | 19 | procedure Release_Shader_Compiler; 20 | 21 | function Compile_Status (Subject : Shader) return Boolean; 22 | 23 | function Info_Log (Subject : Shader) return String; 24 | 25 | -- low-level. creates a Shader object linking to the given OpenGL ID. 26 | -- doesn't take ownership of the ID and therefore doesn't automatically 27 | -- delete it when the last reference vanishes. 28 | function Create_From_Id (Id : UInt) return Shader; 29 | private 30 | type Shader (Kind : Shader_Type) is new GL_Object with null record; 31 | 32 | overriding 33 | procedure Internal_Create_Id (Object : Shader; Id : out UInt); 34 | 35 | overriding 36 | procedure Internal_Release_Id (Object : Shader; Id : UInt); 37 | 38 | for Shader_Type use (Fragment_Shader => 16#8B30#, 39 | Vertex_Shader => 16#8B31#, 40 | Geometry_Shader => 16#8DD9#, 41 | Tess_Evaluation_Shader => 16#8E87#, 42 | Tess_Control_Shader => 16#8E88#); 43 | for Shader_Type'Size use Low_Level.Enum'Size; 44 | 45 | end GL.Objects.Shaders; 46 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-textures-with_1d_loader.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Base (<>) is new Texture_Proxy with private; 6 | package GL.Objects.Textures.With_1D_Loader is 7 | pragma Preelaborate; 8 | 9 | type Target is new Base with null record; 10 | 11 | procedure Load_Empty_Texture 12 | (Object : Target; Level : Mipmap_Level; 13 | Internal_Format : Pixels.Internal_Format; 14 | Width : Types.Size); 15 | 16 | procedure Storage (Object : Target; Levels : Types.Size; 17 | Internal_Format : Pixels.Internal_Format; 18 | Width : Types.Size); 19 | 20 | type Fillable_Target is new With_1D_Loader.Target with null record; 21 | 22 | procedure Load_From_Data 23 | (Object : Fillable_Target; Level : Mipmap_Level; 24 | Internal_Format : Pixels.Internal_Format; 25 | Width : Types.Size; 26 | Source_Format : Pixels.Data_Format; 27 | Source_Type : Pixels.Data_Type; 28 | Source : Image_Source); 29 | 30 | procedure Load_Sub_Image_From_Data 31 | (Object : Fillable_Target; Level : Mipmap_Level; 32 | X_Offset, Y_Offset : Int; 33 | Width, Height : Size; 34 | Format : Pixels.Data_Format; 35 | Data_Type : Pixels.Data_Type; 36 | Source : Image_Source); 37 | 38 | procedure Load_Compressed 39 | (Object : Fillable_Target; 40 | Level : Mipmap_Level; 41 | Internal_Format : Pixels.Internal_Format; 42 | Width, Image_Size : Types.Size; 43 | Source : Image_Source); 44 | end GL.Objects.Textures.With_1D_Loader; 45 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-textures-with_2d_loader.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Base (<>) is new Texture_Proxy with private; 6 | package GL.Objects.Textures.With_2D_Loader is 7 | pragma Preelaborate; 8 | 9 | type Target is new Base with null record; 10 | 11 | procedure Load_Empty_Texture 12 | (Object : Target; Level : Mipmap_Level; 13 | Internal_Format : Pixels.Internal_Format; 14 | Width, Height : Types.Size); 15 | 16 | procedure Storage (Object : Target; Number_Of_Levels : Types.Size; 17 | Internal_Format : Pixels.Internal_Format; 18 | Width, Height : Types.Size); 19 | 20 | type Fillable_Target is new Target with null record; 21 | 22 | procedure Load_From_Data 23 | (Object : Fillable_Target; Level : Mipmap_Level; 24 | Internal_Format : Pixels.Internal_Format; 25 | Width, Height : Types.Size; 26 | Source_Format : Pixels.Data_Format; 27 | Source_Type : Pixels.Data_Type; 28 | Source : Image_Source); 29 | 30 | procedure Load_Sub_Image_From_Data 31 | (Object : Fillable_Target; Level : Mipmap_Level; 32 | X_Offset, Y_Offset : Int; 33 | Width, Height : Size; 34 | Format : Pixels.Data_Format; 35 | Data_Type : Pixels.Data_Type; 36 | Source : Image_Source); 37 | 38 | procedure Load_Compressed 39 | (Object : Fillable_Target; 40 | Level : Mipmap_Level; 41 | Internal_Format : Pixels.Internal_Format; 42 | Width, Height, Image_Size : Types.Size; 43 | Source : Image_Source); 44 | end GL.Objects.Textures.With_2D_Loader; 45 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-textures-with_3d_loader.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Base (<>) is new Texture_Proxy with private; 6 | package GL.Objects.Textures.With_3D_Loader is 7 | pragma Preelaborate; 8 | 9 | type Target is new Base with null record; 10 | 11 | procedure Load_Empty_Texture 12 | (Object : Target; Level : Mipmap_Level; 13 | Internal_Format : Pixels.Internal_Format; 14 | Width, Height, Depth : Types.Size); 15 | 16 | procedure Storage (Object : Target; 17 | Levels : Types.Size; 18 | Internal_Format : Pixels.Internal_Format; 19 | Width, Height, Depth : Types.Size); 20 | 21 | type Fillable_Target is new Target with null record; 22 | 23 | procedure Load_From_Data 24 | (Object : Fillable_Target; Level : Mipmap_Level; 25 | Internal_Format : Pixels.Internal_Format; 26 | Width, Height, Depth : Types.Size; 27 | Source_Format : Pixels.Data_Format; 28 | Source_Type : Pixels.Data_Type; 29 | Source : Image_Source); 30 | 31 | procedure Load_Sub_Image_From_Data 32 | (Object : Fillable_Target; Level : Mipmap_Level; 33 | X_Offset, Y_Offset : Int; 34 | Width, Height : Size; 35 | Format : Pixels.Data_Format; 36 | Data_Type : Pixels.Data_Type; 37 | Source : Image_Source); 38 | 39 | procedure Load_Compressed 40 | (Object : Fillable_Target; 41 | Level : Mipmap_Level; 42 | Internal_Format : Pixels.Internal_Format; 43 | Width, Height, Depth, Image_Size : Types.Size; 44 | Source : Image_Source); 45 | end GL.Objects.Textures.With_3D_Loader; 46 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects-vertex_arrays.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package GL.Objects.Vertex_Arrays is 5 | 6 | type Vertex_Array_Object is new GL_Object with private; 7 | 8 | procedure Bind (Object : Vertex_Array_Object); 9 | 10 | procedure Draw_Arrays (Mode : Connection_Mode; First, Count : Size); 11 | 12 | procedure Draw_Arrays_Instanced (Mode : Connection_Mode; 13 | First, Count, Instances : Size); 14 | 15 | function Current_Array_Object return Vertex_Array_Object; 16 | 17 | -- bind this object to unbind the current array object. 18 | Null_Array_Object : constant Vertex_Array_Object; 19 | 20 | -- Specifies the vertex array element index used to indicate that a new 21 | -- primitive should be started during rendering. When processing of 22 | -- vertex-array element indices encounters a value that matches index, no 23 | -- vertex data is processed, the current graphics primitive is terminated, 24 | -- and a new one of the identical type is started from the next vertex. 25 | procedure Set_Primitive_Restart_Index (Index : UInt); 26 | private 27 | type Vertex_Array_Object is new GL_Object with null record; 28 | 29 | overriding 30 | procedure Internal_Create_Id (Object : Vertex_Array_Object; Id : out UInt); 31 | 32 | overriding 33 | procedure Internal_Release_Id (Object : Vertex_Array_Object; Id : UInt); 34 | 35 | Null_Array_Object : constant Vertex_Array_Object 36 | := Vertex_Array_Object'(Ada.Finalization.Controlled with 37 | Reference => Reference_To_Null_Object'Access); 38 | end GL.Objects.Vertex_Arrays; 39 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-objects.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Finalization; 5 | 6 | with GL.Types; 7 | 8 | private with GL.Low_Level; 9 | 10 | package GL.Objects is 11 | pragma Preelaborate; 12 | 13 | use GL.Types; 14 | 15 | type Access_Kind is (Read_Only, Write_Only, Read_Write); 16 | 17 | type GL_Object is abstract tagged private; 18 | 19 | -- Create an OpenGL object for this reference. This has to be done before 20 | -- the object is used in any way. After calling this procedure, 21 | -- Initialized will be true. 22 | procedure Initialize_Id (Object : in out GL_Object); 23 | 24 | -- Removes the reference to the backing OpenGL object from this reference. 25 | -- the OpenGL object will only be deleted if this was the last reference. 26 | procedure Clear (Object : in out GL_Object); 27 | 28 | -- Check whether the object is set up to be used with OpenGL 29 | -- (i.e. whether Initialize_Id has been called on the object). 30 | function Initialized (Object : GL_Object) return Boolean; 31 | 32 | -- This getter is provided for low-level access. Its primary use is to 33 | -- interact with other C interfaces (e.g. OpenCL) 34 | function Raw_Id (Object : GL_Object) return UInt; 35 | 36 | -- Setter for low-level access. This decreases the reference count of the 37 | -- previously referred OpenGL object. 38 | procedure Set_Raw_Id (Object : in out GL_Object; Id : UInt; 39 | Owned : Boolean := True); 40 | 41 | function "=" (Left, Right : GL_Object) return Boolean; 42 | 43 | -- abstract subprograms are required to be visible. however, these 44 | -- subprograms are not intended to be called from ouside! 45 | 46 | -- Create new OpenGL object of the corresponding type and return its ID 47 | procedure Internal_Create_Id 48 | (Object : GL_Object; Id : out UInt) is abstract; 49 | 50 | -- Tell OpenGL the object referred to be the given ID is no longer needed 51 | procedure Internal_Release_Id 52 | (Object : GL_Object; Id : UInt) is abstract; 53 | 54 | No_Object_Bound_Exception : exception; 55 | private 56 | for Access_Kind use (Read_Only => 16#88B8#, 57 | Write_Only => 16#88B9#, 58 | Read_Write => 16#88BA#); 59 | for Access_Kind'Size use Low_Level.Enum'Size; 60 | 61 | type GL_Object_Reference; 62 | type GL_Object_Reference_Access is access all GL_Object_Reference; 63 | 64 | type GL_Object_Reference is record 65 | GL_Id : UInt; 66 | Reference_Count : Natural; 67 | Is_Owner : Boolean; 68 | end record; 69 | 70 | type GL_Object is abstract new Ada.Finalization.Controlled with record 71 | Reference : GL_Object_Reference_Access := null; 72 | end record; 73 | 74 | -- Increases reference count. 75 | overriding procedure Adjust (Object : in out GL_Object); 76 | 77 | -- Decreases reference count. Destroys texture when it reaches zero. 78 | overriding procedure Finalize (Object : in out GL_Object); 79 | 80 | pragma Inline (Raw_Id); 81 | pragma Inline (Set_Raw_Id); 82 | 83 | Reference_To_Null_Object : aliased GL_Object_Reference := 84 | (GL_Id => 0, Reference_Count => 0, Is_Owner => False); 85 | end GL.Objects; 86 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-raster.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | package GL.Raster is 7 | -- Obsolete as of OpenGL 3. Supplied here to support some older 3rd party 8 | -- functionality like Bitmap and Pixmap fonts of FTGL 9 | 10 | use GL.Types; 11 | use GL.Types.Doubles; 12 | 13 | procedure Set_Pos (Position : Vector2); 14 | procedure Set_Pos (Position : Vector3); 15 | procedure Set_Pos (Position : Vector4); 16 | end GL.Raster; 17 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-rasterization.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | private with GL.Low_Level; 7 | 8 | package GL.Rasterization is 9 | pragma Preelaborate; 10 | 11 | use GL.Types; 12 | 13 | subtype Line_Width_Range is Singles.Vector2; 14 | 15 | type Polygon_Mode_Type is (Point, Line, Fill); 16 | 17 | procedure Set_Line_Width (Value : Single); 18 | function Line_Width return Single; 19 | 20 | function Aliased_Line_Width_Range return Line_Width_Range; 21 | function Smooth_Line_Width_Range return Line_Width_Range; 22 | function Smooth_Line_Width_Granularity return Single; 23 | 24 | procedure Set_Polygon_Mode (Value : Polygon_Mode_Type); 25 | function Polygon_Mode return Polygon_Mode_Type; 26 | procedure Set_Polygon_Offset (Factor, Units : Single := 0.0); 27 | 28 | procedure Set_Point_Size (Value : Single); 29 | function Point_Size return Single; 30 | function Point_Size_Range return Singles.Vector2; 31 | function Point_Size_Granularity return Single; 32 | 33 | procedure Set_Point_Fade_Threshold_Size (Value : Single); 34 | function Point_Fade_Threshold_Size return Single; 35 | private 36 | for Polygon_Mode_Type use (Point => 16#1B00#, 37 | Line => 16#1B01#, 38 | Fill => 16#1B02#); 39 | for Polygon_Mode_Type'Size use Low_Level.Enum'Size; 40 | end GL.Rasterization; 41 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-tessellation.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | package GL.Tessellation is 7 | pragma Preelaborate; 8 | 9 | use GL.Types; 10 | 11 | procedure Set_Patch_Vertices (Value : Int); 12 | 13 | procedure Set_Patch_Default_Inner_Level (Values : Single_Array); 14 | 15 | procedure Set_Patch_Default_Outer_Level (Values : Single_Array); 16 | end GL.Tessellation; 17 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-types-colors.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C.Pointers; 5 | 6 | package GL.Types.Colors is 7 | pragma Preelaborate; 8 | 9 | type Color_Index is (R, G, B, A); 10 | subtype Basic_Color_Index is Color_Index range R .. B; 11 | 12 | subtype Component is Single range 0.0 .. 1.0; 13 | 14 | type Color is array (Color_Index) of aliased Component; 15 | type Basic_Color is array (Basic_Color_Index) of Component; 16 | 17 | pragma Convention (C, Color); 18 | pragma Convention (C, Basic_Color); 19 | 20 | type Color_Array is array (Size range <>) of aliased Color; 21 | type Basic_Color_Array is array (Size range <>) of aliased Basic_Color; 22 | 23 | package Color_Pointers is new Interfaces.C.Pointers 24 | (Size, Color, Color_Array, Color'(others => 0.0)); 25 | package Basic_Color_Pointers is new Interfaces.C.Pointers 26 | (Size, Basic_Color, Basic_Color_Array, Basic_Color'(others => 0.0)); 27 | end GL.Types.Colors; 28 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-vectors.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | generic 5 | type Index_Type is (<>); 6 | type Element_Type is private; 7 | with function "+" (Left, Right : Element_Type) return Element_Type is <>; 8 | with function "-" (Left, Right : Element_Type) return Element_Type is <>; 9 | with function "-" (Left : Element_Type) return Element_Type is <>; 10 | with function "*" (Left, Right : Element_Type) return Element_Type is <>; 11 | with function "/" (Left, Right : Element_Type) return Element_Type is <>; 12 | package GL.Vectors is 13 | pragma Preelaborate; 14 | 15 | type Vector is array (Index_Type) of aliased Element_Type; 16 | pragma Convention (C, Vector); 17 | 18 | function "+" (Left, Right : Vector) return Vector; 19 | 20 | function "-" (Left, Right : Vector) return Vector; 21 | function "-" (Left : Vector) return Vector; 22 | 23 | function "*" (Left : Vector; Right : Element_Type) return Vector; 24 | function "*" (Left : Element_Type; Right : Vector) return Vector; 25 | 26 | function "/" (Left : Vector; Right : Element_Type) return Vector; 27 | 28 | function Dot_Product (Left, Right : Vector) return Element_Type; 29 | 30 | pragma Inline ("+"); 31 | pragma Inline ("-"); 32 | pragma Inline ("*"); 33 | pragma Inline ("/"); 34 | end GL.Vectors; 35 | -------------------------------------------------------------------------------- /opengl/src/interface/gl-window.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Types; 5 | 6 | package GL.Window is 7 | use GL.Types; 8 | 9 | procedure Set_Viewport (X, Y : Int; Width, Height : Size); 10 | procedure Get_Viewport (X, Y : out Int; Width, Height : out Size); 11 | 12 | procedure Set_Depth_Range (Near, Far : Double); 13 | procedure Get_Depth_Range (Near, Far : out Double); 14 | 15 | end GL.Window; 16 | -------------------------------------------------------------------------------- /opengl/src/interface/gl.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C; 5 | 6 | package GL is 7 | pragma Preelaborate; 8 | 9 | package C renames Interfaces.C; 10 | 11 | ----------------------------------------------------------------------------- 12 | -- Basics -- 13 | ----------------------------------------------------------------------------- 14 | 15 | -- this is an OpenGLAda-specific procedure that must be called once at 16 | -- startup and loads all function pointers for post-1.1 OpenGL functionality. 17 | -- it is idempotent (i.e. can be called multiple times without further 18 | -- effect). 19 | procedure Init; 20 | 21 | procedure Flush; 22 | procedure Finish; 23 | 24 | -- index types for vectors and matrices 25 | type Index_Homogeneous is (X, Y, Z, W); 26 | subtype Index_3D is Index_Homogeneous range X .. Z; 27 | subtype Index_2D is Index_Homogeneous range X .. Y; 28 | 29 | -- raised when a function that is not available for the current context 30 | -- is called. 31 | Feature_Not_Supported_Exception : exception; 32 | 33 | -- raised when OpenGLAda does not support a certain OpenGL feature 34 | -- (either because it's too new and has not yet been wrapped, or because 35 | -- it's so deprecated that you shouldn't use it anyway) 36 | Not_Implemented_Exception : exception; 37 | private 38 | 39 | ----------------------------------------------------------------------------- 40 | -- Internal functions -- 41 | ----------------------------------------------------------------------------- 42 | 43 | procedure Raise_Exception_On_OpenGL_Error; 44 | pragma Inline (Raise_Exception_On_OpenGL_Error); 45 | 46 | end GL; 47 | -------------------------------------------------------------------------------- /opengl/src/mac/gl-api-mac_os_x.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package body GL.API.Mac_OS_X is 5 | OpenGLFramework_Cached : CFBundleRef; 6 | 7 | function OpenGLFramework return CFBundleRef is 8 | use type System.Address; 9 | begin 10 | if OpenGLFramework_Cached = System.Null_Address then 11 | declare 12 | OpenGLFramework_ID : constant CFStringRef 13 | := CFStringCreateWithCString (System.Null_Address, 14 | IFC.To_C ("com.apple.opengl"), 15 | kCFStringEncodingASCII); 16 | begin 17 | OpenGLFramework_Cached 18 | := CFBundleGetBundleWithIdentifier (OpenGLFramework_ID); 19 | end; 20 | end if; 21 | return OpenGLFramework_Cached; 22 | end OpenGLFramework; 23 | 24 | end GL.API.Mac_OS_X; 25 | -------------------------------------------------------------------------------- /opengl/src/mac/gl-api-mac_os_x.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Interfaces.C; 5 | with System; 6 | private package GL.API.Mac_OS_X is 7 | pragma Preelaborate; 8 | 9 | -- package for MacOSX-specific stuff 10 | 11 | package IFC renames Interfaces.C; 12 | 13 | subtype CFStringRef is System.Address; 14 | subtype CFBundleRef is System.Address; 15 | subtype CFAllocatorRef is System.Address; 16 | 17 | type CFStringEncoding is new Integer; 18 | pragma Convention (C, CFStringEncoding); 19 | for CFStringEncoding'Size use 32; 20 | 21 | kCFStringEncodingASCII : constant CFStringEncoding := 16#0600#; 22 | 23 | function CFBundleGetBundleWithIdentifier (bundleID : CFStringRef) 24 | return CFBundleRef; 25 | pragma Import (Convention => C, Entity => CFBundleGetBundleWithIdentifier, 26 | External_Name => "CFBundleGetBundleWithIdentifier"); 27 | 28 | function CFStringCreateWithCString (alloc : CFAllocatorRef; 29 | cStr : IFC.char_array; 30 | encoding : CFStringEncoding) 31 | return CFStringRef; 32 | pragma Import (Convention => C, Entity => CFStringCreateWithCString, 33 | External_Name => "CFStringCreateWithCString"); 34 | 35 | function CFBundleGetFunctionPointerForName (bundle : CFBundleRef; 36 | functionName : CFStringRef) 37 | return System.Address; 38 | pragma Import (Convention => C, Entity => CFBundleGetFunctionPointerForName, 39 | External_Name => "CFBundleGetFunctionPointerForName"); 40 | 41 | procedure CFRelease (cf : System.Address); 42 | pragma Import (Convention => C, Entity => CFRelease, 43 | External_Name => "CFRelease"); 44 | 45 | function OpenGLFramework return CFBundleRef; 46 | 47 | 48 | end GL.API.Mac_OS_X; 49 | -------------------------------------------------------------------------------- /opengl/src/mac/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | private with GL.API.Mac_OS_X; 5 | 6 | function GL.API.Subprogram_Reference (Function_Name : String) 7 | return System.Address is 8 | 9 | -- OSX-specific implementation uses CoreFoundation functions 10 | use GL.API.Mac_OS_X; 11 | 12 | package IFC renames Interfaces.C; 13 | 14 | Symbol_Name : constant CFStringRef := CFStringCreateWithCString 15 | (alloc => System.Null_Address, cStr => IFC.To_C (Function_Name), 16 | encoding => kCFStringEncodingASCII); 17 | Result : constant System.Address := CFBundleGetFunctionPointerForName 18 | (bundle => OpenGLFramework, 19 | functionName => Symbol_Name); 20 | begin 21 | CFRelease (Symbol_Name); 22 | return Result; 23 | end GL.API.Subprogram_Reference; 24 | -------------------------------------------------------------------------------- /opengl/src/specs/gl-api-doubles.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Doubles is 2 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Double) with 3 | Dynamic => "glVertexAttribL1d", 4 | Wrapper => "GL.Attributes.Set_Double"; 5 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Double) with 6 | Dynamic => "glVertexAttribL2d", 7 | Wrapper => "GL.Attributes.Set_Double"; 8 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 9 | Value : Types.Doubles.Vector2) with 10 | Dynamic => "glVertexAttribL2dv", 11 | Wrapper => "GL.Attributes.Set_Double"; 12 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Double) 13 | with Dynamic => "glVertexAttribL3d", 14 | Wrapper => "GL.Attributes.Set_Double"; 15 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 16 | Value : Types.Doubles.Vector3) with 17 | Dynamic => "glVertexAttribL3dv", 18 | Wrapper => "GL.Attributes.Set_Double"; 19 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 20 | V0, V1, V2, V3 : Double) with 21 | Dynamic => "glVertexAttribL4d", 22 | Wrapper => "GL.Attributes.Set_Double"; 23 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 24 | Value : Types.Doubles.Vector4) with 25 | Dynamic => "glVertexAttribL4dv", 26 | Wrapper => "GL.Attributes.Set_Double"; 27 | end GL.API.Doubles; -------------------------------------------------------------------------------- /opengl/src/specs/gl-api-ints.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Ints is 2 | procedure Uniform1 (Location : Uniforms.Uniform; Value : Int) with 3 | Dynamic => "glUniform1i", 4 | Wrapper => "GL.Uniforms.Set_Int"; 5 | procedure Uniform1v (Location : Uniforms.Uniform; Count : Size; 6 | Value : Int_Array) with 7 | Dynamic => "glUniform1iv", 8 | Wrapper => "GL.Uniforms.Set_Int"; 9 | procedure Uniform2 (Location : Uniforms.Uniform; V0, V1 : Int) with 10 | Dynamic => "glUniform2i", 11 | Wrapper => "GL.Uniforms.Set_Int"; 12 | procedure Uniform2v (Location : Uniforms.Uniform; Count : Size; 13 | Value : Types.Ints.Vector2_Array) with 14 | Dynamic => "glUniform2iv", 15 | Wrapper => "GL.Uniforms.Set_Int"; 16 | procedure Uniform3 (Location : Uniforms.Uniform; V0, V1, V2 : Int) with 17 | Dynamic => "glUniform3i", 18 | Wrapper => "GL.Uniforms.Set_Int"; 19 | procedure Uniform3v (Location : Uniforms.Uniform; Count : Size; 20 | Value : Types.Ints.Vector3_Array) with 21 | Dynamic => "glUniform3iv", 22 | Wrapper => "GL.Uniforms.Set_Int"; 23 | procedure Uniform4 (Location : Uniforms.Uniform; V0, V1, V2, V3 : Int) with 24 | Dynamic => "glUniform4i", 25 | Wrapper => "GL.Uniforms.Set_Int"; 26 | procedure Uniform4v (Location : Uniforms.Uniform; Count : Size; 27 | Valeu : Types.Ints.Vector4_Array) with 28 | Dynamic => "glUniform4iv", 29 | Wrapper => "GL.Uniforms.Set_Int"; 30 | procedure Uniform_Matrix2 (Location : Uniforms.Uniform; Count : Size; 31 | Transpose : Low_Level.Bool; 32 | Value : Types.Ints.Matrix2_Array) with 33 | Dynamic => "glUniformMatrix2iv", 34 | Wrapper => "GL.Uniforms.Set_Int"; 35 | procedure Uniform_Matrix3 (Location : Uniforms.Uniform; Count : Size; 36 | Transpose : Low_Level.Bool; 37 | Value : Types.Ints.Matrix3_Array) with 38 | Dynamic => "glUniformMatrix3iv", 39 | Wrapper => "GL.Uniforms.Set_Int"; 40 | procedure Uniform_Matrix4 (Location : Uniforms.Uniform; Count : Size; 41 | Transpose : Low_Level.Bool; 42 | Value : Types.Ints.Matrix4_Array) with 43 | Dynamic => "glUniformMatrix4iv", 44 | Wrapper => "GL.Uniforms.Set_Int"; 45 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Int) with 46 | Dynamic => "glVertexAttribI1i", 47 | Wrapper => "GL.Attributes.Set_Int"; 48 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Int) with 49 | Dynamic => "glVertexAttribI2i", 50 | Wrapper => "GL.Attributes.Set_Int"; 51 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 52 | Value : Types.Ints.Vector2) with 53 | Dynamic => "glVertexAttribI2iv", 54 | Wrapper => "GL.Attributes.Set_Int"; 55 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Int) 56 | with Dynamic => "glVertexAttribI3i", 57 | Wrapper => "GL.Attributes.Set_Int"; 58 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 59 | Value : Types.Ints.Vector3) with 60 | Dynamic => "glVertexAttribI3iv", 61 | Wrapper => "GL.Attributes.Set_Int"; 62 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 63 | V0, V1, V2, V3 : Int) with 64 | Dynamic => "glVertexAttribI4i", 65 | Wrapper => "GL.Attributes.Set_Int"; 66 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 67 | Value : Types.Ints.Vector4) with 68 | Dynamic => "glVertexAttrib4Iiv", 69 | Wrapper => "GL.Attributes.Set_Int"; 70 | end GL.API.Ints; 71 | -------------------------------------------------------------------------------- /opengl/src/specs/gl-api-shorts.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Shorts is 2 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Short) with 3 | Dynamic => "glVertexAttrib1s", 4 | Wrapper => "GL.Attributes.Set_Short"; 5 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Short) with 6 | Dynamic => "glVertexAttrib2s", 7 | Wrapper => "GL.Attributes.Set_Short"; 8 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 9 | Value : Shorts.Vector2) with 10 | Dynamic => "glVertexAttrib2sv", 11 | Wrapper => "GL.Attributes.Set_Short"; 12 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Short) 13 | with Dynamic => "glVertexAttrib3s", 14 | Wrapper => "GL.Attributes.Set_Short"; 15 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 16 | Value : Shorts.Vector3) with 17 | Dynamic => "glVertexAttrib3sv", 18 | Wrapper => "GL.Attributes.Set_Short"; 19 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 20 | V0, V1, V2, V3 : Short) with 21 | Dynamic => "glVertexAttrib4s", 22 | Wrapper => "GL.Attributes.Set_Short"; 23 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 24 | Value : Shorts.Vector4) with 25 | Dynamic => "glVertexAttrib4sv", 26 | Wrapper => "GL.Attributes.Set_Short"; 27 | end GL.API.Shorts; -------------------------------------------------------------------------------- /opengl/src/specs/gl-api-singles.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.Singles is 2 | procedure Uniform1 (Location : Uniforms.Uniform; Value : Single) with 3 | Dynamic => "glUniform1f", 4 | Wrapper => "GL.Uniforms.Set_Single"; 5 | procedure Uniform1v (Location : Uniforms.Uniform; Count : Size; 6 | Value : Single_Array) with 7 | Dynamic => "glUniform1fv", 8 | Wrapper => "GL.Uniforms.Set_Single"; 9 | procedure Uniform2 (Location : Uniforms.Uniform; V0, V1 : Single) with 10 | Dynamic => "glUniform2f", 11 | Wrapper => "GL.Uniforms.Set_Single"; 12 | procedure Uniform2v (Location : Uniforms.Uniform; Count : Size; 13 | Value : Types.Singles.Vector2_Array) with 14 | Dynamic => "glUniform2fv", 15 | Wrapper => "GL.Uniforms.Set_Single"; 16 | procedure Uniform3 (Location : Uniforms.Uniform; V0, V1, V2 : Single) with 17 | Dynamic => "glUniform3f", 18 | Wrapper => "GL.Uniforms.Set_Single"; 19 | procedure Uniform3v (Location : Uniforms.Uniform; Count : Size; 20 | Value : Types.Singles.Vector3_Array) with 21 | Dynamic => "glUniform3fv", 22 | Wrapper => "GL.Uniforms.Set_Single"; 23 | procedure Uniform4 (Location : Uniforms.Uniform; V0, V1, V2, V3 : Single) 24 | with Dynamic => "glUniform4f", 25 | Wrapper => "GL.Uniforms.Set_Single"; 26 | procedure Uniform4v (Location : Uniforms.Uniform; Count : Size; 27 | Value : Types.Singles.Vector4_Array) with 28 | Dynamic => "glUniform4fv", 29 | Wrapper => "GL.Uniforms.Set_Single"; 30 | procedure Uniform_Matrix2 (Location : Uniforms.Uniform; Count : Size; 31 | Transpose : Low_Level.Bool; 32 | Value : Types.Singles.Matrix2_Array) with 33 | Dynamic => "glUniformMatrix2fv", 34 | Wrapper => "GL.Uniforms.Set_Single"; 35 | procedure Uniform_Matrix3 (Location : Uniforms.Uniform; Count : Size; 36 | Transpose : Low_Level.Bool; 37 | Value : Types.Singles.Matrix3_Array) with 38 | Dynamic => "glUniformMatrix3fv", 39 | Wrapper => "GL.Uniforms.Set_Single"; 40 | procedure Uniform_Matrix4 (Location : Uniforms.Uniform; Count : Size; 41 | Transpose : Low_Level.Bool; 42 | Value : Types.Singles.Matrix4_Array) with 43 | Dynamic => "glUniformMatrix4fv", 44 | Wrapper => "GL.Uniforms.Set_Single"; 45 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : Single) with 46 | Dynamic => "glVertexAttrib1f", 47 | Wrapper => "GL.Attributes.Set_Single"; 48 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : Single) 49 | with Dynamic => "glVertexAttrib2f", 50 | Wrapper => "GL.Attributes.Set_Single"; 51 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 52 | Value : Types.Singles.Vector2) with 53 | Dynamic => "glVertexAttrib2fv", 54 | Wrapper => "GL.Attributes.Set_Single"; 55 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : Single) 56 | with Dynamic => "glVertexAttrib3f", 57 | Wrapper => "GL.Attributes.Set_Single"; 58 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 59 | Value : Types.Singles.Vector3) with 60 | Dynamic => "glVertexAttrib3fv", 61 | Wrapper => "GL.Attributes.Set_Single"; 62 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 63 | V0, V1, V2, V3 : Single) with 64 | Dynamic => "glVertexAttrib4f", 65 | Wrapper => "GL.Attributes.Set_Single"; 66 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 67 | Value : Types.Singles.Vector4) with 68 | Dynamic => "glVertexAttrib4fv", 69 | Wrapper => "GL.Attributes.Set_Single"; 70 | end GL.API.Singles; 71 | -------------------------------------------------------------------------------- /opengl/src/specs/gl-api-uints.spec: -------------------------------------------------------------------------------- 1 | spec GL.API.UInts is 2 | procedure Uniform1 (Location : Uniforms.Uniform; Value : UInt) with 3 | Dynamic => "glUniform1ui", 4 | Wrapper => "GL.Uniforms.Set_UInt"; 5 | procedure Uniform1v (Location : Uniforms.Uniform; Count : Size; 6 | Value : UInt_Array) with 7 | Dynamic => "glUniform1uiv", 8 | Wrapper => "GL.Uniforms.Set_UInt"; 9 | procedure Uniform2 (Location : Uniforms.Uniform; V0, V1 : UInt) with 10 | Dynamic => "glUniform2ui", 11 | Wrapper => "GL.Uniforms.Set_UInt"; 12 | procedure Uniform2v (Location : Uniforms.Uniform; Count : Size; 13 | Value : UInts.Vector2_Array) with 14 | Dynamic => "glUniform2uiv", 15 | Wrapper => "GL.Uniforms.Set_UInt"; 16 | procedure Uniform3 (Location : Uniforms.Uniform; V0, V1, V2 : UInt) with 17 | Dynamic => "glUniform3ui", 18 | Wrapper => "GL.Uniforms.Set_UInt"; 19 | procedure Uniform3v (Location : Uniforms.Uniform; Count : Size; 20 | Value : UInts.Vector3_Array) with 21 | Dynamic => "glUniform3uiv", 22 | Wrapper => "GL.Uniforms.Set_UInt"; 23 | procedure Uniform4 (Location : Uniforms.Uniform; V0, V1, V2, V3 : UInt) with 24 | Dynamic => "glUniform4ui", 25 | Wrapper => "GL.Uniforms.Set_UInt"; 26 | procedure Uniform4v (Location : Uniforms.Uniform; Count : Size; 27 | Value : UInts.Vector4_Array) with 28 | Dynamic => "glUniform4uiv", 29 | Wrapper => "GL.Uniforms.Set_UInt"; 30 | procedure Uniform_Matrix2 (Location : Uniforms.Uniform; Count : Size; 31 | Transpose : Low_Level.Bool; 32 | Value : UInts.Matrix2_Array) with 33 | Dynamic => "glUniformMatrix2uiv", 34 | Wrapper => "GL.Uniforms.Set_UInt"; 35 | procedure Uniform_Matrix3 (Location : Uniforms.Uniform; Count : Size; 36 | Transpose : Low_Level.Bool; 37 | Value : UInts.Matrix3_Array) with 38 | Dynamic => "glUniformMatrix3uiv", 39 | Wrapper => "GL.Uniforms.Set_UInt"; 40 | procedure Uniform_Matrix4 (Location : Uniforms.Uniform; Count : Size; 41 | Transpose :Low_Level.Bool; 42 | Value : UInts.Matrix4_Array) with 43 | Dynamic => "glUniformMatrix4uiv", 44 | Wrapper => "GL.Uniforms.Set_UInt"; 45 | procedure Vertex_Attrib1 (Index : Attributes.Attribute; Value : UInt) with 46 | Dynamic => "glVertexAttribI1ui", 47 | Wrapper => "GL.Attributes.Set_UInt"; 48 | procedure Vertex_Attrib2 (Index : Attributes.Attribute; V0, V1 : UInt) with 49 | Dynamic => "glVertexAttribI2ui", 50 | Wrapper => "GL.Attributes.Set_UInt"; 51 | procedure Vertex_Attrib2v (Index : Attributes.Attribute; 52 | Value : UInts.Vector2) with 53 | Dynamic => "glVertexAttribI2uiv", 54 | Wrapper => "GL.Attributes.Set_UInt"; 55 | procedure Vertex_Attrib3 (Index : Attributes.Attribute; V0, V1, V2 : UInt) 56 | with Dynamic => "glVertexAttribI3ui", 57 | Wrapper => "GL.Attributes.Set_UInt"; 58 | procedure Vertex_Attrib3v (Index : Attributes.Attribute; 59 | Value : UInts.Vector3) with 60 | Dynamic => "glVertexAttribI3uiv", 61 | Wrapper => "GL.Attributes.Set_UInt"; 62 | procedure Vertex_Attrib4 (Index : Attributes.Attribute; 63 | V0, V1, V2, V3 : UInt) with 64 | Dynamic => "glVertexAttribI4ui", 65 | Wrapper => "GL.Attributes.Set_UInt"; 66 | procedure Vertex_Attrib4v (Index : Attributes.Attribute; 67 | Value : UInts.Vector4) with 68 | Dynamic => "glVertexAttrib4Iuiv", 69 | Wrapper => "GL.Attributes.Set_UInt"; 70 | end GL.API.UInts; 71 | -------------------------------------------------------------------------------- /opengl/src/windows/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.WGL; 5 | 6 | function GL.API.Subprogram_Reference (Function_Name : String) 7 | return System.Address is 8 | begin 9 | return GL.WGL.wglGetProcAddress (Interfaces.C.To_C (Function_Name)); 10 | end GL.API.Subprogram_Reference; 11 | 12 | -------------------------------------------------------------------------------- /opengl/src/x11/gl-api-subprogram_reference.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.GLX; 5 | 6 | function GL.API.Subprogram_Reference (Function_Name : String) 7 | return System.Address is 8 | begin 9 | return GL.GLX.Get_Proc_Address (Interfaces.C.To_C (Function_Name)); 10 | end GL.API.Subprogram_Reference; 11 | -------------------------------------------------------------------------------- /opengl/src/x11/gl-glx.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with System; 5 | with Interfaces.C; 6 | 7 | with GL.Low_Level; 8 | 9 | -- This package is incomplete. As I do not develop or test under Linux, this 10 | -- has very low priority. Perhaps someone wants to help out... 11 | package GL.GLX is 12 | pragma Preelaborate; 13 | 14 | -- needed types from Xlib 15 | type XID is new Interfaces.C.unsigned_long; 16 | 17 | type GLX_Context is new System.Address; 18 | 19 | type GLX_Drawable is new XID; 20 | type Screen_Depth is new Natural; 21 | type Screen_Number is new Natural; 22 | type Visual_ID is new XID; 23 | 24 | type Display_Pointer is new System.Address; 25 | 26 | type X_Visual_Info is record 27 | Visual : System.Address; 28 | Visual_Ident : Visual_ID; 29 | Screen : Screen_Number; 30 | Depth : Screen_Depth; 31 | Class : Integer; 32 | Red_Mask : Long_Integer; 33 | Green_Mask : Long_Integer; 34 | Blue_Mask : Long_Integer; 35 | Colormap_Size : Natural; 36 | Bits_Per_RGB : Natural; 37 | end record; 38 | pragma Convention (C_Pass_By_Copy, X_Visual_Info); 39 | type X_Visual_Info_Pointer is access all X_Visual_Info; 40 | pragma Convention (C, X_Visual_Info_Pointer); 41 | 42 | function Create_Context (Display : Display_Pointer; 43 | Visual : X_Visual_Info_Pointer; 44 | Share_List : GLX_Context; 45 | Direct : Low_Level.Bool) 46 | return GLX_Context; 47 | 48 | function Make_Current (Display : Display_Pointer; 49 | Drawable : GLX_Drawable; 50 | Context : GLX_Context) 51 | return Low_Level.Bool; 52 | 53 | function Make_Context_Current (Display : Display_Pointer; 54 | Draw : GLX_Drawable; 55 | Read : GLX_Drawable; 56 | Context : GLX_Context) 57 | return Low_Level.Bool; 58 | 59 | function Get_Current_Context return System.Address; 60 | 61 | function Get_Current_Display return System.Address; 62 | 63 | function Get_Proc_Address (Name : Interfaces.C.char_array) 64 | return System.Address; 65 | 66 | private 67 | 68 | pragma Import (C, Create_Context, "glXCreateContext"); 69 | pragma Import (C, Make_Current, "glXMakeCurrent"); 70 | pragma Import (C, Make_Context_Current, "glXMakeContextCurrent"); 71 | pragma Import (C, Get_Current_Context, "glXGetCurrentContext"); 72 | pragma Import (C, Get_Current_Display, "glXGetCurrentDisplay"); 73 | pragma Import (C, Get_Proc_Address, "glXGetProcAddress"); 74 | 75 | end GL.GLX; 76 | -------------------------------------------------------------------------------- /tests/ada2012-black.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flyx/OpenGLAda/16c42a07e6375e6f38a4177d138ff2bcb7aab6e4/tests/ada2012-black.png -------------------------------------------------------------------------------- /tests/ada2012-color.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flyx/OpenGLAda/16c42a07e6375e6f38a4177d138ff2bcb7aab6e4/tests/ada2012-color.jpg -------------------------------------------------------------------------------- /tests/alire.lock: -------------------------------------------------------------------------------- 1 | # THIS IS A MACHINE-GENERATED FILE. DO NOT EDIT MANUALLY. 2 | 3 | [solution] 4 | [solution.context] 5 | solved = true 6 | [[solution.state]] 7 | crate = "freetypeada" 8 | fulfilment = "solved" 9 | pinned = false 10 | transitivity = "direct" 11 | versions = "~0.1.0" 12 | [solution.state.release] 13 | authors = [ 14 | "Felix Krause", 15 | ] 16 | description = "Thick binding to the FreeType library" 17 | licenses = "MIT" 18 | maintainers = [ 19 | "Felix Krause ", 20 | ] 21 | maintainers-logins = [ 22 | "flyx", 23 | ] 24 | name = "freetypeada" 25 | project-files = [ 26 | "freetype.gpr", 27 | ] 28 | tags = [ 29 | "fonts", 30 | "rendering", 31 | ] 32 | version = "0.1.0" 33 | website = "https://github.com/flyx/FreeTypeAda" 34 | [solution.state.release.gpr-set-externals] 35 | FreeType_Linker_Param = "-lfreetype" 36 | [solution.state.release.origin] 37 | commit = "4fd90f573dc83a9b23e462520a60eb6a8dd92878" 38 | url = "git+https://github.com/flyx/FreeTypeAda.git" 39 | [[solution.state]] 40 | crate = "gid" 41 | fulfilment = "solved" 42 | pinned = false 43 | transitivity = "direct" 44 | versions = "^9.0.0" 45 | [solution.state.release] 46 | authors = [ 47 | "Gautier de Montmollin", 48 | ] 49 | description = "Decoding a broad variety of image formats" 50 | licenses = "MIT" 51 | maintainers = [ 52 | "fabien.chouteau@gmail.com", 53 | ] 54 | maintainers-logins = [ 55 | "zertovitch", 56 | "Fabien-Chouteau", 57 | ] 58 | name = "gid" 59 | project-files = [ 60 | "gid.gpr", 61 | ] 62 | version = "9.0.0" 63 | [solution.state.release.gpr-externals] 64 | Build_Mode = [ 65 | "Debug", 66 | "Fast_but_checked", 67 | "Fast", 68 | "Small", 69 | "Smallest", 70 | "Profiling", 71 | ] 72 | [solution.state.release.origin] 73 | hashes = [ 74 | "sha512:17722960f65382ce49dfde2ebe24b2adf1cd007ea9f170ec51d35c4a654ac78ddc3c1ba500e764e0c793d6f6aabb2c82a804a5570deb36a199f5b216c2c372e7", 75 | ] 76 | url = "https://sourceforge.net/projects/gen-img-dec/files/gid_009.zip" 77 | 78 | -------------------------------------------------------------------------------- /tests/alire.toml: -------------------------------------------------------------------------------- 1 | name = "openglada_tests" 2 | description = "OpenGLAda tests (not meant for publishing)" 3 | version = "0.9.0" 4 | 5 | authors = ["Felix Krause"] 6 | maintainers = ["Felix Krause "] 7 | maintainers-logins = ["flyx"] 8 | project-files = ["opengl-test.gpr", "opengl-images-test.gpr", 9 | "opengl-text-test.gpr", "opengl-glfw-test.gpr"] 10 | 11 | executables = ["bin/gl_test-context", "bin/gl_test-debugging", 12 | "bin/gl_test/framebuffers", "bin/gl_test-immediate", 13 | "bin/gl_test-opengl3", "bin/gl_test/shaders", 14 | "bin/gl_test-vbos", 15 | "bin/glfw_test-clipboard", "bin/glfw_test-monitors", 16 | "bin/glfw_test-mouse", "bin/glfw_test-windows", 17 | "bin/images_test_png", "bin/images_test_jpg", 18 | "bin/text_test-basic"] 19 | 20 | [[depends-on]] 21 | gid = "^9.0.0" 22 | freetypeada = "~0.1.0" -------------------------------------------------------------------------------- /tests/all_tests.gpr: -------------------------------------------------------------------------------- 1 | aggregate project All_Tests is 2 | for Project_Files use 3 | ("opengl-test.gpr", "opengl-glfw-test.gpr", "opengl-text-test.gpr", 4 | "opengl-images-test.gpr"); 5 | end All_Tests; 6 | -------------------------------------------------------------------------------- /tests/opengl-glfw-test.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "opengl-glfw"; 3 | 4 | project OpenGL.Glfw.Test is 5 | 6 | for Source_Dirs use ("src/glfw3"); 7 | for Main use ("glfw_test-monitors.adb", "glfw_test-windows.adb", 8 | "glfw_test-clipboard.adb", "glfw_test-mouse.adb"); 9 | 10 | for Object_Dir use "obj"; 11 | for Library_Dir use "lib"; 12 | for Exec_Dir use "bin"; 13 | 14 | package Ide renames OpenGL.Ide; 15 | package Builder renames OpenGL.Builder; 16 | package Compiler renames OpenGL.Compiler; 17 | package Binder renames OpenGL.Binder; 18 | end OpenGL.Glfw.Test; 19 | -------------------------------------------------------------------------------- /tests/opengl-images-test.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "opengl-glfw"; 3 | with "opengl-images"; 4 | 5 | project OpenGL.Images.Test is 6 | 7 | for Object_Dir use "obj"; 8 | for Exec_Dir use "bin"; 9 | 10 | for Source_Dirs use ("src/shared", "src/images"); 11 | for Main use ("images_test_jpg.adb", "images_test_png.adb"); 12 | 13 | package Ide renames OpenGL.Ide; 14 | package Builder renames OpenGL.Builder; 15 | package Compiler renames OpenGL.Compiler; 16 | package Binder renames OpenGL.Binder; 17 | end OpenGL.Images.Test; 18 | -------------------------------------------------------------------------------- /tests/opengl-test.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "opengl-glfw"; 3 | 4 | project OpenGL.Test is 5 | for Languages use ("ada"); 6 | 7 | for Object_Dir use "obj"; 8 | for Exec_Dir use "bin"; 9 | 10 | for Source_Dirs use ("src/shared", "src/gl"); 11 | 12 | for Main use ("gl_test-vbos", "gl_test-immediate", "gl_test-shaders", 13 | "gl_test-opengl3", "gl_test-context", "gl_test-framebuffers", 14 | "gl_test-debugging"); 15 | 16 | package Ide renames OpenGL.Ide; 17 | package Builder renames OpenGL.Builder; 18 | package Compiler renames OpenGL.Compiler; 19 | package Binder renames OpenGL.Binder; 20 | end OpenGL.Test; 21 | -------------------------------------------------------------------------------- /tests/opengl-text-test.gpr: -------------------------------------------------------------------------------- 1 | with "opengl"; 2 | with "opengl-glfw"; 3 | with "opengl-text"; 4 | 5 | project OpenGL.Text.Test is 6 | for Object_Dir use "obj"; 7 | for Exec_Dir use "bin"; 8 | 9 | for Source_Dirs use ("src/shared", "src/text"); 10 | for Main use ("text_test-basic"); 11 | 12 | package Ide renames OpenGL.Ide; 13 | package Builder renames OpenGL.Builder; 14 | package Compiler renames OpenGL.Compiler; 15 | package Binder renames OpenGL.Binder; 16 | end OpenGL.Text.Test; 17 | -------------------------------------------------------------------------------- /tests/src/gl/gl_test-immediate.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Buffers; use GL.Buffers; 5 | with GL.Immediate; use GL.Immediate; 6 | with GL.Fixed.Matrix; use GL.Fixed.Matrix; 7 | with GL.Types.Colors; use GL.Types; 8 | use GL.Fixed; 9 | 10 | with GL_Test.Display_Backend; 11 | 12 | procedure GL_Test.Immediate is 13 | use GL.Types.Doubles; 14 | begin 15 | Display_Backend.Init; 16 | 17 | Display_Backend.Open_Window (Width => 500, Height => 500); 18 | 19 | Projection.Load_Identity; 20 | Projection.Apply_Orthogonal (-1.0, 1.0, -1.0, 1.0, -1.0, 1.0); 21 | 22 | while not Display_Backend.Escape_Pressed and 23 | Display_Backend.Window_Opened loop 24 | Clear (Buffer_Bits'(others => True)); 25 | 26 | Projection.Push; 27 | 28 | for I in 1 .. 12 loop 29 | declare 30 | Token : Input_Token := Start (Line_Strip); 31 | begin 32 | Set_Color (Colors.Color'(1.0, 0.0, 0.0, 0.0)); 33 | Token.Add_Vertex (Vector4'(0.1, 0.4, 0.0, 1.0)); 34 | Token.Add_Vertex (Vector4'(0.1, 0.6, 0.0, 1.0)); 35 | Token.Add_Vertex (Vector4'(-0.1, 0.6, 0.0, 1.0)); 36 | Token.Add_Vertex (Vector4'(-0.1, 0.4, 0.0, 1.0)); 37 | end; 38 | Projection.Apply_Rotation (360.0 / 12.0, 0.0, 0.0, 1.0); 39 | end loop; 40 | 41 | Projection.Pop; 42 | Projection.Apply_Rotation (0.8, 0.0, 0.0, 1.0); 43 | 44 | GL.Flush; 45 | 46 | Display_Backend.Swap_Buffers; 47 | 48 | Display_Backend.Poll_Events; 49 | end loop; 50 | 51 | Display_Backend.Shutdown; 52 | 53 | end GL_Test.Immediate; 54 | -------------------------------------------------------------------------------- /tests/src/gl/gl_test-opengl3-fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 140 2 | 3 | in vec3 ex_Color; 4 | out vec4 out_Color; 5 | 6 | void main(void) { 7 | out_Color = vec4(ex_Color, 1.0); 8 | } -------------------------------------------------------------------------------- /tests/src/gl/gl_test-opengl3-vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 140 2 | 3 | in vec3 in_Position; 4 | in vec3 in_Color; 5 | out vec3 ex_Color; 6 | 7 | void main(void) { 8 | gl_Position = vec4(in_Position, 1.0); 9 | ex_Color = in_Color; 10 | } -------------------------------------------------------------------------------- /tests/src/gl/gl_test-shaders-fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | varying vec4 checkerboard_pos; 4 | 5 | void main(void) 6 | { 7 | if (mod(floor(checkerboard_pos.x) + floor(checkerboard_pos.y), 2) == 0) { 8 | gl_FragColor = gl_Color; 9 | } else { 10 | gl_FragColor = vec4(1.0); 11 | } 12 | } -------------------------------------------------------------------------------- /tests/src/gl/gl_test-shaders-vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 120 2 | 3 | varying vec4 checkerboard_pos; 4 | 5 | void main(void) 6 | { 7 | vec4 v = ftransform(); 8 | 9 | gl_Position = v; 10 | checkerboard_pos = (gl_Vertex + 1) * 10; 11 | gl_FrontColor = gl_Color; 12 | } -------------------------------------------------------------------------------- /tests/src/glfw3/glfw_test-clipboard.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.Windows.Clipboard; 5 | with Glfw.Monitors; 6 | with Glfw.Input; 7 | 8 | procedure Glfw_Test.Clipboard is 9 | 10 | type My_Window is new Glfw.Windows.Window with null record; 11 | 12 | overriding 13 | procedure Init (Object : not null access My_Window; 14 | Width, Height : Glfw.Size; 15 | Title : String; 16 | Monitor : Glfw.Monitors.Monitor := Glfw.Monitors.No_Monitor; 17 | Share : access Glfw.Windows.Window'Class := null); 18 | 19 | overriding 20 | procedure Focus_Changed (Object : not null access My_Window; 21 | Focused : Boolean); 22 | 23 | procedure Init (Object : not null access My_Window; 24 | Width, Height : Glfw.Size; 25 | Title : String; 26 | Monitor : Glfw.Monitors.Monitor := Glfw.Monitors.No_Monitor; 27 | Share : access Glfw.Windows.Window'Class := null) is 28 | Upcast : constant Glfw.Windows.Window_Reference 29 | := Glfw.Windows.Window (Object.all)'Access; 30 | begin 31 | Upcast.Init (Width, Height, Title, Monitor, Share); 32 | Glfw.Windows.Clipboard.Set 33 | (Object, "Unfocus to change clipboard contents to window title"); 34 | Object.Enable_Callback (Glfw.Windows.Callbacks.Focus); 35 | end Init; 36 | 37 | procedure Focus_Changed (Object : not null access My_Window; 38 | Focused : Boolean) is 39 | begin 40 | if Focused then 41 | Object.Set_Title (Glfw.Windows.Clipboard.Get (Object)); 42 | else 43 | Glfw.Windows.Clipboard.Set 44 | (Object, Glfw.Windows.Clipboard.Get (Object) & " | focus lost"); 45 | end if; 46 | end Focus_Changed; 47 | 48 | W : aliased My_Window; 49 | begin 50 | Glfw.Init; 51 | Enable_Print_Errors; 52 | 53 | W'Access.Init (640, 480, ""); 54 | 55 | while not W'Access.Should_Close loop 56 | Glfw.Input.Wait_For_Events; 57 | end loop; 58 | 59 | Glfw.Shutdown; 60 | end Glfw_Test.Clipboard; 61 | -------------------------------------------------------------------------------- /tests/src/glfw3/glfw_test-monitors.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.Monitors; 5 | with Ada.Text_IO; 6 | 7 | procedure Glfw_Test.Monitors is 8 | 9 | procedure Print_Gamma_Value_Array (Values : Glfw.Monitors.Gamma_Value_Array) is 10 | use Ada.Text_IO; 11 | First : Boolean := True; 12 | begin 13 | Put ("["); 14 | for I in Values'Range loop 15 | if First then 16 | First := False; 17 | else 18 | Put (","); 19 | end if; 20 | Put (Values (I)'Img); 21 | end loop; 22 | Put_Line ("]"); 23 | end Print_Gamma_Value_Array; 24 | 25 | procedure Print_Monitor_Info (M : Glfw.Monitors.Monitor) is 26 | use Ada.Text_IO; 27 | use type Glfw.Monitors.Video_Mode; 28 | Param1, Param2 : Integer; 29 | VM_List : constant Glfw.Monitors.Video_Mode_List := M.Video_Modes; 30 | Gamma_Ramp : constant Glfw.Monitors.Gamma_Ramp := M.Current_Gamma_Ramp; 31 | begin 32 | Put_Line ("Monitor """ & M.Name & """"); 33 | M.Get_Position (Param1, Param2); 34 | Put_Line ("Position: (" & Param1'Img & "," & Param2'Img & ")"); 35 | M.Get_Physical_Size (Param1, Param2); 36 | Put_Line ("Dimensions: " & Param1'Img & " x " & Param2'Img); 37 | Put_Line ("Video modes: "); 38 | for I in VM_List'Range loop 39 | Put (" ["); 40 | if VM_List (I) = M.Current_Video_Mode then 41 | Put ("x"); 42 | else 43 | Put (" "); 44 | end if; 45 | Put ("] dim(" & VM_List (I).Width'Img & " x" & VM_List (I).Height'Img); 46 | Put ("), rgb(" & VM_List (I).Red_Bits'Img & "," & 47 | VM_List (I).Green_Bits'Img & "," & VM_List (I).Blue_Bits'Img); 48 | Put_Line ("), refresh(" & VM_List (I).Refresh_Rate'Img & ")"); 49 | end loop; 50 | Put_Line ("Gamma ramp:"); 51 | Put (" red: "); 52 | Print_Gamma_Value_Array (Gamma_Ramp.Red); 53 | Put (" green: "); 54 | Print_Gamma_Value_Array (Gamma_Ramp.Green); 55 | Put (" blue: "); 56 | Print_Gamma_Value_Array (Gamma_Ramp.Blue); 57 | end Print_Monitor_Info; 58 | 59 | begin 60 | Glfw.Init; 61 | Enable_Print_Errors; 62 | declare 63 | My_Monitors : constant Glfw.Monitors.Monitor_List := 64 | Glfw.Monitors.Monitors; 65 | begin 66 | for I in My_Monitors'Range loop 67 | Print_Monitor_Info (My_Monitors (I)); 68 | Ada.Text_IO.Put_Line ("--------------------------------------------"); 69 | end loop; 70 | end; 71 | Glfw.Shutdown; 72 | end Glfw_Test.Monitors; 73 | -------------------------------------------------------------------------------- /tests/src/glfw3/glfw_test-windows.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.Windows; 5 | with Glfw.Monitors; 6 | with Glfw.Input.Keys; 7 | 8 | procedure Glfw_Test.Windows is 9 | 10 | type My_Window is new Glfw.Windows.Window with null record; 11 | 12 | overriding 13 | procedure Init (Object : not null access My_Window; 14 | Width, Height : Glfw.Size; 15 | Title : String; 16 | Monitor : Glfw.Monitors.Monitor := Glfw.Monitors.No_Monitor; 17 | Share : access Glfw.Windows.Window'Class := null); 18 | 19 | overriding 20 | procedure Key_Changed (Object : not null access My_Window; 21 | Key : Glfw.Input.Keys.Key; 22 | Scancode : Glfw.Input.Keys.Scancode; 23 | Action : Glfw.Input.Keys.Action; 24 | Mods : Glfw.Input.Keys.Modifiers); 25 | 26 | procedure Init (Object : not null access My_Window; 27 | Width, Height : Glfw.Size; 28 | Title : String; 29 | Monitor : Glfw.Monitors.Monitor := Glfw.Monitors.No_Monitor; 30 | Share : access Glfw.Windows.Window'Class := null) is 31 | Upcast : constant Glfw.Windows.Window_Reference 32 | := Glfw.Windows.Window (Object.all)'Access; 33 | begin 34 | Upcast.Init (Width, Height, Title, Monitor, Share); 35 | Object.Enable_Callback (Glfw.Windows.Callbacks.Key); 36 | end Init; 37 | 38 | procedure Key_Changed (Object : not null access My_Window; 39 | Key : Glfw.Input.Keys.Key; 40 | Scancode : Glfw.Input.Keys.Scancode; 41 | Action : Glfw.Input.Keys.Action; 42 | Mods : Glfw.Input.Keys.Modifiers) is 43 | pragma Unreferenced (Scancode); 44 | pragma Unreferenced (Action); 45 | pragma Unreferenced (Mods); 46 | use type Glfw.Input.Keys.Key; 47 | begin 48 | If Key = Glfw.Input.Keys.Escape then 49 | Object.Set_Should_Close (True); 50 | end if; 51 | end Key_Changed; 52 | 53 | 54 | W1 : aliased Glfw.Windows.Window; 55 | W2 : aliased My_Window; 56 | begin 57 | Glfw.Init; 58 | Enable_Print_Errors; 59 | 60 | W1'Access.Init (640, 480, "Window 1"); 61 | W2'Access.Init (640, 480, "Window 2"); 62 | 63 | while not W2'Access.Should_Close loop 64 | Glfw.Input.Wait_For_Events; 65 | end loop; 66 | 67 | Glfw.Shutdown; 68 | end Glfw_Test.Windows; 69 | -------------------------------------------------------------------------------- /tests/src/glfw3/glfw_test.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Glfw.Errors; 5 | with Ada.Text_IO; 6 | 7 | package body Glfw_Test is 8 | 9 | procedure Print_Error (Code : Glfw.Errors.Kind; Description : String) is 10 | begin 11 | Ada.Text_IO.Put_Line ("Error occured (" & Code'Img & "): " & Description); 12 | end Print_Error; 13 | 14 | procedure Enable_Print_Errors is 15 | begin 16 | Glfw.Errors.Set_Callback (Print_Error'Access); 17 | end Enable_Print_Errors; 18 | end Glfw_Test; 19 | -------------------------------------------------------------------------------- /tests/src/glfw3/glfw_test.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Glfw_Test is 5 | 6 | procedure Enable_Print_Errors; 7 | 8 | end Glfw_Test; 9 | -------------------------------------------------------------------------------- /tests/src/images/images_test_jpg.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2020 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Buffers; 5 | with GL.Types.Colors; 6 | with GL.Fixed.Matrix; 7 | with GL.Images; 8 | with GL.Immediate; 9 | with GL.Objects.Textures.Targets; 10 | with GL.Pixels; 11 | with GL.Toggles; 12 | with GL.Types; 13 | 14 | with GL_Test.Display_Backend; 15 | 16 | procedure Images_Test_JPG is 17 | use GL.Fixed.Matrix; 18 | use GL.Types; 19 | use GL.Types.Doubles; 20 | 21 | Texture : GL.Objects.Textures.Texture; 22 | begin 23 | GL_Test.Display_Backend.Init; 24 | GL_Test.Display_Backend.Open_Window (1000, 498); 25 | 26 | GL.Images.Load_File_To_Texture 27 | ("../ada2012-color.jpg", Texture, GL.Pixels.RGB); 28 | 29 | Projection.Load_Identity; 30 | Projection.Apply_Orthogonal (-1.0, 1.0, -1.0, 1.0, -1.0, 1.0); 31 | 32 | GL.Buffers.Set_Color_Clear_Value (Colors.Color'(1.0, 0.0, 0.0, 1.0)); 33 | 34 | while GL_Test.Display_Backend.Window_Opened loop 35 | GL.Buffers.Clear ((others => True)); 36 | 37 | GL.Objects.Textures.Set_Active_Unit (0); 38 | GL.Toggles.Enable (GL.Toggles.Texture_2D); 39 | GL.Objects.Textures.Targets.Texture_2D.Bind (Texture); 40 | declare 41 | Token : GL.Immediate.Input_Token := GL.Immediate.Start (Quads); 42 | begin 43 | GL.Immediate.Set_Texture_Coordinates (Vector2'(0.0, 0.0)); 44 | Token.Add_Vertex (Vector2'(-1.0, -1.0)); 45 | GL.Immediate.Set_Texture_Coordinates (Vector2'(0.0, 1.0)); 46 | Token.Add_Vertex (Vector2'(-1.0, 1.0)); 47 | GL.Immediate.Set_Texture_Coordinates (Vector2'(1.0, 1.0)); 48 | Token.Add_Vertex (Vector2'(1.0, 1.0)); 49 | GL.Immediate.Set_Texture_Coordinates (Vector2'(1.0, 0.0)); 50 | Token.Add_Vertex (Vector2'(1.0, -1.0)); 51 | end; 52 | GL.Toggles.Disable (GL.Toggles.Texture_2D); 53 | 54 | GL_Test.Display_Backend.Swap_Buffers; 55 | 56 | GL_Test.Display_Backend.Poll_Events; 57 | end loop; 58 | 59 | GL_Test.Display_Backend.Shutdown; 60 | end Images_Test_JPG; 61 | -------------------------------------------------------------------------------- /tests/src/images/images_test_png.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2020 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with GL.Blending; 5 | with GL.Buffers; 6 | with GL.Types.Colors; 7 | with GL.Fixed.Matrix; 8 | with GL.Images; 9 | with GL.Immediate; 10 | with GL.Objects.Textures.Targets; 11 | with GL.Pixels; 12 | with GL.Toggles; 13 | with GL.Types; 14 | 15 | with GL_Test.Display_Backend; 16 | 17 | procedure Images_Test_PNG is 18 | use GL.Fixed.Matrix; 19 | use GL.Types; 20 | use GL.Types.Doubles; 21 | 22 | Texture : GL.Objects.Textures.Texture; 23 | begin 24 | GL_Test.Display_Backend.Init; 25 | GL_Test.Display_Backend.Open_Window (1000, 498); 26 | 27 | GL.Images.Load_File_To_Texture 28 | ("../ada2012-black.png", Texture, GL.Pixels.RGBA); 29 | 30 | Projection.Load_Identity; 31 | Projection.Apply_Orthogonal (-1.0, 1.0, -1.0, 1.0, -1.0, 1.0); 32 | 33 | GL.Buffers.Set_Color_Clear_Value (Colors.Color'(1.0, 0.0, 0.0, 1.0)); 34 | 35 | GL.Toggles.Enable (GL.Toggles.Blend); 36 | GL.Blending.Set_Blend_Func 37 | (GL.Blending.Src_Alpha, GL.Blending.One_Minus_Src_Alpha); 38 | 39 | while GL_Test.Display_Backend.Window_Opened loop 40 | GL.Buffers.Clear ((others => True)); 41 | 42 | GL.Objects.Textures.Set_Active_Unit (0); 43 | GL.Toggles.Enable (GL.Toggles.Texture_2D); 44 | GL.Objects.Textures.Targets.Texture_2D.Bind (Texture); 45 | declare 46 | Token : GL.Immediate.Input_Token := GL.Immediate.Start (Quads); 47 | begin 48 | GL.Immediate.Set_Texture_Coordinates (Vector2'(0.0, 0.0)); 49 | Token.Add_Vertex (Vector2'(-1.0, -1.0)); 50 | GL.Immediate.Set_Texture_Coordinates (Vector2'(0.0, 1.0)); 51 | Token.Add_Vertex (Vector2'(-1.0, 1.0)); 52 | GL.Immediate.Set_Texture_Coordinates (Vector2'(1.0, 1.0)); 53 | Token.Add_Vertex (Vector2'(1.0, 1.0)); 54 | GL.Immediate.Set_Texture_Coordinates (Vector2'(1.0, 0.0)); 55 | Token.Add_Vertex (Vector2'(1.0, -1.0)); 56 | end; 57 | GL.Toggles.Disable (GL.Toggles.Texture_2D); 58 | 59 | GL_Test.Display_Backend.Swap_Buffers; 60 | 61 | GL_Test.Display_Backend.Poll_Events; 62 | end loop; 63 | 64 | GL_Test.Display_Backend.Shutdown; 65 | end Images_Test_PNG; 66 | -------------------------------------------------------------------------------- /tests/src/shared/gl_test-display_backend.adb: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | with Ada.Text_IO; 5 | 6 | with Glfw.Windows.Context; 7 | with Glfw.Windows.Hints; 8 | with Glfw.Input.Keys; 9 | with Glfw.Errors; 10 | 11 | package body GL_Test.Display_Backend is 12 | type Test_Window is new Glfw.Windows.Window with null record; 13 | 14 | overriding 15 | procedure Close_Requested (Object : not null access Test_Window) is 16 | begin 17 | Object.Destroy; 18 | end Close_Requested; 19 | 20 | type Main_Window_Type is not null access Test_Window; 21 | 22 | Main_Window : constant Main_Window_Type := new Test_Window; 23 | 24 | procedure Print_Error (Code : Glfw.Errors.Kind; Description : String) is 25 | begin 26 | Ada.Text_IO.Put_Line ("Error occured (" & Code'Img & "): " & Description); 27 | end Print_Error; 28 | 29 | procedure Enable_Print_Errors is 30 | begin 31 | Glfw.Errors.Set_Callback (Print_Error'Access); 32 | end Enable_Print_Errors; 33 | 34 | procedure Init (Debugging : Boolean := False) is 35 | begin 36 | Enable_Print_Errors; 37 | Glfw.Init; 38 | if Debugging then 39 | Glfw.Windows.Hints.Set_Debug_Context (True); 40 | end if; 41 | end Init; 42 | 43 | procedure Open_Window (Width, Height : Natural; Depth_Bits : Natural := 0) is 44 | begin 45 | if not Main_Window.Initialized then 46 | Glfw.Windows.Hints.Set_Depth_Bits (Depth_Bits); 47 | Main_Window.Init (Glfw.Size (Width), Glfw.Size (Height), 48 | "Test Window"); 49 | end if; 50 | Main_Window.Show; 51 | Main_Window.Enable_Callback (Glfw.Windows.Callbacks.Close); 52 | Glfw.Windows.Context.Make_Current (Main_Window); 53 | end Open_Window; 54 | 55 | procedure Swap_Buffers is 56 | begin 57 | Glfw.Windows.Context.Swap_Buffers (Main_Window); 58 | end Swap_Buffers; 59 | 60 | procedure Poll_Events is 61 | begin 62 | Glfw.Input.Poll_Events; 63 | end Poll_Events; 64 | 65 | procedure Wait_For_Events is 66 | begin 67 | Glfw.Input.Wait_For_Events; 68 | end Wait_For_Events; 69 | 70 | procedure Set_Window_Title (Value : String) is 71 | begin 72 | Main_Window.Set_Title (Value); 73 | end Set_Window_Title; 74 | 75 | function Escape_Pressed return Boolean is 76 | use type Glfw.Input.Button_State; 77 | begin 78 | return Main_Window.Initialized and then 79 | Main_Window.Key_State (Glfw.Input.Keys.Escape) = Glfw.Input.Pressed; 80 | end Escape_Pressed; 81 | 82 | function Window_Opened return Boolean is 83 | begin 84 | return Main_Window.Initialized and then Main_Window.Visible; 85 | end Window_Opened; 86 | 87 | procedure Close_Window is 88 | begin 89 | Main_Window.Destroy; 90 | end Close_Window; 91 | 92 | procedure Shutdown renames Glfw.Shutdown; 93 | 94 | procedure Configure_Minimum_OpenGL_Version (Major, Minor : Natural) is 95 | begin 96 | Glfw.Windows.Hints.Set_Minimum_OpenGL_Version (Major, Minor); 97 | -- needed for OSX 98 | if Major >= 3 then 99 | Glfw.Windows.Hints.Set_Forward_Compat (True); 100 | Glfw.Windows.Hints.Set_Profile (Glfw.Windows.Context.Core_Profile); 101 | end if; 102 | end Configure_Minimum_OpenGL_Version; 103 | 104 | end GL_Test.Display_Backend; 105 | -------------------------------------------------------------------------------- /tests/src/shared/gl_test-display_backend.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package GL_Test.Display_Backend is 5 | -- abstraction layer for tests so they can run on both GLFW 2 and 3. 6 | -- only exposes most basic functionality, not intended for usage outside 7 | -- tests. 8 | 9 | procedure Init (Debugging : Boolean := False); 10 | 11 | procedure Open_Window (Width, Height : Natural; Depth_Bits : Natural := 0); 12 | 13 | procedure Swap_Buffers; 14 | 15 | procedure Poll_Events; 16 | 17 | procedure Wait_For_Events; 18 | 19 | procedure Set_Window_Title (Value : String); 20 | 21 | function Escape_Pressed return Boolean; 22 | 23 | function Window_Opened return Boolean; 24 | 25 | procedure Close_Window; 26 | 27 | procedure Shutdown; 28 | 29 | procedure Configure_Minimum_OpenGL_Version (Major, Minor : Natural); 30 | 31 | end GL_Test.Display_Backend; 32 | -------------------------------------------------------------------------------- /tests/src/shared/gl_test.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package GL_Test is 5 | pragma Pure; 6 | end GL_Test; 7 | -------------------------------------------------------------------------------- /tests/src/text/text_test-basic-fragment.glsl: -------------------------------------------------------------------------------- 1 | #version 410 core 2 | in vec2 uv; 3 | out vec4 color; 4 | uniform sampler2D texSampler; 5 | void main() { 6 | color = vec4(1.0, 0.0, 0.0, texture(texSampler, uv).r); 7 | } -------------------------------------------------------------------------------- /tests/src/text/text_test-basic-vertex.glsl: -------------------------------------------------------------------------------- 1 | #version 410 core 2 | layout(location = 0) in vec2 vertex; 3 | uniform mat4 transformation; 4 | uniform vec2 dimensions; 5 | out vec2 uv; 6 | void main() { 7 | gl_Position = transformation * vec4(vertex.x * dimensions.x, 8 | vertex.y * dimensions.y, 0.0, 1.0); 9 | uv = vertex; 10 | } 11 | -------------------------------------------------------------------------------- /tests/src/text/text_test.ads: -------------------------------------------------------------------------------- 1 | -- part of OpenGLAda, (c) 2017 Felix Krause 2 | -- released under the terms of the MIT license, see the file "COPYING" 3 | 4 | package Text_Test is 5 | pragma Pure; 6 | end Text_Test; 7 | -------------------------------------------------------------------------------- /tests/texgyreadventor-regular.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/flyx/OpenGLAda/16c42a07e6375e6f38a4177d138ff2bcb7aab6e4/tests/texgyreadventor-regular.otf --------------------------------------------------------------------------------