home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / scheme / xscheme028 / scm / tools < prev   
Encoding:
Text File  |  1992-03-04  |  4.6 KB  |  128 lines
  1.  
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ;       File name:      tools.s
  5. ;
  6. ;       original XLISP-version:
  7. ;
  8. ;       Author:         Tim Mikkelsen
  9. ;       Description:    Object-oriented example program
  10. ;       Language:       XLISP 2.0
  11. ;
  12. ;       Date Created:   10-Jan-1988
  13. ;       Date Updated:   2-Apr-1989
  14. ;
  15. ;       (c) Copyright 1988, by Tim Mikkelsen, all rights reserved.
  16. ;           Permission is granted for unrestricted non-commercial use.
  17. ;
  18. ;       port to XScheme:
  19. ;
  20. ;       Language:       Xscheme 0.28
  21. ;
  22. ;       Date Created:   23-Feb-1992
  23. ;
  24. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27. ;
  28. ;       Define the superclasses and classes
  29. ;
  30. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31.  
  32. ;
  33. ; make TOOLS superclass
  34. ;       with a different 'ISNEW method
  35. ;       added methods are 'BORROW and 'RETURN
  36. ;       class variables are     NUMBER          contains # of tool instances
  37. ;                               ACTIVE-LIST     contains list of current objects
  38. ;       instance variables are  POWER           list - (AC BATTERY HAND)
  39. ;                               MOVEABLE        CAN-CARRY or CAN-ROLL or FIXED
  40. ;                               OPERATIONS      list
  41. ;                               MATERIAL        list - (WOOD METAL PLASTIC ...)
  42. ;                               PIECES          list
  43. ;                               LOCATION        HOME or person's name
  44. ;
  45.  
  46. (set! tools (class 'new '(power
  47.                           moveable
  48.                           operations
  49.                           material
  50.                           pieces
  51.                           location)
  52.                           '(number active-list)))
  53. (tools 'answer 'isnew '()
  54.                '((if (null? number) (set! number 1)
  55.                                     (set! number (1+ number)))
  56.                      (set! active-list (cons self active-list))
  57.                      (set! location 'home)
  58.                      self))
  59. (tools 'answer 'borrow '(by-who)
  60.                '((if (eq? location 'home) (set! location by-who)
  61.                                           (display "you can't"))))
  62. (tools 'answer 'return '()
  63.                '((if (eq? location 'home) (display "got it already")
  64.                                           (set! location 'home))))
  65.  
  66. ;
  67. ; make HAND-TOOLS class
  68. ;       with a different 'ISNEW method
  69. ;       new instance variable   WEIGHT          <number> of pounds
  70. ;       the rest is inherited from TOOLS
  71. ;
  72.  
  73. (set! hand-tools (class 'new '(weight) '() tools))
  74. (hand-tools 'answer 'isnew '(pow op mat parts w-in)
  75.                            '((set! power pow)
  76.                              (set! moveable 'can-carry)
  77.                              (set! operations op)
  78.                              (set! material mat)
  79.                              (set! pieces parts)
  80.                              (set! weight w-in)
  81.                              (send-super 'isnew)))
  82.  
  83. ;
  84. ; make SHOP-TOOLS class
  85. ;       with a different 'ISNEW method
  86. ;       no new instance variables
  87. ;       the rest is inherited from TOOLS
  88. ;
  89.  
  90. (set! shop-tools (class 'new '() '() tools))
  91. (shop-tools 'answer 'isnew '(pow mov op mat parts)
  92.                            '((set! power pow)
  93.                             (set! moveable mov)
  94.                             (set! operations op)
  95.                             (set! material mat)
  96.                             (set! pieces parts)
  97.                             (send-super 'isnew)
  98.                             self))
  99.  
  100. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  101. ;
  102. ;       Create instances of various tool classes
  103. ;
  104. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  105.  
  106. (set! hand-drill (hand-tools 'new          ; make an instance - HAND-DRILL
  107.                              '(ac)
  108.                              '(drill polish grind screw)
  109.                              '(wood metal plastic)
  110.                              '(drill drill-bits screw-bits buffer)
  111.                              '2.5))
  112.  
  113. (set! table-saw (shop-tools 'new           ; make an instance - TABLE-SAW
  114.                              '(ac)
  115.                              'fixed
  116.                              '(rip cross-cut)
  117.                              '(wood plastic)
  118.                              '(saw blades fence)))
  119.  
  120.  
  121. (set! radial-arm (shop-tools 'new          ; make an instance = RADIAL-ARM
  122.                              '(ac)
  123.                              'can-roll
  124.                              '(rip cross-cut)
  125.                              '(wood plastic)
  126.                              '(saw blades dust-bag)))
  127.  
  128.