LoginSignup
3

More than 1 year has passed since last update.

posted at

Tcl/Tkで湯婆婆を実装してみる

はじめに

Ja婆婆から始まった湯婆婆シリーズ

敷居の低い(そして奥が深い)ネタに惹かれて参加してみました。

動作環境

MSYS2 MinGW 64-bitでソースコードからビルドしたTcl/Tk 8.6.10をWindows10のコマンドプロンプトで実行して動作確認しました。

Tcl婆婆

まずはTk抜きのTclだけで。

yubaba1.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を参考にさせて頂きました。感謝!

yubaba2.tcl
#!/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くらいですよね?
それくらいのの距離ならシリアル通信でいけそうです。

yubaba3.tcl
#!/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_シリアルポート設定.png
TeraTerm側に名前を入力するので、ローカルエコーを表示するように設定しておくと見やすいです。
teraterm_端末の設定.png

そしてTeraTermでEnterキーを叩くと湯婆婆が語りかけてきますので、名前を入力してEnterキーを押すか、Enterキーだけを押すかします。
teraterm_実行結果.png
なお、スクリプトを実行しているコマンドプロンプト側にもTeraTermへ送信した文字列を表示しています。

>tclsh yubaba3.tcl \\.\COM10

契約書だよ。そこに名前を書きな。
フン。山田太郎というのかい。贅沢な名だねぇ。
今からお前の名前は太だ。いいかい、太だよ。分かったら返事をするんだ、太!!

契約書だよ。そこに名前を書きな。
フン。というのかい。贅沢な名だねぇ。
error: divide by zero

契約書だよ。そこに名前を書きな。

実行を終了するにはコマンドプロンプト側でCtrl-Cを入力するか、コマンドプロンプトを閉じます。

テレワーク婆婆

テレワークと言えばやっぱりネットワークですよね。socket通信を使いましょう。

yubaba4.tcl
#!/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_新しい接続.png

TeraTermから接続してEnterキーを叩くと湯婆婆が語りかけてきますので、名前を入力してEnterキーを押すか、Enterキーだけを押すかします。あと、ソーシャルディスタンス婆婆と同じくローカルエコーをオンにしておきましょう。

実行を終了するにはコマンドプロンプト側でCtrl-Cを入力するか、コマンドプロンプトを閉じます。

ちなみにこのスクリプトは一般的なサーバに比べて変なところがあります。

一般的なサーバの場合、ひとつのクライアントとの通信状況に影響されず、並行して別のクライアントも通信できますが、このスクリプトでは湯婆婆と話をしている間は、他のクライアントは待たされてしまいます。

原因はgets $ch nameでブロックしてしまうからで、ノンブロッキングにして1行入力されるまでは他のイベントを処理するようにすれば他のクライアントを待たせずにすむと思います。が、アドベントカレンダーの投稿が間に合わなさそうだったのでチューニングはやめにしました。

まぁこれはこれで湯婆婆さまらしいですし。

Tcl/Tkで湯婆婆を実装してみる

やっとTcl/Tkです。

yubaba.tcl
#!/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です。

実行するとラベルとエディットボックスだけのウィンドウが開きます。
tcltk1.png
名前を入力してEnterキーを叩くと契約完了です。
tcltk2.png
名前を消してEnterキーを叩くと『お約束のバグ』が出現します。
tcltk3.png

あとがき

DDE婆婆とか、msgcat婆婆とか、send婆婆とか、ffidl婆婆とか、アイデアを練っていたんですが、時間切れでした。

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
What you can do with signing up
3