tkpanel.tcl

MIDI解码程序(用VC编写)

    }
}

proc PauseCheck {} {
    global Stat
    if {$Stat(Paused)} {
	set Stat(Paused) 0
    }
    DispButtonPlay
}

#
# pause music
#
proc PauseCmd {} {
    global Stat
    if {$Stat(Playing)} {
	if {$Stat(Paused)} {
	    set Stat(Paused) 0
	} else {
	    set Stat(Paused) 1
	}
	DispButtonPlay
	WriteMsg "STOP"
    }
}

#
# stop playing
#
proc StopCmd {} {
    global Stat Config
    if {$Stat(Playing)} {
	WriteMsg "QUIT"
	WriteMsg "XTND"
	set Stat(CurIdx) -1
	SelectNumber
	if {$Config(Tracing)} {
	    TraceReset
	}
	wm title . "TkMidity"
	wm iconname . "TkMidity"
    }
}

#
# quit TkMidity
#
proc QuitCmd {} {
    global Config Stat
    if {$Config(AutoExit) || !$Config(ConfirmExit)} {
	WriteMsg "QUIT"
	WriteMsg "ZAPP"
	return
    }
    set oldpause $Stat(Paused)
    if {!$oldpause} {PauseCmd}
    if {[question "Really Quit TkMidity?" 0]} {
	WriteMsg "QUIT"
	WriteMsg "ZAPP"
	return
    }
    if {!$oldpause} {PauseCmd}
}

#
# play previous file
#
proc PrevCmd {} {
    global Stat Config
    if {$Stat(Playing)} {
	WriteMsg "PREV"
	PauseCheck
    }
    VolumeCmd $Config(CurVol) 1
}

#
# play next file
#
proc NextCmd {} {
    global Stat Config
    if {$Stat(Playing)} {
	WriteMsg "NEXT"
	PauseCheck
    }
    VolumeCmd $Config(CurVol) 1
}

#
# forward/backward 2 secs
#
proc ForwardCmd {} {
    global Stat
    if {$Stat(Playing)} {
	WriteMsg "FWRD"
	PauseCheck
    }
}

proc BackwardCmd {} {
    global Stat
    if {$Stat(Playing)} {
	WriteMsg "BACK"
	PauseCheck
    }
}


#
# volume up/down
#
proc VolUpCmd {} {
    global Stat Config
    if {$Stat(Playing)} {
	VolumeCmd [expr $Config(CurVol) + 5]
    }
}

proc VolDownCmd {} {
    global Stat Config
    if {$Stat(Playing)} {
	VolumeCmd [expr $Config(CurVol) - 5]
    }
}

#----------------
# display configured tables
#
proc DispTables {} {
    global Config
    set allitems {file time text volume button trace}

    foreach i $allitems {
	pack forget .body.$i
	if {$Config(Disp:$i)} {
	    pack .body.$i -side top -fill x
	}
    }
}

#
# save configuration and playing mode
#
proc SaveConfig {} {
    global Config ConfigFile
    set fd [open $ConfigFile w]
    if {$fd != ""} {
	puts $fd "global Config"
	foreach i [array names Config] {
	    puts $fd "set Config($i) $Config($i)"
	}
	close $fd
    }
}

#
# load configuration file
#
proc LoadConfig {} {
    global ConfigFile Stat
    catch {source $ConfigFile}
}

#
# from command line
#
proc InitCmdLine {argc argv} {
    global Config
    set Config(Disp:trace) 0
    for {set i 0} {$i < $argc} {incr i} {
	if {[lindex $argv $i] == "-mode"} {
	    incr i
	    set mode [lindex $argv $i]
	    if {$mode == "trace"} {
		set Config(Tracing) 1
		set Config(Disp:trace) 1
	    } elseif {$mode == "shuffle"} {
		set Config(ShufflePlay) 1
	    } elseif {$mode == "normal"} {
		set Config(ShufflePlay) 0
	    } elseif {$mode == "autostart"} {
		set Config(AutoStart) 1
	    } elseif {$mode == "autoexit"} {
		set Config(AutoExit) 1
	    } elseif {$mode == "repeat"} {
		set Config(RepeatPlay) 1
	    }
	}
    }
}


#
# selection callback of the playing file from listbox
#
proc SelectList {lw pos} {
    global Config Stat
    set idx [$lw nearest $pos]
    if {$idx >= 0 && $idx < $Stat(MaxFiles)} {
	if {$Config(ShufflePlay)} {
	    set found [lsearch -exact $Stat(ShuffleList) $idx]
	    if {$found != -1} {
		set Stat(CurIdx) $found
	    }
	} else {
	    set Stat(CurIdx) $idx
	}
	set Stat(Playing) 1
	PauseCheck
	SelectNumber
    }
}


#
#
#
proc OpenFiles {} {
    global Stat
    set files [filebrowser .browser "" "*.{mid*,kar,lzh,zip}"]
    if {$files != ""} {
	WriteMsg "XPND"
	WriteMsg $files
    }
}

#
#
#
proc CloseFiles {} {
    global Stat
    if {[question "Really Clear List?" 0]} {
	StopCmd
	.body.file.list delete 0 end
	set Stat(MaxFiles) 0
	set Stat(FileList) {}
	set Stat(ShuffleList) {}
    }
}

proc ToggleCurFileMode {} {
    global Config Stat
    if {$Config(CurFileMode) == 0} {
	set Config(CurFileMode) 1
    } else {
	set Config(CurFileMode) 0
    }
    SetTime $Stat(LastSec)
}

#----------------
# create main window
#

proc CreateWindow {} {
    global Config Stat

    # menu bar
    frame .menu -relief raised -bd 1
    pack .menu -side top -expand 1 -fill x

    # File menu
    menubutton .menu.file -text "File" -menu .menu.file.m\
	    -underline 0
    menu .menu.file.m
    .menu.file.m add command -label "Open Files" -underline 0\
	    -command OpenFiles
    .menu.file.m add command -label "Clear List" -underline 0\
	    -command CloseFiles
    .menu.file.m add command -label "Save Config" -underline 0\
	    -command SaveConfig
    .menu.file.m add command -label "About" -underline 0\
	    -command {
	information "TkMidity -- TiMidty Tcl/Tk Version\n  written by T.IWAI"
    }
    .menu.file.m add command -label "Quit" -underline 0\
	    -command QuitCmd

    # Mode menu
    menubutton .menu.mode -text "Mode" -menu .menu.mode.m\
	    -underline 0
    menu .menu.mode.m
    .menu.mode.m add check -label "Repeat" -underline 0\
	    -variable Config(RepeatPlay)
    .menu.mode.m add check -label "Shuffle" -underline 0\
	    -variable Config(ShufflePlay) -command {
	if {$Config(ShufflePlay)} {
	    MakeShuffleList
	} else {
	    set Stat(ShuffleList) {}
	}
    }
    .menu.mode.m add check -label "Auto Start" -underline 5\
	    -variable Config(AutoStart)
    .menu.mode.m add check -label "Auto Exit" -underline 5\
	    -variable Config(AutoExit)
    .menu.mode.m add check -label "Confirm Quit" -underline 0\
	    -variable Config(ConfirmExit)

    # Display menu
    menubutton .menu.disp -text "Display" -menu .menu.disp.m\
	    -underline 0
    menu .menu.disp.m
    .menu.disp.m add check -label "File List" -underline 0\
	    -variable Config(Disp:file) -command "DispTables"
    .menu.disp.m add check -label "Time" -underline 0\
	    -variable Config(Disp:time) -command "DispTables"
    .menu.disp.m add check -label "Messages" -underline 0\
	    -variable Config(Disp:text) -command "DispTables"
    .menu.disp.m add check -label "Volume" -underline 0\
	    -variable Config(Disp:volume) -command "DispTables"
    .menu.disp.m add check -label "Buttons" -underline 0\
	    -variable Config(Disp:button) -command "DispTables"
    if {$Config(Tracing)} {
	.menu.disp.m add check -label "Trace" -underline 1\
		-variable Config(Disp:trace) -command "DispTables"
    }

    pack .menu.file .menu.mode .menu.disp -side left

    # display body
    if {$Stat(new_tcltk)} {
	frame .body -relief flat
    } else {
	frame .body -relief raised -bd 1
    }
    pack .body -side top -expand 1 -fill both

    # current playing file
    button .body.curfile -text "-------- / 00:00" -relief ridge\
	    -command "ToggleCurFileMode"
    pack .body.curfile -side top -expand 1 -fill x

    # playing files list
    frame .body.file -relief raised -bd 1
    scrollbar .body.file.bar -relief sunken\
	    -command ".body.file.list yview"
    pack .body.file.bar -side right -fill y
    if {$Stat(new_tcltk)} {
	listbox .body.file.list -width 36 -height 10 -relief sunken -bd 2\
		-yscroll ".body.file.bar set"
    } else {
	listbox .body.file.list -geometry 36x10 -relief sunken -bd 2\
		-yscroll ".body.file.bar set"
    }
    bind .body.file.list <Button-1> {SelectList %W %y}

    pack .body.file.list -side top -expand 1 -fill both

    # time label and scale
    frame .body.time -relief raised -bd 1
    label .body.time.label -text "0:00 / 0:00"
    pack .body.time.label -side top
    scale .body.time.scale -orient horizontal -length 280\
	    -from 0 -to 100 -tickinterval 10
    bind .body.time.scale <ButtonRelease-1> {JumpCmd [%W get]}
    pack .body.time.scale -side bottom -expand 1 -fill x

    # text browser
    frame .body.text -relief raised -bd 1
    scrollbar .body.text.bar -relief sunken\
	    -command ".body.text.buf yview"
    pack .body.text.bar -side right -fill y
    text .body.text.buf -width 36 -height 12 -relief sunken -bd 2\
	    -wrap word -yscroll ".body.text.bar set"
    bind .body.text.buf <Button-1> { }
    bind .body.text.buf <Any-Key> { }
    pack .body.text.buf -side top -expand 1 -fill both
    button .body.text.clear -text "Clear"\
	    -command ClearMsg
    pack .body.text.clear -side bottom

    # volume label and scale
    frame .body.volume -relief raised -bd 1
    label .body.volume.label -text "Volume:"
    pack .body.volume.label -side top
    scale .body.volume.scale -orient horizontal -length 280\
	    -from 0 -to 200 -tickinterval 25\
	    -showvalue true -label "Volume"\
	    -command VolumeCmd
    pack .body.volume.scale -side bottom -expand 1 -fill x
    .body.volume.scale set $Config(CurVol)

    # buttons
    global bitmap_path
    frame .body.button -relief raised -bd 1
    pack .body.button -side top -expand 1 -fill x
    button .body.button.play -bitmap @$bitmap_path/play.xbm\
	    -command "PlayCmd"
    button .body.button.stop -bitmap @$bitmap_path/stop.xbm\
	    -command "StopCmd"
    button .body.button.prev -bitmap @$bitmap_path/prev.xbm\
	    -command "PrevCmd"
    button .body.button.back -bitmap @$bitmap_path/back.xbm\
	    -command "BackwardCmd"
    button .body.button.fwrd -bitmap @$bitmap_path/fwrd.xbm\
	    -command "ForwardCmd"
    button .body.button.next -bitmap @$bitmap_path/next.xbm\
	    -command "NextCmd"
    button .body.button.pause -bitmap @$bitmap_path/pause.xbm\
	    -command "PauseCmd"
    button .body.button.quit -bitmap @$bitmap_path/quit.xbm\
	    -command "QuitCmd"
    pack .body.button.play .body.button.pause\
	    .body.button.prev .body.button.back\
	    .body.button.stop\
	    .body.button.fwrd .body.button.next\
	    .body.button.quit\
	    -side left -ipadx 4 -pady 2 -fill x

    if {$Config(Tracing)} {
	# trace display
	TraceCreate
    }
    TraceUpdate

    # pack all items
    DispTables

    focus .
    tk_menuBar .menu .menu.file .menu.mode .menu.disp
    bind . <Key-Right> "ForwardCmd"
    bind . <Key-n> "NextCmd"
    bind . <Key-Left> "BackwardCmd"
    bind . <Key-p> "PrevCmd"
    bind . <Key-s> "PauseCmd"
    bind . <Key-Down> "VolDownCmd"
    bind . <Key-v> "VolDownCmd"
    bind . <Key-Up> "VolUpCmd"
    bind . <Key-V> "VolUpCmd"
    bind . <Key-space> "PauseCmd"
    bind . <Return> "PlayCmd"
    bind . <Key-c> "StopCmd"
    bind . <Key-q> "QuitCmd"

    VolumeCmd $Config(CurVol) 1
}