![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
Canvas上の座標を取得する †マウスの移動イベント<Motion>を取得してリアルタイムに表示させる。 制約事項 †まだよく分かんない。 # HEAD *********************************************************# プログラムに必要な諸々 #
package require Tk ;# パッケージの読込み #
#/HEAD *********************************************************# プログラムに必要な諸々 #
# Piano Roll ***************************************************# ピアノロールの描画 #
proc pianoRoll { x y } { ;# こんな風に書くの超気持ち悪い。なんとかしたい。 #
.c create rectangle 0 10 20 82 -fill gray -width 0 ;# 左端のグレーゾーン #
.c create rectangle 501 11 520 81 -fill gray -width 0 ;# 右端のグレーゾーン #
;# #
.c create line 20 10 20 82 -fill black -width 1 ;# 輪郭的なもの #
.c create line 49 10 49 82 -fill black -width 1 ;# #
.c create line 0 10 520 10 -fill black -width 1 ;# #
.c create line 0 81 520 81 -fill black -width 1 ;# #
.c create line 500 10 500 81 -fill black -width 1 ;# #
;# #
.c create line $x $y [expr { $x + 29 }] $y -fill black -width 1 ;# #
.c create line [expr { $x + 30 }] $y 500 $y -fill #666666 -width 1 ;# 延長線 #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 8 }] \
[expr { $x + 29 }] [expr { $y + 8 }] -fill black -width 1 ;# #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 18 }] \
[expr { $x + 29 }] [expr { $y + 18 }] -fill black -width 1 ;# #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 28 }] \
[expr { $x + 29 }] [expr { $y + 28 }] -fill black -width 1 ;# #
;# #
.c create line $x [expr { $y + 35 }] \
[expr { $x + 29 }] [expr { $y + 35 }] -fill black -width 1 ;# #
.c create line [expr { $x + 30 }] [expr { $y + 35 }] \
500 [expr { $y + 35 }] -fill #666666 -width 1 ;# #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 43 }] \
[expr { $x + 29 }] [expr { $y + 43 }] -fill black -width 1 ;# #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 53 }] \
[expr { $x + 29 }] [expr { $y + 53 }] -fill black -width 1 ;# #
;# #
.c create line $x [expr { $y + 60 }] \
[expr { $x + 29 }] [expr { $y + 60 }] -fill black -width 1 ;# #
.c create line [expr { $x + 30 }] [expr { $y + 60 }] \
500 [expr { $y + 60 }] -fill #666666 -width 1 ;# #
;# #
.c create line [expr { $x + 17 }] [expr { $y + 68 }] \
[expr { $x + 29 }] [expr { $y + 68 }] -fill black -width 1 ;# #
;# #
.c create rectangle $x [expr { $y + 6 }] \
[expr { $x + 17 }] [expr { $y + 10 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 6 }] \
500 [expr { $y + 10 }] -fill #AAAAAA -width 0 ;# #
;# #
;# #
.c create rectangle $x [expr { $y + 16 }] \
[expr { $x + 17 }] [expr { $y + 20 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 16 }] \
500 [expr { $y + 20 }] -fill #AAAAAA -width 0 ;# #
;# #
.c create rectangle $x [expr { $y + 26 }] \
[expr { $x + 17 }] [expr { $y + 30 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 26 }] \
500 [expr { $y + 30 }] -fill #AAAAAA -width 0 ;# #
;# #
.c create rectangle $x [expr { $y + 41 }] \
[expr { $x + 17 }] [expr { $y + 45 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 41 }] \
500 [expr { $y + 45 }] -fill #AAAAAA -width 0 ;# #
;# #
.c create rectangle $x [expr { $y + 51 }] \
[expr { $x + 17 }] [expr { $y + 55 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 51 }] \
500 [expr { $y + 55 }] -fill #AAAAAA -width 0 ;# #
;# #
.c create rectangle $x [expr { $y + 66 }] [expr { $x + 17 }] \
[expr { $y + 68 }] -fill black ;# #
.c create rectangle [expr { $x + 30 }] [expr { $y + 66 }] \
500 [expr { $y + 68 }] -fill #AAAAAA -width 0 ;# #
;# #
for {set cnt 1} {$cnt < 8} {incr cnt} { ;# 小節線の描画 #
set x [expr {$cnt * 60}] ;# #
.c create line $x 8 $x 81 -width 1 ;# #
.c create line [expr { $x + 15}] 8 [expr { $x + 15}] 81 -fill #AAAAAA -width 1 ;# #
.c create line [expr { $x + 30}] 8 [expr { $x + 30}] 81 -fill #AAAAAA -width 1 ;# #
.c create line [expr { $x + 45}] 8 [expr { $x + 45}] 81 -fill #AAAAAA -width 1 ;# #
} ;# #
.c create line 480 8 480 81 -width 1 ;# 小節線の描画(残り) #
.c create line 495 8 495 81 -fill #AAAAAA -width 1 ;# #
} ;# #
#/Piano Roll ***************************************************# #
# Region Sense *************************************************# 感知のカード #
wm title . "Region Sense" ;# メインウィンドウのタイトル #
wm geometry . 520x160+250+200 ;# メインウィンドウの大きさと表れる座標 #
set font {Times 10} ;# フォントの指定 #
;# #
button .exit -width 4 -text "Exit" -command exit ;# 終了ボタンの生成 #
place .exit -x 1 -y 1 -anchor nw ;# プレイサーによる位置決め #
;# #
frame .bBarL -borderwidth 1 -relief groove ;# フレーム左(試作) #
place .bBarL -x 41 -y 1 -anchor nw ;# プレイサーによる位置決め #
label .bBarL.msg -font $font -wraplength 200 -justify right -text "This is only a test." ;# The future. #
pack .bBarL.msg -side right ;# パッカーによる位置決め #
;# #
frame .bBarR -borderwidth 1 -relief groove ;# フレーム右(試作) #
place .bBarR -x 519 -y 1 -anchor ne ;# プレイサーによる位置決め #
label .bBarR.msg -font $font -wraplength 200 -justify right -text "This is only a test." ;# The future. #
pack .bBarR.msg -side right ;# パッカーによる位置決め #
;# #
frame .sBar -borderwidth 1 -relief sunken ;# いわゆるステータスバー #
pack .sBar -side bottom -fill x ;# パッカーによる位置決め #
;# #
label .sBar.coordinate -font $font -wraplength 5i -justify right -text "This is only a test." ;# The future. #
pack .sBar.coordinate -side right ;# パッカーによる位置決め #
;# #
canvas .c -background white -width 510 -height 100 ;# キャンバスの定義 #
#pack .c -side bottom -fill x ;# パッカーによる位置決め #
place .c -x 0 -y 25 -anchor nw ;# プレイサーによる位置決め *他もプレイサーなので* #
;# #
pianoRoll 20 13 ;# 描画開始位置を渡してピアノロールの描画を依頼 #
;# #
bind .c <Motion> { motionSense %x %y } ;# モーションイベントを感知して表示させる #
;# #
;# #
#/Region Sense *************************************************# #
# Motion Sense *************************************************# モーション感知 #
proc motionSense { x y } { ;# #
# set size [winfo fpixels .c 1i] ;# そんなに細かい値はいらんです #
# set x [expr $x/$size] ;# #
# set y [expr $y/$size] ;# #
.sBar.coordinate configure \
-text [format "x: %6i y: %6i" $x $y ] ;# 座標のリアルタイム表示 #
# -text [format "x: %6.2fi y: %6.2fi" $x $y ] ;# そんなに細かい値はいらんです #
} ;# #
#/Motion Sense *************************************************# #
修正履歴 †課題 †管理人自身、この言語がいまいち理解できていない。
参考ページ †[Active_State: http://www.activestate.com/Products/activetcl/feature_list.mhtml] |
