/usr/share/openmsx/scripts/osd_menu.tcl is in openmsx-data 0.8.2-2.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 | namespace eval osd_menu {
set_help_text main_menu_open "(experimental) Show the OSD menu."
set_help_text main_menu_close "(experimental) Remove the OSD menu."
set_help_text main_menu_toggle "(experimental) Toggle the OSD menu."
# default colors defined here, for easy global tweaking
variable default_bg_color "0x7090aae8 0xa0c0dde8 0x90b0cce8 0xc0e0ffe8"
variable default_text_color 0x000000ff
variable default_text_color 0x000000ff
variable default_select_color "0x0044aa80 0x2266dd80 0x0055cc80 0x44aaff80"
variable default_header_text_color 0xff9020ff
variable is_dingoo [string match *-dingux* $::tcl_platform(osVersion)]
proc get_optional {dict_name key default} {
upvar $dict_name d
expr {[dict exists $d $key] ? [dict get $d $key] : $default}
}
proc set_optional {dict_name key value} {
upvar $dict_name d
if {![dict exists $d $key]} {
dict set d $key $value
}
}
variable menulevels 0
variable main_menu
proc push_menu_info {} {
variable menulevels
incr menulevels 1
set levelname "menuinfo_$menulevels"
variable $levelname
set $levelname [uplevel {dict create \
name $name lst $lst menu_len $menu_len presentation $presentation \
menutexts $menutexts selectinfo $selectinfo selectidx $selectidx \
scrollidx $scrollidx on_close $on_close}]
}
proc peek_menu_info {} {
variable menulevels
uplevel upvar #0 osd_menu::menuinfo_$menulevels menuinfo
}
proc set_selectidx {value} {
peek_menu_info
dict set menuinfo selectidx $value
}
proc set_scrollidx {value} {
peek_menu_info
dict set menuinfo scrollidx $value
}
proc menu_create {menudef} {
variable menulevels
variable default_bg_color
variable default_text_color
variable default_select_color
variable default_header_text_color
set name "menu[expr {$menulevels + 1}]"
set defactions [get_optional menudef "actions" ""]
set bgcolor [get_optional menudef "bg-color" $default_bg_color]
set deftextcolor [get_optional menudef "text-color" $default_text_color]
set selectcolor [get_optional menudef "select-color" $default_select_color]
set deffontsize [get_optional menudef "font-size" 12]
set deffont [get_optional menudef "font" "skins/Vera.ttf.gz"]
set bordersize [get_optional menudef "border-size" 0]
set on_open [get_optional menudef "on-open" ""]
set on_close [get_optional menudef "on-close" ""]
osd create rectangle $name -scaled true -rgba $bgcolor -clip true \
-borderrgba 0x000000ff -bordersize 0.5
set y $bordersize
set selectinfo [list]
set menutexts [list]
foreach itemdef [dict get $menudef items] {
set selectable [get_optional itemdef "selectable" true]
incr y [get_optional itemdef "pre-spacing" 0]
set fontsize [get_optional itemdef "font-size" $deffontsize]
set font [get_optional itemdef "font" $deffont]
set textcolor [expr {$selectable
? [get_optional itemdef "text-color" $deftextcolor]
: [get_optional itemdef "text-color" $default_header_text_color]}]
set actions [get_optional itemdef "actions" ""]
set on_select [get_optional itemdef "on-select" ""]
set on_deselect [get_optional itemdef "on-deselect" ""]
set textid "${name}.item${y}"
set text [dict get $itemdef text]
lappend menutexts $textid $text
osd create text $textid -font $font -size $fontsize \
-rgba $textcolor -x $bordersize -y $y
if {$selectable} {
set allactions [concat $defactions $actions]
lappend selectinfo [list $y $fontsize $allactions $on_select $on_deselect]
}
incr y $fontsize
incr y [get_optional itemdef "post-spacing" 0]
}
set width [dict get $menudef width]
set height [expr {$y + $bordersize}]
set xpos [get_optional menudef "xpos" [expr {(320 - $width) / 2}]]
set ypos [get_optional menudef "ypos" [expr {(240 - $height) / 2}]]
osd configure $name -x $xpos -y $ypos -w $width -h $height
set selw [expr {$width - 2 * $bordersize}]
osd create rectangle "${name}.selection" -z -1 -rgba $selectcolor \
-x $bordersize -w $selw
set lst [get_optional menudef "lst" ""]
set menu_len [get_optional menudef "menu_len" 0]
set presentation [get_optional menudef "presentation" ""]
set selectidx 0
set scrollidx 0
push_menu_info
uplevel #0 $on_open
menu_on_select $selectinfo $selectidx
menu_refresh_top
}
proc menu_refresh_top {} {
peek_menu_info
foreach {osdid text} [dict get $menuinfo menutexts] {
set cmd [list subst $text]
osd configure $osdid -text [uplevel #0 $cmd]
}
set selectinfo [dict get $menuinfo selectinfo]
if {[llength $selectinfo] == 0} return
set selectidx [dict get $menuinfo selectidx ]
lassign [lindex $selectinfo $selectidx] sely selh
osd configure "[dict get $menuinfo name].selection" -y $sely -h $selh
}
proc menu_close_top {} {
variable menulevels
peek_menu_info
menu_on_deselect [dict get $menuinfo selectinfo] [dict get $menuinfo selectidx]
uplevel #0 [dict get $menuinfo on_close]
osd destroy [dict get $menuinfo name]
unset menuinfo
incr menulevels -1
if {$menulevels == 0} {
menu_last_closed
}
}
proc menu_close_all {} {
variable menulevels
while {$menulevels} {
menu_close_top
}
}
proc menu_setting {cmd_result} {
menu_refresh_top
}
proc menu_updown {delta} {
peek_menu_info
set selectinfo [dict get $menuinfo selectinfo]
set num [llength $selectinfo]
if {$num == 0} return
set selectidx [dict get $menuinfo selectidx ]
menu_on_deselect $selectinfo $selectidx
set selectidx [expr {($selectidx + $delta) % $num}]
set_selectidx $selectidx
menu_on_select $selectinfo $selectidx
menu_refresh_top
}
proc menu_on_select {selectinfo selectidx} {
set on_select [lindex $selectinfo $selectidx 3]
uplevel #0 $on_select
}
proc menu_on_deselect {selectinfo selectidx} {
set on_deselect [lindex $selectinfo $selectidx 4]
uplevel #0 $on_deselect
}
proc menu_action {button} {
peek_menu_info
set selectinfo [dict get $menuinfo selectinfo]
set selectidx [dict get $menuinfo selectidx ]
set actions [lindex $selectinfo $selectidx 2]
set_optional actions UP {osd_menu::menu_updown -1}
set_optional actions DOWN {osd_menu::menu_updown 1}
set_optional actions B {osd_menu::menu_close_top}
set cmd [get_optional actions $button ""]
uplevel #0 $cmd
}
user_setting create string osd_rom_path "OSD Rom Load Menu Last Known Path" $env(HOME)
user_setting create string osd_disk_path "OSD Disk Load Menu Last Known Path" $env(HOME)
user_setting create string osd_tape_path "OSD Tape Load Menu Last Known Path" $env(HOME)
if {![file exists $::osd_rom_path]} {
# revert to default (should always exist)
unset ::osd_rom_path
}
if {![file exists $::osd_disk_path]} {
# revert to default (should always exist)
unset ::osd_disk_path
}
if {![file exists $::osd_tape_path]} {
# revert to default (should always exist)
unset ::osd_tape_path
}
proc main_menu_open {} {
variable main_menu
do_menu_open $main_menu
}
proc do_menu_open {top_menu} {
variable is_dingoo
# close console, because the menu interferes with it
set ::console off
# also remove other OSD controlled widgets (like the osd keyboard)
if {[info exists ::osd_control::close]} {
eval $::osd_control::close
}
# end tell how to close this widget
namespace eval ::osd_control {set close ::osd_menu::main_menu_close}
menu_create $top_menu
set ::pause true
# TODO make these bindings easier to customize
bind_default "keyb UP" -repeat {osd_menu::menu_action UP }
bind_default "keyb DOWN" -repeat {osd_menu::menu_action DOWN }
bind_default "keyb LEFT" -repeat {osd_menu::menu_action LEFT }
bind_default "keyb RIGHT" -repeat {osd_menu::menu_action RIGHT}
if {$is_dingoo} {
bind_default "keyb LCTRL" {osd_menu::menu_action A }
bind_default "keyb LALT" {osd_menu::menu_action B }
} else {
bind_default "keyb SPACE" {osd_menu::menu_action A }
bind_default "keyb RETURN" {osd_menu::menu_action A }
bind_default "keyb ESCAPE" {osd_menu::menu_action B }
}
}
proc main_menu_close {} {
menu_close_all
}
proc main_menu_toggle {} {
variable menulevels
if {$menulevels} {
# there is at least one menu open, close it
menu_close_all
} else {
# none open yet, open main menu
main_menu_open
}
}
proc menu_last_closed {} {
variable is_dingoo
set ::pause false
# TODO avoid duplication with 'main_menu_open'
unbind_default "keyb UP"
unbind_default "keyb DOWN"
unbind_default "keyb LEFT"
unbind_default "keyb RIGHT"
if {$is_dingoo} {
unbind_default "keyb LCTRL"
unbind_default "keyb LALT"
} else {
unbind_default "keyb SPACE"
unbind_default "keyb RETURN"
unbind_default "keyb ESCAPE"
}
namespace eval ::osd_control {unset close}
}
proc prepare_menu_list {lst num menudef} {
set execute [dict get $menudef execute]
set header [dict get $menudef header]
set item_extra [get_optional menudef item ""]
set on_select [get_optional menudef on-select ""]
set on_deselect [get_optional menudef on-deselect ""]
set presentation [get_optional menudef presentation $lst]
# 'assert': presentation should have same length as item list!
if {[llength $presentation] != [llength $lst]} {
error "Presentation should be of same length as item list!"
}
dict set menudef presentation $presentation
lappend header "selectable" "false"
set items [list $header]
set lst_len [llength $lst]
set menu_len [expr {$lst_len < $num ? $lst_len : $num}]
for {set i 0} {$i < $menu_len} {incr i} {
set actions [list "A" "osd_menu::list_menu_item_exec {$execute} $i"]
if {$i == 0} {
lappend actions "UP" "osd_menu::move_selection -1"
}
if {$i == ($menu_len - 1)} {
lappend actions "DOWN" "osd_menu::move_selection 1"
}
lappend actions "LEFT" "osd_menu::move_selection -$menu_len"
lappend actions "RIGHT" "osd_menu::move_selection $menu_len"
set item [list "text" "\[osd_menu::list_menu_item_show $i\]" \
"actions" $actions]
if {$on_select ne ""} {
lappend item "on-select" "osd_menu::list_menu_item_select $i $on_select"
}
if {$on_deselect ne ""} {
lappend item "on-deselect" "osd_menu::list_menu_item_select $i $on_deselect"
}
lappend items [concat $item $item_extra]
}
dict set menudef items $items
dict set menudef lst $lst
dict set menudef menu_len $menu_len
return $menudef
}
proc list_menu_item_exec {execute pos} {
peek_menu_info
{*}$execute [lindex [dict get $menuinfo lst] [expr {$pos + [dict get $menuinfo scrollidx]}]]
}
proc list_menu_item_show {pos} {
peek_menu_info
return [lindex [dict get $menuinfo presentation] [expr {$pos + [dict get $menuinfo scrollidx]}]]
}
proc list_menu_item_select {pos select_proc} {
peek_menu_info
$select_proc [lindex [dict get $menuinfo lst] [expr {$pos + [dict get $menuinfo scrollidx]}]]
}
proc move_selection {delta} {
peek_menu_info
set lst_last [expr {[llength [dict get $menuinfo lst]] - 1}]
set scrollidx [dict get $menuinfo scrollidx]
set selectidx [dict get $menuinfo selectidx]
set old_itemidx [expr {$scrollidx + $selectidx}]
set new_itemidx [expr {$old_itemidx + $delta}]
if {$new_itemidx < 0} {
# Before first element
if {$old_itemidx == 0} {
# if first element was already selected, wrap to last
set new_itemidx $lst_last
} else {
# otherwise, clamp to first element
set new_itemidx 0
}
} elseif {$new_itemidx > $lst_last} {
# After last element
if {$old_itemidx == $lst_last} {
# if last element was already selected, wrap to first
set new_itemidx 0
} else {
# otherwise clam to last element
set new_itemidx $lst_last
}
}
select_menu_idx $new_itemidx
}
proc select_menu_idx {itemidx} {
peek_menu_info
set menu_len [dict get $menuinfo menu_len]
set scrollidx [dict get $menuinfo scrollidx]
set selectidx [dict get $menuinfo selectidx]
set selectinfo [dict get $menuinfo selectinfo]
menu_on_deselect $selectinfo $selectidx
set selectidx [expr {$itemidx - $scrollidx}]
if {$selectidx < 0} {
incr scrollidx $selectidx
set selectidx 0
} elseif {$selectidx >= $menu_len} {
set selectidx [expr {$menu_len - 1}]
set scrollidx [expr {$itemidx - $selectidx}]
}
set_selectidx $selectidx
set_scrollidx $scrollidx
menu_on_select $selectinfo $selectidx
menu_refresh_top
}
proc select_menu_item {item} {
peek_menu_info
set index [lsearch -exact [dict get $menuinfo lst] $item]
if {$index == -1} return
select_menu_idx $index
}
#
# definitions of menus
#
set main_menu {
font-size 10
border-size 2
width 160
items {{ text "[openmsx_info version]"
font-size 12
post-spacing 6
selectable false }
{ text "Load ROM..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_ROM_list $::osd_rom_path] }}}
{ text "Insert Disk..."
actions { A { if {[catch diska]} { osd::display_message "No disk drive on this machine..." error } else {osd_menu::menu_create [osd_menu::menu_create_disk_list $::osd_disk_path]} }}}
{ text "Set Tape..."
actions { A { if {[catch "machine_info connector cassetteport"]} { osd::display_message "No cassette port on this machine..." error } else { osd_menu::menu_create [osd_menu::menu_create_tape_list $::osd_tape_path]} }}
post-spacing 3 }
{ text "Save State..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_save_state] }}}
{ text "Load State..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_load_state] }}
post-spacing 3 }
{ text "Hardware..."
actions { A { osd_menu::menu_create $osd_menu::hardware_menu }}
post-spacing 3 }
{ text "Misc Settings..."
actions { A { osd_menu::menu_create $osd_menu::misc_setting_menu }}}
{ text "Sound Settings..."
actions { A { osd_menu::menu_create $osd_menu::sound_setting_menu }}}
{ text "Video Settings..."
actions { A { osd_menu::menu_create $osd_menu::video_setting_menu }}
post-spacing 3 }
{ text "Advanced..."
actions { A { osd_menu::menu_create $osd_menu::advanced_menu }}
post-spacing 10 }
{ text "Reset MSX"
actions { A { reset; osd_menu::menu_close_all }}}
{ text "Exit openMSX"
actions { A exit }}}}
set misc_setting_menu {
font-size 8
border-size 2
width 150
xpos 100
ypos 120
items {{ text "Misc Settings"
font-size 10
post-spacing 6
selectable false }
{ text "Speed: $speed"
actions { LEFT { osd_menu::menu_setting [incr speed -1] }
RIGHT { osd_menu::menu_setting [incr speed 1] }}}
{ text "Minimal Frameskip: $minframeskip"
actions { LEFT { osd_menu::menu_setting [incr minframeskip -1] }
RIGHT { osd_menu::menu_setting [incr minframeskip 1] }}}
{ text "Maximal Frameskip: $maxframeskip"
actions { LEFT { osd_menu::menu_setting [incr maxframeskip -1] }
RIGHT { osd_menu::menu_setting [incr maxframeskip 1] }}}}}
set sound_setting_menu {
font-size 8
border-size 2
width 150
xpos 100
ypos 120
items {{ text "Sound Settings"
font-size 10
post-spacing 6
selectable false }
{ text "Volume: $master_volume"
actions { LEFT { osd_menu::menu_setting [incr master_volume -5] }
RIGHT { osd_menu::menu_setting [incr master_volume 5] }}}
{ text "Mute: $mute"
actions { LEFT { osd_menu::menu_setting [cycle_back mute] }
RIGHT { osd_menu::menu_setting [cycle mute] }}}}}
set horizontal_stretch_desc [dict create 320.00 "none (large borders)" 288.00 "a bit more than all border pixels" 284.00 "all border pixels" 280.00 "a bit less than all border pixels" 272.00 "realistic" 256.00 "no borders at all"]
set video_setting_menu {
font-size 8
border-size 2
width 210
xpos 100
ypos 120
items {{ text "Video Settings"
font-size 10
post-spacing 6
selectable false }
{ text "Scaler: $scale_algorithm"
actions { LEFT { osd_menu::menu_setting [cycle_back scale_algorithm] }
RIGHT { osd_menu::menu_setting [cycle scale_algorithm] }}}
{ text "Scale Factor: ${scale_factor}x"
actions { LEFT { osd_menu::menu_setting [incr scale_factor -1] }
RIGHT { osd_menu::menu_setting [incr scale_factor 1] }}}
{ text "Horizontal Stretch: [osd_menu::get_horizontal_stretch_presentation $horizontal_stretch]"
actions { A { osd_menu::menu_create [osd_menu::menu_create_stretch_list]; osd_menu::select_menu_item $::horizontal_stretch }}
post-spacing 6 }
{ text "Scanline: $scanline%"
actions { LEFT { osd_menu::menu_setting [incr scanline -1] }
RIGHT { osd_menu::menu_setting [incr scanline 1] }}}
{ text "Blur: $blur%"
actions { LEFT { osd_menu::menu_setting [incr blur -1] }
RIGHT { osd_menu::menu_setting [incr blur 1] }}}
{ text "Glow: $glow%"
actions { LEFT { osd_menu::menu_setting [incr glow -1] }
RIGHT { osd_menu::menu_setting [incr glow 1] }}}}}
set hardware_menu {
font-size 8
border-size 2
width 175
xpos 100
ypos 120
items {{ text "Hardware"
font-size 10
post-spacing 6
selectable false }
{ text "Change Machine..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_load_machine_list] }}}
{ text "Extensions..."
actions { A { osd_menu::menu_create $osd_menu::extensions_menu }}}
{ text "Connectors..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_connectors_list] }}}
}}
set extensions_menu {
font-size 8
border-size 2
width 175
xpos 100
ypos 120
items {{ text "Extensions"
font-size 10
post-spacing 6
selectable false }
{ text "Add..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_extensions_list] }}}
{ text "Remove..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_plugged_extensions_list] }}}}}
set advanced_menu {
font-size 8
border-size 2
width 175
xpos 100
ypos 120
items {{ text "Advanced"
font-size 10
post-spacing 6
selectable false }
{ text "Manage Running Machines..."
actions { A { osd_menu::menu_create $osd_menu::running_machines_menu }}}
{ text "Toys..."
actions { A { osd_menu::menu_create [osd_menu::menu_create_toys_list] }}}}}
set running_machines_menu {
font-size 8
border-size 2
width 175
xpos 100
ypos 120
items {{ text "Manage Running Machines"
font-size 10
post-spacing 6
selectable false }
{ text "Select Running Machine Tab: [utils::get_machine_display_name]"
actions { A { osd_menu::menu_create [osd_menu::menu_create_running_machine_list] }}}
{ text "New Running Machine Tab"
actions { A { osd_menu::menu_create [osd_menu::menu_create_load_machine_list "add"] }}}
{ text "Close Current Machine Tab"
actions { A { set old_active_machine [activate_machine]; cycle_machine; delete_machine $old_active_machine }}}}}
proc menu_create_running_machine_list {} {
set menu_def {
execute menu_machine_tab_select_exec
font-size 8
border-size 2
width 200
xpos 110
ypos 130
header { text "Select Running Machine"
font-size 10
post-spacing 6 }}
set items [utils::get_ordered_machine_list]
set presentation [list]
foreach i $items {
if {[activate_machine] eq $i} {
set postfix_text "current"
} else {
set postfix_text [utils::get_machine_time $i]
}
lappend presentation [format "%s (%s)" [utils::get_machine_display_name ${i}] $postfix_text]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 5 $menu_def]
}
proc menu_machine_tab_select_exec {item} {
menu_close_top
activate_machine $item
}
proc get_horizontal_stretch_presentation { value } {
if {[dict exists $osd_menu::horizontal_stretch_desc $value]} {
return [dict get $osd_menu::horizontal_stretch_desc $value]
} else {
return "custom: $::horizontal_stretch"
}
}
proc menu_create_stretch_list {} {
set menu_def [list \
execute menu_stretch_exec \
font-size 8 \
border-size 2 \
width 150 \
xpos 110 \
ypos 130 \
header { text "Select Horizontal Stretch:"
font-size 10
post-spacing 6 }]
set items [list]
set presentation [list]
set values [dict keys $osd_menu::horizontal_stretch_desc]
if {$::horizontal_stretch ni $values} {
lappend values $::horizontal_stretch
}
foreach value $values {
lappend items $value
lappend presentation [osd_menu::get_horizontal_stretch_presentation $value]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 6 $menu_def]
}
proc menu_stretch_exec {value} {
set ::horizontal_stretch $value
menu_close_top
# refresh the video settings menu
menu_close_top
menu_create $osd_menu::video_setting_menu
}
proc menu_create_load_machine_list {{mode "replace"}} {
if {$mode eq "replace"} {
set proc_to_exec osd_menu::menu_load_machine_exec_replace
} elseif {$mode eq "add"} {
set proc_to_exec osd_menu::menu_load_machine_exec_add
} else {
error "Undefined mode: $mode"
}
set menu_def [list \
execute $proc_to_exec \
font-size 8 \
border-size 2 \
width 200 \
xpos 110 \
ypos 130 \
header { text "Select Machine to Run"
font-size 10
post-spacing 6 }]
set items [openmsx_info machines]
foreach i $items {
lappend presentation [utils::get_machine_display_name_by_config_name ${i}]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 10 $menu_def]
}
proc menu_load_machine_exec_replace {item} {
if {[catch "machine $item" errorText]} {
osd::display_message $errorText error
} else {
menu_close_all
}
}
proc menu_load_machine_exec_add {item} {
set id [create_machine]
set err [catch {${id}::load_machine $item} error_result]
if {$err} {
delete_machine $id
osd::display_message "Error starting [utils::get_machine_display_name_by_config_name $item]: $error_result" error
} else {
menu_close_top
activate_machine $id
}
}
proc menu_create_extensions_list {} {
set menu_def {
execute menu_add_extension_exec
font-size 8
border-size 2
width 200
xpos 110
ypos 130
header { text "Select Extension to Add"
font-size 10
post-spacing 6 }}
set items [openmsx_info extensions]
set presentation [list]
foreach i $items {
lappend presentation [utils::get_extension_display_name_by_config_name $i]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 10 $menu_def]
}
proc menu_add_extension_exec {item} {
if {[catch "ext $item" errorText]} {
osd::display_message $errorText error
} else {
menu_close_all
}
}
proc menu_create_plugged_extensions_list {} {
set menu_def {
execute menu_remove_extension_exec
font-size 8
border-size 2
width 200
xpos 110
ypos 130
header { text "Select Extension to Remove"
font-size 10
post-spacing 6 }}
set items [list_extensions]
set possible_items [openmsx_info extensions]
set useful_items [list]
foreach item $items {
if {$item in $possible_items} {
lappend useful_items $item
}
}
set presentation [list]
foreach i $useful_items {
lappend presentation [utils::get_extension_display_name_by_config_name ${i}]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $useful_items 10 $menu_def]
}
proc menu_remove_extension_exec {item} {
menu_close_all
remove_extension $item
}
proc get_pluggable_for_connector {connector} {
return [lindex [split [plug $connector] ": "] 2]
}
proc menu_create_connectors_list {} {
set menu_def {
execute menu_connector_exec
font-size 8
border-size 2
width 200
xpos 100
ypos 120
header { text "Connectors"
font-size 10
post-spacing 6 }}
set items [machine_info connector]
set presentation [list]
foreach item $items {
set plugged [get_pluggable_for_connector $item]
set plugged_presentation ""
if {$plugged ne "--empty--"} {
set plugged_presentation " ([machine_info pluggable $plugged])"
}
lappend presentation "[machine_info connector $item]: $plugged$plugged_presentation"
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 5 $menu_def]
}
proc menu_connector_exec {item} {
menu_create [create_menu_pluggable_list $item]
select_menu_item [get_pluggable_for_connector $item]
}
proc create_menu_pluggable_list {connector} {
set menu_def [list \
execute [list menu_plug_exec $connector] \
font-size 8 \
border-size 2 \
width 200 \
xpos 110 \
ypos 140 \
header [list text "What to Plug into [machine_info connector $connector]?" \
font-size 10 \
post-spacing 6 ]]
set items [list]
set class [machine_info connectionclass $connector]
# find out which pluggables are already plugged
# (currently a pluggable can be used only once per machine)
set already_plugged [list]
foreach other_connector [machine_info connector] {
set other_plugged [get_pluggable_for_connector $other_connector]
if {$other_plugged ne "--empty--" && $other_connector ne $connector} {
lappend already_plugged $other_plugged
}
}
# get a list of all pluggables that fit this connector
# and which are not plugged yet in other connectors
foreach pluggable [machine_info pluggable] {
if {$pluggable ni $already_plugged && [machine_info connectionclass $pluggable] eq $class} {
lappend items $pluggable
}
}
set presentation [list]
foreach item $items {
lappend presentation "$item: [machine_info pluggable $item]"
}
set plugged [get_pluggable_for_connector $connector]
if {$plugged ne "--empty--"} {
set items [linsert $items 0 "--unplug--"]
set presentation [linsert $presentation 0 "Nothing, unplug $plugged ([machine_info pluggable $plugged])"]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 5 $menu_def]
}
proc menu_plug_exec {connector pluggable} {
set command ""
if {$pluggable eq "--unplug--"} {
set command "unplug $connector"
} else {
set command "plug $connector $pluggable"
}
if {[catch [eval $command] errorText]} {
osd::display_message $errorText error
} else {
menu_close_top
# refresh the connectors menu
menu_close_top
menu_create [menu_create_connectors_list]
}
}
proc menu_create_toys_list {} {
set menu_def {
execute menu_toys_exec
font-size 8
border-size 2
width 200
xpos 100
ypos 120
header { text "Toys"
font-size 10
post-spacing 6 }}
set items [info commands toggle_*]
set presentation [list]
foreach i $items {
lappend presentation [string range $i 7 end]
}
lappend menu_def presentation $presentation
return [prepare_menu_list $items 5 $menu_def]
}
proc menu_toys_exec {toy} {
return [$toy]
}
proc ls {directory extensions} {
set roms [glob -nocomplain -tails -directory $directory -type f *.{$extensions}]
set dirs [glob -nocomplain -tails -directory $directory -type d *]
set dirs2 [list]
foreach dir $dirs {
lappend dirs2 "$dir/"
}
return [concat ".." [lsort $dirs2] [lsort $roms]]
}
proc menu_create_ROM_list {path} {
return [prepare_menu_list [concat "--eject--" [ls $path "rom,zip,gz"]] \
10 \
{ execute menu_select_rom
font-size 8
border-size 2
width 200
xpos 100
ypos 120
header { text "ROMS $::osd_rom_path"
font-size 10
post-spacing 6 }}]
}
proc menu_select_rom {item} {
if {$item eq "--eject--"} {
menu_close_all
carta eject
reset
} else {
set fullname [file join $::osd_rom_path $item]
if {[file isdirectory $fullname]} {
menu_close_top
set ::osd_rom_path [file normalize $fullname]
menu_create [menu_create_ROM_list $::osd_rom_path]
} else {
menu_close_all
carta $fullname
osd::display_message "Now running ROM:\n[rom_info]"
reset
}
}
}
proc menu_create_disk_list {path} {
return [prepare_menu_list [concat "--eject--" [ls $path "dsk,zip,gz,xsa"]] \
10 \
{ execute menu_select_disk
font-size 8
border-size 2
width 200
xpos 100
ypos 120
header { text "Disks $::osd_disk_path"
font-size 10
post-spacing 6 }}]
}
proc menu_select_disk {item} {
if {$item eq "--eject--"} {
menu_close_all
diska eject
} else {
set fullname [file join $::osd_disk_path $item]
if {[file isdirectory $fullname]} {
menu_close_top
set ::osd_disk_path [file normalize $fullname]
menu_create [menu_create_disk_list $::osd_disk_path]
} else {
menu_close_all
diska $fullname
}
}
}
proc menu_create_tape_list {path} {
return [prepare_menu_list [concat "--eject--" "--rewind--" [ls $path "cas,wav,gz"]] \
10 \
{ execute menu_select_tape
font-size 8
border-size 2
width 200
xpos 100
ypos 120
header { text "Tapes $::osd_tape_path"
font-size 10
post-spacing 6 }}]
}
proc menu_select_tape {item} {
if {$item eq "--eject--"} {
menu_close_all
cassetteplayer eject
} elseif {$item eq "--rewind--"} {
menu_close_all
cassetteplayer rewind
} else {
set fullname [file join $::osd_tape_path $item]
if {[file isdirectory $fullname]} {
menu_close_top
set ::osd_tape_path [file normalize $fullname]
menu_create [menu_create_tape_list $::osd_tape_path]
} else {
menu_close_all
cassetteplayer $fullname
}
}
}
proc get_savestates_list_presentation_sorted {} {
set presentation [list]
foreach i [lsort -integer -index 1 -decreasing [savestate::list_savestates_raw]] {
if {[info commands clock] ne ""} {
set pres_str [format "%s (%s)" [lindex $i 0] [clock format [lindex $i 1] -format "%x - %X"]]
} else {
set pres_str [lindex $i 0]
}
lappend presentation $pres_str
}
return $presentation
}
proc menu_create_load_state {} {
set menu_def \
{ execute menu_loadstate_exec
font-size 8
border-size 2
width 200
xpos 100
ypos 120
on-open {osd create rectangle "preview" -x 225 -y 5 -w 90 -h 70 -rgba 0x30303080 -scaled true}
on-close {osd destroy "preview"}
on-select menu_loadstate_select
on-deselect menu_loadstate_deselect
header { text "Load State"
font-size 10
post-spacing 6 }}
set items [list_savestates -t]
lappend menu_def presentation [get_savestates_list_presentation_sorted]
return [prepare_menu_list $items 10 $menu_def]
}
proc menu_create_save_state {} {
set items [concat [list "create new"] [list_savestates -t]]
set menu_def \
{ execute menu_savestate_exec
font-size 8
border-size 2
width 200
xpos 100
ypos 120
on-open {osd create rectangle "preview" -x 225 -y 5 -w 90 -h 70 -rgba 0x30303080 -scaled true}
on-close {osd destroy "preview"}
on-select menu_loadstate_select
on-deselect menu_loadstate_deselect
header { text "Save State"
font-size 10
post-spacing 6 }}
lappend menu_def presentation [concat [list "create new"] [get_savestates_list_presentation_sorted]]
return [prepare_menu_list $items 10 $menu_def]
}
proc menu_loadstate_select {item} {
set png $::env(OPENMSX_USER_DATA)/../savestates/${item}.png
catch {osd create rectangle "preview.image" -relx 0.05 -rely 0.05 -w 80 -h 60 -image $png}
}
proc menu_loadstate_deselect {item} {
osd destroy "preview.image"
}
proc menu_loadstate_exec {item} {
if {[catch "loadstate $item" errorText]} {
osd::display_message $errorText error
} else {
menu_close_all
}
}
proc menu_savestate_exec {item} {
if {$item eq "create new"} {
set item [menu_free_savestate_name]
} else {
#TODO "Overwrite are you sure?" -dialog
}
if {[catch "savestate $item" errorText]} {
osd::display_message $errorText error
} else {
menu_close_all
}
}
proc menu_free_savestate_name {} {
set existing [list_savestates]
set i 1
while 1 {
set name [format "savestate%04d" $i]
if {$name ni $existing} {
return $name
}
incr i
}
}
# keybindings
if {$tcl_platform(os) eq "Darwin"} { ;# Mac
bind_default "keyb META+O" main_menu_toggle
} elseif {$is_dingoo} { ;# Dingoo
bind_default "keyb ESCAPE" main_menu_toggle ;# select button
bind_default "keyb MENU" main_menu_toggle ;# default: power+select
} else { ;# any other
bind_default "keyb MENU" main_menu_toggle
}
namespace export main_menu_open
namespace export main_menu_close
namespace export main_menu_toggle
} ;# namespace osd_menu
namespace import osd_menu::*
|