package provide Freetype::ftbdf 0.1

if {![info exists _source([file tail [info script]])]} {
package require Freetype::ft2build
package require $FT_FREETYPE

set BDF_PROPERTY_TYPE_NONE     0
set BDF_PROPERTY_TYPE_ATOM     1
set BDF_PROPERTY_TYPE_INTEGER  2
set BDF_PROPERTY_TYPE_CARDINAL 3

# atom, integer, cardinal is union
ft::struct define BDF_Property {
    {type     int    - int       1 int}
    {atom     string * char      1 void}
    {integer  int    - FT_Int32  1 void}
    {cardinal int    - FT_UInt32 1 pointer}
}
oo::define BDF_Property method get {varName} {
    if {$varName eq "atom"} {
        if {[next type] ne $::BDF_PROPERTY_TYPE_ATOM} {
            return {}
        }
    }
    next $varName
}
oo::define BDF_Property method set {varName varValue} {
    if {$varName eq "atom"} {
        if {[next type] ne $::BDF_PROPERTY_TYPE_ATOM} {
            return
        }
    }
    next $varName $varValue
}

::ffidl::callout _FT_Get_BDF_Charset_ID {pointer pointer-var pointer-var} int \
    [::ffidl::symbol $::ft::lib FT_Get_BDF_Charset_ID]
proc FT_Get_BDF_Charset_ID {face charset_encodingVarName charset_registryVarName} {
    set p_enc [::ft::_bytearray_from_pointer 0]
    set p_reg [::ft::_bytearray_from_pointer 0]

    set result [_FT_Get_BDF_Charset_ID [$face getPointer] p_enc p_reg]

    set p_encoding [::ft::_bytearray_to_pointer $p_enc]
    set p_registry [::ft::_bytearray_to_pointer $p_reg]

    upvar $charset_encodingVarName enc
    upvar $charset_registryVarName reg
    set enc [::ffidl::new-string $p_encoding -1]
    set reg [::ffidl::new-string $p_registry -1]
    return $result
}

::ffidl::callout _FT_Get_BDF_Property {pointer pointer-utf8 pointer} int \
    [::ffidl::symbol $::ft::lib FT_Get_BDF_Property]
proc FT_Get_BDF_Property {face prop_name propertyVarName} {
    upvar $propertyVarName property

    if {[info exists property] &&
        [info object isa object $property] &&
        [info object isa typeof $property BDF_Property]} {
        set adr [$property getPointer]
    } else {
        set _temp [BDF_Property new]
        set adr [$_temp getPointer]
    }

    set result [_FT_Get_BDF_Property [$face getPointer] $prop_name $adr]
    if {$result == 0 && [info exists _temp]} {
        set property $_temp
    }
    return $result
}

set _source([file tail [info script]]) 1
}
