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

◆ main openmsx / share / scripts / _scc_toys.tcl

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

# thanks to bifimsx for his help and his technical documentation @
# http://bifi.msxnet.org/msxnet/tech/scc.html
#
# TODO:
# - optimize! (A LOT!)
# - support SCC-I

set_help_text toggle_scc_viewer\
{Toggles display of the SCC viewer in which you can follow the wave forms and
volume per SCC channel in real time. Note: it doesn't explicitly support SCC-I
yet and it can take up quite some CPU load...}

namespace eval scc_toys {

#scc viewer
variable scc_viewer_active false
variable scc_devices [list]
variable num_samples 32
variable num_channels 5
variable vertical_downscale_factor 4
variable channel_height [expr {256 / $vertical_downscale_factor}]
variable machine_switch_trigger_id 0
variable frame_trigger_id 0
variable volume_address [expr {$num_samples * $num_channels + 2 * $num_channels}]

#scc editor / PSG2SCC
variable active false
variable cur_wp1
variable cur_wp2
variable latch -1
variable regs [list 0xa0 0xa1 0xa2 0xa3 0xa4 0xa5 -1 0xaf 0xaa 0xab 0xac -1 -1 -1 -1 -1]
variable select_device
variable select_device_chan 0

proc update_device_list {} {
	variable scc_devices
	variable select_device

	set scc_devices [list]
	foreach soundchip [machine_info sounddevice] {
		switch [machine_info sounddevice $soundchip] {
			"Konami SCC" -
			"Konami SCC+" {
				lappend scc_devices $soundchip
			}
		}
	}

	if {[llength $scc_devices] == 0} {
		#if no SCC is present try to plug in SCC
		if {![catch {ext scc} errorText]} {
			update_device_list
		} else {
			error "No SCC devices present and failed to insert one: $errorText"
		}
	}

	# for now, always select the first device
	set select_device [lindex $scc_devices 0]
}

proc scc_viewer_init {} {
	variable machine_switch_trigger_id
	variable scc_viewer_active
	variable scc_devices
	variable num_channels
	variable num_samples
	variable vertical_downscale_factor
	variable channel_height

	update_device_list

	#set base element
	osd create rectangle scc_viewer \
		-x 2 \
		-y 2 \
		-alpha 0 \
		-z 100

	set textheight 15
	set border_width 2
	set inter_channel_spacing 8
	set device_width [expr {$num_channels * ($num_samples + $inter_channel_spacing) \
	                       - $inter_channel_spacing + 2 * $border_width}]

	#create channels
	set number 0
	set offset 0
	foreach device $scc_devices {
		osd create rectangle scc_viewer.$device \
			-x [expr {$offset + $number * $device_width}] \
			-h [expr {$channel_height + 2 * $border_width + $textheight}] \
			-w $device_width \
			-rgba 0xffffff20 \
			-clip true
		osd create text scc_viewer.$device.title \
			-rgba 0xffffffff \
			-text $device \
			-size $textheight
		for {set chan 0} {$chan < $num_channels} {incr chan} {
			osd create rectangle scc_viewer.$device.$chan \
				-x [expr {($chan * ($num_samples + $inter_channel_spacing)) + $border_width}] \
				-y [expr {$border_width + $textheight}] \
				-h $channel_height \
				-w $num_samples \
				-rgba "0x0044aa80 0x2266dd80 0x0055cc80 0x44aaff80" \
				-borderrgba 0xffffff80 -bordersize 1 \
				-clip true
			osd create rectangle scc_viewer.$device.$chan.volume \
				-relw 1 \
				-z 1 \
				-rgba 0x0077ff80 \
				-borderrgba 0x0077ffc0 -bordersize 1
			osd create rectangle scc_viewer.$device.$chan.mid \
				-y [expr {$channel_height / 2}] \
				-h 1 \
				-relw 1 \
				-z 3 \
				-rgba 0xdd0000ff
			osd create rectangle scc_viewer.$device.$chan.mid.2 \
				-y -1 \
				-h 3 \
				-relw 1 \
				-rgba 0xff000060
			for {set pos 0} {$pos < $num_samples} {incr pos} {
				osd create rectangle scc_viewer.$device.$chan.$pos \
					-x $pos \
					-y [expr {$channel_height / 2}] \
					-w 2 \
					-z 2 \
					-rgba 0xffffffb0
			}
		}
		incr number
		set offset 10
	}
	set machine_switch_trigger_id [after machine_switch [namespace code scc_viewer_reset]]
}

proc update_scc_viewer {} {
	variable scc_viewer_active
	variable scc_devices
	variable num_channels
	variable num_samples
	variable vertical_downscale_factor
	variable channel_height
	variable frame_trigger_id
	variable volume_address

	if {!$scc_viewer_active} return

	foreach device $scc_devices {
		binary scan [debug read_block "$device SCC" 0 224] c* scc_regs
		for {set chan 0} {$chan < $num_channels} {incr chan} {
			for {set pos 0} {$pos < $num_samples} {incr pos} {
				set scc_wave_new [expr {[get_scc_wave [lindex $scc_regs [expr {($chan * $num_samples) + $pos}]]] / $vertical_downscale_factor}]
					osd configure scc_viewer.$device.$chan.$pos \
						-h $scc_wave_new
			}
			set volume [expr {[lindex $scc_regs [expr {$volume_address + $chan}]] * 4}]
			osd configure scc_viewer.$device.$chan.volume \
				-h $volume \
				-y [expr {($channel_height - $volume) / 2}]
		}
	}
	# set frame_trigger_id [after frame [namespace code {puts [time update_scc_viewer]}]];# for profiling
	set frame_trigger_id [after time 0.05 [namespace code update_scc_viewer]]
}

proc get_scc_wave {sccval} {
	expr {-($sccval < 128 ? $sccval : $sccval - 256)}
}

proc scc_viewer_reset {} {
	variable scc_viewer_active
	if {!$scc_viewer_active} {
		error "Please fix a bug in this script!"
	}
	toggle_scc_viewer
	toggle_scc_viewer
}

proc toggle_scc_viewer {} {
	variable scc_viewer_active
	variable machine_switch_trigger_id
	variable frame_trigger_id

	if {$scc_viewer_active} {
		after cancel $machine_switch_trigger_id
		after cancel $frame_trigger_id
		set scc_viewer_active false
		osd destroy scc_viewer
	} else {
		scc_viewer_init
		set scc_viewer_active true
		update_scc_viewer
	}
	return ""
}

proc init {} {
	variable select_device
	update_device_list

	set_scc_wave $select_device 0 3
	set_scc_wave $select_device 1 2
	set_scc_wave $select_device 2 3
}

proc update1 {} {
	variable latch
	set latch $::wp_last_value
}

proc update2 {} {
	variable latch
	variable regs
	variable select_device

	set reg [expr {($latch == -1) ? $latch : [lindex $regs $latch]}]
	set val $::wp_last_value
	if {$latch == 7} {set val [expr {($val ^ 0x07) & 0x07}]}
	if {$reg != -1} {
		if {[catch {debug write "$select_device SCC" $reg $val}]} {
			# device gone? Let's deactivate
			toggle_psg2scc
		}
	}
}

proc toggle_psg2scc {} {
	variable active
	variable cur_wp1
	variable cur_wp2
	variable select_device

	if {!$active} {
		init
		set active true
		set cur_wp1 [debug set_watchpoint write_io 0xa0 1 {scc_toys::update1}]
		set cur_wp2 [debug set_watchpoint write_io 0xa1 1 {scc_toys::update2}]
		return "Activated."
	} else {
		debug remove_watchpoint $cur_wp1
		debug remove_watchpoint $cur_wp2
		catch { ;# may fail if device is gone
			debug write "$select_device SCC" 0xaf 0
		}
		set active false
		return "Deactivated."
	}
}

proc set_scc_form {device channel wave} {
	set base [expr {$channel * 32}]
	for {set i 0} {$i < 32} {incr i} {
		debug write "$device SCC" [expr {$base + $i}] "0x[string range $wave [expr {$i * 2}] [expr {$i * 2 + 1}]]"
	}
}

proc set_scc_wave {device channel form} {
	switch $form {
		0 { #Saw Tooth
			set_scc_form $device $channel "fff7efe7dfd7cfc7bfb7afa79f978f877f776f675f574f473f372f271f170f07"
		}
		1 { #Square
			set_scc_form $device $channel "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f80808080808080808080808080808080"
		}
		2 { #Triangle
			set_scc_form $device $channel "7f7060504030201000f0e0d0c0b0a0908090a0b0c0d0e0f00010203040506070"
		}
		3 { #Sin Wave
			set_scc_form $device $channel "001931475A6A757D7F7D756A5A47311900E7CFB9A6968B8380838B96A6B9CFE7"
		}
		4 { #Organ
			set_scc_form $device $channel "0070502050703000507F6010304000B0106000E0F000B090C010E0A0C0F0C0A0"
		}
		5 { #SAWWY001
			set_scc_form $device $channel "636E707070705F2198858080808086AB40706F8C879552707052988080808EC1"
		}
		6 { #SQROOT01
			set_scc_form $device $channel "00407F401001EAD6C3B9AFA49C958F8A86838183868A8F959CA4AFB9C3D6EAFF"
		}
		7 { #SQROOT01
			set_scc_form $device $channel "636E707070705F2198858080808086AB40706F8C879552707052988080808EC1"
		}
		8 { #DYERVC01
			set_scc_form $device $channel "00407F4001C081C001407F4001C0014001E0012001F0011001FFFFFFFF404040"
		}
		9 { #SPACY
			set_scc_form $device $channel "808ea0c0e000203f3e3c3a373129201c1000e6c0d000203f10e080c000200090"
		}
	}
}

#SCC editor/copier
proc toggle_scc_editor {} {
	variable select_device

	if {![osd exists scc_viewer]} {toggle_scc_viewer}

	# If exists destory/reset and exit
	if {[osd exists scc]} {
		osd destroy scc
		osd destroy selected
		# Let's assume the user doesn't have the SCC Viewer active
		toggle_scc_viewer
		deactivate_input_layer scc_editor
		return ""
	}

	bind -layer scc_editor "mouse button1 down" {scc_toys::checkclick}
	activate_input_layer scc_editor

	osd create rectangle scc \
		-x 200 -y 100 -h 256 -w 256 \
		-rgba "0x0044aa80 0x2266dd80 0x0055cc80 0x44aaff80" \
		-borderrgba 0xffffffff -bordersize 1
	for {set i 0} {$i < 32} {incr i} {
		osd create rectangle scc.slider$i -x [expr {$i * 8}] -y 0 -h 255 -w 8 -rgba 0x0000ff80
		osd create rectangle scc.slider$i.val -x 0 -y 127 -h 1 -w 8 -rgba 0xffffff90
	}

	for {set i 0} {$i < 32} {incr i} {
		osd create rectangle "scc.hline$i" -x [expr {$i * 8 - 1}] -y 0 -h 255 -w 1 -rgba 0xffffff60
		osd create rectangle "scc.vline$i" -x 0 -y [expr {$i * 8 - 1}] -h 1 -w 255 -rgba 0xffffff60
	}

	osd create rectangle "scc.hmid1" -x 63 -y 0 -h 255 -w 1 -rgba 0xff000080
	osd create text      "scc.hmid1.text" -x -2 -y -12 -text "7" -size 8 -rgba 0xffffffff

	osd create rectangle "scc.hmid2" -x 127 -y 0 -h 255 -w 1 -rgba 0xffffffff
	osd create text      "scc.hmid2.text" -x -5 -y -12 -text "15" -size 8 -rgba 0xffffffff

	osd create rectangle "scc.hmid3" -x 191 -y 0 -h 255 -w 1 -rgba 0xff000080
	osd create text      "scc.hmid3.text" -x -5 -y -12 -text "23" -size 8 -rgba 0xffffffff

	osd create text      "scc.hline0.text" -x 0 -y -12 -text "0" -size 8 -rgba 0xffffffff
	osd create text      "scc.hline31.text" -x 0 -y -12 -text "31" -size 8 -rgba 0xffffffff

	osd create rectangle "scc.vmid1" -x 0 -y 63 -h 1 -w 255 -rgba 0xff000080
	osd create text      "scc.vmid1.text" -x -20 -y -4 -text "+64" -size 8 -rgba 0xffffffff

	osd create rectangle "scc.vmid2" -x 0 -y 127 -h 1 -w 255 -rgba 0xffffffff
	osd create text      "scc.vmid2.text" -x -10 -y -4 -text "0" -size 8 -rgba 0xffffffff

	osd create rectangle "scc.vmid3" -x 0 -y 191 -h 1 -w 255 -rgba 0xff000080
	osd create text      "scc.vmid3.text" -x -18 -y -4 -text "-64" -size 8 -rgba 0xffffffff

	osd create text      "scc.vline0.text" -x -25 -y 0 -text "+128" -size 8 -rgba 0xffffffff
	osd create text      "scc.vline31.text" -x -22 -y 0 -text "-128" -size 8 -rgba 0xffffffff

	osd create rectangle selected

	return ""
}

proc checkclick {} {
	variable scc_devices
	variable select_device
	variable select_device_chan

	#check editor matrix
	for {set i 0} {$i < 32} {incr i} {
		lassign [osd info "scc.slider$i" -mousecoord] x y
		if {($x >= 0 && $x <= 1) && ($y >= 0 && $y <= 1)} {
			debug write "$select_device SCC" [expr {$select_device_chan * 32 + $i}] [expr {int(255 * $y - 128) & 0xff}]
			osd configure scc.slider$i.val \
				-y [expr {$y * 255}] \
				-h [expr {128 - ($y * 255)}]
		}
	}

	#check scc viewer channels
	foreach device $scc_devices {
		for {set i 0} {$i < 5} {incr i} {
			lassign [osd info "scc_viewer.$device.$i" -mousecoord] x y
			if {($x >= 0 && $x <= 1) && ($y >= 0 && $y <= 1)} {
				#store device and channel picked from the SCC_viewer in memory
				set select_device $device
				set select_device_chan $i

				set abs_x [osd info "scc_viewer.$device" -x]
				set sel_h [osd info "scc_viewer.$device.$i" -h]
				set sel_w [osd info "scc_viewer.$device.$i" -w]
				set sel_x [osd info "scc_viewer.$device.$i" -x]
				set sel_y [osd info "scc_viewer.$device.$i" -y]

				osd configure selected \
					-x [expr {int($sel_x) + $abs_x}] \
					-y [expr {int($sel_y)}] \
					-w [expr {$sel_w + 4}] \
					-h [expr {$sel_h + 4}] \
					-z 1 \
					-rgba 0xff0000ff

				set base [expr {$i * 32}]
				for {set q 0} {$q < 32} {incr q} {
					set sccwave_new [get_scc_wave [debug read "$device SCC" [expr {$base + $q}]]]
					set sccwave_old [osd info scc.slider$q.val -h]
					osd configure scc.slider$q.val \
						-y [expr {128 + $y}] \
						-h $sccwave_new
				}
			}
		}
	}
}

proc get_val_matrix_column {sccval} {
	expr {$sccval < 0 ? $sccval + 256 : $sccval}
}

proc get_scc_string_from_matrix {name} {
	set sccstring ""
	set outputfile "$name"
	set output [open $outputfile "w"]

	for {set i 0} {$i < 32} {incr i} {
		set a [format %02x [get_val_matrix_column [expr {int([osd info scc.slider$i.val -h])}]]]
		set sccstring [concat $sccstring$a]
	}

	close $output

	puts "$outputfile writen to $name"
	return $sccstring
}

namespace export toggle_scc_editor
namespace export toggle_psg2scc
namespace export set_scc_wave
namespace export toggle_scc_viewer

} ;# namespace scc_toys

namespace import scc_toys::*

`/`	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	# thanks to bifimsx for his help and his technical documentation @
	2	# http://bifi.msxnet.org/msxnet/tech/scc.html
	3	#
	4	# TODO:
	5	# - optimize! (A LOT!)
	6	# - support SCC-I
	7
	8	set_help_text toggle_scc_viewer\
	9	{Toggles display of the SCC viewer in which you can follow the wave forms and
	10	volume per SCC channel in real time. Note: it doesn't explicitly support SCC-I
	11	yet and it can take up quite some CPU load...}
	12
	13	namespace eval scc_toys {
	14
	15	#scc viewer
	16	variable scc_viewer_active false
	17	variable scc_devices [list]
	18	variable num_samples 32
	19	variable num_channels 5
	20	variable vertical_downscale_factor 4
	21	variable channel_height [expr {256 / $vertical_downscale_factor}]
	22	variable machine_switch_trigger_id 0
	23	variable frame_trigger_id 0
	24	variable volume_address [expr {$num_samples * $num_channels + 2 * $num_channels}]
	25
	26	#scc editor / PSG2SCC
	27	variable active false
	28	variable cur_wp1
	29	variable cur_wp2
	30	variable latch -1
	31	variable regs [list 0xa0 0xa1 0xa2 0xa3 0xa4 0xa5 -1 0xaf 0xaa 0xab 0xac -1 -1 -1 -1 -1]
	32	variable select_device
	33	variable select_device_chan 0
	34
	35	proc update_device_list {} {
	36	variable scc_devices
	37	variable select_device
	38
	39	set scc_devices [list]
	40	foreach soundchip [machine_info sounddevice] {
	41	switch [machine_info sounddevice $soundchip] {
	42	"Konami SCC" -
	43	"Konami SCC+" {
	44	lappend scc_devices $soundchip
	45	}
	46	}
	47	}
	48
	49	if {[llength $scc_devices] == 0} {
	50	#if no SCC is present try to plug in SCC
	51	if {![catch {ext scc} errorText]} {
	52	update_device_list
	53	} else {
	54	error "No SCC devices present and failed to insert one: $errorText"
	55	}
	56	}
	57
	58	# for now, always select the first device
	59	set select_device [lindex $scc_devices 0]
	60	}
	61
	62	proc scc_viewer_init {} {
	63	variable machine_switch_trigger_id
	64	variable scc_viewer_active
65	variable scc_devices
66	variable num_channels
67	variable num_samples
68	variable vertical_downscale_factor
69	variable channel_height
70
71	update_device_list
72
73	#set base element
74	osd create rectangle scc_viewer \
75	-x 2 \
76	-y 2 \
77	-alpha 0 \
78	-z 100
79
80	set textheight 15
81	set border_width 2
82	set inter_channel_spacing 8
83	set device_width [expr {$num_channels * ($num_samples + $inter_channel_spacing) \
84	- $inter_channel_spacing + 2 * $border_width}]
85
86	#create channels
87	set number 0
88	set offset 0
89	foreach device $scc_devices {
90	osd create rectangle scc_viewer.$device \
91	-x [expr {$offset + $number * $device_width}] \
92	-h [expr {$channel_height + 2 * $border_width + $textheight}] \
93	-w $device_width \
94	-rgba 0xffffff20 \
95	-clip true
96	osd create text scc_viewer.$device.title \
97	-rgba 0xffffffff \
98	-text $device \
99	-size $textheight
100	for {set chan 0} {$chan < $num_channels} {incr chan} {
101	osd create rectangle scc_viewer.$device.$chan \
102	-x [expr {($chan * ($num_samples + $inter_channel_spacing)) + $border_width}] \
103	-y [expr {$border_width + $textheight}] \
104	-h $channel_height \
105	-w $num_samples \
106	-rgba "0x0044aa80 0x2266dd80 0x0055cc80 0x44aaff80" \
107	-borderrgba 0xffffff80 -bordersize 1 \
108	-clip true
109	osd create rectangle scc_viewer.$device.$chan.volume \
110	-relw 1 \
111	-z 1 \
112	-rgba 0x0077ff80 \
113	-borderrgba 0x0077ffc0 -bordersize 1
114	osd create rectangle scc_viewer.$device.$chan.mid \
115	-y [expr {$channel_height / 2}] \
116	-h 1 \
117	-relw 1 \
118	-z 3 \
119	-rgba 0xdd0000ff
120	osd create rectangle scc_viewer.$device.$chan.mid.2 \
121	-y -1 \
122	-h 3 \
123	-relw 1 \
124	-rgba 0xff000060
125	for {set pos 0} {$pos < $num_samples} {incr pos} {
126	osd create rectangle scc_viewer.$device.$chan.$pos \
127	-x $pos \
128	-y [expr {$channel_height / 2}] \
129	-w 2 \
130	-z 2 \
131	-rgba 0xffffffb0
132	}
133	}
134	incr number
135	set offset 10
136	}
137	set machine_switch_trigger_id [after machine_switch [namespace code scc_viewer_reset]]
138	}
139
140	proc update_scc_viewer {} {
141	variable scc_viewer_active
142	variable scc_devices
143	variable num_channels
144	variable num_samples
145	variable vertical_downscale_factor
146	variable channel_height
147	variable frame_trigger_id
148	variable volume_address
149
150	if {!$scc_viewer_active} return
151
152	foreach device $scc_devices {
153	binary scan [debug read_block "$device SCC" 0 224] c* scc_regs
154	for {set chan 0} {$chan < $num_channels} {incr chan} {
155	for {set pos 0} {$pos < $num_samples} {incr pos} {
156	set scc_wave_new [expr {[get_scc_wave [lindex $scc_regs [expr {($chan * $num_samples) + $pos}]]] / $vertical_downscale_factor}]
157	osd configure scc_viewer.$device.$chan.$pos \
158	-h $scc_wave_new
159	}
160	set volume [expr {[lindex $scc_regs [expr {$volume_address + $chan}]] * 4}]
161	osd configure scc_viewer.$device.$chan.volume \
162	-h $volume \
163	-y [expr {($channel_height - $volume) / 2}]
164	}
165	}
166	# set frame_trigger_id [after frame [namespace code {puts [time update_scc_viewer]}]];# for profiling
167	set frame_trigger_id [after time 0.05 [namespace code update_scc_viewer]]
168	}
169
170	proc get_scc_wave {sccval} {
171	expr {-($sccval < 128 ? $sccval : $sccval - 256)}
172	}
173
174	proc scc_viewer_reset {} {
175	variable scc_viewer_active
176	if {!$scc_viewer_active} {
177	error "Please fix a bug in this script!"
178	}
179	toggle_scc_viewer
180	toggle_scc_viewer
181	}
182
183	proc toggle_scc_viewer {} {
184	variable scc_viewer_active
185	variable machine_switch_trigger_id
186	variable frame_trigger_id
187
188	if {$scc_viewer_active} {
189	after cancel $machine_switch_trigger_id
190	after cancel $frame_trigger_id
191	set scc_viewer_active false
192	osd destroy scc_viewer
193	} else {
194	scc_viewer_init
195	set scc_viewer_active true
196	update_scc_viewer
197	}
198	return ""
199	}
200
201	proc init {} {
202	variable select_device
203	update_device_list
204
205	set_scc_wave $select_device 0 3
206	set_scc_wave $select_device 1 2
207	set_scc_wave $select_device 2 3
208	}
209
210	proc update1 {} {
211	variable latch
212	set latch $::wp_last_value
213	}
214
215	proc update2 {} {
216	variable latch
217	variable regs
218	variable select_device
219
220	set reg [expr {($latch == -1) ? $latch : [lindex $regs $latch]}]
221	set val $::wp_last_value
222	if {$latch == 7} {set val [expr {($val ^ 0x07) & 0x07}]}
223	if {$reg != -1} {
224	if {[catch {debug write "$select_device SCC" $reg $val}]} {
225	# device gone? Let's deactivate
226	toggle_psg2scc
227	}
228	}
229	}
230
231	proc toggle_psg2scc {} {
232	variable active
233	variable cur_wp1
234	variable cur_wp2
235	variable select_device
236
237	if {!$active} {
238	init
239	set active true
240	set cur_wp1 [debug set_watchpoint write_io 0xa0 1 {scc_toys::update1}]
241	set cur_wp2 [debug set_watchpoint write_io 0xa1 1 {scc_toys::update2}]
242	return "Activated."
243	} else {
244	debug remove_watchpoint $cur_wp1
245	debug remove_watchpoint $cur_wp2
246	catch { ;# may fail if device is gone
247	debug write "$select_device SCC" 0xaf 0
248	}
249	set active false
250	return "Deactivated."
251	}
252	}
253
254	proc set_scc_form {device channel wave} {
255	set base [expr {$channel * 32}]
256	for {set i 0} {$i < 32} {incr i} {
257	debug write "$device SCC" [expr {$base + $i}] "0x[string range $wave [expr {$i * 2}] [expr {$i * 2 + 1}]]"
258	}
259	}
260
261	proc set_scc_wave {device channel form} {
262	switch $form {
263	0 { #Saw Tooth
264	set_scc_form $device $channel "fff7efe7dfd7cfc7bfb7afa79f978f877f776f675f574f473f372f271f170f07"
265	}
266	1 { #Square
267	set_scc_form $device $channel "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f80808080808080808080808080808080"
268	}
269	2 { #Triangle
270	set_scc_form $device $channel "7f7060504030201000f0e0d0c0b0a0908090a0b0c0d0e0f00010203040506070"
271	}
272	3 { #Sin Wave
273	set_scc_form $device $channel "001931475A6A757D7F7D756A5A47311900E7CFB9A6968B8380838B96A6B9CFE7"
274	}
275	4 { #Organ
276	set_scc_form $device $channel "0070502050703000507F6010304000B0106000E0F000B090C010E0A0C0F0C0A0"
277	}
278	5 { #SAWWY001
279	set_scc_form $device $channel "636E707070705F2198858080808086AB40706F8C879552707052988080808EC1"
280	}
281	6 { #SQROOT01
282	set_scc_form $device $channel "00407F401001EAD6C3B9AFA49C958F8A86838183868A8F959CA4AFB9C3D6EAFF"
283	}
284	7 { #SQROOT01
285	set_scc_form $device $channel "636E707070705F2198858080808086AB40706F8C879552707052988080808EC1"
286	}
287	8 { #DYERVC01
288	set_scc_form $device $channel "00407F4001C081C001407F4001C0014001E0012001F0011001FFFFFFFF404040"
289	}
290	9 { #SPACY
291	set_scc_form $device $channel "808ea0c0e000203f3e3c3a373129201c1000e6c0d000203f10e080c000200090"
292	}
293	}
294	}
295
296	#SCC editor/copier
297	proc toggle_scc_editor {} {
298	variable select_device
299
300	if {![osd exists scc_viewer]} {toggle_scc_viewer}
301
302	# If exists destory/reset and exit
303	if {[osd exists scc]} {
304	osd destroy scc
305	osd destroy selected
306	# Let's assume the user doesn't have the SCC Viewer active
307	toggle_scc_viewer
308	deactivate_input_layer scc_editor
309	return ""
310	}
311
312	bind -layer scc_editor "mouse button1 down" {scc_toys::checkclick}
313	activate_input_layer scc_editor
314
315	osd create rectangle scc \
316	-x 200 -y 100 -h 256 -w 256 \
317	-rgba "0x0044aa80 0x2266dd80 0x0055cc80 0x44aaff80" \
318	-borderrgba 0xffffffff -bordersize 1
319	for {set i 0} {$i < 32} {incr i} {
320	osd create rectangle scc.slider$i -x [expr {$i * 8}] -y 0 -h 255 -w 8 -rgba 0x0000ff80
321	osd create rectangle scc.slider$i.val -x 0 -y 127 -h 1 -w 8 -rgba 0xffffff90
322	}
323
324	for {set i 0} {$i < 32} {incr i} {
325	osd create rectangle "scc.hline$i" -x [expr {$i * 8 - 1}] -y 0 -h 255 -w 1 -rgba 0xffffff60
326	osd create rectangle "scc.vline$i" -x 0 -y [expr {$i * 8 - 1}] -h 1 -w 255 -rgba 0xffffff60
327	}
328
329	osd create rectangle "scc.hmid1" -x 63 -y 0 -h 255 -w 1 -rgba 0xff000080
330	osd create text "scc.hmid1.text" -x -2 -y -12 -text "7" -size 8 -rgba 0xffffffff
331
332	osd create rectangle "scc.hmid2" -x 127 -y 0 -h 255 -w 1 -rgba 0xffffffff
333	osd create text "scc.hmid2.text" -x -5 -y -12 -text "15" -size 8 -rgba 0xffffffff
334
335	osd create rectangle "scc.hmid3" -x 191 -y 0 -h 255 -w 1 -rgba 0xff000080
336	osd create text "scc.hmid3.text" -x -5 -y -12 -text "23" -size 8 -rgba 0xffffffff
337
338	osd create text "scc.hline0.text" -x 0 -y -12 -text "0" -size 8 -rgba 0xffffffff
339	osd create text "scc.hline31.text" -x 0 -y -12 -text "31" -size 8 -rgba 0xffffffff
340
341	osd create rectangle "scc.vmid1" -x 0 -y 63 -h 1 -w 255 -rgba 0xff000080
342	osd create text "scc.vmid1.text" -x -20 -y -4 -text "+64" -size 8 -rgba 0xffffffff
343
344	osd create rectangle "scc.vmid2" -x 0 -y 127 -h 1 -w 255 -rgba 0xffffffff
345	osd create text "scc.vmid2.text" -x -10 -y -4 -text "0" -size 8 -rgba 0xffffffff
346
347	osd create rectangle "scc.vmid3" -x 0 -y 191 -h 1 -w 255 -rgba 0xff000080
348	osd create text "scc.vmid3.text" -x -18 -y -4 -text "-64" -size 8 -rgba 0xffffffff
349
350	osd create text "scc.vline0.text" -x -25 -y 0 -text "+128" -size 8 -rgba 0xffffffff
351	osd create text "scc.vline31.text" -x -22 -y 0 -text "-128" -size 8 -rgba 0xffffffff
352
353	osd create rectangle selected
354
355	return ""
356	}
357
358	proc checkclick {} {
359	variable scc_devices
360	variable select_device
361	variable select_device_chan
362
363	#check editor matrix
364	for {set i 0} {$i < 32} {incr i} {
365	lassign [osd info "scc.slider$i" -mousecoord] x y
366	if {($x >= 0 && $x <= 1) && ($y >= 0 && $y <= 1)} {
367	debug write "$select_device SCC" [expr {$select_device_chan * 32 + $i}] [expr {int(255 * $y - 128) & 0xff}]
368	osd configure scc.slider$i.val \
369	-y [expr {$y * 255}] \
370	-h [expr {128 - ($y * 255)}]
371	}
372	}
373
374	#check scc viewer channels
375	foreach device $scc_devices {
376	for {set i 0} {$i < 5} {incr i} {
377	lassign [osd info "scc_viewer.$device.$i" -mousecoord] x y
378	if {($x >= 0 && $x <= 1) && ($y >= 0 && $y <= 1)} {
379	#store device and channel picked from the SCC_viewer in memory
380	set select_device $device
381	set select_device_chan $i
382
383	set abs_x [osd info "scc_viewer.$device" -x]
384	set sel_h [osd info "scc_viewer.$device.$i" -h]
385	set sel_w [osd info "scc_viewer.$device.$i" -w]
386	set sel_x [osd info "scc_viewer.$device.$i" -x]
387	set sel_y [osd info "scc_viewer.$device.$i" -y]
388
389	osd configure selected \
390	-x [expr {int($sel_x) + $abs_x}] \
391	-y [expr {int($sel_y)}] \
392	-w [expr {$sel_w + 4}] \
393	-h [expr {$sel_h + 4}] \
394	-z 1 \
395	-rgba 0xff0000ff
396
397	set base [expr {$i * 32}]
398	for {set q 0} {$q < 32} {incr q} {
399	set sccwave_new [get_scc_wave [debug read "$device SCC" [expr {$base + $q}]]]
400	set sccwave_old [osd info scc.slider$q.val -h]
401	osd configure scc.slider$q.val \
402	-y [expr {128 + $y}] \
403	-h $sccwave_new
404	}
405	}
406	}
407	}
408	}
409
410	proc get_val_matrix_column {sccval} {
411	expr {$sccval < 0 ? $sccval + 256 : $sccval}
412	}
413
414	proc get_scc_string_from_matrix {name} {
415	set sccstring ""
416	set outputfile "$name"
417	set output [open $outputfile "w"]
418
419	for {set i 0} {$i < 32} {incr i} {
420	set a [format %02x [get_val_matrix_column [expr {int([osd info scc.slider$i.val -h])}]]]
421	set sccstring [concat $sccstring$a]
422	}
423
424	close $output
425
426	puts "$outputfile writen to $name"
427	return $sccstring
428	}
429
430	namespace export toggle_scc_editor
431	namespace export toggle_psg2scc
432	namespace export set_scc_wave
433	namespace export toggle_scc_viewer
434
435	} ;# namespace scc_toys
436
437	namespace import scc_toys::*

Keyboard