| 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 | |
| 20 | ! Callback interface for navigation events |
| 21 | abstract interface |
| 22 | subroutine navigation_callback() |
| 23 | end subroutine navigation_callback |
| 24 | end interface |
| 25 | |
| 26 | ! Segment bounds for hit-testing |
| 27 | type :: segment_bounds |
| 28 | integer(c_int) :: x, y, width, height |
| 29 | end type segment_bounds |
| 30 | |
| 31 | ! Maximum number of path segments |
| 32 | integer, parameter :: MAX_SEGMENTS = 50 |
| 33 | |
| 34 | ! Path segment cache (updated on main thread only via update_breadcrumb_cache) |
| 35 | character(len=512), dimension(MAX_SEGMENTS), save :: cached_segment_paths = "" |
| 36 | character(len=256), dimension(MAX_SEGMENTS), save :: cached_segment_names = "" |
| 37 | integer, save :: cached_segment_count = 0 |
| 38 | |
| 39 | ! Hover state |
| 40 | integer, save :: hovered_segment = 0 ! 0 = none, 1+ = segment index |
| 41 | integer, save :: last_hovered_segment = -1 |
| 42 | |
| 43 | ! Click bounds for each segment (populated during draw) |
| 44 | type(segment_bounds), dimension(MAX_SEGMENTS), save :: segment_rects |
| 45 | |
| 46 | ! Widget pointer |
| 47 | type(c_ptr), save :: breadcrumb_widget_ptr = c_null_ptr |
| 48 | |
| 49 | ! Navigation callback (called when user clicks a segment) |
| 50 | procedure(navigation_callback), pointer, save :: nav_callback => null() |
| 51 | |
| 52 | contains |
| 53 | |
| 54 | ! Create and initialize the breadcrumb drawing area widget |
| 55 | function create_breadcrumb_widget() result(widget) |
| 56 | type(c_ptr) :: widget, motion_controller, click_controller |
| 57 | |
| 58 | ! Create drawing area |
| 59 | widget = gtk_drawing_area_new() |
| 60 | breadcrumb_widget_ptr = widget |
| 61 | |
| 62 | if (.not. c_associated(widget)) then |
| 63 | print *, "ERROR: Failed to create breadcrumb drawing area" |
| 64 | return |
| 65 | end if |
| 66 | |
| 67 | ! Set minimum height (width will expand to fill) |
| 68 | call gtk_widget_set_size_request(widget, -1_c_int, 30_c_int) |
| 69 | |
| 70 | ! Set draw function (called when widget needs to redraw) |
| 71 | call gtk_drawing_area_set_draw_func(widget, & |
| 72 | c_funloc(on_draw_breadcrumb), & |
| 73 | c_null_ptr, & |
| 74 | c_null_funptr) |
| 75 | |
| 76 | ! Add motion event controller for hover |
| 77 | motion_controller = gtk_event_controller_motion_new() |
| 78 | call g_signal_connect(motion_controller, "motion"//c_null_char, & |
| 79 | c_funloc(on_breadcrumb_motion), c_null_ptr) |
| 80 | call gtk_widget_add_controller(widget, motion_controller) |
| 81 | |
| 82 | ! Add click gesture controller for navigation |
| 83 | click_controller = gtk_gesture_click_new() |
| 84 | call g_signal_connect(click_controller, "pressed"//c_null_char, & |
| 85 | c_funloc(on_breadcrumb_click), c_null_ptr) |
| 86 | call gtk_widget_add_controller(widget, click_controller) |
| 87 | |
| 88 | print *, "Breadcrumb widget created successfully" |
| 89 | end function create_breadcrumb_widget |
| 90 | |
| 91 | ! Get widget pointer (for external access) |
| 92 | function get_breadcrumb_widget_ptr() result(ptr) |
| 93 | type(c_ptr) :: ptr |
| 94 | ptr = breadcrumb_widget_ptr |
| 95 | end function get_breadcrumb_widget_ptr |
| 96 | |
| 97 | ! Register a callback to be called when navigation occurs |
| 98 | subroutine set_navigation_callback(callback) |
| 99 | procedure(navigation_callback) :: callback |
| 100 | nav_callback => callback |
| 101 | print *, "Breadcrumb navigation callback registered" |
| 102 | end subroutine set_navigation_callback |
| 103 | |
| 104 | ! Update cached path segments (called from main thread on navigation events) |
| 105 | ! This is the ONLY function that modifies cached_segment_* |
| 106 | subroutine update_breadcrumb_cache(full_path) |
| 107 | character(len=*), intent(in) :: full_path |
| 108 | character(len=512) :: home_dir, working_path |
| 109 | integer :: i, slash_pos, start_pos, home_len |
| 110 | logical :: uses_tilde |
| 111 | |
| 112 | print *, "Updating breadcrumb cache for: ", trim(full_path) |
| 113 | |
| 114 | ! Reset cache |
| 115 | cached_segment_count = 0 |
| 116 | cached_segment_paths = "" |
| 117 | cached_segment_names = "" |
| 118 | |
| 119 | if (len_trim(full_path) == 0) return |
| 120 | |
| 121 | ! Get home directory for ~ abbreviation |
| 122 | call get_environment_variable("HOME", home_dir) |
| 123 | home_len = len_trim(home_dir) |
| 124 | |
| 125 | ! Check if path starts with home directory |
| 126 | working_path = trim(full_path) |
| 127 | uses_tilde = .false. |
| 128 | if (home_len > 0) then |
| 129 | if (len_trim(full_path) >= home_len) then |
| 130 | if (full_path(1:home_len) == home_dir(1:home_len)) then |
| 131 | ! Replace home with ~ |
| 132 | if (len_trim(full_path) == home_len) then |
| 133 | working_path = "~" |
| 134 | else if (full_path(home_len+1:home_len+1) == "/") then |
| 135 | working_path = "~" // trim(full_path(home_len+1:)) |
| 136 | end if |
| 137 | uses_tilde = .true. |
| 138 | end if |
| 139 | end if |
| 140 | end if |
| 141 | |
| 142 | ! Handle root path |
| 143 | if (trim(working_path) == "/") then |
| 144 | cached_segment_count = 1 |
| 145 | cached_segment_paths(1) = "/" |
| 146 | cached_segment_names(1) = "/" |
| 147 | print *, " Segment 1: / -> /" |
| 148 | call queue_redraw() |
| 149 | return |
| 150 | end if |
| 151 | |
| 152 | ! Handle home-only path |
| 153 | if (trim(working_path) == "~") then |
| 154 | cached_segment_count = 1 |
| 155 | cached_segment_paths(1) = trim(full_path) ! Store actual path for navigation |
| 156 | cached_segment_names(1) = "~" |
| 157 | print *, " Segment 1: ", trim(full_path), " -> ~" |
| 158 | call queue_redraw() |
| 159 | return |
| 160 | end if |
| 161 | |
| 162 | ! Parse path into segments |
| 163 | start_pos = 1 |
| 164 | |
| 165 | ! Skip leading / or ~ |
| 166 | if (working_path(1:1) == "/" .or. working_path(1:1) == "~") then |
| 167 | start_pos = 2 |
| 168 | ! Add root segment |
| 169 | cached_segment_count = 1 |
| 170 | if (uses_tilde) then |
| 171 | cached_segment_paths(1) = trim(home_dir) |
| 172 | cached_segment_names(1) = "~" |
| 173 | else |
| 174 | cached_segment_paths(1) = "/" |
| 175 | cached_segment_names(1) = "/" |
| 176 | end if |
| 177 | print *, " Segment 1: ", trim(cached_segment_paths(1)), " -> ", trim(cached_segment_names(1)) |
| 178 | end if |
| 179 | |
| 180 | ! Parse remaining segments |
| 181 | do while (start_pos <= len_trim(working_path) .and. cached_segment_count < MAX_SEGMENTS) |
| 182 | ! Find next slash |
| 183 | slash_pos = index(working_path(start_pos:), "/") |
| 184 | |
| 185 | if (slash_pos == 0) then |
| 186 | ! Last segment (no trailing slash) |
| 187 | cached_segment_count = cached_segment_count + 1 |
| 188 | ! Build full path for this segment |
| 189 | if (uses_tilde) then |
| 190 | cached_segment_paths(cached_segment_count) = trim(home_dir) // & |
| 191 | trim(working_path(2:len_trim(working_path))) |
| 192 | else |
| 193 | cached_segment_paths(cached_segment_count) = trim(working_path) |
| 194 | end if |
| 195 | ! Extract just the name (remove any leading/trailing slashes) |
| 196 | cached_segment_names(cached_segment_count) = trim(adjustl(working_path(start_pos:))) |
| 197 | ! Remove leading slash if present |
| 198 | if (len_trim(cached_segment_names(cached_segment_count)) > 0) then |
| 199 | if (cached_segment_names(cached_segment_count)(1:1) == "/") then |
| 200 | cached_segment_names(cached_segment_count) = & |
| 201 | trim(cached_segment_names(cached_segment_count)(2:)) |
| 202 | end if |
| 203 | end if |
| 204 | print *, " Segment ", cached_segment_count, ": ", & |
| 205 | trim(cached_segment_paths(cached_segment_count)), " -> ", & |
| 206 | trim(cached_segment_names(cached_segment_count)) |
| 207 | exit |
| 208 | else |
| 209 | ! Intermediate segment |
| 210 | cached_segment_count = cached_segment_count + 1 |
| 211 | ! Build full path up to this segment |
| 212 | if (uses_tilde) then |
| 213 | cached_segment_paths(cached_segment_count) = trim(home_dir) // & |
| 214 | trim(working_path(2:start_pos+slash_pos-2)) |
| 215 | else |
| 216 | cached_segment_paths(cached_segment_count) = trim(working_path(1:start_pos+slash_pos-2)) |
| 217 | end if |
| 218 | ! Extract just the name (remove any leading/trailing slashes) |
| 219 | cached_segment_names(cached_segment_count) = trim(adjustl(working_path(start_pos:start_pos+slash_pos-2))) |
| 220 | ! Remove leading slash if present |
| 221 | if (len_trim(cached_segment_names(cached_segment_count)) > 0) then |
| 222 | if (cached_segment_names(cached_segment_count)(1:1) == "/") then |
| 223 | cached_segment_names(cached_segment_count) = & |
| 224 | trim(cached_segment_names(cached_segment_count)(2:)) |
| 225 | end if |
| 226 | end if |
| 227 | print *, " Segment ", cached_segment_count, ": ", & |
| 228 | trim(cached_segment_paths(cached_segment_count)), " -> ", & |
| 229 | trim(cached_segment_names(cached_segment_count)) |
| 230 | start_pos = start_pos + slash_pos |
| 231 | end if |
| 232 | end do |
| 233 | |
| 234 | print *, "Breadcrumb cache updated: ", cached_segment_count, " segments" |
| 235 | |
| 236 | ! Trigger redraw |
| 237 | call queue_redraw() |
| 238 | end subroutine update_breadcrumb_cache |
| 239 | |
| 240 | ! Helper: Queue redraw of widget |
| 241 | subroutine queue_redraw() |
| 242 | if (c_associated(breadcrumb_widget_ptr)) then |
| 243 | call gtk_widget_queue_draw(breadcrumb_widget_ptr) |
| 244 | end if |
| 245 | end subroutine queue_redraw |
| 246 | |
| 247 | ! Draw callback - render the breadcrumb |
| 248 | subroutine on_draw_breadcrumb(area, cr, width, height, user_data) bind(c) |
| 249 | type(c_ptr), value :: area, cr, user_data |
| 250 | integer(c_int), value :: width, height |
| 251 | type(c_ptr) :: layout, font_desc |
| 252 | integer(c_int), target :: text_width, text_height |
| 253 | integer(c_int) :: x_offset |
| 254 | integer :: i |
| 255 | character(len=:), allocatable :: separator |
| 256 | |
| 257 | ! Early return if no segments |
| 258 | if (cached_segment_count == 0) return |
| 259 | |
| 260 | ! Create Pango layout for text rendering |
| 261 | layout = pango_cairo_create_layout(cr) |
| 262 | if (.not. c_associated(layout)) then |
| 263 | print *, "ERROR: Failed to create Pango layout" |
| 264 | return |
| 265 | end if |
| 266 | |
| 267 | separator = " / " |
| 268 | x_offset = 5 ! Left padding |
| 269 | |
| 270 | ! Draw each segment |
| 271 | do i = 1, cached_segment_count |
| 272 | ! Set font and color based on segment state |
| 273 | |
| 274 | ! Root segment (first): green |
| 275 | if (i == 1) then |
| 276 | call cairo_set_source_rgb(cr, 0.0_c_double, 0.6_c_double, 0.0_c_double) |
| 277 | font_desc = pango_font_description_from_string("Sans 11"//c_null_char) |
| 278 | |
| 279 | ! Active segment (last): bold red |
| 280 | else if (i == cached_segment_count) then |
| 281 | call cairo_set_source_rgb(cr, 0.8_c_double, 0.0_c_double, 0.0_c_double) |
| 282 | font_desc = pango_font_description_from_string("Sans Bold 11"//c_null_char) |
| 283 | |
| 284 | ! Hovered segment: darker gray |
| 285 | else if (i == hovered_segment) then |
| 286 | call cairo_set_source_rgb(cr, 0.3_c_double, 0.3_c_double, 0.3_c_double) |
| 287 | font_desc = pango_font_description_from_string("Sans 11"//c_null_char) |
| 288 | |
| 289 | ! Inactive segment: gray |
| 290 | else |
| 291 | call cairo_set_source_rgb(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double) |
| 292 | font_desc = pango_font_description_from_string("Sans 11"//c_null_char) |
| 293 | end if |
| 294 | |
| 295 | ! Set font |
| 296 | call pango_layout_set_font_description(layout, font_desc) |
| 297 | call pango_font_description_free(font_desc) |
| 298 | |
| 299 | ! Set text |
| 300 | call pango_layout_set_text(layout, trim(cached_segment_names(i))//c_null_char, & |
| 301 | int(len_trim(cached_segment_names(i)), c_int)) |
| 302 | |
| 303 | ! Get text size |
| 304 | call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height)) |
| 305 | |
| 306 | ! Store bounds for hit-testing |
| 307 | segment_rects(i)%x = x_offset |
| 308 | segment_rects(i)%y = 0 |
| 309 | segment_rects(i)%width = text_width |
| 310 | segment_rects(i)%height = height |
| 311 | |
| 312 | ! Position and draw text |
| 313 | call cairo_move_to(cr, real(x_offset, c_double), & |
| 314 | real((height - text_height) / 2, c_double)) ! Vertically center |
| 315 | call pango_cairo_show_layout(cr, layout) |
| 316 | |
| 317 | ! Update offset |
| 318 | x_offset = x_offset + text_width |
| 319 | |
| 320 | ! Draw separator (if not last segment) |
| 321 | if (i < cached_segment_count) then |
| 322 | ! Set separator color (gray) |
| 323 | call cairo_set_source_rgb(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double) |
| 324 | font_desc = pango_font_description_from_string("Sans 11"//c_null_char) |
| 325 | call pango_layout_set_font_description(layout, font_desc) |
| 326 | call pango_font_description_free(font_desc) |
| 327 | |
| 328 | call pango_layout_set_text(layout, trim(separator)//c_null_char, & |
| 329 | int(len_trim(separator), c_int)) |
| 330 | call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height)) |
| 331 | call cairo_move_to(cr, real(x_offset, c_double), & |
| 332 | real((height - text_height) / 2, c_double)) |
| 333 | call pango_cairo_show_layout(cr, layout) |
| 334 | |
| 335 | x_offset = x_offset + text_width |
| 336 | end if |
| 337 | end do |
| 338 | |
| 339 | ! Clean up (Pango layout is freed by GTK automatically) |
| 340 | end subroutine on_draw_breadcrumb |
| 341 | |
| 342 | ! Motion callback - track hover state |
| 343 | subroutine on_breadcrumb_motion(controller, x, y, user_data) bind(c) |
| 344 | type(c_ptr), value :: controller, user_data |
| 345 | real(c_double), value :: x, y |
| 346 | integer :: new_hovered |
| 347 | |
| 348 | ! Find which segment is under the mouse |
| 349 | new_hovered = find_segment_at_position(x, y) |
| 350 | |
| 351 | ! Only redraw if hover state CHANGED (optimization) |
| 352 | if (new_hovered /= last_hovered_segment) then |
| 353 | last_hovered_segment = new_hovered |
| 354 | hovered_segment = new_hovered |
| 355 | call queue_redraw() |
| 356 | end if |
| 357 | end subroutine on_breadcrumb_motion |
| 358 | |
| 359 | ! Click callback - handle navigation |
| 360 | subroutine on_breadcrumb_click(gesture, n_press, x, y, user_data) bind(c) |
| 361 | use treemap_renderer, only: get_current_view_node, scan_directory |
| 362 | use types, only: file_node |
| 363 | type(c_ptr), value :: gesture, user_data |
| 364 | integer(c_int), value :: n_press |
| 365 | real(c_double), value :: x, y |
| 366 | integer :: clicked_segment |
| 367 | type(file_node), pointer :: current_view |
| 368 | character(len=:), allocatable :: target_path |
| 369 | |
| 370 | ! Find which segment was clicked |
| 371 | clicked_segment = find_segment_at_position(x, y) |
| 372 | |
| 373 | if (clicked_segment > 0 .and. clicked_segment <= cached_segment_count) then |
| 374 | ! Don't navigate if clicking the active (last) segment |
| 375 | if (clicked_segment == cached_segment_count) then |
| 376 | print *, "Clicked active segment - no navigation" |
| 377 | return |
| 378 | end if |
| 379 | |
| 380 | print *, "Breadcrumb clicked: segment ", clicked_segment, " (", & |
| 381 | trim(cached_segment_names(clicked_segment)), ")" |
| 382 | |
| 383 | ! Get the full path for this segment |
| 384 | target_path = trim(cached_segment_paths(clicked_segment)) |
| 385 | print *, "Navigating to: ", target_path |
| 386 | |
| 387 | ! Scan the target directory |
| 388 | ! This will update the current view and trigger callbacks |
| 389 | call scan_directory(target_path) |
| 390 | |
| 391 | ! Call navigation callback to update UI |
| 392 | if (associated(nav_callback)) then |
| 393 | call nav_callback() |
| 394 | end if |
| 395 | |
| 396 | ! Redraw |
| 397 | call queue_redraw() |
| 398 | end if |
| 399 | end subroutine on_breadcrumb_click |
| 400 | |
| 401 | ! Helper: Find which segment is at given position |
| 402 | function find_segment_at_position(x, y) result(segment_index) |
| 403 | real(c_double), intent(in) :: x, y |
| 404 | integer :: segment_index |
| 405 | integer :: i |
| 406 | |
| 407 | segment_index = 0 |
| 408 | do i = 1, cached_segment_count |
| 409 | if (x >= segment_rects(i)%x .and. & |
| 410 | x <= segment_rects(i)%x + segment_rects(i)%width .and. & |
| 411 | y >= segment_rects(i)%y .and. & |
| 412 | y <= segment_rects(i)%y + segment_rects(i)%height) then |
| 413 | segment_index = i |
| 414 | return |
| 415 | end if |
| 416 | end do |
| 417 | end function find_segment_at_position |
| 418 | |
| 419 | end module breadcrumb_widget |
| 420 |