bootmenu.4th 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196
  1. \ boot menu
  2. decimal
  3. lcd-cls
  4. \ dos file name <count>8.3
  5. 8 1+ 3 + 1+ constant item-length
  6. 8 constant menu-item-length
  7. 2 constant first-menu-line
  8. lcd-text-columns menu-item-length /mod dup constant items-per-line
  9. 1- / menu-item-length + constant display-item-width
  10. \ 16 line screen = title + blank + 12 items + blank + soft-keys
  11. 12 items-per-line * constant max-items
  12. : menu-data ( u -- )
  13. create
  14. item-length * allot
  15. align
  16. does> ( index -- c-addr )
  17. swap item-length * +
  18. ;
  19. max-items menu-data menu
  20. variable menu-count
  21. : read-items ( -- )
  22. s" /" open-directory ?dup
  23. if cr ." open-directory error = "
  24. dec. drop exit
  25. then
  26. >r \ save dirid
  27. begin
  28. here 256 r@ read-directory ?dup
  29. if cr ." directory read error = "
  30. dec. drop
  31. r> close-directory drop exit
  32. then
  33. dup
  34. while
  35. here swap ( c-addr u )
  36. 2dup s" .4MU" search if
  37. 4 = if
  38. drop
  39. menu-count @
  40. dup max-items <
  41. if
  42. menu \ src count dest
  43. 2dup c! char+ \ save count (byte)
  44. swap cmove
  45. 1 menu-count +!
  46. else
  47. drop
  48. then
  49. else
  50. drop 2drop
  51. then
  52. else
  53. 2drop 2drop
  54. then
  55. repeat
  56. drop
  57. r> close-directory drop
  58. ;
  59. : item-position ( u -- x y )
  60. items-per-line /mod \ col row
  61. >r
  62. display-item-width *
  63. r>
  64. first-menu-line +
  65. ;
  66. : display-item ( u -- )
  67. dup item-position
  68. lcd-at-xy
  69. menu dup char+ swap c@
  70. 4 - \ ignore the .4mu extension
  71. lcd-type
  72. ;
  73. : display-highlighted-item ( u -- )
  74. lcd-white
  75. display-item
  76. lcd-black
  77. ;
  78. : display-items ( -- )
  79. lcd-cls
  80. s" Forth programs" lcd-type
  81. menu-count @ 0
  82. ?do
  83. i display-item
  84. loop
  85. ;
  86. : run-program ( c-addr u -- )
  87. lcd-cls s" Loading: " lcd-type
  88. 2dup lcd-type
  89. included
  90. quit
  91. ;
  92. variable menu-cursor
  93. : boot-menu ( -- )
  94. read-items
  95. display-items
  96. 22 lcd-text-rows 1- lcd-at-xy s" Console" lcd-type
  97. ctp-flush
  98. key-flush
  99. button-flush
  100. -1 menu-cursor !
  101. begin
  102. ctp-pos? if
  103. ctp-char dup 0<
  104. if
  105. 2drop
  106. menu-cursor @ 0< 0= if
  107. menu-cursor @ menu
  108. dup char+ swap c@
  109. ['] run-program catch
  110. cold \ restart menu
  111. then
  112. -1 menu-cursor !
  113. else
  114. menu-cursor @ 0< 0=
  115. if
  116. menu-cursor @ display-item
  117. -1 menu-cursor !
  118. then
  119. first-menu-line - dup 0< 0=
  120. if
  121. items-per-line *
  122. swap
  123. display-item-width /
  124. +
  125. dup menu-count @ <
  126. if
  127. dup menu-cursor !
  128. display-highlighted-item
  129. else
  130. drop
  131. then
  132. else
  133. 2drop
  134. then
  135. then
  136. then
  137. button? if
  138. button
  139. case
  140. button-power of
  141. power-off
  142. endof
  143. button-left of
  144. endof
  145. button-centre of
  146. endof
  147. button-right of
  148. lcd-cls
  149. s" Serial Console Active" lcd-type lcd-cr lcd-cr
  150. s" Connect Debug Cable at:" lcd-type lcd-cr
  151. s" 19200 8N1" lcd-type lcd-cr
  152. cold0 \ does not return
  153. endof
  154. endcase
  155. then
  156. key? if
  157. key-flush
  158. then
  159. wait-for-event
  160. again
  161. ;
  162. \ start menu
  163. boot-menu
  164. \ ensure restart will occur if any program exits
  165. cold
  166. cold
  167. cold
  168. cold
  169. decimal