fortrangoingonforty/fortty / b0c1a51

Browse files

Add window title support and cursor styles

Authored by mfwolffe <wolffemf@dukes.jmu.edu>
SHA
b0c1a510965b4d408d4c39e082ede2a9f52a85b8
Parents
abacd9a
Tree
7ddabd9

3 changed files

StatusFile+-
M src/terminal/parser.f90 87 4
M src/text/renderer.f90 66 0
M src/window/glfw_bindings.f90 65 0
src/terminal/parser.f90modified
@@ -2,6 +2,7 @@ module parser_mod
22
   use cell_mod
33
   use screen_mod
44
   use terminal_mod
5
+  use cursor_mod, only: CURSOR_BLOCK, CURSOR_UNDERLINE, CURSOR_BAR
56
   implicit none
67
   private
78
@@ -30,6 +31,10 @@ module parser_mod
3031
     logical :: has_private = .false.
3132
     character(len=1) :: private_marker = ' '
3233
34
+    ! Intermediate character (for sequences like CSI Ps SP q)
35
+    character(len=1) :: intermediate = ' '
36
+    logical :: has_intermediate = .false.
37
+
3338
     ! OSC string buffer (for window title, etc.)
3439
     character(len=256) :: osc_buffer
3540
     integer :: osc_len = 0
@@ -61,6 +66,8 @@ contains
6166
     p%param_started = .false.
6267
     p%has_private = .false.
6368
     p%private_marker = ' '
69
+    p%has_intermediate = .false.
70
+    p%intermediate = ' '
6471
     p%osc_buffer = ''
6572
     p%osc_len = 0
6673
     ! Note: Don't reset UTF-8 state here - it persists across escape sequences
@@ -258,8 +265,10 @@ contains
258265
       return
259266
     end if
260267
261
-    ! Intermediate byte or unknown - ignore but stay in CSI
268
+    ! Intermediate byte (space, !, ", etc.) - store it
262269
     if (byte >= 32 .and. byte <= 47) then
270
+      p%has_intermediate = .true.
271
+      p%intermediate = char(byte)
263272
       return
264273
     end if
265274
@@ -275,24 +284,70 @@ contains
275284
276285
     ! OSC ends with BEL (7) or ST (ESC \)
277286
     if (byte == 7) then  ! BEL
278
-      ! OSC complete - we could set window title here
287
+      call dispatch_osc(p, term)
279288
       call parser_reset(p)
280289
       return
281290
     end if
282291
283292
     if (byte == 27) then  ! ESC - might be ST
284
-      ! For simplicity, just reset - real parser would check for '\'
293
+      ! For simplicity, dispatch and reset
294
+      call dispatch_osc(p, term)
285295
       call parser_reset(p)
286296
       return
287297
     end if
288298
289
-    ! Accumulate OSC string (we ignore it for now)
299
+    ! Accumulate OSC string
290300
     if (p%osc_len < 256) then
291301
       p%osc_len = p%osc_len + 1
292302
       p%osc_buffer(p%osc_len:p%osc_len) = char(byte)
293303
     end if
294304
   end subroutine handle_osc
295305
306
+  ! Dispatch OSC command
307
+  subroutine dispatch_osc(p, term)
308
+    type(parser_t), intent(in) :: p
309
+    type(terminal_t), intent(inout) :: term
310
+    integer :: cmd, sep_pos, i
311
+    character(len=256) :: title_text
312
+
313
+    if (p%osc_len == 0) return
314
+
315
+    ! Parse command number (before first ';')
316
+    sep_pos = 0
317
+    do i = 1, p%osc_len
318
+      if (p%osc_buffer(i:i) == ';') then
319
+        sep_pos = i
320
+        exit
321
+      end if
322
+    end do
323
+
324
+    if (sep_pos == 0) return  ! No separator found
325
+
326
+    ! Extract command number
327
+    cmd = 0
328
+    do i = 1, sep_pos - 1
329
+      if (p%osc_buffer(i:i) >= '0' .and. p%osc_buffer(i:i) <= '9') then
330
+        cmd = cmd * 10 + (ichar(p%osc_buffer(i:i)) - ichar('0'))
331
+      end if
332
+    end do
333
+
334
+    ! Extract title text (after ';')
335
+    title_text = ''
336
+    if (sep_pos < p%osc_len) then
337
+      title_text = p%osc_buffer(sep_pos + 1:p%osc_len)
338
+    end if
339
+
340
+    select case (cmd)
341
+      case (0)  ! Set icon name and window title
342
+        call terminal_set_title(term, trim(title_text))
343
+      case (1)  ! Set icon name only (we treat as title too)
344
+        call terminal_set_title(term, trim(title_text))
345
+      case (2)  ! Set window title only
346
+        call terminal_set_title(term, trim(title_text))
347
+      ! Other OSC commands can be added here
348
+    end select
349
+  end subroutine dispatch_osc
350
+
296351
   ! Dispatch CSI command based on final byte
297352
   subroutine dispatch_csi(p, term, cmd)
298353
     type(parser_t), intent(inout) :: p
@@ -312,6 +367,34 @@ contains
312367
       return
313368
     end if
314369
370
+    ! Handle DECSCUSR (CSI Ps SP q) - Set Cursor Style
371
+    if (p%has_intermediate .and. p%intermediate == ' ' .and. cmd == 113) then
372
+      ! Ps=0,1: blinking block, Ps=2: steady block
373
+      ! Ps=3: blinking underline, Ps=4: steady underline
374
+      ! Ps=5: blinking bar, Ps=6: steady bar
375
+      select case (n)
376
+        case (0, 1)  ! Blinking block
377
+          term%cursor%style = CURSOR_BLOCK
378
+          term%cursor%blink = .true.
379
+        case (2)  ! Steady block
380
+          term%cursor%style = CURSOR_BLOCK
381
+          term%cursor%blink = .false.
382
+        case (3)  ! Blinking underline
383
+          term%cursor%style = CURSOR_UNDERLINE
384
+          term%cursor%blink = .true.
385
+        case (4)  ! Steady underline
386
+          term%cursor%style = CURSOR_UNDERLINE
387
+          term%cursor%blink = .false.
388
+        case (5)  ! Blinking bar
389
+          term%cursor%style = CURSOR_BAR
390
+          term%cursor%blink = .true.
391
+        case (6)  ! Steady bar
392
+          term%cursor%style = CURSOR_BAR
393
+          term%cursor%blink = .false.
394
+      end select
395
+      return
396
+    end if
397
+
315398
     select case (cmd)
316399
       case (65)  ! 'A' - CUU (cursor up)
317400
         call terminal_cursor_up(term, n)
src/text/renderer.f90modified
@@ -12,6 +12,7 @@ module renderer_mod
1212
   public :: renderer_create, renderer_destroy
1313
   public :: renderer_begin, renderer_draw_char, renderer_draw_string, renderer_flush
1414
   public :: renderer_set_projection, renderer_load_fallback_font
15
+  public :: renderer_draw_rect
1516
1617
   ! Vertex format: position(2) + texcoord(2) + color(4) = 8 floats per vertex
1718
   integer, parameter :: FLOATS_PER_VERTEX = 8
@@ -337,4 +338,69 @@ contains
337338
     call font_load_fallback(r%font, font_path)
338339
   end subroutine renderer_load_fallback_font
339340
341
+  ! Draw a solid rectangle at position (x, y) with size (w, h)
342
+  subroutine renderer_draw_rect(r, x, y, w, h, red, green, blue, alpha)
343
+    type(renderer_t), intent(inout) :: r
344
+    real, intent(in) :: x, y, w, h
345
+    real, intent(in) :: red, green, blue, alpha
346
+    real(c_float) :: x0, y0, x1, y1
347
+    real(c_float) :: u0, v0, u1, v1
348
+    integer :: base
349
+
350
+    ! Check for overflow
351
+    if (r%vertex_count + VERTICES_PER_QUAD > MAX_VERTICES) then
352
+      call renderer_flush(r)
353
+    end if
354
+
355
+    ! Rectangle corners
356
+    x0 = real(x, c_float)
357
+    y0 = real(y, c_float)
358
+    x1 = x0 + real(w, c_float)
359
+    y1 = y0 + real(h, c_float)
360
+
361
+    ! Use UV coords (0,0) which should sample a solid pixel from atlas
362
+    ! Most atlases have a solid white pixel at origin
363
+    u0 = 0.0_c_float
364
+    v0 = 0.0_c_float
365
+    u1 = 0.001_c_float  ! Tiny region to avoid sampling other glyphs
366
+    v1 = 0.001_c_float
367
+
368
+    ! Build 6 vertices for 2 triangles
369
+    base = r%vertex_count * FLOATS_PER_VERTEX + 1
370
+
371
+    ! Triangle 1: bottom-left, bottom-right, top-left
372
+    r%vertices(base:base+7) = [x0, y1, u0, v1, &
373
+                               real(red,c_float), real(green,c_float), &
374
+                               real(blue,c_float), real(alpha,c_float)]
375
+    base = base + FLOATS_PER_VERTEX
376
+
377
+    r%vertices(base:base+7) = [x1, y1, u1, v1, &
378
+                               real(red,c_float), real(green,c_float), &
379
+                               real(blue,c_float), real(alpha,c_float)]
380
+    base = base + FLOATS_PER_VERTEX
381
+
382
+    r%vertices(base:base+7) = [x0, y0, u0, v0, &
383
+                               real(red,c_float), real(green,c_float), &
384
+                               real(blue,c_float), real(alpha,c_float)]
385
+    base = base + FLOATS_PER_VERTEX
386
+
387
+    ! Triangle 2: bottom-right, top-right, top-left
388
+    r%vertices(base:base+7) = [x1, y1, u1, v1, &
389
+                               real(red,c_float), real(green,c_float), &
390
+                               real(blue,c_float), real(alpha,c_float)]
391
+    base = base + FLOATS_PER_VERTEX
392
+
393
+    r%vertices(base:base+7) = [x1, y0, u1, v0, &
394
+                               real(red,c_float), real(green,c_float), &
395
+                               real(blue,c_float), real(alpha,c_float)]
396
+    base = base + FLOATS_PER_VERTEX
397
+
398
+    r%vertices(base:base+7) = [x0, y0, u0, v0, &
399
+                               real(red,c_float), real(green,c_float), &
400
+                               real(blue,c_float), real(alpha,c_float)]
401
+
402
+    r%vertex_count = r%vertex_count + VERTICES_PER_QUAD
403
+
404
+  end subroutine renderer_draw_rect
405
+
340406
 end module renderer_mod
src/window/glfw_bindings.f90modified
@@ -84,6 +84,11 @@ module glfw_bindings
8484
   integer(c_int), parameter :: GLFW_PRESS = 1
8585
   integer(c_int), parameter :: GLFW_REPEAT = 2
8686
87
+  ! Mouse button constants
88
+  integer(c_int), parameter :: GLFW_MOUSE_BUTTON_LEFT = 0
89
+  integer(c_int), parameter :: GLFW_MOUSE_BUTTON_RIGHT = 1
90
+  integer(c_int), parameter :: GLFW_MOUSE_BUTTON_MIDDLE = 2
91
+
8792
   ! Callback type for framebuffer size
8893
   abstract interface
8994
     subroutine glfw_framebuffer_size_callback(window, width, height) bind(C)
@@ -115,6 +120,18 @@ module glfw_bindings
115120
       type(c_ptr), value :: window
116121
       real(c_double), value :: xoffset, yoffset
117122
     end subroutine glfw_scroll_callback
123
+
124
+    subroutine glfw_mouse_button_callback(window, button, action, mods) bind(C)
125
+      import :: c_ptr, c_int
126
+      type(c_ptr), value :: window
127
+      integer(c_int), value :: button, action, mods
128
+    end subroutine glfw_mouse_button_callback
129
+
130
+    subroutine glfw_cursor_pos_callback(window, xpos, ypos) bind(C)
131
+      import :: c_ptr, c_double
132
+      type(c_ptr), value :: window
133
+      real(c_double), value :: xpos, ypos
134
+    end subroutine glfw_cursor_pos_callback
118135
   end interface
119136
120137
   interface
@@ -168,6 +185,13 @@ module glfw_bindings
168185
       integer(c_int), value :: value
169186
     end subroutine glfwSetWindowShouldClose
170187
188
+    ! void glfwSetWindowTitle(GLFWwindow* window, const char* title)
189
+    subroutine glfwSetWindowTitle(window, title) bind(C, name="glfwSetWindowTitle")
190
+      import :: c_ptr, c_char
191
+      type(c_ptr), value :: window
192
+      character(kind=c_char), intent(in) :: title(*)
193
+    end subroutine glfwSetWindowTitle
194
+
171195
     ! void glfwSwapBuffers(GLFWwindow* window)
172196
     subroutine glfwSwapBuffers(window) bind(C, name="glfwSwapBuffers")
173197
       import :: c_ptr
@@ -178,6 +202,11 @@ module glfw_bindings
178202
     subroutine glfwPollEvents() bind(C, name="glfwPollEvents")
179203
     end subroutine glfwPollEvents
180204
205
+    ! double glfwGetTime(void)
206
+    real(c_double) function glfwGetTime() bind(C, name="glfwGetTime")
207
+      import :: c_double
208
+    end function glfwGetTime
209
+
181210
     ! void glfwGetFramebufferSize(GLFWwindow* window, int* width, int* height)
182211
     subroutine glfwGetFramebufferSize(window, width, height) bind(C, name="glfwGetFramebufferSize")
183212
       import :: c_int, c_ptr
@@ -230,6 +259,42 @@ module glfw_bindings
230259
       import :: c_funptr, c_char
231260
       character(kind=c_char), intent(in) :: procname(*)
232261
     end function glfwGetProcAddress
262
+
263
+    ! GLFWmousebuttonfun glfwSetMouseButtonCallback(GLFWwindow* window, GLFWmousebuttonfun callback)
264
+    type(c_funptr) function glfwSetMouseButtonCallback(window, callback) &
265
+        bind(C, name="glfwSetMouseButtonCallback")
266
+      import :: c_ptr, c_funptr
267
+      type(c_ptr), value :: window
268
+      type(c_funptr), value :: callback
269
+    end function glfwSetMouseButtonCallback
270
+
271
+    ! GLFWcursorposfun glfwSetCursorPosCallback(GLFWwindow* window, GLFWcursorposfun callback)
272
+    type(c_funptr) function glfwSetCursorPosCallback(window, callback) &
273
+        bind(C, name="glfwSetCursorPosCallback")
274
+      import :: c_ptr, c_funptr
275
+      type(c_ptr), value :: window
276
+      type(c_funptr), value :: callback
277
+    end function glfwSetCursorPosCallback
278
+
279
+    ! void glfwGetCursorPos(GLFWwindow* window, double* xpos, double* ypos)
280
+    subroutine glfwGetCursorPos(window, xpos, ypos) bind(C, name="glfwGetCursorPos")
281
+      import :: c_ptr, c_double
282
+      type(c_ptr), value :: window
283
+      real(c_double), intent(out) :: xpos, ypos
284
+    end subroutine glfwGetCursorPos
285
+
286
+    ! const char* glfwGetClipboardString(GLFWwindow* window)
287
+    type(c_ptr) function glfwGetClipboardString(window) bind(C, name="glfwGetClipboardString")
288
+      import :: c_ptr
289
+      type(c_ptr), value :: window
290
+    end function glfwGetClipboardString
291
+
292
+    ! void glfwSetClipboardString(GLFWwindow* window, const char* string)
293
+    subroutine glfwSetClipboardString(window, string) bind(C, name="glfwSetClipboardString")
294
+      import :: c_ptr, c_char
295
+      type(c_ptr), value :: window
296
+      character(kind=c_char), intent(in) :: string(*)
297
+    end subroutine glfwSetClipboardString
233298
   end interface
234299
235300
 end module glfw_bindings