/sys/boot/forth/frames.4th

https://github.com/FreeBSDonHyper-V/freebsd · Forth · 165 lines · 150 code · 15 blank · 0 comment · 2 complexity · 773239c1ed76051a9a45c4402970d323 MD5 · raw file

  1. \ Copyright (c) 2003 Scott Long <scottl@FreeBSD.org>
  2. \ Copyright (c) 2012-2015 Devin Teske <dteske@FreeBSD.org>
  3. \ All rights reserved.
  4. \
  5. \ Redistribution and use in source and binary forms, with or without
  6. \ modification, are permitted provided that the following conditions
  7. \ are met:
  8. \ 1. Redistributions of source code must retain the above copyright
  9. \ notice, this list of conditions and the following disclaimer.
  10. \ 2. Redistributions in binary form must reproduce the above copyright
  11. \ notice, this list of conditions and the following disclaimer in the
  12. \ documentation and/or other materials provided with the distribution.
  13. \
  14. \ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
  15. \ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  16. \ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  17. \ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
  18. \ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  19. \ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  20. \ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  21. \ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  22. \ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  23. \ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  24. \ SUCH DAMAGE.
  25. \
  26. \ $FreeBSD$
  27. marker task-frames.4th
  28. vocabulary frame-drawing
  29. only forth also frame-drawing definitions
  30. \ XXX Filled boxes are left as an exercise for the reader... ;-/
  31. variable h_el
  32. variable v_el
  33. variable lt_el
  34. variable lb_el
  35. variable rt_el
  36. variable rb_el
  37. variable fill
  38. \ ASCII frames (used when serial console is detected)
  39. 45 constant ascii_dash
  40. 61 constant ascii_equal
  41. 124 constant ascii_pipe
  42. 43 constant ascii_plus
  43. s" arch-pc98" environment? [if]
  44. \ Single frames
  45. 149 constant sh_el
  46. 150 constant sv_el
  47. 152 constant slt_el
  48. 154 constant slb_el
  49. 153 constant srt_el
  50. 155 constant srb_el
  51. \ Double frames
  52. 149 constant dh_el
  53. 150 constant dv_el
  54. 152 constant dlt_el
  55. 154 constant dlb_el
  56. 153 constant drt_el
  57. 155 constant drb_el
  58. \ Fillings
  59. 0 constant fill_none
  60. 32 constant fill_blank
  61. 135 constant fill_dark
  62. 135 constant fill_med
  63. 135 constant fill_bright
  64. [else]
  65. \ Single frames
  66. 196 constant sh_el
  67. 179 constant sv_el
  68. 218 constant slt_el
  69. 192 constant slb_el
  70. 191 constant srt_el
  71. 217 constant srb_el
  72. \ Double frames
  73. 205 constant dh_el
  74. 186 constant dv_el
  75. 201 constant dlt_el
  76. 200 constant dlb_el
  77. 187 constant drt_el
  78. 188 constant drb_el
  79. \ Fillings
  80. 0 constant fill_none
  81. 32 constant fill_blank
  82. 176 constant fill_dark
  83. 177 constant fill_med
  84. 178 constant fill_bright
  85. [then]
  86. only forth definitions also frame-drawing
  87. : hline ( len x y -- ) \ Draw horizontal single line
  88. at-xy \ move cursor
  89. 0 do
  90. h_el @ emit
  91. loop
  92. ;
  93. : f_ascii ( -- ) ( -- ) \ set frames to ascii
  94. ascii_dash h_el !
  95. ascii_pipe v_el !
  96. ascii_plus lt_el !
  97. ascii_plus lb_el !
  98. ascii_plus rt_el !
  99. ascii_plus rb_el !
  100. ;
  101. : f_single ( -- ) \ set frames to single
  102. boot_serial? if f_ascii exit then
  103. sh_el h_el !
  104. sv_el v_el !
  105. slt_el lt_el !
  106. slb_el lb_el !
  107. srt_el rt_el !
  108. srb_el rb_el !
  109. ;
  110. : f_double ( -- ) \ set frames to double
  111. boot_serial? if
  112. f_ascii
  113. ascii_equal h_el !
  114. exit
  115. then
  116. dh_el h_el !
  117. dv_el v_el !
  118. dlt_el lt_el !
  119. dlb_el lb_el !
  120. drt_el rt_el !
  121. drb_el rb_el !
  122. ;
  123. : vline ( len x y -- ) \ Draw vertical single line
  124. 2dup 4 pick
  125. 0 do
  126. at-xy
  127. v_el @ emit
  128. 1+
  129. 2dup
  130. loop
  131. 2drop 2drop drop
  132. ;
  133. : box ( w h x y -- ) \ Draw a box
  134. 2dup 1+ 4 pick 1- -rot
  135. vline \ Draw left vert line
  136. 2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  137. vline \ Draw right vert line
  138. 2dup swap 1+ swap 5 pick 1- -rot
  139. hline \ Draw top horiz line
  140. 2dup swap 1+ swap 4 pick + 5 pick 1- -rot
  141. hline \ Draw bottom horiz line
  142. 2dup at-xy lt_el @ emit \ Draw left-top corner
  143. 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner
  144. 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner
  145. 2 pick + swap 3 pick + swap at-xy rb_el @ emit
  146. 2drop
  147. ;
  148. f_single
  149. fill_none fill !
  150. only forth definitions