share/scripts/_music_keyboard.tcl at main · doomsdayone/openmsx

◆ main openmsx / share / scripts / _music_keyboard.tcl

6.3 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw

# TODO:
# - optimize by precalcing the notes for all reg values
# - make a better visualisation if many channels are available (grouping?)

set_help_text toggle_music_keyboard \
{Puts a music keyboard on the On-Screen-Display for each channel and each
supported sound chip. It is not very practical yet if you have many
sound chips in your currently running MSX. The redder a key on the
keyboard is, the louder the note is played. Use the command again to
remove it. Note: it cannot handle run-time insertion/removal of sound
devices. It can handle changing of machines, though. Not all chips are
supported yet and some channels give not so useful note output (but
still it is nice to see something happening).
Note that displaying these keyboard may cause quite some CPU load!}

namespace eval music_keyboard {

# some useful constants
variable note_strings [list "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B"]
# we define these outside the proc to gain some speed (they are precalculated)
variable loga [expr {log(2 ** (1 / 12.0))}]
variable r3 [expr {log(440.0) / $loga - 57}]

variable keyb_dict
variable note_key_color
variable num_notes
variable machine_switch_trigger_id 0
variable frame_trigger_id 0

proc freq_to_note {freq} {
	variable loga
	variable r3
	expr {($freq < 16) ? -1 : (log($freq) / $loga - $r3)}
}

proc keyboard_init {} {
	variable num_notes
	variable note_strings
	variable note_key_color
	variable keyb_dict
	variable machine_switch_trigger_id

	foreach soundchip [machine_info sounddevice] {
		set channel_count [soundchip_utils::get_num_channels $soundchip]
		for {set channel 0} {$channel < $channel_count} {incr channel} {
			set freq_expr [soundchip_utils::get_frequency_expr $soundchip $channel]
			# skip devices/channels which don't have freq expressions (not implemented yet)
			if {$freq_expr eq "x"} continue
			dict set keyb_dict $soundchip $channel [dict create \
				freq_expr $freq_expr \
				vol_expr  [soundchip_utils::get_volume_expr    $soundchip $channel] \
				prev_note 0]
		}
	}

	# and now create the visualisation (keyboards)
	set num_octaves 9
	set num_notes [expr {$num_octaves * 12}]
	set key_width 3
	set border 1
	set yborder 1
	set step_white [expr {$key_width + $border}] ;# total width of white keys
	set keyboard_height 8
	set white_key_height [expr {$keyboard_height - $yborder}]

	osd create rectangle music_keyboard -scaled true
	set channel_count 0
	dict for {soundchip chip_dict} $keyb_dict {
		set chipname [string map {. _} $soundchip]
		# create surrounding widget for this chip
		dict for {channel chan_dict} $chip_dict {
			osd create rectangle music_keyboard.chip${chipname}ch${channel} \
				-y [expr {$channel_count * $keyboard_height}] \
				-w [expr {($num_octaves * 7) * $step_white + $border}] \
				-h $keyboard_height \
				-rgba 0x101010A0
			set nof_blacks 0
			for {set note 0} {$note < $num_notes} {incr note} {
				set z -1
				set xcor 0
				if {[string range [lindex $note_strings [expr {$note % 12}]] end end] eq "#"} {
					# black key
					dict set note_key_color $note 0x000000
					set h [expr {round($white_key_height * 0.7)}]
					set xcor [expr {($key_width + 1) / 2}]
					incr nof_blacks
				} else {
					# white key
					set h $white_key_height
					dict set note_key_color $note 0xFFFFFF
					set z -2
				}
				osd create rectangle music_keyboard.chip${chipname}ch${channel}.key${note} \
					-x [expr {($note - $nof_blacks) * $step_white + $border + $xcor}] \
					-y 0 -z $z \
					-w $key_width -h $h \
					-rgb [dict get $note_key_color $note]
			}

			set next_to_kbd_x [expr {($num_notes - $nof_blacks) * $step_white + $border}]

			osd create rectangle music_keyboard.ch${channel}chip${chipname}infofield \
				-x $next_to_kbd_x -y [expr {$channel_count * $keyboard_height}] \
				-w [expr {320 - $next_to_kbd_x}] -h $keyboard_height \
				-rgba 0x000000A0
			osd create text music_keyboard.ch${channel}chip${chipname}infofield.notetext \
				-rgb 0xFFFFFF -size [expr {round($keyboard_height * 0.75)}]
			osd create text music_keyboard.ch${channel}chip${chipname}infofield.chlabel \
				-rgb 0x1F1FFF -size [expr {round($keyboard_height * 0.75)}] \
				-x 10 -text "[expr {$channel + 1}] ($soundchip)"
			incr channel_count
		}
	}

	set machine_switch_trigger_id [after machine_switch [namespace code music_keyboard_reset]]
}

proc update_keyboard {} {
	variable keyb_dict
	variable num_notes
	variable note_strings
	variable note_key_color
	variable frame_trigger_id

	dict for {soundchip chip_dict} $keyb_dict {
		dict for {channel chan_dict} $chip_dict {
			set freq_expr [dict get $chan_dict freq_expr]
			set vol_expr  [dict get $chan_dict vol_expr]
			set prev_note [dict get $chan_dict prev_note]

			# make sure OSD widget name doesn't contain dots...
			set chipname [string map {. _} $soundchip]

			set note [expr {round([freq_to_note [eval $freq_expr]])}]
			if {$note != $prev_note} {
				osd configure music_keyboard.chip${chipname}ch${channel}.key${prev_note} \
					-rgb [dict get $note_key_color $prev_note]
			}
			if {($note < $num_notes) && ($note > 0)} {
				set volume [eval $vol_expr]
				set deviation [expr {round(255 * $volume)}]
				set color [dict get $note_key_color $note]
				set color [expr {($color > 0x808080)
				                 ? ($color - (($deviation << 8) + $deviation))
				                 : ($color + ($deviation << 16))}]
				osd configure music_keyboard.chip${chipname}ch${channel}.key${note} \
					-rgb $color

				if {$deviation > 0} {
					set note_text [lindex $note_strings [expr {$note % 12}]]
				} else {
					set note_text ""
				}
				dict set keyb_dict $soundchip $channel prev_note $note
			} else {
				set note_text ""
			}
			osd configure music_keyboard.ch${channel}chip${chipname}infofield.notetext \
				-text $note_text
		}
	}
	set frame_trigger_id [after frame [namespace code update_keyboard]]
}

proc music_keyboard_reset {} {
	if {![osd exists music_keyboard]} {
		error "Please fix a bug in this script!"
	}
	toggle_music_keyboard
	toggle_music_keyboard
}

proc toggle_music_keyboard {} {
	variable machine_switch_trigger_id
	variable frame_trigger_id
	variable keyb_dict

	if {[osd exists music_keyboard]} {
		after cancel $machine_switch_trigger_id
		after cancel $frame_trigger_id
		osd destroy music_keyboard
		unset keyb_dict
	} else {
		keyboard_init
		update_keyboard
	}
	return ""
}

namespace export toggle_music_keyboard

} ;# namespace music_keyboard

namespace import music_keyboard::*

1	# TODO:
2	# - optimize by precalcing the notes for all reg values
3	# - make a better visualisation if many channels are available (grouping?)
4
5	set_help_text toggle_music_keyboard \
6	{Puts a music keyboard on the On-Screen-Display for each channel and each
7	supported sound chip. It is not very practical yet if you have many
8	sound chips in your currently running MSX. The redder a key on the
9	keyboard is, the louder the note is played. Use the command again to
10	remove it. Note: it cannot handle run-time insertion/removal of sound
11	devices. It can handle changing of machines, though. Not all chips are
12	supported yet and some channels give not so useful note output (but
13	still it is nice to see something happening).
14	Note that displaying these keyboard may cause quite some CPU load!}
15
16	namespace eval music_keyboard {
17
18	# some useful constants
19	variable note_strings [list "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B"]
20	# we define these outside the proc to gain some speed (they are precalculated)
21	variable loga [expr {log(2 ** (1 / 12.0))}]
22	variable r3 [expr {log(440.0) / $loga - 57}]
23
24	variable keyb_dict
25	variable note_key_color
26	variable num_notes
27	variable machine_switch_trigger_id 0
28	variable frame_trigger_id 0
29
30	proc freq_to_note {freq} {
31	variable loga
32	variable r3
33	expr {($freq < 16) ? -1 : (log($freq) / $loga - $r3)}
34	}
35
36	proc keyboard_init {} {
37	variable num_notes
38	variable note_strings
39	variable note_key_color
40	variable keyb_dict
41	variable machine_switch_trigger_id
42
43	foreach soundchip [machine_info sounddevice] {
44	set channel_count [soundchip_utils::get_num_channels $soundchip]
45	for {set channel 0} {$channel < $channel_count} {incr channel} {
46	set freq_expr [soundchip_utils::get_frequency_expr $soundchip $channel]
47	# skip devices/channels which don't have freq expressions (not implemented yet)
48	if {$freq_expr eq "x"} continue
49	dict set keyb_dict $soundchip $channel [dict create \
50	freq_expr $freq_expr \
51	vol_expr [soundchip_utils::get_volume_expr $soundchip $channel] \
52	prev_note 0]
53	}
54	}
55
56	# and now create the visualisation (keyboards)
57	set num_octaves 9
58	set num_notes [expr {$num_octaves * 12}]
59	set key_width 3
60	set border 1
61	set yborder 1
62	set step_white [expr {$key_width + $border}] ;# total width of white keys
63	set keyboard_height 8
64	set white_key_height [expr {$keyboard_height - $yborder}]
65
66	osd create rectangle music_keyboard -scaled true
67	set channel_count 0
68	dict for {soundchip chip_dict} $keyb_dict {
69	set chipname [string map {. _} $soundchip]
70	# create surrounding widget for this chip
71	dict for {channel chan_dict} $chip_dict {
72	osd create rectangle music_keyboard.chip${chipname}ch${channel} \
73	-y [expr {$channel_count * $keyboard_height}] \
74	-w [expr {($num_octaves * 7) * $step_white + $border}] \
75	-h $keyboard_height \
76	-rgba 0x101010A0
77	set nof_blacks 0
78	for {set note 0} {$note < $num_notes} {incr note} {
79	set z -1
80	set xcor 0
81	if {[string range [lindex $note_strings [expr {$note % 12}]] end end] eq "#"} {
82	# black key
83	dict set note_key_color $note 0x000000
84	set h [expr {round($white_key_height * 0.7)}]
85	set xcor [expr {($key_width + 1) / 2}]
86	incr nof_blacks
87	} else {
88	# white key
89	set h $white_key_height
90	dict set note_key_color $note 0xFFFFFF
91	set z -2
92	}
93	osd create rectangle music_keyboard.chip${chipname}ch${channel}.key${note} \
94	-x [expr {($note - $nof_blacks) * $step_white + $border + $xcor}] \
95	-y 0 -z $z \
96	-w $key_width -h $h \
97	-rgb [dict get $note_key_color $note]
98	}
99
100	set next_to_kbd_x [expr {($num_notes - $nof_blacks) * $step_white + $border}]
101
102	osd create rectangle music_keyboard.ch${channel}chip${chipname}infofield \
103	-x $next_to_kbd_x -y [expr {$channel_count * $keyboard_height}] \
104	-w [expr {320 - $next_to_kbd_x}] -h $keyboard_height \
105	-rgba 0x000000A0
106	osd create text music_keyboard.ch${channel}chip${chipname}infofield.notetext \
107	-rgb 0xFFFFFF -size [expr {round($keyboard_height * 0.75)}]
108	osd create text music_keyboard.ch${channel}chip${chipname}infofield.chlabel \
109	-rgb 0x1F1FFF -size [expr {round($keyboard_height * 0.75)}] \
110	-x 10 -text "[expr {$channel + 1}] ($soundchip)"
111	incr channel_count
112	}
113	}
114
115	set machine_switch_trigger_id [after machine_switch [namespace code music_keyboard_reset]]
116	}
117
118	proc update_keyboard {} {
119	variable keyb_dict
120	variable num_notes
121	variable note_strings
122	variable note_key_color
123	variable frame_trigger_id
124
125	dict for {soundchip chip_dict} $keyb_dict {
126	dict for {channel chan_dict} $chip_dict {
127	set freq_expr [dict get $chan_dict freq_expr]
128	set vol_expr [dict get $chan_dict vol_expr]
129	set prev_note [dict get $chan_dict prev_note]
130
131	# make sure OSD widget name doesn't contain dots...
132	set chipname [string map {. _} $soundchip]
133
134	set note [expr {round([freq_to_note [eval $freq_expr]])}]
135	if {$note != $prev_note} {
136	osd configure music_keyboard.chip${chipname}ch${channel}.key${prev_note} \
137	-rgb [dict get $note_key_color $prev_note]
138	}
139	if {($note < $num_notes) && ($note > 0)} {
140	set volume [eval $vol_expr]
141	set deviation [expr {round(255 * $volume)}]
142	set color [dict get $note_key_color $note]
143	set color [expr {($color > 0x808080)
144	? ($color - (($deviation << 8) + $deviation))
145	: ($color + ($deviation << 16))}]
146	osd configure music_keyboard.chip${chipname}ch${channel}.key${note} \
147	-rgb $color
148
149	if {$deviation > 0} {
150	set note_text [lindex $note_strings [expr {$note % 12}]]
151	} else {
152	set note_text ""
153	}
154	dict set keyb_dict $soundchip $channel prev_note $note
155	} else {
156	set note_text ""
157	}
158	osd configure music_keyboard.ch${channel}chip${chipname}infofield.notetext \
159	-text $note_text
160	}
161	}
162	set frame_trigger_id [after frame [namespace code update_keyboard]]
163	}
164
165	proc music_keyboard_reset {} {
166	if {![osd exists music_keyboard]} {
167	error "Please fix a bug in this script!"
168	}
169	toggle_music_keyboard
170	toggle_music_keyboard
171	}
172
173	proc toggle_music_keyboard {} {
174	variable machine_switch_trigger_id
175	variable frame_trigger_id
176	variable keyb_dict
177
178	if {[osd exists music_keyboard]} {
179	after cancel $machine_switch_trigger_id
180	after cancel $frame_trigger_id
181	osd destroy music_keyboard
182	unset keyb_dict
183	} else {
184	keyboard_init
185	update_keyboard
186	}
187	return ""
188	}
189
190	namespace export toggle_music_keyboard
191
192	} ;# namespace music_keyboard
193
194	namespace import music_keyboard::*

`/`	Search
`g` `c`	Code
`g` `h`	History
`g` `b`	Bookmarks
`g` `t`	Trust
`y`	Permalink to this state (files and trees)
`?`	This sheet

Keyboard