Mercurial > repos > tabletprog
comparison modules/freetype.tp @ 321:3edd0169311a
Add basic binding to Freetype2
author | Michael Pavone <pavone@retrodev.com> |
---|---|
date | Sun, 22 Mar 2015 19:10:32 -0700 |
parents | |
children | 50760ba52b11 |
comparison
equal
deleted
inserted
replaced
320:1debeb21dd47 | 321:3edd0169311a |
---|---|
1 { | |
2 _helper <- #{ | |
3 includeSystemHeader: "ft2build.h" | |
4 includeSystemHeader: FT_FREETYPE_H | |
5 llMessage: newFace withVars: { | |
6 libOpaque <- cpointer ptr | |
7 opath <- object ptr | |
8 oindex <- object ptr | |
9 path <- string ptr | |
10 index <- obj_int32 ptr | |
11 faceOpaque <- cpointer ptr | |
12 rescode <- int32_t | |
13 } andCode: :libOpaque opath oindex { | |
14 path <- (mcall: string 1 opath) castTo: (string ptr) | |
15 index <- (mcall: int32 1 oindex) castTo: (obj_int32 ptr) | |
16 faceOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 | |
17 rescode <- FT_New_Face: (libOpaque val) (path data) (index num) ((addr_of: (faceOpaque val)) castTo: (FT_Face ptr)) | |
18 if: rescode = 0 { | |
19 mcall: value 2 option faceOpaque | |
20 } else: { | |
21 mcall: none 1 option | |
22 } | |
23 } | |
24 | |
25 llMessage: getFirstChar withVars: { | |
26 opaque <- cpointer ptr | |
27 glyphIndex <- obj_uint32 ptr | |
28 charCode <- obj_uint32 ptr | |
29 makeChar <- lambda ptr | |
30 } andCode: :opaque makeChar { | |
31 glyphIndex <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
32 charCode <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
33 charCode num!: (FT_Get_First_Char: (opaque val) (addr_of: (glyphIndex num))) | |
34 ccall: makeChar 2 charCode glyphIndex | |
35 } | |
36 | |
37 llMessage: getNextChar withVars: { | |
38 opaque <- cpointer ptr | |
39 ocurChar <- object ptr | |
40 curChar <- obj_uint32 ptr | |
41 glyphIndex <- obj_uint32 ptr | |
42 charCode <- obj_uint32 ptr | |
43 makeChar <- lambda ptr | |
44 } andCode: :opaque ocurChar makeChar { | |
45 curChar <- (mcall: uint32 1 ocurChar) castTo: (obj_uint32 ptr) | |
46 glyphIndex <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
47 charCode <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
48 charCode num!: (FT_Get_Next_Char: (opaque val) (curChar num) (addr_of: (glyphIndex num))) | |
49 ccall: makeChar 2 charCode glyphIndex | |
50 } | |
51 } | |
52 | |
53 _makeSlot <- :opaque { | |
54 #{ | |
55 llProperty: slot withType: FT_GlyphSlot | |
56 llMessage: _ptr_init withVars: { | |
57 opaque <- cpointer ptr | |
58 } andCode: :opaque { | |
59 slot <- opaque val | |
60 self | |
61 } | |
62 | |
63 llMessage: linearHoriAdvance withVars: { | |
64 intret <- obj_int32 ptr | |
65 } andCode: { | |
66 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
67 intret num!: (slot linearHoriAdvance) | |
68 intret | |
69 } | |
70 | |
71 llMessage: linearVertAdvance withVars: { | |
72 intret <- obj_int32 ptr | |
73 } andCode: { | |
74 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
75 intret num!: (slot linearVertAdvance) | |
76 intret | |
77 } | |
78 | |
79 llMessage: bitmapTop withVars: { | |
80 intret <- obj_int32 ptr | |
81 } andCode: { | |
82 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
83 intret num!: (slot bitmap_top) | |
84 intret | |
85 } | |
86 | |
87 llMessage: bitmapLeft withVars: { | |
88 intret <- obj_int32 ptr | |
89 } andCode: { | |
90 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
91 intret num!: (slot bitmap_left) | |
92 intret | |
93 } | |
94 | |
95 llMessage: bitmapRows withVars: { | |
96 uintret <- obj_uint32 ptr | |
97 } andCode: { | |
98 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
99 uintret num!: ((addr_of: (slot bitmap)) rows) | |
100 uintret | |
101 } | |
102 | |
103 llMessage: bitmapWidth withVars: { | |
104 uintret <- obj_uint32 ptr | |
105 } andCode: { | |
106 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
107 uintret num!: ((addr_of: (slot bitmap)) width) | |
108 uintret | |
109 } | |
110 | |
111 llMessage: bitmapPitch withVars: { | |
112 intret <- obj_int32 ptr | |
113 } andCode: { | |
114 intret <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
115 intret num!: ((addr_of: (slot bitmap)) pitch) | |
116 intret | |
117 } | |
118 | |
119 llMessage: bitmapData withVars: { | |
120 opaque <- cpointer ptr | |
121 size <- obj_int32 ptr | |
122 } andCode: { | |
123 opaque <- make_object: (addr_of: cpointer_meta) NULL 0 | |
124 opaque val!: ((addr_of: (slot bitmap)) buffer) | |
125 size <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
126 size num!: ((addr_of: (slot bitmap)) rows) * ((addr_of: (slot bitmap)) pitch) | |
127 mcall: fromOpaque:withSize 3 bytearray opaque size | |
128 } | |
129 | |
130 llMessage: renderGlyph withVars: { | |
131 omode <- object ptr | |
132 mode <- obj_uint32 ptr | |
133 intret <- obj_int32 ptr | |
134 } andCode: :omode { | |
135 mode <- (mcall: uint32 1 omode) castTo: (obj_uint32 ptr) | |
136 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
137 intret num!: (FT_Render_Glyph: slot (mode num)) | |
138 intret | |
139 } | |
140 } _ptr_init: opaque | |
141 } | |
142 | |
143 _makeChar <- :_charcode _glyph { | |
144 #{ | |
145 charcode <- _charcode | |
146 glyph <- _glyph | |
147 } | |
148 } | |
149 _makeFace <- :opaque { | |
150 #{ | |
151 llProperty: face withType: FT_Face | |
152 llProperty: makeSlot withType: (lambda ptr) | |
153 llMessage: _ptr_init withVars: { | |
154 opaque <- cpointer ptr | |
155 makeSlotLambda <- lambda ptr | |
156 } andCode: :opaque makeSlotLambda { | |
157 face <- opaque val | |
158 makeSlot <- makeSlotLambda | |
159 self | |
160 } | |
161 | |
162 llMessage: faceOpaque withVars: { | |
163 opaque <- cpointer ptr | |
164 } andCode: { | |
165 opaque <- make_object: (addr_of: cpointer_meta) NULL 0 | |
166 opaque val!: face | |
167 opaque | |
168 } | |
169 | |
170 llMessage: setCharWidth:height:hRes:vRes withVars: { | |
171 ohsize <- object ptr | |
172 hsize <- obj_float32 ptr | |
173 ovsize <- object ptr | |
174 vsize <- obj_float32 ptr | |
175 ohres <- object ptr | |
176 hres <- obj_int32 ptr | |
177 ovres <- object ptr | |
178 vres <- obj_int32 ptr | |
179 intret <- obj_int32 ptr | |
180 } andCode: :ohsize ovsize :ohres :ovres { | |
181 hsize <- (mcall: f32 1 ohsize) castTo: (obj_float32 ptr) | |
182 vsize <- (mcall: f32 1 ovsize) castTo: (obj_float32 ptr) | |
183 hres <- (mcall: int32 1 ohres) castTo: (obj_int32 ptr) | |
184 vres <- (mcall: int32 1 ovres) castTo: (obj_int32 ptr) | |
185 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
186 intret num!: (FT_Set_Char_Size: face (hsize num) * 64 (vsize num) * 64 (hres num) (vres num)) | |
187 intret | |
188 } | |
189 | |
190 setCharSize:res <- :size :res { | |
191 setCharWidth: size height: size hRes: res vRes: res | |
192 } | |
193 | |
194 llMessage: getCharIndex withVars: { | |
195 ocharcode <- object ptr | |
196 charcode <- obj_uint32 ptr | |
197 uintret <- obj_uint32 ptr | |
198 } andCode: :ocharcode { | |
199 charcode <- (mcall: uint32 1 ocharcode) castTo: (obj_uint32 ptr) | |
200 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
201 uintret num!: (FT_Get_Char_Index: face (charcode num)) | |
202 uintret | |
203 } | |
204 | |
205 llMessage: loadGlyph:flags withVars: { | |
206 oindex <- object ptr | |
207 index <- obj_uint32 ptr | |
208 oflags <- object ptr | |
209 flags <- obj_uint32 ptr | |
210 intret <- obj_int32 ptr | |
211 } andCode: :oindex :oflags { | |
212 index <- (mcall: uint32 1 oindex) castTo: (obj_uint32 ptr) | |
213 flags <- (mcall: uint32 1 oflags) castTo: (obj_uint32 ptr) | |
214 intret <- make_object: (addr_of: obj_int32_meta) NULL 0 | |
215 intret num!: (FT_Load_Glyph: face (index num) (flags num)) | |
216 intret | |
217 } | |
218 | |
219 llMessage: glyphSlot withVars: { | |
220 opaque <- cpointer ptr | |
221 } andCode: { | |
222 opaque <- make_object: (addr_of: cpointer_meta) NULL 0 | |
223 opaque val!: (face glyph) | |
224 ccall: makeSlot 1 opaque | |
225 } | |
226 | |
227 firstChar <- { | |
228 _helper getFirstChar: faceOpaque _makeChar | |
229 } | |
230 | |
231 nextChar <- :curChar { | |
232 _helper getNextChar: faceOpaque curChar _makeChar | |
233 } | |
234 | |
235 charmap <- { | |
236 d <- dict hash | |
237 char <- firstChar | |
238 d set: (char charcode) (char glyph) | |
239 while: { (char glyph) != 0u32 } do: { | |
240 char <- nextChar: (char charcode) | |
241 d set: (char charcode) (char glyph) | |
242 } | |
243 d | |
244 } | |
245 } _ptr_init: opaque _makeSlot | |
246 } | |
247 | |
248 _constant <- macro: :name cname { | |
249 quote: (llMessage: name withVars: { | |
250 uintret <- obj_uint32 ptr | |
251 } andCode: { | |
252 uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 | |
253 uintret num!: cname | |
254 uintret | |
255 }) | |
256 } | |
257 | |
258 _loadFlags <- #{ | |
259 _constant: default FT_LOAD_DEFAULT | |
260 _constant: noScale FT_LOAD_NO_SCALE | |
261 _constant: noHinting FT_LOAD_NO_HINTING | |
262 _constant: render FT_LOAD_RENDER | |
263 _constant: noBitmap FT_LOAD_NO_BITMAP | |
264 _constant: verticalLayout FT_LOAD_VERTICAL_LAYOUT | |
265 _constant: forceAuthohint FT_LOAD_FORCE_AUTOHINT | |
266 _constant: pedantic FT_LOAD_PEDANTIC | |
267 _constant: noRecurse FT_LOAD_NO_RECURSE | |
268 _constant: ignoreTransform FT_LOAD_IGNORE_TRANSFORM | |
269 _constant: monochrome FT_LOAD_MONOCHROME | |
270 _constant: linearDesign FT_LOAD_LINEAR_DESIGN | |
271 _constant: noAutohint FT_LOAD_NO_AUTOHINT | |
272 _constant: color FT_LOAD_COLOR | |
273 } | |
274 | |
275 #{ | |
276 init <- { | |
277 | |
278 #{ | |
279 includeSystemHeader: "ft2build.h" | |
280 includeSystemHeader: FT_FREETYPE_H | |
281 llProperty: library withType: FT_Library | |
282 | |
283 llMessage: _init withVars: { | |
284 } andCode: { | |
285 FT_Init_FreeType: (addr_of: library) | |
286 self | |
287 } | |
288 | |
289 llMessage: libraryOpaque withVars: { | |
290 libOpaque <- cpointer ptr | |
291 } andCode: { | |
292 libOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 | |
293 libOpaque val!: library | |
294 libOpaque | |
295 } | |
296 | |
297 faceFromPath:index <- :path :index { | |
298 (_helper newFace: libraryOpaque path index) value: :opaque { | |
299 option value: (_makeFace: opaque) | |
300 } none: { | |
301 option none | |
302 } | |
303 } | |
304 | |
305 llMessage: destroy withVars: { | |
306 } andCode: { | |
307 FT_Done_FreeType: library | |
308 self | |
309 } | |
310 } _init | |
311 } | |
312 | |
313 loadFlags <- { _loadFlags } | |
314 } | |
315 } |