module fortplot_tt_outlines !! TrueType glyph outline extraction. !! Parses the glyf table to extract vertex data (moves, lines, quadratic !! bezier curves) for simple and composite glyphs. Fortran port of !! stbtt__GetGlyphShapeTT from stb_truetype.h lines 1658-1895. use fortplot_tt_binary, only: tt_byte, tt_ushort, tt_short, tt_ulong use fortplot_tt_metrics, only: tt_get_glyf_offset use, intrinsic :: iso_fortran_env, only: int8, dp => real64 implicit none private public :: tt_vertex_t, TT_VMOVE, TT_VLINE, TT_VCURVE public :: tt_set_vertex, tt_get_glyph_shape integer, parameter :: TT_VMOVE = 1 integer, parameter :: TT_VLINE = 2 integer, parameter :: TT_VCURVE = 3 type :: tt_vertex_t integer :: x, y integer :: cx, cy integer :: vtype end type tt_vertex_t contains pure function tt_set_vertex(vtype, x, y, cx, cy) result(v) !! Construct a vertex with the given type and coordinates. integer, intent(in) :: vtype, x, y, cx, cy type(tt_vertex_t) :: v v%vtype = vtype v%x = x v%y = y v%cx = cx v%cy = cy end function tt_set_vertex pure subroutine tt_close_shape(vertices, nv, was_off, start_off, & sx, sy, scx, scy, cx, cy) !! Close a contour by emitting final vertex(es) back to the start point. !! Handles all four combinations of was_off and start_off flags. type(tt_vertex_t), intent(inout) :: vertices(:) integer, intent(inout) :: nv logical, intent(in) :: was_off, start_off integer, intent(in) :: sx, sy, scx, scy, cx, cy if (start_off) then if (was_off) then nv = nv + 1 vertices(nv) = tt_set_vertex(TT_VCURVE, & shifta(cx + scx, 1), shifta(cy + scy, 1), cx, cy) end if nv = nv + 1 vertices(nv) = tt_set_vertex(TT_VCURVE, sx, sy, scx, scy) else if (was_off) then nv = nv + 1 vertices(nv) = tt_set_vertex(TT_VCURVE, sx, sy, cx, cy) else nv = nv + 1 vertices(nv) = tt_set_vertex(TT_VLINE, sx, sy, 0, 0) end if end if end subroutine tt_close_shape subroutine tt_get_glyph_shape(data, loca, glyf, index_to_loc_format, & num_glyphs, glyph_index, vertices, nvertices) !! Extract glyph outline as an array of move/line/curve vertices. !! Handles simple glyphs (numberOfContours > 0) and composite glyphs !! (numberOfContours < 0) with recursive component resolution. integer(int8), intent(in) :: data(:) integer, intent(in) :: loca, glyf, index_to_loc_format integer, intent(in) :: num_glyphs, glyph_index type(tt_vertex_t), allocatable, intent(out) :: vertices(:) integer, intent(out) :: nvertices integer :: g, number_of_contours nvertices = 0 g = tt_get_glyf_offset(data, loca, glyf, index_to_loc_format, & num_glyphs, glyph_index) if (g < 0) return number_of_contours = tt_short(data, g) if (number_of_contours > 0) then call parse_simple_glyph(data, g, number_of_contours, & vertices, nvertices) else if (number_of_contours < 0) then call parse_composite_glyph(data, g, loca, glyf, & index_to_loc_format, num_glyphs, vertices, nvertices) end if end subroutine tt_get_glyph_shape subroutine parse_simple_glyph(data, g, number_of_contours, & vertices, nvertices) !! Parse a simple (non-composite) glyph from the glyf table. !! Decodes flags, delta-encoded coordinates, and converts raw points !! into move/line/curve vertices with proper contour closing. integer(int8), intent(in) :: data(:) integer, intent(in) :: g, number_of_contours type(tt_vertex_t), allocatable, intent(out) :: vertices(:) integer, intent(out) :: nvertices integer :: endpts_off, ins, points_off, n, m, off, ptr endpts_off = g + 10 ins = tt_ushort(data, g + 10 + number_of_contours * 2) points_off = g + 10 + number_of_contours * 2 + 2 + ins n = 1 + tt_ushort(data, endpts_off + number_of_contours * 2 - 2) m = n + 2 * number_of_contours allocate(vertices(m)) off = m - n ptr = points_off call load_flags(data, vertices, off, n, ptr) call load_x_coords(data, vertices, off, n, ptr) call load_y_coords(data, vertices, off, n, ptr) call build_contours(data, vertices, endpts_off, off, n, nvertices) end subroutine parse_simple_glyph subroutine load_flags(data, vertices, off, n, ptr) !! Load per-point flags from the glyf table into vertices(off+1:off+n)%vtype. !! Handles run-length encoding via the repeat flag (bit 3). integer(int8), intent(in) :: data(:) type(tt_vertex_t), intent(inout) :: vertices(:) integer, intent(in) :: off, n integer, intent(inout) :: ptr integer :: i, flags, flagcount flags = 0 flagcount = 0 do i = 1, n if (flagcount == 0) then flags = tt_byte(data, ptr) ptr = ptr + 1 if (iand(flags, 8) /= 0) then flagcount = tt_byte(data, ptr) ptr = ptr + 1 end if else flagcount = flagcount - 1 end if vertices(off + i)%vtype = flags end do end subroutine load_flags subroutine load_x_coords(data, vertices, off, n, ptr) !! Decode delta-encoded x coordinates from the glyf table. !! Flag bit 1 = short (1 byte), bit 4 = sign/same. integer(int8), intent(in) :: data(:) type(tt_vertex_t), intent(inout) :: vertices(:) integer, intent(in) :: off, n integer, intent(inout) :: ptr integer :: i, flags, dx, x x = 0 do i = 1, n flags = vertices(off + i)%vtype if (iand(flags, 2) /= 0) then dx = tt_byte(data, ptr) ptr = ptr + 1 if (iand(flags, 16) /= 0) then x = x + dx else x = x - dx end if else if (iand(flags, 16) == 0) then x = x + tt_short(data, ptr) ptr = ptr + 2 end if end if vertices(off + i)%x = x end do end subroutine load_x_coords subroutine load_y_coords(data, vertices, off, n, ptr) !! Decode delta-encoded y coordinates from the glyf table. !! Flag bit 2 = short (1 byte), bit 5 = sign/same. integer(int8), intent(in) :: data(:) type(tt_vertex_t), intent(inout) :: vertices(:) integer, intent(in) :: off, n integer, intent(inout) :: ptr integer :: i, flags, dy, y y = 0 do i = 1, n flags = vertices(off + i)%vtype if (iand(flags, 4) /= 0) then dy = tt_byte(data, ptr) ptr = ptr + 1 if (iand(flags, 32) /= 0) then y = y + dy else y = y - dy end if else if (iand(flags, 32) == 0) then y = y + tt_short(data, ptr) ptr = ptr + 2 end if end if vertices(off + i)%y = y end do end subroutine load_y_coords subroutine build_contours(data, vertices, endpts_off, off, n, nvertices) !! Convert raw decoded points into move/line/curve vertex sequences. !! Each contour starts with TT_VMOVE; off-curve points generate !! TT_VCURVE with implicit on-curve midpoints between consecutive !! off-curve points. integer(int8), intent(in) :: data(:) type(tt_vertex_t), intent(inout) :: vertices(:) integer, intent(in) :: endpts_off, off, n integer, intent(out) :: nvertices integer :: i, j, flags, x, y integer :: sx, sy, cx, cy, scx, scy integer :: next_move, next_flags logical :: was_off, start_off, skip_next nvertices = 0 sx = 0; sy = 0; cx = 0; cy = 0; scx = 0; scy = 0 was_off = .false.; start_off = .false. skip_next = .false. next_move = 0 j = 0 do i = 1, n if (skip_next) then skip_next = .false. cycle end if flags = vertices(off + i)%vtype x = vertices(off + i)%x y = vertices(off + i)%y if (i - 1 == next_move) then if (i /= 1) then call tt_close_shape(vertices, nvertices, was_off, & start_off, sx, sy, scx, scy, cx, cy) end if start_off = (iand(flags, 1) == 0) if (start_off) then scx = x; scy = y if (i < n) then next_flags = vertices(off + i + 1)%vtype if (iand(next_flags, 1) == 0) then sx = shifta(x + vertices(off + i + 1)%x, 1) sy = shifta(y + vertices(off + i + 1)%y, 1) else sx = vertices(off + i + 1)%x sy = vertices(off + i + 1)%y skip_next = .true. end if else sx = x; sy = y end if else sx = x; sy = y end if nvertices = nvertices + 1 vertices(nvertices) = tt_set_vertex(TT_VMOVE, sx, sy, 0, 0) was_off = .false. next_move = 1 + tt_ushort(data, endpts_off + j * 2) j = j + 1 else if (iand(flags, 1) == 0) then if (was_off) then nvertices = nvertices + 1 vertices(nvertices) = tt_set_vertex(TT_VCURVE, & shifta(cx + x, 1), shifta(cy + y, 1), cx, cy) end if cx = x; cy = y was_off = .true. else if (was_off) then nvertices = nvertices + 1 vertices(nvertices) = tt_set_vertex(TT_VCURVE, & x, y, cx, cy) else nvertices = nvertices + 1 vertices(nvertices) = tt_set_vertex(TT_VLINE, & x, y, 0, 0) end if was_off = .false. end if end if end do call tt_close_shape(vertices, nvertices, was_off, start_off, & sx, sy, scx, scy, cx, cy) end subroutine build_contours subroutine parse_composite_glyph(data, g, loca, glyf, & index_to_loc_format, num_glyphs, vertices, nvertices) !! Parse a composite glyph by recursively resolving component glyphs, !! applying affine transforms, and concatenating vertex arrays. integer(int8), intent(in) :: data(:) integer, intent(in) :: g, loca, glyf, index_to_loc_format, num_glyphs type(tt_vertex_t), allocatable, intent(out) :: vertices(:) integer, intent(out) :: nvertices type(tt_vertex_t), allocatable :: comp_verts(:), tmp(:) integer :: comp_off, comp_flags, gidx, comp_nv integer :: x, y, k real(dp) :: mtx(6), m_scale, n_scale comp_off = g + 10 nvertices = 0 do comp_flags = tt_ushort(data, comp_off); comp_off = comp_off + 2 gidx = tt_ushort(data, comp_off); comp_off = comp_off + 2 call read_component_transform(data, comp_flags, comp_off, mtx) m_scale = sqrt(mtx(1) * mtx(1) + mtx(2) * mtx(2)) n_scale = sqrt(mtx(3) * mtx(3) + mtx(4) * mtx(4)) call tt_get_glyph_shape(data, loca, glyf, index_to_loc_format, & num_glyphs, gidx, comp_verts, comp_nv) if (comp_nv > 0) then do k = 1, comp_nv x = comp_verts(k)%x; y = comp_verts(k)%y comp_verts(k)%x = nint(m_scale * (mtx(1)*x + mtx(3)*y + mtx(5))) comp_verts(k)%y = nint(n_scale * (mtx(2)*x + mtx(4)*y + mtx(6))) x = comp_verts(k)%cx; y = comp_verts(k)%cy comp_verts(k)%cx = nint(m_scale * (mtx(1)*x + mtx(3)*y + mtx(5))) comp_verts(k)%cy = nint(n_scale * (mtx(2)*x + mtx(4)*y + mtx(6))) end do if (allocated(vertices)) then allocate(tmp(nvertices + comp_nv)) tmp(1:nvertices) = vertices(1:nvertices) tmp(nvertices + 1:nvertices + comp_nv) = comp_verts(1:comp_nv) call move_alloc(tmp, vertices) else allocate(vertices(comp_nv)) vertices(1:comp_nv) = comp_verts(1:comp_nv) end if nvertices = nvertices + comp_nv end if if (iand(comp_flags, 32) == 0) exit end do end subroutine parse_composite_glyph subroutine read_component_transform(data, comp_flags, comp_off, mtx) !! Read the affine transform for a composite glyph component. !! Decodes translation (8-bit or 16-bit, xy or point-number) and !! optional scale/rotation matrix entries from the glyf table. integer(int8), intent(in) :: data(:) integer, intent(in) :: comp_flags integer, intent(inout) :: comp_off real(dp), intent(out) :: mtx(6) integer :: byte_val mtx = [1.0_dp, 0.0_dp, 0.0_dp, 1.0_dp, 0.0_dp, 0.0_dp] if (iand(comp_flags, 2) /= 0) then ! ARGS_ARE_XY_VALUES if (iand(comp_flags, 1) /= 0) then mtx(5) = real(tt_short(data, comp_off), dp) comp_off = comp_off + 2 mtx(6) = real(tt_short(data, comp_off), dp) comp_off = comp_off + 2 else byte_val = tt_byte(data, comp_off) if (byte_val >= 128) byte_val = byte_val - 256 mtx(5) = real(byte_val, dp) comp_off = comp_off + 1 byte_val = tt_byte(data, comp_off) if (byte_val >= 128) byte_val = byte_val - 256 mtx(6) = real(byte_val, dp) comp_off = comp_off + 1 end if else if (iand(comp_flags, 1) /= 0) then comp_off = comp_off + 4 else comp_off = comp_off + 2 end if end if if (iand(comp_flags, 8) /= 0) then mtx(1) = real(tt_short(data, comp_off), dp) / 16384.0_dp mtx(4) = mtx(1) mtx(2) = 0.0_dp; mtx(3) = 0.0_dp comp_off = comp_off + 2 else if (iand(comp_flags, 64) /= 0) then mtx(1) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 mtx(2) = 0.0_dp; mtx(3) = 0.0_dp mtx(4) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 else if (iand(comp_flags, 128) /= 0) then mtx(1) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 mtx(2) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 mtx(3) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 mtx(4) = real(tt_short(data, comp_off), dp) / 16384.0_dp comp_off = comp_off + 2 end if end subroutine read_component_transform end module fortplot_tt_outlines