/share/examples/bootforth/frames.4th

https://bitbucket.org/iorivur/freebsd-bhyve-with-suspend-resume · Forth · 112 lines · 103 code · 9 blank · 0 comment · 1 complexity · 3822d5ac9a1cf8d9ee592595e409e690 MD5 · raw file

  1. \ Words implementing frame drawing
  2. \ XXX Filled boxes are left as an exercise for the reader... ;-/
  3. \ $FreeBSD: head/share/examples/bootforth/frames.4th 124676 2004-01-18 15:16:12Z nyan $
  4. marker task-frames.4th
  5. variable h_el
  6. variable v_el
  7. variable lt_el
  8. variable lb_el
  9. variable rt_el
  10. variable rb_el
  11. variable fill
  12. s" arch-pc98" environment? [if]
  13. \ Single frames
  14. 149 constant sh_el
  15. 150 constant sv_el
  16. 152 constant slt_el
  17. 154 constant slb_el
  18. 153 constant srt_el
  19. 155 constant srb_el
  20. \ Double frames
  21. 149 constant dh_el
  22. 150 constant dv_el
  23. 152 constant dlt_el
  24. 154 constant dlb_el
  25. 153 constant drt_el
  26. 155 constant drb_el
  27. \ Fillings
  28. 0 constant fill_none
  29. 32 constant fill_blank
  30. 135 constant fill_dark
  31. 135 constant fill_med
  32. 135 constant fill_bright
  33. [else]
  34. \ Single frames
  35. 196 constant sh_el
  36. 179 constant sv_el
  37. 218 constant slt_el
  38. 192 constant slb_el
  39. 191 constant srt_el
  40. 217 constant srb_el
  41. \ Double frames
  42. 205 constant dh_el
  43. 186 constant dv_el
  44. 201 constant dlt_el
  45. 200 constant dlb_el
  46. 187 constant drt_el
  47. 188 constant drb_el
  48. \ Fillings
  49. 0 constant fill_none
  50. 32 constant fill_blank
  51. 176 constant fill_dark
  52. 177 constant fill_med
  53. 178 constant fill_bright
  54. [then]
  55. : hline ( len x y -- ) \ Draw horizontal single line
  56. at-xy \ move cursor
  57. 0 do
  58. h_el @ emit
  59. loop
  60. ;
  61. : f_single ( -- ) \ set frames to single
  62. sh_el h_el !
  63. sv_el v_el !
  64. slt_el lt_el !
  65. slb_el lb_el !
  66. srt_el rt_el !
  67. srb_el rb_el !
  68. ;
  69. : f_double ( -- ) \ set frames to double
  70. dh_el h_el !
  71. dv_el v_el !
  72. dlt_el lt_el !
  73. dlb_el lb_el !
  74. drt_el rt_el !
  75. drb_el rb_el !
  76. ;
  77. : vline ( len x y -- ) \ Draw vertical single line
  78. 2dup 4 pick
  79. 0 do
  80. at-xy
  81. v_el @ emit
  82. 1+
  83. 2dup
  84. loop
  85. 2drop 2drop drop
  86. ;
  87. : box ( w h x y -- ) \ Draw a box
  88. 2dup 1+ 4 pick 1- -rot
  89. vline \ Draw left vert line
  90. 2dup 1+ swap 5 pick + swap 4 pick 1- -rot
  91. vline \ Draw right vert line
  92. 2dup swap 1+ swap 5 pick 1- -rot
  93. hline \ Draw top horiz line
  94. 2dup swap 1+ swap 4 pick + 5 pick 1- -rot
  95. hline \ Draw bottom horiz line
  96. 2dup at-xy lt_el @ emit \ Draw left-top corner
  97. 2dup 4 pick + at-xy lb_el @ emit \ Draw left bottom corner
  98. 2dup swap 5 pick + swap at-xy rt_el @ emit \ Draw right top corner
  99. 2 pick + swap 3 pick + swap at-xy rb_el @ emit
  100. 2drop
  101. ;
  102. f_single
  103. fill_none fill !