# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: font.tcl,v 2.24 2006/01/28 19:16:59 jfontain Exp $


class font {

    catch widget::widget         ;# force widget class load for static data members visibility below, in case of package utilization

    proc font {this} {error {object-less class}}

    proc sizes {family {feedback 0}} {                                                                                  ;# in points
        variable cache

        if {![info exists cache($family)]} {
            if {$feedback} {
                lifoLabel::push $global::messenger [format [mc {retrieving all %s font sizes...}] $family]
                busy 1
            }
            for {set size 0} {$size <= 64} {incr size} {
                set sizes([::font actual [list $family $size] -size]) {}
            }
            set cache($family) [lsort -integer [array names sizes]]
            if {$feedback} {
                busy 0
                lifoLabel::pop $global::messenger
            }
        }
        return $cache($family)
    }

    proc closest {family size} {                                                                      ;# find font with similar size
        set sizes [font::sizes $family]
        if {[lsearch -exact $sizes $size] >= 0} {return $size}
        set ratio $global::32BitIntegerMaximum
        foreach value $sizes {
            if {(abs($value - $size) / double($size)) < $ratio} {
                set closest $value
                set ratio [expr {abs($value - $size) / double($size)}]
            }
        }
        return $closest
    }

    proc create {array name operation} {
        variable family
        variable size

        if {[info exists ($name)]} return
        switch $name {
            smallNormal {                                    ;# small size is 80% of medium size, but with a lower visible boundary:
                set value [minimum [maximum [expr {round(0.8 * $size)}] 10] [expr {$size - 1}]]      ;# minimize on windows platform
                set (smallNormal) [::font create -family $family -size [closest $family $value]]
            }
            tinyNormal {
                set value [minimum 10 [expr {$size - 1}]]                                            ;# minimize on windows platform
                set (tinyNormal) [::font create -family $family -size [closest $family $value]]
            }
            fixedNormal {
                set (fixedNormal) [::font create -family courier -size [closest courier $size]]
            }
        }
    }

    variable family [::font actual $widget::option(button,font) -family]
    variable size [::font actual $widget::option(button,font) -size]
    set (mediumNormal) [::font create -family $family -size $size]
    set (mediumBold) [::font create -family $family -size $size -weight bold]
    set (mediumItalic) [::font create -family $family -size $size -slant italic]
    set (mediumBoldItalic) [::font create -family $family -size $size -weight bold -slant italic]
    foreach name [list smallNormal tinyNormal fixedNormal] {
        trace add variable font::($name) read font::create              ;# delay long operations until the time when they are needed
    }
}
