programming.nbk: Home | Index | Next Page: Tcl | Previous Page: struct tm* localtime(const time_t* timer );

 table_code

package require Tk 8.4
wm withdraw .

proc table_display {name between} {
    append txt "#pre\n"
    # load the table data page, split it into a list, one element per line
    set table1 [split [pageget $name] "\n"]
    append txt $table1
    append txt "\n\n"
    # split each line into a list, one element per cell
    foreach z $table1 {
        set t [split $z ~]
        set y {}
        foreach x $t {
            lappend y [string trim $x]
        }
        lappend table2 $y
    }
    append txt $table2
    append txt "\n\n"

    # replace each cell element with a list of the raw text plus font information
    set widths [list 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
    foreach z $table2 {
        set i 0
        set y {}
        foreach x $z {
            set x [normalizeCell $x]
            lappend y $x
            set cellfont [lindex $x 0]
            set cellfont [fontfromdigits $cellfont]
            set celltext [lindex $x 1]
            set w [font measure $cellfont $celltext]
            if {$w > [lindex $widths $i]} {lset widths $i $w}
            append txt "|$celltext| $cellfont width = $w\n"
            incr i 1
        }
        lappend table3 $y
    }
    append txt $table3
    append txt "\nwidths = $widths"
    append txt "\n#unpre\n"

    # go through the cells again.
    # pad the cell text, then add the formatting back
    # output the final text
    foreach z $table3 {
        set i 0
        append txt "\n-"
        foreach x $z {
            set cellfont [lindex $x 0]
            set celltext [lindex $x 1]
            set celltext [pad $celltext [fontfromdigits $cellfont] [lindex $widths $i]]
            set celltext [cannonical $cellfont $celltext]
            append txt "$celltext$between"
            incr i 1
        }
    }
    append txt "\n"
    return $txt
}

proc normalizeCell {cellTxt} {
    set cellTxt [string trim $cellTxt]
    set cellTxt [regsub -all "</.>" $cellTxt ""]
    set cellTxt [string trim $cellTxt]
    set fontdigits ""
    set start [string index $cellTxt 0]
    while {$start == "<" } {
        append fontdigits [string index $cellTxt 1]
        set cellTxt [string range $cellTxt 3 end]
        set start [string index $cellTxt 0]
    }  
    return [list $fontdigits $cellTxt]
}

proc pad {txt font width } {
    set f [fontfromdigits $font]
    set w  [font measure $f $txt]
    while { $w < $width }  {
        append txt " "
        set w [font measure $f $txt] 
    } 
    return $txt   
}

proc fontfromdigits {fontdigits } {
    set isFont "Arial 12"
    set isBold ""
    set isItalic ""
    set digits [split $fontdigits ""]
    foreach d $digits {
        if {[string match $d "b"] } {set isBold "bold"}
        if {[string match $d "i"] } {set isItalic "italic"}
        if {[string match $d "m"] } {set isFont "Courier 10"}
        if {[string match $d "h"] } {set isFont "Helvetica 12"; set isBold "bold"}
        if {[string match $d "s"] } {set isFont "Helvetica 8"}
    }
    set final "$isFont $isBold $isItalic"
    return $final
}

proc cannonical {fontstring txt } {
    set digits [split $fontstring ""]
    foreach d $digits {
        set txt "<$d>$txt</$d>"
    }
    return $txt
}

programming.nbk: Home | Index | Next Page: Tcl | Previous Page: struct tm* localtime(const time_t* timer );

Notebook exported on Monday, 7 July 2008, 18:56:06 PM Eastern Daylight Time