Advertisement
arimal

openmsx ocd_menu.tcl

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