From 19d9fa719b3d1658a96b422161f0879d6b696664 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Thu, 4 Jun 2009 00:31:33 +0100 Subject: [PATCH 1/1] database updates seem to work --- pctb/database | 7 -- pctb/show-thing.tcl | 156 ++++++++++++++++++++++++++------------------ 2 files changed, 93 insertions(+), 70 deletions(-) diff --git a/pctb/database b/pctb/database index 7ccee42..e69de29 100644 --- a/pctb/database +++ b/pctb/database @@ -1,7 +0,0 @@ -0 1 57 -5 -1f0 -200 -200 -100 -3f0 diff --git a/pctb/show-thing.tcl b/pctb/show-thing.tcl index 19912cb..0b0b8f5 100755 --- a/pctb/show-thing.tcl +++ b/pctb/show-thing.tcl @@ -3,11 +3,12 @@ # usage: # run show-thing without args # then on stdin write -# one line which is a Tcl list for foolist +# one line which is a Tcl list for glyphsdone # the xpm in the format expected # then expect child to raise SIGSTOP or exit 0 or exit nonzero # if child raised SIGSTOP, check database was updated + proc manyset {list args} { foreach val $list var $args { upvar 1 $var my @@ -15,14 +16,55 @@ proc manyset {list args} { } } + +#---------- display core ---------- + set mul 6 set inter 1 set gotsh 20 set csrh 20 +proc init_widgets {} { + global csrh gotsh + + frame .d + + image create bitmap image/main + label .d.mi -image image/main -borderwidth 0 + + frame .d.csr -bg black -height $csrh + frame .d.got -bg black -height $gotsh + + image create bitmap image/cursor -data \ +{#define csr_width 11 +#define csr_height 11 +static unsigned char csr_bits[] = { + 0x20, 0x00, 0x20, 0x00, 0x20, 0x00, 0x21, 0x04, 0x22, 0x02, 0x25, 0x05, + 0xaa, 0x02, 0x74, 0x01, 0xa8, 0x00, 0x70, 0x00, 0x20, 0x00}; +} + + frame .d.csr.csr + label .d.csr.csr.l -image image/cursor -compound left + entry .d.csr.csr.e -bd 0 + pack .d.csr.csr.l -side left + + frame .d.csr_0 -bg white -width 1 + frame .d.csr_1 -bg white -width 1 + + place .d.csr -x 0 -y 0 + place .d.mi -x 0 -y $csrh + pack .d + + frame .help + pack .help +} + + +#---------- xpm input processor ---------- + proc read_xpm {f} { - global foolist mul inter rhsmost_max unk_l unk_r gotsh csrh + global glyphsdone mul inter rhsmost_max unk_l unk_r gotsh csrh global cols rows wordmap set o {} @@ -65,7 +107,7 @@ proc read_xpm {f} { set how q } else { set ab 0 - foreach {min max context got} $foolist { + foreach {min max context got} $glyphsdone { set rhsmost_max $max if {$x >= $min && $x <= $max} { set how [lindex {a b} $ab] @@ -98,7 +140,7 @@ proc read_xpm {f} { incr y } set data [exec xpmtoppm << $o] - image create photo main_image -data $data + image create photo image/main -data $data foreach w {.d .d.csr .d.got} { $w configure -width $mulcols @@ -110,21 +152,13 @@ proc read_xpm {f} { place .d.got -x 0 -y [expr {$csrh+$mulrows}] } -#puts $o - -frame .d -set mi main_image -image create bitmap main_image -label .d.mi -image $mi -borderwidth 0 +#---------- per-invocation display ---------- -frame .d.csr -bg black -height $csrh -frame .d.got -bg black -height $gotsh - -proc draw_foolist {} { - global foolist mul inter +proc draw_glyphsdone {} { + global glyphsdone mul inter eval destroy [winfo children .d.got] - foreach {min max context got} $foolist { + foreach {min max context 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 @@ -132,34 +166,11 @@ proc draw_foolist {} { } } -set imcsr [image create bitmap -data \ -{#define csr_width 11 -#define csr_height 11 -static unsigned char csr_bits[] = { - 0x20, 0x00, 0x20, 0x00, 0x20, 0x00, 0x21, 0x04, 0x22, 0x02, 0x25, 0x05, - 0xaa, 0x02, 0x74, 0x01, 0xa8, 0x00, 0x70, 0x00, 0x20, 0x00}; -}] - -frame .d.csr.csr -label .d.csr.csr.l -image $imcsr -compound left -entry .d.csr.csr.e -bd 0 -pack .d.csr.csr.l -side left - -frame .d.csr_0 -bg white -width 1 -frame .d.csr_1 -bg white -width 1 - -place .d.csr -x 0 -y 0 -place .d.mi -x 0 -y $csrh -pack .d - -frame .help -pack .help - proc startup_cursor {} { global cur_already cur_mode cur_0 cur_1 last_ht - global foolist unk_l unk_r + global glyphsdone unk_l unk_r - set cur_already [expr {[llength $foolist]/4-1}] + set cur_already [expr {[llength $glyphsdone]/4-1}] set cur_mode 1 ;# one of: 0 1 already text set cur_0 $unk_l @@ -167,6 +178,9 @@ proc startup_cursor {} { set last_ht {} } + +#---------- runtime display and keystroke handling ---------- + proc helptext {t} { global last_ht if {![string compare $t $last_ht]} return @@ -186,13 +200,13 @@ proc helptext {t} { proc recursor/0 {} { recursor//01 0 } proc recursor/1 {} { recursor//01 1 } proc recursor//01 {z1} { - global mul rhsmost_max cols foolist + global mul rhsmost_max cols glyphsdone upvar #0 cur_$z1 cur .d.csr.csr.l configure -text {adjust} place .d.csr.csr -x [expr {$cur*$mul - 7}] bind_key space { othercursor } bind_leftright cur_$z1 0 [expr {$cols-1}] - if {[llength $foolist]} { + if {[llength $glyphsdone]} { bind_key Tab { set cur_mode already; recursor } } else { bind_key Tab {} @@ -241,20 +255,20 @@ proc recursor/text {} { proc recursor/already {} { global mul - global foolist + global glyphsdone global cur_already mul - global foolist cur_already mul + global glyphsdone cur_already mul .d.csr.csr.l configure -text {correct} - set rmax [lindex $foolist [expr {$cur_already*4}]] + set rmax [lindex $glyphsdone [expr {$cur_already*4}]] place .d.csr.csr -x [expr {$rmax*$mul-3}] bind_key Return {} bind_key space {} - bind_leftright cur_already 0 [expr {[llength $foolist]/4-1}] + bind_leftright cur_already 0 [expr {[llength $glyphsdone]/4-1}] bind_key Tab { bind_key Delete {}; set cur_mode 1; recursor } bind_key Delete { - RETURN_RESULT DELETE [lrange $foolist \ + RETURN_RESULT DELETE [lrange $glyphsdone \ [expr $cur_already*4] \ - [expr $cur_already*4+1]] + [expr $cur_already*4+2]] } helptext { {{<- ->} {move cursor, selecting glyph to correct}} @@ -295,6 +309,8 @@ proc recursor {} { } +#---------- database read and write ---------- + # database format: # series of glyphs: # ... @@ -342,27 +358,41 @@ proc write_database {} { file rename -force database.new database } +proc dbkey {ctx l r} { + global wordmap + set bm $ctx + for {set x $l} {$x <= $r} {incr x} { + lappend bm [format %x $wordmap($x)] + } + return $bm +} + proc update_database/DEFINE {c0 c1 strh} { - global foolist unk_l unk_context wordmap database + global glyphsdone unk_l unk_context wordmap database if {$c0 > $c1} { manyset [list $c0 $c1] c1 c0 } if {$c0 == $unk_l} { set ncontext $unk_context } else { - foreach {l r context got} $foolist { + foreach {l r context got} $glyphsdone { if {$l==$c0} { set ncontext $context; break } } - if {![exists ncontext]} { + if {![info exists ncontext]} { puts stderr "must start at letter LHS!" return } } - set bm $ncontext - for {set x $c0} {$x < $c1} {incr x} { - lappend bm [format %x $wordmap($x)] - } + incr c1 -1 + set bm [dbkey $ncontext $c0 $c1] set database($bm) $strh write_database } + +proc update_database/DELETE {l r ctx} { + global database + set bm [dbkey $ctx $l $r] + unset database($bm) + write_database +} proc RETURN_RESULT {how what} { @@ -378,9 +408,9 @@ proc RETURN_RESULT {how what} { # bind . {} proc test_main {} { - global foolist unk_l unk_r unk_context - - set foolist { + global glyphsdone unk_l unk_r unk_context + + set glyphsdone { 7 11 1 M 13 17 0 a 19 23 0 n @@ -393,11 +423,11 @@ proc test_main {} { read_xpm $f close $f - draw_foolist + draw_glyphsdone startup_cursor - - read_database - recursor } +read_database +init_widgets test_main +recursor -- 2.30.2