module fortplot_mathtext !! Mathematical text rendering with superscripts and subscripts !! Supports matplotlib-like syntax: x^2, y_i, x_{text}, y^{superscript} use, intrinsic :: iso_fortran_env, only: wp => real64 use fortplot_unicode, only: utf8_to_codepoint, utf8_char_length implicit none private public :: mathtext_element_t, parse_mathtext, mathtext_scripts_share_anchor public :: ELEMENT_NORMAL, ELEMENT_SUPERSCRIPT, ELEMENT_SUBSCRIPT public :: ELEMENT_SQRT, ELEMENT_FRACTION, ELEMENT_SPACE ! Mathematical text element types integer, parameter :: ELEMENT_NORMAL = 0 integer, parameter :: ELEMENT_SUPERSCRIPT = 1 integer, parameter :: ELEMENT_SUBSCRIPT = 2 integer, parameter :: ELEMENT_SQRT = 3 integer, parameter :: ELEMENT_FRACTION = 4 integer, parameter :: ELEMENT_SPACE = 5 ! Font scaling factors (matching matplotlib's approach) real(wp), parameter :: SHRINK_FACTOR = 0.7_wp ! Super/subscript size ratio real(wp), parameter :: SUPERSCRIPT_RAISE = 0.4_wp ! Raise in font-size units real(wp), parameter :: SUBSCRIPT_LOWER = 0.15_wp ! Lower in font-size units type :: mathtext_element_t character(len=:), allocatable :: text character(len=:), allocatable :: denominator integer :: element_type = ELEMENT_NORMAL real(wp) :: font_size_ratio = 1.0_wp real(wp) :: vertical_offset = 0.0_wp ! In pixels, positive = up logical :: italic = .false. !! True for runs that originate inside a '$...$' math segment. !! matplotlib renders math variables in italic; backends apply a !! synthetic oblique shear to alphabetic glyphs of italic runs. end type mathtext_element_t contains recursive function parse_mathtext(input_text, math_mode) result(elements) !! Parse mathematical text into renderable elements character(len=*), intent(in) :: input_text logical, intent(in), optional :: math_mode type(mathtext_element_t), allocatable :: elements(:) integer :: i, n, current_len character(len=len(input_text)) :: current_text type(mathtext_element_t) :: temp_elements(3 * len(input_text)) integer :: element_count logical :: in_math, handled element_count = 0 n = len_trim(input_text) i = 1 current_text = '' current_len = 0 in_math = .false. if (present(math_mode)) in_math = math_mode do while (i <= n) if (in_math) then call handle_math_symbol(input_text, i, n, current_text, current_len, & temp_elements, element_count, handled) if (handled) cycle end if if (input_text(i:i) == '$') then ! Unescaped '$' toggles math mode; runs inside render italic. call flush_current_text(current_text, current_len, temp_elements, & element_count, in_math) in_math = .not. in_math i = i + 1 else if (input_text(i:i) == '^') then call flush_script_base(current_text, current_len, temp_elements, & element_count, in_math) i = i + 1 call parse_superscript_subscript(input_text, i, n, temp_elements, & element_count, ELEMENT_SUPERSCRIPT, & in_math) else if (input_text(i:i) == '_') then call flush_script_base(current_text, current_len, temp_elements, & element_count, in_math) i = i + 1 call parse_superscript_subscript(input_text, i, n, temp_elements, & element_count, ELEMENT_SUBSCRIPT, & in_math) else if (input_text(i:i) == '\') then call handle_mathtext_escape(input_text, i, n, current_text, & current_len, temp_elements, & element_count, in_math) else call append_current_text(current_text, current_len, input_text(i:i)) i = i + 1 end if end do call flush_current_text(current_text, current_len, temp_elements, & element_count, in_math) allocate(elements(element_count)) elements(1:element_count) = temp_elements(1:element_count) do i = 2, element_count if (.not. mathtext_scripts_share_anchor(elements, i)) cycle if (elements(i)%element_type == ELEMENT_SUBSCRIPT) then elements(i)%vertical_offset = -0.34_wp else elements(i - 1)%vertical_offset = -0.34_wp end if end do end function parse_mathtext subroutine handle_math_symbol(input, i, n, current, current_len, & elements, element_count, handled) character(len=*), intent(in) :: input integer, intent(inout) :: i, current_len, element_count integer, intent(in) :: n character(len=*), intent(inout) :: current type(mathtext_element_t), intent(inout) :: elements(:) logical, intent(out) :: handled integer :: codepoint, char_len, previous logical :: spaced, binary character(len=:), allocatable :: symbol handled = .true. codepoint = utf8_to_codepoint(input, i) if (index(' ' // achar(9) // achar(10) // achar(13) // '{}', & input(i:i)) > 0) then i = i + 1 return end if char_len = max(1, utf8_char_length(input(i:i))) if (i + char_len - 1 > n) char_len = 1 select case (codepoint) case (43, 45, 177, 183, 215, 247, 8722) binary = .true. case (60, 61, 62, 8733, 8764, 8776, 8800, 8801, 8804, 8805, & 8592, 8593, 8594, 8595, 8596) binary = .false. case default handled = .false. return end select previous = previous_math_codepoint(input, i) spaced = .true. if (binary) spaced = .not. any(previous == & [0, 36, 40, 91, 123, 60, 61, 62, 8733, 8776, 8800, 8801, 8804, 8805]) call flush_current_text(current, current_len, elements, element_count, .true.) if (spaced) then element_count = element_count + 1 call create_element(elements(element_count), '', ELEMENT_SPACE, & 1.0_wp, 0.0_wp, .false.) end if symbol = input(i:i + char_len - 1) if (codepoint == 45) symbol = '−' element_count = element_count + 1 call create_element(elements(element_count), symbol, ELEMENT_NORMAL, & 1.0_wp, 0.0_wp, .false.) if (spaced) then element_count = element_count + 1 call create_element(elements(element_count), '', ELEMENT_SPACE, & 1.0_wp, 0.0_wp, .false.) end if i = i + char_len end subroutine handle_math_symbol integer function previous_math_codepoint(input, i) result(codepoint) character(len=*), intent(in) :: input integer, intent(in) :: i integer :: previous, byte previous = i - 1 codepoint = 0 do while (previous >= 1) byte = iachar(input(previous:previous)) if (iand(byte, 192) == 128) then previous = previous - 1 cycle end if if (index(' ' // achar(9) // achar(10) // achar(13), & input(previous:previous)) == 0) exit previous = previous - 1 end do if (previous >= 1) codepoint = utf8_to_codepoint(input, previous) end function previous_math_codepoint subroutine flush_script_base(current_text, current_len, elements, & element_count, in_math) character(len=*), intent(inout) :: current_text integer, intent(inout) :: current_len type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count logical, intent(in) :: in_math integer :: start_idx, byte if (current_len <= 0) return start_idx = current_len do while (start_idx > 1) byte = iachar(current_text(start_idx:start_idx)) if (iand(byte, 192) /= 128) exit start_idx = start_idx - 1 end do if (start_idx > 1) then element_count = element_count + 1 call create_element(elements(element_count), & current_text(1:start_idx - 1), & ELEMENT_NORMAL, 1.0_wp, 0.0_wp, in_math) end if element_count = element_count + 1 call create_element(elements(element_count), & current_text(start_idx:current_len), & ELEMENT_NORMAL, 1.0_wp, 0.0_wp, in_math) current_text = '' current_len = 0 end subroutine flush_script_base subroutine handle_mathtext_escape(input_text, i, n, current_text, & current_len, elements, element_count, in_math) character(len=*), intent(in) :: input_text integer, intent(inout) :: i integer, intent(in) :: n character(len=*), intent(inout) :: current_text integer, intent(inout) :: current_len type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count logical, intent(in) :: in_math if (i + 4 <= n) then if (input_text(i + 1:i + 4) == 'frac') then call flush_current_text(current_text, current_len, elements, & element_count, in_math) i = i + 5 call parse_fraction_content(input_text, i, n, elements, & element_count, in_math) return end if if (input_text(i + 1:i + 4) == 'sqrt') then call flush_current_text(current_text, current_len, elements, & element_count, in_math) i = i + 5 call parse_sqrt_content(input_text, i, n, elements, & element_count, in_math) return end if end if block logical :: handled call handle_math_function_escape(input_text, i, n, current_text, & current_len, elements, element_count, & in_math, handled) if (handled) return end block if (i + 5 <= n) then if (input_text(i + 1:i + 5) == 'times') then ! Emit U+00D7 (multiplication sign) so log mantissa labels like ! 4.2 x 10^1 render with matplotlib's cross glyph. call append_current_text(current_text, current_len, '×') i = i + 6 return end if end if if (i + 1 <= n) then select case (input_text(i + 1:i + 1)) case ('_', '^', '$', '\', '{', '}') call append_current_text(current_text, current_len, & input_text(i + 1:i + 1)) i = i + 2 case default call append_current_text(current_text, current_len, input_text(i:i)) i = i + 1 end select else call append_current_text(current_text, current_len, input_text(i:i)) i = i + 1 end if end subroutine handle_mathtext_escape subroutine handle_math_function_escape(input_text, i, n, current_text, & current_len, elements, element_count, & in_math, handled) character(len=*), intent(in) :: input_text integer, intent(inout) :: i integer, intent(in) :: n character(len=*), intent(inout) :: current_text integer, intent(inout) :: current_len type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count logical, intent(in) :: in_math logical, intent(out) :: handled character(len=8) :: command integer :: cmd_len, cmd_end handled = .false. if (.not. in_math) return call match_math_function(input_text, i, n, command, cmd_len) if (cmd_len <= 0) return call flush_current_text(current_text, current_len, elements, element_count, & in_math) element_count = element_count + 1 call create_element(elements(element_count), command(1:cmd_len), & ELEMENT_NORMAL, 1.0_wp, 0.0_wp, .false.) cmd_end = i + cmd_len + 1 if (cmd_end <= n) then if (input_text(cmd_end:cmd_end) == ' ') cmd_end = cmd_end + 1 end if i = cmd_end handled = .true. end subroutine handle_math_function_escape subroutine match_math_function(input_text, i, n, command, cmd_len) character(len=*), intent(in) :: input_text integer, intent(in) :: i, n character(len=*), intent(out) :: command integer, intent(out) :: cmd_len command = '' cmd_len = 0 if (i + 3 <= n) then select case (input_text(i + 1:i + 3)) case ('sin', 'cos', 'tan', 'log', 'exp') if (is_command_boundary(input_text, i + 4, n)) then command = input_text(i + 1:i + 3) cmd_len = 3 end if return end select end if if (i + 2 <= n) then select case (input_text(i + 1:i + 2)) case ('ln') if (is_command_boundary(input_text, i + 3, n)) then command = input_text(i + 1:i + 2) cmd_len = 2 end if return end select end if if (i + 3 <= n) then if (input_text(i + 1:i + 3) == 'lim') then if (is_command_boundary(input_text, i + 4, n)) then command = 'lim' cmd_len = 3 end if end if end if end subroutine match_math_function logical function is_command_boundary(input_text, pos, n) character(len=*), intent(in) :: input_text integer, intent(in) :: pos, n integer :: ch if (pos > n) then is_command_boundary = .true. return end if ch = iachar(input_text(pos:pos)) is_command_boundary = .not. ((ch >= iachar('A') .and. ch <= iachar('Z')) .or. & (ch >= iachar('a') .and. ch <= iachar('z'))) end function is_command_boundary subroutine append_current_text(current_text, current_len, text) character(len=*), intent(inout) :: current_text integer, intent(inout) :: current_len character(len=*), intent(in) :: text current_len = current_len + len(text) current_text(current_len - len(text) + 1:current_len) = text end subroutine append_current_text subroutine flush_current_text(current_text, current_len, elements, & element_count, in_math) character(len=*), intent(inout) :: current_text integer, intent(inout) :: current_len type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count logical, intent(in) :: in_math if (current_len <= 0) return element_count = element_count + 1 call create_element(elements(element_count), current_text(1:current_len), & ELEMENT_NORMAL, 1.0_wp, 0.0_wp, in_math) current_text = '' current_len = 0 end subroutine flush_current_text subroutine parse_superscript_subscript(input_text, start_i, n, elements, & element_count, element_type, in_math) !! Parse superscript or subscript content character(len=*), intent(in) :: input_text integer, intent(inout) :: start_i integer, intent(in) :: n type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count integer, intent(in) :: element_type logical, intent(in) :: in_math character(len=n) :: script_text integer :: i, brace_count, script_len, byte logical :: in_braces real(wp) :: font_size_ratio, vertical_offset script_text = '' script_len = 0 ! Track actual length of script_text content i = start_i if (i > n) return ! Check if we have braces for multi-character script if (input_text(i:i) == '{') then in_braces = .true. brace_count = 1 i = i + 1 ! Skip opening brace do while (i <= n .and. brace_count > 0) if (input_text(i:i) == '{') then brace_count = brace_count + 1 script_len = script_len + 1 script_text(script_len:script_len) = input_text(i:i) else if (input_text(i:i) == '}') then brace_count = brace_count - 1 if (brace_count > 0) then script_len = script_len + 1 script_text(script_len:script_len) = input_text(i:i) end if else script_len = script_len + 1 script_text(script_len:script_len) = input_text(i:i) end if i = i + 1 end do else ! A single script character may occupy several UTF-8 bytes. script_len = 1 byte = iachar(input_text(i:i)) if (byte >= 192) script_len = 2 if (byte >= 224) script_len = 3 if (byte >= 240) script_len = 4 script_len = min(script_len, n - i + 1) script_text(1:script_len) = input_text(i:i + script_len - 1) i = i + script_len end if ! Set font size and vertical offset font_size_ratio = SHRINK_FACTOR if (element_type == ELEMENT_SUPERSCRIPT) then vertical_offset = SUPERSCRIPT_RAISE ! Positive to move up in PDF coordinates else if (element_type == ELEMENT_SUBSCRIPT) then vertical_offset = -SUBSCRIPT_LOWER ! Negative to move down in PDF coordinates else vertical_offset = 0.0_wp end if ! Create element if (script_len > 0) then element_count = element_count + 1 call create_element(elements(element_count), script_text(1:script_len), & element_type, font_size_ratio, vertical_offset, in_math) end if start_i = i end subroutine parse_superscript_subscript subroutine parse_sqrt_content(input_text, start_i, n, elements, & element_count, in_math) !! Parse square root content character(len=*), intent(in) :: input_text integer, intent(inout) :: start_i integer, intent(in) :: n type(mathtext_element_t), intent(inout) :: elements(:) integer, intent(inout) :: element_count logical, intent(in) :: in_math character(len=n) :: rad_text integer :: i, brace_count, rad_len, byte rad_text = '' rad_len = 0 i = start_i do while (i <= n) if (scan(input_text(i:i), & ' ' // achar(9) // achar(10) // achar(13)) == 0) exit i = i + 1 end do start_i = i if (i > n) return if (input_text(i:i) == '{') then brace_count = 1 i = i + 1 do while (i <= n .and. brace_count > 0) if (input_text(i:i) == '{') then brace_count = brace_count + 1 rad_len = rad_len + 1 rad_text(rad_len:rad_len) = input_text(i:i) else if (input_text(i:i) == '}') then brace_count = brace_count - 1 if (brace_count > 0) then rad_len = rad_len + 1 rad_text(rad_len:rad_len) = input_text(i:i) end if else rad_len = rad_len + 1 rad_text(rad_len:rad_len) = input_text(i:i) end if i = i + 1 end do else rad_len = 1 byte = iachar(input_text(i:i)) if (byte >= 192) rad_len = 2 if (byte >= 224) rad_len = 3 if (byte >= 240) rad_len = 4 rad_len = min(rad_len, n - i + 1) rad_text(1:rad_len) = input_text(i:i + rad_len - 1) i = i + rad_len end if if (rad_len > 0) then element_count = element_count + 1 call create_element(elements(element_count), rad_text(1:rad_len), & ELEMENT_SQRT, 1.0_wp, 0.0_wp, in_math) end if start_i = i end subroutine parse_sqrt_content subroutine parse_fraction_content(input_text, start_i, n, elements, & element_count, in_math) character(len=*), intent(in) :: input_text integer, intent(inout) :: start_i, element_count integer, intent(in) :: n type(mathtext_element_t), intent(inout) :: elements(:) logical, intent(in) :: in_math integer :: numerator numerator = element_count + 1 call parse_sqrt_content(input_text, start_i, n, elements, & element_count, in_math) if (element_count < numerator) return elements(numerator)%element_type = ELEMENT_FRACTION elements(numerator)%denominator = '' call parse_sqrt_content(input_text, start_i, n, elements, & element_count, in_math) if (element_count > numerator) then elements(numerator)%denominator = elements(element_count)%text element_count = numerator end if end subroutine parse_fraction_content pure logical function mathtext_scripts_share_anchor(elements, i) result(shared) type(mathtext_element_t), intent(in) :: elements(:) integer, intent(in) :: i shared = .false. if (i <= 1) return if (elements(i)%element_type == ELEMENT_SUPERSCRIPT) then shared = elements(i - 1)%element_type == ELEMENT_SUBSCRIPT else if (elements(i)%element_type == ELEMENT_SUBSCRIPT) then shared = elements(i - 1)%element_type == ELEMENT_SUPERSCRIPT end if end function mathtext_scripts_share_anchor subroutine create_element(element, text, element_type, font_size_ratio, & vertical_offset, italic) !! Create a mathtext element with proper string handling type(mathtext_element_t), intent(out) :: element character(len=*), intent(in) :: text integer, intent(in) :: element_type real(wp), intent(in) :: font_size_ratio, vertical_offset logical, intent(in) :: italic ! Store text properly - preserve all spaces element%text = text element%element_type = element_type element%font_size_ratio = font_size_ratio element%vertical_offset = vertical_offset element%italic = italic end subroutine create_element end module fortplot_mathtext