PageRenderTime 35ms CodeModel.GetById 31ms RepoModel.GetById 0ms app.codeStats 0ms

/share/examples/bootforth/frames.4th

https://repo.or.cz/dragonfly/vkernel-mp.git
Forth | 91 lines | 81 code | 10 blank | 0 comment | 1 complexity | 2d8dd59ade025cc2eeb9f181b1bc1c54 MD5 | raw file
Possible License(s): CC-BY-SA-3.0, Unlicense, BSD-3-Clause, ISC, GPL-2.0, AGPL-1.0 
    

  1. \ Words implementing frame drawing
    2. 

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

  3. \ $FreeBSD: src/share/examples/bootforth/frames.4th,v 1.2 1999/08/28 00:19:09 peter Exp $
    4. 

  4. \ $DragonFly: src/share/examples/bootforth/frames.4th,v 1.2 2003/06/17 06:36:57 dillon Exp $
    5. 

  5. 

  6. marker task-frames.4th
    7. 

  7. 

  8. variable h_el
    9. 

  9. variable v_el
    10. 

  10. variable lt_el
    11. 

  11. variable lb_el
    12. 

  12. variable rt_el
    13. 

  13. variable rb_el
    14. 

  14. variable fill
    15. 

  15. 

  16. \ Single frames
    17. 

  17. 196 constant sh_el
    18. 

  18. 179 constant sv_el
    19. 

  19. 218 constant slt_el
    20. 

  20. 192 constant slb_el
    21. 

  21. 191 constant srt_el
    22. 

  22. 217 constant srb_el
    23. 

  23. \ Double frames
    24. 

  24. 205 constant dh_el
    25. 

  25. 186 constant dv_el
    26. 

  26. 201 constant dlt_el
    27. 

  27. 200 constant dlb_el
    28. 

  28. 187 constant drt_el
    29. 

  29. 188 constant drb_el
    30. 

  30. \ Fillings
    31. 

  31. 0 constant fill_none
    32. 

  32. 32 constant fill_blank
    33. 

  33. 176 constant fill_dark
    34. 

  34. 177 constant fill_med
    35. 

  35. 178 constant fill_bright
    36. 

  36. 

  37. 

  38. : hline	( len x y -- )	\ Draw horizontal single line
    39. 

  39. 	at-xy		\ move cursor
    40. 

  40. 	0 do
    41. 

  41. 		h_el @ emit
    42. 

  42. 	loop
    43. 

  43. ;
    44. 

  44. 

  45. : f_single	( -- )	\ set frames to single
    46. 

  46. 	sh_el h_el !
    47. 

  47. 	sv_el v_el !
    48. 

  48. 	slt_el lt_el !
    49. 

  49. 	slb_el lb_el !
    50. 

  50. 	srt_el rt_el !
    51. 

  51. 	srb_el rb_el !
    52. 

  52. ;
    53. 

  53. 

  54. : f_double	( -- )	\ set frames to double
    55. 

  55. 	dh_el h_el !
    56. 

  56. 	dv_el v_el !
    57. 

  57. 	dlt_el lt_el !
    58. 

  58. 	dlb_el lb_el !
    59. 

  59. 	drt_el rt_el !
    60. 

  60. 	drb_el rb_el !
    61. 

  61. ;
    62. 

  62. 

  63. : vline	( len x y -- )	\ Draw vertical single line
    64. 

  64. 	2dup 4 pick
    65. 

  65. 	0 do
    66. 

  66. 		at-xy
    67. 

  67. 		v_el @ emit
    68. 

  68. 		1+
    69. 

  69. 		2dup
    70. 

  70. 	loop
    71. 

  71. 	2drop 2drop drop
    72. 

  72. ;
    73. 

  73. 

  74. : box	( w h x y -- )	\ Draw a box
    75. 

  75. 	2dup 1+ 4 pick 1- -rot
    76. 

  76. 	vline		\ Draw left vert line
    77. 

  77. 	2dup 1+ swap 5 pick + swap 4 pick 1- -rot
    78. 

  78. 	vline		\ Draw right vert line
    79. 

  79. 	2dup swap 1+ swap 5 pick 1- -rot
    80. 

  80. 	hline		\ Draw top horiz line
    81. 

  81. 	2dup swap 1+ swap 4 pick + 5 pick 1- -rot
    82. 

  82. 	hline		\ Draw bottom horiz line
    83. 

  83. 	2dup at-xy lt_el @ emit	\ Draw left-top corner
    84. 

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

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

  86. 	2 pick + swap 3 pick + swap at-xy rb_el @ emit
    87. 

  87. 	2drop
    88. 

  88. ;
    89. 

  89. 

  90. f_single
    91. 

  91. fill_none fill !
    92. 

  92.