![[PukiWiki]](image/pukiwiki.png "[PukiWiki]")
ピアノロールなGUIを作る †市販DAW並のGUIを目指す。 制約事項 †ってかよく分かんない。 # HEAD *********************************************************# プログラムに必要な諸々 #
source "*:/*****/tcl/lib/mylib/PR_drawing.tcl" ;# ソースファイルの読込み #
package require Tk ;# パッケージの読込み #
package require pr_drawing ;# パッケージの読込み #
#/HEAD *********************************************************# プログラムに必要な諸々 #
# Namespace PIANO_ROLL_MAIN ************************************# 名前空間(PIANO_ROLL_MAIN) #
namespace eval PIANO_ROLL_MAIN { ;# 名前空間 #
namespace export * ;# すべてのプロシージャを公開 #
# Style Seq ****************************************************# Styleシーケンサ #
wm title . "StyleSeq" ;# メインウィンドウのタイトル #
wm geometry . 541x280+250+200 ;# メインウィンドウの大きさと表れる座標 #
;# #
set tk_demoDirectory "*:\\*****\\tcl\\demos\\Tk8.5\\images" ;# xbm形式シルクスクリーンの所在 #
set font {Times 10} ;# フォントの指定 #
;# #
# Set Bar Definition *******************************************# バー定義配列の定義 #
set barDefinition(barLen) 20 ;# バー定義配列(バー長さ) #
set barDefinition(grid_h) 5 ;# バー定義配列(水平方向グリッド) #
set barDefinition(grid_v) 5 ;# バー定義配列(垂直方向グリッド) #
set barDefinition(left) 15 ;# バー定義配列(左限) #
set barDefinition(right) 5435 ;# バー定義配列(右限) #
set barDefinition(top) 13 ;# バー定義配列(上限) #
set barDefinition(bottom) 438 ;# バー定義配列(下限) #
set barDefinition(size) 2 ;# バー定義配列(バーの持ち位置調整) #
set barDefinition(normalStyle) "-fill green -stipple {}" ;# バー定義配列(通常時塗りつぶし) #
;# #
#if {[winfo depth .c] > 0} { ;# ウィンドウの深さで動作を変える(必要なし？) #
# set barDefinition(activeStyle) "-fill red -stipple {}" ;# アクティブ時塗りつぶし #
# set barDefinition(moveStyle) [list -fill yellow \
# -stipple @[file join $tk_demoDirectory gray25.xbm]] ;# 移動時塗りつぶし #
#} else { ;# ウィンドウの深さで動作を変える(必要なし？) #
# set barDefinition(activeStyle) "-fill black -stipple {}" ;# アクティブ時塗りつぶし #
# set barDefinition(moveStyle) [list -fill black \
# -stipple @[file join $tk_demoDirectory gray25.xbm]] ;# 移動時塗りつぶし #
#} ;# #
set barDefinition(activeStyle) "-fill red -stipple {}" ;# アクティブ時塗りつぶし #
set barDefinition(moveStyle) [list -fill yellow \
-stipple @[file join $tk_demoDirectory gray25.xbm]] ;# 移動時塗りつぶし #
#/Set Bar Definition *******************************************# バー定義配列の定義 #
# Tool Bar 01 **************************************************# ツールバー01の生成 #
frame .tBar01 ;# ツールバー01用のフレームを宣言 #
grid .tBar01 -row 0 -columnspan 2 -sticky ew ;# グリッダーによるツールバー01フレームの配置 #
#grid columnconfigure . 1 -weight 1 ;# 水平方向に満たす #
;# #
button .tBar01.exit -font {Times 8} -text "Exit" -command exit ;# 終了ボタンの生成 #
pack .tBar01.exit -side left -padx 2 -pady 2 ;# パッカーによる位置決め #
#pack .tBar01.exit -side left ;# パッカーによる位置決め #
;# #
label .tBar01.l_msg -font $font -wraplength 200 -justify left \
-text "This is only a test." -relief sunken ;# The future. #
pack .tBar01.l_msg -side left -after .tBar01.exit -padx 2 -pady 2 ;# パッカーによる位置決め #
#pack .tBar01.l_msg -side left -after .tBar01.exit ;# パッカーによる位置決め #
;# #
label .tBar01.r_msg -font $font -wraplength 200 -justify left \
-text "This is only a test." -relief sunken ;# The future. #
pack .tBar01.r_msg -side right -fill x -padx 2 -pady 2 ;# パッカーによる位置決め #
#pack .tBar01.r_msg -side right -fill x ;# パッカーによる位置決め #
#/Tool Bar 01 **************************************************# ツールバー01の生成 #
# Canvas for Piano Roll ****************************************# ピアノロールを表示するキャンバスの生成 #
canvas .scaleC -background white -width 486 -height 32 \
-scrollregion {5 2 5475 32} -xscrollcommand {.xsbar set} ;# スクロールキャンバスの定義 #
;# #
canvas .c -background white -width 486 -height 121 \
-scrollregion {5 2 5475 444} \
-xscrollcommand {.xsbar set} -yscrollcommand {.ysbar set} ;# キャンバスの定義 *スクロール領域はゴリ押しで* #
# .c configure -xscrollincrement 0.5i -yscrollincrement 0.05i ;# スクロールの刻み幅 *なんか表示が微妙になる* #
;# #
canvas .keyC -background white -width 50 -height 121 \
-scrollregion {5 2 55 444} -yscrollcommand {.ysbar set} ;# 鍵盤キャンバスの定義 #
# .keyC configure -xscrollincrement 0.5i -yscrollincrement 0.05i ;# スクロールの刻み幅 *なんか表示が微妙になる* #
;# #
#.c configure -scrollregion [.c bbox all] \ ;# これやるとスクロールバーがピタッとこない #
;# #
scrollbar .xsbar -orient horizontal \
-command {::PIANO_ROLL_MAIN::scrollMultiple .c .scaleC 1} ;# 水平方向スクロールバーの宣言 #
scrollbar .ysbar -orient vertical \
-command {::PIANO_ROLL_MAIN::scrollMultiple .c .keyC 0} ;# 垂直方向スクロールバーの宣言 *コマンド横流し* #
;# #
::PR_DRAWING::pianoRoll 25 13 -25 ;# 描画開始座標を渡してピアノロールの描画を依頼 #
;# #
grid .scaleC -row 1 -column 1 -sticky ew -padx 0 ;# グリッダーによるスケールキャンバスの配置 #
grid .keyC -row 2 -column 0 -sticky nsew -padx 0 ;# グリッダーによる鍵盤キャンバスの配置 #
grid .c -row 2 -column 1 -sticky nsew -padx 0 ;# グリッダーによるピアノロールキャンバスの配置 #
grid .ysbar -row 2 -column 2 -sticky ns -padx 0 ;# グリッダーによる垂直方向スクロールバーの配置 #
#grid .keyC .c .ysbar -sticky news ;# グリッダーによるwigdetの配置 #
grid .xsbar -row 3 -columnspan 2 -sticky ew ;# グリッダーによる水平方向スクロールバーの配置 #
#/Canvas for Piano Roll ****************************************# ピアノロールを表示するキャンバスの生成 #
# Sub Canvas ***************************************************# サブキャンバスの生成 #
canvas .subC -background white -width 510 -height 30 ;# サブキャンバスの定義 #
grid .subC -row 4 -columnspan 2 -padx 2 -pady 2 -sticky ew ;# グリッダーによるサブキャンバスの配置 #
;# #
.subC addtag tower withtag [.subC create rect 10 10 40 25 \
-outline black -fill [lindex [.c config -bg] 4]] ;# 塔の生成 #
.subC addtag cBar withtag [::PR_DRAWING::cBarGeneration .subC 15 15 $barDefinition(barLen)] ;# 共通バー生成を依頼 #
#/Sub Canvas ***************************************************# サブキャンバスの生成 #
# Status Bar ***************************************************# ステータスバーの生成 #
frame .sBar -borderwidth 1 -relief sunken ;# いわゆるステータスバー #
grid .sBar -row 5 -columnspan 3 -padx 2 -pady 2 -sticky ew ;# グリッダーによるステータスバーの配置 #
;# #
label .sBar.coordinate -font $font -wraplength 5i -justify left -text "This is only a test." ;# 座標表示用ラベル #
pack .sBar.coordinate -side right ;# パッカーによる位置決め #
;# #
label .sBar.delta -font $font -wraplength 5i -justify left -text "This is only a test." ;# デルタ値表示用ラベル #
pack .sBar.delta -side left ;# パッカーによる位置決め #
#/Status Bar ***************************************************# ステータスバーの生成 #
# Grid Configuration *******************************************# ウィンドウリサイズのための定義 #
grid rowconfigure . 2 -weight 1 ;# リサイズ時にサイズ変更するグリッドを指定 #
grid columnconfigure . 1 -weight 1 ;# リサイズ時にサイズ変更するグリッドを指定 #
#/Grid Configuration *******************************************# ウィンドウリサイズのための定義 #
# BIND *********************************************************# バインダー #
bind .c <Motion> { PIANO_ROLL_MAIN::senseMotion %x %y } ;# モーションイベントを感知して表示させる #
bind .c <Double-1> { PIANO_ROLL_MAIN::barGeneration .c %x %y } ;# キャンバスをダブルクリックした時の動作をbind #
.c bind dBar <1> { PIANO_ROLL_MAIN::selectBar .c %x %y } ;# 個別バーをクリックした時の動作をbind #
.c bind dBar <Double-3> { PIANO_ROLL_MAIN::deleteBar .c } ;# 個別バーを右ダブルクリックした時の動作をbind #
bind .c <B1-Motion> { PIANO_ROLL_MAIN::moveBar .c %x %y } ;# 個別バーをドラッグする動作をbind #
#bind .c <B3-Motion> { PIANO_ROLL_MAIN::moveBar .c %x %y } ;# 個別バーをマウス右ボタンでドラッグする動作をbind #
bind .c <Any-ButtonRelease-1> { PIANO_ROLL_MAIN::releaseBar .c } ;# 個別バーをドロップした時の動作をbind #
#bind .c <Any-ButtonRelease-3> { PIANO_ROLL_MAIN::releaseBar .c } ;# 個別バーをドロップした時の動作をbind #
bind . <F1> { PIANO_ROLL_MAIN::modBarLen .subC 5 } ;# F1を押下した時の動作をbind #
bind . <F2> { PIANO_ROLL_MAIN::modBarLen .subC 10 } ;# F2を押下した時の動作をbind #
bind . <F3> { PIANO_ROLL_MAIN::modBarLen .subC 15 } ;# F3を押下した時の動作をbind #
bind . <F4> { PIANO_ROLL_MAIN::modBarLen .subC 20 } ;# F4を押下した時の動作をbind #
bind .c <1> { focus .c } ;# キャンバスをクリックしたらfocus #
bind .c <MouseWheel> { PIANO_ROLL_MAIN::senseWheels .c %D 0 } ;# ホイールイベントを感知してスクロール(垂直指定) #
bind .c <Shift-MouseWheel> { PIANO_ROLL_MAIN::senseWheels .c %D 1 } ;# Shift + ホイールで水平方向スクロール #
#/BIND *********************************************************# バインダー #
.c yview moveto 0.35 ;# C3が表示されるように #
.keyC yview moveto 0.35 ;# C3が表示されるように #
#/Style Seq ****************************************************# Styleシーケンサ #
# Bar Generation ***********************************************# 個別バーの生成 #
proc barGeneration {c x y} { ;# #
variable ::PIANO_ROLL_MAIN::barDefinition ;# バー定義配列にアクセス #
if {[$c find withtag active] != {}} { ;# アクティブな個別バーが存在するか #
return ;# アクティブな個別バーが存在する場合、処理中断 #
} ;# *ダブルクリックとシングルクリックの競合を防止* #
$c addtag active withtag [::PR_DRAWING::cBarGeneration $c $x $y $barDefinition(barLen)] ;# 個別バー生成を依頼 #
$c addtag dBar withtag active ;# 個別バーの生成 #
set barDefinition(x) $x ;# 水平座標の設定 #
set barDefinition(y) $y ;# 垂直座標の設定 #
moveBar $c $barDefinition(x) $barDefinition(y) ;# バーの移動を依頼 #
} ;# #
#/Bar Generation ***********************************************# 個別バーの生成 #
# Move Bar *****************************************************# バーの移動 #
proc moveBar {c x y} { ;# #
variable ::PIANO_ROLL_MAIN::barDefinition ;# バー定義配列にアクセス #
if {[$c find withtag active] == ""} { ;# アクティブな個別バーが存在しないか #
return ;# アクティブな個別バーが存在しない場合、処理中断 #
} ;# #
set cx [$c canvasx $x $barDefinition(grid_h)] ;# グリッド付加と座標の取得 #
set cy [$c canvasy $y $barDefinition(grid_v)] ;# グリッド付加と座標の取得 #
;# #
set coords [$c coords active] ;# activeタグを持つバーの座標データを取得 #
set actBarWidth [expr {[lindex $coords 2] - [lindex $coords 0]}] ;# 取得した座標データからバーの長さを算出 #
set rLimit [expr { $barDefinition(right) + 20 - $actBarWidth }] ;# 長さの違うバーに対応した右限 #
;# #
if {$cx < $barDefinition(left)} { ;# バーを定義した範囲から出さないように #
set cx $barDefinition(left) ;# 左限 #
} ;# #
if {$cx > $rLimit} { ;# バーを定義した範囲から出さないように #
set cx $rLimit ;# 右限 #
} ;# #
if {$cy < $barDefinition(top)} { ;# バーを定義した範囲から出さないように #
set cy $barDefinition(top) ;# 上限 #
} ;# #
if {$cy > $barDefinition(bottom)} { ;# バーを定義した範囲から出さないように #
set cy $barDefinition(bottom) ;# 下限 #
} ;# #
;# #
set cy [expr {$cy - $barDefinition(size)}] ;# バーの持ち位置の調節 #
eval "$c itemconf active $barDefinition(moveStyle)" ;# バーの状態を移動時のものに変える #
;# #
$c move active [expr {$cx - $barDefinition(x)}] [expr {$cy - $barDefinition(y)}] ;# バーの移動 #
set barDefinition(x) $cx ;# 水平座標の設定 #
set barDefinition(y) $cy ;# 垂直座標の設定 #
} ;# #
#/Move Bar *****************************************************# 個別バーの生成 #
# Release Bar **************************************************# 個別バーを放す #
proc releaseBar c { ;# #
variable ::PIANO_ROLL_MAIN::barDefinition ;# バー定義配列にアクセス #
if {[$c find withtag active] == {}} { ;# アクティブな個別バーが存在するか #
return ;# アクティブな個別バーが存在しない場合、処理中断 #
} ;# #
eval "$c itemconf active $barDefinition(normalStyle)" ;# バーの状態を通常時のものに変える #
$c dtag active ;# activeタグを解除 #
} ;# #
#/Release Bar **************************************************# 個別バーを放す #
# Select Bar ***************************************************# 個別バーをクリック #
proc selectBar {c x y} { ;# #
variable ::PIANO_ROLL_MAIN::barDefinition ;# バー定義配列にアクセス #
if {[$c find withtag active] != {}} { ;# アクティブな個別バーが存在するか #
return ;# アクティブな個別バーが存在する場合、処理中断 #
} ;# *ダブルクリックとシングルクリックの競合を防止* #
$c addtag active withtag current ;# 選択したバーにactiveタグを付与 #
set coords [$c coords active] ;# 選択したバーの座標の取得 #
set barDefinition(x) [lindex $coords 0] ;# 選択したバーの水平座標の取得 #
set barDefinition(y) [lindex $coords 1] ;# 選択したバーの垂直座標の取得 #
eval "$c itemconf active $barDefinition(activeStyle)" ;# バーの状態をアクティブ時のものに変える #
$c raise active ;# activeを浮かせる(移動可能にする) #
# moveBar $c $barDefinition(x) $barDefinition(y) ;# バーの移動を依頼 #
} ;# #
#/Select Bar ***************************************************# 個別バーをクリック #
# Delete Bar ***************************************************# 個別バーを右ダブルクリック #
proc deleteBar c { ;# #
$c delete current ;# 選択されたバーを削除 #
} ;# #
#/Delete Bar ***************************************************# 個別バーを右ダブルクリック #
# Modify Bar Length ********************************************# バーの長さとグリッド幅を変更する #
proc modBarLen {t len} { ;# #
variable ::PIANO_ROLL_MAIN::barDefinition ;# バー定義配列にアクセス #
.subC delete cBar ;# それまでの共通バーを削除 #
set barDefinition(barLen) $len ;# バー定義のグリッド幅を更新 #
.subC addtag cBar withtag [::PR_DRAWING::cBarGeneration .subC 15 15 $len] ;# 共通バーの再生成 #
} ;# #
#/Modify Bar Length ********************************************# バーの長さとグリッド幅を変更する #
# Sense Motion *************************************************# モーション感知 #
proc senseMotion { x y } { ;# #
variable ::PIANO_ROLL_MAIN::.sBar.coordinate ;# ステータスバー座標表示にアクセス #
.sBar.coordinate configure \
-text [format "x: %4i y: %4i" $x $y ] ;# 座標のリアルタイム表示 #
} ;# #
#/Sense Motion *************************************************# モーション感知 #
# Sense Wheels *************************************************# マウスホイール感知 #
proc senseWheels { c d horiz } { ;# #
variable ::PIANO_ROLL_MAIN::.sBar.delta ;# ステータスバーデルタ値表示にアクセス #
.sBar.delta configure \
-text [format "delta: %4i" $d ] ;# デルタ値のリアルタイム表示 #
;# #
if { 0 == $horiz } { ;# 方向指定が垂直か #
if { $d <= 0 } { ;# デルタがネガティブ(-120)か #
$c yview scroll 1 units ;# ネガティブならスクロールダウン #
.keyC yview scroll 1 units ;# ネガティブならスクロールダウン(例外的にこう書く) #
} else { ;# デルタがポジティブ(120)か #
$c yview scroll -1 units ;# ポジティブならスクロールアップ #
.keyC yview scroll -1 units ;# ポジティブならスクロールアップ(例外的にこう書く) #
} ;# #
} else { ;# 方向指定が垂直以外か #
if { $d < 0 } { ;# デルタがネガティブ(-120)か #
$c xview scroll 2 units ;# ネガティブならスクロールライト #
.scaleC xview scroll 2 units ;# ネガティブならスクロールライト(例外的にこう書く) #
} else { ;# デルタがポジティブ(120)か #
$c xview scroll -2 units ;# ポジティブならスクロールレフト #
.scaleC xview scroll -2 units ;# ネガティブならスクロールレフト(例外的にこう書く) #
} ;# #
} ;# #
} ;# #
#/Sense Wheels *************************************************# マウスホイール感知 #
# Scroll Multiple **********************************************# 複数キャンバスのスクロール #
proc scrollMultiple { c1 c2 horiz args } { ;# #
set cnt 0 ;# 引数個数カウンタ #
foreach elem $args { ;# 可変長引数を分割して配列にセット #
set elemA($cnt) $elem ;# #
incr cnt ;# 引数個数カウンタをインクリメント #
} ;# #
;# #
if { 0 == $horiz } { ;# 方向指定が垂直か #
if { 3 == $cnt } { ;# 可変長引数の数が3のとき #
$c1 yview $elemA(0) $elemA(1) $elemA(2) ;# ピアノロールキャンバスのスクロール #
$c2 yview $elemA(0) $elemA(1) $elemA(2) ;# 鍵盤キャンバスのスクロール #
} elseif { 2 == $cnt } { ;# 可変長引数の数が2のとき #
$c1 yview $elemA(0) $elemA(1) ;# ピアノロールキャンバスのスクロール #
$c2 yview $elemA(0) $elemA(1) ;# 鍵盤キャンバスのスクロール #
} else { ;# それ以外のときはよく分からん #
return -1 ;# *スクロールコマンドのオプションは原則的に #
} ;# 3か2しかないと思っています* #
} else { ;# 方向指定が垂直以外か #
if { 3 == $cnt } { ;# 可変長引数の数が3のとき #
$c1 xview $elemA(0) $elemA(1) $elemA(2) ;# ピアノロールキャンバスのスクロール #
$c2 xview $elemA(0) $elemA(1) $elemA(2) ;# スケールキャンバスのスクロール #
} elseif { 2 == $cnt } { ;# 可変長引数の数が2のとき #
$c1 xview $elemA(0) $elemA(1) ;# ピアノロールキャンバスのスクロール #
$c2 xview $elemA(0) $elemA(1) ;# スケールキャンバスのスクロール #
} else { ;# それ以外のときはよく分からん #
return -1 ;# *スクロールコマンドのオプションは原則的に #
} ;# 3か2しかないと思っています* #
} ;# #
# $c1 yview $args ;# オプションNG #
} ;# #
#/Scroll Multiple **********************************************# 複数キャンバスのスクロール #
} ;# #
#/Namespace PIANO_ROLL_MAIN ************************************# 名前空間(PIANO_ROLL_MAIN) #
package provide pr_main 1.00 ;# パッケージとバージョンの宣言 #
ファイル名:pkgIndex.tcl package ifneeded pr_drawing 0.01 [list source [file join $dir pr_drawing.tcl]] ファイル名:PR_drawing.tcl # HEAD *********************************************************# プログラムに必要な諸々 #
package require Tk ;# パッケージの読込み #
#/HEAD *********************************************************# プログラムに必要な諸々 #
# Namespace PR_DRAWING *****************************************# 名前空間(PR_DRAWING) #
namespace eval PR_DRAWING { ;# 名前空間 #
namespace export * ;# すべてのプロシージャを公開 #
# Piano Roll ***************************************************# ピアノロールの描画処理 #
proc pianoRoll { x y z } { ;# パッケージ化してメインファイルをスッキリさせる #
.keyC create rectangle 5 10 25 441 -fill gray -width 0 ;# 左端のグレーゾーン #
.c create rectangle 5456 11 5475 441 -fill gray -width 0 ;# 右端のグレーゾーン #
;# #
.keyC create line 25 10 25 441 -fill black -width 1 ;# 左端の縦線 #
.keyC create line 54 10 54 441 -fill black -width 1 ;# 鍵盤の右辺 #
.c create line 5 10 5475 10 -fill black -width 1 ;# ピアノロールの上辺 #
.keyC create line 5 10 55 10 -fill black -width 1 ;# 鍵盤の上辺 #
.c create line 5 441 5475 441 -fill black -width 1 ;# ピアノロールの下辺 #
.keyC create line 5 441 55 441 -fill black -width 1 ;# 鍵盤の下辺 #
.c create line 5 10 5 441 -fill black -width 1 ;# ピアノロールの左端 #
.c create line 5455 2 5455 441 -fill black -width 1 ;# 右端の縦線 #
.scaleC create line 5455 8 5455 34 -fill black -width 1 ;# 右端の縦線 #
;# #
.keyC create line $x $y [expr { $x + 29 }] $y -fill black -width 1 ;# B-C間の境界線(鍵盤) #
.c create line [expr { $z + 30 }] $y 5455 $y -fill #666666 -width 1 ;# B-C間の境界線(ピアノロール) #
;# #
set pitch 6 ;# 音高表示用 #
for {set cnt 0} {$cnt < 7} {incr cnt} { ;# 鍵盤と境界線の描画 #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 6 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 11 }] -fill black ;# A#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 6 }] \
5455 [expr { $y + 60 * $cnt + 11 }] -fill #AAAAAA -width 0 ;# A#黒鍵(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 8 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 8 }] -fill black -width 1 ;# A-B間の境界線(鍵盤) #
;# #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 16 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 21 }] -fill black ;# G#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 16 }] \
5455 [expr { $y + 60 * $cnt + 21 }] -fill #AAAAAA -width 0 ;# G#黒鍵(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 18 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 18 }] -fill black -width 1 ;# G-A間の境界線(鍵盤)#
;# #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 26 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 31 }] -fill black ;# F#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 26 }] \
5455 [expr { $y + 60 * $cnt + 31 }] -fill #AAAAAA -width 0 ;# F#黒鍵(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 28 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 28 }] -fill black -width 1 ;# F-G間の境界線(鍵盤)#
;# #
.keyC create line $x [expr { $y + 60 * $cnt + 35 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 35 }] -fill black -width 1 ;# E-F間の境界線(鍵盤)#
.c create line [expr { $z + 30 }] [expr { $y + 60 * $cnt + 35 }] \
5455 [expr { $y + 60 * $cnt + 35 }] -fill #666666 -width 1 ;# E-F間の境界線(ピアノロール) #
;# #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 41 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 46 }] -fill black ;# D#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 41 }] \
5455 [expr { $y + 60 * $cnt + 46 }] -fill #AAAAAA -width 0 ;# D#黒鍵(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 43 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 43 }] -fill black -width 1 ;# D-E間の境界線(鍵盤)#
;# #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 51 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 56 }] -fill black ;# C#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 51 }] \
5455 [expr { $y + 60 * $cnt + 56 }] -fill #AAAAAA -width 0 ;# C#黒鍵(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 53 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 53 }] -fill black -width 1 ;# C-D間の境界線(鍵盤)#
;# #
.keyC create text 12 [expr { $y + 60 * $cnt + 55 }] \
-font {Times 7} -text "C[expr {$pitch - $cnt}]" ;# 音高表示 #
;# #
.keyC create line $x [expr { $y + 60 * $cnt + 60 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 60 }] -fill black -width 1 ;# B-C間の境界線(鍵盤)#
.c create line [expr { $z + 30 }] [expr { $y + 60 * $cnt + 60 }] \
5455 [expr { $y + 60 * $cnt + 60 }] -fill #666666 -width 1 ;# B-C間の境界線(ピアノロール) #
;# #
.keyC create line [expr { $x + 17 }] [expr { $y + 60 * $cnt + 68 }] \
[expr { $x + 29 }] [expr { $y + 60 * $cnt + 68 }] -fill black -width 1 ;# A-B間の境界線(鍵盤)#
;# #
expr {$pitch - 1} ;# 音高表示用カウンタをデクリメント #
} ;# #
;# #
.keyC create rectangle $x [expr { $y + 60 * $cnt + 6 }] \
[expr { $x + 17 }] [expr { $y + 60 * $cnt + 8 }] -fill black ;# A#黒鍵(鍵盤) #
.c create rectangle [expr { $z + 30 }] [expr { $y + 60 * $cnt + 6 }] \
5455 [expr { $y + 60 * $cnt + 8 }] -fill #AAAAAA -width 0 ;# A#黒鍵(ピアノロール) #
;# #
for {set cnt 0} {$cnt < 68} {incr cnt} { ;# 小節線の描画 #
set z [expr {($cnt * 80) + 15}] ;# 黒線(小節線)の間隔と開始位置調整オフセット #
.c create line $z 2 $z 441 -width 1 ;# 黒線(小節線)の生成 #
.c create line [expr { $z + 20}] 2 [expr { $z + 20}] 441 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
.c create line [expr { $z + 40}] 2 [expr { $z + 40}] 441 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
.c create line [expr { $z + 60}] 2 [expr { $z + 60}] 441 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
;# #
.scaleC create line $z 14 $z 34 -width 1 ;# 黒線(小節線)の生成 #
.scaleC create text $z 8 -font {Times 7} -text "$cnt" ;# 小節番号の表示 #
.scaleC create line [expr { $z + 20}] 24 [expr { $z + 20}] 34 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
.scaleC create line [expr { $z + 40}] 21 [expr { $z + 40}] 34 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
.scaleC create line [expr { $z + 60}] 24 [expr { $z + 60}] 34 -fill #AAAAAA -width 1 ;# 灰線(四分線)の生成 #
} ;# #
# .c create line 480 8 480 81 -fill #AAAAAA -width 1 ;# 小節線の描画(残り) #
# .c create line 500 8 500 81 -fill #AAAAAA -width 1 ;# #
.c create line 5 10 5 441 -fill black -width 1 ;# 鍵盤の下辺 #
} ;# #
#/Piano Roll ***************************************************# ピアノロールの描画処理 #
# Common Bar Generation ****************************************# 共通バーの生成 #
proc cBarGeneration {c x y l} { ;# #
$c create rectangle $x $y \
[expr {$x + $l}] [expr {$y + 5}] -fill pink ;# 共通バーの生成 #
} ;# #
#/Common Bar Generation ****************************************# 共通バーの生成 #
} ;# #
# Namespace PR_DRAWING *****************************************# 名前空間(PR_DRAWING) #
package provide pr_drawing 1.00 ;# パッケージとバージョンの宣言 #
修正履歴 †
課題 †表面的にはまとまってきたけどまだまだ先は長い。
参考ページ †[Active_State: http://www.activestate.com/Products/activetcl/feature_list.mhtml] |
