Tcl/Tk婆婆もサロゲートペアに対応させてみた

いつの間にか湯婆婆アドベントカレンダーに1日だけ空きができて侘しかったので、勢い余って書いた続編を投稿させて頂きます。

はじめに

湯婆婆 Advent Calendar 2020への投稿を終えてほっと一息ついていたところ、翌日の「Flutterの湯婆婆にサロゲートペア文字を理解させたら可愛くなった💗」を読んでTcl/Tk婆婆でも試してみたくなりました。

灯台もと暗し

実は私の姓にもサロゲートペアの「𠩤」が含まれているのですが、自分の名前ではテストしていませんでした。

やはりサロゲートペアには対応していませんでした。

サロゲートペア対応

公式にどういう状況なのかは理解していませんが、いくつか動きはあるようです。

• TIP 389: Full support for Unicode 10.0 and later (part 1)
• Tclによるサロゲートペア文字列の切り出しとか

しかし難解でついていけなかったので、今回は「Flutterの湯婆婆にサロゲートペア文字を理解させたら可愛くなった💗」で紹介されていた「ゴリゴリと対応するならば」でやってみました。

yubaba.tcl

#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
    exec wish -encoding cp932 "$0" ${1+"$@"}

proc string_split {str} {
    set ret [list]
    binary scan [encoding convertto unicode $str] su* letters
    set bytes ""
    foreach letter $letters {
        append bytes [binary format su $letter]
        if {0xd800 <= $letter && 0xdbff >= $letter} {
            continue;# surrogate pair
        }
        lappend ret [encoding convertfrom unicode $bytes]
        set bytes ""
    }
    return $ret
}

grid [label .w1 -text "契約書だよ。そこに名前を書きな。"] -sticky w
grid [entry .w2 -textvariable name] -sticky w
grid [label .w3 -textvariable contract -justify left] -sticky w
bind .w2 <Key-Return> {
    set contract "フン。${name}というのかい。贅沢な名だねぇ。"
    set nameLetters [string_split $name]
    set newNameIndex [expr {[clock microseconds] %% [llength $nameLetters]}]
    set newName [lindex $nameLetters $newNameIndex]
    append contract "\n今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
}

string_splitでサロゲートペアを考慮しつつ文字列を文字のリストに分割しておき、後の処理はstringコマンドではなくリスト処理コマンドで文字数や切り出しを行います。

うまくいったみたいです。

「𠮷𠩤」さんではどうでしょう？

勉強になりました。