_osd_menu.tcl 64 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094
  1. namespace eval osd_menu {
  2. set_help_text main_menu_open "Show the OSD menu."
  3. set_help_text main_menu_close "Remove the OSD menu."
  4. set_help_text main_menu_toggle "Toggle the OSD menu."
  5. variable is_dingux [string match dingux "[openmsx_info platform]"]
  6. variable scaling_available [expr {[lindex [lindex [openmsx_info setting scale_factor] 2] 1] > 1}]
  7. proc get_optional {dict_name key default} {
  8. upvar $dict_name d
  9. expr {[dict exists $d $key] ? [dict get $d $key] : $default}
  10. }
  11. proc set_optional {dict_name key value} {
  12. upvar $dict_name d
  13. if {![dict exists $d $key]} {
  14. dict set d $key $value
  15. }
  16. }
  17. variable menulevels 0
  18. # some variables for typing-in-menus support
  19. variable input_buffer ""
  20. variable input_last_time [openmsx_info realtime]
  21. variable input_timeout 1; #sec
  22. proc push_menu_info {} {
  23. variable menulevels
  24. incr menulevels 1
  25. set levelname "menuinfo_$menulevels"
  26. variable $levelname
  27. set $levelname [uplevel {dict create \
  28. name $name lst $lst menu_len $menu_len presentation $presentation \
  29. menutextexpressions $menutextexpressions menutexts $menutexts \
  30. selectinfo $selectinfo selectidx $selectidx scrollidx \
  31. $scrollidx on_close $on_close}]
  32. }
  33. proc peek_menu_info {} {
  34. variable menulevels
  35. uplevel upvar #0 osd_menu::menuinfo_$menulevels menuinfo
  36. }
  37. proc set_selectidx {value} {
  38. peek_menu_info
  39. dict set menuinfo selectidx $value
  40. }
  41. proc set_scrollidx {value} {
  42. peek_menu_info
  43. dict set menuinfo scrollidx $value
  44. }
  45. proc menu_create {menudef} {
  46. variable menulevels
  47. variable default_bg_color
  48. variable default_text_color
  49. variable default_select_color
  50. variable default_header_text_color
  51. set name "menu[expr {$menulevels + 1}]"
  52. set defactions [get_optional menudef "actions" ""]
  53. set bgcolor [get_optional menudef "bg-color" $default_bg_color]
  54. set deftextcolor [get_optional menudef "text-color" $default_text_color]
  55. set selectcolor [get_optional menudef "select-color" $default_select_color]
  56. set deffontsize [get_optional menudef "font-size" 12]
  57. set deffont [get_optional menudef "font" "skins/Vera.ttf.gz"]
  58. set bordersize [get_optional menudef "border-size" 0]
  59. set on_open [get_optional menudef "on-open" ""]
  60. set on_close [get_optional menudef "on-close" ""]
  61. osd create rectangle $name -scaled true -rgba $bgcolor -clip true \
  62. -borderrgba 0x000000ff -bordersize 0.5
  63. set y $bordersize
  64. set selectinfo [list]
  65. set menutextexpressions [list]
  66. set menutexts [list]
  67. foreach itemdef [dict get $menudef items] {
  68. set selectable [get_optional itemdef "selectable" true]
  69. incr y [get_optional itemdef "pre-spacing" 0]
  70. set fontsize [get_optional itemdef "font-size" $deffontsize]
  71. set font [get_optional itemdef "font" $deffont]
  72. set textcolor [expr {$selectable
  73. ? [get_optional itemdef "text-color" $deftextcolor]
  74. : [get_optional itemdef "text-color" $default_header_text_color]}]
  75. set actions [get_optional itemdef "actions" ""]
  76. set on_select [get_optional itemdef "on-select" ""]
  77. set on_deselect [get_optional itemdef "on-deselect" ""]
  78. set textid "${name}.item${y}"
  79. if {[dict exists $itemdef textexpr]} {
  80. set textexpr [dict get $itemdef textexpr]
  81. lappend menutextexpressions $textid $textexpr
  82. } else {
  83. set text [dict get $itemdef text]
  84. lappend menutexts $textid $text
  85. }
  86. osd create text $textid -font $font -size $fontsize \
  87. -rgba $textcolor -x $bordersize -y $y
  88. if {$selectable} {
  89. set allactions [concat $defactions $actions]
  90. lappend selectinfo [list $y $fontsize $allactions $on_select $on_deselect]
  91. }
  92. incr y $fontsize
  93. incr y [get_optional itemdef "post-spacing" 0]
  94. }
  95. set width [dict get $menudef width]
  96. set height [expr {$y + $bordersize}]
  97. set xpos [get_optional menudef "xpos" [expr {(320 - $width) / 2}]]
  98. set ypos [get_optional menudef "ypos" [expr {(240 - $height) / 2}]]
  99. osd configure $name -x $xpos -y $ypos -w $width -h $height
  100. set selw [expr {$width - 2 * $bordersize}]
  101. osd create rectangle "${name}.selection" -z -1 -rgba $selectcolor \
  102. -x $bordersize -w $selw
  103. set lst [get_optional menudef "lst" ""]
  104. set menu_len [get_optional menudef "menu_len" 0]
  105. if {[llength $lst] > $menu_len} {
  106. set startheight 0
  107. if {[llength $selectinfo] > 0} {
  108. # there are selectable items. Start the scrollbar
  109. # at the top of the first selectable item
  110. # (skipping headers and stuff)
  111. set startheight [lindex $selectinfo 0 0]
  112. }
  113. osd create rectangle "${name}.scrollbar" -z -1 -rgba 0x00000010 \
  114. -relx 1.0 -x -6 -w 6 -relh 1.0 -h -$startheight -y $startheight -borderrgba 0x00000070 -bordersize 0.5
  115. osd create rectangle "${name}.scrollbar.thumb" -z -1 -rgba $default_select_color \
  116. -relw 1.0 -w -2 -x 1
  117. }
  118. set presentation [get_optional menudef "presentation" ""]
  119. set selectidx 0
  120. set scrollidx 0
  121. push_menu_info
  122. uplevel #0 $on_open
  123. menu_on_select $selectinfo $selectidx
  124. menu_refresh_top
  125. menu_update_scrollbar
  126. }
  127. proc menu_update_scrollbar {} {
  128. peek_menu_info
  129. set name [dict get $menuinfo name]
  130. if {[osd exists ${name}.scrollbar]} {
  131. set menu_len [dict get $menuinfo menu_len]
  132. set scrollidx [dict get $menuinfo scrollidx]
  133. set selectidx [dict get $menuinfo selectidx]
  134. set totalitems [llength [dict get $menuinfo lst]]
  135. set height [expr {1.0*$menu_len/$totalitems}]
  136. set minheight 0.05 ;# TODO: derive from width of bar
  137. set height [expr {$height > $minheight ? $height : $minheight}]
  138. set pos [expr {1.0*($scrollidx+$selectidx)/($totalitems-1)}]
  139. # scale the pos to the usable range
  140. set pos [expr {$pos*(1.0-$height)}]
  141. osd configure "${name}.scrollbar.thumb" -relh $height -rely $pos
  142. }
  143. }
  144. proc menu_refresh_top {} {
  145. peek_menu_info
  146. foreach {osdid textexpr} [dict get $menuinfo menutextexpressions] {
  147. set cmd [list subst $textexpr]
  148. osd configure $osdid -text [uplevel #0 $cmd]
  149. }
  150. foreach {osdid text} [dict get $menuinfo menutexts] {
  151. osd configure $osdid -text $text
  152. }
  153. set selectinfo [dict get $menuinfo selectinfo]
  154. if {[llength $selectinfo] == 0} return
  155. set selectidx [dict get $menuinfo selectidx ]
  156. lassign [lindex $selectinfo $selectidx] sely selh
  157. osd configure "[dict get $menuinfo name].selection" -y $sely -h $selh
  158. }
  159. proc menu_close_top {} {
  160. variable menulevels
  161. peek_menu_info
  162. menu_on_deselect [dict get $menuinfo selectinfo] [dict get $menuinfo selectidx]
  163. uplevel #0 [dict get $menuinfo on_close]
  164. osd destroy [dict get $menuinfo name]
  165. unset menuinfo
  166. incr menulevels -1
  167. if {$menulevels == 0} {
  168. menu_last_closed
  169. }
  170. }
  171. proc menu_close_all {} {
  172. variable menulevels
  173. while {$menulevels} {
  174. menu_close_top
  175. }
  176. }
  177. proc menu_setting {cmd_result} {
  178. menu_refresh_top
  179. }
  180. proc menu_updown {delta} {
  181. peek_menu_info
  182. set num [llength [dict get $menuinfo selectinfo]]
  183. if {$num == 0} return
  184. set old_idx [dict get $menuinfo selectidx]
  185. menu_reselect [expr {($old_idx + $delta) % $num}]
  186. }
  187. proc menu_reselect {new_idx} {
  188. peek_menu_info
  189. set selectinfo [dict get $menuinfo selectinfo]
  190. set old_idx [dict get $menuinfo selectidx]
  191. menu_on_deselect $selectinfo $old_idx
  192. set_selectidx $new_idx
  193. menu_on_select $selectinfo $new_idx
  194. menu_refresh_top
  195. }
  196. proc menu_on_select {selectinfo selectidx} {
  197. set on_select [lindex $selectinfo $selectidx 3]
  198. uplevel #0 $on_select
  199. }
  200. proc menu_on_deselect {selectinfo selectidx} {
  201. set on_deselect [lindex $selectinfo $selectidx 4]
  202. uplevel #0 $on_deselect
  203. }
  204. proc menu_action {button} {
  205. # for any menu action, clear the input buffer
  206. variable input_buffer
  207. set input_buffer ""
  208. peek_menu_info
  209. set selectidx [dict get $menuinfo selectidx ]
  210. menu_action_idx $selectidx $button
  211. }
  212. proc menu_action_idx {idx button} {
  213. peek_menu_info
  214. set selectinfo [dict get $menuinfo selectinfo]
  215. set actions [lindex $selectinfo $idx 2]
  216. set_optional actions UP {osd_menu::menu_updown -1}
  217. set_optional actions DOWN {osd_menu::menu_updown 1}
  218. set_optional actions B {osd_menu::menu_close_top}
  219. set cmd [get_optional actions $button ""]
  220. uplevel #0 $cmd
  221. }
  222. proc get_mouse_coords {} {
  223. peek_menu_info
  224. set x 2; set y 2
  225. catch {
  226. set name [dict get $menuinfo name]
  227. lassign [osd info $name -mousecoord] x y
  228. }
  229. list $x $y
  230. }
  231. proc menu_get_mouse_idx {xy} {
  232. lassign $xy x y
  233. if {$x < 0 || 1 < $x || $y < 0 || 1 < $y} {return -1}
  234. peek_menu_info
  235. set name [dict get $menuinfo name]
  236. set yy [expr {$y * [osd info $name -h]}]
  237. set sel 0
  238. foreach i [dict get $menuinfo selectinfo] {
  239. lassign $i y h actions
  240. if {($y <= $yy) && ($yy < ($y + $h))} {
  241. return $sel
  242. }
  243. incr sel
  244. }
  245. return -1
  246. }
  247. proc menu_mouse_down {} {
  248. variable mouse_coord
  249. variable mouse_idx
  250. set mouse_coord [get_mouse_coords]
  251. set mouse_idx [menu_get_mouse_idx $mouse_coord]
  252. if {$mouse_idx != -1} {
  253. menu_reselect $mouse_idx
  254. }
  255. }
  256. proc menu_mouse_up {} {
  257. variable mouse_coord
  258. variable mouse_idx
  259. set mouse_coord [get_mouse_coords]
  260. set mouse_idx [menu_get_mouse_idx $mouse_coord]
  261. if {$mouse_idx != -1} {
  262. menu_action_idx $mouse_idx A
  263. }
  264. unset mouse_coord
  265. unset mouse_idx
  266. }
  267. proc menu_mouse_wheel {event} {
  268. lassign $event type1 type2 x y
  269. if {$y > 0} {
  270. osd_menu::menu_action UP
  271. } elseif {$y < 0} {
  272. osd_menu::menu_action DOWN
  273. }
  274. }
  275. proc menu_mouse_motion {} {
  276. variable mouse_coord
  277. variable mouse_idx
  278. if {![info exists mouse_coord]} return
  279. set new_mouse_coord [get_mouse_coords]
  280. set new_idx [menu_get_mouse_idx $new_mouse_coord]
  281. if {$new_idx != -1 && $new_idx != $mouse_idx} {
  282. menu_reselect $new_idx
  283. set mouse_coord $new_mouse_coord
  284. set mouse_idx $new_idx
  285. return
  286. }
  287. if {$mouse_idx != -1} {
  288. lassign $mouse_coord old_x old_y
  289. lassign $new_mouse_coord new_x new_y
  290. set delta_x [expr {$new_x - $old_x}]
  291. set delta_y [expr {$new_y - $old_y}]
  292. if {$delta_y > 0.1} {
  293. menu_action_idx $mouse_idx DOWN
  294. set mouse_coord $new_mouse_coord
  295. return
  296. } elseif {$delta_y < -0.1} {
  297. menu_action_idx $mouse_idx UP
  298. set mouse_coord $new_mouse_coord
  299. return
  300. } elseif {$delta_x > 0.1} {
  301. menu_action_idx $mouse_idx RIGHT
  302. set mouse_coord $new_mouse_coord
  303. return
  304. } elseif {$delta_x < -0.1} {
  305. menu_action_idx $mouse_idx LEFT
  306. set mouse_coord $new_mouse_coord
  307. return
  308. }
  309. }
  310. }
  311. user_setting create string osd_rom_path "OSD Rom Load Menu Last Known Path" $env(HOME)
  312. user_setting create string osd_disk_path "OSD Disk Load Menu Last Known Path" $env(HOME)
  313. user_setting create string osd_tape_path "OSD Tape Load Menu Last Known Path" $env(HOME)
  314. user_setting create string osd_hdd_path "OSD HDD Load Menu Last Known Path" $env(HOME)
  315. user_setting create string osd_ld_path "OSD LD Load Menu Last Known Path" $env(HOME)
  316. if {![file exists $::osd_rom_path] || ![file readable $::osd_rom_path]} {
  317. # revert to default (should always exist)
  318. unset ::osd_rom_path
  319. }
  320. if {![file exists $::osd_disk_path] || ![file readable $::osd_disk_path]} {
  321. # revert to default (should always exist)
  322. unset ::osd_disk_path
  323. }
  324. if {![file exists $::osd_tape_path] || ![file readable $::osd_tape_path]} {
  325. # revert to default (should always exist)
  326. unset ::osd_tape_path
  327. }
  328. if {![file exists $::osd_hdd_path] || ![file readable $::osd_hdd_path]} {
  329. # revert to default (should always exist)
  330. unset ::osd_hdd_path
  331. }
  332. if {![file exists $::osd_ld_path] || ![file readable $::osd_ld_path]} {
  333. # revert to default (should always exist)
  334. unset ::osd_ld_path
  335. }
  336. variable taperecordings_directory [file normalize $::env(OPENMSX_USER_DATA)/../taperecordings]
  337. proc main_menu_open {} {
  338. do_menu_open [create_main_menu]
  339. }
  340. proc do_menu_open {top_menu} {
  341. variable is_dingux
  342. # close console, because the menu interferes with it
  343. set ::console off
  344. # also remove other OSD controlled widgets (like the osd keyboard)
  345. if {[info exists ::osd_control::close]} {
  346. eval $::osd_control::close
  347. }
  348. # end tell how to close this widget
  349. namespace eval ::osd_control {set close ::osd_menu::main_menu_close}
  350. menu_create $top_menu
  351. set ::pause true
  352. # TODO make these bindings easier to customize
  353. bind -layer osd_menu "OSDcontrol UP PRESS" -repeat {osd_menu::menu_action UP }
  354. bind -layer osd_menu "OSDcontrol DOWN PRESS" -repeat {osd_menu::menu_action DOWN }
  355. bind -layer osd_menu "OSDcontrol LEFT PRESS" -repeat {osd_menu::menu_action LEFT }
  356. bind -layer osd_menu "OSDcontrol RIGHT PRESS" -repeat {osd_menu::menu_action RIGHT}
  357. bind -layer osd_menu "mouse button1 down" {osd_menu::menu_mouse_down}
  358. bind -layer osd_menu "mouse button1 up" {osd_menu::menu_mouse_up}
  359. bind -layer osd_menu "mouse button3 up" {osd_menu::menu_close_top}
  360. bind -layer osd_menu "mouse motion" {osd_menu::menu_mouse_motion}
  361. bind -layer osd_menu "mouse wheel" -event {osd_menu::menu_mouse_wheel}
  362. if {$is_dingux} {
  363. bind -layer osd_menu "keyb LCTRL" {osd_menu::menu_action A }
  364. bind -layer osd_menu "keyb LALT" {osd_menu::menu_action B }
  365. } else {
  366. bind -layer osd_menu "OSDcontrol A PRESS" {osd_menu::menu_action A }
  367. bind -layer osd_menu "OSDcontrol B PRESS" {osd_menu::menu_action B }
  368. # on Android, use BACK button to go back in menus
  369. bind -layer osd_menu "keyb BACK" {osd_menu::menu_action B }
  370. }
  371. bind -layer osd_menu "CTRL+UP" {osd_menu::select_menu_idx 0}
  372. bind -layer osd_menu "CTRL+LEFT" {osd_menu::select_menu_idx 0}
  373. bind -layer osd_menu "keyb HOME" {osd_menu::select_menu_idx 0}
  374. set alphanum {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9}
  375. foreach char $alphanum {
  376. bind -layer osd_menu "keyb $char" "osd_menu::handle_keyboard_input $char"
  377. }
  378. activate_input_layer osd_menu -blocking
  379. }
  380. proc main_menu_close {} {
  381. menu_close_all
  382. }
  383. proc main_menu_toggle {} {
  384. variable menulevels
  385. if {$menulevels} {
  386. # there is at least one menu open, close it
  387. menu_close_all
  388. } else {
  389. # none open yet, open main menu
  390. main_menu_open
  391. }
  392. }
  393. proc menu_last_closed {} {
  394. set ::pause false
  395. after realtime 0 {deactivate_input_layer osd_menu}
  396. namespace eval ::osd_control {unset close}
  397. }
  398. proc prepare_menu_list {lst num menudef} {
  399. set execute [dict get $menudef execute]
  400. set header [dict get $menudef header]
  401. set item_extra [get_optional menudef item ""]
  402. set on_select [get_optional menudef on-select ""]
  403. set on_deselect [get_optional menudef on-deselect ""]
  404. set presentation [get_optional menudef presentation $lst]
  405. # 'assert': presentation should have same length as item list!
  406. if {[llength $presentation] != [llength $lst]} {
  407. error "Presentation should be of same length as item list!"
  408. }
  409. dict set menudef presentation $presentation
  410. lappend header "selectable" "false"
  411. set items [list $header]
  412. set lst_len [llength $lst]
  413. set menu_len [expr {$lst_len < $num ? $lst_len : $num}]
  414. for {set i 0} {$i < $menu_len} {incr i} {
  415. set actions [list "A" "osd_menu::list_menu_item_exec {$execute} $i"]
  416. if {$i == 0} {
  417. lappend actions "UP" "osd_menu::move_selection -1"
  418. }
  419. if {$i == ($menu_len - 1)} {
  420. lappend actions "DOWN" "osd_menu::move_selection 1"
  421. }
  422. lappend actions "LEFT" "osd_menu::move_selection -$menu_len"
  423. lappend actions "RIGHT" "osd_menu::move_selection $menu_len"
  424. set item [list "textexpr" "\[osd_menu::list_menu_item_show $i\]" \
  425. "actions" $actions]
  426. if {$on_select ne ""} {
  427. lappend item "on-select" "osd_menu::list_menu_item_select $i $on_select"
  428. }
  429. if {$on_deselect ne ""} {
  430. lappend item "on-deselect" "osd_menu::list_menu_item_select $i $on_deselect"
  431. }
  432. lappend items [concat $item $item_extra]
  433. }
  434. dict set menudef items $items
  435. dict set menudef lst $lst
  436. dict set menudef menu_len $menu_len
  437. return $menudef
  438. }
  439. proc list_menu_item_exec {execute pos} {
  440. peek_menu_info
  441. {*}$execute [lindex [dict get $menuinfo lst] [expr {$pos + [dict get $menuinfo scrollidx]}]]
  442. }
  443. proc list_menu_item_show {pos} {
  444. peek_menu_info
  445. return [lindex [dict get $menuinfo presentation] [expr {$pos + [dict get $menuinfo scrollidx]}]]
  446. }
  447. proc list_menu_item_select {pos select_proc} {
  448. peek_menu_info
  449. $select_proc [lindex [dict get $menuinfo lst] [expr {$pos + [dict get $menuinfo scrollidx]}]]
  450. }
  451. proc move_selection {delta} {
  452. peek_menu_info
  453. set lst_last [expr {[llength [dict get $menuinfo lst]] - 1}]
  454. set scrollidx [dict get $menuinfo scrollidx]
  455. set selectidx [dict get $menuinfo selectidx]
  456. set old_itemidx [expr {$scrollidx + $selectidx}]
  457. set new_itemidx [expr {$old_itemidx + $delta}]
  458. if {$new_itemidx < 0} {
  459. # Before first element
  460. if {$old_itemidx == 0} {
  461. # if first element was already selected, wrap to last
  462. set new_itemidx $lst_last
  463. } else {
  464. # otherwise, clamp to first element
  465. set new_itemidx 0
  466. }
  467. } elseif {$new_itemidx > $lst_last} {
  468. # After last element
  469. if {$old_itemidx == $lst_last} {
  470. # if last element was already selected, wrap to first
  471. set new_itemidx 0
  472. } else {
  473. # otherwise clam to last element
  474. set new_itemidx $lst_last
  475. }
  476. }
  477. select_menu_idx $new_itemidx
  478. }
  479. proc select_menu_idx {itemidx} {
  480. peek_menu_info
  481. set menu_len [dict get $menuinfo menu_len]
  482. set scrollidx [dict get $menuinfo scrollidx]
  483. set selectidx [dict get $menuinfo selectidx]
  484. set selectinfo [dict get $menuinfo selectinfo]
  485. menu_on_deselect $selectinfo $selectidx
  486. set selectidx [expr {$itemidx - $scrollidx}]
  487. if {$selectidx < 0} {
  488. incr scrollidx $selectidx
  489. set selectidx 0
  490. } elseif {($menu_len > 0) && ($selectidx >= $menu_len)} {
  491. set selectidx [expr {$menu_len - 1}]
  492. set scrollidx [expr {$itemidx - $selectidx}]
  493. }
  494. set_selectidx $selectidx
  495. set_scrollidx $scrollidx
  496. menu_on_select $selectinfo $selectidx
  497. menu_refresh_top
  498. menu_update_scrollbar
  499. }
  500. proc select_menu_item {item} {
  501. peek_menu_info
  502. set index [lsearch -exact [dict get $menuinfo lst] $item]
  503. if {$index == -1} return
  504. select_menu_idx $index
  505. }
  506. proc handle_keyboard_input {char} {
  507. variable input_buffer
  508. variable input_last_time
  509. variable input_timeout
  510. set current_time [openmsx_info realtime]
  511. if {[expr {$current_time - $input_last_time}] < $input_timeout} {
  512. set input_buffer "$input_buffer$char"
  513. } else {
  514. set input_buffer $char
  515. }
  516. set input_last_time $current_time
  517. osd_menu::select_next_menu_item_starting_with $input_buffer
  518. }
  519. proc select_next_menu_item_starting_with {text} {
  520. peek_menu_info
  521. set items [dict get $menuinfo presentation]
  522. if {[llength $items] == 0} return
  523. set selectidx [dict get $menuinfo selectidx]
  524. set scrollidx [dict get $menuinfo scrollidx]
  525. set itemidx [expr {$scrollidx + $selectidx}]
  526. # start after the current item if this is a new search
  527. if {[string length $text] == 1} {
  528. incr itemidx
  529. }
  530. # use the list twice to wrap
  531. set index [lsearch -glob -nocase -start $itemidx [concat $items $items] "$text*"]
  532. if {$index == -1} return
  533. set index [expr {$index % [llength $items]}]
  534. select_menu_idx $index
  535. }
  536. variable mediaslot_info [dict create \
  537. "rom" [dict create mediabasecommand "cart" mediapath "::osd_rom_path" listtype "rom" itemtext "Load ROM" shortmediaslotname "slot" longmediaslotname "cartridge slot"]\
  538. "disk" [dict create mediabasecommand "disk" mediapath "::osd_disk_path" listtype "disk" itemtext "Insert disk" shortmediaslotname "drive" longmediaslotname "disk drive"]\
  539. #"cassette" [dict create mediabasecommand "cassetteplayer" mediapath "::osd_tape_path" listtype "tape" itemtext "Set tape" shortmediaslotname "xxx" longmediaslotname "cassette player"]\
  540. ]
  541. proc create_slot_actions_to_select_file {slot path listtype} {
  542. # the action A is checking what is currently in that media slot (e.g. diska) and if it's not empty, it puts that path as last known path. Then it creates the menu and afterwards selects the current item.
  543. return [list actions [list A "set curSel \[lindex \[$slot\] 1\]; set $path \[expr {\$curSel ne {} ? \[file dirname \$curSel\] : \$$path}\]; osd_menu::menu_create \[osd_menu::menu_create_${listtype}_list \$$path $slot\]; catch { osd_menu::select_menu_item \[file tail \$curSel\]}"]]
  544. }
  545. proc get_slot_str {slot} {
  546. return [string toupper [string index $slot end]]
  547. }
  548. proc create_slot_menu_def {slots path listtype menutitle create_action_proc} {
  549. set menudef {
  550. font-size 8
  551. border-size 2
  552. width 150
  553. xpos 100
  554. ypos 80
  555. }
  556. lappend items [list text $menutitle\
  557. font-size 12\
  558. post-spacing 6\
  559. selectable false\
  560. ]
  561. foreach slot $slots {
  562. set slotcontent "(empty)"
  563. if {![string match "empty*" [lindex [$slot] 2]]} {
  564. set slotcontent [file tail [lindex [$slot] 1]]
  565. }
  566. lappend items [list text "[get_slot_str $slot]: $slotcontent" {*}[$create_action_proc $slot $path $listtype]]
  567. }
  568. dict set menudef items $items
  569. return $menudef
  570. }
  571. proc create_media_menu_items {file_type_category} {
  572. variable mediaslot_info
  573. set longmediaslotname [dict get $mediaslot_info $file_type_category longmediaslotname]
  574. set shortmediaslotname [dict get $mediaslot_info $file_type_category shortmediaslotname]
  575. set mediapath [dict get $mediaslot_info $file_type_category mediapath]
  576. set listtype [dict get $mediaslot_info $file_type_category listtype]
  577. set itemtext [dict get $mediaslot_info $file_type_category itemtext]
  578. set mediabasecommand [dict get $mediaslot_info $file_type_category mediabasecommand]
  579. if {[catch ${mediabasecommand}a]} {; # example: Philips NMS 801 without cart slot, or no diskdrives. TODO: make more generic
  580. lappend menuitems [list text "(No $longmediaslotname present...)"\
  581. selectable false\
  582. text-color 0x808080ff\
  583. ]
  584. } else {
  585. set slots [lsort [info command ${mediabasecommand}?]]; # TODO: make more generic
  586. if {[llength $slots] <= 2} {
  587. foreach slot $slots {
  588. lappend menuitems [list text "${itemtext}... (${shortmediaslotname} [get_slot_str $slot])" {*}[create_slot_actions_to_select_file $slot $mediapath $listtype]]
  589. }
  590. } else {
  591. set slot [lindex $slots 0]
  592. lappend menuitems [list text "${itemtext}... (${shortmediaslotname} [get_slot_str $slot])" {*}[create_slot_actions_to_select_file $slot $mediapath $listtype]]
  593. lappend menuitems [list text "${itemtext}... (any ${shortmediaslotname})" actions [list A "osd_menu::menu_create \[osd_menu::create_slot_menu_def \[list $slots\] \{$mediapath\} \{$listtype\} \{Select $longmediaslotname...\} \{create_slot_actions_to_select_file\}\]"]]
  594. }
  595. }
  596. return $menuitems
  597. }
  598. #
  599. # definitions of menus
  600. #
  601. proc create_main_menu {} {
  602. set menu_def {
  603. font-size 10
  604. border-size 2
  605. width 160
  606. }
  607. lappend items { textexpr "[openmsx_info version]"
  608. font-size 12
  609. post-spacing 6
  610. selectable false }
  611. lappend items {*}[create_media_menu_items "rom"]
  612. lappend items {*}[create_media_menu_items "disk"]
  613. if {[info command hda] ne ""} {; # only exists when hard disk extension available
  614. foreach drive [lrange [lsort [info command hd?]] 0 1] {
  615. set drive_str [string toupper [string index $drive end]]
  616. lappend items [list text "Change HD/SD image... (drive $drive_str)" \
  617. actions [list A "set curSel \[lindex \[$drive\] 1\]; set ::osd_hdd_path \[expr {\$curSel ne {} ? \[file dirname \$curSel\] : \$::osd_hdd_path}\]; osd_menu::menu_create \[osd_menu::menu_create_hdd_list \$::osd_hdd_path $drive\]; catch { osd_menu::select_menu_item \[file tail \$curSel\]}"]]
  618. }
  619. }
  620. if {[info command laserdiscplayer] ne ""} {; # only exists on some Pioneers
  621. lappend items { text "Load LaserDisc..."
  622. actions { A { set curSel [lindex [laserdiscplayer] 1]; set ::osd_ld_path [expr {$curSel ne {} ? [file dirname $curSel] : $::osd_ld_path}]; osd_menu::menu_create [osd_menu::menu_create_ld_list $::osd_ld_path]; catch { osd_menu::select_menu_item [file tail $curSel]}} }
  623. }
  624. }
  625. if {[catch "machine_info connector cassetteport"]} {; # example: turboR
  626. lappend items { text "(No cassette port present...)"
  627. selectable false
  628. text-color 0x808080ff
  629. post-spacing 3
  630. }
  631. } else {
  632. lappend items { text "Set Tape..."
  633. actions { A { osd_menu::menu_create [osd_menu::menu_create_tape_list $::osd_tape_path]; catch { osd_menu::select_menu_item [file tail [lindex [cassetteplayer] 1]]}} }
  634. post-spacing 3 }
  635. }
  636. lappend items { text "Save State..."
  637. actions { A { osd_menu::menu_create [osd_menu::menu_create_save_state] }}}
  638. lappend items { text "Load State..."
  639. actions { A { osd_menu::menu_create [osd_menu::menu_create_load_state] }}
  640. post-spacing 3 }
  641. lappend items { text "Hardware..."
  642. actions { A { osd_menu::menu_create [osd_menu::create_hardware_menu] }}
  643. post-spacing 3 }
  644. lappend items { text "Misc Settings..."
  645. actions { A { osd_menu::menu_create $osd_menu::misc_setting_menu }}}
  646. lappend items { text "Sound Settings..."
  647. actions { A { osd_menu::menu_create $osd_menu::sound_setting_menu }}}
  648. lappend items { text "Video Settings..."
  649. actions { A { osd_menu::menu_create [osd_menu::create_video_setting_menu] }}
  650. post-spacing 3 }
  651. lappend items { text "Advanced..."
  652. actions { A { osd_menu::menu_create $osd_menu::advanced_menu }}
  653. post-spacing 10 }
  654. lappend items { text "Reset MSX"
  655. actions { A { reset; osd_menu::menu_close_all }}}
  656. lappend items { text "Exit openMSX"
  657. actions { A quitmenu::quit_menu }}
  658. dict set menu_def items $items
  659. return $menu_def
  660. }
  661. set misc_setting_menu {
  662. font-size 8
  663. border-size 2
  664. width 160
  665. xpos 100
  666. ypos 120
  667. items {{ text "Misc Settings"
  668. font-size 10
  669. post-spacing 6
  670. selectable false }
  671. { textexpr "Speed: ${speed}%"
  672. actions { LEFT { osd_menu::menu_setting [incr speed -1] }
  673. RIGHT { osd_menu::menu_setting [incr speed 1] }}}
  674. { textexpr "Fastforward speed: ${fastforwardspeed}%"
  675. actions { LEFT { osd_menu::menu_setting [incr fastforwardspeed -1] }
  676. RIGHT { osd_menu::menu_setting [incr fastforwardspeed 1] }}}
  677. { textexpr "Full speed when loading: [osd_menu::boolean_to_text $fullspeedwhenloading]"
  678. actions { LEFT { osd_menu::menu_setting [cycle_back fullspeedwhenloading] }
  679. RIGHT { osd_menu::menu_setting [cycle fullspeedwhenloading] }}}
  680. { textexpr "Keyboard mapping mode: $kbd_mapping_mode"
  681. actions { LEFT { osd_menu::menu_setting [cycle_back kbd_mapping_mode] }
  682. RIGHT { osd_menu::menu_setting [cycle kbd_mapping_mode] }}}
  683. }}
  684. set resampler_desc [dict create fast "fast (but low quality)" blip "blip (good speed/quality)" hq "hq (best but uses more CPU)"]
  685. set sound_setting_menu {
  686. font-size 8
  687. border-size 2
  688. width 180
  689. xpos 100
  690. ypos 120
  691. items {{ text "Sound Settings"
  692. font-size 10
  693. post-spacing 6
  694. selectable false }
  695. { textexpr "Volume: $master_volume"
  696. actions { LEFT { osd_menu::menu_setting [incr master_volume -5] }
  697. RIGHT { osd_menu::menu_setting [incr master_volume 5] }}}
  698. { textexpr "Mute: [osd_menu::boolean_to_text $mute]"
  699. actions { LEFT { osd_menu::menu_setting [cycle_back mute] }
  700. RIGHT { osd_menu::menu_setting [cycle mute] }}}
  701. { text "Individual Sound Device Settings..."
  702. actions { A { osd_menu::menu_create [osd_menu::menu_create_sound_device_list]}}}
  703. { textexpr "Resampler: [osd_menu::get_resampler_presentation $resampler]"
  704. actions { LEFT { osd_menu::menu_setting [cycle_back resampler] }
  705. RIGHT { osd_menu::menu_setting [cycle resampler] }}}}}
  706. set horizontal_stretch_desc [dict create 320.0 "none (large borders)" 288.0 "a bit more than all border pixels" 284.0 "all border pixels" 280.0 "a bit less than all border pixels" 272.0 "realistic" 256.0 "no borders at all"]
  707. proc menu_create_sound_device_list {} {
  708. set menu_def {
  709. execute menu_sound_device_select_exec
  710. font-size 8
  711. border-size 2
  712. width 200
  713. xpos 110
  714. ypos 130
  715. header { text "Select Sound Chip"
  716. font-size 10
  717. post-spacing 6 }}
  718. set items [machine_info sounddevice]
  719. return [prepare_menu_list $items 5 $menu_def]
  720. }
  721. proc menu_sound_device_select_exec {item} {
  722. menu_create [create_sound_device_settings_menu $item]
  723. select_menu_item $item
  724. }
  725. proc create_sound_device_settings_menu {device} {
  726. set ypos 140
  727. set menu_def [list \
  728. font-size 8 \
  729. border-size 2 \
  730. width 210 \
  731. xpos 120 \
  732. ypos $ypos]
  733. lappend items [list text "$device Settings" \
  734. font-size 10 \
  735. post-spacing 6 \
  736. selectable false]
  737. # volume and balance
  738. foreach aspect [list volume balance] {
  739. set var_name ::${device}_${aspect}
  740. set item [list]
  741. lappend item "textexpr"
  742. set first [string range $aspect 0 0]
  743. set rest [string range $aspect 1 end]
  744. set first [string toupper $first]
  745. set capped_aspect "${first}${rest}"
  746. lappend item "$capped_aspect: \[[list set $var_name]]"
  747. lappend item "actions"
  748. set actions [list]
  749. lappend actions "LEFT"
  750. lappend actions "osd_menu::menu_setting \[[list incr $var_name -5]]"
  751. lappend actions "RIGHT"
  752. lappend actions "osd_menu::menu_setting \[[list incr $var_name 5]]"
  753. lappend item $actions
  754. lappend items $item
  755. }
  756. # channel mute
  757. set channel_count [soundchip_utils::get_num_channels $device]
  758. for {set channel 1} {$channel <= $channel_count} {incr channel} {
  759. set chmute_var_name ${device}_ch${channel}_mute
  760. set item [list]
  761. lappend item "textexpr"
  762. set pretext ""
  763. if {$channel_count > 1} {
  764. set pretext "Channel $channel "
  765. }
  766. lappend item "${pretext}Mute: \[osd_menu::boolean_to_text \[[list set $chmute_var_name]]]"
  767. lappend item "actions"
  768. set actions [list]
  769. lappend actions "LEFT"
  770. lappend actions "osd_menu::menu_setting \[[list cycle_back $chmute_var_name]]"
  771. lappend actions "RIGHT"
  772. lappend actions "osd_menu::menu_setting \[[list cycle $chmute_var_name]]"
  773. lappend item $actions
  774. lappend items $item
  775. }
  776. # adjust menu position for longer lists
  777. # TODO: make this less magic
  778. if {$channel_count > 8} {;# more won't fit
  779. dict set menu_def ypos [expr {$ypos - round(($channel_count - 8) * ($ypos - 10)/16)}]
  780. }
  781. dict set menu_def items $items
  782. return $menu_def
  783. }
  784. proc boolean_to_text {boolean} {
  785. if {[lsearch -nocase [list "true" "on" "yes"] $boolean] != -1} {
  786. return "on"
  787. } elseif {[lsearch -nocase [list "false" "off" "no"] $boolean] != -1} {
  788. return "off"
  789. } else {
  790. puts stderr "Couldn't make head or tails of: XXX${boolean}XXX"
  791. return $boolean
  792. }
  793. }
  794. proc create_video_setting_menu {} {
  795. variable scaling_available
  796. set menu_def {
  797. font-size 8
  798. border-size 2
  799. width 210
  800. xpos 100
  801. ypos 110
  802. }
  803. lappend items { text "Video Settings"
  804. font-size 10
  805. post-spacing 6
  806. selectable false }
  807. if {[expr {[lindex [lindex [openmsx_info setting videosource] 2] 1] > 1}]} {
  808. lappend items { textexpr "Video source: $videosource"
  809. actions { LEFT { osd_menu::menu_setting [cycle_back videosource] }
  810. RIGHT { osd_menu::menu_setting [cycle videosource] }}
  811. post-spacing 3}
  812. }
  813. if {$scaling_available} {
  814. lappend items { textexpr "Scaler: $scale_algorithm"
  815. actions { LEFT { osd_menu::menu_setting [cycle_back scale_algorithm] }
  816. RIGHT { osd_menu::menu_setting [cycle scale_algorithm] }}}
  817. # only add scale factor setting if it can actually be changed
  818. set scale_minmax [lindex [openmsx_info setting scale_factor] 2]
  819. if {[expr {[lindex $scale_minmax 0] != [lindex $scale_minmax 1]}]} {
  820. lappend items { textexpr "Scale Factor: ${scale_factor}x"
  821. actions { LEFT { osd_menu::menu_setting [incr scale_factor -1] }
  822. RIGHT { osd_menu::menu_setting [incr scale_factor 1] }}}
  823. }
  824. }
  825. lappend items { textexpr "Horizontal Stretch: [osd_menu::get_horizontal_stretch_presentation $horizontal_stretch]"
  826. actions { A { osd_menu::menu_create [osd_menu::menu_create_stretch_list]; osd_menu::select_menu_item $horizontal_stretch }}
  827. post-spacing 3 }
  828. if {$::renderer eq "SDLGL-PP"} {
  829. lappend items { textexpr "VSync: [osd_menu::boolean_to_text $vsync]"
  830. actions { LEFT { osd_menu::menu_setting [cycle_back vsync] }
  831. RIGHT { osd_menu::menu_setting [cycle vsync] }}
  832. post-spacing 3 }
  833. }
  834. if {$scaling_available} {
  835. lappend items { textexpr "Scanline: $scanline%"
  836. actions { LEFT { osd_menu::menu_setting [incr scanline -1] }
  837. RIGHT { osd_menu::menu_setting [incr scanline 1] }}}
  838. lappend items { textexpr "Blur: $blur%"
  839. actions { LEFT { osd_menu::menu_setting [incr blur -1] }
  840. RIGHT { osd_menu::menu_setting [incr blur 1] }}}
  841. }
  842. if {$::renderer eq "SDLGL-PP"} {
  843. lappend items { textexpr "Glow: $glow%"
  844. actions { LEFT { osd_menu::menu_setting [incr glow -1] }
  845. RIGHT { osd_menu::menu_setting [incr glow 1] }}}
  846. lappend items { textexpr "Display Deform: $display_deform"
  847. actions { LEFT { osd_menu::menu_setting [cycle_back display_deform] }
  848. RIGHT { osd_menu::menu_setting [cycle display_deform] }}}
  849. }
  850. lappend items { textexpr "Noise: $noise%"
  851. actions { LEFT { osd_menu::menu_setting [set noise [expr $noise - 1]] }
  852. RIGHT { osd_menu::menu_setting [set noise [expr $noise + 1]] }}
  853. post-spacing 3}
  854. lappend items { textexpr "Enforce VDP Sprites-per-line Limit: [osd_menu::boolean_to_text $limitsprites]"
  855. actions { LEFT { osd_menu::menu_setting [cycle_back limitsprites] }
  856. RIGHT { osd_menu::menu_setting [cycle limitsprites] }}}
  857. dict set menu_def items $items
  858. return $menu_def
  859. }
  860. proc create_hardware_menu {} {
  861. set menu_def {
  862. font-size 8
  863. border-size 2
  864. width 175
  865. xpos 100
  866. ypos 120
  867. }
  868. lappend items { text "Hardware"
  869. font-size 10
  870. post-spacing 6
  871. selectable false }
  872. lappend items { text "Change Machine..."
  873. actions { A { osd_menu::menu_create [osd_menu::menu_create_load_machine_list]; catch { osd_menu::select_menu_item [machine_info config_name]} }}}
  874. lappend items { text "Set Current Machine as Default"
  875. actions { A { set ::default_machine [machine_info config_name]; osd_menu::menu_close_top }}}
  876. lappend items { text "Extensions..."
  877. actions { A { osd_menu::menu_create $osd_menu::extensions_menu }}}
  878. lappend items { text "Connectors..."
  879. actions { A { osd_menu::menu_create [osd_menu::menu_create_connectors_list] }}}
  880. if {![catch {openmsx_info setting firmwareswitch}]} {
  881. lappend items { textexpr "Firmware switch: [osd_menu::boolean_to_text $::firmwareswitch]"
  882. actions { LEFT { osd_menu::menu_setting [cycle_back firmwareswitch] }
  883. RIGHT { osd_menu::menu_setting [cycle firmwareswitch] }}}
  884. }
  885. dict set menu_def items $items
  886. return $menu_def
  887. }
  888. set extensions_menu {
  889. font-size 8
  890. border-size 2
  891. width 175
  892. xpos 100
  893. ypos 120
  894. items {{ text "Extensions"
  895. font-size 10
  896. post-spacing 6
  897. selectable false }
  898. { text "Add..."
  899. actions { A { osd_menu::menu_create [osd_menu::menu_create_extensions_list] }}}
  900. { text "Remove..."
  901. actions { A { osd_menu::menu_create [osd_menu::menu_create_plugged_extensions_list] }}}}}
  902. set advanced_menu {
  903. font-size 8
  904. border-size 2
  905. width 175
  906. xpos 100
  907. ypos 120
  908. items {{ text "Advanced"
  909. font-size 10
  910. post-spacing 6
  911. selectable false }
  912. { text "Manage Running Machines..."
  913. actions { A { osd_menu::menu_create $osd_menu::running_machines_menu }}}
  914. { text "Toys and Utilities..."
  915. actions { A { osd_menu::menu_create [osd_menu::menu_create_toys_list] }}}}}
  916. set running_machines_menu {
  917. font-size 8
  918. border-size 2
  919. width 175
  920. xpos 100
  921. ypos 120
  922. items {{ text "Manage Running Machines"
  923. font-size 10
  924. post-spacing 6
  925. selectable false }
  926. { textexpr "Select Running Machine Tab: [utils::get_machine_display_name]"
  927. actions { A { osd_menu::menu_create [osd_menu::menu_create_running_machine_list] }}}
  928. { text "New Running Machine Tab"
  929. actions { A { osd_menu::menu_create [osd_menu::menu_create_load_machine_list "add"] }}}
  930. { text "Close Current Machine Tab"
  931. actions { A { set old_active_machine [activate_machine]; cycle_machine; delete_machine $old_active_machine }}}}}
  932. proc menu_create_running_machine_list {} {
  933. set menu_def {
  934. execute menu_machine_tab_select_exec
  935. font-size 8
  936. border-size 2
  937. width 200
  938. xpos 110
  939. ypos 130
  940. header { text "Select Running Machine"
  941. font-size 10
  942. post-spacing 6 }}
  943. set items [utils::get_ordered_machine_list]
  944. set presentation [list]
  945. foreach i $items {
  946. if {[activate_machine] eq $i} {
  947. set postfix_text "current"
  948. } else {
  949. set postfix_text [utils::get_machine_time $i]
  950. }
  951. lappend presentation [format "%s (%s)" [utils::get_machine_display_name ${i}] $postfix_text]
  952. }
  953. lappend menu_def presentation $presentation
  954. return [prepare_menu_list $items 5 $menu_def]
  955. }
  956. proc menu_machine_tab_select_exec {item} {
  957. menu_close_top
  958. activate_machine $item
  959. }
  960. proc get_resampler_presentation { value } {
  961. if {[dict exists $osd_menu::resampler_desc $value]} {
  962. return [dict get $osd_menu::resampler_desc $value]
  963. } else {
  964. return $value
  965. }
  966. }
  967. proc get_horizontal_stretch_presentation { value } {
  968. if {[dict exists $osd_menu::horizontal_stretch_desc $value]} {
  969. return [dict get $osd_menu::horizontal_stretch_desc $value]
  970. } else {
  971. return "custom: $::horizontal_stretch"
  972. }
  973. }
  974. proc menu_create_stretch_list {} {
  975. set menu_def [list \
  976. execute menu_stretch_exec \
  977. font-size 8 \
  978. border-size 2 \
  979. width 150 \
  980. xpos 110 \
  981. ypos 130 \
  982. header { text "Select Horizontal Stretch:"
  983. font-size 10
  984. post-spacing 6 }]
  985. set items [list]
  986. set presentation [list]
  987. set values [dict keys $osd_menu::horizontal_stretch_desc]
  988. if {$::horizontal_stretch ni $values} {
  989. lappend values $::horizontal_stretch
  990. }
  991. foreach value $values {
  992. lappend items $value
  993. lappend presentation [osd_menu::get_horizontal_stretch_presentation $value]
  994. }
  995. lappend menu_def presentation $presentation
  996. return [prepare_menu_list $items 6 $menu_def]
  997. }
  998. proc menu_stretch_exec {value} {
  999. set ::horizontal_stretch $value
  1000. menu_close_top
  1001. menu_refresh_top
  1002. }
  1003. # Returns list of machines/extensions, but try to filter out duplicates caused
  1004. # by symlinks (e.g. turbor.xml -> Panasonic_FS-A1GT.xml). What this does not
  1005. # catch is a symlink in the systemdir (so link also pointing to the systemdir)
  1006. # and a similarly named file in the userdir. This situation does occur on my
  1007. # development setup, but it shouldn't happen for regular users.
  1008. proc get_filtered_configs {type} {
  1009. set result [list]
  1010. set configs [list]
  1011. foreach t [openmsx_info $type] {
  1012. # try both <name>.xml and <name>/hardwareconfig.xml
  1013. set conf [data_file $type/$t.xml]
  1014. if {![file exists $conf]} {
  1015. set conf [data_file $type/$t/hardwareconfig.xml]
  1016. }
  1017. # follow symlink (on platforms that support links)
  1018. catch {
  1019. set conf [file join [file dirname $conf] [file readlink $conf]]
  1020. }
  1021. # only add if the (possibly resolved link) hasn't been seen before
  1022. if {$conf ni $configs} {
  1023. lappend configs $conf
  1024. lappend result $t
  1025. }
  1026. }
  1027. return $result
  1028. }
  1029. proc menu_create_load_machine_list {{mode "replace"}} {
  1030. if {$mode eq "replace"} {
  1031. set proc_to_exec osd_menu::menu_load_machine_exec_replace
  1032. } elseif {$mode eq "add"} {
  1033. set proc_to_exec osd_menu::menu_load_machine_exec_add
  1034. } else {
  1035. error "Undefined mode: $mode"
  1036. }
  1037. set menu_def [list \
  1038. execute $proc_to_exec \
  1039. font-size 8 \
  1040. border-size 2 \
  1041. width 200 \
  1042. xpos 110 \
  1043. ypos 130 \
  1044. header { text "Select Machine to Run"
  1045. font-size 10
  1046. post-spacing 6 }]
  1047. set items [get_filtered_configs machines]
  1048. foreach i $items {
  1049. set extra_info ""
  1050. if {$i eq $::default_machine} {
  1051. set extra_info " (default)"
  1052. }
  1053. lappend presentation "[utils::get_machine_display_name_by_config_name $i]$extra_info"
  1054. }
  1055. set items_sorted [list]
  1056. set presentation_sorted [list]
  1057. foreach i [lsort -dictionary -indices $presentation] {
  1058. lappend presentation_sorted [lindex $presentation $i]
  1059. lappend items_sorted [lindex $items $i]
  1060. }
  1061. lappend menu_def presentation $presentation_sorted
  1062. return [prepare_menu_list $items_sorted 10 $menu_def]
  1063. }
  1064. proc menu_load_machine_exec_replace {item} {
  1065. if {[catch {machine $item} errorText]} {
  1066. osd::display_message $errorText error
  1067. } else {
  1068. menu_close_all
  1069. }
  1070. }
  1071. proc menu_load_machine_exec_add {item} {
  1072. set id [create_machine]
  1073. set err [catch {${id}::load_machine $item} error_result]
  1074. if {$err} {
  1075. delete_machine $id
  1076. osd::display_message "Error starting [utils::get_machine_display_name_by_config_name $item]: $error_result" error
  1077. } else {
  1078. menu_close_top
  1079. activate_machine $id
  1080. }
  1081. }
  1082. proc menu_create_extensions_list {} {
  1083. set menu_def {
  1084. execute menu_add_extension_exec
  1085. font-size 8
  1086. border-size 2
  1087. width 200
  1088. xpos 110
  1089. ypos 130
  1090. header { text "Select Extension to Add"
  1091. font-size 10
  1092. post-spacing 6 }}
  1093. set items [get_filtered_configs extensions]
  1094. set presentation [list]
  1095. foreach i $items {
  1096. lappend presentation [utils::get_extension_display_name_by_config_name $i]
  1097. }
  1098. set items_sorted [list]
  1099. set presentation_sorted [list]
  1100. foreach i [lsort -dictionary -indices $presentation] {
  1101. lappend presentation_sorted [lindex $presentation $i]
  1102. lappend items_sorted [lindex $items $i]
  1103. }
  1104. lappend menu_def presentation $presentation_sorted
  1105. return [prepare_menu_list $items_sorted 10 $menu_def]
  1106. }
  1107. proc menu_add_extension_exec {item} {
  1108. if {[catch {ext $item} errorText]} {
  1109. osd::display_message $errorText error
  1110. } else {
  1111. menu_close_all
  1112. }
  1113. }
  1114. proc menu_create_plugged_extensions_list {} {
  1115. set menu_def {
  1116. execute menu_remove_extension_exec
  1117. font-size 8
  1118. border-size 2
  1119. width 200
  1120. xpos 110
  1121. ypos 130
  1122. header { text "Select Extension to Remove"
  1123. font-size 10
  1124. post-spacing 6 }}
  1125. set items [list_extensions]
  1126. set possible_items [get_filtered_configs extensions]
  1127. set useful_items [list]
  1128. foreach item $items {
  1129. if {$item in $possible_items} {
  1130. lappend useful_items $item
  1131. }
  1132. }
  1133. set presentation [list]
  1134. foreach i $useful_items {
  1135. lappend presentation [utils::get_extension_display_name_by_config_name ${i}]
  1136. }
  1137. lappend menu_def presentation $presentation
  1138. return [prepare_menu_list $useful_items 10 $menu_def]
  1139. }
  1140. proc menu_remove_extension_exec {item} {
  1141. menu_close_all
  1142. remove_extension $item
  1143. }
  1144. proc menu_create_connectors_list {} {
  1145. set menu_def {
  1146. execute menu_connector_exec
  1147. font-size 8
  1148. border-size 2
  1149. width 200
  1150. xpos 100
  1151. ypos 120
  1152. header { text "Connectors"
  1153. font-size 10
  1154. post-spacing 6 }}
  1155. set items [machine_info connector]
  1156. set presentation [list]
  1157. foreach item $items {
  1158. set plugged [get_pluggable_for_connector $item]
  1159. set plugged_presentation ""
  1160. if {$plugged ne ""} {
  1161. set plugged_presentation " ([machine_info pluggable $plugged])"
  1162. }
  1163. lappend presentation "[machine_info connector $item]: $plugged$plugged_presentation"
  1164. }
  1165. lappend menu_def presentation $presentation
  1166. return [prepare_menu_list $items 5 $menu_def]
  1167. }
  1168. proc menu_connector_exec {item} {
  1169. menu_create [create_menu_pluggable_list $item]
  1170. select_menu_item [get_pluggable_for_connector $item]
  1171. }
  1172. proc create_menu_pluggable_list {connector} {
  1173. set menu_def [list \
  1174. execute [list menu_plug_exec $connector] \
  1175. font-size 8 \
  1176. border-size 2 \
  1177. width 200 \
  1178. xpos 110 \
  1179. ypos 140 \
  1180. header [list text "What to Plug into [machine_info connector $connector]?" \
  1181. font-size 10 \
  1182. post-spacing 6 ]]
  1183. set items [list]
  1184. set class [machine_info connectionclass $connector]
  1185. # find out which pluggables are already plugged
  1186. # (currently a pluggable can be used only once per machine)
  1187. set already_plugged [list]
  1188. foreach other_connector [machine_info connector] {
  1189. set other_plugged [get_pluggable_for_connector $other_connector]
  1190. if {$other_plugged ne "" && $other_connector ne $connector} {
  1191. lappend already_plugged $other_plugged
  1192. }
  1193. }
  1194. # get a list of all pluggables that fit this connector
  1195. # and which are not plugged yet in other connectors
  1196. foreach pluggable [machine_info pluggable] {
  1197. if {$pluggable ni $already_plugged && [machine_info connectionclass $pluggable] eq $class} {
  1198. lappend items $pluggable
  1199. }
  1200. }
  1201. set presentation [list]
  1202. foreach item $items {
  1203. lappend presentation "$item: [machine_info pluggable $item]"
  1204. }
  1205. set plugged [get_pluggable_for_connector $connector]
  1206. if {$plugged ne ""} {
  1207. set items [linsert $items 0 "--unplug--"]
  1208. set presentation [linsert $presentation 0 "Nothing, unplug $plugged ([machine_info pluggable $plugged])"]
  1209. }
  1210. lappend menu_def presentation $presentation
  1211. return [prepare_menu_list $items 5 $menu_def]
  1212. }
  1213. proc menu_plug_exec {connector pluggable} {
  1214. set command ""
  1215. if {$pluggable eq "--unplug--"} {
  1216. set command "unplug {$connector}"
  1217. } else {
  1218. set command "plug {$connector} {$pluggable}"
  1219. }
  1220. #note: NO braces around $command
  1221. if {[catch $command errorText]} {
  1222. osd::display_message $errorText error
  1223. } else {
  1224. menu_close_top
  1225. # refresh the connectors menu
  1226. # The list must be recreated, so menu_refresh_top won't work
  1227. menu_close_top
  1228. menu_create [menu_create_connectors_list]
  1229. }
  1230. }
  1231. proc menu_create_toys_list {} {
  1232. set menu_def {
  1233. execute menu_toys_exec
  1234. font-size 8
  1235. border-size 2
  1236. width 200
  1237. xpos 100
  1238. ypos 120
  1239. header { text "Toys and Utilities"
  1240. font-size 10
  1241. post-spacing 6 }}
  1242. set items [list]
  1243. set presentation [list]
  1244. # This also picks up 'lazy' command names
  1245. foreach cmd [openmsx::all_command_names] {
  1246. if {[string match toggle_* $cmd]} {
  1247. lappend items $cmd
  1248. lappend presentation [string map {_ " "} [string range $cmd 7 end]]
  1249. }
  1250. }
  1251. lappend menu_def presentation $presentation
  1252. return [prepare_menu_list $items 5 $menu_def]
  1253. }
  1254. proc menu_toys_exec {toy} {
  1255. return [$toy]
  1256. }
  1257. proc ls {directory extensions} {
  1258. set dirs [list]
  1259. set specialdir [list]
  1260. set items [list]
  1261. if {[catch {
  1262. set files [glob -nocomplain -tails -directory $directory -types {f r} *]
  1263. set items [lsearch -regexp -all -inline -nocase $files .*\\.($extensions)]
  1264. set dirs [glob -nocomplain -tails -directory $directory -types {d r x} *]
  1265. set specialdir [glob -nocomplain -tails -directory $directory -types {hidden d} ".openMSX"]
  1266. } errorText]} {
  1267. osd::display_message "Unable to read dir $directory: $errorText" error
  1268. }
  1269. set dirs2 [list]
  1270. foreach dir [concat $dirs $specialdir] {
  1271. lappend dirs2 "$dir/"
  1272. }
  1273. set extra_entries [list]
  1274. set volumes [file volumes]
  1275. if {$directory ni $volumes} {
  1276. # check whether .. is readable (it's not always so on Android)
  1277. if {[file readable [file join $directory ..]]} {
  1278. lappend extra_entries ".."
  1279. }
  1280. } else {
  1281. if {[llength $volumes] > 1} {
  1282. set extra_entries $volumes
  1283. }
  1284. }
  1285. return [concat [lsort $extra_entries] [lsort $dirs2] [lsort $items]]
  1286. }
  1287. proc is_empty_dir {directory extensions} {
  1288. set files [list]
  1289. catch {set files [glob -nocomplain -tails -directory $directory -types {f r} *]}
  1290. set items [lsearch -regexp -all -inline -nocase $files .*\\.($extensions)]
  1291. if {[llength $items] != 0} {return false}
  1292. set dirs [list]
  1293. catch {set dirs [glob -nocomplain -tails -directory $directory -types {d r x} *]}
  1294. if {[llength $dirs] != 0} {return false}
  1295. set specialdir [list]
  1296. catch {set specialdir [glob -nocomplain -tails -directory $directory -types {hidden d} ".openMSX"]}
  1297. if {[llength $specialdir] != 0} {return false}
  1298. return true
  1299. }
  1300. proc menu_create_rom_list {path slot} {
  1301. set menu_def [list execute [list menu_select_rom $slot] \
  1302. font-size 8 \
  1303. border-size 2 \
  1304. width 200 \
  1305. xpos 100 \
  1306. ypos 120 \
  1307. header { textexpr "ROMs $::osd_rom_path" \
  1308. font-size 10 \
  1309. post-spacing 6 }]
  1310. set extensions "rom|ri|mx1|mx2|zip|gz"
  1311. set items [list]
  1312. set presentation [list]
  1313. if {[lindex [$slot] 2] ne "empty"} {
  1314. lappend items "--eject--"
  1315. lappend presentation "--eject-- [file tail [lindex [$slot] 1]]"
  1316. }
  1317. set i 1
  1318. foreach pool_path [filepool::get_paths_for_type rom] {
  1319. if {$path ne $pool_path && [file exists $pool_path] &&
  1320. ![is_empty_dir $pool_path $extensions]} {
  1321. lappend items $pool_path
  1322. lappend presentation "\[ROM Pool $i\]"
  1323. }
  1324. incr i
  1325. }
  1326. set files [ls $path $extensions]
  1327. set items [concat $items $files]
  1328. set presentation [concat $presentation $files]
  1329. lappend menu_def presentation $presentation
  1330. return [prepare_menu_list $items 10 $menu_def]
  1331. }
  1332. proc menu_select_rom {slot item {open_main false}} {
  1333. if {$item eq "--eject--"} {
  1334. menu_close_all
  1335. $slot eject
  1336. reset
  1337. } else {
  1338. set fullname [file join $::osd_rom_path $item]
  1339. if {[file isdirectory $fullname]} {
  1340. menu_close_top
  1341. set ::osd_rom_path [file normalize $fullname]
  1342. menu_create [menu_create_rom_list $::osd_rom_path $slot]
  1343. } else {
  1344. set mappertype ""
  1345. set hash [sha1sum $fullname]
  1346. if {[catch {set mappertype [dict get [openmsx_info software $hash] mapper_type_name]}]} {
  1347. # not in the database, execute after selecting mapper type
  1348. set menu_proc menu_create
  1349. if {$open_main} { set menu_proc do_menu_open }
  1350. ${menu_proc} [menu_create_mappertype_list $slot $fullname]
  1351. } else {
  1352. # in the database, so just execute
  1353. menu_rom_with_mappertype_exec $slot $fullname $mappertype
  1354. }
  1355. }
  1356. }
  1357. }
  1358. proc menu_rom_with_mappertype_exec {slot fullname mappertype} {
  1359. if {[catch {$slot $fullname -romtype $mappertype} errorText]} {
  1360. osd::display_message "Can't insert ROM: $errorText" error
  1361. } else {
  1362. menu_close_all
  1363. set rominfo [getlist_rom_info]
  1364. set message1 "Now running ROM"
  1365. set message2 " \n"
  1366. dict with rominfo {
  1367. if {$slotname ne "" && $slot ne ""} {
  1368. append message1 " in cartridge slot $slotname (slot $slot)"
  1369. }
  1370. append message1 ":\n"
  1371. if {$title ne ""} {
  1372. append message1 "Title:\n"
  1373. append message2 "$title\n"
  1374. } elseif {$filename ne ""} {
  1375. append message1 "File:\n"
  1376. append message2 "$filename\n"
  1377. }
  1378. if {$year ne ""} {
  1379. append message1 "Year:\n"
  1380. append message2 "$year\n"
  1381. }
  1382. if {$company ne ""} {
  1383. append message1 "Company:\n"
  1384. append message2 "$company\n"
  1385. }
  1386. if {$country ne ""} {
  1387. append message1 "Country:\n"
  1388. append message2 "$country\n"
  1389. }
  1390. if {$status ne ""} {
  1391. append message1 "Status:\n"
  1392. append message2 "$status\n"
  1393. }
  1394. if {$remark ne ""} {
  1395. append message1 "Remark:\n"
  1396. append message2 "$remark\n"
  1397. }
  1398. if {$mappertype ne ""} {
  1399. append message1 "Mapper:\n"
  1400. append message2 "$mappertype\n"
  1401. }
  1402. }
  1403. osd::display_message $message1
  1404. set txt_size 6
  1405. set xpos 35
  1406. # TODO: prevent this from being duplicated from osd_widgets::text_box
  1407. if {$::scale_factor == 1} {
  1408. set txt_size 9
  1409. set xpos 53
  1410. }
  1411. # TODO: this code knows the internal name of the widget of osd::display_message proc... it shouldn't need to.
  1412. osd create text osd_display_message.rominfo_text -x $xpos -y 2 -size $txt_size -rgba 0xffffffff -text "$message2"
  1413. reset
  1414. }
  1415. }
  1416. proc menu_create_mappertype_list {slot fullname} {
  1417. set menu_def [list execute [list menu_rom_with_mappertype_exec $slot $fullname] \
  1418. font-size 8 \
  1419. border-size 2 \
  1420. width 200 \
  1421. xpos 100 \
  1422. ypos 120 \
  1423. header { text "Select mapper type" \
  1424. font-size 10 \
  1425. post-spacing 6 }]
  1426. set items [openmsx_info romtype]
  1427. set presentation [list]
  1428. foreach i $items {
  1429. lappend presentation "[dict get [openmsx_info romtype $i] description]"
  1430. }
  1431. set items_sorted [list "auto"]
  1432. set presentation_sorted [list "Auto-detect (guess)"]
  1433. foreach i [lsort -dictionary -indices $presentation] {
  1434. lappend presentation_sorted [lindex $presentation $i]
  1435. lappend items_sorted [lindex $items $i]
  1436. }
  1437. lappend menu_def presentation $presentation_sorted
  1438. return [prepare_menu_list $items_sorted 10 $menu_def]
  1439. }
  1440. proc menu_create_disk_list {path drive} {
  1441. set menu_def [list execute [list menu_select_disk $drive] \
  1442. font-size 8 \
  1443. border-size 2 \
  1444. width 200 \
  1445. xpos 100 \
  1446. ypos 120 \
  1447. header { textexpr "Disks $::osd_disk_path" \
  1448. font-size 10 \
  1449. post-spacing 6 }]
  1450. set cur_image [lindex [$drive] 1]
  1451. set extensions "dsk|zip|gz|xsa|dmk|di1|di2|fd?|1|2|3|4|5|6|7|8|9"
  1452. set items [list]
  1453. set presentation [list]
  1454. if {[lindex [$drive] 2] ne "empty readonly"} {
  1455. lappend items "--eject--"
  1456. lappend presentation "--eject-- [file tail $cur_image]"
  1457. }
  1458. set i 1
  1459. foreach pool_path [filepool::get_paths_for_type disk] {
  1460. if {$path ne $pool_path && [file exists $pool_path] &&
  1461. ![is_empty_dir $pool_path $extensions]} {
  1462. lappend items $pool_path
  1463. lappend presentation "\[Disk Pool $i\]"
  1464. }
  1465. incr i
  1466. }
  1467. if {$cur_image ne $path} {
  1468. lappend items "."
  1469. lappend presentation "--insert this dir as disk--"
  1470. }
  1471. set files [ls $path $extensions]
  1472. set items [concat $items $files]
  1473. set presentation [concat $presentation $files]
  1474. lappend menu_def presentation $presentation
  1475. return [prepare_menu_list $items 10 $menu_def]
  1476. }
  1477. proc menu_select_disk {drive item {dummy false}} {
  1478. if {$item eq "--eject--"} {
  1479. set cur_image [lindex [$drive] 1]
  1480. menu_close_all
  1481. $drive eject
  1482. osd::display_message "Disk $cur_image ejected from drive [get_slot_str $drive]!"
  1483. } else {
  1484. # if the item is already a directory, it's an absolute path, use that as fullname
  1485. if {[file isdirectory $item] && $item ne "." && $item ne ".." && $item ni [file volumes]} {
  1486. set fullname $item
  1487. set abspath true
  1488. } else {
  1489. set fullname [file normalize [file join $::osd_disk_path $item]]
  1490. set abspath false
  1491. }
  1492. if {[file isdirectory $fullname] && $item ne "." && !$abspath} {
  1493. menu_close_top
  1494. set ::osd_disk_path [file normalize $fullname]
  1495. menu_create [menu_create_disk_list $::osd_disk_path $drive]
  1496. } else {
  1497. if {[catch {$drive $fullname} errorText]} {
  1498. osd::display_message "Can't insert disk: $errorText" error
  1499. } else {
  1500. menu_close_all
  1501. if {$item eq "."} { set item $fullname }
  1502. osd::display_message "Disk $item inserted in drive [get_slot_str $drive]!"
  1503. }
  1504. }
  1505. }
  1506. }
  1507. proc menu_create_tape_list {path} {
  1508. variable taperecordings_directory
  1509. set menu_def { execute menu_select_tape
  1510. font-size 8
  1511. border-size 2
  1512. width 200
  1513. xpos 100
  1514. ypos 120
  1515. header { textexpr "Tapes $::osd_tape_path"
  1516. font-size 10
  1517. post-spacing 6 }}
  1518. set extensions "cas|wav|zip|gz"
  1519. set items [list]
  1520. set presentation [list]
  1521. lappend items "--create--"
  1522. lappend presentation "--create new and insert--"
  1523. set inserted [lindex [cassetteplayer] 1]
  1524. if {$inserted ne ""} {
  1525. lappend items "--eject--"
  1526. lappend presentation "--eject-- [file tail $inserted]"
  1527. lappend items "--rewind--"
  1528. lappend presentation "--rewind-- [file tail $inserted]"
  1529. }
  1530. if {$path ne $taperecordings_directory && [file exists $taperecordings_directory]} {
  1531. lappend items $taperecordings_directory
  1532. lappend presentation "\[My Tape Recordings\]"
  1533. }
  1534. set i 1
  1535. foreach pool_path [filepool::get_paths_for_type tape] {
  1536. if {$path ne $pool_path && [file exists $pool_path] &&
  1537. ![is_empty_dir $pool_path $extensions]} {
  1538. lappend items $pool_path
  1539. lappend presentation "\[Tape Pool $i\]"
  1540. }
  1541. incr i
  1542. }
  1543. set files [ls $path $extensions]
  1544. set items [concat $items $files]
  1545. set presentation [concat $presentation $files]
  1546. lappend menu_def presentation $presentation
  1547. return [prepare_menu_list $items 10 $menu_def]
  1548. }
  1549. proc menu_select_tape {item} {
  1550. variable taperecordings_directory
  1551. if {$item eq "--create--"} {
  1552. menu_close_all
  1553. osd::display_message [cassetteplayer new [menu_free_tape_name]]
  1554. } elseif {$item eq "--eject--"} {
  1555. menu_close_all
  1556. osd::display_message [cassetteplayer eject]
  1557. } elseif {$item eq "--rewind--"} {
  1558. menu_close_all
  1559. osd::display_message [cassetteplayer rewind]
  1560. } else {
  1561. set fullname [file join $::osd_tape_path $item]
  1562. if {[file isdirectory $fullname]} {
  1563. menu_close_top
  1564. set ::osd_tape_path [file normalize $fullname]
  1565. menu_create [menu_create_tape_list $::osd_tape_path]
  1566. } else {
  1567. if {[catch {cassetteplayer $fullname} errorText]} {
  1568. osd::display_message "Can't set tape: $errorText" error
  1569. } else {
  1570. osd::display_message "Inserted tape $item!"
  1571. menu_close_all
  1572. }
  1573. }
  1574. }
  1575. }
  1576. proc menu_free_tape_name {} {
  1577. variable taperecordings_directory
  1578. set existing [list]
  1579. foreach f [lsort [glob -tails -directory $taperecordings_directory -type f -nocomplain *.wav]] {
  1580. lappend existing [file rootname $f]
  1581. }
  1582. set i 1
  1583. while 1 {
  1584. set name [format "[guess_title untitled] %04d" $i]
  1585. if {$name ni $existing} {
  1586. return $name
  1587. }
  1588. incr i
  1589. }
  1590. }
  1591. proc menu_create_hdd_list {path drive} {
  1592. return [prepare_menu_list [ls $path "dsk|zip|gz|hdd"] \
  1593. 10 \
  1594. [list execute [list menu_select_hdd $drive]\
  1595. font-size 8 \
  1596. border-size 2 \
  1597. width 200 \
  1598. xpos 100 \
  1599. ypos 120 \
  1600. header { textexpr "Hard disk images $::osd_hdd_path"
  1601. font-size 10
  1602. post-spacing 6 }]]
  1603. }
  1604. proc menu_select_hdd {drive item} {
  1605. set fullname [file join $::osd_hdd_path $item]
  1606. if {[file isdirectory $fullname]} {
  1607. menu_close_top
  1608. set ::osd_hdd_path [file normalize $fullname]
  1609. menu_create [menu_create_hdd_list $::osd_hdd_path $drive]
  1610. } else {
  1611. confirm_action "Really power off to change HDD image?" osd_menu::confirm_change_hdd [list $item $drive]
  1612. }
  1613. }
  1614. proc confirm_change_hdd {item result} {
  1615. menu_close_top
  1616. if {$result eq "Yes"} {
  1617. set fullname [file join $::osd_hdd_path [lindex $item 0]]
  1618. if {[catch {set ::power off; [lindex $item 1] $fullname} errorText]} {
  1619. osd::display_message "Can't change hard disk image: $errorText" error
  1620. # TODO: we already powered off even though the file may be invalid... save state first?
  1621. } else {
  1622. osd::display_message "Changed hard disk image to [lindex $item 0]!"
  1623. menu_close_all
  1624. }
  1625. set ::power on
  1626. }
  1627. }
  1628. proc menu_create_ld_list {path} {
  1629. set menu_def [list execute menu_select_ld \
  1630. font-size 8 \
  1631. border-size 2 \
  1632. width 200 \
  1633. xpos 100 \
  1634. ypos 120 \
  1635. header { textexpr "LaserDiscs $::osd_ld_path" \
  1636. font-size 10 \
  1637. post-spacing 6 }]
  1638. set cur_image [lindex [laserdiscplayer] 1]
  1639. set extensions "ogv"
  1640. set items [list]
  1641. set presentation [list]
  1642. if {$cur_image ne ""} {
  1643. lappend items "--eject--"
  1644. lappend presentation "--eject-- [file tail $cur_image]"
  1645. }
  1646. set files [ls $path $extensions]
  1647. set items [concat $items $files]
  1648. set presentation [concat $presentation $files]
  1649. lappend menu_def presentation $presentation
  1650. return [prepare_menu_list $items 10 $menu_def]
  1651. }
  1652. proc menu_select_ld {item} {
  1653. if {$item eq "--eject--"} {
  1654. menu_close_all
  1655. osd::display_message [laserdiscplayer eject]
  1656. set cur_image [lindex [laserdiscplayer] 1]
  1657. osd::display_message "LaserDisc $cur_image ejected!"
  1658. } else {
  1659. set fullname [file join $::osd_ld_path $item]
  1660. if {[file isdirectory $fullname]} {
  1661. menu_close_top
  1662. set ::osd_ld_path [file normalize $fullname]
  1663. menu_create [menu_create_ld_list $::osd_ld_path]
  1664. } else {
  1665. if {[catch {laserdiscplayer insert $fullname} errorText]} {
  1666. osd::display_message "Can't load LaserDisc: $errorText" error
  1667. } else {
  1668. osd::display_message "Loaded LaserDisc $item!"
  1669. menu_close_all
  1670. }
  1671. }
  1672. }
  1673. }
  1674. proc get_savestates_list_presentation_sorted {} {
  1675. set presentation [list]
  1676. foreach i [lsort -integer -index 1 -decreasing [savestate::list_savestates_raw]] {
  1677. set pres_str [lindex $i 0]
  1678. lappend presentation $pres_str
  1679. }
  1680. return $presentation
  1681. }
  1682. proc menu_create_load_state {} {
  1683. set menu_def \
  1684. { execute menu_loadstate_exec
  1685. font-size 8
  1686. border-size 2
  1687. width 200
  1688. xpos 100
  1689. ypos 120
  1690. on-open {osd create rectangle "preview" -x 225 -y 5 -w 90 -h 70 -rgba 0x30303080 -scaled true}
  1691. on-close {osd destroy "preview"}
  1692. on-select menu_loadstate_select
  1693. on-deselect menu_loadstate_deselect
  1694. header { text "Load State"
  1695. font-size 10
  1696. post-spacing 6 }}
  1697. set items [list_savestates -t]
  1698. lappend menu_def presentation [get_savestates_list_presentation_sorted]
  1699. return [prepare_menu_list $items 10 $menu_def]
  1700. }
  1701. proc menu_create_save_state {} {
  1702. set items [concat [list "create new"] [list_savestates -t]]
  1703. set menu_def \
  1704. { execute menu_savestate_exec
  1705. font-size 8
  1706. border-size 2
  1707. width 200
  1708. xpos 100
  1709. ypos 120
  1710. on-open {osd create rectangle "preview" -x 225 -y 5 -w 90 -h 70 -rgba 0x30303080 -scaled true}
  1711. on-close {osd destroy "preview"}
  1712. on-select menu_loadstate_select
  1713. on-deselect menu_loadstate_deselect
  1714. header { text "Save State"
  1715. font-size 10
  1716. post-spacing 6 }}
  1717. lappend menu_def presentation [concat [list "create new"] [get_savestates_list_presentation_sorted]]
  1718. return [prepare_menu_list $items 10 $menu_def]
  1719. }
  1720. proc menu_loadstate_select {item} {
  1721. set png $::env(OPENMSX_USER_DATA)/../savestates/${item}.png
  1722. catch {osd create rectangle "preview.image" -relx 0.05 -rely 0.05 -w 80 -h 60 -image $png}
  1723. }
  1724. proc menu_loadstate_deselect {item} {
  1725. osd destroy "preview.image"
  1726. }
  1727. proc menu_loadstate_exec {item} {
  1728. if {[catch {loadstate $item} errorText]} {
  1729. osd::display_message $errorText error
  1730. } else {
  1731. menu_close_all
  1732. }
  1733. }
  1734. proc menu_savestate_exec {item} {
  1735. if {$item eq "create new"} {
  1736. set item [menu_free_savestate_name]
  1737. confirm_save_state $item "Yes"
  1738. menu_close_all
  1739. } else {
  1740. confirm_action "Overwrite $item?" osd_menu::confirm_save_state $item
  1741. }
  1742. }
  1743. proc confirm_save_state {item result} {
  1744. menu_close_top
  1745. if {$result eq "Yes"} {
  1746. if {[catch {savestate $item} errorText]} {
  1747. osd::display_message $errorText error
  1748. } else {
  1749. osd::display_message "State saved to $item!"
  1750. menu_close_all
  1751. }
  1752. }
  1753. }
  1754. proc menu_free_savestate_name {} {
  1755. set existing [list_savestates]
  1756. set i 1
  1757. while 1 {
  1758. set name [format "[guess_title savestate] %04d" $i]
  1759. if {$name ni $existing} {
  1760. return $name
  1761. }
  1762. incr i
  1763. }
  1764. }
  1765. proc confirm_action {text action item} {
  1766. set items [list "No" "Yes"]
  1767. set menu_def [list execute [list $action $item] \
  1768. font-size 8 \
  1769. border-size 2 \
  1770. width 210 \
  1771. xpos 100 \
  1772. ypos 100 \
  1773. header [list text $text \
  1774. font-size 10 \
  1775. post-spacing 6 ]]
  1776. osd_menu::menu_create [osd_menu::prepare_menu_list $items [llength $items] $menu_def]
  1777. }
  1778. proc menu_loadreplay_exec {item} {
  1779. if {[catch {reverse loadreplay $item} errorText]} {
  1780. osd::display_message $errorText error
  1781. } else {
  1782. menu_close_all
  1783. }
  1784. }
  1785. proc menu_loadscript_exec {item} {
  1786. if {[catch {source $item} errorText]} {
  1787. osd::display_message $errorText error
  1788. }
  1789. }
  1790. proc create_slot_actions_to_put_stuff_in_slot {slot path listtype} {
  1791. return [list actions [list A [list osd_menu::menu_select_$listtype $slot $path]]]
  1792. }
  1793. proc drop_handler { event } {
  1794. variable mediaslot_info
  1795. lassign $event type filename
  1796. set category [openmsx_info file_type_category $filename]
  1797. set isdir [file isdirectory $filename]
  1798. if {$category eq "unknown" && $isdir} {
  1799. set category "disk"
  1800. }
  1801. set filetext "file"
  1802. if {$isdir} {
  1803. set filetext "folder"
  1804. }
  1805. if {$category eq "disk" || $category eq "rom"} {
  1806. set longmediaslotname [dict get $mediaslot_info $category longmediaslotname]
  1807. set listtype [dict get $mediaslot_info $category listtype]
  1808. set mediabasecommand [dict get $mediaslot_info $category mediabasecommand]
  1809. set slots [lsort [info command ${mediabasecommand}?]]
  1810. if {[llength $slots] == 0} {
  1811. osd::display_message "Can't handle dropped $filetext $filename, no $longmediaslotname present." error
  1812. } elseif {[llength $slots] > 1} {
  1813. set path $filename
  1814. set menutitle "Select ${longmediaslotname}"
  1815. set create_action_proc "create_slot_actions_to_put_stuff_in_slot"
  1816. osd_menu::do_menu_open [create_slot_menu_def $slots $path $listtype $menutitle $create_action_proc]
  1817. } else {
  1818. osd_menu::menu_select_$listtype "${mediabasecommand}a" $filename true
  1819. }
  1820. } elseif {$category eq "laserdisc"} {
  1821. if {[info command laserdiscplayer] ne ""} {; # only exists on some Pioneers
  1822. osd_menu::menu_select_ld $filename
  1823. } else {
  1824. osd::display_message "Can't handle dropped $filetext $filename, no laser disc player present." error
  1825. }
  1826. } elseif {$category eq "cassette"} {
  1827. if {[catch "machine_info connector cassetteport"]} {; # example: turboR
  1828. osd::display_message "Can't handle dropped $filetext $filename, no cassette port present." error
  1829. } else {
  1830. osd_menu::menu_select_tape $filename
  1831. }
  1832. } elseif {$category eq "savestate"} {
  1833. osd_menu::menu_loadstate_exec [file rootname $filename]
  1834. } elseif {$category eq "replay"} {
  1835. osd_menu::menu_loadreplay_exec $filename
  1836. } elseif {$category eq "script"} {
  1837. osd_menu::menu_loadscript_exec $filename
  1838. } else {
  1839. # stuff we can implement outside openMSX
  1840. if {[file extension $filename] eq ".txt"} {
  1841. type_from_file $filename
  1842. } else {
  1843. osd::display_message "Don't know how to handle dropped $filetext $filename..." error
  1844. }
  1845. }
  1846. }
  1847. # Keep openmsx console from interfering with the osd menu:
  1848. # when the console is activated while the osd menu is already open, we want
  1849. # to prevent the osd menu from receiving the keys that are pressed in the
  1850. # console.
  1851. variable old_console $::console
  1852. proc console_input_layer {name1 name1 op} {
  1853. global console
  1854. variable old_console
  1855. if {$console == $old_console} return
  1856. set old_console $console
  1857. if {$console} {
  1858. activate_input_layer console -blocking
  1859. } else {
  1860. deactivate_input_layer console
  1861. }
  1862. }
  1863. trace add variable ::console write [namespace code console_input_layer]
  1864. namespace export main_menu_open
  1865. namespace export main_menu_close
  1866. namespace export main_menu_toggle
  1867. } ;# namespace osd_menu
  1868. namespace import osd_menu::*