File: _osd_widgets.tcl

package info (click to toggle)
openmsx 21.0%2Bdfsg-3
  • links: PTS
  • area: main
  • in suites: sid
  • size: 28,132 kB
  • sloc: cpp: 244,928; xml: 54,344; tcl: 15,603; python: 5,335; perl: 281; sh: 78; makefile: 57
file content (265 lines) | stat: -rw-r--r-- 9,255 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
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