Mercurial > repos > tabletprog
view 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 source
{ _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 } } }