OXYGENHUB
◆ main openmsx / share / scripts / _shuffler.tcl
3.6 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 1
namespace eval shuffler {
2
3
namespace ensemble create
4
5
set_help_text shuffler \
6
"Starts MSX instances for each ROM file in the given folder and switches
7
between these machines after the given switch_time has passed. The next game is
8
the next game in the folder (for round_robin order) or a random game (for
9
random order).
10
11
Usage:
12
shuffler start <parameters> - starts the shuffler, with parameters below.
13
shuffler stop               - stops the shuffler.
14
15
Parameters:
16
folder: the folder to use to look for the ROM files to run
17
switch_time: the time in seconds after which the shuffler will switch to the next game (default: 10)
18
order: optional: the order in which the games are switched (default: round_robin, i.e. in fixed order)
19
machine: optional: the machine to use (default: C-BIOS_MSX2+)
20
extensions: optional: the extensions to look for (default: {.rom .ri .ROM})"
21
22
variable machines_running [list]
23
24
variable max_num_files 50
25
26
variable interval 0
27
variable shuffle_order
28
variable after_id ""
29
variable original_machine ""
30
31
proc start {folder {switch_time 10} {order round_robin} {machine {C-BIOS_MSX2+}} {extensions {.rom .ri .ROM}} } {
32
	variable max_num_files
33
	variable interval
34
	variable shuffle_order
35
	variable machines_running
36
	variable after_id
37
	variable original_machine
38
39
	if {[llength $machines_running] > 0} {
40
		error "Shuffler already running, stop it first..."
41
	}
42
43
	foreach ext $extensions {
44
		lappend pattern "*$ext"
45
	}
46
	set files [glob -directory $folder -nocomplain {*}$pattern]
47
48
	set num_files [llength $files]
49
	if {$num_files > $max_num_files} {
50
		error "Too many files found in folder $folder with extensions $extensions: $num_files, the maximum is $max_num_files"
51
	} elseif {$num_files <= 1} {
52
		error "Not enough suitable files found in $folder matching $extensions... aborting."
53
	}
54
55
	foreach file_to_run $files {
56
		set id [create_machine]
57
		if {[catch {${id}::load_machine $machine} error_result]} {
58
			stop
59
			error "Error starting machine $machine: $error_result"
60
		}
61
		if {[catch {${id}::carta $file_to_run} error_result]} {
62
			stop
63
			error "Error starting $file_to_run: $error_result"
64
		}
65
		lappend machines_running $id
66
	}
67
68
	set interval $switch_time
69
	set shuffle_order $order
70
	set original_machine [activate_machine]
71
	next_machine
72
	return "Shuffling with: [join $files {, }]"
73
}
74
75
proc stop {} {
76
	variable after_id
77
	variable machines_running
78
	variable original_machine
79
80
	after cancel $after_id
81
	foreach machine $machines_running {
82
		delete_machine $machine
83
	}
84
	set machines_running [list]
85
	if {$original_machine ne ""} {
86
		activate_machine $original_machine
87
		set original_machine ""
88
	}
89
}
90
91
proc next_machine {} {
92
	variable machines_running
93
	variable interval
94
	variable shuffle_order
95
	variable after_id
96
97
	set current_machine [activate_machine]
98
	set index [lsearch -exact $machines_running $current_machine]
99
	set num_machines [llength $machines_running]
100
	if {$shuffle_order eq "random"} {
101
		if {$num_machines > 1} {
102
			set old_index $index
103
			while {$index == $old_index} {
104
				set index [expr {round([utils::get_random_number $num_machines])}]
105
			}
106
		}
107
	} else {
108
		set index [expr {($index + 1) % $num_machines}]
109
	}
110
	activate_machine [lindex $machines_running $index]
111
112
	set after_id [after time $interval [namespace code next_machine]]
113
}
114
115
proc tabcompletion {args} {
116
	if {[lsearch -exact $args "start"] >= 0} {
117
		switch [llength $args] {
118
			3 {puts [lindex $args 2]; utils::file_completion [lindex $args 2]}
119
			4 {}
120
			5 { concat round_robin random }
121
			6 { openmsx_info machines }
122
			default {}
123
		}
124
	} else {
125
		concat start stop
126
	}
127
}
128
129
set_tabcompletion_proc shuffler [namespace code tabcompletion]
130
131
namespace export start stop
132
133
} ;# namespace shuffler
134
135
namespace import shuffler::*