/stand/forth/frames.4th

https://github.com/opnsense/src · Forth · 142 lines · 127 code · 15 blank · 0 comment · 2 complexity · d1e3d8ef24a2ad7cb85e691daa249680 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. \ Single frames
  44. 196 constant sh_el
  45. 179 constant sv_el
  46. 218 constant slt_el
  47. 192 constant slb_el
  48. 191 constant srt_el
  49. 217 constant srb_el
  50. \ Double frames
  51. 205 constant dh_el
  52. 186 constant dv_el
  53. 201 constant dlt_el
  54. 200 constant dlb_el
  55. 187 constant drt_el
  56. 188 constant drb_el
  57. \ Fillings
  58. 0 constant fill_none
  59. 32 constant fill_blank
  60. 176 constant fill_dark
  61. 177 constant fill_med
  62. 178 constant fill_bright
  63. only forth definitions also frame-drawing
  64. : hline ( len x y -- ) \ Draw horizontal single line
  65. at-xy \ move cursor
  66. 0 do
  67. h_el @ emit
  68. loop
  69. ;
  70. : f_ascii ( -- ) ( -- ) \ set frames to ascii
  71. ascii_dash h_el !
  72. ascii_pipe v_el !
  73. ascii_plus lt_el !
  74. ascii_plus lb_el !
  75. ascii_plus rt_el !
  76. ascii_plus rb_el !
  77. ;
  78. : f_single ( -- ) \ set frames to single
  79. boot_serial? if f_ascii exit then
  80. sh_el h_el !
  81. sv_el v_el !
  82. slt_el lt_el !
  83. slb_el lb_el !
  84. srt_el rt_el !
  85. srb_el rb_el !
  86. ;
  87. : f_double ( -- ) \ set frames to double
  88. boot_serial? if
  89. f_ascii
  90. ascii_equal h_el !
  91. exit
  92. then
  93. dh_el h_el !
  94. dv_el v_el !
  95. dlt_el lt_el !
  96. dlb_el lb_el !
  97. drt_el rt_el !
  98. drb_el rb_el !
  99. ;
  100. : vline ( len x y -- ) \ Draw vertical single line
  101. 2dup 4 pick
  102. 0 do
  103. at-xy
  104. v_el @ emit
  105. 1+
  106. 2dup
  107. loop
  108. 2drop 2drop drop
  109. ;
  110. : box ( w h x y -- ) \ Draw a box
  111. 2dup 1+ 4 pick 1- -rot
  112. vline \ Draw left vert line
  113. 2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  114. vline \ Draw right vert line
  115. 2dup swap 1+ swap 5 pick 1- -rot
  116. hline \ Draw top horiz line
  117. 2dup swap 1+ swap 4 pick + 5 pick 1- -rot
  118. hline \ Draw bottom horiz line
  119. 2dup at-xy lt_el @ emit \ Draw left-top corner
  120. 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner
  121. 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner
  122. 2 pick + swap 3 pick + swap at-xy rb_el @ emit
  123. 2drop
  124. ;
  125. f_single
  126. fill_none fill !
  127. only forth definitions