Fortran · 15108 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
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
196 cached_segment_names(cached_segment_count) = trim(working_path(start_pos:))
197 print *, " Segment ", cached_segment_count, ": ", &
198 trim(cached_segment_paths(cached_segment_count)), " -> ", &
199 trim(cached_segment_names(cached_segment_count))
200 exit
201 else
202 ! Intermediate segment
203 cached_segment_count = cached_segment_count + 1
204 ! Build full path up to this segment
205 if (uses_tilde) then
206 cached_segment_paths(cached_segment_count) = trim(home_dir) // &
207 trim(working_path(2:start_pos+slash_pos-2))
208 else
209 cached_segment_paths(cached_segment_count) = trim(working_path(1:start_pos+slash_pos-2))
210 end if
211 ! Extract just the name
212 cached_segment_names(cached_segment_count) = trim(working_path(start_pos:start_pos+slash_pos-2))
213 print *, " Segment ", cached_segment_count, ": ", &
214 trim(cached_segment_paths(cached_segment_count)), " -> ", &
215 trim(cached_segment_names(cached_segment_count))
216 start_pos = start_pos + slash_pos
217 end if
218 end do
219
220 print *, "Breadcrumb cache updated: ", cached_segment_count, " segments"
221
222 ! Trigger redraw
223 call queue_redraw()
224 end subroutine update_breadcrumb_cache
225
226 ! Helper: Queue redraw of widget
227 subroutine queue_redraw()
228 if (c_associated(breadcrumb_widget_ptr)) then
229 call gtk_widget_queue_draw(breadcrumb_widget_ptr)
230 end if
231 end subroutine queue_redraw
232
233 ! Draw callback - render the breadcrumb
234 subroutine on_draw_breadcrumb(area, cr, width, height, user_data) bind(c)
235 type(c_ptr), value :: area, cr, user_data
236 integer(c_int), value :: width, height
237 type(c_ptr) :: layout, font_desc
238 integer(c_int), target :: text_width, text_height
239 integer(c_int) :: x_offset
240 integer :: i
241 character(len=:), allocatable :: separator
242
243 ! Early return if no segments
244 if (cached_segment_count == 0) return
245
246 ! Create Pango layout for text rendering
247 layout = pango_cairo_create_layout(cr)
248 if (.not. c_associated(layout)) then
249 print *, "ERROR: Failed to create Pango layout"
250 return
251 end if
252
253 separator = " / "
254 x_offset = 5 ! Left padding
255
256 ! Draw each segment
257 do i = 1, cached_segment_count
258 ! Set font and color based on segment state
259
260 ! Root segment (first): green
261 if (i == 1) then
262 call cairo_set_source_rgb(cr, 0.0_c_double, 0.6_c_double, 0.0_c_double)
263 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
264
265 ! Active segment (last): bold red
266 else if (i == cached_segment_count) then
267 call cairo_set_source_rgb(cr, 0.8_c_double, 0.0_c_double, 0.0_c_double)
268 font_desc = pango_font_description_from_string("Sans Bold 11"//c_null_char)
269
270 ! Hovered segment: darker gray
271 else if (i == hovered_segment) then
272 call cairo_set_source_rgb(cr, 0.3_c_double, 0.3_c_double, 0.3_c_double)
273 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
274
275 ! Inactive segment: gray
276 else
277 call cairo_set_source_rgb(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double)
278 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
279 end if
280
281 ! Set font
282 call pango_layout_set_font_description(layout, font_desc)
283 call pango_font_description_free(font_desc)
284
285 ! Set text
286 call pango_layout_set_text(layout, trim(cached_segment_names(i))//c_null_char, &
287 int(len_trim(cached_segment_names(i)), c_int))
288
289 ! Get text size
290 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
291
292 ! Store bounds for hit-testing
293 segment_rects(i)%x = x_offset
294 segment_rects(i)%y = 0
295 segment_rects(i)%width = text_width
296 segment_rects(i)%height = height
297
298 ! Position and draw text
299 call cairo_move_to(cr, real(x_offset, c_double), &
300 real((height - text_height) / 2, c_double)) ! Vertically center
301 call pango_cairo_show_layout(cr, layout)
302
303 ! Update offset
304 x_offset = x_offset + text_width
305
306 ! Draw separator (if not last segment)
307 if (i < cached_segment_count) then
308 ! Set separator color (gray)
309 call cairo_set_source_rgb(cr, 0.5_c_double, 0.5_c_double, 0.5_c_double)
310 font_desc = pango_font_description_from_string("Sans 11"//c_null_char)
311 call pango_layout_set_font_description(layout, font_desc)
312 call pango_font_description_free(font_desc)
313
314 call pango_layout_set_text(layout, trim(separator)//c_null_char, &
315 int(len_trim(separator), c_int))
316 call pango_layout_get_pixel_size(layout, c_loc(text_width), c_loc(text_height))
317 call cairo_move_to(cr, real(x_offset, c_double), &
318 real((height - text_height) / 2, c_double))
319 call pango_cairo_show_layout(cr, layout)
320
321 x_offset = x_offset + text_width
322 end if
323 end do
324
325 ! Clean up (Pango layout is freed by GTK automatically)
326 end subroutine on_draw_breadcrumb
327
328 ! Motion callback - track hover state
329 subroutine on_breadcrumb_motion(controller, x, y, user_data) bind(c)
330 type(c_ptr), value :: controller, user_data
331 real(c_double), value :: x, y
332 integer :: new_hovered
333
334 ! Find which segment is under the mouse
335 new_hovered = find_segment_at_position(x, y)
336
337 ! Only redraw if hover state CHANGED (optimization)
338 if (new_hovered /= last_hovered_segment) then
339 last_hovered_segment = new_hovered
340 hovered_segment = new_hovered
341 call queue_redraw()
342 end if
343 end subroutine on_breadcrumb_motion
344
345 ! Click callback - handle navigation
346 subroutine on_breadcrumb_click(gesture, n_press, x, y, user_data) bind(c)
347 use treemap_renderer, only: get_current_view_node, scan_directory
348 use types, only: file_node
349 type(c_ptr), value :: gesture, user_data
350 integer(c_int), value :: n_press
351 real(c_double), value :: x, y
352 integer :: clicked_segment
353 type(file_node), pointer :: current_view
354 character(len=:), allocatable :: target_path
355
356 ! Find which segment was clicked
357 clicked_segment = find_segment_at_position(x, y)
358
359 if (clicked_segment > 0 .and. clicked_segment <= cached_segment_count) then
360 ! Don't navigate if clicking the active (last) segment
361 if (clicked_segment == cached_segment_count) then
362 print *, "Clicked active segment - no navigation"
363 return
364 end if
365
366 print *, "Breadcrumb clicked: segment ", clicked_segment, " (", &
367 trim(cached_segment_names(clicked_segment)), ")"
368
369 ! Get the full path for this segment
370 target_path = trim(cached_segment_paths(clicked_segment))
371 print *, "Navigating to: ", target_path
372
373 ! Scan the target directory
374 ! This will update the current view and trigger callbacks
375 call scan_directory(target_path)
376
377 ! Call navigation callback to update UI
378 if (associated(nav_callback)) then
379 call nav_callback()
380 end if
381
382 ! Redraw
383 call queue_redraw()
384 end if
385 end subroutine on_breadcrumb_click
386
387 ! Helper: Find which segment is at given position
388 function find_segment_at_position(x, y) result(segment_index)
389 real(c_double), intent(in) :: x, y
390 integer :: segment_index
391 integer :: i
392
393 segment_index = 0
394 do i = 1, cached_segment_count
395 if (x >= segment_rects(i)%x .and. &
396 x <= segment_rects(i)%x + segment_rects(i)%width .and. &
397 y >= segment_rects(i)%y .and. &
398 y <= segment_rects(i)%y + segment_rects(i)%height) then
399 segment_index = i
400 return
401 end if
402 end do
403 end function find_segment_at_position
404
405 end module breadcrumb_widget
406