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

◆ main openmsx / share / scripts / _soundchip_utils.tcl

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

# Several utility procs for usage in other scripts
# don't export anything, just use it from the namespace,
# because these scripts aren't useful for console users
# and should therefore not be exported to the global
# namespace.
#
# These procs are specifically for sound chips.
#
# Born to prevent duplication between scripts for common stuff.

namespace eval soundchip_utils {

proc get_num_channels {soundchip} {
	set num 1
	while {[info exists ::${soundchip}_ch${num}_mute]} {
		incr num
	}
	expr {$num - 1}
}

# It is advised to cache the result of this proc for each channel of each sound device
# before using it, because then a lot will be pre-evaluated and at run time only the
# actual variable stuff will be evaluated.
# We cannot cache it here, because we don't know the names of the sound chips in the
# machine you are going to use this on.
# @param soundchip the name of the soundchip as it appears in the output of
# "machine_info sounddevice"
# @channel the channel for which you want the expression to get the volume, the
# first channel is channel 0 and the channels are the ones as they are output
# by the record_channels command.
# @return expression to calculate the volume of the device for that channel in
# range [0-1]; returns just 'x' in case the chip is not supported.
# @todo:
#  - frequency expressions for (some of?) the drum channels are not correct
#  - implement volume for MoonSound FM (tricky stuff)
#  - actually, don't use regs to calc volume but actual wave data (needs openMSX
#    changes)
#
proc get_volume_expr {soundchip channel} {
	switch [machine_info sounddevice $soundchip] {
		"PSG" {
			set regs "\"${soundchip} regs\""
			return "set keybits \[debug read $regs 7\]; set val \[debug read $regs [expr {$channel + 8}]\]; expr {(\$val & 0x10) ? 1.0 : ((\$val & 0xF) / 15.0) * !((\$keybits >> $channel) & (\$keybits >> [expr {$channel + 3}]) & 1)}"
		}
		"MoonSound wave-part" {
			set regs "\"${soundchip} regs\""
			return "expr {((\[debug read $regs [expr {$channel + 0x68}]\]) >> 7) ? (127 - (\[debug read $regs [expr {$channel + 0x50}]\] >> 1)) / 127.0 : 0.0}";
		}
		"Konami SCC" -
		"Konami SCC+" {
			set regs "\"${soundchip} SCC\""
			return "expr {((\[debug read $regs [expr {$channel + 0xAA}]\] &0xF)) / 15.0 * ((\[debug read $regs 0xAF\] >> $channel) &1)}"
		}
		"MSX-MUSIC" {
			set regs "\"${soundchip} regs\""
			set vol_expr "(\[debug read $regs [expr {$channel + 0x30}]\] & 0x0F)"
			set keyon_expr "(\[debug read $regs [expr {$channel + 0x20}]\] & 0x10)"
			set music_mode_expr "$keyon_expr ? ((15 - $vol_expr) / 15.0) : 0.0"
			set rhythm_expr "\[debug read $regs 0x0E\]"
			if {$channel < 6} {
				# always melody channel
				return "expr {$music_mode_expr}"
			} elseif {$channel < 9} {
				# melody channel when not in rhythm mode
				return "expr {($rhythm_expr & 0x20) ? 0.0 : $music_mode_expr}"
			} elseif {$channel < 14} {
				# rhythm channel (when rhythm mode enabled)
				if {$channel < 12} {
					set vol_expr "(\[debug read $regs [expr {$channel + 0x30 - 3}]\] & 0x0F)"
				} else {
					set vol_expr "(\[debug read $regs [expr {$channel + 0x2E - 3}]\] >> 4)"
				}
				switch $channel {
					 9 {set mask 0x30} ;# BD
					10 {set mask 0x28} ;# SD
					11 {set mask 0x22} ;# T-CYM
					12 {set mask 0x21} ;# HH
					13 {set mask 0x24} ;# TOM
				}
				return "expr {($rhythm_expr & $mask) ? (15 - $vol_expr) / 15.0 : 0.0}"
			} else {
				error "Unknown channel: $channel for $soundchip!"
			}
		}
		"MSX-AUDIO" {
			set regs "\"${soundchip} regs\""
			set ofst [expr {0x43 + $channel + 5 * ($channel / 3)}]
			set keyon_expr "(\[debug read $regs [expr {$channel + 0xB0}]\] & 0x20)"
			set vol_expr {(63 - (\[debug read $regs $ofst\] & 63)) / 63.0}
			set music_mode_expr "($keyon_expr ? [subst $vol_expr] : 0.0)"
			set rhythm_expr "\[debug read $regs 0xBD\]"
			if {$channel < 6} {
				# always melody channel
				return "expr {$music_mode_expr}"
			} elseif {$channel < 9} {
				# melody channel when not in rhythm mode
				return "expr {($rhythm_expr & 0x20) ? 0.0 : $music_mode_expr}"
			} elseif {$channel < 14} {
				# rhythm channel (when rhythm mode enabled)
				switch $channel {
					 9 {set mask 0x30; set ofst 0x53} ;# BD  (slot 16)
					10 {set mask 0x28; set ofst 0x54} ;# SD  (slot 17)
					11 {set mask 0x22; set ofst 0x55} ;# CYM (slot 18)
					12 {set mask 0x21; set ofst 0x51} ;# HH  (slot 13)
					13 {set mask 0x24; set ofst 0x52} ;# TOM (slot 14)
				}
				return "expr {($rhythm_expr & $mask) ? [subst $vol_expr] : 0.0}"
			} elseif {$channel < 15} {
				# ADPCM
				# can we output 0 when no sample is playing?
				return "expr {\[debug read $regs 0x12\] / 255.0}"
			} else {
				error "Unknown channel: $channel for $soundchip!"
			}
		}
		"DCSG" {
			set regs "\"${soundchip} regs\""
			set addr [expr {$channel*3 + 2}]
			if {${channel} == 3} {
				incr addr -1
			}
			return "expr {(15 - \[debug read $regs $addr\]) / 15.0}"
		}
		default {
			return "x"
		}
	}
}

# It is advised to cache the result of this proc for each channel of each sound device
# before using it, because then a lot will be pre-evaluated and at run time only the
# actual variable stuff will be evaluated.
# We cannot cache it here, because we don't know the names of the sound chips in the
# machine you are going to use this on.
# @param soundchip the name of the soundchip as it appears in the output of
# "machine_info sounddevice"
# @channel the channel for which you want the expression to get the frequency, the
# first channel is channel 0 and the channels are the ones as they are output
# by the record_channels command.
# @return expression to calculate the frequency of the device for that channel in
# Hz; returns just 'x' in case the chip is not supported.
# @todo:
#  - implement frequency for MoonSound
#
proc get_frequency_expr {soundchip channel} {
	switch [machine_info sounddevice $soundchip] {
		"PSG" {
			set regs "\"${soundchip} regs\""
			set basefreq [expr {3579545.454545 / 32.0}]
			return "set val \[expr {\[debug read $regs \[expr {0 + ($channel * 2)}\]\] + 256 * ((\[debug read $regs \[expr {1 + ($channel * 2)}\]\]) & 15)}\]; expr {$basefreq/(\$val < 1 ? 1 : \$val)}"
		}
		"Konami SCC" -
		"Konami SCC+" {
			set regs "\"${soundchip} SCC\""
			set basefreq [expr {3579545.454545 / 32.0}]
			return "set val \[expr {\[debug read $regs \[expr {0xA0 + 0 + ($channel * 2)}\]\] + 256 * ((\[debug read $regs \[expr {0xA0 + 1 + ($channel * 2)}\]\]) & 15)}\]; expr {$basefreq/(\$val < 1 ? 1 : \$val)}"
		}
		"MSX-MUSIC" {
			set regs "\"${soundchip} regs\""
			set basefreq [expr {3579545.454545 / 72.0}]
			set factor [expr {$basefreq / (1 << 18)}]
			if {$channel >= 9} {
				#drums
				incr channel -3
			}
			return "expr {(\[debug read $regs [expr {$channel + 0x10}]\] + 256 * ((\[debug read $regs [expr {$channel + 0x20}]\]) & 1)) * $factor * (1 << (((\[debug read $regs [expr {$channel + 0x20}]\]) & 15) >> 1))}"
		}
		"MSX-AUDIO" {
			set regs "\"${soundchip} regs\""
			set basefreq [expr {3579545.454545 / 72.0}]
			if {$channel == 14} { ;# ADPCM
				set factor [expr {$basefreq / (1 << 16)}]
				return "expr {(\[debug read $regs 0x10\] + 256 * \[debug read $regs 0x11\]) * $factor / 10}";# /10 is just to make it fall a bit into a decent range...
			} else {
				set factor [expr {$basefreq / (1 << 19)}]
				if {$channel >= 9} {
					#drums
					incr channel -3
				}
				return "expr {(\[debug read $regs [expr {$channel + 0xA0}]\] + 256 * ((\[debug read $regs [expr {$channel + 0xB0}]\]) & 3)) * $factor * (1 << (((\[debug read $regs [expr {$channel + 0xB0}]\]) & 31) >> 2))}"
			}
		}
		"DCSG" {
			set regs "\"${soundchip} regs\""
			set basefreq [expr {(3579545.454545 / 8.0) / 2.0}]
			set addr [expr {$channel*3}]
			set next_addr [expr {$addr + 1}]
			if {${channel} == 3} {
				# noise channel not supported
				return "x"
			} else {
				return "set period \[expr {\[debug read $regs $addr\] + (\[debug read $regs $next_addr\] << 4)}\]; if {\$period == 0} {set period 1024}; expr {$basefreq / (2*\$period)}"
			}
		}
		default {
			return "x"
		}
	}
}

namespace export get_num_channels
namespace export get_volume_expr
namespace export get_frequency_expr

} ;# namespace soundchip_utils

# Don't import in global namespace, these are only useful in other scripts.

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

e8555c89 Andy McCall 1 month ago	1	# Several utility procs for usage in other scripts
	2	# don't export anything, just use it from the namespace,
	3	# because these scripts aren't useful for console users
	4	# and should therefore not be exported to the global
	5	# namespace.
	6	#
	7	# These procs are specifically for sound chips.
	8	#
	9	# Born to prevent duplication between scripts for common stuff.
	10
	11	namespace eval soundchip_utils {
	12
	13	proc get_num_channels {soundchip} {
	14	set num 1
	15	while {[info exists ::${soundchip}_ch${num}_mute]} {
	16	incr num
	17	}
	18	expr {$num - 1}
	19	}
	20
	21	# It is advised to cache the result of this proc for each channel of each sound device
	22	# before using it, because then a lot will be pre-evaluated and at run time only the
	23	# actual variable stuff will be evaluated.
	24	# We cannot cache it here, because we don't know the names of the sound chips in the
	25	# machine you are going to use this on.
	26	# @param soundchip the name of the soundchip as it appears in the output of
	27	# "machine_info sounddevice"
	28	# @channel the channel for which you want the expression to get the volume, the
	29	# first channel is channel 0 and the channels are the ones as they are output
	30	# by the record_channels command.
	31	# @return expression to calculate the volume of the device for that channel in
	32	# range [0-1]; returns just 'x' in case the chip is not supported.
	33	# @todo:
	34	# - frequency expressions for (some of?) the drum channels are not correct
	35	# - implement volume for MoonSound FM (tricky stuff)
	36	# - actually, don't use regs to calc volume but actual wave data (needs openMSX
	37	# changes)
	38	#
	39	proc get_volume_expr {soundchip channel} {
	40	switch [machine_info sounddevice $soundchip] {
	41	"PSG" {
	42	set regs "\"${soundchip} regs\""
	43	return "set keybits \[debug read $regs 7\]; set val \[debug read $regs [expr {$channel + 8}]\]; expr {(\$val & 0x10) ? 1.0 : ((\$val & 0xF) / 15.0) * !((\$keybits >> $channel) & (\$keybits >> [expr {$channel + 3}]) & 1)}"
	44	}
	45	"MoonSound wave-part" {
	46	set regs "\"${soundchip} regs\""
	47	return "expr {((\[debug read $regs [expr {$channel + 0x68}]\]) >> 7) ? (127 - (\[debug read $regs [expr {$channel + 0x50}]\] >> 1)) / 127.0 : 0.0}";
	48	}
	49	"Konami SCC" -
	50	"Konami SCC+" {
	51	set regs "\"${soundchip} SCC\""
	52	return "expr {((\[debug read $regs [expr {$channel + 0xAA}]\] &0xF)) / 15.0 * ((\[debug read $regs 0xAF\] >> $channel) &1)}"
	53	}
	54	"MSX-MUSIC" {
	55	set regs "\"${soundchip} regs\""
	56	set vol_expr "(\[debug read $regs [expr {$channel + 0x30}]\] & 0x0F)"
	57	set keyon_expr "(\[debug read $regs [expr {$channel + 0x20}]\] & 0x10)"
	58	set music_mode_expr "$keyon_expr ? ((15 - $vol_expr) / 15.0) : 0.0"
	59	set rhythm_expr "\[debug read $regs 0x0E\]"
	60	if {$channel < 6} {
	61	# always melody channel
	62	return "expr {$music_mode_expr}"
	63	} elseif {$channel < 9} {
	64	# melody channel when not in rhythm mode
65	return "expr {($rhythm_expr & 0x20) ? 0.0 : $music_mode_expr}"
66	} elseif {$channel < 14} {
67	# rhythm channel (when rhythm mode enabled)
68	if {$channel < 12} {
69	set vol_expr "(\[debug read $regs [expr {$channel + 0x30 - 3}]\] & 0x0F)"
70	} else {
71	set vol_expr "(\[debug read $regs [expr {$channel + 0x2E - 3}]\] >> 4)"
72	}
73	switch $channel {
74	9 {set mask 0x30} ;# BD
75	10 {set mask 0x28} ;# SD
76	11 {set mask 0x22} ;# T-CYM
77	12 {set mask 0x21} ;# HH
78	13 {set mask 0x24} ;# TOM
79	}
80	return "expr {($rhythm_expr & $mask) ? (15 - $vol_expr) / 15.0 : 0.0}"
81	} else {
82	error "Unknown channel: $channel for $soundchip!"
83	}
84	}
85	"MSX-AUDIO" {
86	set regs "\"${soundchip} regs\""
87	set ofst [expr {0x43 + $channel + 5 * ($channel / 3)}]
88	set keyon_expr "(\[debug read $regs [expr {$channel + 0xB0}]\] & 0x20)"
89	set vol_expr {(63 - (\[debug read $regs $ofst\] & 63)) / 63.0}
90	set music_mode_expr "($keyon_expr ? [subst $vol_expr] : 0.0)"
91	set rhythm_expr "\[debug read $regs 0xBD\]"
92	if {$channel < 6} {
93	# always melody channel
94	return "expr {$music_mode_expr}"
95	} elseif {$channel < 9} {
96	# melody channel when not in rhythm mode
97	return "expr {($rhythm_expr & 0x20) ? 0.0 : $music_mode_expr}"
98	} elseif {$channel < 14} {
99	# rhythm channel (when rhythm mode enabled)
100	switch $channel {
101	9 {set mask 0x30; set ofst 0x53} ;# BD (slot 16)
102	10 {set mask 0x28; set ofst 0x54} ;# SD (slot 17)
103	11 {set mask 0x22; set ofst 0x55} ;# CYM (slot 18)
104	12 {set mask 0x21; set ofst 0x51} ;# HH (slot 13)
105	13 {set mask 0x24; set ofst 0x52} ;# TOM (slot 14)
106	}
107	return "expr {($rhythm_expr & $mask) ? [subst $vol_expr] : 0.0}"
108	} elseif {$channel < 15} {
109	# ADPCM
110	# can we output 0 when no sample is playing?
111	return "expr {\[debug read $regs 0x12\] / 255.0}"
112	} else {
113	error "Unknown channel: $channel for $soundchip!"
114	}
115	}
116	"DCSG" {
117	set regs "\"${soundchip} regs\""
118	set addr [expr {$channel*3 + 2}]
119	if {${channel} == 3} {
120	incr addr -1
121	}
122	return "expr {(15 - \[debug read $regs $addr\]) / 15.0}"
123	}
124	default {
125	return "x"
126	}
127	}
128	}
129
130	# It is advised to cache the result of this proc for each channel of each sound device
131	# before using it, because then a lot will be pre-evaluated and at run time only the
132	# actual variable stuff will be evaluated.
133	# We cannot cache it here, because we don't know the names of the sound chips in the
134	# machine you are going to use this on.
135	# @param soundchip the name of the soundchip as it appears in the output of
136	# "machine_info sounddevice"
137	# @channel the channel for which you want the expression to get the frequency, the
138	# first channel is channel 0 and the channels are the ones as they are output
139	# by the record_channels command.
140	# @return expression to calculate the frequency of the device for that channel in
141	# Hz; returns just 'x' in case the chip is not supported.
142	# @todo:
143	# - implement frequency for MoonSound
144	#
145	proc get_frequency_expr {soundchip channel} {
146	switch [machine_info sounddevice $soundchip] {
147	"PSG" {
148	set regs "\"${soundchip} regs\""
149	set basefreq [expr {3579545.454545 / 32.0}]
150	return "set val \[expr {\[debug read $regs \[expr {0 + ($channel * 2)}\]\] + 256 * ((\[debug read $regs \[expr {1 + ($channel * 2)}\]\]) & 15)}\]; expr {$basefreq/(\$val < 1 ? 1 : \$val)}"
151	}
152	"Konami SCC" -
153	"Konami SCC+" {
154	set regs "\"${soundchip} SCC\""
155	set basefreq [expr {3579545.454545 / 32.0}]
156	return "set val \[expr {\[debug read $regs \[expr {0xA0 + 0 + ($channel * 2)}\]\] + 256 * ((\[debug read $regs \[expr {0xA0 + 1 + ($channel * 2)}\]\]) & 15)}\]; expr {$basefreq/(\$val < 1 ? 1 : \$val)}"
157	}
158	"MSX-MUSIC" {
159	set regs "\"${soundchip} regs\""
160	set basefreq [expr {3579545.454545 / 72.0}]
161	set factor [expr {$basefreq / (1 << 18)}]
162	if {$channel >= 9} {
163	#drums
164	incr channel -3
165	}
166	return "expr {(\[debug read $regs [expr {$channel + 0x10}]\] + 256 * ((\[debug read $regs [expr {$channel + 0x20}]\]) & 1)) * $factor * (1 << (((\[debug read $regs [expr {$channel + 0x20}]\]) & 15) >> 1))}"
167	}
168	"MSX-AUDIO" {
169	set regs "\"${soundchip} regs\""
170	set basefreq [expr {3579545.454545 / 72.0}]
171	if {$channel == 14} { ;# ADPCM
172	set factor [expr {$basefreq / (1 << 16)}]
173	return "expr {(\[debug read $regs 0x10\] + 256 * \[debug read $regs 0x11\]) * $factor / 10}";# /10 is just to make it fall a bit into a decent range...
174	} else {
175	set factor [expr {$basefreq / (1 << 19)}]
176	if {$channel >= 9} {
177	#drums
178	incr channel -3
179	}
180	return "expr {(\[debug read $regs [expr {$channel + 0xA0}]\] + 256 * ((\[debug read $regs [expr {$channel + 0xB0}]\]) & 3)) * $factor * (1 << (((\[debug read $regs [expr {$channel + 0xB0}]\]) & 31) >> 2))}"
181	}
182	}
183	"DCSG" {
184	set regs "\"${soundchip} regs\""
185	set basefreq [expr {(3579545.454545 / 8.0) / 2.0}]
186	set addr [expr {$channel*3}]
187	set next_addr [expr {$addr + 1}]
188	if {${channel} == 3} {
189	# noise channel not supported
190	return "x"
191	} else {
192	return "set period \[expr {\[debug read $regs $addr\] + (\[debug read $regs $next_addr\] << 4)}\]; if {\$period == 0} {set period 1024}; expr {$basefreq / (2*\$period)}"
193	}
194	}
195	default {
196	return "x"
197	}
198	}
199	}
200
201	namespace export get_num_channels
202	namespace export get_volume_expr
203	namespace export get_frequency_expr
204
205	} ;# namespace soundchip_utils
206
207	# Don't import in global namespace, these are only useful in other scripts.

Keyboard