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

◆ main openmsx / share / scripts / _osd_widgets.tcl

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

namespace eval osd_widgets {

set help_text \
{The command 'osd_widgets::msx_init' takes one parameter, this parameter will be used as
our base layer which will be scaled according to the MSX resultion adjusted for
'set adjust', 'scale factor' and 'horizontal_stretch'.

All these compensation factors ('set adjust', ...) can change over time. So it
is needed to 'regularly' (e.g. in a 'after frame' callback) re-adjust the msx
layer. This can be done with the 'osd_widgets::msx_update' proc.

Example: osd_widgets::msx_init baselayer
         osd create rectangle baselayer.box -x 10 -y 10 -h 16 -w 16 -rgb 0xffffff
         ...
         osd_widgets::msx_update baselayer

This will display a white 16x16 box at MSX location x,y == 10,10.}
set_help_text osd_widgets::msx_init   $help_text
set_help_text osd_widgets::msx_update $help_text

variable registered_msx_widgets [list]
variable msx_widgets_adjust_watchpoint ""

proc msx_init {name} {
	variable registered_msx_widgets
	variable msx_widgets_adjust_watchpoint

	osd create rectangle $name -scaled true -alpha 0
	msx_update $name

	if {$name ni $registered_msx_widgets} {
		lappend registered_msx_widgets $name
	}
	if {[lindex [trace info variable ::horizontal_stretch] 0 1] eq ""} {
		trace add variable ::horizontal_stretch {write unset array} ::osd_widgets::update_registered_msx_widgets
	}
	if {$msx_widgets_adjust_watchpoint == ""} {
		# Triggers when REG18SAV is written to. Frame delay is necessary for msx_update to get the updated data.
		# Though it is perhaps not enough to just watch the memory address rather than the actual register?
		set msx_widgets_adjust_watchpoint [debug set_watchpoint write_mem 0xFFF1 {} {
			after frame ::osd_widgets::update_registered_msx_widgets
		}]
	}
}

# Update all known MSX widgets to adjust to new compensation factors. This is currently only used when the horizontal stretch is changed.
proc update_registered_msx_widgets {args} {
	variable registered_msx_widgets
	foreach name $registered_msx_widgets {
		if {[osd exists $name]} {
			msx_update $name
		} else {
			set idx [lsearch $registered_msx_widgets $name]
			set registered_msx_widgets [lreplace $registered_msx_widgets $idx $idx]
		}
	}
}

proc msx_update {name} {
	# compensate for horizontal-stretch and set-adjust
	set hstretch $::horizontal_stretch
	set xsize   [expr {320.0 / $hstretch}]
	set xoffset [expr {($hstretch - 256) / 2 * $xsize}]
	set ysize 1
	set lines [expr {([vdpreg 9] & 128) ? 212 : 192}]
	set yoffset [expr {(240 - $lines) / 2 * $ysize}]
	set adjreg [vdpreg 18]
	set hadj [expr {(($adjreg & 15) ^ 7) - 7}]
	set vadj [expr {(($adjreg >> 4) ^ 7) - 7}]
	set xoffset [expr {$xoffset + $xsize * $hadj}]
	set yoffset [expr {$yoffset + $ysize * $vadj}]
	osd configure $name -x $xoffset -y $yoffset -w $xsize -h $ysize
}

set_help_text create_power_bar\
{The command 'osd_widgets::create_power_bar' supports the following parameters:
    -name == Name of the power bar
    -w == Width of the power bar (in pixels)
    -h == Height of the power bar
    -barcolor == Powerbar color
    -background == When power declines this color is shown
    -edgecolor == This is the edge color (try white when I doubt which color to use)

Colors must have the following hexadecimal format 0xRRGGBBAA.

The power bar is initially created outside the viewable area, so we need to invoke
the 'update_power_bar' command to make it visible. Use 'hide_power_bar' to
remove it again.}

set_help_text update_power_bar\
{The command 'update_power_bar' uses the following parameters:
    -name == Name of the power bar
    -x == vertical position of the power bar
    -y == horizontal position of the power bar
    -power == fill rate of the power bar in decimal percentages (10% == 0.1)
    -text == text to be printed above the power bar}

proc create_power_bar {name w h barcolor background edgecolor} {
	osd create rectangle $name        -rely 999 -relw $w -relh $h -rgba $background
	osd create rectangle $name.top    -x -1 -y   -1 -relw 1 -w 2 -h 1 -rgba $edgecolor
	osd create rectangle $name.bottom -x -1 -rely 1 -relw 1 -w 2 -h 1 -rgba $edgecolor
	osd create rectangle $name.left   -x -1         -w 1 -relh 1      -rgba $edgecolor
	osd create rectangle $name.right  -relx 1       -w 1 -relh 1      -rgba $edgecolor
	osd create rectangle $name.bar    -relw 1 -relh 1 -rgba $barcolor -z 18
	osd create text      $name.text   -x 0 -y -6 -size 4 -rgba $edgecolor
}

proc update_power_bar {name x y power text} {
	if {$power > 1.0} {set power 1.0}
	if {$power < 0.0} {set power 0.0}
	osd configure $name -relx $x -rely $y
	osd configure $name.bar -relw $power
	osd configure $name.text -text "$text"
}

proc hide_power_bar {name} {
	osd configure $name -rely 999
}


set_help_text osd_widgets::text_box\
{The 'osd_widgets::text_box' widget supports the same properties as a 'rectangle' widget with the following additions:
 -text: defines the text to be printed, can have multiple lines (separated by 'new line' characters).
 -textcolor: defines the color of the text
 -textsize: defines the font size of the text}

variable widget_handlers
variable opaque_duration   2.5
variable fade_out_duration 2.5
variable fade_in_duration  0.4

proc text_box {name args} {
	variable widget_handlers
	variable opaque_duration

	# Default values in case nothing is given
	set txt_color 0xffffffff
	set txt_size 6

	# Process arguments
	set rect_props [list]
	foreach {key val} $args {
		switch -- $key {
			-text     {set message $val}
			-textrgba {set txt_color $val}
			-textsize {set txt_size  $val}
			default   {lappend rect_props $key $val}
		}
	}

	if {$message eq ""} return

	# For handheld devices set minimal text size to 9
	#  TODO: does this belong here or at some higher level?
	if {($::scale_factor == 1) && ($txt_size < 9)} {
		set txt_size 9
	}

	# Destroy widget (if it already existed)
	osd destroy $name

	# Guess height of rectangle
	osd create rectangle $name {*}$rect_props -h [expr {4 + $txt_size}]

	osd create text $name.text -x 2 -y 2 -size $txt_size -rgb $txt_color \
		-text $message -wrap word -wraprelw 1.0 -wrapw -4

	# Adjust height of rectangle to actual text height (depends on newlines
	# and text wrapping).
	catch {
		lassign [osd info $name.text -query-size] x y
		osd configure $name -h [expr {4 + $y}]
	}

	# if the widget was still active, kill old click/opaque handler
	if {[info exists widget_handlers($name)]} {
		lassign $widget_handlers($name) click opaque
		after cancel $click
		after cancel $opaque
	}

	set click  [after "mouse button1 down" "osd_widgets::click_handler $name"]
	set opaque [after realtime $opaque_duration "osd_widgets::timer_handler $name"]
	set widget_handlers($name) [list $click $opaque]

	return ""
}

proc click_handler {name} {
	if {[osd::is_cursor_in $name]} {
		kill_widget $name
	}
	return ""
}

proc kill_widget {name} {
	variable widget_handlers

	lassign $widget_handlers($name) click opaque
	after cancel $click
	after cancel $opaque
	unset widget_handlers($name)
	osd destroy $name
}

proc timer_handler {name} {
	variable widget_handlers
	variable opaque_duration
	variable fade_out_duration
	variable fade_in_duration

	# clicking it might have killed it already
	if {![osd exists $name]} {
		return
	}

	# if already faded out... don't poll again and clean up
	if {[osd info $name -fadeCurrent] == 0.0} {
		kill_widget $name
		return
	}

	# If the cursor is over the widget, we fade-in fast and leave the widget
	# opaque for some time (= don't poll for some longer time). Otherwise
	# we fade-out slow and more quickly poll the cursor position.
	lassign $widget_handlers($name) click opaque
	if {[osd::is_cursor_in $name]} {
		osd configure $name -fadePeriod $fade_in_duration -fadeTarget 1.0
		set opaque [after realtime $opaque_duration "osd_widgets::timer_handler $name"]
	} else {
		osd configure $name -fadePeriod $fade_out_duration -fadeTarget 0.0
		set opaque [after realtime 0.25 "osd_widgets::timer_handler $name"]
	}
	set widget_handlers($name) [list $click $opaque]
}

proc volume_control {incr_val} {
	if {![osd exists volume]} {
		osd create rectangle volume -x 0 -y 0 -h 32 -w 320 -rgba 0x000000a0 -scaled true
		osd create rectangle volume.bar -x 16 -y 16 -h 8 -w 290 -rgba 0x000000c0 -borderrgba 0xffffffff -bordersize 1
		osd create rectangle volume.bar.meter -x 1 -y 1 -h 6 -w 288 -rgba "0x00aa33e8 0x00dd66e8 0x00cc55e8 0x00ff77e8"
		osd create text      volume.text -x 16 -y 3 -size 10 -rgba 0xffffffff
	}

	incr ::master_volume $incr_val
	if {$::master_volume == 0} {set ::mute on} else {set ::mute off}
	osd configure volume.bar.meter -w [expr {($::master_volume / 100.00) * 288}]
	osd configure volume.text -text [format "Volume: %03d" $::master_volume]
	osd configure volume -fadePeriod 5 -fadeTarget 0 -fadeCurrent 1
}

# only export stuff that is useful in other scripts or for the console user
namespace export msx_init
namespace export msx_update
namespace export box
namespace export text_box
namespace export create_power_bar
namespace export update_power_bar
namespace export hide_power_bar
namespace export volume_control

};# namespace osd_widgets

# only import stuff to global that is useful outside of scripts (i.e. for the console user)
namespace import osd_widgets::volume_control

`/`	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	namespace eval osd_widgets {
	2
	3	set help_text \
	4	{The command 'osd_widgets::msx_init' takes one parameter, this parameter will be used as
	5	our base layer which will be scaled according to the MSX resultion adjusted for
	6	'set adjust', 'scale factor' and 'horizontal_stretch'.
	7
	8	All these compensation factors ('set adjust', ...) can change over time. So it
	9	is needed to 'regularly' (e.g. in a 'after frame' callback) re-adjust the msx
	10	layer. This can be done with the 'osd_widgets::msx_update' proc.
	11
	12	Example: osd_widgets::msx_init baselayer
	13	osd create rectangle baselayer.box -x 10 -y 10 -h 16 -w 16 -rgb 0xffffff
	14	...
	15	osd_widgets::msx_update baselayer
	16
	17	This will display a white 16x16 box at MSX location x,y == 10,10.}
	18	set_help_text osd_widgets::msx_init $help_text
	19	set_help_text osd_widgets::msx_update $help_text
	20
	21	variable registered_msx_widgets [list]
	22	variable msx_widgets_adjust_watchpoint ""
	23
	24	proc msx_init {name} {
	25	variable registered_msx_widgets
	26	variable msx_widgets_adjust_watchpoint
	27
	28	osd create rectangle $name -scaled true -alpha 0
	29	msx_update $name
	30
	31	if {$name ni $registered_msx_widgets} {
	32	lappend registered_msx_widgets $name
	33	}
	34	if {[lindex [trace info variable ::horizontal_stretch] 0 1] eq ""} {
	35	trace add variable ::horizontal_stretch {write unset array} ::osd_widgets::update_registered_msx_widgets
	36	}
	37	if {$msx_widgets_adjust_watchpoint == ""} {
	38	# Triggers when REG18SAV is written to. Frame delay is necessary for msx_update to get the updated data.
	39	# Though it is perhaps not enough to just watch the memory address rather than the actual register?
	40	set msx_widgets_adjust_watchpoint [debug set_watchpoint write_mem 0xFFF1 {} {
	41	after frame ::osd_widgets::update_registered_msx_widgets
	42	}]
	43	}
	44	}
	45
	46	# Update all known MSX widgets to adjust to new compensation factors. This is currently only used when the horizontal stretch is changed.
	47	proc update_registered_msx_widgets {args} {
	48	variable registered_msx_widgets
	49	foreach name $registered_msx_widgets {
	50	if {[osd exists $name]} {
	51	msx_update $name
	52	} else {
	53	set idx [lsearch $registered_msx_widgets $name]
	54	set registered_msx_widgets [lreplace $registered_msx_widgets $idx $idx]
	55	}
	56	}
	57	}
	58
	59	proc msx_update {name} {
	60	# compensate for horizontal-stretch and set-adjust
	61	set hstretch $::horizontal_stretch
	62	set xsize [expr {320.0 / $hstretch}]
	63	set xoffset [expr {($hstretch - 256) / 2 * $xsize}]
	64	set ysize 1
65	set lines [expr {([vdpreg 9] & 128) ? 212 : 192}]
66	set yoffset [expr {(240 - $lines) / 2 * $ysize}]
67	set adjreg [vdpreg 18]
68	set hadj [expr {(($adjreg & 15) ^ 7) - 7}]
69	set vadj [expr {(($adjreg >> 4) ^ 7) - 7}]
70	set xoffset [expr {$xoffset + $xsize * $hadj}]
71	set yoffset [expr {$yoffset + $ysize * $vadj}]
72	osd configure $name -x $xoffset -y $yoffset -w $xsize -h $ysize
73	}
74
75	set_help_text create_power_bar\
76	{The command 'osd_widgets::create_power_bar' supports the following parameters:
77	-name == Name of the power bar
78	-w == Width of the power bar (in pixels)
79	-h == Height of the power bar
80	-barcolor == Powerbar color
81	-background == When power declines this color is shown
82	-edgecolor == This is the edge color (try white when I doubt which color to use)
83
84	Colors must have the following hexadecimal format 0xRRGGBBAA.
85
86	The power bar is initially created outside the viewable area, so we need to invoke
87	the 'update_power_bar' command to make it visible. Use 'hide_power_bar' to
88	remove it again.}
89
90	set_help_text update_power_bar\
91	{The command 'update_power_bar' uses the following parameters:
92	-name == Name of the power bar
93	-x == vertical position of the power bar
94	-y == horizontal position of the power bar
95	-power == fill rate of the power bar in decimal percentages (10% == 0.1)
96	-text == text to be printed above the power bar}
97
98	proc create_power_bar {name w h barcolor background edgecolor} {
99	osd create rectangle $name -rely 999 -relw $w -relh $h -rgba $background
100	osd create rectangle $name.top -x -1 -y -1 -relw 1 -w 2 -h 1 -rgba $edgecolor
101	osd create rectangle $name.bottom -x -1 -rely 1 -relw 1 -w 2 -h 1 -rgba $edgecolor
102	osd create rectangle $name.left -x -1 -w 1 -relh 1 -rgba $edgecolor
103	osd create rectangle $name.right -relx 1 -w 1 -relh 1 -rgba $edgecolor
104	osd create rectangle $name.bar -relw 1 -relh 1 -rgba $barcolor -z 18
105	osd create text $name.text -x 0 -y -6 -size 4 -rgba $edgecolor
106	}
107
108	proc update_power_bar {name x y power text} {
109	if {$power > 1.0} {set power 1.0}
110	if {$power < 0.0} {set power 0.0}
111	osd configure $name -relx $x -rely $y
112	osd configure $name.bar -relw $power
113	osd configure $name.text -text "$text"
114	}
115
116	proc hide_power_bar {name} {
117	osd configure $name -rely 999
118	}
119
120
121	set_help_text osd_widgets::text_box\
122	{The 'osd_widgets::text_box' widget supports the same properties as a 'rectangle' widget with the following additions:
123	-text: defines the text to be printed, can have multiple lines (separated by 'new line' characters).
124	-textcolor: defines the color of the text
125	-textsize: defines the font size of the text}
126
127	variable widget_handlers
128	variable opaque_duration 2.5
129	variable fade_out_duration 2.5
130	variable fade_in_duration 0.4
131
132	proc text_box {name args} {
133	variable widget_handlers
134	variable opaque_duration
135
136	# Default values in case nothing is given
137	set txt_color 0xffffffff
138	set txt_size 6
139
140	# Process arguments
141	set rect_props [list]
142	foreach {key val} $args {
143	switch -- $key {
144	-text {set message $val}
145	-textrgba {set txt_color $val}
146	-textsize {set txt_size $val}
147	default {lappend rect_props $key $val}
148	}
149	}
150
151	if {$message eq ""} return
152
153	# For handheld devices set minimal text size to 9
154	# TODO: does this belong here or at some higher level?
155	if {($::scale_factor == 1) && ($txt_size < 9)} {
156	set txt_size 9
157	}
158
159	# Destroy widget (if it already existed)
160	osd destroy $name
161
162	# Guess height of rectangle
163	osd create rectangle $name {*}$rect_props -h [expr {4 + $txt_size}]
164
165	osd create text $name.text -x 2 -y 2 -size $txt_size -rgb $txt_color \
166	-text $message -wrap word -wraprelw 1.0 -wrapw -4
167
168	# Adjust height of rectangle to actual text height (depends on newlines
169	# and text wrapping).
170	catch {
171	lassign [osd info $name.text -query-size] x y
172	osd configure $name -h [expr {4 + $y}]
173	}
174
175	# if the widget was still active, kill old click/opaque handler
176	if {[info exists widget_handlers($name)]} {
177	lassign $widget_handlers($name) click opaque
178	after cancel $click
179	after cancel $opaque
180	}
181
182	set click [after "mouse button1 down" "osd_widgets::click_handler $name"]
183	set opaque [after realtime $opaque_duration "osd_widgets::timer_handler $name"]
184	set widget_handlers($name) [list $click $opaque]
185
186	return ""
187	}
188
189	proc click_handler {name} {
190	if {[osd::is_cursor_in $name]} {
191	kill_widget $name
192	}
193	return ""
194	}
195
196	proc kill_widget {name} {
197	variable widget_handlers
198
199	lassign $widget_handlers($name) click opaque
200	after cancel $click
201	after cancel $opaque
202	unset widget_handlers($name)
203	osd destroy $name
204	}
205
206	proc timer_handler {name} {
207	variable widget_handlers
208	variable opaque_duration
209	variable fade_out_duration
210	variable fade_in_duration
211
212	# clicking it might have killed it already
213	if {![osd exists $name]} {
214	return
215	}
216
217	# if already faded out... don't poll again and clean up
218	if {[osd info $name -fadeCurrent] == 0.0} {
219	kill_widget $name
220	return
221	}
222
223	# If the cursor is over the widget, we fade-in fast and leave the widget
224	# opaque for some time (= don't poll for some longer time). Otherwise
225	# we fade-out slow and more quickly poll the cursor position.
226	lassign $widget_handlers($name) click opaque
227	if {[osd::is_cursor_in $name]} {
228	osd configure $name -fadePeriod $fade_in_duration -fadeTarget 1.0
229	set opaque [after realtime $opaque_duration "osd_widgets::timer_handler $name"]
230	} else {
231	osd configure $name -fadePeriod $fade_out_duration -fadeTarget 0.0
232	set opaque [after realtime 0.25 "osd_widgets::timer_handler $name"]
233	}
234	set widget_handlers($name) [list $click $opaque]
235	}
236
237	proc volume_control {incr_val} {
238	if {![osd exists volume]} {
239	osd create rectangle volume -x 0 -y 0 -h 32 -w 320 -rgba 0x000000a0 -scaled true
240	osd create rectangle volume.bar -x 16 -y 16 -h 8 -w 290 -rgba 0x000000c0 -borderrgba 0xffffffff -bordersize 1
241	osd create rectangle volume.bar.meter -x 1 -y 1 -h 6 -w 288 -rgba "0x00aa33e8 0x00dd66e8 0x00cc55e8 0x00ff77e8"
242	osd create text volume.text -x 16 -y 3 -size 10 -rgba 0xffffffff
243	}
244
245	incr ::master_volume $incr_val
246	if {$::master_volume == 0} {set ::mute on} else {set ::mute off}
247	osd configure volume.bar.meter -w [expr {($::master_volume / 100.00) * 288}]
248	osd configure volume.text -text [format "Volume: %03d" $::master_volume]
249	osd configure volume -fadePeriod 5 -fadeTarget 0 -fadeCurrent 1
250	}
251
252	# only export stuff that is useful in other scripts or for the console user
253	namespace export msx_init
254	namespace export msx_update
255	namespace export box
256	namespace export text_box
257	namespace export create_power_bar
258	namespace export update_power_bar
259	namespace export hide_power_bar
260	namespace export volume_control
261
262	};# namespace osd_widgets
263
264	# only import stuff to global that is useful outside of scripts (i.e. for the console user)
265	namespace import osd_widgets::volume_control

Keyboard