FrontPage

ピアノロールなGUIを作る

市販DAW並のGUIを目指す。
サンプルコード上のコメントをもって解説に替える。

一旦クローズ

制約事項

ってかよく分かんない。
OSはWindows、Active_Tcl 8.5.5.0で、デモを真似しながらぼちぼちと書いてます。


ファイル名:styleSeq.tcl

# 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 ***************************************************# 個別バーを右

ダブルクリック #

#/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                                ;# パッケージとバージョンの宣言                     #
[添付ファイル一覧] [全ページの添付ファイル一覧]
アップロード可能最大ファイルサイズは 1,024KB です。

管理者パスワード:

修正履歴

  1. パッケージ化してメインファイルをスッキリさす。
  2. 名前空間を活用する。

課題

表面的にはまとまってきたけどまだまだ先は長い。

  1. 個別バーを複数生成した場合の再移動がバグってるから直す。
    # Select Bar ***************************************************# 個別バーをクリック                               #
        set coords [$c coords current]                             ;# 選択したバーの座標の取得                         #
        set bd(x) [lindex $coords 0]                               ;# 選択したバーの水平座標の取得                     #
        set bd(y) [lindex $coords 1]                               ;# 選択したバーの垂直座標の取得                     #
    #/Select Bar ***************************************************# 個別バーをクリック                               #
    
  2. スクローラブルキャンバスにする。 → 打開
  3. バーを右クリックしたら削除できるようにする。 → 打開
  4. MIDI形式でファイルの入出力ができるようにする。
      → 内部データの持ち方をどうするのか、一般的なシーケンサをお手本にすべし。 → 別の機会に
  5. 線画をファイルの読込みで行うようにする。 → 今のところ必要を感じないのでまたいつか

  • 備考

参考ページ

[Active_State: http://www.activestate.com/Products/activetcl/feature_list.mhtml]
[もっとTcl/Tk: http://www.interq.or.jp/japan/s-imai/tcltk/]
[なもなも 屋根裏分室: http://www.geocities.co.jp/SiliconValley/4137/dir1/md.html]


トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2011-06-05 (日) 11:57:30 (4733d)