PageRenderTime 25ms CodeModel.GetById 14ms RepoModel.GetById 0ms app.codeStats 0ms

/stand/forth/frames.4th

https://bitbucket.org/freebsd/freebsd-base
Forth | 142 lines | 127 code | 15 blank | 0 comment | 2 complexity | 77d87186817a90a5608b3219712ee18c 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. 0x2500 constant sh_el
  45. 0x2502 constant sv_el
  46. 0x250c constant slt_el
  47. 0x2514 constant slb_el
  48. 0x2510 constant srt_el
  49. 0x2518 constant srb_el
  50. \ Double frames
  51. 0x2550 constant dh_el
  52. 0x2551 constant dv_el
  53. 0x2554 constant dlt_el
  54. 0x255a constant dlb_el
  55. 0x2557 constant drt_el
  56. 0x255d constant drb_el
  57. \ Fillings
  58. 0 constant fill_none
  59. 32 constant fill_blank
  60. 0x2591 constant fill_dark
  61. 0x2592 constant fill_med
  62. 0x2593 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 @ xemit
  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 @ xemit
  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 @ xemit \ Draw left-top corner
  120. 2dup 4 pick + at-xy lb_el @ xemit \ Draw left bottom corner
  121. 2dup swap 5 pick + swap at-xy rt_el @ xemit \ Draw right top corner
  122. 2 pick + swap 3 pick + swap at-xy rb_el @ xemit
  123. 2drop
  124. ;
  125. f_single
  126. fill_none fill !
  127. only forth definitions