OXYGENHUB
◆ main openmsx / share / scripts / _reverse.tcl
7.9 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
1 
namespace eval reverse {
2
3 
# Enable reverse if not yet enabled. As an optimization, also return
4 
# reverse-status info (so that caller doesn't have to query it again).
5 
proc auto_enable {} {
6 
	set stat_dict [reverse status]
7 
	if {[dict get $stat_dict status] eq "disabled"} {
8 
		reverse start
9 
	}
10 
	return $stat_dict
11 
}
12
13 
set_help_text reverse_prev \
14 
{Goes back in time to the previous 'snapshot'.
15 
A 'snapshot' is actually an internal implementation detail, but the\
16 
important thing for this command is that the further back in the past,\
17 
the less dense the snapshots are. So executing this command multiple times\
18 
will take successively bigger steps in the past. Going back to a snapshot\
19 
is also slightly faster than going back to an arbitrary point in time\
20 
(let's say going back a fixed amount of time).
21 
}
22 
proc reverse_prev {{minimum 1} {maximum 15}} {
23 
	set stats [auto_enable]
24 
	set snapshots [dict get $stats snapshots]
25 
	set num_snapshots [llength $snapshots]
26 
	if {$num_snapshots == 0} return
27
28 
	set current [dict get $stats current]
29 
	set upperTarget [expr {$current - $minimum}]
30 
	set lowerTarget [expr {$current - $maximum}]
31
32 
	# search latest snapshot that is still before upperTarget
33 
	set i [expr {$num_snapshots - 1}]
34 
	while {([lindex $snapshots $i] > $upperTarget) && ($i > 0)} {
35 
		incr i -1
36 
	}
37 
	# but don't go below lowerTarget
38 
	set t [lindex $snapshots $i]
39 
	if {$t < $lowerTarget} {set t $lowerTarget}
40
41 
	reverse goto $t
42 
}
43
44 
set_help_text reverse_next \
45 
{This is very much like 'reverse_prev', but instead it goes to the closest\
46 
snapshot in the future (if possible).
47 
}
48 
proc reverse_next {{minimum 0} {maximum 15}} {
49 
	set stats [auto_enable]
50 
	set snapshots [dict get $stats snapshots]
51 
	set num_snapshots [llength $snapshots]
52 
	if {$num_snapshots == 0} return
53
54 
	set current [dict get $stats current]
55 
	set lowerTarget [expr {$current + $minimum}]
56 
	set upperTarget [expr {$current + $maximum}]
57
58 
	# search first snapshot that is after lowerTarget
59 
	lappend snapshots [dict get $stats end]
60 
	set i 0
61 
	while {($i < $num_snapshots) && ([lindex $snapshots $i] < $lowerTarget)} {
62 
		incr i
63 
	}
64
65 
	if {$i < $num_snapshots} {
66 
		# but don't go above upperTarget
67 
		set t [lindex $snapshots $i]
68 
		if {$t > $upperTarget} {set t $upperTarget}
69 
		reverse goto $t
70 
	}
71 
}
72
73 
proc goto_time_delta {delta} {
74 
	set t [expr {[dict get [reverse status] current] + $delta}]
75 
	if {$t < 0} {set t 0}
76 
	reverse goto $t
77 
}
78
79 
proc go_back_one_step {} {
80 
	goto_time_delta [expr {-$::speed / 100.0}]
81 
}
82
83 
proc go_forward_one_step {} {
84 
	goto_time_delta [expr { $::speed / 100.0}]
85 
}
86
87
88 
# reverse bookmarks
89
90 
variable bookmarks [dict create]
91
92 
proc create_bookmark_from_current_time {name} {
93 
	variable bookmarks
94 
	dict set bookmarks $name [machine_info time]
95 
	# The next message is useful as part of a hotkey command for this
96 
#	message "Saved current time to bookmark '$name'"
97 
	return "Created bookmark '$name' at [dict get $bookmarks $name]"
98 
}
99
100 
proc remove_bookmark {name} {
101 
	variable bookmarks
102 
	dict unset bookmarks $name
103 
	return "Removed bookmark '$name'"
104 
}
105
106 
proc jump_to_bookmark {name} {
107 
	variable bookmarks
108 
	if {[dict exists $bookmarks $name]} {
109 
		reverse goto [dict get $bookmarks $name]
110 
		# The next message is useful as part of a hotkey command for
111 
		# this
112 
		#message "Jumped to bookmark '$name'"
113 
	} else {
114 
		error "Bookmark '$name' not defined..."
115 
	}
116 
}
117
118 
proc clear_bookmarks {} {
119 
	variable bookmarks
120 
	set bookmarks [dict create]
121 
}
122
123 
proc save_bookmarks {name} {
124 
	variable bookmarks
125
126 
	set directory [file normalize $::env(OPENMSX_USER_DATA)/../reverse_bookmarks]
127 
	file mkdir $directory
128 
	set fullname [file join $directory ${name}.rbm]
129
130 
	if {[catch {
131 
		set the_file [open $fullname {WRONLY TRUNC CREAT}]
132 
		puts $the_file $bookmarks
133 
		close $the_file
134 
	} errorText]} {
135 
		error "Failed to save to $fullname: $errorText"
136 
	}
137 
	return "Successfully saved bookmarks to $fullname"
138 
}
139
140 
proc load_bookmarks {name} {
141 
	variable bookmarks
142
143 
	set directory [file normalize $::env(OPENMSX_USER_DATA)/../reverse_bookmarks]
144 
	set fullname [file join $directory ${name}.rbm]
145
146 
	if {[catch {
147 
		set the_file [open $fullname {RDONLY}]
148 
		set bookmarks [read $the_file]
149 
		close $the_file
150 
	} errorText]} {
151 
		error "Failed to load from $fullname: $errorText"
152 
	}
153
154 
	return "Successfully loaded $fullname"
155 
}
156
157 
proc list_bookmarks_files {} {
158 
	set directory [file normalize $::env(OPENMSX_USER_DATA)/../reverse_bookmarks]
159 
	set results [list]
160 
	foreach f [lsort [glob -tails -directory $directory -type f -nocomplain *.rbm]] {
161 
		lappend results [file rootname $f]
162 
	}
163 
	return $results
164 
}
165
166 
proc reverse_bookmarks {subcmd args} {
167 
	switch -- $subcmd {
168 
		"create" {create_bookmark_from_current_time {*}$args}
169 
		"remove" {remove_bookmark  {*}$args}
170 
		"goto"   {jump_to_bookmark {*}$args}
171 
		"clear"  {clear_bookmarks}
172 
		"load"   {load_bookmarks   {*}$args}
173 
		"save"   {save_bookmarks   {*}$args}
174 
		default  {error "Invalid subcommand: $subcmd"}
175 
	}
176 
}
177
178 
set_help_proc reverse_bookmarks [namespace code reverse_bookmarks_help]
179
180 
proc reverse_bookmarks_help {args} {
181 
	switch -- [lindex $args 1] {
182 
		"create"    {return {Creates a bookmark at the current time with the given name.
183
184 
Syntax: reverse_bookmarks create <name>
185 
}}
186 
		"remove" {return {Removes the bookmark with the given name.
187
188 
Syntax: reverse_bookmarks remove <name>
189 
}}
190 
		"goto"   {return {Goes to the bookmark with the given name.
191
192 
Syntax: reverse_bookmarks goto <name>
193 
}}
194 
		"clear"  {return {Removes all bookmarks.
195
196 
Syntax: reverse_bookmarks clear
197 
}}
198 
		"save"   {return {Saves the current reverse bookmarks to a file.
199
200 
Syntax: reverse_bookmarks save <filename>
201 
}}
202 
		"load"   {return {Loads reverse bookmarks from file.
203
204 
Syntax: reverse_bookmarks load <filename>
205 
}}
206 
		default {return {Controls the reverse bookmarks functionality.
207
208 
Syntax:  reverse_bookmarks <sub-command> [<arguments>]
209 
Where sub-command is one of:
210 
    create   Create a bookmark at the current time
211 
    remove   Remove a previously created bookmark
212 
    goto     Go to a previously created bookmark
213 
    clear    Shortcut to remove all bookmarks
214 
    save     Save current bookmarks to a file
215 
    load     Load previously saved bookmarks
216
217 
Use 'help reverse_bookmarks <sub-command>' to get more detailed help on a specific sub-command.
218 
}}
219 
	}
220 
}
221
222 
set_tabcompletion_proc reverse_bookmarks [namespace code reverse_bookmarks_tabcompletion]
223 
proc reverse_bookmarks_tabcompletion {args} {
224 
	variable bookmarks
225
226 
	if {[llength $args] == 2} {
227 
		return [list "create" "remove" "goto" "clear" "save" "load"]
228 
	} elseif {[llength $args] == 3} {
229 
		switch -- [lindex $args 1] {
230 
			"remove" -
231 
			"goto"  {return [dict keys $bookmarks]}
232 
			"load"  -
233 
			"save"  {return [list_bookmarks_files]}
234 
			default {return [list]}
235 
		}
236 
	}
237 
}
238
239 
### auto save replays
240
241 
trace add variable ::auto_save_replay "write" [namespace code auto_save_setting_changed]
242
243 
variable old_auto_save_value $::auto_save_replay
244 
variable auto_save_after_id 0
245
246 
proc auto_save_setting_changed {name1 name2 op} {
247 
	variable old_auto_save_value
248 
	variable auto_save_after_id
249
250 
	if {$::auto_save_replay != $old_auto_save_value} {
251 
		set old_auto_save_value $::auto_save_replay
252
253 
		if {$::auto_save_replay && $auto_save_after_id == 0 } {
254 
			set stat_dict [reverse status]
255 
			if {[dict get $stat_dict status] eq "disabled"} {
256 
				error "Reverse is not enabled!"
257 
			}
258 
			auto_save_replay_loop
259 
			puts "Enabled auto-save of replay to filename $::auto_save_replay_filename every $::auto_save_replay_interval seconds."
260 
		} elseif {!$::auto_save_replay && $auto_save_after_id != 0 } {
261 
			after cancel $auto_save_after_id
262 
			set auto_save_after_id 0
263 
			puts "Auto-save of replay disabled."
264 
		}
265 
	}
266 
}
267
268 
proc auto_save_replay_loop {} {
269 
	variable auto_save_after_id
270
271 
	if {$::auto_save_replay} {
272 
		reverse savereplay -maxnofextrasnapshots 0 $::auto_save_replay_filename
273
274 
		set auto_save_after_id [after realtime $::auto_save_replay_interval "reverse::auto_save_replay_loop"]
275 
	}
276 
}
277
278 
namespace export reverse_prev
279 
namespace export reverse_next
280 
namespace export goto_time_delta
281 
namespace export go_back_one_step
282 
namespace export go_forward_one_step
283 
namespace export reverse_bookmarks
284
285 
} ;# namespace reverse
286
287 
namespace import reverse::*