はじめに
敷居の低い(そして奥が深い)ネタに惹かれて参加してみました。
動作環境
MSYS2 MinGW 64-bitでソースコードからビルドしたTcl/Tk 8.6.10をWindows10のコマンドプロンプトで実行して動作確認しました。
Tcl婆婆
まずはTk抜きのTclだけで。
#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
exec tclsh -encoding cp932 "$0" ${1+"$@"}
puts "契約書だよ。そこに名前を書きな。"
gets stdin name
puts "フン。${name}というのかい。贅沢な名だねぇ。"
set newNameIndex [expr {[clock microseconds] % [string length $name]}]
set newName [string index $name $newNameIndex]
puts "今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
実行結果は以下の如し。
> tclsh yubaba1.tcl
契約書だよ。そこに名前を書きな。
山田太郎
フン。山田太郎というのかい。贅沢な名だねぇ。
今からお前の名前は郎だ。いいかい、郎だよ。分かったら返事をするんだ、郎!!
そして、お約束のバグも。
> tclsh yubaba1.tcl
契約書だよ。そこに名前を書きな。
フン。というのかい。贅沢な名だねぇ。
divide by zero
while executing
"expr {[clock seconds] % [string length $name]}"
invoked from within
"set newNameIndex [expr {[clock seconds] % [string length $name]}]"
(file "yubaba.tcl" line 8)
newNameIndexを算出する処理はrand()を使うのが普通だと思います。
なんでこんな変な実装しちゃったかというと、『お約束のバグ』を実現するためですw
こうでもしないとエラーが起きなくて。
まあしかし、デバッグしてると「なんでこんな不自然な実装にしてんねん」としか思えない記述が不具合の元凶だったりしますから。
オマージュ婆婆
意味もなく元ネタ(Java)風な書式にしてみました。Tcl/Tk 8.6から標準装備になったオブジェクト指向機能TclOOですが、ほぼ使ったことが無かったのでbitWalkを参考にさせて頂きました。感謝!
#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
exec tclsh -encoding cp932 "$0" ${1+"$@"}
namespace eval ::System::out {
proc println {text} {
puts $text
}
}
oo::class create Scanner {
variable Channel
constructor {channel} {
set Channel $channel
}
method nextLine {} {
return [gets $Channel]
}
}
oo::class create Random {
method nextInt {limit} {
return [expr {[clock microseconds] % $limit}]
}
}
oo::class create Yubaba {
constructor {} {
::System::out::println "契約書だよ。そこに名前を書きな。"
set keiyakusho [Scanner new stdin]
set name [$keiyakusho nextLine]
::System::out::println "フン。${name}というのかい。贅沢な名だねぇ。"
set random [Random new]
set newNameIndex [$random nextInt [string length $name]]
set newName [string range $name $newNameIndex $newNameIndex]
::System::out::println "今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
}
}
Yubaba new
実行結果はTcl婆婆と同じなので割愛しますw
ソーシャルディスタンス婆婆
ご高齢な湯婆婆さまとはソーシャルディスタンスでお話しなくては。
ソーシャルディスタンスって2～3mくらいですよね？
それくらいのの距離ならシリアル通信でいけそうです。
#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
exec tclsh -encoding cp932 "$0" ${1+"$@"}
lassign $argv port
set ch [open $port r+]
fconfigure $ch -mode 115200,n,8,1 -encoding utf-8 -translation {auto crlf} -blocking 1 -buffering line
gets $ch
while 1 {
set msg "\n契約書だよ。そこに名前を書きな。"
puts $ch $msg
puts $msg
gets $ch name
set msg "フン。${name}というのかい。贅沢な名だねぇ。"
puts $ch $msg
puts $msg
if {[catch {apply {{name} {
set newNameIndex [expr {[clock microseconds] % [string length $name]}]
set newName [string index $name $newNameIndex]
return "今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
}} $name} msg]} {
set msg "error: $msg"
}
puts $ch $msg
puts $msg
}
2台のPCのシリアルポートをクロスケーブルで接続し、一方のPCで以下のようにスクリプトを実行します。
> tclsh yubaba3.tcl \\.\COM10
もう一方のPCではTeraTermなどの通信ターミナルソフトを実行してシリアルポートを開きます。
TeraTerm側に名前を入力するので、ローカルエコーを表示するように設定しておくと見やすいです。
そしてTeraTermでEnterキーを叩くと湯婆婆が語りかけてきますので、名前を入力してEnterキーを押すか、Enterキーだけを押すかします。
なお、スクリプトを実行しているコマンドプロンプト側にもTeraTermへ送信した文字列を表示しています。
>tclsh yubaba3.tcl \\.\COM10
契約書だよ。そこに名前を書きな。
フン。山田太郎というのかい。贅沢な名だねぇ。
今からお前の名前は太だ。いいかい、太だよ。分かったら返事をするんだ、太!!
契約書だよ。そこに名前を書きな。
フン。というのかい。贅沢な名だねぇ。
error: divide by zero
契約書だよ。そこに名前を書きな。
実行を終了するにはコマンドプロンプト側でCtrl-Cを入力するか、コマンドプロンプトを閉じます。
テレワーク婆婆
テレワークと言えばやっぱりネットワークですよね。socket通信を使いましょう。
#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
exec tclsh -encoding cp932 "$0" ${1+"$@"}
proc yubaba {ch} {
gets $ch
puts $ch "\n契約書だよ。そこに名前を書きな。"
gets $ch name
puts $ch "フン。${name}というのかい。贅沢な名だねぇ。"
if {[catch {apply {name {
set newNameIndex [expr {[clock microseconds] % [string length $name]}]
set newName [string index $name $newNameIndex]
return "今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
}} $name} msg]} {
set msg "error: $msg"
}
puts $ch $msg
}
proc connected {ch addr port} {
puts "connected from $addr:$port."
fconfigure $ch -encoding utf-8 -translation auto -blocking 1 -buffering line
fileevent $ch readable [list yubaba $ch]
}
puts "listening on [fconfigure [socket -server connected 0] -sockname]"
vwait forever
まずスクリプトを実行します。すると待ち受けポート番号が表示されます。
> tclsh yubaba4.tcl
listening on 0.0.0.0 0.0.0.0 51656 :: :: 51656
TCP/IPネットワークで接続された2台のホスト間でもいけるはずなんですが、ファイアウォールの設定によってはうまくつながらないかも知れないので同一ホストで実験してみます。
今回試すまで知りませんでしたがTeraTermで接続することができます。
TeraTermから接続してEnterキーを叩くと湯婆婆が語りかけてきますので、名前を入力してEnterキーを押すか、Enterキーだけを押すかします。あと、ソーシャルディスタンス婆婆と同じくローカルエコーをオンにしておきましょう。
実行を終了するにはコマンドプロンプト側でCtrl-Cを入力するか、コマンドプロンプトを閉じます。
ちなみにこのスクリプトは一般的なサーバに比べて変なところがあります。
一般的なサーバの場合、ひとつのクライアントとの通信状況に影響されず、並行して別のクライアントも通信できますが、このスクリプトでは湯婆婆と話をしている間は、他のクライアントは待たされてしまいます。
原因はgets $ch nameでブロックしてしまうからで、ノンブロッキングにして1行入力されるまでは他のイベントを処理するようにすれば他のクライアントを待たせずにすむと思います。が、アドベントカレンダーの投稿が間に合わなさそうだったのでチューニングはやめにしました。
まぁこれはこれで湯婆婆さまらしいですし。
Tcl/Tkで湯婆婆を実装してみる
やっとTcl/Tkです。
#!/bin/sh
#-*-mode:tcl;coding:cp932;tab-width:8-*-\
exec wish -encoding cp932 "$0" ${1+"$@"}
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 newNameIndex [expr {[clock microseconds] %% [string length $name]}]
set newName [string index $name $newNameIndex]
append contract "\n今からお前の名前は${newName}だ。いいかい、${newName}だよ。分かったら返事をするんだ、${newName}!!"
}
実行は
> wish yubaba.tcl
でもいいですし、拡張子.tclをwishに関連付けておいてyubaba.tclをダブルクリックしてもOKです。
実行するとラベルとエディットボックスだけのウィンドウが開きます。
名前を入力してEnterキーを叩くと契約完了です。
名前を消してEnterキーを叩くと『お約束のバグ』が出現します。
あとがき
DDE婆婆とか、msgcat婆婆とか、send婆婆とか、ffidl婆婆とか、アイデアを練っていたんですが、時間切れでした。