Mercurial > repos > tabletprog

comparison modules/freetype.tp @ 321:3edd0169311a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 }