module fortplot_pdf_axes !! PDF axes, grid, and tick drawing operations !! Handles plot frame, axes, tick marks, and grid lines use iso_fortran_env, only: wp => real64 use fortplot_pdf_core, only: pdf_context_core, PDF_MARGIN, & PDF_TICK_SIZE, PDF_LABEL_SIZE, & PDF_TICK_LABEL_SIZE, PDF_TITLE_SIZE use fortplot_pdf_drawing, only: pdf_stream_writer use fortplot_pdf_text, only: draw_pdf_text, draw_pdf_text_bold, & draw_mixed_font_text, draw_rotated_mixed_font_text implicit none private ! Public procedures public :: draw_pdf_axes_and_labels public :: draw_pdf_3d_axes_frame public :: draw_pdf_frame_with_area public :: draw_pdf_tick_marks_with_area public :: draw_pdf_tick_labels_with_area public :: draw_pdf_title_and_labels public :: setup_axes_data_ranges public :: generate_tick_data contains subroutine setup_axes_data_ranges(ctx, x_min_orig, x_max_orig, y_min_orig, y_max_orig, & x_min_adj, x_max_adj, y_min_adj, y_max_adj, xscale, yscale) !! Set up data ranges for axes with optional log scaling type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: x_min_orig, x_max_orig, y_min_orig, y_max_orig real(wp), intent(out) :: x_min_adj, x_max_adj, y_min_adj, y_max_adj character(len=*), intent(in), optional :: xscale, yscale real(wp) :: x_range, y_range ! Initialize adjusted values x_min_adj = x_min_orig x_max_adj = x_max_orig y_min_adj = y_min_orig y_max_adj = y_max_orig ! Apply log scaling if requested if (present(xscale)) then if (xscale == 'log' .and. x_min_adj > 0.0_wp) then x_min_adj = log10(x_min_adj) x_max_adj = log10(x_max_adj) end if end if if (present(yscale)) then if (yscale == 'log' .and. y_min_adj > 0.0_wp) then y_min_adj = log10(y_min_adj) y_max_adj = log10(y_max_adj) end if end if ! Ensure valid ranges x_range = x_max_adj - x_min_adj y_range = y_max_adj - y_min_adj if (abs(x_range) < 1.0e-10_wp) then x_min_adj = x_min_adj - 0.5_wp x_max_adj = x_max_adj + 0.5_wp end if if (abs(y_range) < 1.0e-10_wp) then y_min_adj = y_min_adj - 0.5_wp y_max_adj = y_max_adj + 0.5_wp end if end subroutine setup_axes_data_ranges subroutine generate_tick_data(ctx, data_x_min, data_x_max, data_y_min, data_y_max, & x_positions, y_positions, x_labels, y_labels, & num_x_ticks, num_y_ticks, xscale, yscale, & plot_area_left, plot_area_bottom, plot_area_width, plot_area_height) !! Generate tick positions and labels for axes !! Refactored to be under 100 lines (QADS compliance) type(pdf_context_core), intent(in) :: ctx real(wp), intent(in) :: data_x_min, data_x_max, data_y_min, data_y_max real(wp), allocatable, intent(out) :: x_positions(:), y_positions(:) character(len=32), allocatable, intent(out) :: x_labels(:), y_labels(:) integer, intent(out) :: num_x_ticks, num_y_ticks character(len=*), intent(in), optional :: xscale, yscale real(wp), intent(in) :: plot_area_left, plot_area_bottom, plot_area_width, plot_area_height ! Calculate number of ticks and allocate arrays call initialize_tick_arrays(plot_area_width, plot_area_height, num_x_ticks, num_y_ticks, & x_positions, y_positions, x_labels, y_labels) ! Generate X axis ticks call generate_x_axis_ticks(data_x_min, data_x_max, num_x_ticks, plot_area_left, & plot_area_width, x_positions, x_labels, xscale) ! Generate Y axis ticks call generate_y_axis_ticks(data_y_min, data_y_max, num_y_ticks, plot_area_bottom, & plot_area_height, y_positions, y_labels, yscale) end subroutine generate_tick_data subroutine initialize_tick_arrays(plot_width, plot_height, num_x_ticks, num_y_ticks, & x_positions, y_positions, x_labels, y_labels) !! Initialize tick count and allocate arrays real(wp), intent(in) :: plot_width, plot_height integer, intent(out) :: num_x_ticks, num_y_ticks real(wp), allocatable, intent(out) :: x_positions(:), y_positions(:) character(len=32), allocatable, intent(out) :: x_labels(:), y_labels(:) integer, parameter :: TARGET_TICKS = 8 ! Determine number of ticks using plot area dimensions num_x_ticks = min(TARGET_TICKS, max(2, int(plot_width / 50.0_wp))) num_y_ticks = min(TARGET_TICKS, max(2, int(plot_height / 40.0_wp))) ! Allocate arrays allocate(x_positions(num_x_ticks)) allocate(y_positions(num_y_ticks)) allocate(x_labels(num_x_ticks)) allocate(y_labels(num_y_ticks)) end subroutine initialize_tick_arrays subroutine generate_x_axis_ticks(data_min, data_max, num_ticks, plot_left, plot_width, & positions, labels, scale_type) !! Generate X axis tick positions and labels real(wp), intent(in) :: data_min, data_max, plot_left, plot_width integer, intent(in) :: num_ticks real(wp), intent(out) :: positions(:) character(len=32), intent(out) :: labels(:) character(len=*), intent(in), optional :: scale_type real(wp) :: data_range, data_step, tick_value integer :: i real(wp), parameter :: EPSILON = 1.0e-10_wp data_range = data_max - data_min ! Generate tick positions and labels if (abs(data_range) < EPSILON) then call handle_zero_range_ticks(data_min, num_ticks, plot_left + plot_width * 0.5_wp, & positions, labels, scale_type) else data_step = data_range / real(num_ticks - 1, wp) do i = 1, num_ticks tick_value = data_min + real(i - 1, wp) * data_step ! Convert to plot coordinates positions(i) = plot_left + (tick_value - data_min) / data_range * plot_width ! Generate label call format_tick_label(tick_value, labels(i), scale_type) end do end if end subroutine generate_x_axis_ticks subroutine generate_y_axis_ticks(data_min, data_max, num_ticks, plot_bottom, plot_height, & positions, labels, scale_type) !! Generate Y axis tick positions and labels real(wp), intent(in) :: data_min, data_max, plot_bottom, plot_height integer, intent(in) :: num_ticks real(wp), intent(out) :: positions(:) character(len=32), intent(out) :: labels(:) character(len=*), intent(in), optional :: scale_type real(wp) :: data_range, data_step, tick_value integer :: i real(wp), parameter :: EPSILON = 1.0e-10_wp data_range = data_max - data_min ! Generate tick positions and labels if (abs(data_range) < EPSILON) then call handle_zero_range_ticks(data_min, num_ticks, plot_bottom + plot_height * 0.5_wp, & positions, labels, scale_type) else data_step = data_range / real(num_ticks - 1, wp) do i = 1, num_ticks tick_value = data_min + real(i - 1, wp) * data_step ! Convert to plot coordinates positions(i) = plot_bottom + (tick_value - data_min) / data_range * plot_height ! Generate label call format_tick_label(tick_value, labels(i), scale_type) end do end if end subroutine generate_y_axis_ticks subroutine handle_zero_range_ticks(data_value, num_ticks, center_position, & positions, labels, scale_type) !! Handle ticks for zero or near-zero range data real(wp), intent(in) :: data_value, center_position integer, intent(in) :: num_ticks real(wp), intent(out) :: positions(:) character(len=32), intent(out) :: labels(:) character(len=*), intent(in), optional :: scale_type integer :: i do i = 1, num_ticks positions(i) = center_position call format_tick_label(data_value, labels(i), scale_type) end do end subroutine handle_zero_range_ticks subroutine format_tick_label(tick_value, label, scale_type) !! Format tick label based on scale type real(wp), intent(in) :: tick_value character(len=32), intent(out) :: label character(len=*), intent(in), optional :: scale_type if (present(scale_type)) then if (scale_type == 'log') then write(label, '(ES10.2)') 10.0_wp ** tick_value else write(label, '(F10.2)') tick_value end if else write(label, '(F10.2)') tick_value end if label = adjustl(label) end subroutine format_tick_label subroutine draw_pdf_axes_and_labels(ctx, xscale, yscale, symlog_threshold, & data_x_min, data_x_max, data_y_min, data_y_max, & title, xlabel, ylabel, plot_area_left, plot_area_bottom, & plot_area_width, plot_area_height, canvas_height) !! Draw complete axes system with labels using actual plot area coordinates type(pdf_context_core), intent(inout) :: ctx character(len=*), intent(in), optional :: xscale, yscale real(wp), intent(in), optional :: symlog_threshold real(wp), intent(in) :: data_x_min, data_x_max, data_y_min, data_y_max character(len=*), intent(in), optional :: title, xlabel, ylabel real(wp), intent(in) :: plot_area_left, plot_area_bottom, plot_area_width, plot_area_height, canvas_height real(wp), allocatable :: x_positions(:), y_positions(:) character(len=32), allocatable :: x_labels(:), y_labels(:) integer :: num_x_ticks, num_y_ticks real(wp) :: x_min_adj, x_max_adj, y_min_adj, y_max_adj ! Setup data ranges call setup_axes_data_ranges(ctx, data_x_min, data_x_max, data_y_min, data_y_max, & x_min_adj, x_max_adj, y_min_adj, y_max_adj, xscale, yscale) ! Generate tick data call generate_tick_data(ctx, x_min_adj, x_max_adj, y_min_adj, y_max_adj, & x_positions, y_positions, x_labels, y_labels, & num_x_ticks, num_y_ticks, xscale, yscale, & plot_area_left, plot_area_bottom, plot_area_width, plot_area_height) ! Grid functionality removed - PDF plots now display without grid lines ! Plot area parameters are now mandatory (non-optional) call draw_pdf_frame_with_area(ctx, plot_area_left, plot_area_bottom, & plot_area_width, plot_area_height, canvas_height) call draw_pdf_tick_marks_with_area(ctx, x_positions, y_positions, num_x_ticks, num_y_ticks, & plot_area_left, plot_area_bottom, canvas_height) call draw_pdf_tick_labels_with_area(ctx, x_positions, y_positions, x_labels, y_labels, & num_x_ticks, num_y_ticks, plot_area_left, plot_area_bottom, canvas_height) ! Draw title and axis labels if (present(title) .or. present(xlabel) .or. present(ylabel)) then call draw_pdf_title_and_labels(ctx, title, xlabel, ylabel, & plot_area_left, plot_area_bottom, & plot_area_width, plot_area_height) end if end subroutine draw_pdf_axes_and_labels subroutine draw_pdf_3d_axes_frame(ctx, x_min, x_max, y_min, y_max, z_min, z_max) !! Draw 3D axes frame - see issue #494 for implementation roadmap type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: x_min, x_max, y_min, y_max, z_min, z_max ! PDF backend does not support 3D axes projection ! 3D plots in PDF backend fall back to 2D projections handled by the ! standard 2D axes drawing functions. This is consistent with many ! PDF plotting libraries that focus on vector graphics in 2D space. ! 3D visualization is better suited to raster backends (PNG) that can ! render projected 3D axes with proper visual depth cues. ! Implementation needed - see issue #494 end subroutine draw_pdf_3d_axes_frame subroutine draw_pdf_frame_with_area(ctx, plot_left, plot_bottom, plot_width, plot_height, canvas_height) !! Draw the plot frame using actual plot area coordinates (FIXED version) type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: plot_left, plot_bottom, plot_width, plot_height, canvas_height character(len=256) :: frame_cmd real(wp) :: x1, y1 ! PDF coordinates: Y=0 at bottom (same as our data coordinates) x1 = plot_left y1 = plot_bottom ! No conversion needed - PDF Y=0 is at bottom ! Draw rectangle frame write(frame_cmd, '(F0.3, 1X, F0.3, " ", F0.3, 1X, F0.3, " re S")') & x1, y1, plot_width, plot_height ctx%stream_data = ctx%stream_data // trim(adjustl(frame_cmd)) // new_line('a') end subroutine draw_pdf_frame_with_area subroutine draw_pdf_tick_marks_with_area(ctx, x_positions, y_positions, num_x, num_y, & plot_left, plot_bottom, canvas_height) !! Draw tick marks using actual plot area coordinates (FIXED version) type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: x_positions(:), y_positions(:) integer, intent(in) :: num_x, num_y real(wp), intent(in) :: plot_left, plot_bottom, canvas_height integer :: i character(len=256) :: tick_cmd real(wp) :: tick_length, bottom_y tick_length = PDF_TICK_SIZE bottom_y = plot_bottom ! PDF Y=0 is at bottom, no conversion needed ! Draw X-axis ticks (bottom of plot area) do i = 1, num_x write(tick_cmd, '(F0.3, 1X, F0.3, " m ", F0.3, 1X, F0.3, " l S")') & x_positions(i), bottom_y, & x_positions(i), bottom_y - tick_length ctx%stream_data = ctx%stream_data // trim(adjustl(tick_cmd)) // new_line('a') end do ! Draw Y-axis ticks (left side of plot area) do i = 1, num_y write(tick_cmd, '(F0.3, 1X, F0.3, " m ", F0.3, 1X, F0.3, " l S")') & plot_left, y_positions(i), & plot_left - tick_length, y_positions(i) ctx%stream_data = ctx%stream_data // trim(adjustl(tick_cmd)) // new_line('a') end do end subroutine draw_pdf_tick_marks_with_area subroutine draw_pdf_tick_labels_with_area(ctx, x_positions, y_positions, x_labels, y_labels, & num_x, num_y, plot_left, plot_bottom, canvas_height) !! Draw tick labels using actual plot area coordinates (FIXED version) type(pdf_context_core), intent(inout) :: ctx real(wp), intent(in) :: x_positions(:), y_positions(:) character(len=*), intent(in) :: x_labels(:), y_labels(:) integer, intent(in) :: num_x, num_y real(wp), intent(in) :: plot_left, plot_bottom, canvas_height integer :: i real(wp) :: label_x, label_y, bottom_y real(wp) :: x_offset, y_offset x_offset = 5.0_wp ! Offset for X labels below ticks y_offset = 10.0_wp ! Offset for Y labels left of ticks bottom_y = plot_bottom ! PDF Y=0 is at bottom, no conversion needed ! Draw X-axis labels do i = 1, num_x label_x = x_positions(i) - 15.0_wp ! Center horizontally label_y = bottom_y - PDF_TICK_SIZE - x_offset - 10.0_wp call draw_pdf_text(ctx, label_x, label_y, trim(x_labels(i))) end do ! Draw Y-axis labels with overlap detection call draw_pdf_y_labels_with_overlap_detection(ctx, y_positions, y_labels, num_y, & plot_left - PDF_TICK_SIZE - y_offset, 0.0_wp) end subroutine draw_pdf_tick_labels_with_area subroutine draw_pdf_title_and_labels(ctx, title, xlabel, ylabel, & plot_area_left, plot_area_bottom, & plot_area_width, plot_area_height) !! Draw plot title and axis labels type(pdf_context_core), intent(inout) :: ctx character(len=*), intent(in), optional :: title, xlabel, ylabel real(wp), intent(in) :: plot_area_left, plot_area_bottom, plot_area_width, plot_area_height real(wp) :: title_x, title_y real(wp) :: xlabel_x, xlabel_y real(wp) :: ylabel_x, ylabel_y ! Draw title (centered at top) if (present(title)) then if (len_trim(title) > 0) then title_x = plot_area_left + plot_area_width * 0.5_wp - & real(len_trim(title), wp) * 3.5_wp title_y = plot_area_bottom + plot_area_height + 20.0_wp call draw_pdf_text_bold(ctx, title_x, title_y, trim(title)) end if end if ! Draw X-axis label (centered at bottom) if (present(xlabel)) then if (len_trim(xlabel) > 0) then xlabel_x = plot_area_left + plot_area_width * 0.5_wp - & real(len_trim(xlabel), wp) * 3.0_wp xlabel_y = plot_area_bottom - 35.0_wp call draw_mixed_font_text(ctx, xlabel_x, xlabel_y, trim(xlabel)) end if end if ! Draw Y-axis label (rotated on left) if (present(ylabel)) then if (len_trim(ylabel) > 0) then ylabel_x = plot_area_left - 45.0_wp ylabel_y = plot_area_bottom + plot_area_height * 0.5_wp - & real(len_trim(ylabel), wp) * 3.0_wp call draw_rotated_mixed_font_text(ctx, ylabel_x, ylabel_y, trim(ylabel)) end if end if end subroutine draw_pdf_title_and_labels 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 real(wp), intent(in) :: y_positions(:) character(len=*), intent(in) :: y_labels(:) integer, intent(in) :: num_y real(wp), intent(in) :: plot_left, canvas_height real(wp) :: last_y_drawn real(wp) :: min_spacing integer :: i real(wp) :: label_x, label_y min_spacing = 15.0_wp ! Minimum vertical spacing between labels last_y_drawn = -1000.0_wp ! Initialize to ensure first label is drawn do i = 1, num_y label_y = y_positions(i) - 3.0_wp ! PDF Y=0 is at bottom, no conversion needed ! Only draw if sufficient spacing from last label if (abs(label_y - last_y_drawn) >= min_spacing) then label_x = plot_left - real(len_trim(y_labels(i)), wp) * 5.0_wp call draw_pdf_text(ctx, label_x, label_y, trim(y_labels(i))) last_y_drawn = label_y end if end do end subroutine draw_pdf_y_labels_with_overlap_detection end module fortplot_pdf_axes