Wish Tcl/Tk 入門 8. グラフィック

グラフィックには、window 上の部品をマウスに連動して動か すのと、canvas 上で線や多角形を書いたりする本来のグラフィッ クの2種類があります。

8.1 ボタンをマウスで動かします。

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# メイン
wm title . place.tcl
#
# ボタンの定義
#
button .but1 -text A \
            -foreground orange    -background white \
      -activeforeground red -activebackground white  
button .but2 -text B \
            -foreground orange    -background white \
      -activeforeground red -activebackground white  
#
# .but1 絶対的と .but2 相対的な配置で指定。
#
place .but1 -x 100 -y 100 -anchor c
place .but2 -relx 0.5 -rely 0.8 -anchor c
#
# ボタンの処理  = マウスボタン 1 の動き
#        <3> =   = マウスボタン 1 を押す
#    = < Double-Button-1 > = ダブルクリック
#    man n bind
#
bind .but1  {MoveBut 1}
bind .but2  {MoveBut 2}
bind .but1 <3> { place forget .but1 }
bind .but2  { place forget .but2  }
# bind all  { puts " ボタン %b イベントタイプ %T " }
bind all  {exit}
#
# ボタンの位置を再計算 pointerx,y マウスの座標
#                      rootx,y window 左上の座標
#  winfo は window の情報を指定
#
proc MoveBut {n} {
set m .but$n
if { $n == 1 } {
set x [ expr [ winfo pointerx . ] - [ winfo rootx . ] ]
set y [ expr [ winfo pointery . ] - [ winfo rooty . ] ]
place $m -x $x -y $y -anchor c
return
}
#
# 相対座標の定義は以下にある。double(整数) で実数化する。
# そうでないと全て整数の割算なので、答えは 0 と 1 の間の場合
# 0 になる。
#
if { $n == 2 } {
set rx [ expr ( [ winfo pointerx . ] - [ winfo rootx . ] ) / \
                double( [ winfo width . ] )  ]
set ry [ expr ( [ winfo pointery . ] - [ winfo rooty . ] ) / \
                double( [ winfo height . ] ) ]
# puts [ winfo pointerx . ],[ winfo rootx . ],[ winfo width . ],[ winfo height . ],$rx,$ry
place $m -relx $rx -rely $ry -anchor c
return
}
}

ここで新しいのは、 です。これはボタンを選択し たときにマウスのボタン1 (左ボタン) をおされた状態で動いた場 合の判断です。ボタンの操作に対して bind で処理できます。 詳しくは man n bind で見てください。

window 上での座標は、window の 左上の座標 (roox,rooy) か ら pointer の座標 (pointerx, pointery) までのドット数で判断 します。相対座標は、これを window の大きさ (width, height) で割ったものです。全て整数なので、割算をする時には、どれかを 実数化して答えを実数にするようにしなければいけません。

A と B のボタンをドラッグして Window の好きなところに移 動できます。ボタンを消すのには、place forget .but1 でできま す。A ボタンは右ボタンで、B ボタンは 左ボタンのダブルクリッ クで消えます。

8.2 碁盤を作る。(line, oval)

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# go.tcl
# file の中身を読み、保存します。メインプログラムは最後にあります。
#
proc goban {} {
global mesh mesh2 wh
#
# 縦横の 各 19 本の線を引きます。$mesh の i 倍
#
set en [ expr 19 * $mesh ] 
for { set i 1 } { $i <= 19 } { incr i } {
set x [ expr $i * $mesh ]
.c1 create line $x $mesh $x $en 
.c1 create line $mesh $x $en $x
}
#
# 星に ・ を付けます。
# oval (楕円は長方形の左上、右下の xy 座標 で指定 )
#
set hosi 2
for { set i 4 } { $i <= 16 } { incr i 6 } {
   set ii [ expr $mesh * $i  ]
   set i1 [ expr $ii - $hosi ]
   set i2 [ expr $ii + $hosi ]
for { set j 4 } { $j <= 16 } { incr j 6 } {
   set jj [ expr $mesh * $j  ]
   set j1 [ expr $jj - $hosi ]
   set j2 [ expr $jj + $hosi ]
.c1 create oval $i1 $j1 $i2 $j2 -fill black 
} }
#
# proc goban の終り
#
}
#
# 画面の初期化
#
proc init {} {
#
# canvas 内に書いた全てのもの tag を消します。
#
.c1 delete tag all
goban
}

#
# 石を置く x,y は マウスの位置 .c1 の座標を見る
#
proc okuisi { isi } {
global mesh mesh2 wh
set x [ expr [ winfo pointerx .c1 ] - [ winfo rootx .c1 ] ]
set y [ expr [ winfo pointery .c1 ] - [ winfo rooty .c1 ] ]
#
# 目の位置を決める
#
set xx [ expr ( ( $x + $mesh2 ) / $mesh ) * $mesh ]
set yy [ expr ( ( $y + $mesh2 ) / $mesh ) * $mesh ]
if { ( $xx == 0 ) || ( $xx == $wh ) || \
	( $yy == 0 ) || ( $yy == $wh ) } { return $isi }
#
   set x1 [ expr $xx - $mesh2 ]
   set x2 [ expr $xx + $mesh2 ]
   set y1 [ expr $yy - $mesh2 ]
   set y2 [ expr $yy + $mesh2 ]
#
    if { $isi == "黒" } { 
.c1 create oval $x1 $y1 $x2 $y2 -fill black 
return "白" } else {
.c1 create oval $x1 $y1 $x2 $y2 -fill ivory
return "黒" }
}
#
# メインプログラムです。
#
wm title . go-tcl
#
# menu を作ります。menubutton です。
#
frame .m1 -relief raised -borderwidth 2
pack .m1 -side top -fill x
#
menubutton .m1.mb1 -text F:ファイル -underline 0 -menu .m1.mb1.file
label .m1.lb1 -text "                              次の手番は "
set isi 黒
label .m1.lb2 -textvariable isi
label .m1.lb3 -text "です。"
pack  .m1.mb1 -side left -expand yes -fill x
pack .m1.lb3 .m1.lb2 .m1.lb1 -side right -expand yes 
#
menu .m1.mb1.file -tearoff no
.m1.mb1.file  add command -label 初期化 -command { init } \
	-accelerator "Cntl+G"
bind all  { init }
.m1.mb1.file  add command -label 終了 -command exit \
	-accelerator "Cntl+C"
bind all  { exit }
#
# 碁盤の mesh の間隔を定義します。
#
global mesh mesh2 wh
set mesh 20
set mesh2 [ expr $mesh / 2 ]
set wh [ expr $mesh * 20 ] 
#
# canvas を作ります。pack で表示です。
#
canvas .c1 -bg #e18899db67ef -width $wh -height $wh 
pack .c1
puts [ winfo rooty .c1 ]
#
# 碁盤を作るため proc goban を呼びます。
#
goban
#
# 石を置く操作をします。
#
set isi 黒
bind all <1> { set isi [ okuisi $isi ] }

メインプログラムが一番最後に来ているのは、tcl/tk が イン タープリター ( 上から 1 行ずつ読む言語 ) なので、下にどういう proc が存在するかが分からないからです。全ての proc を理解さ せた上で、メインプログラムを動かせます。

石を白黒交互に置きます。初期化では、canvas の下に書いて あるもの (tag) を全て消去します。

同じところに置いたり出来ないようにするには、新たに proc を作ります。死んだ石や効の判定は難しいです。tcl/tk で proc を作った人は e-mail くださいませ。さらに囲碁のアルゴリズムを 研究しているひとの proc も頂ければ幸いです。総合的なプログラ ムを製作するには、このように 多くの proc を組み合わせて作り ます。

oval で 円(楕円) line で直線を書いています。直線の -fill は 線の色をしめします。tk_chooseColor で色を選択してみるのが 面白いと思います。button .b -fg [tk_chooseColor -initialcolor gr ay -title "Choose color"] が man n tk_chooseColor にありまし た。

canvas には、arc (円弧), bitmap, image, line, oval, polygon, rectangle, text, window (道具を埋め込みます。) が可能です。また set contents [ .c1 postscript ] で .c1 の内 容を postscript で出力することができます。

8.3 XY グラフ を作ります。

#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# graph.tcl
# graph を作成します。
#
# 線を引きます。xw = xmax - xmin    
#               wx = sxmax - sxmin
# 実の スケールから、screen のスケールに変換します。
#
proc rline { x1 y1 x2 y2 i } {
global xmin ymin xmax ymax majx minx majy miny xw yw sxm sym wx wy
#
set xx1 [ expr int ( ( $x1 - $xmin ) / $xw * $wx ) + $sxm ]
set xx2 [ expr int ( ( $x2 - $xmin ) / $xw * $wx ) + $sxm ]
set yy1 [ expr int ( -( $y1 - $ymin ) / $yw * $wy ) + $sym ]
set yy2 [ expr int ( -( $y2 - $ymin ) / $yw * $wy ) + $sym ]
if { $i == 0 } {
.c1 create line $xx1 $yy1 $xx2 $yy2 -fill blue
} else {
.c1 create line $xx1 $yy1 $xx2 $yy2 -arrow last 
}
}
#
# 文字を書きます xw = xmax - xmin
#                wx = sxmax - sxmin
# 実の スケールから、screen のスケールに変換します。
#
proc rtext { x1 y1 i a } {
global xmin ymin xmax ymax majx minx majy miny xw yw sxm sym wx wy
set xx1 [ expr int ( ( $x1 - $xmin ) / $xw * $wx ) + $sxm ]
set yy1 [ expr int ( -( $y1 - $ymin ) / $yw * $wy ) + $sym ]
.c1 create text $xx1 $yy1 -text $i -anchor $a
}
#
# 画面の初期化
#
proc init {} {
#
# canvas 内に書いた全てのもの tag を消します。
#
.c1 delete tag all
}
#
# グラフの処理
#
proc plot { siki } {
global xmin ymin xmax ymax majx minx majy miny xw yw sxm sym wx wy
init 
#
# 軸の plot
#
set xw [ expr $xmax - $xmin ]
set yw [ expr $ymax - $ymin ]
#
# x 軸 と軸メモリ
#
if { [ expr $ymax * $ymin ] < 0.0 } then {
    set yy 0.0 } else { set yy $ymin }
set yyy [ expr -$miny * 0.2 ]
set xxx [ expr $xmax - $minx * 0.3 ]
rline $xmin $yy $xmax $yy 1
rtext $xmax $yyy "x" "ne"
# 大メモリ
set ista [ expr int( $xmin / $majx ) ]
set iend [ expr int( $xmax / $majx ) ]
for { set i $ista } { $i <= $iend } {incr i } {
set xx [ expr $i * $majx ]
rline $xx $yy $xx $yyy 0
rtext $xx $yyy $xx "n"
}
# 小メモリ
set ista [ expr int( $xmin / $minx ) ]
set iend [ expr int( $xmax / $minx ) ]
for { set i $ista } { $i <= $iend } {incr i } {
set xx [ expr $i * $minx ]
rline $xx $yy $xx $yyy 0
}
#
# y 軸 も同様に設定します。
#
if { [ expr $xmax * $xmin ] < 0.0 } then {
    set xx 0.0 } else { set xx $ymin }
set xxx [ expr -$minx * 0.2 ]
set yyy [ expr $ymax - $miny * 0.3 ]
rline $xx $ymin $xx $ymax 1
rtext $xxx $ymax "y" "ne"
# 大メモリ
set ista [ expr int( $ymin / $majy ) ]
set iend [ expr int( $ymax / $majy ) ]
for { set i $ista } { $i <= $iend } {incr i } {
set yy [ expr $i * $majy ]
if { ( $yy < -$miny ) || ( $yy > $miny ) } {
rline $xxx $yy $xx $yy 0
rtext $xxx $yy $yy "e" }
}
# 小メモリ
set ista [ expr int( $ymin / $miny ) ]
set iend [ expr int( $ymax / $miny ) ]
for { set i $ista } { $i <= $iend } {incr i } {
set yy [ expr $i * $miny ]
if { ( $yy < -$miny ) || ( $yy > $miny ) } {
rline $xxx $yy $xx $yy 0
}
}
#
# 関数を評価します。eval $siki での形式は
# set y [ expr $x * $x ] の形です。
#
set dx [ expr ( $xmax - $xmin ) / 100. ]
for { set i 0 } { $i < 100 } { incr i } {
set x [ expr $xmin + $i * $dx ] 
eval $siki 
if { $i > 0 } { rline $px $py $x $y 0 } 
set px $x
set py $y
}
}
#
# postscript に save します。
#
proc saveps {} {

    set ftype { { "Postscript Files" .ps } { "All Files" * }}
    set fname [ tk_getSaveFile -filetypes $ftype -parent . ]
    if { $fname == "" } return
#
# "w" write mode で file を open 
#
    set fileid [ open $fname "w" ]
#
# .c1 を postscript にして書き出します。
#
    puts -nonewline $fileid [ .c1 postscript ]
    close $fileid
}
#
# メインプログラムです。
#
wm title . graph-tcl
global xmin ymin xmax ymax majx minx majy miny xw yw sxm sym wx wy
#
# menu を作ります。menubutton です。
#
frame .m1 -relief raised -borderwidth 2
pack .m1 -side top -fill x
#
menubutton .m1.mb1 -text F:ファイル -underline 0 -menu .m1.mb1.file
label .m1.lb1 -text "  使い方 : f(x) = に tcl の式 をいれ実行をおします。"
pack .m1.mb1 .m1.lb1 -side left
frame .f1 
pack .f1 -side top -fill x
#
set xmin -1.2
set xmax  1.2
set ymin -1.2
set ymax  1.2
#
label .f1.lb1 -text "xmin ="
entry .f1.e1 -width 10 -bg white -fg blue -textvariable xmin
label .f1.lb2 -text "xmax ="
entry .f1.e2 -width 10 -bg white -fg blue -textvariable xmax
label .f1.lb3 -text "ymin ="
entry .f1.e3 -width 10 -bg white -fg blue -textvariable ymin
label .f1.lb4 -text "ymax ="
entry .f1.e4 -width 10 -bg white -fg blue -textvariable ymax
pack .f1.lb1 .f1.e1 .f1.lb2 .f1.e2 .f1.lb3 .f1.e3 .f1.lb4 .f1.e4 -side left -expand yes -fill x -ipadx 0 -padx 5
#
frame .f3
set majx  0.5
set minx  0.1
set majy  0.5
set miny  0.1
pack .f3 -side top -fill x
label .f3.lb1 -text "majx ="
entry .f3.e1 -width 10 -bg white -fg blue -textvariable majx
label .f3.lb2 -text "minx ="
entry .f3.e2 -width 10 -bg white -fg blue -textvariable minx
label .f3.lb3 -text "majy ="
entry .f3.e3 -width 10 -bg white -fg blue -textvariable majy
label .f3.lb4 -text "miny ="
entry .f3.e4 -width 10 -bg white -fg blue -textvariable miny
pack .f3.lb1 .f3.e1 .f3.lb2 .f3.e2 .f3.lb3 .f3.e3 .f3.lb4 .f3.e4 -side left -expand yes -fill x -ipadx 0 -padx 5
#
frame .f2
pack .f2 -side top -fill x
label .f2.lb1 -text " f(x) = "
#
# siki に 評価式をいれます。特殊文字は \[ や \$ の様にいれると
# そのまま表示されます。
#
set siki "set y \[ expr \$x * \$x \] " 
#
entry .f2.e1 -width 60 -bg white -fg blue -textvariable siki
button .f2.b1 -text "実行"  -command { plot $siki } 
pack .f2.lb1 .f2.e1 .f2.b1 -side left -expand yes -fill x
bind .f2.e1  { plot $siki }
#
menu .m1.mb1.file -tearoff no
.m1.mb1.file  add command -label 初期化 -command { init } \
	-accelerator "Cntl+G"
bind all  { init }
.m1.mb1.file  add command -label 保存 -command { saveps } \
	-accelerator "Cntl+S"
bind all  { saveps }
.m1.mb1.file  add command -label 終了 -command exit \
	-accelerator "Cntl+C"
bind all  { exit }
#
# canvas を作ります。pack で表示です。
#
set wx1 400
set wy1 400
set margin 10
set sxm $margin
set sym [ expr $wy1 - $margin ]
set wx  [ expr $wx1 - 2 * $margin ]
set wy  [ expr $wy1 - 2 * $margin ]
canvas .c1 -bg white -width $wx1 -height $wy1
pack .c1

set y の所にいろいろな 式をいれて実行してみてください。 いろいろ機能を拡張することができます。機能を増やすのであれば、 menu の中に parameter を 組み込むようにすると良いと思います。n

$x を puts の中で表示するには、\$x のように \ を付けます。 \[ も同じです。

機能を拡張したら、e-mail でソースを送ってください。これ はいろいろ拡張して見たいところです。xmgr, gnuplotと互換で あ ると便利ですが...