home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 18 / forthsup / patterns.fth < prev    next >
Encoding:
Text File  |  1986-09-18  |  5.6 KB  |  166 lines
  1. \ Fill patterns from Jesse Taylor
  2. needs _patptr linea.fth
  3.  
  4. hex
  5.  
  6. create p0
  7. ffffffff , ffffffff , ffffffff , ffffffff ,
  8. ffffffff , ffffffff , ffffffff , ffffffff ,
  9. ffffffff , ffffffff , ffffffff , ffffffff ,
  10. ffffffff , ffffffff , ffffffff , ffffffff ,
  11. ffffffff , ffffffff , ffffffff , ffffffff ,
  12. ffffffff , ffffffff , ffffffff , ffffffff ,
  13.  
  14. create p1
  15. ffffffff , c000c000 , c000c000 , c000c000 ,
  16. c000c000 , c000c000 , c000c000 , c000c000 ,
  17. ffffffff , c000c000 , c000c000 , c000c000 ,
  18. c000c000 , c000c000 , c000c000 , c000c000 ,
  19. ffffffff , c000c000 , c000c000 , c000c000 ,
  20. c000c000 , c000c000 , c000c000 , c000c000 ,
  21.  
  22. create p2
  23. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,
  24. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,
  25. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,
  26. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,
  27. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,
  28. cccc3333 , cccc3333 , cccc3333 , cccc3333 ,  
  29.  
  30. create p3
  31. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  32. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  33. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  34. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  35. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  36. c0c03030 , 0c0c0303 ,  c0c03030 , 0c0c0303 ,
  37.  
  38. create p4
  39. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  40. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  41. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  42. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  43. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  44. 03030c0c , 3030c0c0 ,  03030c0c , 3030c0c0 ,
  45.  
  46. create p5
  47. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,
  48. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,
  49. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,  
  50. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,
  51. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,
  52. c003300c , 0c3003c0 ,  03c00c30 , 300cc003 ,
  53.  
  54. create p6
  55. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  56. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  57. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  58. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  59. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  60. c3c33c3c , 3c3cc3c3 , c3c33c3c , 3c3cc3c3 ,
  61.  
  62. create p7
  63. ffff8001 , 80018001 , ffff0180 , 01800180 ,
  64. ffff8001 , 80018001 , ffff0180 , 01800180 ,
  65. ffff8001 , 80018001 , ffff0180 , 01800180 ,
  66. ffff8001 , 80018001 , ffff0180 , 01800180 ,
  67. ffff8001 , 80018001 , ffff0180 , 01800180 ,
  68. ffff8001 , 80018001 , ffff0180 , 01800180 , 
  69.  
  70. create p8
  71. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  72. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  73. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  74. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  75. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  76. 40a08040 , 80a05515 , 08081004 , 10048aaa ,
  77.  
  78. create p9
  79. 44440000 , 44440000 , 44440000 , 44440000 ,
  80. 44440000 , 44440000 , 44440000 , 44440000 ,
  81. 44440000 , 44440000 , 44440000 , 44440000 ,
  82. 44440000 , 44440000 , 44440000 , 44440000 ,
  83. 44440000 , 44440000 , 44440000 , 44440000 ,
  84. 44440000 , 44440000 , 44440000 , 44440000 ,
  85.  
  86. create p10
  87. ffff2222 , ffff1111 , ffff8888 , ffff4444 ,
  88. ffff2222 , ffff1111 , ffff8888 , ffff4444 ,
  89. ffff2222 , ffff1111 , ffff8888 , ffff4444 , 
  90. ffff2222 , ffff1111 , ffff8888 , ffff4444 ,
  91. ffff2222 , ffff1111 , ffff8888 , ffff4444 ,
  92. ffff2222 , ffff1111 , ffff8888 , ffff4444 ,
  93.  
  94. create p11
  95. 44448282 , 01010202 , 04040808 , 10102828 ,
  96. 44448282 , 01010202 , 04040808 , 10102828 ,
  97. 44448282 , 01010202 , 04040808 , 10102828 ,
  98. 44448282 , 01010202 , 04040808 , 10102828 ,
  99. 44448282 , 01010202 , 04040808 , 10102828 ,
  100. 44448282 , 01010202 , 04040808 , 10102828 ,
  101.  
  102. create p12
  103. 80808888 , 8080aaaa , 80808888 , 8080aaaa ,
  104. 80808888 , 8080aaaa , 80808888 , 8080aaaa ,
  105. 80808888 , 8080aaaa , 80808888 , 8080aaaa ,
  106. 80808888 , 8080aaaa , 80808888 , 8080aaaa ,
  107. 80808888 , 8080aaaa , 80808888 , 8080aaaa ,
  108. 80808888 , 8080aaaa , 80808888 , 8080aaaa , 
  109.  
  110. create p13
  111. 00001010 , 44440000 , 00001010 , 44440000 ,
  112. 00001010 , 44440000 , 00001010 , 44440000 ,
  113. 00001010 , 44440000 , 00001010 , 44440000 ,
  114. 00001010 , 44440000 , 00001010 , 44440000 ,
  115. 00001010 , 44440000 , 00001010 , 44440000 ,
  116. 00001010 , 44440000 , 00001010 , 44440000 ,
  117.  
  118. create p14
  119. 01018080 , 40400000 , 04040808 , 10100000 ,
  120. 01018080 , 40400000 , 04040808 , 10100000 ,
  121. 01018080 , 40400000 , 04040808 , 10100000 ,
  122. 01018080 , 40400000 , 04040808 , 10100000 ,
  123. 01018080 , 40400000 , 04040808 , 10100000 ,
  124. 01018080 , 40400000 , 04040808 , 10100000 ,
  125.  
  126. create p15
  127. 77778888 , 77770000 , dddd2222 , dddd0000 ,
  128. 77778888 , 77770000 , dddd2222 , dddd0000 ,
  129. 77778888 , 77770000 , dddd2222 , dddd0000 , 
  130. 77778888 , 77770000 , dddd2222 , dddd0000 ,
  131. 77778888 , 77770000 , dddd2222 , dddd0000 ,
  132. 77778888 , 77770000 , dddd2222 , dddd0000 ,
  133.  
  134. create p16
  135. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  136. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  137. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  138. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  139. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  140. 7e7e8181 , c0c03f3f , 00006666 , 99990000 ,
  141.  
  142. create p17
  143. e640ffff , ffffe640 , e640ffff , e640e640 ,
  144. e640ffff , ffffe640 , e640ffff , e640e640 ,
  145. e640ffff , ffffe640 , e640ffff , e640e640 ,
  146. e640ffff , ffffe640 , e640ffff , e640e640 ,
  147. e640ffff , ffffe640 , e640ffff , e640e640 ,
  148. e640ffff , ffffe640 , e640ffff , e640e640 , 
  149.  
  150. create p18
  151. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  152. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  153. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  154. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  155. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  156. 3838c6c6 , 38380000 , 83836c6c , 83830000 ,
  157. decimal
  158. create patterns
  159.  p0 ,  p1 ,  p2 ,  p3 ,  p4 ,  p5 ,  p6 ,
  160.  p7 ,  p8 ,  p9 ,  p10 , p11 , p12 ,
  161.  p13 , p14 , p15 , p16 , p17 , p18 ,
  162.  
  163. : set-pattern  ( n -- )  \ set the current fill pattern
  164.    4 *  patterns +  @  _patptr  !
  165. ;
  166.