#
# Output a font IVS table to html.
# 

set font_file [file join [file dir [info script]] ../tests/fonts/TakaoExMincho.ttf]

# append a path to freetype tcl binding.
lappend auto_path [file normalize [file join [file dir [info script]] ../../]]

package require Freetype
package require Tk ;# required to GIF output.

set error [FT_Init_FreeType lib]
if {$error != 0} {error $::ft::errors($eoor)}

set error [FT_New_Face $lib $font_file 0 face]
if {$error != 0} {error $::ft::errors($error)}

set vs_list [FT_Face_GetVariantSelectors $face]
set char_list [list]
foreach vs $vs_list {
    lappend char_list {*}[FT_Face_GetCharsOfVariant $face $vs]
}

set char_list [lsort -uniq $char_list]

#size (point)
proc output_img {face size index uni vs} {
    set size [::ft::_f26dot6_from_double $size]
    set error [FT_Set_Char_Size $face $size $size 98 98]
    if {$error != 0} {error $::ft::errors($error)}

    set error [FT_Load_Glyph $face $index $::FT_LOAD_DEFAULT]
    if {$error != 0} {error $::ft::errors($error)}

    set error [FT_Render_Glyph [$face get glyph] $::FT_RENDER_MODE_NORMAL]
    if {$error != 0} {error $::ft::errors($error)}

    set ft_bitmap [[$face get glyph] get bitmap]
    set width [$ft_bitmap get width]
    set height [$ft_bitmap get rows]
    set buffer [$ft_bitmap get buffer]
    set bin $buffer
    set rgblist [list]
    foreach {v} [::ft::_bytearray_to_list $bin uint8] {
        set v [expr {0xFF - $v}] ;#invert mono
        lappend rgblist [format "#%02X%02X%02X" $v $v $v]
    }

    set data [list]
    set i 0
    for {set y 0} {$y < $height} {incr y} {
        set row [list]
        for {set x 0} {$x < $width} {incr x} {
            lappend row [lindex $rgblist $i]
            incr i
        }
        lappend data $row
    }

    set img [image create photo -width $width -height $height]
    $img put $data

    set img_file img_[format %04X $uni]_[format %05X $vs].gif
    $img write $img_file -background #ffffff -format gif

    image delete $img
    #return $index
    return "<img src=$img_file>"
}

proc output_html {face dir char_list vs_list} {
    if {[file exists $dir] == 0} {
        file mkdir $dir
    }
    cd $dir
    
    set size 48

    set fp [open index.html w]
    fconfigure $fp -encoding utf-8
    puts $fp "<html>"
    puts $fp "<head>"
    puts $fp "<meta content=\"text/html; charset=UTF-8\" http-equiv=\"content-type\">"
    puts $fp "<style type=\"text/css\">"
    puts $fp ".sysfont {"
    puts $fp "  font-size: ${size}pt;"
    puts $fp "}"
    puts $fp "</style>"
    puts $fp "</head>"
    puts $fp "<body>"

    puts $fp "<table border=1>"

    puts $fp "<tr>"
    puts $fp "<td>UNICODE</td>"
    puts $fp "<td>Font</td>"
    puts $fp "<td>Default</td>"
    foreach vs $vs_list {
        puts $fp "<td>[format %05X $vs]</td>"
    }
    puts $fp "</tr>"

    foreach char $char_list {
        puts $fp "<tr>"
        puts $fp "<td>U+[format %04X $char]</td>"
        eval set unichar \\u[format %04x $char]
        puts $fp "<td><span class=sysfont>$unichar</span></td>"

        set index [FT_Get_Char_Index $face $char]
        puts $fp "<td>[output_img $face $size $index $char 0]</td>"

        foreach vs $vs_list {
            set index [FT_Face_GetCharVariantIndex $face $char $vs]
            if {$index != 0} {
                puts $fp "<td>[output_img $face $size $index $char $vs]</td>"
            } else {
                puts $fp "<td></td>"
            }
        }
        puts $fp "</tr>"
    }
    puts $fp "</table>"

    puts $fp "</body>"
    puts $fp "</html>"
    close $fp
}

output_html $face [file dir [info script]]/IVS_Table $char_list $vs_list

set error [FT_Done_Face $face]
if {$error != 0} {error $::ft::errors($error)}

set error [FT_Done_FreeType $lib]
if {$error != 0} {error $::ft::errors($error)}

destroy .
exit

