upvar 1 $maxhv maxh
set w .d.ctx.at$x
if {[llength $ctxs]==1} { set fg blue } { set fg yellow }
- label $w -bg black -fg $fg -text [join $ctxs "/\n "]
- place $w -x [expr {$x*$mul}] -y 0
+ label $w -bg black -fg $fg -text [join $ctxs "/\n"] -justify left
+ place $w -x [expr {($x-1)*$mul}] -y 0
set wh [winfo reqheight $w]
if {$wh > $maxh} { set maxh $wh }
}
eval destroy [winfo children .d.ctx]
set maxh 0
- foreach {min max context got} $glyphsdone {
- show_context maxh $min [list $context]
+ foreach {min max contexts got} $glyphsdone {
+ show_context maxh $min $contexts
}
show_context maxh $unk_l $unk_contexts
.d.ctx configure -height $maxh
}
if {$y==-3} {
manyset $l cols rows colours cpp
- #assert {$colours==2}
- #assert {$cpp==1}
+ if {$colours!=2 || $cpp!=1} { error "$l ?" }
+
+ set chop_l [expr {$unk_l - 80}]
+ set chop_r [expr {$cols - $unk_l - 100}]
+ if {$chop_l<0} { set chop_l 0 }
+
+ set unk_l [expr {$unk_l - $chop_l}]
+ set unk_r [expr {$unk_r - $chop_l}]
+ set ngd {}
+ foreach {min max contexts got} $glyphsdone {
+ lappend ngd \
+ [expr {$min-$chop_l}] \
+ [expr {$max-$chop_l}] \
+ $contexts $got
+ }
+ set glyphsdone $ngd
+
+ set realcols $cols
+ set cols [expr {$cols - $chop_l - $chop_r}]
+ puts stderr "NOW cols=$cols chop_l,r=$chop_l,$chop_r rows=$rows\
+ $unk_l $unk_r $ngd"
+
set mulcols [expr {$cols*$mul+$inter}]
set mulrows [expr {$rows*$mul+$inter}]
append o "\"$mulcols $mulrows 9 1\",\n"
set x 0
set ol "\"+"
set olh $ol
+ if {$chop_r>=0} {
+ set l [string range $l $chop_l end-$chop_r]
+ } else {
+ set l [string range $l $chop_l end]
+ append l [string repeat " " [expr -$chop_r]]
+ }
foreach c [split $l ""] {
set how "u"
if {$x >= $unk_l && $x <= $unk_r} {
set how q
} else {
set ab 0
- foreach {min max context got} $glyphsdone {
+ foreach {min max contexts got} $glyphsdone {
set rhsmost_max $max
if {$x >= $min && $x <= $max} {
set how [lindex {a b} $ab]
proc draw_glyphsdone {} {
global glyphsdone mul inter
eval destroy [winfo children .d.got]
- foreach {min max context got} $glyphsdone {
+ foreach {min max contexts got} $glyphsdone {
frame .d.got.m$min -bd 0 -background \#888
label .d.got.m$min.l -text "$got" -fg white -bg black -bd 0
pack .d.got.m$min.l -padx 1 -pady 1
foreach o [lsort $ol] {
puts $f $o
}
+ puts $f "."
close $f
file rename -force $database_fn.new $database_fn
}
if {$c0 == $unk_l} {
set ncontexts $unk_contexts
} else {
- foreach {l r context got} $glyphsdone {
- if {$l==$c0} { set ncontexts [list $context]; break }
+ foreach {l r contexts got} $glyphsdone {
+ if {$l==$c0} { set ncontexts $contexts; break }
}
if {![info exists ncontexts]} {
puts stderr "must start at letter LHS!"
write_database
}
-proc update_database/DELETE {l r ctx} {
+proc update_database/DELETE {l r ctxs} {
global database
- set bm [dbkey $ctx $l $r]
- unset database($bm)
+ foreach ctx $ctxs {
+ set bm [dbkey $ctx $l $r]
+ catch { unset database($bm) }
+ }
write_database
}