Fortran · 4775 bytes Raw Blame History
1 module atlas_mod
2 use, intrinsic :: iso_c_binding
3 use glyph_mod
4 use font_mod
5 use gl_bindings
6 implicit none
7 private
8
9 public :: atlas_t
10 public :: atlas_create, atlas_destroy, atlas_get_glyph
11
12 integer, parameter :: ATLAS_SIZE = 512
13 integer, parameter :: ASCII_START = 32
14 integer, parameter :: ASCII_END = 126
15
16 type :: atlas_t
17 integer :: texture_id = 0
18 integer :: width = ATLAS_SIZE
19 integer :: height = ATLAS_SIZE
20 integer :: cursor_x = 0
21 integer :: cursor_y = 0
22 integer :: row_height = 0
23 type(glyph_t) :: glyphs(0:127)
24 logical :: initialized = .false.
25 end type atlas_t
26
27 contains
28
29 ! Create a texture atlas from a font, pre-rendering ASCII characters
30 function atlas_create(font) result(atlas)
31 type(font_t), intent(inout) :: font
32 type(atlas_t) :: atlas
33 integer :: tex(1)
34 integer :: cp
35 type(glyph_t) :: g
36 type(c_ptr) :: bitmap_ptr
37
38 if (.not. font%loaded) then
39 print *, "Error: Cannot create atlas from unloaded font"
40 return
41 end if
42
43 ! Create OpenGL texture
44 call glGenTextures(1, tex)
45 atlas%texture_id = tex(1)
46 call glBindTexture(GL_TEXTURE_2D, atlas%texture_id)
47
48 ! Set texture parameters
49 call glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR)
50 call glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
51 call glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE)
52 call glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
53
54 ! Disable byte-alignment restriction for grayscale textures
55 call glPixelStorei(GL_UNPACK_ALIGNMENT, 1)
56
57 ! Allocate empty texture
58 call glTexImage2D(GL_TEXTURE_2D, 0, GL_RED, &
59 atlas%width, atlas%height, 0, &
60 GL_RED, GL_UNSIGNED_BYTE, c_null_ptr)
61
62 ! Initialize glyph array
63 do cp = 0, 127
64 call glyph_init(atlas%glyphs(cp))
65 end do
66
67 ! Pre-render ASCII printable characters (32-126)
68 atlas%cursor_x = 1
69 atlas%cursor_y = 1
70 atlas%row_height = 0
71
72 do cp = ASCII_START, ASCII_END
73 g = font_render_glyph(font, cp, bitmap_ptr)
74 if (g%valid) then
75 call atlas_add_glyph(atlas, g, bitmap_ptr)
76 atlas%glyphs(cp) = g
77 end if
78 end do
79
80 ! Unbind texture
81 call glBindTexture(GL_TEXTURE_2D, 0)
82
83 atlas%initialized = .true.
84
85 end function atlas_create
86
87 ! Add a rendered glyph to the atlas
88 subroutine atlas_add_glyph(atlas, g, bitmap_ptr)
89 type(atlas_t), intent(inout) :: atlas
90 type(glyph_t), intent(inout) :: g
91 type(c_ptr), intent(in) :: bitmap_ptr
92 integer :: padding
93
94 padding = 1 ! 1 pixel padding between glyphs
95
96 ! Check if glyph fits in current row
97 if (atlas%cursor_x + g%width + padding > atlas%width) then
98 ! Move to next row
99 atlas%cursor_x = 1
100 atlas%cursor_y = atlas%cursor_y + atlas%row_height + padding
101 atlas%row_height = 0
102 end if
103
104 ! Check if glyph fits vertically
105 if (atlas%cursor_y + g%height + padding > atlas%height) then
106 print *, "Warning: Atlas texture is full, cannot add glyph"
107 return
108 end if
109
110 ! Store position in atlas
111 g%tex_x = atlas%cursor_x
112 g%tex_y = atlas%cursor_y
113
114 ! Copy bitmap to texture
115 if (g%width > 0 .and. g%height > 0 .and. c_associated(bitmap_ptr)) then
116 call glTexSubImage2D(GL_TEXTURE_2D, 0, &
117 g%tex_x, g%tex_y, g%width, g%height, &
118 GL_RED, GL_UNSIGNED_BYTE, bitmap_ptr)
119 end if
120
121 ! Calculate UV coordinates (normalized 0-1)
122 g%u0 = real(g%tex_x, c_float) / real(atlas%width, c_float)
123 g%v0 = real(g%tex_y, c_float) / real(atlas%height, c_float)
124 g%u1 = real(g%tex_x + g%width, c_float) / real(atlas%width, c_float)
125 g%v1 = real(g%tex_y + g%height, c_float) / real(atlas%height, c_float)
126
127 ! Update cursor position
128 atlas%cursor_x = atlas%cursor_x + g%width + padding
129 atlas%row_height = max(atlas%row_height, g%height)
130
131 end subroutine atlas_add_glyph
132
133 ! Get glyph information for a codepoint
134 function atlas_get_glyph(atlas, codepoint) result(g)
135 type(atlas_t), intent(in) :: atlas
136 integer, intent(in) :: codepoint
137 type(glyph_t) :: g
138
139 if (codepoint >= 0 .and. codepoint <= 127) then
140 g = atlas%glyphs(codepoint)
141 else
142 ! Return invalid glyph for unsupported characters
143 call glyph_init(g)
144 end if
145 end function atlas_get_glyph
146
147 ! Destroy atlas and free texture
148 subroutine atlas_destroy(atlas)
149 type(atlas_t), intent(inout) :: atlas
150 integer :: tex(1)
151
152 if (atlas%texture_id > 0) then
153 tex(1) = atlas%texture_id
154 call glDeleteTextures(1, tex)
155 atlas%texture_id = 0
156 end if
157
158 atlas%initialized = .false.
159 end subroutine atlas_destroy
160
161 end module atlas_mod
162