home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / pc / source / tile.lzh / tile.1 / tst / sets.tst < prev    next >
Encoding:
Text File  |  1990-07-26  |  1.2 KB  |  71 lines
  1. #include blocks.f83
  2. #include sets.f83
  3.  
  4. sets blocks
  5.  
  6. .( 1: Set elements return pointers to the entry) cr
  7.  
  8. : element ( -- )
  9.   create last ,
  10. does> ( element -- entry)
  11.   @
  12. ;
  13.  
  14.  
  15. .( 2: A print function for element sets) cr
  16.  
  17. : print-set ( set -- )
  18.   dup .set ." elements: "
  19.   ." { "
  20.   block[ .name space ]; map-set
  21.   ." } "
  22. ;
  23.  
  24. .( 3: A simple destructive copying function for sets) cr
  25.  
  26. : copy-set ( set1 set2 -- set2)
  27.   dup empty-set union-set
  28. ;
  29.  
  30.  
  31. .( 4: Color elements and some sets for calculations) cr
  32.  
  33. element white
  34. element black
  35.  
  36. element blue
  37. element red
  38. element yellow
  39.  
  40. element green
  41. element brown
  42. element violet
  43.  
  44. 10 SET colors
  45.  
  46. { yellow red blue }    constant primary
  47. { green brown violet } constant secondary
  48.  
  49.  
  50. .( 5: The set of sets and a print print function) cr
  51.  
  52. { colors primary secondary } constant the-sets
  53.  
  54. : print-the-sets ( -- )
  55.   the-sets block[ execute print-set cr ]; map-set
  56. ;
  57.  
  58.  
  59. .( 6: Testing the symbol set management) cr
  60.  
  61. print-the-sets cr
  62.  
  63. yellow colors append-set colors print-set cr
  64. secondary colors copy-set print-set cr
  65. brown colors remove-set colors print-set cr
  66. primary colors union-set print-set cr
  67. blue colors remove-set colors print-set cr
  68. { brown blue yellow } colors intersection-set print-set cr
  69.  
  70. forth only
  71.