1 /* Automatically generated from Squeak on 30 July 2012 4:52:40 pm
2    by VMMaker 4.9.8
3  */
4 
5 #include <math.h>
6 #include <stdio.h>
7 #include <stdlib.h>
8 #include <string.h>
9 #include <time.h>
10 
11 /* Default EXPORT macro that does nothing (see comment in sq.h): */
12 #define EXPORT(returnType) returnType
13 
14 /* Do not include the entire sq.h file but just those parts needed. */
15 /*  The virtual machine proxy definition */
16 #include "sqVirtualMachine.h"
17 /* Configuration options */
18 #include "sqConfig.h"
19 /* Platform specific definitions */
20 #include "sqPlatformSpecific.h"
21 
22 #define true 1
23 #define false 0
24 #define null 0  /* using 'null' because nil is predefined in Think C */
25 #ifdef SQUEAK_BUILTIN_PLUGIN
26 #undef EXPORT
27 // was #undef EXPORT(returnType) but screws NorCroft cc
28 #define EXPORT(returnType) static returnType
29 #endif
30 #include <ft2build.h>
31 #include FT_TRUETYPE_TABLES_H
32 #include FT_FREETYPE_H
33 #include FT_OUTLINE_H
34 
35 #include "sqMemoryAccess.h"
36 
37 
38 /*** Constants ***/
39 #define FT2GlyphSlotFaceIndex 0
40 #define FT2GlyphSlotInstSize 17
41 #define FT2OutlineContoursIndex 4
42 #define FT2OutlineContoursSizeIndex 0
43 #define FT2OutlineFlagsIndex 5
44 #define FT2OutlineInstSize 6
45 #define FT2OutlinePointsIndex 2
46 #define FT2OutlinePointsSizeIndex 1
47 #define FT2OutlineTagsIndex 3
48 #define FormBitsIndex 0
49 #define FormDepthIndex 3
50 #define FormHeightIndex 2
51 #define FormInstSize 5
52 #define FormWidthIndex 1
53 
54 /*** Function Prototypes ***/
55 static sqInt ftAllocateHandleInReceiverForPointer(void *aPointer);
56 static sqInt ftAllocateStringForPointer(const char *aPointer);
57 static FT_Encoding ftEncodingValueFromString(sqInt string);
58 static void * ftHandleValueFromReceiver(sqInt rcvrOop);
59 static int ftInitBitmapfromForm(FT_Bitmap*bitmap, sqInt formOop);
60 static int ftInitBitmapfromFormrenderMode(FT_Bitmap*bitmap, sqInt formOop, sqInt mode);
61 static int ftParameterError(void);
62 static sqInt ftStringFromEncodingValue(FT_Encoding encoding);
63 #pragma export on
64 EXPORT(const char*) getModuleName(void);
65 #pragma export off
66 static sqInt halt(void);
67 #pragma export on
68 EXPORT(sqInt) initialiseModule(void);
69 EXPORT(sqInt) primitiveCopyToExternalMemory(void);
70 EXPORT(sqInt) primitiveDoneFace(void);
71 EXPORT(sqInt) primitiveDoneFacePreserveFields(void);
72 EXPORT(sqInt) primitiveEmboldenFaceGlyphSlotOutline(void);
73 EXPORT(sqInt) primitiveErrorCode(void);
74 EXPORT(sqInt) primitiveErrorString(void);
75 EXPORT(sqInt) primitiveFreeExternalMemory(void);
76 EXPORT(sqInt) primitiveGetFaceCharIndex(void);
77 EXPORT(sqInt) primitiveGetFaceCharMap(void);
78 EXPORT(sqInt) primitiveGetFaceCharMapsIntoArray(void);
79 EXPORT(sqInt) primitiveGetFaceGlyphName(void);
80 EXPORT(sqInt) primitiveGetKerningLeftRight(void);
81 EXPORT(sqInt) primitiveGetPostscriptName(void);
82 EXPORT(sqInt) primitiveGetSfntTableOS2(void);
83 EXPORT(sqInt) primitiveHasKerning(void);
84 EXPORT(sqInt) primitiveLibraryHandle(void);
85 EXPORT(sqInt) primitiveLoadCharacter(void);
86 EXPORT(sqInt) primitiveLoadFaceBbox(void);
87 EXPORT(sqInt) primitiveLoadFaceFields(void);
88 EXPORT(sqInt) primitiveLoadGlyph(void);
89 EXPORT(sqInt) primitiveLoadGlyphSlotFromFace(void);
90 EXPORT(sqInt) primitiveLoadOutlineArraysFromFace(void);
91 EXPORT(sqInt) primitiveLoadOutlineSizesFromFace(void);
92 EXPORT(sqInt) primitiveModuleErrorCode(void);
93 EXPORT(sqInt) primitiveNewFaceFromFileAndIndex(void);
94 EXPORT(sqInt) primitiveNewMemoryFaceFromExternalMemoryAndIndex(void);
95 EXPORT(sqInt) primitiveNumberOfOutlineCountours(void);
96 EXPORT(sqInt) primitiveRenderGlyphIntoForm(void);
97 EXPORT(sqInt) primitiveRenderGlyphIntoFormWithRenderMode(void);
98 EXPORT(sqInt) primitiveResetErrorCode(void);
99 EXPORT(sqInt) primitiveSetFaceCharMap(void);
100 EXPORT(sqInt) primitiveSetPixelSizes(void);
101 EXPORT(sqInt) primitiveSetTransform(void);
102 EXPORT(sqInt) primitiveTransformFaceGlyphSlotOutline(void);
103 EXPORT(sqInt) primitiveTranslateFaceGlyphSlotOutline(void);
104 EXPORT(sqInt) primitiveVersion(void);
105 EXPORT(sqInt) setInterpreter(struct VirtualMachine*anInterpreter);
106 EXPORT(sqInt) shutdownModule(void);
107 #pragma export off
108 /*** Variables ***/
109 static int errorCode;
110 
111 #ifdef SQUEAK_BUILTIN_PLUGIN
112 extern
113 #endif
114 struct VirtualMachine* interpreterProxy;
115 static FT_Library library;
116 static const char *moduleName =
117 #ifdef SQUEAK_BUILTIN_PLUGIN
118 	"FT2Plugin 30 July 2012 (i)"
119 #else
120 	"FT2Plugin 30 July 2012 (e)"
121 #endif
122 ;
123 
124 
125 
126 /*	given aPointer (returned from a library call),
127 	set the receiver's (bottom of stack) first instance variable
128 	to a ByteArray containing the pointer's bytes */
129 
ftAllocateHandleInReceiverForPointer(void * aPointer)130 static sqInt ftAllocateHandleInReceiverForPointer(void *aPointer) {
131 	sqInt returnedHandle;
132 	void **extraByteArrayPtr;
133 
134 	if (aPointer) {
135 
136 		/* Allocate a Smalltalk ByteArray -- lastAlloc contains the length */
137 		/* Copy from the C bytecode buffer to the Smalltalk ByteArray */
138 
139 		returnedHandle = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), sizeof(void **));
140 		extraByteArrayPtr = interpreterProxy->arrayValueOf(returnedHandle);
141 		*extraByteArrayPtr = (void *)(aPointer);
142 	} else {
143 		returnedHandle = interpreterProxy->nilObject();
144 	}
145 	interpreterProxy->storePointerofObjectwithValue(0, interpreterProxy->stackObjectValue(interpreterProxy->methodArgumentCount()), returnedHandle);
146 	;
147 	return returnedHandle;
148 }
149 
150 
151 /*	given NUL-terminated char* aPointer (returned from a library call),
152 	return the oop for a String containing the pointer's bytes */
153 
ftAllocateStringForPointer(const char * aPointer)154 static sqInt ftAllocateStringForPointer(const char *aPointer) {
155 	sqInt returnedHandle;
156 	char *extraByteArrayPtr;
157 
158 	if (aPointer) {
159 
160 		/* Allocate a Smalltalk ByteArray -- lastAlloc contains the length */
161 		/* Copy from the C bytecode buffer to the Smalltalk ByteArray */
162 
163 		returnedHandle = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classString(), strlen(aPointer));
164 		extraByteArrayPtr = interpreterProxy->arrayValueOf(returnedHandle);
165 		;
166 		strncpy(extraByteArrayPtr, aPointer, strlen(aPointer));
167 	} else {
168 		returnedHandle = interpreterProxy->nilObject();
169 	}
170 	return returnedHandle;
171 }
172 
173 
174 /*	Return a 32-bit word from the bytes held by string. */
175 
ftEncodingValueFromString(sqInt string)176 static FT_Encoding ftEncodingValueFromString(sqInt string) {
177 	unsigned long retval;
178 	unsigned char*ptr;
179 
180 	interpreterProxy->success((!((string & 1))) && ((interpreterProxy->isBytes(string)) && ((interpreterProxy->slotSizeOf(string)) == (sizeof(FT_Encoding)))));
181 	if (interpreterProxy->failed()) {
182 		return null;
183 	}
184 	retval = 0;
185 
186 	/* 	ptr := self cCode: '(unsigned char *) (string + 4)'. */
187 
188 	ptr = interpreterProxy->arrayValueOf(string);
189 	;
190 	retval = ((unsigned long)ptr[0]) << 24;
191 	retval += ((unsigned long)ptr[1]) << 16;
192 	retval += ((unsigned long)ptr[2]) << 8;
193 	retval += (unsigned long)ptr[3];
194 	;
195 	return (FT_Encoding)retval;
196 }
197 
198 
199 /*	this is the opposite of #ftAllocateHandleIn:forPointer: .
200 	It takes rcvr's first instance variable,
201 	which should be a ByteArray the size of a void*,
202 	and returns its value as a C pointer. */
203 
ftHandleValueFromReceiver(sqInt rcvrOop)204 static void * ftHandleValueFromReceiver(sqInt rcvrOop) {
205 	sqInt oop;
206 	sqInt btw;
207 
208 	oop = interpreterProxy->fetchPointerofObject(0, rcvrOop);
209 	interpreterProxy->success((interpreterProxy->isBytes(oop)) && ((interpreterProxy->slotSizeOf(oop)) == (sizeof(void *))));
210 	if (interpreterProxy->failed()) {
211 		return null;
212 	}
213 	btw = BYTES_PER_WORD;
214 	return *(void**)(pointerForOop(oop + btw));
215 }
216 
217 
218 /*	Initialize the values in an FT_Bitmap from the given Form */
219 
ftInitBitmapfromForm(FT_Bitmap * bitmap,sqInt formOop)220 static int ftInitBitmapfromForm(FT_Bitmap*bitmap, sqInt formOop) {
221 	sqInt pixelMode;
222 	sqInt numGrays;
223 	sqInt width;
224 	sqInt depth;
225 	sqInt height;
226 	sqInt wordsPerRow;
227 	sqInt pitch;
228 	unsigned char*buffer;
229 
230 	interpreterProxy->success(interpreterProxy->isPointers(formOop));
231 	interpreterProxy->success((interpreterProxy->slotSizeOf(formOop)) >= FormInstSize);
232 	if (interpreterProxy->failed()) {
233 		return null;
234 	}
235 	width = interpreterProxy->fetchIntegerofObject(FormWidthIndex, formOop);
236 	height = interpreterProxy->fetchIntegerofObject(FormHeightIndex, formOop);
237 	depth = interpreterProxy->fetchIntegerofObject(FormDepthIndex, formOop);
238 	buffer = ((void*) (interpreterProxy->fetchArrayofObject(FormBitsIndex, formOop)));
239 	if (interpreterProxy->failed()) {
240 		return null;
241 	}
242 	if (depth < 0) {
243 		depth = depth * -1;
244 	}
245 	if (depth == 1) {
246 		wordsPerRow = ((sqInt) (width + 31) >> 5);
247 		numGrays = 1;
248 		pixelMode = FT_PIXEL_MODE_MONO;
249 	} else {
250 		if (depth == 8) {
251 			wordsPerRow = ((sqInt) (width + 3) >> 2);
252 			numGrays = 256;
253 			pixelMode = FT_PIXEL_MODE_GRAY;
254 		} else {
255 			return interpreterProxy->primitiveFail();
256 		}
257 	}
258 
259 #ifndef WORDS_BIGENDIAN
260 	depth = depth * -1;
261 #endif
262 ;
263 	interpreterProxy->storeIntegerofObjectwithValue(FormDepthIndex, formOop, depth);
264 	pitch = wordsPerRow * 4;
265 	bitmap->rows = height;
266 	bitmap->width = width;
267 	bitmap->pitch = pitch;
268 	bitmap->buffer = buffer;
269 	bitmap->num_grays = numGrays;
270 	bitmap->pixel_mode = pixelMode;
271 	return 1;
272 }
273 
274 
275 /*	Initialize the values in an FT_Bitmap from the given Form */
276 /*	pixelMode */
277 
ftInitBitmapfromFormrenderMode(FT_Bitmap * bitmap,sqInt formOop,sqInt mode)278 static int ftInitBitmapfromFormrenderMode(FT_Bitmap*bitmap, sqInt formOop, sqInt mode) {
279 	sqInt numGrays;
280 	sqInt width;
281 	sqInt depth;
282 	sqInt height;
283 	sqInt wordsPerRow;
284 	sqInt pitch;
285 	unsigned char*buffer;
286 
287 	interpreterProxy->success(interpreterProxy->isPointers(formOop));
288 	interpreterProxy->success((interpreterProxy->slotSizeOf(formOop)) >= FormInstSize);
289 	if (interpreterProxy->failed()) {
290 		return null;
291 	}
292 	width = interpreterProxy->fetchIntegerofObject(FormWidthIndex, formOop);
293 	height = interpreterProxy->fetchIntegerofObject(FormHeightIndex, formOop);
294 	depth = interpreterProxy->fetchIntegerofObject(FormDepthIndex, formOop);
295 	buffer = ((void*) (interpreterProxy->fetchArrayofObject(FormBitsIndex, formOop)));
296 	if (interpreterProxy->failed()) {
297 		return null;
298 	}
299 	if (depth < 0) {
300 		depth = depth * -1;
301 	}
302 	if (depth == 1) {
303 		wordsPerRow = ((sqInt) (width + 31) >> 5);
304 		numGrays = 1;
305 	} else {
306 		if (depth == 8) {
307 			wordsPerRow = ((sqInt) (width + 3) >> 2);
308 			numGrays = 256;
309 		} else {
310 			return interpreterProxy->primitiveFail();
311 		}
312 	}
313 
314 #ifndef WORDS_BIGENDIAN
315 	depth = depth * -1;
316 #endif
317 ;
318 	interpreterProxy->storeIntegerofObjectwithValue(FormDepthIndex, formOop, depth);
319 	pitch = wordsPerRow * 4;
320 	bitmap->rows = height;
321 	bitmap->width = width;
322 	bitmap->pitch = pitch;
323 	bitmap->buffer = buffer;
324 	bitmap->num_grays = numGrays;
325 	bitmap->pixel_mode = mode;
326 	return 1;
327 }
328 
ftParameterError(void)329 static int ftParameterError(void) {
330 	errorCode = 255;
331 	return interpreterProxy->primitiveFail();
332 }
333 
334 
335 /*	Return a newly allocated String from the given 32-bit word */
336 
ftStringFromEncodingValue(FT_Encoding encoding)337 static sqInt ftStringFromEncodingValue(FT_Encoding encoding) {
338 	unsigned char*ptr;
339 	sqInt stringOop;
340 
341 	stringOop = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classString(), sizeof(FT_Encoding));
342 	;
343 	if (interpreterProxy->failed()) {
344 		return null;
345 	}
346 	ptr = interpreterProxy->firstIndexableField(stringOop);
347 	;
348 	ptr[0] = (encoding & 0xFF000000) >> 24;
349 	ptr[1] = (encoding & 0x00FF0000) >> 16;
350 	ptr[2] = (encoding & 0x0000FF00) >> 8;
351 	ptr[3] = (encoding & 0x000000FF);
352 	return stringOop;
353 }
354 
355 
356 /*	Note: This is hardcoded so it can be run from Squeak.
357 	The module name is used for validating a module *after*
358 	it is loaded to check if it does really contain the module
359 	we're thinking it contains. This is important! */
360 
getModuleName(void)361 EXPORT(const char*) getModuleName(void) {
362 	return moduleName;
363 }
364 
halt(void)365 static sqInt halt(void) {
366 	;
367 }
368 
initialiseModule(void)369 EXPORT(sqInt) initialiseModule(void) {
370 
371 	/*  not implemented?? commented out because of compilation errors
372 
373 	self ifDefined: 'macintoshSqueak' then: [
374 		self fetchPreferences.
375 	].
376 	 */
377 
378 	library = null;
379 	errorCode = FT_Init_FreeType(&library);
380 	return errorCode == 0;
381 }
382 
primitiveCopyToExternalMemory(void)383 EXPORT(sqInt) primitiveCopyToExternalMemory(void) {
384 	void *aPointer;
385 	sqInt rcvr;
386 	size_t byteSize;
387 	char *aByteArray;
388 
389 	interpreterProxy->success(interpreterProxy->isBytes(interpreterProxy->stackValue(0)));
390 	aByteArray = ((char *) (interpreterProxy->firstIndexableField(interpreterProxy->stackValue(0))));
391 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FreeTypeExternalMemory"));
392 	rcvr = interpreterProxy->stackValue(1);
393 	if (interpreterProxy->failed()) {
394 		ftParameterError();
395 		return null;
396 	}
397 	;
398 	errorCode = 0;
399 	byteSize = interpreterProxy->byteSizeOf((oopForPointer( aByteArray ) - BASE_HEADER_SIZE));
400 	;
401 	if (interpreterProxy->failed()) {
402 		return null;
403 	}
404 	aPointer = malloc(byteSize);
405 	memcpy(aPointer,aByteArray,byteSize);
406 	ftAllocateHandleInReceiverForPointer(aPointer);
407 	if (interpreterProxy->failed()) {
408 		ftParameterError();
409 		return null;
410 	}
411 	interpreterProxy->pop(1);
412 	return null;
413 }
414 
415 
416 /*	Call the library to release the given face record.
417 	Nil out the pointer fields */
418 
primitiveDoneFace(void)419 EXPORT(sqInt) primitiveDoneFace(void) {
420 	sqInt rcvr;
421 	sqInt i;
422 	FT_Face face;
423 
424 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
425 	rcvr = interpreterProxy->stackValue(0);
426 	if (interpreterProxy->failed()) {
427 		ftParameterError();
428 		return null;
429 	}
430 	face = ftHandleValueFromReceiver(rcvr);
431 	if (face == null) {
432 		interpreterProxy->primitiveFail();
433 		return null;
434 	}
435 	;
436 
437 	/* nil out all the fields */
438 
439 	errorCode = FT_Done_Face(face);
440 	for (i = 0; i <= 23; i += 1) {
441 		interpreterProxy->storePointerofObjectwithValue(i, rcvr, interpreterProxy->nilObject());
442 	}
443 	interpreterProxy->success(errorCode == 0);
444 	if (interpreterProxy->failed()) {
445 		ftParameterError();
446 		return null;
447 	}
448 	return null;
449 }
450 
451 
452 /*	Call the library to release the given face record.
453 	Nil out the handle field, but do not nil the other fields,
454 	as their values are needed even if the face cannot be re-opened
455 	in the future due to a missing font file etc. */
456 
primitiveDoneFacePreserveFields(void)457 EXPORT(sqInt) primitiveDoneFacePreserveFields(void) {
458 	sqInt rcvr;
459 	FT_Face face;
460 
461 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
462 	rcvr = interpreterProxy->stackValue(0);
463 	if (interpreterProxy->failed()) {
464 		ftParameterError();
465 		return null;
466 	}
467 	face = ftHandleValueFromReceiver(rcvr);
468 	if (face == null) {
469 		interpreterProxy->primitiveFail();
470 		return null;
471 	}
472 	;
473 
474 	/* nil the handle field */
475 
476 	errorCode = FT_Done_Face(face);
477 	interpreterProxy->storePointerofObjectwithValue(0, rcvr, interpreterProxy->nilObject());
478 	interpreterProxy->success(errorCode == 0);
479 	if (interpreterProxy->failed()) {
480 		ftParameterError();
481 		return null;
482 	}
483 	return null;
484 }
485 
486 
487 /*	emboldens the outline in the face's glyphSlot by strength (expressed in 26.6 pixel format).
488 	The new outline will be at most 4 times `strength' pixels wider and higher.  */
489 
primitiveEmboldenFaceGlyphSlotOutline(void)490 EXPORT(sqInt) primitiveEmboldenFaceGlyphSlotOutline(void) {
491 	sqInt rcvr;
492 	FT_Face face;
493 	sqInt strength;
494 
495 	strength = interpreterProxy->stackIntegerValue(0);
496 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
497 	rcvr = interpreterProxy->stackValue(1);
498 	if (interpreterProxy->failed()) {
499 		ftParameterError();
500 		return null;
501 	}
502 	face = ftHandleValueFromReceiver(rcvr);
503 	if (face == null) {
504 		interpreterProxy->primitiveFail();
505 		return null;
506 	}
507 	errorCode = FT_Outline_Embolden( &face->glyph->outline, strength );
508 	interpreterProxy->success(errorCode == 0);
509 	if (interpreterProxy->failed()) {
510 		return null;
511 	}
512 	if (interpreterProxy->failed()) {
513 		ftParameterError();
514 		return null;
515 	}
516 	interpreterProxy->pop(1);
517 	return null;
518 }
519 
520 
521 /*	high byte is module error, low is generic error */
522 
primitiveErrorCode(void)523 EXPORT(sqInt) primitiveErrorCode(void) {
524 	sqInt _return_value;
525 
526 	_return_value = interpreterProxy->positive32BitIntegerFor((FT_ERROR_BASE(errorCode)));
527 	if (interpreterProxy->failed()) {
528 		ftParameterError();
529 		return null;
530 	}
531 	interpreterProxy->popthenPush(1, _return_value);
532 	return null;
533 }
534 
primitiveErrorString(void)535 EXPORT(sqInt) primitiveErrorString(void) {
536 	const char *str;
537 	const struct ftError *ftError;
538 
539 
540 struct ftError { int errCode; const char* errMsg; };
541 #undef __FTERRORS_H__
542 #define FT_ERRORDEF( e, v, s )  { e, s },
543 #define FT_ERROR_START_LIST     {
544 #define FT_ERROR_END_LIST       { 0xFF, "Bad Squeak Method Parameter" }, { 0, NULL } };
545 static const struct ftError ftErrors[] =
546 #include FT_ERRORS_H
547 ;
548 	ftError = ftErrors;
549 	;
550 	while (((str = ftError->errMsg)) && (FT_ERROR_BASE(errorCode) != ftError->errCode)) {
551 		ftError++;
552 	}
553 	;
554 	if (!(str)) {
555 		interpreterProxy->success(0);
556 	}
557 	if (interpreterProxy->failed()) {
558 		return null;
559 	}
560 	interpreterProxy->popthenPush(1, ftAllocateStringForPointer(str));
561 	if (interpreterProxy->failed()) {
562 		ftParameterError();
563 		return null;
564 	}
565 	return null;
566 }
567 
primitiveFreeExternalMemory(void)568 EXPORT(sqInt) primitiveFreeExternalMemory(void) {
569 	sqInt rcvr;
570 	void*memPointer;
571 
572 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FreeTypeExternalMemory"));
573 	rcvr = interpreterProxy->stackValue(0);
574 	if (interpreterProxy->failed()) {
575 		ftParameterError();
576 		return null;
577 	}
578 	;
579 
580 	/* free the memory handle */
581 
582 	errorCode = 0;
583 	memPointer = ftHandleValueFromReceiver(rcvr);
584 	if (!(memPointer == null)) {
585 		free(memPointer);
586 	}
587 	if (interpreterProxy->failed()) {
588 		ftParameterError();
589 		return null;
590 	}
591 	return null;
592 }
593 
594 
595 /*	Return the Freetype glyph index of the given character code, in the
596 	current encoding.
597 	Return value of 0 means 'undefined character code'. */
598 
primitiveGetFaceCharIndex(void)599 EXPORT(sqInt) primitiveGetFaceCharIndex(void) {
600 	sqInt rcvr;
601 	sqInt result;
602 	FT_Face face;
603 	sqInt charIndex;
604 	sqInt _return_value;
605 
606 	charIndex = interpreterProxy->stackIntegerValue(0);
607 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
608 	rcvr = interpreterProxy->stackValue(1);
609 	if (interpreterProxy->failed()) {
610 		ftParameterError();
611 		return null;
612 	}
613 	errorCode = 0;
614 	face = ftHandleValueFromReceiver(rcvr);
615 	if (face == null) {
616 		interpreterProxy->primitiveFail();
617 		return null;
618 	}
619 	result = FT_Get_Char_Index(face, charIndex);
620 	_return_value = interpreterProxy->positive32BitIntegerFor(result);
621 	if (interpreterProxy->failed()) {
622 		ftParameterError();
623 		return null;
624 	}
625 	interpreterProxy->popthenPush(2, _return_value);
626 	return null;
627 }
628 
primitiveGetFaceCharMap(void)629 EXPORT(sqInt) primitiveGetFaceCharMap(void) {
630 	FT_Encoding encoding;
631 	sqInt rcvr;
632 	FT_CharMap charmap;
633 	sqInt stringOop;
634 	FT_Face face;
635 
636 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
637 	rcvr = interpreterProxy->stackValue(0);
638 	if (interpreterProxy->failed()) {
639 		ftParameterError();
640 		return null;
641 	}
642 	face = ftHandleValueFromReceiver(rcvr);
643 	if (face == null) {
644 		interpreterProxy->primitiveFail();
645 		return null;
646 	}
647 	charmap = face->charmap;
648 	if (!(charmap)) {
649 		return null;
650 	}
651 	interpreterProxy->pushRemappableOop(rcvr);
652 	encoding = charmap->encoding;
653 	stringOop = ftStringFromEncodingValue(encoding);
654 	rcvr = interpreterProxy->popRemappableOop();
655 	interpreterProxy->storePointerofObjectwithValue(22, rcvr, stringOop);
656 	interpreterProxy->storeIntegerofObjectwithValue(23, rcvr, charmap->platform_id);
657 	interpreterProxy->storeIntegerofObjectwithValue(24, rcvr, charmap->encoding_id);
658 	if (interpreterProxy->failed()) {
659 		return null;
660 	}
661 	if (interpreterProxy->failed()) {
662 		ftParameterError();
663 		return null;
664 	}
665 	return null;
666 }
667 
primitiveGetFaceCharMapsIntoArray(void)668 EXPORT(sqInt) primitiveGetFaceCharMapsIntoArray(void) {
669 	FT_CharMap *charmap;
670 	int numCharmaps;
671 	sqInt i;
672 	sqInt stringOop;
673 	FT_Face face;
674 	sqInt arrayOop;
675 	sqInt rcvr;
676 	sqInt *array;
677 
678 	interpreterProxy->success(interpreterProxy->isIndexable(interpreterProxy->stackValue(0)));
679 	array = ((int *) (interpreterProxy->firstIndexableField(interpreterProxy->stackValue(0))));
680 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
681 	rcvr = interpreterProxy->stackValue(1);
682 	if (interpreterProxy->failed()) {
683 		ftParameterError();
684 		return null;
685 	}
686 	face = ftHandleValueFromReceiver(rcvr);
687 	if (face == null) {
688 		interpreterProxy->primitiveFail();
689 		return null;
690 	}
691 	numCharmaps = face->num_charmaps;
692 	arrayOop = oopForPointer(array) - BASE_HEADER_SIZE;
693 	interpreterProxy->success((interpreterProxy->slotSizeOf(arrayOop)) == numCharmaps);
694 	if (interpreterProxy->failed()) {
695 		return null;
696 	}
697 	charmap = face->charmaps;
698 	;
699 	for (i = 0; i <= (numCharmaps - 1); i += 1) {
700 		interpreterProxy->pushRemappableOop(arrayOop);
701 		stringOop = ftStringFromEncodingValue((*charmap)->encoding);
702 		arrayOop = interpreterProxy->popRemappableOop();
703 		interpreterProxy->storePointerofObjectwithValue(i, arrayOop, stringOop);
704 		charmap++;
705 	}
706 	if (interpreterProxy->failed()) {
707 		return null;
708 	}
709 	if (interpreterProxy->failed()) {
710 		ftParameterError();
711 		return null;
712 	}
713 	interpreterProxy->pop(1);
714 	return null;
715 }
716 
717 
718 /*	return a String */
719 
primitiveGetFaceGlyphName(void)720 EXPORT(sqInt) primitiveGetFaceGlyphName(void) {
721 	char buffer[100];
722 	sqInt rcvr;
723 	sqInt string;
724 	FT_Face face;
725 	sqInt glyphIndex;
726 
727 	glyphIndex = interpreterProxy->stackIntegerValue(0);
728 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
729 	rcvr = interpreterProxy->stackValue(1);
730 	if (interpreterProxy->failed()) {
731 		ftParameterError();
732 		return null;
733 	}
734 	face = ftHandleValueFromReceiver(rcvr);
735 	if (face == null) {
736 		interpreterProxy->primitiveFail();
737 		return null;
738 	}
739 	errorCode = FT_Get_Glyph_Name(face, glyphIndex, buffer, 100);
740 	interpreterProxy->success(errorCode == 0);
741 	if (interpreterProxy->failed()) {
742 		return null;
743 	}
744 	string = ftAllocateStringForPointer(buffer);
745 	if (interpreterProxy->failed()) {
746 		ftParameterError();
747 		return null;
748 	}
749 	interpreterProxy->popthenPush(2, string);
750 	return null;
751 }
752 
primitiveGetKerningLeftRight(void)753 EXPORT(sqInt) primitiveGetKerningLeftRight(void) {
754 	sqInt kernMode;
755 	sqInt rcvr;
756 	FT_Vector result;
757 	sqInt pointOop;
758 	FT_Face face;
759 	sqInt leftGlyph;
760 	sqInt rightGlyph;
761 
762 	leftGlyph = interpreterProxy->stackIntegerValue(1);
763 	rightGlyph = interpreterProxy->stackIntegerValue(0);
764 
765 		result.x=3;
766 		result.y=4;;
767 	;
768 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
769 	rcvr = interpreterProxy->stackValue(2);
770 	if (interpreterProxy->failed()) {
771 		ftParameterError();
772 		return null;
773 	}
774 	errorCode = 0;
775 	face = ftHandleValueFromReceiver(rcvr);
776 	if (face == null) {
777 		interpreterProxy->primitiveFail();
778 		return null;
779 	}
780 	kernMode = FT_KERNING_UNSCALED;
781 	;
782 	FT_Get_Kerning(face, leftGlyph, rightGlyph, kernMode, &result);;
783 	pointOop = interpreterProxy->makePointwithxValueyValue(result.x, result.y);
784 	if (interpreterProxy->failed()) {
785 		ftParameterError();
786 		return null;
787 	}
788 	interpreterProxy->popthenPush(3, pointOop);
789 	return null;
790 }
791 
792 
793 /*	return a String */
794 
primitiveGetPostscriptName(void)795 EXPORT(sqInt) primitiveGetPostscriptName(void) {
796 	char*buffer;
797 	sqInt rcvr;
798 	sqInt string;
799 	FT_Face face;
800 
801 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
802 	rcvr = interpreterProxy->stackValue(0);
803 	if (interpreterProxy->failed()) {
804 		ftParameterError();
805 		return null;
806 	}
807 	buffer = 0;
808 	face = ftHandleValueFromReceiver(rcvr);
809 	if (face == null) {
810 		interpreterProxy->primitiveFail();
811 		return null;
812 	}
813 	buffer = FT_Get_Postscript_Name(face);
814 	interpreterProxy->success(buffer != 0);
815 	if (interpreterProxy->failed()) {
816 		return null;
817 	}
818 	string = ftAllocateStringForPointer(buffer);
819 	if (interpreterProxy->failed()) {
820 		ftParameterError();
821 		return null;
822 	}
823 	interpreterProxy->popthenPush(1, string);
824 	return null;
825 }
826 
827 
828 /*	return the bytes from the OS/2 table */
829 
primitiveGetSfntTableOS2(void)830 EXPORT(sqInt) primitiveGetSfntTableOS2(void) {
831 	char *buffer;
832 	sqInt rcvr;
833 	sqInt returnedHandle;
834 	char *extraByteArrayPtr;
835 	FT_Face face;
836 	sqInt _return_value;
837 
838 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
839 	rcvr = interpreterProxy->stackValue(0);
840 	if (interpreterProxy->failed()) {
841 		ftParameterError();
842 		return null;
843 	}
844 	buffer = 0;
845 	face = ftHandleValueFromReceiver(rcvr);
846 	if (face == null) {
847 		interpreterProxy->primitiveFail();
848 		return null;
849 	}
850 	buffer = FT_Get_Sfnt_Table(face,ft_sfnt_os2);
851 	if (buffer == 0) {
852 		_return_value = interpreterProxy->integerObjectOf(-1);
853 		if (interpreterProxy->failed()) {
854 			ftParameterError();
855 			return null;
856 		}
857 		interpreterProxy->popthenPush(1, _return_value);
858 		return null;
859 	}
860 
861 	/* Copy from the C bytecode buffer to the Smalltalk ByteArray */
862 
863 	returnedHandle = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), sizeof(TT_OS2));
864 	extraByteArrayPtr = interpreterProxy->arrayValueOf(returnedHandle);
865 	;
866 	memcpy(extraByteArrayPtr, buffer, sizeof(TT_OS2));
867 	if (interpreterProxy->failed()) {
868 		ftParameterError();
869 		return null;
870 	}
871 	interpreterProxy->popthenPush(1, returnedHandle);
872 	return null;
873 }
874 
primitiveHasKerning(void)875 EXPORT(sqInt) primitiveHasKerning(void) {
876 	sqInt rcvr;
877 	FT_Face face;
878 	sqInt _return_value;
879 
880 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
881 	rcvr = interpreterProxy->stackValue(0);
882 	if (interpreterProxy->failed()) {
883 		ftParameterError();
884 		return null;
885 	}
886 	errorCode = 0;
887 	face = ftHandleValueFromReceiver(rcvr);
888 	if (face == null) {
889 		interpreterProxy->primitiveFail();
890 		return null;
891 	}
892 	_return_value = (((FT_HAS_KERNING( face )) << 1) | 1);
893 	if (interpreterProxy->failed()) {
894 		ftParameterError();
895 		return null;
896 	}
897 	interpreterProxy->popthenPush(1, _return_value);
898 	return null;
899 }
900 
901 
902 /*	Fill in the handle in an FT2Library structure with a copy of our global pointer. */
903 
primitiveLibraryHandle(void)904 EXPORT(sqInt) primitiveLibraryHandle(void) {
905 	sqInt rcvr;
906 
907 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Library"));
908 	rcvr = interpreterProxy->stackValue(0);
909 	if (interpreterProxy->failed()) {
910 		ftParameterError();
911 		return null;
912 	}
913 	errorCode = 0;
914 	ftAllocateHandleInReceiverForPointer(library);
915 	if (interpreterProxy->failed()) {
916 		ftParameterError();
917 		return null;
918 	}
919 	return null;
920 }
921 
922 
923 /*	Load the glyph at the given index in the current charmap.
924 	The default map upon opening a font is the 'unic' or Unicode charmap, if any. */
925 
primitiveLoadCharacter(void)926 EXPORT(sqInt) primitiveLoadCharacter(void) {
927 	sqInt rcvr;
928 	FT_Face face;
929 	sqInt index;
930 	sqInt flags;
931 
932 	index = interpreterProxy->stackIntegerValue(1);
933 	flags = interpreterProxy->stackIntegerValue(0);
934 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
935 	rcvr = interpreterProxy->stackValue(2);
936 	if (interpreterProxy->failed()) {
937 		ftParameterError();
938 		return null;
939 	}
940 	face = ftHandleValueFromReceiver(rcvr);
941 	if (face == null) {
942 		interpreterProxy->primitiveFail();
943 		return null;
944 	}
945 	errorCode = FT_Load_Char(face, index, flags);
946 	interpreterProxy->success(errorCode == 0);
947 	if (interpreterProxy->failed()) {
948 		return null;
949 	}
950 	if (interpreterProxy->failed()) {
951 		ftParameterError();
952 		return null;
953 	}
954 	interpreterProxy->pop(2);
955 	return null;
956 }
957 
primitiveLoadFaceBbox(void)958 EXPORT(sqInt) primitiveLoadFaceBbox(void) {
959 	sqInt rcvr;
960 	sqInt pointOop;
961 	sqInt rectOop;
962 	FT_Face face;
963 	sqInt aRectangle;
964 
965 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "Rectangle"));
966 	aRectangle = interpreterProxy->stackValue(0);
967 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
968 	rcvr = interpreterProxy->stackValue(1);
969 	if (interpreterProxy->failed()) {
970 		ftParameterError();
971 		return null;
972 	}
973 	rectOop = aRectangle;
974 	if (!(interpreterProxy->isPointers(rectOop))) {
975 		interpreterProxy->primitiveFail();
976 		return null;
977 	}
978 	if ((interpreterProxy->slotSizeOf(rectOop)) < 2) {
979 		interpreterProxy->primitiveFail();
980 		return null;
981 	}
982 	face = ftHandleValueFromReceiver(rcvr);
983 	if (face == null) {
984 		interpreterProxy->primitiveFail();
985 		return null;
986 	}
987 	;
988 	if (!(face->face_flags & FT_FACE_FLAG_SCALABLE)) {
989 		interpreterProxy->success(0);
990 	}
991 	if (interpreterProxy->failed()) {
992 		return null;
993 	}
994 	interpreterProxy->pushRemappableOop(rectOop);
995 	pointOop = interpreterProxy->makePointwithxValueyValue(face->bbox.xMin, face->bbox.yMin);
996 	rectOop = interpreterProxy->popRemappableOop();
997 	interpreterProxy->storePointerofObjectwithValue(0, rectOop, pointOop);
998 	interpreterProxy->pushRemappableOop(rectOop);
999 	pointOop = interpreterProxy->makePointwithxValueyValue(face->bbox.xMax, face->bbox.yMax);
1000 	rectOop = interpreterProxy->popRemappableOop();
1001 	interpreterProxy->storePointerofObjectwithValue(1, rectOop, pointOop);
1002 	if (interpreterProxy->failed()) {
1003 		ftParameterError();
1004 		return null;
1005 	}
1006 	interpreterProxy->pop(1);
1007 	return null;
1008 }
1009 
1010 
1011 /*	Fill in many of the receiver's (an FT2Face) fields (other than its handle)
1012 	from the FT_Face record that it points to. */
1013 
primitiveLoadFaceFields(void)1014 EXPORT(sqInt) primitiveLoadFaceFields(void) {
1015 	sqInt rcvr;
1016 	sqInt strOop;
1017 	FT_Face face;
1018 
1019 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
1020 	rcvr = interpreterProxy->stackValue(0);
1021 	if (interpreterProxy->failed()) {
1022 		ftParameterError();
1023 		return null;
1024 	}
1025 	face = ftHandleValueFromReceiver(rcvr);
1026 	if (face == null) {
1027 		interpreterProxy->primitiveFail();
1028 		return null;
1029 	}
1030 	;
1031 	interpreterProxy->storeIntegerofObjectwithValue(1, rcvr, face->num_faces);
1032 	interpreterProxy->storeIntegerofObjectwithValue(2, rcvr, face->face_index);
1033 	interpreterProxy->storeIntegerofObjectwithValue(3, rcvr, face->face_flags);
1034 	interpreterProxy->storeIntegerofObjectwithValue(4, rcvr, face->style_flags);
1035 	interpreterProxy->storeIntegerofObjectwithValue(5, rcvr, face->num_glyphs);
1036 	interpreterProxy->pushRemappableOop(rcvr);
1037 	strOop = ftAllocateStringForPointer(face->family_name);
1038 	rcvr = interpreterProxy->popRemappableOop();
1039 	interpreterProxy->storePointerofObjectwithValue(6, rcvr, strOop);
1040 	interpreterProxy->pushRemappableOop(rcvr);
1041 	strOop = ftAllocateStringForPointer(face->style_name);
1042 	rcvr = interpreterProxy->popRemappableOop();
1043 	interpreterProxy->storePointerofObjectwithValue(7, rcvr, strOop);
1044 	interpreterProxy->storeIntegerofObjectwithValue(8, rcvr, face->num_fixed_sizes);
1045 	interpreterProxy->storeIntegerofObjectwithValue(10, rcvr, face->num_charmaps);
1046 	if (face->face_flags & FT_FACE_FLAG_SCALABLE) {
1047 		interpreterProxy->storeIntegerofObjectwithValue(13, rcvr, face->units_per_EM);
1048 		interpreterProxy->storeIntegerofObjectwithValue(14, rcvr, face->ascender);
1049 		interpreterProxy->storeIntegerofObjectwithValue(15, rcvr, face->descender);
1050 		interpreterProxy->storeIntegerofObjectwithValue(16, rcvr, face->height);
1051 		interpreterProxy->storeIntegerofObjectwithValue(17, rcvr, face->max_advance_width);
1052 		interpreterProxy->storeIntegerofObjectwithValue(18, rcvr, face->max_advance_height);
1053 		interpreterProxy->storeIntegerofObjectwithValue(19, rcvr, face->underline_position);
1054 		interpreterProxy->storeIntegerofObjectwithValue(20, rcvr, face->underline_thickness);
1055 	}
1056 	if (interpreterProxy->failed()) {
1057 		ftParameterError();
1058 		return null;
1059 	}
1060 	return null;
1061 }
1062 
primitiveLoadGlyph(void)1063 EXPORT(sqInt) primitiveLoadGlyph(void) {
1064 	sqInt rcvr;
1065 	FT_Face face;
1066 	sqInt index;
1067 	sqInt flags;
1068 
1069 	index = interpreterProxy->stackIntegerValue(1);
1070 	flags = interpreterProxy->stackIntegerValue(0);
1071 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
1072 	rcvr = interpreterProxy->stackValue(2);
1073 	if (interpreterProxy->failed()) {
1074 		ftParameterError();
1075 		return null;
1076 	}
1077 	face = ftHandleValueFromReceiver(rcvr);
1078 	if (face == null) {
1079 		interpreterProxy->primitiveFail();
1080 		return null;
1081 	}
1082 	errorCode = FT_Load_Glyph(face, index, flags);
1083 	interpreterProxy->success(errorCode == 0);
1084 	if (interpreterProxy->failed()) {
1085 		return null;
1086 	}
1087 	if (interpreterProxy->failed()) {
1088 		ftParameterError();
1089 		return null;
1090 	}
1091 	interpreterProxy->pop(2);
1092 	return null;
1093 }
1094 
1095 
1096 /*	Assumes that primitiveLoadGlyph:flags: has been called earlier to set face->glyph. */
1097 
primitiveLoadGlyphSlotFromFace(void)1098 EXPORT(sqInt) primitiveLoadGlyphSlotFromFace(void) {
1099 	sqInt rcvr;
1100 	FT_GlyphSlot gs;
1101 	sqInt gfOop;
1102 	sqInt btw;
1103 	FT_Face face;
1104 	FT_Glyph_Format *gfPtr;
1105 	sqInt aFace;
1106 
1107 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
1108 	aFace = interpreterProxy->stackValue(0);
1109 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2GlyphSlot"));
1110 	rcvr = interpreterProxy->stackValue(1);
1111 	if (interpreterProxy->failed()) {
1112 		ftParameterError();
1113 		return null;
1114 	}
1115 	errorCode = 0;
1116 	if ((interpreterProxy->slotSizeOf(rcvr)) < 8) {
1117 		interpreterProxy->primitiveFail();
1118 		return null;
1119 	}
1120 	face = ftHandleValueFromReceiver(aFace);
1121 	if (face == null) {
1122 		interpreterProxy->primitiveFail();
1123 		return null;
1124 	}
1125 	gs = face->glyph;
1126 	if (!(gs)) {
1127 		interpreterProxy->primitiveFail();
1128 		return null;
1129 	}
1130 	;
1131 	interpreterProxy->storePointerofObjectwithValue(0, rcvr, aFace);
1132 	interpreterProxy->storeIntegerofObjectwithValue(1, rcvr, gs->linearHoriAdvance);
1133 	interpreterProxy->storeIntegerofObjectwithValue(2, rcvr, gs->linearVertAdvance);
1134 	interpreterProxy->storeIntegerofObjectwithValue(3, rcvr, gs->advance.x);
1135 	interpreterProxy->storeIntegerofObjectwithValue(4, rcvr, gs->advance.y);
1136 	interpreterProxy->pushRemappableOop(rcvr);
1137 	gfOop = interpreterProxy->instantiateClassindexableSize(interpreterProxy->classByteArray(), sizeof(FT_Glyph_Format));
1138 	;
1139 	btw = BYTES_PER_WORD;
1140 	gfPtr = (FT_Glyph_Format *) pointerForOop(gfOop + btw);
1141 	;
1142 	if (interpreterProxy->failed()) {
1143 		return null;
1144 	}
1145 	*gfPtr = gs->format;
1146 	rcvr = interpreterProxy->popRemappableOop();
1147 	interpreterProxy->storePointerofObjectwithValue(5, rcvr, gfOop);
1148 	interpreterProxy->storeIntegerofObjectwithValue(6, rcvr, gs->bitmap_left);
1149 	interpreterProxy->storeIntegerofObjectwithValue(7, rcvr, gs->bitmap_top);
1150 	interpreterProxy->storeIntegerofObjectwithValue(8, rcvr, gs->metrics.width);
1151 	interpreterProxy->storeIntegerofObjectwithValue(9, rcvr, gs->metrics.height);
1152 	interpreterProxy->storeIntegerofObjectwithValue(10, rcvr, gs->metrics.horiBearingX);
1153 	interpreterProxy->storeIntegerofObjectwithValue(11, rcvr, gs->metrics.horiBearingY);
1154 	interpreterProxy->storeIntegerofObjectwithValue(12, rcvr, gs->metrics.horiAdvance);
1155 	interpreterProxy->storeIntegerofObjectwithValue(13, rcvr, gs->metrics.vertBearingX);
1156 	interpreterProxy->storeIntegerofObjectwithValue(14, rcvr, gs->metrics.vertBearingY);
1157 	interpreterProxy->storeIntegerofObjectwithValue(15, rcvr, gs->metrics.vertAdvance);
1158 	if (interpreterProxy->failed()) {
1159 		ftParameterError();
1160 		return null;
1161 	}
1162 	interpreterProxy->pop(1);
1163 	return null;
1164 }
1165 
1166 
1167 /*	Assumes that primitiveLoadGlyph:flags: has been called earlier to set face->glyph. */
1168 
primitiveLoadOutlineArraysFromFace(void)1169 EXPORT(sqInt) primitiveLoadOutlineArraysFromFace(void) {
1170 	sqInt i;
1171 	sqInt pointsSize;
1172 	FT_GlyphSlot gs;
1173 	FT_Face face;
1174 	sqInt rcvr;
1175 	char * tags;
1176 	short* contours;
1177 	sqInt contoursSize;
1178 	long * points;
1179 	sqInt aFace;
1180 	sqInt array;
1181 	sqInt array1;
1182 	sqInt array2;
1183 
1184 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
1185 	aFace = interpreterProxy->stackValue(0);
1186 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Outline"));
1187 	rcvr = interpreterProxy->stackValue(1);
1188 	if (interpreterProxy->failed()) {
1189 		ftParameterError();
1190 		return null;
1191 	}
1192 	errorCode = 0;
1193 	if ((interpreterProxy->slotSizeOf(rcvr)) < FT2OutlineInstSize) {
1194 		interpreterProxy->primitiveFail();
1195 		return null;
1196 	}
1197 	face = ftHandleValueFromReceiver(aFace);
1198 	if (face == null) {
1199 		interpreterProxy->primitiveFail();
1200 		return null;
1201 	}
1202 	gs = face->glyph;
1203 	if (!(gs)) {
1204 		interpreterProxy->primitiveFail();
1205 		return null;
1206 	}
1207 	;
1208 	pointsSize = gs->outline.n_points;
1209 	/* begin fetchWordArray:ofObject:assureSize: */
1210 	array = interpreterProxy->fetchPointerofObject(FT2OutlinePointsIndex, rcvr);
1211 	if ((interpreterProxy->isWords(array)) && ((interpreterProxy->slotSizeOf(array)) == (pointsSize * 2))) {
1212 		points = interpreterProxy->arrayValueOf(array);
1213 		goto l1;
1214 	}
1215 	points = null;
1216 l1:	/* end fetchWordArray:ofObject:assureSize: */;
1217 	if (points == null) {
1218 		interpreterProxy->primitiveFail();
1219 		return null;
1220 	}
1221 	/* begin fetchByteArray:ofObject:assureSize: */
1222 	array1 = interpreterProxy->fetchPointerofObject(FT2OutlineTagsIndex, rcvr);
1223 	if ((interpreterProxy->isBytes(array1)) && ((interpreterProxy->slotSizeOf(array1)) == pointsSize)) {
1224 		tags = interpreterProxy->arrayValueOf(array1);
1225 		goto l2;
1226 	}
1227 	tags = null;
1228 l2:	/* end fetchByteArray:ofObject:assureSize: */;
1229 	if (tags == null) {
1230 		interpreterProxy->primitiveFail();
1231 		return null;
1232 	}
1233 	for (i = 0; i <= (pointsSize - 1); i += 1) {
1234 		points[2 * i] = (gs->outline.points[i].x);
1235 		points[(2 * i) + 1] = (gs->outline.points[i].y);
1236 		tags[i] = (gs->outline.tags[i]);
1237 	}
1238 	contoursSize = gs->outline.n_contours;
1239 	/* begin fetchShortArray:ofObject:assureSize: */
1240 	array2 = interpreterProxy->fetchPointerofObject(FT2OutlineContoursIndex, rcvr);
1241 	if ((interpreterProxy->isWords(array2)) && ((interpreterProxy->slotSizeOf(array2)) == (((sqInt) (contoursSize + 1) >> 1)))) {
1242 		contours = interpreterProxy->arrayValueOf(array2);
1243 		goto l3;
1244 	}
1245 	contours = null;
1246 l3:	/* end fetchShortArray:ofObject:assureSize: */;
1247 	for (i = 0; i <= (contoursSize - 1); i += 1) {
1248 		contours[i] = (gs->outline.contours[i]);
1249 	}
1250 	if (interpreterProxy->failed()) {
1251 		ftParameterError();
1252 		return null;
1253 	}
1254 	interpreterProxy->pop(1);
1255 	return null;
1256 }
1257 
1258 
1259 /*	Assumes that primitiveLoadGlyph:flags: has been called earlier to set face->glyph. */
1260 
primitiveLoadOutlineSizesFromFace(void)1261 EXPORT(sqInt) primitiveLoadOutlineSizesFromFace(void) {
1262 	sqInt rcvr;
1263 	FT_GlyphSlot gs;
1264 	FT_Face face;
1265 	sqInt aFace;
1266 
1267 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Face"));
1268 	aFace = interpreterProxy->stackValue(0);
1269 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Outline"));
1270 	rcvr = interpreterProxy->stackValue(1);
1271 	if (interpreterProxy->failed()) {
1272 		ftParameterError();
1273 		return null;
1274 	}
1275 	errorCode = 0;
1276 	if ((interpreterProxy->slotSizeOf(rcvr)) < FT2OutlineInstSize) {
1277 		interpreterProxy->primitiveFail();
1278 		return null;
1279 	}
1280 	face = ftHandleValueFromReceiver(aFace);
1281 	if (face == null) {
1282 		interpreterProxy->primitiveFail();
1283 		return null;
1284 	}
1285 	gs = face->glyph;
1286 	if (!(gs)) {
1287 		interpreterProxy->primitiveFail();
1288 		return null;
1289 	}
1290 	;
1291 	interpreterProxy->storeIntegerofObjectwithValue(FT2OutlineContoursSizeIndex, rcvr, gs->outline.n_contours);
1292 	interpreterProxy->storeIntegerofObjectwithValue(FT2OutlinePointsSizeIndex, rcvr, gs->outline.n_points);
1293 	interpreterProxy->storeIntegerofObjectwithValue(FT2OutlineFlagsIndex, rcvr, gs->outline.flags);
1294 	if (interpreterProxy->failed()) {
1295 		ftParameterError();
1296 		return null;
1297 	}
1298 	interpreterProxy->pop(1);
1299 	return null;
1300 }
1301 
1302 
1303 /*	high byte is module error, low is generic error */
1304 
primitiveModuleErrorCode(void)1305 EXPORT(sqInt) primitiveModuleErrorCode(void) {
1306 	sqInt _return_value;
1307 
1308 	_return_value = interpreterProxy->positive32BitIntegerFor((FT_ERROR_MODULE(errorCode)));
1309 	if (interpreterProxy->failed()) {
1310 		ftParameterError();
1311 		return null;
1312 	}
1313 	interpreterProxy->popthenPush(1, _return_value);
1314 	return null;
1315 }
1316 
1317 
1318 /*	Fill in the receiver's (a FT2Face object) fields
1319 	from the address and fields of a newly opened FT_Face object. */
1320 
primitiveNewFaceFromFileAndIndex(void)1321 EXPORT(sqInt) primitiveNewFaceFromFileAndIndex(void) {
1322 	char translatedFilePath[1024];
1323 	sqInt rcvr;
1324 	size_t byteSize;
1325 	FT_Face face;
1326 	char *fontFilePath;
1327 	sqInt anInteger;
1328 
1329 	interpreterProxy->success(interpreterProxy->isBytes(interpreterProxy->stackValue(1)));
1330 	fontFilePath = ((char *) (interpreterProxy->firstIndexableField(interpreterProxy->stackValue(1))));
1331 	anInteger = interpreterProxy->stackIntegerValue(0);
1332 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
1333 	rcvr = interpreterProxy->stackValue(2);
1334 	if (interpreterProxy->failed()) {
1335 		ftParameterError();
1336 		return null;
1337 	}
1338 	;
1339 	errorCode = 0;
1340 	byteSize = interpreterProxy->byteSizeOf((oopForPointer( fontFilePath ) - BASE_HEADER_SIZE));
1341 	;
1342 	if (interpreterProxy->failed()) {
1343 		return null;
1344 	}
1345 	if (byteSize > 1000) {
1346 		interpreterProxy->success(0);
1347 		return null;
1348 	}
1349 	interpreterProxy->ioFilenamefromStringofLengthresolveAliases(translatedFilePath, fontFilePath, byteSize, 1);
1350 	errorCode = FT_New_Face(library, translatedFilePath, anInteger, &face);
1351 	;
1352 	;
1353 	interpreterProxy->success(errorCode == 0);
1354 	if (interpreterProxy->failed()) {
1355 		return null;
1356 	}
1357 	ftAllocateHandleInReceiverForPointer(face);
1358 	if (interpreterProxy->failed()) {
1359 		ftParameterError();
1360 		return null;
1361 	}
1362 	interpreterProxy->pop(2);
1363 	return null;
1364 }
1365 
1366 
1367 /*	Fill in the receiver's (a FT2Face object) fields
1368 	from the address and fields of a newly opened FT_Face object. */
1369 
primitiveNewMemoryFaceFromExternalMemoryAndIndex(void)1370 EXPORT(sqInt) primitiveNewMemoryFaceFromExternalMemoryAndIndex(void) {
1371 	sqInt rcvr;
1372 	void *memPointer;
1373 	FT_Face face;
1374 	sqInt aFreeTypeExternalMemory;
1375 	sqInt byteSize;
1376 	sqInt anInteger;
1377 
1378 	aFreeTypeExternalMemory = interpreterProxy->stackValue(2);
1379 	byteSize = interpreterProxy->stackIntegerValue(1);
1380 	anInteger = interpreterProxy->stackIntegerValue(0);
1381 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(3), "FT2Face"));
1382 	rcvr = interpreterProxy->stackValue(3);
1383 	if (interpreterProxy->failed()) {
1384 		ftParameterError();
1385 		return null;
1386 	}
1387 	;
1388 	errorCode = 0;
1389 	memPointer = ftHandleValueFromReceiver(aFreeTypeExternalMemory);
1390 	;
1391 	if (interpreterProxy->failed()) {
1392 		return null;
1393 	}
1394 	errorCode = FT_New_Memory_Face(library, memPointer, byteSize, anInteger, &face);
1395 	;
1396 	;
1397 	interpreterProxy->success(errorCode == 0);
1398 	if (interpreterProxy->failed()) {
1399 		return null;
1400 	}
1401 	ftAllocateHandleInReceiverForPointer(face);
1402 	if (interpreterProxy->failed()) {
1403 		ftParameterError();
1404 		return null;
1405 	}
1406 	interpreterProxy->pop(3);
1407 	return null;
1408 }
1409 
1410 
1411 /*	Assumes that primitiveLoadGlyph:flags: has been called earlier to set face->glyph. */
1412 
primitiveNumberOfOutlineCountours(void)1413 EXPORT(sqInt) primitiveNumberOfOutlineCountours(void) {
1414 	sqInt rcvr;
1415 	sqInt contoursSize;
1416 	FT_GlyphSlot gs;
1417 	sqInt aFace;
1418 	FT_Face face;
1419 	sqInt _return_value;
1420 
1421 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2GlyphSlot"));
1422 	rcvr = interpreterProxy->stackValue(0);
1423 	if (interpreterProxy->failed()) {
1424 		ftParameterError();
1425 		return null;
1426 	}
1427 	errorCode = 0;
1428 	if ((interpreterProxy->slotSizeOf(rcvr)) < FT2GlyphSlotInstSize) {
1429 		interpreterProxy->primitiveFail();
1430 		return null;
1431 	}
1432 	aFace = interpreterProxy->fetchPointerofObject(FT2GlyphSlotFaceIndex, rcvr);
1433 	face = ftHandleValueFromReceiver(aFace);
1434 	if (face == null) {
1435 		interpreterProxy->primitiveFail();
1436 		return null;
1437 	}
1438 	gs = face->glyph;
1439 	if (!(gs)) {
1440 		interpreterProxy->primitiveFail();
1441 		return null;
1442 	}
1443 	;
1444 	contoursSize = gs->outline.n_contours;
1445 	_return_value = ((contoursSize << 1) | 1);
1446 	if (interpreterProxy->failed()) {
1447 		ftParameterError();
1448 		return null;
1449 	}
1450 	interpreterProxy->popthenPush(1, _return_value);
1451 	return null;
1452 }
1453 
1454 
1455 /*	Render this face into the given form */
1456 
primitiveRenderGlyphIntoForm(void)1457 EXPORT(sqInt) primitiveRenderGlyphIntoForm(void) {
1458 	FT_Bitmap bitmap;
1459 	sqInt faceOop;
1460 	FT_Face face;
1461 	sqInt formOop;
1462 
1463 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "Form"));
1464 	formOop = interpreterProxy->stackValue(0);
1465 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
1466 	faceOop = interpreterProxy->stackValue(1);
1467 	if (interpreterProxy->failed()) {
1468 		ftParameterError();
1469 		return null;
1470 	}
1471 	face = ftHandleValueFromReceiver(faceOop);
1472 	if (face == null) {
1473 		interpreterProxy->primitiveFail();
1474 		return null;
1475 	}
1476 	ftInitBitmapfromForm(&bitmap, formOop);
1477 	if (interpreterProxy->failed()) {
1478 		return null;
1479 	}
1480 	errorCode = FT_Outline_Get_Bitmap(library, &face->glyph->outline, &bitmap);
1481 	interpreterProxy->success(errorCode == 0);
1482 	if (interpreterProxy->failed()) {
1483 		ftParameterError();
1484 		return null;
1485 	}
1486 	interpreterProxy->pop(1);
1487 	return null;
1488 }
1489 
1490 
1491 /*	Render this face into the given form */
1492 
primitiveRenderGlyphIntoFormWithRenderMode(void)1493 EXPORT(sqInt) primitiveRenderGlyphIntoFormWithRenderMode(void) {
1494 	FT_Bitmap bitmap;
1495 	sqInt faceOop;
1496 	FT_Face face;
1497 	sqInt formOop;
1498 	sqInt mode;
1499 
1500 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "Form"));
1501 	formOop = interpreterProxy->stackValue(1);
1502 	mode = interpreterProxy->stackIntegerValue(0);
1503 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
1504 	faceOop = interpreterProxy->stackValue(2);
1505 	if (interpreterProxy->failed()) {
1506 		ftParameterError();
1507 		return null;
1508 	}
1509 	face = ftHandleValueFromReceiver(faceOop);
1510 	if (face == null) {
1511 		interpreterProxy->primitiveFail();
1512 		return null;
1513 	}
1514 	ftInitBitmapfromFormrenderMode(&bitmap, formOop, mode);
1515 	if (interpreterProxy->failed()) {
1516 		return null;
1517 	}
1518 	errorCode = FT_Outline_Get_Bitmap(library, &face->glyph->outline, &bitmap);
1519 	interpreterProxy->success(errorCode == 0);
1520 	if (interpreterProxy->failed()) {
1521 		ftParameterError();
1522 		return null;
1523 	}
1524 	interpreterProxy->pop(2);
1525 	return null;
1526 }
1527 
primitiveResetErrorCode(void)1528 EXPORT(sqInt) primitiveResetErrorCode(void) {
1529 	sqInt oldError;
1530 	sqInt _return_value;
1531 
1532 	oldError = errorCode;
1533 	errorCode = 0;
1534 	_return_value = interpreterProxy->positive32BitIntegerFor(oldError);
1535 	if (interpreterProxy->failed()) {
1536 		ftParameterError();
1537 		return null;
1538 	}
1539 	interpreterProxy->popthenPush(1, _return_value);
1540 	return null;
1541 }
1542 
primitiveSetFaceCharMap(void)1543 EXPORT(sqInt) primitiveSetFaceCharMap(void) {
1544 	FT_Encoding encoding;
1545 	sqInt rcvr;
1546 	FT_Face face;
1547 	sqInt encodingString;
1548 
1549 	encodingString = interpreterProxy->stackValue(0);
1550 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
1551 	rcvr = interpreterProxy->stackValue(1);
1552 	if (interpreterProxy->failed()) {
1553 		ftParameterError();
1554 		return null;
1555 	}
1556 	face = ftHandleValueFromReceiver(rcvr);
1557 	if (face == null) {
1558 		interpreterProxy->primitiveFail();
1559 		return null;
1560 	}
1561 	encoding = ftEncodingValueFromString(encodingString);
1562 	if (interpreterProxy->failed()) {
1563 		return null;
1564 	}
1565 	;
1566 	errorCode = FT_Select_Charmap(face, encoding);
1567 	interpreterProxy->success(errorCode == 0);
1568 	if (interpreterProxy->failed()) {
1569 		return null;
1570 	}
1571 	if (interpreterProxy->failed()) {
1572 		ftParameterError();
1573 		return null;
1574 	}
1575 	interpreterProxy->pop(1);
1576 	return null;
1577 }
1578 
primitiveSetPixelSizes(void)1579 EXPORT(sqInt) primitiveSetPixelSizes(void) {
1580 	sqInt rcvr;
1581 	FT_Face face;
1582 	sqInt x;
1583 	sqInt y;
1584 
1585 	x = interpreterProxy->stackIntegerValue(1);
1586 	y = interpreterProxy->stackIntegerValue(0);
1587 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
1588 	rcvr = interpreterProxy->stackValue(2);
1589 	if (interpreterProxy->failed()) {
1590 		ftParameterError();
1591 		return null;
1592 	}
1593 	face = ftHandleValueFromReceiver(rcvr);
1594 	if (face == null) {
1595 		interpreterProxy->primitiveFail();
1596 		return null;
1597 	}
1598 	errorCode = FT_Set_Pixel_Sizes(face, x, y);
1599 	interpreterProxy->success(errorCode == 0);
1600 	if (interpreterProxy->failed()) {
1601 		return null;
1602 	}
1603 	if (interpreterProxy->failed()) {
1604 		ftParameterError();
1605 		return null;
1606 	}
1607 	interpreterProxy->pop(2);
1608 	return null;
1609 }
1610 
primitiveSetTransform(void)1611 EXPORT(sqInt) primitiveSetTransform(void) {
1612 	sqInt *matrixsqIntPtr;
1613 	sqInt *deltasqIntPtr;
1614 	FT_Face face;
1615 	FT_Vector delta;
1616 	FT_Matrix matrix;
1617 	sqInt rcvr;
1618 	sqInt matrixWordArray;
1619 	sqInt deltaWordArray;
1620 
1621 	matrixWordArray = interpreterProxy->stackValue(1);
1622 	deltaWordArray = interpreterProxy->stackValue(0);
1623 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(2), "FT2Face"));
1624 	rcvr = interpreterProxy->stackValue(2);
1625 	if (interpreterProxy->failed()) {
1626 		ftParameterError();
1627 		return null;
1628 	}
1629 	face = ftHandleValueFromReceiver(rcvr);
1630 	if (face == null) {
1631 		interpreterProxy->primitiveFail();
1632 		return null;
1633 	}
1634 	matrixsqIntPtr = interpreterProxy->arrayValueOf(matrixWordArray);
1635 	deltasqIntPtr = interpreterProxy->arrayValueOf(deltaWordArray);
1636 	delta.x = deltasqIntPtr[0]; delta.y = deltasqIntPtr[1];;
1637 	matrix.xx = matrixsqIntPtr[0]; matrix.xy = matrixsqIntPtr[1];
1638 		matrix.yx = matrixsqIntPtr[2]; matrix.yy = matrixsqIntPtr[3]; ;
1639 	if (!(interpreterProxy->failed())) {
1640 		FT_Set_Transform( face, &matrix, &delta);
1641 	}
1642 	if (interpreterProxy->failed()) {
1643 		ftParameterError();
1644 		return null;
1645 	}
1646 	interpreterProxy->pop(2);
1647 	return null;
1648 }
1649 
primitiveTransformFaceGlyphSlotOutline(void)1650 EXPORT(sqInt) primitiveTransformFaceGlyphSlotOutline(void) {
1651 	FT_Matrix matrix;
1652 	sqInt rcvr;
1653 	sqInt *matrixsqIntPtr;
1654 	FT_Face face;
1655 	sqInt matrixWordArray;
1656 
1657 	matrixWordArray = interpreterProxy->stackValue(0);
1658 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
1659 	rcvr = interpreterProxy->stackValue(1);
1660 	if (interpreterProxy->failed()) {
1661 		ftParameterError();
1662 		return null;
1663 	}
1664 	face = ftHandleValueFromReceiver(rcvr);
1665 	if (face == null) {
1666 		interpreterProxy->primitiveFail();
1667 		return null;
1668 	}
1669 	matrixsqIntPtr = interpreterProxy->arrayValueOf(matrixWordArray);
1670 	matrix.xx = matrixsqIntPtr[0]; matrix.xy = matrixsqIntPtr[1];
1671 		matrix.yx = matrixsqIntPtr[2]; matrix.yy = matrixsqIntPtr[3]; ;
1672 	if (!(interpreterProxy->failed())) {
1673 		FT_Outline_Transform( &face->glyph->outline, &matrix );
1674 	}
1675 	if (interpreterProxy->failed()) {
1676 		ftParameterError();
1677 		return null;
1678 	}
1679 	interpreterProxy->pop(1);
1680 	return null;
1681 }
1682 
primitiveTranslateFaceGlyphSlotOutline(void)1683 EXPORT(sqInt) primitiveTranslateFaceGlyphSlotOutline(void) {
1684 	sqInt rcvr;
1685 	FT_Vector delta;
1686 	sqInt *deltasqIntPtr;
1687 	FT_Face face;
1688 	sqInt deltaWordArray;
1689 
1690 	deltaWordArray = interpreterProxy->stackValue(0);
1691 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(1), "FT2Face"));
1692 	rcvr = interpreterProxy->stackValue(1);
1693 	if (interpreterProxy->failed()) {
1694 		ftParameterError();
1695 		return null;
1696 	}
1697 	face = ftHandleValueFromReceiver(rcvr);
1698 	if (face == null) {
1699 		interpreterProxy->primitiveFail();
1700 		return null;
1701 	}
1702 	deltasqIntPtr = interpreterProxy->arrayValueOf(deltaWordArray);
1703 	delta.x = deltasqIntPtr[0]; delta.y = deltasqIntPtr[1];;
1704 	if (!(interpreterProxy->failed())) {
1705 		FT_Outline_Translate( &face->glyph->outline, delta.x, delta.y );
1706 	}
1707 	if (interpreterProxy->failed()) {
1708 		ftParameterError();
1709 		return null;
1710 	}
1711 	interpreterProxy->pop(1);
1712 	return null;
1713 }
1714 
primitiveVersion(void)1715 EXPORT(sqInt) primitiveVersion(void) {
1716 	int aminor;
1717 	int apatch;
1718 	sqInt rcvr;
1719 	int amajor;
1720 
1721 	interpreterProxy->success(interpreterProxy->isKindOf(interpreterProxy->stackValue(0), "FT2Version"));
1722 	rcvr = interpreterProxy->stackValue(0);
1723 	if (interpreterProxy->failed()) {
1724 		ftParameterError();
1725 		return null;
1726 	}
1727 	errorCode = 0;
1728 	FT_Library_Version(library, &amajor, &aminor, &apatch);
1729 	;
1730 	interpreterProxy->storeIntegerofObjectwithValue(0, rcvr, amajor);
1731 	;
1732 	interpreterProxy->storeIntegerofObjectwithValue(1, rcvr, aminor);
1733 	;
1734 	interpreterProxy->storeIntegerofObjectwithValue(2, rcvr, apatch);
1735 	if (interpreterProxy->failed()) {
1736 		ftParameterError();
1737 		return null;
1738 	}
1739 	return null;
1740 }
1741 
1742 
1743 /*	Note: This is coded so that is can be run from Squeak. */
1744 
setInterpreter(struct VirtualMachine * anInterpreter)1745 EXPORT(sqInt) setInterpreter(struct VirtualMachine*anInterpreter) {
1746 	sqInt ok;
1747 
1748 	interpreterProxy = anInterpreter;
1749 	ok = interpreterProxy->majorVersion() == VM_PROXY_MAJOR;
1750 	if (ok == 0) {
1751 		return 0;
1752 	}
1753 	ok = interpreterProxy->minorVersion() >= VM_PROXY_MINOR;
1754 	return ok;
1755 }
1756 
shutdownModule(void)1757 EXPORT(sqInt) shutdownModule(void) {
1758 	errorCode = FT_Done_FreeType(library);
1759 	if (errorCode == 0) {
1760 		library = null;
1761 	}
1762 	return errorCode == 0;
1763 }
1764 
1765 
1766 #ifdef SQUEAK_BUILTIN_PLUGIN
1767 
1768 
1769 void* FT2Plugin_exports[][3] = {
1770 	{"FT2Plugin", "primitiveTransformFaceGlyphSlotOutline", (void*)primitiveTransformFaceGlyphSlotOutline},
1771 	{"FT2Plugin", "primitiveModuleErrorCode", (void*)primitiveModuleErrorCode},
1772 	{"FT2Plugin", "primitiveLoadFaceFields", (void*)primitiveLoadFaceFields},
1773 	{"FT2Plugin", "primitiveGetFaceGlyphName", (void*)primitiveGetFaceGlyphName},
1774 	{"FT2Plugin", "shutdownModule", (void*)shutdownModule},
1775 	{"FT2Plugin", "primitiveGetSfntTableOS2", (void*)primitiveGetSfntTableOS2},
1776 	{"FT2Plugin", "primitiveDoneFace", (void*)primitiveDoneFace},
1777 	{"FT2Plugin", "primitiveNewFaceFromFileAndIndex", (void*)primitiveNewFaceFromFileAndIndex},
1778 	{"FT2Plugin", "primitiveLibraryHandle", (void*)primitiveLibraryHandle},
1779 	{"FT2Plugin", "primitiveGetKerningLeftRight", (void*)primitiveGetKerningLeftRight},
1780 	{"FT2Plugin", "primitiveLoadOutlineArraysFromFace", (void*)primitiveLoadOutlineArraysFromFace},
1781 	{"FT2Plugin", "primitiveEmboldenFaceGlyphSlotOutline", (void*)primitiveEmboldenFaceGlyphSlotOutline},
1782 	{"FT2Plugin", "primitiveLoadGlyph", (void*)primitiveLoadGlyph},
1783 	{"FT2Plugin", "getModuleName", (void*)getModuleName},
1784 	{"FT2Plugin", "primitiveSetTransform", (void*)primitiveSetTransform},
1785 	{"FT2Plugin", "primitiveResetErrorCode", (void*)primitiveResetErrorCode},
1786 	{"FT2Plugin", "primitiveLoadGlyphSlotFromFace", (void*)primitiveLoadGlyphSlotFromFace},
1787 	{"FT2Plugin", "primitiveNumberOfOutlineCountours", (void*)primitiveNumberOfOutlineCountours},
1788 	{"FT2Plugin", "primitiveSetPixelSizes", (void*)primitiveSetPixelSizes},
1789 	{"FT2Plugin", "primitiveTranslateFaceGlyphSlotOutline", (void*)primitiveTranslateFaceGlyphSlotOutline},
1790 	{"FT2Plugin", "setInterpreter", (void*)setInterpreter},
1791 	{"FT2Plugin", "primitiveGetFaceCharMapsIntoArray", (void*)primitiveGetFaceCharMapsIntoArray},
1792 	{"FT2Plugin", "primitiveHasKerning", (void*)primitiveHasKerning},
1793 	{"FT2Plugin", "primitiveGetFaceCharIndex", (void*)primitiveGetFaceCharIndex},
1794 	{"FT2Plugin", "primitiveCopyToExternalMemory", (void*)primitiveCopyToExternalMemory},
1795 	{"FT2Plugin", "primitiveLoadFaceBbox", (void*)primitiveLoadFaceBbox},
1796 	{"FT2Plugin", "primitiveDoneFacePreserveFields", (void*)primitiveDoneFacePreserveFields},
1797 	{"FT2Plugin", "primitiveNewMemoryFaceFromExternalMemoryAndIndex", (void*)primitiveNewMemoryFaceFromExternalMemoryAndIndex},
1798 	{"FT2Plugin", "primitiveGetFaceCharMap", (void*)primitiveGetFaceCharMap},
1799 	{"FT2Plugin", "primitiveSetFaceCharMap", (void*)primitiveSetFaceCharMap},
1800 	{"FT2Plugin", "primitiveLoadOutlineSizesFromFace", (void*)primitiveLoadOutlineSizesFromFace},
1801 	{"FT2Plugin", "primitiveFreeExternalMemory", (void*)primitiveFreeExternalMemory},
1802 	{"FT2Plugin", "primitiveErrorCode", (void*)primitiveErrorCode},
1803 	{"FT2Plugin", "initialiseModule", (void*)initialiseModule},
1804 	{"FT2Plugin", "primitiveGetPostscriptName", (void*)primitiveGetPostscriptName},
1805 	{"FT2Plugin", "primitiveErrorString", (void*)primitiveErrorString},
1806 	{"FT2Plugin", "primitiveLoadCharacter", (void*)primitiveLoadCharacter},
1807 	{"FT2Plugin", "primitiveVersion", (void*)primitiveVersion},
1808 	{"FT2Plugin", "primitiveRenderGlyphIntoForm", (void*)primitiveRenderGlyphIntoForm},
1809 	{"FT2Plugin", "primitiveRenderGlyphIntoFormWithRenderMode", (void*)primitiveRenderGlyphIntoFormWithRenderMode},
1810 	{NULL, NULL, NULL}
1811 };
1812 
1813 
1814 #endif /* ifdef SQ_BUILTIN_PLUGIN */
1815 
1816