Fortran · 23055 bytes Raw Blame History
1 ! Custom Cairo Breadcrumb Widget for Sniffly
2 ! Renders path as clickable, color-coded text segments with hover effects
3 module breadcrumb_widget
4 use, intrinsic :: iso_c_binding
5 use gtk, only: gtk_drawing_area_new, gtk_drawing_area_set_draw_func, &
6 gtk_widget_set_size_request, gtk_event_controller_motion_new, &
7 gtk_widget_add_controller, g_signal_connect, &
8 gtk_gesture_click_new, gtk_widget_queue_draw
9 use cairo, only: cairo_set_source_rgb, cairo_set_source_rgba, cairo_move_to
10 use pango, only: pango_cairo_create_layout, pango_layout_set_text, &
11 pango_font_description_from_string, pango_layout_set_font_description, &
12 pango_cairo_show_layout, pango_layout_get_pixel_size, &
13 pango_font_description_free
14 implicit none
15 private
16
17 public :: create_breadcrumb_widget, update_breadcrumb_cache, &
18 set_navigation_callback, get_breadcrumb_widget_ptr, &
19 get_previous_breadcrumb_path, clear_previous_breadcrumb_path
20
21 ! Callback interface for navigation events
22 abstract interface
23 subroutine navigation_callback()
24 end subroutine navigation_callback
25 end interface
26
27 ! Segment bounds for hit-testing
28 type :: segment_bounds
29 integer(c_int) :: x, y, width, height
30 end type segment_bounds
31
32 ! Maximum number of path segments
33 integer, parameter :: MAX_SEGMENTS = 50
34
35 ! Path segment cache (updated on main thread only via update_breadcrumb_cache)
36 character(len=512), dimension(MAX_SEGMENTS), save :: cached_segment_paths = ""
37 character(len=256), dimension(MAX_SEGMENTS), save :: cached_segment_names = ""
38 integer, save :: cached_segment_count = 0
39
40 ! Forward lookahead segments (greyed out continuation when navigating back)
41 character(len=512), dimension(MAX_SEGMENTS), save :: cached_forward_segment_paths = ""
42 character(len=256), dimension(MAX_SEGMENTS), save :: cached_forward_segment_names = ""
43 integer, save :: cached_forward_segment_count = 0
44
45 ! Hover state
46 integer, save :: hovered_segment = 0 ! 0 = none, 1+ = segment index
47 integer, save :: last_hovered_segment = -1
48
49 ! Click bounds for each segment (populated during draw)
50 type(segment_bounds), dimension(MAX_SEGMENTS), save :: segment_rects
51
52 ! Widget pointer
53 type(c_ptr), save :: breadcrumb_widget_ptr = c_null_ptr
54
55 ! Navigation callback (called when user clicks a segment)
56 procedure(navigation_callback), pointer, save :: nav_callback => null()
57
58 ! Previous path before breadcrumb navigation (for lookahead detection)
59 character(len=512), save :: previous_breadcrumb_path = ""
60
61 contains
62
63 ! Create and initialize the breadcrumb drawing area widget
64 function create_breadcrumb_widget() result(widget)
65 type(c_ptr) :: widget, motion_controller, click_controller
66
67 ! Create drawing area
68 widget = gtk_drawing_area_new()
69 breadcrumb_widget_ptr = widget
70
71 if (.not. c_associated(widget)) then
72 print *, "ERROR: Failed to create breadcrumb drawing area"
73 return
74 end if
75
76 ! Set minimum height (width will expand to fill)
77 call gtk_widget_set_size_request(widget, -1_c_int, 30_c_int)
78
79 ! Set draw function (called when widget needs to redraw)
80 call gtk_drawing_area_set_draw_func(widget, &
81 c_funloc(on_draw_breadcrumb), &
82 c_null_ptr, &
83 c_null_funptr)
84
85 ! Add motion event controller for hover
86 motion_controller = gtk_event_controller_motion_new()
87 call g_signal_connect(motion_controller, "motion"//c_null_char, &
88 c_funloc(on_breadcrumb_motion), c_null_ptr)
89 call gtk_widget_add_controller(widget, motion_controller)
90
91 ! Add click gesture controller for navigation
92 click_controller = gtk_gesture_click_new()
93 call g_signal_connect(click_controller, "pressed"//c_null_char, &
94 c_funloc(on_breadcrumb_click), c_null_ptr)
95 call gtk_widget_add_controller(widget, click_controller)
96
97 print *, "Breadcrumb widget created successfully"
98 end function create_breadcrumb_widget
99
100 ! Get widget pointer (for external access)
101 function get_breadcrumb_widget_ptr() result(ptr)
102 type(c_ptr) :: ptr
103 ptr = breadcrumb_widget_ptr
104 end function get_breadcrumb_widget_ptr
105
106 ! Register a callback to be called when navigation occurs
107 subroutine set_navigation_callback(callback)
108 procedure(navigation_callback) :: callback
109 nav_callback => callback
110 print *, "Breadcrumb navigation callback registered"
111 end subroutine set_navigation_callback
112
113 ! Update cached path segments (called from main thread on navigation events)
114 ! This is the ONLY function that modifies cached_segment_*
115 subroutine update_breadcrumb_cache(full_path, forward_path)
116 character(len=*), intent(in) :: full_path
117 character(len=*), intent(in), optional :: forward_path
118 character(len=512) :: working_path, fwd_continuation
119 integer :: slash_pos, start_pos, current_len
120
121 print *, "Updating breadcrumb cache for: ", trim(full_path)
122
123 ! Reset cache
124 cached_segment_count = 0
125 cached_segment_paths = ""
126 cached_segment_names = ""
127 cached_forward_segment_count = 0
128 cached_forward_segment_paths = ""
129 cached_forward_segment_names = ""
130
131 ! If path is empty, trigger redraw to clear breadcrumb and return
132 if (len_trim(full_path) == 0) then
133 call queue_redraw()
134 return
135 end if
136
137 ! Use full path (no ~ abbreviation for better navigation)
138 working_path = trim(full_path)
139
140 ! Handle root path
141 if (trim(working_path) == "/") then
142 cached_segment_count = 1
143 cached_segment_paths(1) = "/"
144 cached_segment_names(1) = "/"
145 print *, " Segment 1: / -> /"
146 call queue_redraw()
147 return
148 end if
149
150 ! Parse path into segments
151 start_pos = 1
152
153 ! Add root segment
154 if (working_path(1:1) == "/") then
155 start_pos = 2
156 cached_segment_count = 1
157 cached_segment_paths(1) = "/"
158 cached_segment_names(1) = "/"
159 print *, " Segment 1: / -> /"
160 end if
161
162 ! Parse remaining segments
163 do while (start_pos <= len_trim(working_path) .and. cached_segment_count < MAX_SEGMENTS)
164 ! Skip any leading slashes
165 do while (start_pos <= len_trim(working_path) .and. working_path(start_pos:start_pos) == "/")
166 start_pos = start_pos + 1
167 end do
168
169 ! Check if we've reached the end
170 if (start_pos > len_trim(working_path)) exit
171
172 ! Find next slash
173 slash_pos = index(working_path(start_pos:), "/")
174
175 if (slash_pos == 0) then
176 ! Last segment (no trailing slash)
177 cached_segment_count = cached_segment_count + 1
178 cached_segment_paths(cached_segment_count) = trim(working_path)
179 cached_segment_names(cached_segment_count) = trim(working_path(start_pos:))
180 print *, " Segment ", cached_segment_count, ": ", &
181 trim(cached_segment_paths(cached_segment_count)), " -> ", &
182 trim(cached_segment_names(cached_segment_count))
183 exit
184 else
185 ! Intermediate segment
186 cached_segment_count = cached_segment_count + 1
187 cached_segment_paths(cached_segment_count) = trim(working_path(1:start_pos+slash_pos-2))
188 cached_segment_names(cached_segment_count) = trim(working_path(start_pos:start_pos+slash_pos-2))
189 print *, " Segment ", cached_segment_count, ": ", &
190 trim(cached_segment_paths(cached_segment_count)), " -> ", &
191 trim(cached_segment_names(cached_segment_count))
192 start_pos = start_pos + slash_pos
193 end if
194 end do
195
196 print *, "Breadcrumb cache updated: ", cached_segment_count, " segments"
197
198 ! Parse forward lookahead continuation (if provided)
199 if (present(forward_path) .and. len_trim(forward_path) > 0) then
200 current_len = len_trim(full_path)
201
202 ! Check if forward_path starts with current path
203 if (len_trim(forward_path) > current_len) then
204 if (forward_path(1:current_len) == full_path(1:current_len)) then
205 ! Extract continuation (everything after current path)
206 if (forward_path(current_len+1:current_len+1) == "/") then
207 fwd_continuation = trim(forward_path(current_len+1:))
208 else
209 fwd_continuation = trim(forward_path(current_len:))
210 end if
211
212 print *, "Forward continuation: ", trim(fwd_continuation)
213
214 ! Parse continuation segments (similar to main path parsing)
215 start_pos = 1
216
217 ! Skip leading slashes
218 do while (start_pos <= len_trim(fwd_continuation) .and. &
219 fwd_continuation(start_pos:start_pos) == "/")
220 start_pos = start_pos + 1
221 end do
222
223 ! Parse forward segments
224 do while (start_pos <= len_trim(fwd_continuation) .and. &
225 cached_forward_segment_count < MAX_SEGMENTS)
226 ! Skip any leading slashes
227 do while (start_pos <= len_trim(fwd_continuation) .and. &
228 fwd_continuation(start_pos:start_pos) == "/")
229 start_pos = start_pos + 1
230 end do
231
232 if (start_pos > len_trim(fwd_continuation)) exit
233
234 ! Find next slash
235 slash_pos = index(fwd_continuation(start_pos:), "/")
236
237 if (slash_pos == 0) then
238 ! Last segment
239 cached_forward_segment_count = cached_forward_segment_count + 1
240 cached_forward_segment_paths(cached_forward_segment_count) = trim(forward_path)
241 cached_forward_segment_names(cached_forward_segment_count) = &
242 trim(fwd_continuation(start_pos:))
243 print *, " Forward segment ", cached_forward_segment_count, ": ", &
244 trim(cached_forward_segment_names(cached_forward_segment_count))
245 exit
246 else
247 ! Intermediate segment
248 cached_forward_segment_count = cached_forward_segment_count + 1
249 ! Build full path up to this segment
250 cached_forward_segment_paths(cached_forward_segment_count) = &
251 trim(full_path) // trim(fwd_continuation(1:start_pos+slash_pos-2))
252 cached_forward_segment_names(cached_forward_segment_count) = &
253 trim(fwd_continuation(start_pos:start_pos+slash_pos-2))
254 print *, " Forward segment ", cached_forward_segment_count, ": ", &
255 trim(cached_forward_segment_names(cached_forward_segment_count))
256 start_pos = start_pos + slash_pos
257 end if
258 end do
259
260 print *, "Forward lookahead: ", cached_forward_segment_count, " segments"
261 end if
262 end if
263 end if
264
265 ! Trigger redraw
266 call queue_redraw()
267 end subroutine update_breadcrumb_cache
268
269 ! Helper: Queue redraw of widget
270 subroutine queue_redraw()
271 if (c_associated(breadcrumb_widget_ptr)) then
272 call gtk_widget_queue_draw(breadcrumb_widget_ptr)
273 end if
274 end subroutine queue_redraw
275
276 ! Draw callback - render the breadcrumb
277 subroutine on_draw_breadcrumb(area, cr, width, height, user_data) bind(c)
278 type(c_ptr), value :: area, cr, user_data
279 integer(c_int), value :: width, height
280 type(c_ptr) :: layout, font_desc
281 integer(c_int), target :: text_width, text_height
282 integer(c_int) :: x_offset
283 integer :: i
284 character(len=:), allocatable :: separator
285
286 ! Early return if no segments
287 if (cached_segment_count == 0) return
288
289 ! Create Pango layout for text rendering
290 layout = pango_cairo_create_layout(cr)
291 if (.not. c_associated(layout)) then
292 print *, "ERROR: Failed to create Pango layout"
293 return
294 end if
295
296 separator = " / "
297 x_offset = 5 ! Left padding
298
299 ! Draw each segment
300 do i = 1, cached_segment_count
301 ! Set font and color based on segment state
302
303 ! Root segment (first): green
304 if (i == 1) then
305 call cairo_set_source_rgb(cr, 0.0_c_double, 0.6_c_double, 0.0_c_double)
306 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
307
308 ! Active segment (last): bold red
309 else if (i == cached_segment_count) then
310 call cairo_set_source_rgb(cr, 0.8_c_double, 0.0_c_double, 0.0_c_double)
311 font_desc = pango_font_description_from_string("Sans Bold 11"//c_null_char)
312
313 ! Hovered segment: darker gray
314 else if (i == hovered_segment) then
315 call cairo_set_source_rgb(cr, 0.3_c_double, 0.3_c_double, 0.3_c_double)
316 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
317
318 ! Inactive segment: gray
319 else
320 call cairo_set_source_rgb(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double)
321 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
322 end if
323
324 ! Set font
325 call pango_layout_set_font_description(layout, font_desc)
326 call pango_font_description_free(font_desc)
327
328 ! Set text
329 call pango_layout_set_text(layout, trim(cached_segment_names(i))//c_null_char, &
330 int(len_trim(cached_segment_names(i)), c_int))
331
332 ! Get text size
333 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
334
335 ! Store bounds for hit-testing
336 segment_rects(i)%x = x_offset
337 segment_rects(i)%y = 0
338 segment_rects(i)%width = text_width
339 segment_rects(i)%height = height
340
341 ! Position and draw text
342 call cairo_move_to(cr, real(x_offset, c_double), &
343 real((height - text_height) / 2, c_double)) ! Vertically center
344 call pango_cairo_show_layout(cr, layout)
345
346 ! Update offset
347 x_offset = x_offset + text_width
348
349 ! Draw separator (if not last segment)
350 if (i < cached_segment_count) then
351 ! Skip separator after root "/" since it already contains the slash
352 if (trim(cached_segment_names(i)) /= "/") then
353 ! Set separator color (black to distinguish from colored segment text)
354 call cairo_set_source_rgb(cr, 0.0_c_double, 0.0_c_double, 0.0_c_double)
355 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
356 call pango_layout_set_font_description(layout, font_desc)
357 call pango_font_description_free(font_desc)
358
359 ! Don't trim separator to preserve both leading and trailing spaces
360 call pango_layout_set_text(layout, separator//c_null_char, &
361 int(len(separator), c_int))
362 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
363 call cairo_move_to(cr, real(x_offset, c_double), &
364 real((height - text_height) / 2, c_double))
365 call pango_cairo_show_layout(cr, layout)
366
367 x_offset = x_offset + text_width
368 else
369 ! After root "/", just add a space (no slash separator since root already has it)
370 ! Set separator color (black)
371 call cairo_set_source_rgb(cr, 0.0_c_double, 0.0_c_double, 0.0_c_double)
372 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
373 call pango_layout_set_font_description(layout, font_desc)
374 call pango_font_description_free(font_desc)
375
376 call pango_layout_set_text(layout, " "//c_null_char, 1_c_int)
377 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
378 call cairo_move_to(cr, real(x_offset, c_double), &
379 real((height - text_height) / 2, c_double))
380 call pango_cairo_show_layout(cr, layout)
381
382 x_offset = x_offset + text_width
383 end if
384 end if
385 end do
386
387 ! Draw forward lookahead segments (greyed out)
388 do i = 1, cached_forward_segment_count
389 ! Draw separator before forward segment (black, but with transparency for lookahead)
390 call cairo_set_source_rgba(cr, 0.0_c_double, 0.0_c_double, 0.0_c_double, 0.5_c_double)
391 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
392 call pango_layout_set_font_description(layout, font_desc)
393 call pango_font_description_free(font_desc)
394
395 ! Don't trim separator to preserve both leading and trailing spaces
396 call pango_layout_set_text(layout, separator//c_null_char, &
397 int(len(separator), c_int))
398 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
399 call cairo_move_to(cr, real(x_offset, c_double), &
400 real((height - text_height) / 2, c_double))
401 call pango_cairo_show_layout(cr, layout)
402 x_offset = x_offset + text_width
403
404 ! Set color for forward segment based on hover state
405 if (cached_segment_count + i == hovered_segment) then
406 ! Hovered forward segment: same dark grey as regular segments (full opacity)
407 call cairo_set_source_rgb(cr, 0.3_c_double, 0.3_c_double, 0.3_c_double)
408 else
409 ! Normal forward segment: lighter grey with transparency
410 call cairo_set_source_rgba(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double, 0.5_c_double)
411 end if
412
413 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
414 call pango_layout_set_font_description(layout, font_desc)
415 call pango_font_description_free(font_desc)
416
417 ! Draw forward segment name
418 call pango_layout_set_text(layout, trim(cached_forward_segment_names(i))//c_null_char, &
419 int(len_trim(cached_forward_segment_names(i)), c_int))
420 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
421
422 ! Store bounds for hit-testing (use offset indices: segment count + i)
423 segment_rects(cached_segment_count + i)%x = x_offset
424 segment_rects(cached_segment_count + i)%y = 0
425 segment_rects(cached_segment_count + i)%width = text_width
426 segment_rects(cached_segment_count + i)%height = height
427
428 ! Position and draw text
429 call cairo_move_to(cr, real(x_offset, c_double), &
430 real((height - text_height) / 2, c_double))
431 call pango_cairo_show_layout(cr, layout)
432
433 x_offset = x_offset + text_width
434 end do
435
436 ! Clean up (Pango layout is freed by GTK automatically)
437 end subroutine on_draw_breadcrumb
438
439 ! Motion callback - track hover state
440 subroutine on_breadcrumb_motion(controller, x, y, user_data) bind(c)
441 type(c_ptr), value :: controller, user_data
442 real(c_double), value :: x, y
443 integer :: new_hovered
444
445 ! Find which segment is under the mouse
446 new_hovered = find_segment_at_position(x, y)
447
448 ! Only redraw if hover state CHANGED (optimization)
449 if (new_hovered /= last_hovered_segment) then
450 last_hovered_segment = new_hovered
451 hovered_segment = new_hovered
452 call queue_redraw()
453 end if
454 end subroutine on_breadcrumb_motion
455
456 ! Click callback - handle navigation
457 subroutine on_breadcrumb_click(gesture, n_press, x, y, user_data) bind(c)
458 use treemap_renderer, only: get_current_view_node, scan_directory
459 use progressive_scanner, only: is_scan_active
460 use types, only: file_node
461 type(c_ptr), value :: gesture, user_data
462 integer(c_int), value :: n_press
463 real(c_double), value :: x, y
464 integer :: clicked_segment, total_segments
465 type(file_node), pointer :: current_view
466 character(len=:), allocatable :: target_path
467 character(len=512) :: current_path
468
469 ! Block navigation if scan is active (safety check)
470 if (is_scan_active()) then
471 print *, "Breadcrumb click blocked: Scan in progress"
472 return
473 end if
474
475 ! Find which segment was clicked
476 clicked_segment = find_segment_at_position(x, y)
477 total_segments = cached_segment_count + cached_forward_segment_count
478
479 if (clicked_segment > 0 .and. clicked_segment <= total_segments) then
480 ! Save current path before navigation (for lookahead detection)
481 current_view => get_current_view_node()
482 if (associated(current_view) .and. allocated(current_view%path)) then
483 current_path = trim(current_view%path)
484 previous_breadcrumb_path = current_path
485 print *, "Saved previous breadcrumb path: ", trim(previous_breadcrumb_path)
486 else
487 previous_breadcrumb_path = ""
488 end if
489
490 ! Check if it's a regular segment or forward segment
491 if (clicked_segment <= cached_segment_count) then
492 ! Regular segment clicked
493 ! Don't navigate if clicking the active (last) segment
494 if (clicked_segment == cached_segment_count .and. cached_forward_segment_count == 0) then
495 print *, "Clicked active segment - no navigation"
496 previous_breadcrumb_path = "" ! Clear since no navigation
497 return
498 end if
499
500 print *, "Breadcrumb clicked: segment ", clicked_segment, " (", &
501 trim(cached_segment_names(clicked_segment)), ")"
502
503 ! Get the full path for this segment
504 target_path = trim(cached_segment_paths(clicked_segment))
505 else
506 ! Forward segment clicked
507 print *, "Forward breadcrumb clicked: segment ", clicked_segment - cached_segment_count, " (", &
508 trim(cached_forward_segment_names(clicked_segment - cached_segment_count)), ")"
509
510 ! Get the full path for this forward segment
511 target_path = trim(cached_forward_segment_paths(clicked_segment - cached_segment_count))
512 end if
513
514 print *, "Navigating to: ", target_path
515 print *, " (breadcrumb navigation - checking for lookahead)"
516
517 ! Scan the target directory
518 ! This will update the current view and trigger callbacks
519 call scan_directory(target_path)
520
521 ! Call navigation callback to update UI
522 if (associated(nav_callback)) then
523 call nav_callback()
524 end if
525
526 ! Redraw
527 call queue_redraw()
528 end if
529 end subroutine on_breadcrumb_click
530
531 ! Get the previous breadcrumb path (before navigation)
532 function get_previous_breadcrumb_path() result(path)
533 character(len=512) :: path
534 path = previous_breadcrumb_path
535 end function get_previous_breadcrumb_path
536
537 ! Clear the previous breadcrumb path
538 subroutine clear_previous_breadcrumb_path()
539 previous_breadcrumb_path = ""
540 end subroutine clear_previous_breadcrumb_path
541
542 ! Helper: Find which segment is at given position
543 function find_segment_at_position(x, y) result(segment_index)
544 real(c_double), intent(in) :: x, y
545 integer :: segment_index
546 integer :: i, total_segments
547
548 segment_index = 0
549 total_segments = cached_segment_count + cached_forward_segment_count
550
551 ! Check all segments (regular + forward)
552 do i = 1, total_segments
553 if (x >= segment_rects(i)%x .and. &
554 x <= segment_rects(i)%x + segment_rects(i)%width .and. &
555 y >= segment_rects(i)%y .and. &
556 y <= segment_rects(i)%y + segment_rects(i)%height) then
557 segment_index = i
558 return
559 end if
560 end do
561 end function find_segment_at_position
562
563 end module breadcrumb_widget
564