Mercurial > repos > tabletprog
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/modules/freetype.tp Sun Mar 22 19:10:32 2015 -0700 @@ -0,0 +1,315 @@ +{ + _helper <- #{ + includeSystemHeader: "ft2build.h" + includeSystemHeader: FT_FREETYPE_H + llMessage: newFace withVars: { + libOpaque <- cpointer ptr + opath <- object ptr + oindex <- object ptr + path <- string ptr + index <- obj_int32 ptr + faceOpaque <- cpointer ptr + rescode <- int32_t + } andCode: :libOpaque opath oindex { + path <- (mcall: string 1 opath) castTo: (string ptr) + index <- (mcall: int32 1 oindex) castTo: (obj_int32 ptr) + faceOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 + rescode <- FT_New_Face: (libOpaque val) (path data) (index num) ((addr_of: (faceOpaque val)) castTo: (FT_Face ptr)) + if: rescode = 0 { + mcall: value 2 option faceOpaque + } else: { + mcall: none 1 option + } + } + + llMessage: getFirstChar withVars: { + opaque <- cpointer ptr + glyphIndex <- obj_uint32 ptr + charCode <- obj_uint32 ptr + makeChar <- lambda ptr + } andCode: :opaque makeChar { + glyphIndex <- make_object: (addr_of: obj_uint32_meta) NULL 0 + charCode <- make_object: (addr_of: obj_uint32_meta) NULL 0 + charCode num!: (FT_Get_First_Char: (opaque val) (addr_of: (glyphIndex num))) + ccall: makeChar 2 charCode glyphIndex + } + + llMessage: getNextChar withVars: { + opaque <- cpointer ptr + ocurChar <- object ptr + curChar <- obj_uint32 ptr + glyphIndex <- obj_uint32 ptr + charCode <- obj_uint32 ptr + makeChar <- lambda ptr + } andCode: :opaque ocurChar makeChar { + curChar <- (mcall: uint32 1 ocurChar) castTo: (obj_uint32 ptr) + glyphIndex <- make_object: (addr_of: obj_uint32_meta) NULL 0 + charCode <- make_object: (addr_of: obj_uint32_meta) NULL 0 + charCode num!: (FT_Get_Next_Char: (opaque val) (curChar num) (addr_of: (glyphIndex num))) + ccall: makeChar 2 charCode glyphIndex + } + } + + _makeSlot <- :opaque { + #{ + llProperty: slot withType: FT_GlyphSlot + llMessage: _ptr_init withVars: { + opaque <- cpointer ptr + } andCode: :opaque { + slot <- opaque val + self + } + + llMessage: linearHoriAdvance withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (slot linearHoriAdvance) + intret + } + + llMessage: linearVertAdvance withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (slot linearVertAdvance) + intret + } + + llMessage: bitmapTop withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (slot bitmap_top) + intret + } + + llMessage: bitmapLeft withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (slot bitmap_left) + intret + } + + llMessage: bitmapRows withVars: { + uintret <- obj_uint32 ptr + } andCode: { + uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 + uintret num!: ((addr_of: (slot bitmap)) rows) + uintret + } + + llMessage: bitmapWidth withVars: { + uintret <- obj_uint32 ptr + } andCode: { + uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 + uintret num!: ((addr_of: (slot bitmap)) width) + uintret + } + + llMessage: bitmapPitch withVars: { + intret <- obj_int32 ptr + } andCode: { + intret <- make_object: (addr_of: obj_uint32_meta) NULL 0 + intret num!: ((addr_of: (slot bitmap)) pitch) + intret + } + + llMessage: bitmapData withVars: { + opaque <- cpointer ptr + size <- obj_int32 ptr + } andCode: { + opaque <- make_object: (addr_of: cpointer_meta) NULL 0 + opaque val!: ((addr_of: (slot bitmap)) buffer) + size <- make_object: (addr_of: obj_int32_meta) NULL 0 + size num!: ((addr_of: (slot bitmap)) rows) * ((addr_of: (slot bitmap)) pitch) + mcall: fromOpaque:withSize 3 bytearray opaque size + } + + llMessage: renderGlyph withVars: { + omode <- object ptr + mode <- obj_uint32 ptr + intret <- obj_int32 ptr + } andCode: :omode { + mode <- (mcall: uint32 1 omode) castTo: (obj_uint32 ptr) + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (FT_Render_Glyph: slot (mode num)) + intret + } + } _ptr_init: opaque + } + + _makeChar <- :_charcode _glyph { + #{ + charcode <- _charcode + glyph <- _glyph + } + } + _makeFace <- :opaque { + #{ + llProperty: face withType: FT_Face + llProperty: makeSlot withType: (lambda ptr) + llMessage: _ptr_init withVars: { + opaque <- cpointer ptr + makeSlotLambda <- lambda ptr + } andCode: :opaque makeSlotLambda { + face <- opaque val + makeSlot <- makeSlotLambda + self + } + + llMessage: faceOpaque withVars: { + opaque <- cpointer ptr + } andCode: { + opaque <- make_object: (addr_of: cpointer_meta) NULL 0 + opaque val!: face + opaque + } + + llMessage: setCharWidth:height:hRes:vRes withVars: { + ohsize <- object ptr + hsize <- obj_float32 ptr + ovsize <- object ptr + vsize <- obj_float32 ptr + ohres <- object ptr + hres <- obj_int32 ptr + ovres <- object ptr + vres <- obj_int32 ptr + intret <- obj_int32 ptr + } andCode: :ohsize ovsize :ohres :ovres { + hsize <- (mcall: f32 1 ohsize) castTo: (obj_float32 ptr) + vsize <- (mcall: f32 1 ovsize) castTo: (obj_float32 ptr) + hres <- (mcall: int32 1 ohres) castTo: (obj_int32 ptr) + vres <- (mcall: int32 1 ovres) castTo: (obj_int32 ptr) + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (FT_Set_Char_Size: face (hsize num) * 64 (vsize num) * 64 (hres num) (vres num)) + intret + } + + setCharSize:res <- :size :res { + setCharWidth: size height: size hRes: res vRes: res + } + + llMessage: getCharIndex withVars: { + ocharcode <- object ptr + charcode <- obj_uint32 ptr + uintret <- obj_uint32 ptr + } andCode: :ocharcode { + charcode <- (mcall: uint32 1 ocharcode) castTo: (obj_uint32 ptr) + uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 + uintret num!: (FT_Get_Char_Index: face (charcode num)) + uintret + } + + llMessage: loadGlyph:flags withVars: { + oindex <- object ptr + index <- obj_uint32 ptr + oflags <- object ptr + flags <- obj_uint32 ptr + intret <- obj_int32 ptr + } andCode: :oindex :oflags { + index <- (mcall: uint32 1 oindex) castTo: (obj_uint32 ptr) + flags <- (mcall: uint32 1 oflags) castTo: (obj_uint32 ptr) + intret <- make_object: (addr_of: obj_int32_meta) NULL 0 + intret num!: (FT_Load_Glyph: face (index num) (flags num)) + intret + } + + llMessage: glyphSlot withVars: { + opaque <- cpointer ptr + } andCode: { + opaque <- make_object: (addr_of: cpointer_meta) NULL 0 + opaque val!: (face glyph) + ccall: makeSlot 1 opaque + } + + firstChar <- { + _helper getFirstChar: faceOpaque _makeChar + } + + nextChar <- :curChar { + _helper getNextChar: faceOpaque curChar _makeChar + } + + charmap <- { + d <- dict hash + char <- firstChar + d set: (char charcode) (char glyph) + while: { (char glyph) != 0u32 } do: { + char <- nextChar: (char charcode) + d set: (char charcode) (char glyph) + } + d + } + } _ptr_init: opaque _makeSlot + } + + _constant <- macro: :name cname { + quote: (llMessage: name withVars: { + uintret <- obj_uint32 ptr + } andCode: { + uintret <- make_object: (addr_of: obj_uint32_meta) NULL 0 + uintret num!: cname + uintret + }) + } + + _loadFlags <- #{ + _constant: default FT_LOAD_DEFAULT + _constant: noScale FT_LOAD_NO_SCALE + _constant: noHinting FT_LOAD_NO_HINTING + _constant: render FT_LOAD_RENDER + _constant: noBitmap FT_LOAD_NO_BITMAP + _constant: verticalLayout FT_LOAD_VERTICAL_LAYOUT + _constant: forceAuthohint FT_LOAD_FORCE_AUTOHINT + _constant: pedantic FT_LOAD_PEDANTIC + _constant: noRecurse FT_LOAD_NO_RECURSE + _constant: ignoreTransform FT_LOAD_IGNORE_TRANSFORM + _constant: monochrome FT_LOAD_MONOCHROME + _constant: linearDesign FT_LOAD_LINEAR_DESIGN + _constant: noAutohint FT_LOAD_NO_AUTOHINT + _constant: color FT_LOAD_COLOR + } + + #{ + init <- { + + #{ + includeSystemHeader: "ft2build.h" + includeSystemHeader: FT_FREETYPE_H + llProperty: library withType: FT_Library + + llMessage: _init withVars: { + } andCode: { + FT_Init_FreeType: (addr_of: library) + self + } + + llMessage: libraryOpaque withVars: { + libOpaque <- cpointer ptr + } andCode: { + libOpaque <- make_object: (addr_of: cpointer_meta) NULL 0 + libOpaque val!: library + libOpaque + } + + faceFromPath:index <- :path :index { + (_helper newFace: libraryOpaque path index) value: :opaque { + option value: (_makeFace: opaque) + } none: { + option none + } + } + + llMessage: destroy withVars: { + } andCode: { + FT_Done_FreeType: library + self + } + } _init + } + + loadFlags <- { _loadFlags } + } +} \ No newline at end of file