diff --git a/src/backends/vector/fortplot_pdf.f90 b/src/backends/vector/fortplot_pdf.f90 index ea75d53b..eae06527 100644 --- a/src/backends/vector/fortplot_pdf.f90 +++ b/src/backends/vector/fortplot_pdf.f90 @@ -112,12 +112,19 @@ function create_pdf_canvas(width, height) result(ctx) end function create_pdf_canvas subroutine draw_pdf_line(this, x1, y1, x2, y2) + use, intrinsic :: ieee_arithmetic, only: ieee_is_nan class(pdf_context), intent(inout) :: this real(wp), intent(in) :: x1, y1, x2, y2 real(wp) :: pdf_x1, pdf_y1, pdf_x2, pdf_y2 ! Ensure coordinate context reflects latest figure ranges and plot area call this%update_coord_context() + ! Skip drawing if any coordinate is NaN (disconnected line segments) + if (ieee_is_nan(x1) .or. ieee_is_nan(y1) .or. & + ieee_is_nan(x2) .or. ieee_is_nan(y2)) then + return + end if + call normalize_to_pdf_coords(this%coord_ctx, x1, y1, pdf_x1, pdf_y1) call normalize_to_pdf_coords(this%coord_ctx, x2, y2, pdf_x2, pdf_y2) call this%stream_writer%draw_vector_line(pdf_x1, pdf_y1, pdf_x2, pdf_y2) @@ -339,14 +346,13 @@ subroutine fill_quad_wrapper(this, x_quad, y_quad) px(i), py(i)) end do - ! Slightly expand axis-aligned quads to overlap neighbors and avoid hairline seams + ! Check if quad is axis-aligned for potential optimization minx = min(min(px(1), px(2)), min(px(3), px(4))) maxx = max(max(px(1), px(2)), max(px(3), px(4))) miny = min(min(py(1), py(2)), min(py(3), py(4))) maxy = max(max(py(1), py(2)), max(py(3), py(4))) - eps = 0.05_wp ! expand by small amount in PDF points + eps = 0.05_wp - ! If the quad is axis-aligned (common for pcolormesh), use expanded bbox if ((abs(py(1) - py(2)) < 1.0e-6_wp .and. abs(px(2) - px(3)) < & 1.0e-6_wp .and. & abs(py(3) - py(4)) < 1.0e-6_wp .and. abs(px(4) - px(1)) < & @@ -356,15 +362,16 @@ subroutine fill_quad_wrapper(this, x_quad, y_quad) write (cmd, '(F0.3,1X,F0.3)') maxx + eps, maxy + eps; call this%stream_writer%add_to_stream(trim(cmd)//' l') write (cmd, '(F0.3,1X,F0.3)') minx - eps, maxy + eps; call this%stream_writer%add_to_stream(trim(cmd)//' l') call this%stream_writer%add_to_stream('h') - call this%stream_writer%add_to_stream('f') + ! Use 'B' (fill and stroke) instead of 'f*' to eliminate anti-aliasing gaps + call this%stream_writer%add_to_stream('B') else - ! Fallback: draw original quad write (cmd, '(F0.3,1X,F0.3)') px(1), py(1); call this%stream_writer%add_to_stream(trim(cmd)//' m') write (cmd, '(F0.3,1X,F0.3)') px(2), py(2); call this%stream_writer%add_to_stream(trim(cmd)//' l') write (cmd, '(F0.3,1X,F0.3)') px(3), py(3); call this%stream_writer%add_to_stream(trim(cmd)//' l') write (cmd, '(F0.3,1X,F0.3)') px(4), py(4); call this%stream_writer%add_to_stream(trim(cmd)//' l') call this%stream_writer%add_to_stream('h') - call this%stream_writer%add_to_stream('f') + ! Use 'B' (fill and stroke) instead of 'f*' to eliminate anti-aliasing gaps + call this%stream_writer%add_to_stream('B') end if end subroutine fill_quad_wrapper diff --git a/src/backends/vector/fortplot_pdf_axes.f90 b/src/backends/vector/fortplot_pdf_axes.f90 index 3ce47919..3a2cf47d 100644 --- a/src/backends/vector/fortplot_pdf_axes.f90 +++ b/src/backends/vector/fortplot_pdf_axes.f90 @@ -12,8 +12,11 @@ module fortplot_pdf_axes draw_mixed_font_text, draw_rotated_mixed_font_text, & draw_pdf_mathtext, estimate_pdf_text_width use fortplot_text_helpers, only: prepare_mathtext_if_needed - use fortplot_text_layout, only: has_mathtext + use fortplot_text_layout, only: has_mathtext, preprocess_math_text use fortplot_latex_parser, only: process_latex_in_text + use fortplot_mathtext, only: mathtext_element_t, parse_mathtext + use fortplot_pdf_mathtext_render, only: render_mathtext_element_pdf + use fortplot_unicode, only: utf8_char_length, utf8_to_codepoint use fortplot_axes, only: compute_scale_ticks, format_tick_label, MAX_TICKS use fortplot_tick_calculation, only: determine_decimals_from_ticks, & format_tick_value_consistent @@ -558,18 +561,134 @@ end subroutine render_mixed_text subroutine render_rotated_mixed_text(ctx, x, y, text) !! Helper: process LaTeX and render rotated mixed-font ylabel - !! Uses same logic as PNG: process LaTeX ONLY, no Unicode conversion + !! Now supports mathtext rendering for ylabel with $...$ delimiters type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: x, y character(len=*), intent(in) :: text character(len=512) :: processed integer :: plen + character(len=600) :: math_ready + integer :: mlen - ! Process LaTeX commands ONLY (same as PNG does) + ! Process LaTeX commands call process_latex_in_text(text, processed, plen) - call draw_rotated_mixed_font_text(ctx, x, y, processed(1:plen)) + + ! Check if mathtext is present ($...$ delimiters) + call prepare_mathtext_if_needed(processed(1:plen), math_ready, mlen) + + if (has_mathtext(math_ready(1:mlen))) then + ! For mathtext, we need to use a rotated mathtext renderer + ! Since draw_pdf_mathtext doesn't support rotation, we'll use + ! the text matrix approach with mathtext rendering + call draw_rotated_pdf_mathtext(ctx, x, y, math_ready(1:mlen)) + else + call draw_rotated_mixed_font_text(ctx, x, y, processed(1:plen)) + end if end subroutine render_rotated_mixed_text + subroutine draw_rotated_pdf_mathtext(ctx, x, y, text) + !! Draw rotated mathtext for ylabel + !! Uses rotation matrix with manual text positioning for subscripts/superscripts + use fortplot_pdf_text_segments, only: process_text_segments + type(pdf_context_core), intent(inout) :: ctx + real(wp), intent(in) :: x, y + character(len=*), intent(in) :: text + character(len=1024) :: matrix_cmd, td_cmd + character(len=2048) :: preprocessed_text + integer :: processed_len + character(len=4096) :: math_ready + integer :: mlen + type(mathtext_element_t), allocatable :: elements(:) + integer :: i + real(wp) :: elem_font_size, elem_y_offset + real(wp) :: char_width + integer :: j, codepoint, char_len, text_len + logical :: in_symbol_font + + ! Process text for mathtext + call process_latex_in_text(text, preprocessed_text, processed_len) + call preprocess_math_text(preprocessed_text(1:processed_len), math_ready, mlen) + + ! Parse mathtext elements + elements = parse_mathtext(math_ready(1:mlen)) + + ! Begin text object with rotation matrix (90 degrees counterclockwise) + ctx%stream_data = ctx%stream_data // 'BT' // new_line('a') + + ! Set rotation matrix: [0 1 -1 0 x y] for 90-degree rotation + write(matrix_cmd, '("0 1 -1 0 ", F0.3, 1X, F0.3, " Tm")') x, y + ctx%stream_data = ctx%stream_data // trim(adjustl(matrix_cmd)) // new_line('a') + + ! Render each mathtext element with proper font size and vertical offset + in_symbol_font = .false. + do i = 1, size(elements) + if (len_trim(elements(i)%text) > 0) then + ! Calculate element font size and vertical offset + elem_font_size = PDF_LABEL_SIZE * elements(i)%font_size_ratio + elem_y_offset = elements(i)%vertical_offset * PDF_LABEL_SIZE + + ! Move to position for this element using Td (relative positioning) + ! The rotation matrix transforms these: x->forward along text, y->perpendicular + if (i > 1) then + ! Move horizontally by previous element width, vertically by offset difference + write(td_cmd, '(F0.3, 1X, F0.3, " Td")') char_width, & + elem_y_offset - (elements(i-1)%vertical_offset * PDF_LABEL_SIZE) + ctx%stream_data = ctx%stream_data // trim(adjustl(td_cmd)) // new_line('a') + else if (abs(elem_y_offset) > 0.01_wp) then + ! First element with non-zero offset + write(td_cmd, '("0 ", F0.3, " Td")') elem_y_offset + ctx%stream_data = ctx%stream_data // trim(adjustl(td_cmd)) // new_line('a') + end if + + ! Set font size for this element + write(matrix_cmd, '("/F", I0, 1X, F0.1, " Tf")') & + ctx%fonts%get_helvetica_obj(), elem_font_size + ctx%stream_data = ctx%stream_data // trim(adjustl(matrix_cmd)) // new_line('a') + + ! Render text segments + call process_text_segments(ctx, elements(i)%text, in_symbol_font, elem_font_size) + + ! Calculate width for next element positioning + char_width = 0.0_wp + j = 1 + text_len = len_trim(elements(i)%text) + do while (text_len < len(elements(i)%text)) + if (elements(i)%text(text_len+1:text_len+1) == ' ') then + text_len = text_len + 1 + else + exit + end if + end do + + do while (j <= text_len) + char_len = utf8_char_length(elements(i)%text(j:j)) + if (char_len == 0) then + codepoint = iachar(elements(i)%text(j:j)) + char_len = 1 + else + codepoint = utf8_to_codepoint(elements(i)%text, j) + end if + + if (codepoint >= 48 .and. codepoint <= 57) then + char_width = char_width + elem_font_size * 0.55_wp + else if (codepoint >= 65 .and. codepoint <= 90) then + char_width = char_width + elem_font_size * 0.65_wp + else if (codepoint >= 97 .and. codepoint <= 122) then + char_width = char_width + elem_font_size * 0.5_wp + else if (codepoint == 32) then + char_width = char_width + elem_font_size * 0.3_wp + else + char_width = char_width + elem_font_size * 0.5_wp + end if + + j = j + char_len + end do + end if + end do + + ctx%stream_data = ctx%stream_data // 'ET' // new_line('a') + end subroutine draw_rotated_pdf_mathtext + subroutine draw_pdf_y_labels_with_overlap_detection(ctx, y_positions, y_labels, num_y, plot_left, canvas_height) !! Draw Y-axis labels with overlap detection to prevent clustering type(pdf_context_core), intent(inout) :: ctx diff --git a/src/backends/vector/fortplot_pdf_drawing.f90 b/src/backends/vector/fortplot_pdf_drawing.f90 index 3334a3ab..19328767 100644 --- a/src/backends/vector/fortplot_pdf_drawing.f90 +++ b/src/backends/vector/fortplot_pdf_drawing.f90 @@ -392,13 +392,15 @@ subroutine draw_pdf_arrow(this, x, y, dx, dy, size, style) call this%write_stroke() ! Draw arrow head based on style - if (style == 'filled' .or. style == 'open') then + ! Handle both matplotlib-style ('->', '<-', etc.) and legacy ('filled', 'open') + if (index(style, '>') > 0 .or. index(style, '<') > 0 .or. & + style == 'filled' .or. style == 'open') then call this%write_move(tip_x, tip_y) call this%write_line(left_x, left_y) call this%write_line(right_x, right_y) call this%write_command("h") ! Close path - - if (style == 'filled') then + + if (style == 'filled' .or. style == '->') then call this%write_command("B") ! Fill and stroke else call this%write_stroke() ! Just stroke diff --git a/src/backends/vector/fortplot_pdf_markers.f90 b/src/backends/vector/fortplot_pdf_markers.f90 index 11366033..6c39d3d2 100644 --- a/src/backends/vector/fortplot_pdf_markers.f90 +++ b/src/backends/vector/fortplot_pdf_markers.f90 @@ -76,10 +76,39 @@ subroutine draw_pdf_arrow_at_coords(ctx_handle, stream_writer, x, y, dx, dy, siz type(pdf_stream_writer), intent(inout) :: stream_writer real(wp), intent(in) :: x, y, dx, dy, size character(len=*), intent(in) :: style - real(wp) :: pdf_x, pdf_y - + real(wp) :: pdf_x, pdf_y, pdf_dx, pdf_dy, pdf_size + real(wp) :: x_range, y_range, left, right, bottom, top, scale_factor + real(wp), parameter :: EPSILON = 1.0e-10_wp + call normalize_to_pdf_coords(ctx_handle, x, y, pdf_x, pdf_y) - call draw_pdf_arrow(stream_writer, pdf_x, pdf_y, dx, dy, size, style) + + x_range = ctx_handle%x_max - ctx_handle%x_min + y_range = ctx_handle%y_max - ctx_handle%y_min + + left = real(ctx_handle%plot_area%left, wp) + right = real(ctx_handle%plot_area%left + ctx_handle%plot_area%width, wp) + bottom = real(ctx_handle%plot_area%bottom, wp) + top = real(ctx_handle%plot_area%bottom + ctx_handle%plot_area%height, wp) + + scale_factor = sqrt((right - left)**2 + (top - bottom)**2) / sqrt(2.0_wp) + + if (abs(x_range) > EPSILON) then + pdf_dx = dx * (right - left) / x_range + else + pdf_dx = 0.0_wp + end if + + if (abs(y_range) > EPSILON) then + pdf_dy = dy * (top - bottom) / y_range + else + pdf_dy = 0.0_wp + end if + + if (abs(pdf_dx) < EPSILON .and. abs(pdf_dy) < EPSILON) return + + pdf_size = size * scale_factor / 100.0_wp + + call draw_pdf_arrow(stream_writer, pdf_x, pdf_y, pdf_dx, pdf_dy, pdf_size, style) end subroutine draw_pdf_arrow_at_coords end module fortplot_pdf_markers diff --git a/src/backends/vector/fortplot_pdf_mathtext_render.f90 b/src/backends/vector/fortplot_pdf_mathtext_render.f90 index 875d8618..5edf1323 100644 --- a/src/backends/vector/fortplot_pdf_mathtext_render.f90 +++ b/src/backends/vector/fortplot_pdf_mathtext_render.f90 @@ -50,7 +50,7 @@ subroutine render_mathtext_element_pdf(this, element, x_pos, baseline_y, & real(wp) :: elem_font_size, elem_y real(wp) :: char_width - integer :: i, codepoint, char_len + integer :: i, codepoint, char_len, text_len real(wp) :: sym_w, rad_width, top_y elem_font_size = base_font_size * element%font_size_ratio @@ -100,7 +100,17 @@ subroutine render_mathtext_element_pdf(this, element, x_pos, baseline_y, & char_width = 0.0_wp i = 1 - do while (i <= len_trim(element%text)) + ! Calculate width including trailing spaces by scanning beyond len_trim + text_len = len_trim(element%text) + do while (text_len < len(element%text)) + if (element%text(text_len+1:text_len+1) == ' ') then + text_len = text_len + 1 + else + exit + end if + end do + + do while (i <= text_len) char_len = utf8_char_length(element%text(i:i)) if (char_len == 0) then codepoint = iachar(element%text(i:i)) diff --git a/src/backends/vector/fortplot_pdf_text_segments.f90 b/src/backends/vector/fortplot_pdf_text_segments.f90 index abe114d5..672a05f8 100644 --- a/src/backends/vector/fortplot_pdf_text_segments.f90 +++ b/src/backends/vector/fortplot_pdf_text_segments.f90 @@ -26,7 +26,7 @@ subroutine process_text_segments(this, text, in_symbol_font, font_size) character(len=*), intent(in) :: text logical, intent(inout) :: in_symbol_font real(wp), intent(in) :: font_size - integer :: i, codepoint, char_len + integer :: i, n, codepoint, char_len character(len=8) :: symbol_char logical :: is_valid character(len=2048) :: buffer @@ -38,7 +38,17 @@ subroutine process_text_segments(this, text, in_symbol_font, font_size) buf_is_symbol = in_symbol_font i = 1 - do while (i <= len_trim(text)) + n = len_trim(text) + ! Scan forward from len_trim to include trailing spaces (but not padding) + do while (n < len(text)) + if (ichar(text(n+1:n+1)) == 32) then + n = n + 1 ! Include trailing space + else + exit ! Stop at first non-space padding character + end if + end do + + do while (i <= n) char_len = utf8_char_length(text(i:i)) if (char_len <= 1) then @@ -82,7 +92,7 @@ subroutine process_text_segments(this, text, in_symbol_font, font_size) i = i + 1 else call check_utf8_sequence(text, i, is_valid, char_len) - if (is_valid .and. i + char_len - 1 <= len_trim(text)) then + if (is_valid .and. i + char_len - 1 <= n) then codepoint = utf8_to_codepoint(text, i) else codepoint = 0 diff --git a/src/text/fortplot_annotation_rendering.f90 b/src/text/fortplot_annotation_rendering.f90 index 1ce7d3eb..fdd7b5b0 100644 --- a/src/text/fortplot_annotation_rendering.f90 +++ b/src/text/fortplot_annotation_rendering.f90 @@ -27,29 +27,39 @@ subroutine render_figure_annotations(backend, annotations, annotation_count, & margin_left, margin_right, & margin_bottom, margin_top) !! Render all annotations for the current figure - !! + !! !! This is the main entry point called from figure_render() that processes !! all stored annotations and dispatches them to the appropriate backend. !! Uses existing backend text rendering infrastructure. - + + use fortplot_pdf, only: pdf_context + class(plot_context), intent(inout) :: backend type(text_annotation_t), intent(in) :: annotations(:) integer, intent(in) :: annotation_count real(wp), intent(in) :: x_min, x_max, y_min, y_max integer, intent(in) :: width, height real(wp), intent(in) :: margin_left, margin_right, margin_bottom, margin_top - + integer :: i real(wp) :: render_x, render_y - logical :: valid_annotation + logical :: valid_annotation, is_pdf_backend character(len=256) :: error_message - + ! Early exit if no annotations if (annotation_count == 0) return - + + ! Check if backend is PDF (PDF expects data coordinates, not pixels) + select type (backend) + type is (pdf_context) + is_pdf_backend = .true. + class default + is_pdf_backend = .false. + end select + call log_info("Rendering annotations: processing " // & trim(adjustl(int_to_char(annotation_count))) // " annotations") - + ! Process each annotation do i = 1, annotation_count ! Skip re-validation if already validated at creation time (Issue #870: prevent duplicate warnings) @@ -68,30 +78,54 @@ subroutine render_figure_annotations(backend, annotations, annotation_count, & cycle end if end if - + ! Skip pie chart label/autopct annotations for ASCII and PDF backends ! ASCII backend uses legend-only approach for cleaner output ! PDF backend has coordinate transformation issues with pie annotations if (should_skip_pie_annotation(backend, annotations(i))) then cycle end if - - ! Transform coordinates to rendering coordinates - call transform_annotation_to_rendering_coords(annotations(i), & - x_min, x_max, y_min, y_max, & - width, height, & - margin_left, margin_right, & - margin_bottom, margin_top, & - render_x, render_y) - + + ! PDF backend text() expects DATA coordinates and applies normalize_to_pdf_coords + ! But annotations can be in FIGURE or AXIS coordinates, so we need special handling + if (is_pdf_backend .and. annotations(i)%coord_type /= COORD_DATA) then + ! For PDF with FIGURE/AXIS coordinates: convert to DATA coordinates first + ! Then PDF's text() will apply normalize_to_pdf_coords + select case (annotations(i)%coord_type) + case (COORD_FIGURE) + ! Figure coordinates (0-1): map to data space + render_x = x_min + annotations(i)%x * (x_max - x_min) + render_y = y_min + annotations(i)%y * (y_max - y_min) + case (COORD_AXIS) + ! Axis coordinates (0-1 in plot area): map to data space + render_x = x_min + annotations(i)%x * (x_max - x_min) + render_y = y_min + annotations(i)%y * (y_max - y_min) + case default + render_x = annotations(i)%x + render_y = annotations(i)%y + end select + else if (is_pdf_backend) then + ! PDF with DATA coordinates: pass directly (text() will transform) + render_x = annotations(i)%x + render_y = annotations(i)%y + else + ! For raster/ASCII: transform to pixel coordinates + call transform_annotation_to_rendering_coords(annotations(i), & + x_min, x_max, y_min, y_max, & + width, height, & + margin_left, margin_right, & + margin_bottom, margin_top, & + render_x, render_y) + end if + ! Set annotation color call backend%color(annotations(i)%color(1), & annotations(i)%color(2), & annotations(i)%color(3)) - + ! Render the annotation text using existing backend method call backend%text(render_x, render_y, trim(annotations(i)%text)) - + ! Render arrow if present (simplified implementation) if (annotations(i)%has_arrow) then call render_annotation_arrow(backend, annotations(i), & @@ -101,7 +135,7 @@ subroutine render_figure_annotations(backend, annotations, annotation_count, & margin_bottom, margin_top) end if end do - + call log_info("Annotation rendering completed successfully") end subroutine render_figure_annotations