/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. 

  2. \ XXX Filled boxes are left as an exercise for the reader... ;-/
    3. 

  3. \ $FreeBSD: head/share/examples/bootforth/frames.4th 124676 2004-01-18 15:16:12Z nyan $
    4. 

  4. 

  5. marker task-frames.4th
    6. 

  6. 

  7. variable h_el
    8. 

  8. variable v_el
    9. 

  9. variable lt_el
    10. 

  10. variable lb_el
    11. 

  11. variable rt_el
    12. 

  12. variable rb_el
    13. 

  13. variable fill
    14. 

  14. 

  15. s" arch-pc98" environment? [if]
    16. 

  16. 	\ Single frames
    17. 

  17. 	149 constant sh_el
    18. 

  18. 	150 constant sv_el
    19. 

  19. 	152 constant slt_el
    20. 

  20. 	154 constant slb_el
    21. 

  21. 	153 constant srt_el
    22. 

  22. 	155 constant srb_el
    23. 

  23. 	\ Double frames
    24. 

  24. 	149 constant dh_el
    25. 

  25. 	150 constant dv_el
    26. 

  26. 	152 constant dlt_el
    27. 

  27. 	154 constant dlb_el
    28. 

  28. 	153 constant drt_el
    29. 

  29. 	155 constant drb_el
    30. 

  30. 	\ Fillings
    31. 

  31. 	0 constant fill_none
    32. 

  32. 	32 constant fill_blank
    33. 

  33. 	135 constant fill_dark
    34. 

  34. 	135 constant fill_med
    35. 

  35. 	135 constant fill_bright
    36. 

  36. [else]
    37. 

  37. 	\ Single frames
    38. 

  38. 	196 constant sh_el
    39. 

  39. 	179 constant sv_el
    40. 

  40. 	218 constant slt_el
    41. 

  41. 	192 constant slb_el
    42. 

  42. 	191 constant srt_el
    43. 

  43. 	217 constant srb_el
    44. 

  44. 	\ Double frames
    45. 

  45. 	205 constant dh_el
    46. 

  46. 	186 constant dv_el
    47. 

  47. 	201 constant dlt_el
    48. 

  48. 	200 constant dlb_el
    49. 

  49. 	187 constant drt_el
    50. 

  50. 	188 constant drb_el
    51. 

  51. 	\ Fillings
    52. 

  52. 	0 constant fill_none
    53. 

  53. 	32 constant fill_blank
    54. 

  54. 	176 constant fill_dark
    55. 

  55. 	177 constant fill_med
    56. 

  56. 	178 constant fill_bright
    57. 

  57. [then]
    58. 

  58. 

  59. : hline	( len x y -- )	\ Draw horizontal single line
    60. 

  60. 	at-xy		\ move cursor
    61. 

  61. 	0 do
    62. 

  62. 		h_el @ emit
    63. 

  63. 	loop
    64. 

  64. ;
    65. 

  65. 

  66. : f_single	( -- )	\ set frames to single
    67. 

  67. 	sh_el h_el !
    68. 

  68. 	sv_el v_el !
    69. 

  69. 	slt_el lt_el !
    70. 

  70. 	slb_el lb_el !
    71. 

  71. 	srt_el rt_el !
    72. 

  72. 	srb_el rb_el !
    73. 

  73. ;
    74. 

  74. 

  75. : f_double	( -- )	\ set frames to double
    76. 

  76. 	dh_el h_el !
    77. 

  77. 	dv_el v_el !
    78. 

  78. 	dlt_el lt_el !
    79. 

  79. 	dlb_el lb_el !
    80. 

  80. 	drt_el rt_el !
    81. 

  81. 	drb_el rb_el !
    82. 

  82. ;
    83. 

  83. 

  84. : vline	( len x y -- )	\ Draw vertical single line
    85. 

  85. 	2dup 4 pick
    86. 

  86. 	0 do
    87. 

  87. 		at-xy
    88. 

  88. 		v_el @ emit
    89. 

  89. 		1+
    90. 

  90. 		2dup
    91. 

  91. 	loop
    92. 

  92. 	2drop 2drop drop
    93. 

  93. ;
    94. 

  94. 

  95. : box	( w h x y -- )	\ Draw a box
    96. 

  96. 	2dup 1+ 4 pick 1- -rot
    97. 

  97. 	vline		\ Draw left vert line
    98. 

  98. 	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
    99. 

  99. 	vline		\ Draw right vert line
    100. 

  100. 	2dup swap 1+ swap 5 pick 1- -rot
    101. 

  101. 	hline		\ Draw top horiz line
    102. 

  102. 	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
    103. 

  103. 	hline		\ Draw bottom horiz line
    104. 

  104. 	2dup at-xy lt_el @ emit	\ Draw left-top corner
    105. 

  105. 	2dup 4 pick + at-xy lb_el @ emit	\ Draw left bottom corner
    106. 

  106. 	2dup swap 5 pick + swap at-xy rt_el @ emit	\ Draw right top corner
    107. 

  107. 	2 pick + swap 3 pick + swap at-xy rb_el @ emit
    108. 

  108. 	2drop
    109. 

  109. ;
    110. 

  110. 

  111. f_single
    112. 

  112. fill_none fill !
    113.