OXYGENHUB
◆ main openmsx / share / scripts / _psg_log.tcl
3.0 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
# Binary format PSG logger
2 
#
3 
# (see http://www.msx.org/forumtopic6258.html for more context)
4 
#
5 
# Shiru wrote:
6 
#
7 
#  Is it possible to make output in standart binary *.psg format (used in
8 
#  emulators like x128, very-very old version of fMSX, Z80Stealth and some other)?
9 
#
10 
#  Header:
11 
#
12 
#   +0 4 Signature #50 #53 #47 #1A ('PSG' and byte #1A)
13 
#   +4 1 Version number
14 
#   +5 1 Interrupts freq. (50/60)
15 
#   +6 10 Unused
16 
#
17 
#  Note: only signature is necessary, many emulators just fill other bytes by zero.
18 
#
19 
#  Data stream:
20 
#
21 
#  #00..#FC - register number, followed by data byte (value for that register)
22 
#  #FD - EOF (usually not used in real logs, and not all progs can handle it)
23 
#  #FE - number of interrupts (followed byte with number of interrupts/4, usually not used)
24 
#  #FF - single interrupt
25
26 
namespace eval psg_log {
27
28 
set_help_text psg_log \
29 
{This script logs PSG registers 0 through 13 to a file as they are written,
30 
seperated each frame.
31 
The file format is the PSG format used in some emulators. More information
32 
is here:  http://www.msx.org/forumtopic6258.html (and in the comments of
33 
this script).
34
35 
Usage:
36 
   psg_log start <filename>  start logging PSG registers to <filename>
37 
                             (default: log.psg)
38 
   psg_log stop              stop logging PSG registers
39
40 
Examples:
41 
   psg_log start             start logging registers to default file log.psg
42 
   psg_log start myfile.psg  start logging to file myfile.psg
43 
   psg_log stop              stop logging PSG registers
44 
}
45
46 
set_tabcompletion_proc psg_log [namespace code tab_psg_log]
47
48 
proc tab_psg_log { args } {
49 
	if {[llength $args] == 2} {
50 
		return "start stop"
51 
	}
52 
}
53
54 
variable psg_log_file -1
55 
variable psg_log_wp ""
56 
variable psg_log_reg
57
58 
proc psg_log { subcommand {filename "log.psg"} } {
59 
	variable psg_log_file
60 
	variable psg_log_wp
61 
	if {$subcommand eq "start"} {
62 
		if {$psg_log_file != -1} { close $psg_log_file }
63 
		set psg_log_file [open $filename {WRONLY TRUNC CREAT}]
64 
		fconfigure $psg_log_file -translation binary
65 
		set header "0x50 0x53 0x47 0x1A 0 0 0 0 0 0 0 0 0 0 0 0"
66 
		puts -nonewline $psg_log_file [binary format c16 $header]
67 
		if {$psg_log_wp == ""} { set psg_log_wp [debug set_watchpoint write_io {0xa0 0xa1} 1 { psg_log::psg_log_write }] }
68 
		after frame [namespace code do_psg_frame]
69 
		return ""
70 
	} elseif {$subcommand eq "stop"} {
71 
		debug remove_watchpoint $psg_log_wp
72 
		close $psg_log_file
73 
		set psg_log_file -1
74 
		set psg_log_wp ""
75 
		return ""
76 
	} else {
77 
		error "bad option \"$subcommand\": must be start, stop"
78 
	}
79 
}
80
81 
proc do_psg_frame {} {
82 
	variable psg_log_file
83 
	if {$psg_log_file == -1} return
84 
	puts -nonewline $psg_log_file [binary format c 0xFF]
85 
	after frame [namespace code do_psg_frame]
86 
}
87
88 
proc psg_log_write {} {
89 
	variable psg_log_file
90 
	variable psg_log_reg
91 
	if {($::wp_last_address & 1) == 0} {
92 
		set psg_log_reg $::wp_last_value
93 
	} else {
94 
		if {$psg_log_reg < 14} { puts -nonewline $psg_log_file [binary format c2 "$psg_log_reg $::wp_last_value"] }
95 
	}
96 
}
97
98 
namespace export psg_log
99
100 
} ;# namespace psg_log
101
102 
namespace import psg_log::*