From 0784ae937712ff7bf220f25d58e8da0ae2a10d87 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sat, 4 Jul 2009 14:42:48 +0100 Subject: [PATCH] antialiasing text conversion: dictionary-manager prompting seems to work --- pctb/dictionary-manager | 204 ++++++++++++++++++++-------------------- pctb/ocr.c | 4 +- 2 files changed, 104 insertions(+), 104 deletions(-) diff --git a/pctb/dictionary-manager b/pctb/dictionary-manager index 210af06..a638d9e 100755 --- a/pctb/dictionary-manager +++ b/pctb/dictionary-manager @@ -150,7 +150,7 @@ proc resize_widgets_core {} { global mulcols mulrows csrh gotsh ctxh global unk_l unk_contexts - foreach w {.d.csr .d.got .d.ctx} { + foreach w {.d.csr .d.got .d.ctx .d.mi} { $w configure -width $mulcols } @@ -202,7 +202,7 @@ proc read_database {fn} { set database_fn $fn if {![file exists $database_fn]} return set f [open $database_fn r] - if {[string compare [db_getsl $f] $magic]} { error "$l $reqkind ?" } + if {[string compare [db_getsl $f] $magic]} { error "$magic $reqkind ?" } read_database_header/$reqkind $f while 1 { @@ -261,7 +261,7 @@ proc required/char {} { manyset [lrange $l 0 3] unk_l unk_r unk_contexts set glyphsdone [lrange $l 3 end] - char_read_xpm stdin + char_read_pgm stdin catch { unset all_contexts } @@ -581,111 +581,111 @@ proc maybe_upload_entry {im def} { #========== CHARACTER SET ========== -#---------- xpm input processor ---------- +#---------- pgm input processor ---------- -proc char_read_xpm {f} { +proc char_read_pgm {f} { global glyphsdone mul inter rhsmost_max unk_l unk_r mulcols mulrows - global cols rows wordmap + global cols rows charkey - set o {} - set y -3 - while 1 { - must_gets_imagel $f l - if {![regexp {^"(.*)",$} $l dummy l]} { - append o "$l\n" - if {[regexp {^\}\;$} $l]} break - continue - } - if {$y==-3} { - manyset $l cols rows colours cpp - 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 context contexts got} $glyphsdone { - lappend ngd \ - [expr {$min-$chop_l}] \ - [expr {$max-$chop_l}] \ - $context $contexts $got - } - set glyphsdone $ngd + must_gets_imagel $f l + if {[string compare $l P2]} { error "magic $l ?" } + + must_gets_imagel $f l + if {![regexp {^([1-9]\d{0,3}) ([1-9]\d{0,3}) ([1-9]\d?)$} \ + $l dummy cols rows maxval]} { error "head $l ?" } + + for {set depth 1} {$maxval != (1<<$depth)-1} {incr depth} { + if {$depth >= 16} { error "maxval $maxval ?" } + } + + set chop_l [expr {$unk_l - 80}] + set chop_r [expr {$cols - $unk_l - 100}] + if {$chop_l<0} { set chop_l 0 } + if {$chop_r<0} { set chop_r 0 } - set realcols $cols - set cols [expr {$cols - $chop_l - $chop_r}] - debug "NOW cols=$cols chop_l,r=$chop_l,$chop_r rows=$rows\ + set unk_l [expr {$unk_l - $chop_l}] + set unk_r [expr {$unk_r - $chop_l}] + set ngd {} + foreach {min max context contexts got} $glyphsdone { + lappend ngd \ + [expr {$min-$chop_l}] \ + [expr {$max-$chop_l}] \ + $context $contexts $got + } + set glyphsdone $ngd + + set realcols $cols + set cols [expr {$cols - $chop_l - $chop_r}] + debug "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" - for {set x 0} {$x<$cols} {incr x} { set wordmap($x) 0 } - } elseif {$y==-2} { # first pixel - append o \ -"\"+ c #111\", -\"a c #800\", -\"A c #fcc\", -\"b c #00c\", -\"B c #fff\", -\"u c #000\", -\"U c #ff0\", -\"q c #000\", -\"Q c #ff0\",\n" - } elseif {$y==-1} { # 2nd pixel but we've already printed ours - } else { - set ybit [expr {1<<$y}] - set x 0 - set ol "\"+" - set olh $ol - if {$chop_r>=0} { - set l [string range $l $chop_l end-$chop_r] + + set mulcols [expr {$cols*$mul+$inter}] + set mulrows [expr {$rows*$mul+$inter}] + + set o "P3\n$mulcols $mulrows 15\n" + + for {set x 0} {$x<$cols} {incr x} { set charkey($x) {} } + + set ointer1 " 1 1 1" + set ointer [string repeat $ointer1 $inter] + set ointerl "[string repeat $ointer1 $mulcols]\n" + + append o $ointerl + + for {set y 0} {$y<$rows} {incr y} { + must_gets_imagel $f l + if {[llength $l] != $realcols} { error "realcols=$realcols $l ?" } + + set ol $ointer + + for {set x 0} {$x<$cols} {incr x} { + set realx [expr {$x + $chop_l}] + set c [lindex $l $realx] + append charkey($x) [format %x $c] + + set how "u" + if {$x >= $unk_l && $x <= $unk_r} { + set how q } 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 contexts got} $glyphsdone { - set rhsmost_max $max - if {$x >= $min && $x <= $max} { - set how [lindex {a b} $ab] - break - } - set ab [expr {!$ab}] + set ab 0 + foreach {min max context contexts got} $glyphsdone { + set rhsmost_max $max + if {$x >= $min && $x <= $max} { + set how [lindex {a b} $ab] + break } + set ab [expr {!$ab}] } - switch -exact $c { - " " { set p $how } - "o" { - set p [string toupper $how] - incr wordmap($x) $ybit - } - default { error "$c ?" } - } - append ol "[string repeat $p [expr {$mul-$inter}]][ - string repeat + $inter]" - append olh [string repeat + $mul] - incr x } - set ole "\",\n" - append ol $ole - append olh $ole - set olhn [string repeat $olh $inter] - if {!$y} { append o $olhn } - append o [string repeat $ol [expr {$mul-1}]] - append o $olhn + set c15 [expr {$c << (16-$depth)}] + set c15 [expr {$c15 | ($c15 >> $depth)}] + set c15 [expr {$c15 | ($c15 >> $depth*2)}] + set c15 [expr {$c15 >> 12}] + + foreach rgb {r g b} { set $rgb {$c15} } + switch -exact $how { + a { set r {$c15>>1 | 0x8} } + b { set b {$c15>>2 | 0xc} } + u { set b 0 } + q { set b 0 } + default { error "how $how ?" } + } +#debug "PIXEL $x,$y how=$how c=$c c15=$c15 $r $g $b" + + set opixel " " + foreach rgb {r g b} { + append opixel [format " %2d" [expr [set $rgb]]] + } + append ol [string repeat $opixel [expr {$mul-$inter}]] + append ol $ointer } - incr y + append ol "\n" + append o [string repeat $ol [expr {$mul-$inter}]] + append o $ointerl } - set data [exec xpmtoppm << $o] + +# debug "DATA $o" + set data [exec pnmscale 1 << $o] image create photo image/main -data $data } @@ -892,7 +892,7 @@ proc recursor {} { # $database($context 0x 0x...) = $hex -set database_magic/char {# ypp-sc-tools pctb font v1} +set database_magic/char {# ypp-sc-tools pctb font v2} proc read_database_header/char {f} { global rows @@ -906,7 +906,7 @@ proc read_database_entry/char {f context} { while 1 { set l [db_getsl $f] if {![string length $l]} break - lappend bm [format %x 0x$l] + lappend bm $l } set database($bm) $strq } @@ -923,10 +923,10 @@ proc format_database_entry/char {bm strq} { } proc dbkey {ctx l r} { - global wordmap + global charkey set bm $ctx for {set x $l} {$x <= $r} {incr x} { - lappend bm [format %x $wordmap($x)] + lappend bm $charkey($x) } return $bm } @@ -944,7 +944,7 @@ proc char_get_definition_cursors {} { } proc char_get_definition_contexts {} { - global glyphsdone unk_l unk_contexts wordmap database + global glyphsdone unk_l unk_contexts database manyset [char_get_definition_cursors] c0 c1 diff --git a/pctb/ocr.c b/pctb/ocr.c index c747b20..bbdbedc 100644 --- a/pctb/ocr.c +++ b/pctb/ocr.c @@ -265,10 +265,10 @@ static void callout_unknown(OcrReader *rd, int w, const Pixcol cols[], fputc('\n',resolver); fprintf(resolver, - "P2\n%d %d\n%d\n", w, rd->h, AAMAXVAL); + "P2\n%d %d %d\n", w, rd->h, AAMAXVAL); for (y=0; yh; y++) { for (x=0; x