| 1 | module window_mod |
| 2 | use, intrinsic :: iso_c_binding |
| 3 | use types |
| 4 | use glfw_bindings |
| 5 | use gl_bindings |
| 6 | implicit none |
| 7 | private |
| 8 | |
| 9 | public :: window_t |
| 10 | public :: window_create, window_destroy |
| 11 | public :: window_should_close, window_swap_buffers, window_poll_events |
| 12 | |
| 13 | type :: window_t |
| 14 | type(c_ptr) :: handle = c_null_ptr |
| 15 | integer :: width = 0 |
| 16 | integer :: height = 0 |
| 17 | integer :: fb_width = 0 |
| 18 | integer :: fb_height = 0 |
| 19 | end type window_t |
| 20 | |
| 21 | ! Module-level window pointer for callbacks |
| 22 | ! (GLFW callbacks don't have user data for framebuffer callback) |
| 23 | type(c_ptr), save :: current_window = c_null_ptr |
| 24 | |
| 25 | ! Interface to C helper for loading OpenGL |
| 26 | interface |
| 27 | integer(c_int) function fortty_load_gl() bind(C, name="fortty_load_gl") |
| 28 | import :: c_int |
| 29 | end function fortty_load_gl |
| 30 | end interface |
| 31 | |
| 32 | contains |
| 33 | |
| 34 | function window_create(width, height, title) result(win) |
| 35 | integer, intent(in) :: width, height |
| 36 | character(len=*), intent(in) :: title |
| 37 | type(window_t) :: win |
| 38 | type(c_funptr) :: dummy |
| 39 | integer(c_int) :: gl_loaded |
| 40 | character(len=256) :: c_title |
| 41 | |
| 42 | ! Initialize GLFW |
| 43 | if (glfwInit() == GLFW_FALSE) then |
| 44 | print *, "Error: Failed to initialize GLFW" |
| 45 | stop 1 |
| 46 | end if |
| 47 | |
| 48 | ! Set error callback |
| 49 | dummy = glfwSetErrorCallback(c_funloc(error_callback)) |
| 50 | |
| 51 | ! Request OpenGL 3.3 Core Profile |
| 52 | call glfwWindowHint(GLFW_CONTEXT_VERSION_MAJOR, 3) |
| 53 | call glfwWindowHint(GLFW_CONTEXT_VERSION_MINOR, 3) |
| 54 | call glfwWindowHint(GLFW_OPENGL_PROFILE, GLFW_OPENGL_CORE_PROFILE) |
| 55 | call glfwWindowHint(GLFW_OPENGL_FORWARD_COMPAT, GLFW_TRUE) |
| 56 | |
| 57 | ! Create window |
| 58 | c_title = trim(title) // c_null_char |
| 59 | win%handle = glfwCreateWindow(width, height, c_title, c_null_ptr, c_null_ptr) |
| 60 | |
| 61 | if (.not. c_associated(win%handle)) then |
| 62 | print *, "Error: Failed to create GLFW window" |
| 63 | call glfwTerminate() |
| 64 | stop 1 |
| 65 | end if |
| 66 | |
| 67 | win%width = width |
| 68 | win%height = height |
| 69 | current_window = win%handle |
| 70 | |
| 71 | ! Make context current |
| 72 | call glfwMakeContextCurrent(win%handle) |
| 73 | |
| 74 | ! Load OpenGL functions via GLAD |
| 75 | gl_loaded = fortty_load_gl() |
| 76 | if (gl_loaded == 0) then |
| 77 | print *, "Error: Failed to load OpenGL functions" |
| 78 | call glfwDestroyWindow(win%handle) |
| 79 | call glfwTerminate() |
| 80 | stop 1 |
| 81 | end if |
| 82 | |
| 83 | ! Get actual framebuffer size (may differ on HiDPI) |
| 84 | call glfwGetFramebufferSize(win%handle, win%fb_width, win%fb_height) |
| 85 | |
| 86 | ! Set initial viewport |
| 87 | call glViewport(0, 0, win%fb_width, win%fb_height) |
| 88 | |
| 89 | ! Register callbacks |
| 90 | dummy = glfwSetFramebufferSizeCallback(win%handle, c_funloc(framebuffer_size_callback)) |
| 91 | dummy = glfwSetKeyCallback(win%handle, c_funloc(key_callback)) |
| 92 | |
| 93 | end function window_create |
| 94 | |
| 95 | subroutine window_destroy(win) |
| 96 | type(window_t), intent(inout) :: win |
| 97 | |
| 98 | if (c_associated(win%handle)) then |
| 99 | call glfwDestroyWindow(win%handle) |
| 100 | win%handle = c_null_ptr |
| 101 | end if |
| 102 | |
| 103 | call glfwTerminate() |
| 104 | end subroutine window_destroy |
| 105 | |
| 106 | function window_should_close(win) result(should) |
| 107 | type(window_t), intent(in) :: win |
| 108 | logical :: should |
| 109 | |
| 110 | should = glfwWindowShouldClose(win%handle) /= GLFW_FALSE |
| 111 | end function window_should_close |
| 112 | |
| 113 | subroutine window_swap_buffers(win) |
| 114 | type(window_t), intent(in) :: win |
| 115 | |
| 116 | call glfwSwapBuffers(win%handle) |
| 117 | end subroutine window_swap_buffers |
| 118 | |
| 119 | subroutine window_poll_events() |
| 120 | call glfwPollEvents() |
| 121 | end subroutine window_poll_events |
| 122 | |
| 123 | ! Callback: handle window resize |
| 124 | subroutine framebuffer_size_callback(window, width, height) bind(C) |
| 125 | type(c_ptr), value :: window |
| 126 | integer(c_int), value :: width, height |
| 127 | |
| 128 | call glViewport(0, 0, width, height) |
| 129 | end subroutine framebuffer_size_callback |
| 130 | |
| 131 | ! Callback: handle key presses |
| 132 | subroutine key_callback(window, key, scancode, action, mods) bind(C) |
| 133 | type(c_ptr), value :: window |
| 134 | integer(c_int), value :: key, scancode, action, mods |
| 135 | |
| 136 | ! Close window on Escape |
| 137 | if (key == GLFW_KEY_ESCAPE .and. action == GLFW_PRESS) then |
| 138 | call glfwSetWindowShouldClose(window, GLFW_TRUE) |
| 139 | end if |
| 140 | end subroutine key_callback |
| 141 | |
| 142 | ! Callback: handle GLFW errors |
| 143 | subroutine error_callback(error_code, description) bind(C) |
| 144 | integer(c_int), value :: error_code |
| 145 | type(c_ptr), value :: description |
| 146 | |
| 147 | print *, "GLFW Error ", error_code |
| 148 | end subroutine error_callback |
| 149 | |
| 150 | end module window_mod |
| 151 |