home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / xlisp-1.6 / example.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  3.7 KB  |  102 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         example.lsp
  5. ; RCS:          $Header: $
  6. ; Description:  Another OOP example
  7. ; Author:       ???
  8. ; Created:      Sat Oct  5 20:49:30 1991
  9. ; Modified:     Sat Oct  5 20:49:49 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ; Make the class ship and its instance variables be known
  29.  
  30. (setq ship (Class :new '(x y xv yv m name captain registry)))
  31.  
  32.  
  33. (ship :answer :getx        '() '( x ))    ; just evaluate x
  34. (ship :answer :getxv        '() '( xv ))    ; note that the method is a
  35. (ship :answer :gety        '() '( y ))    ; list of forms, the value
  36. (ship :answer :getyv        '() '( yv ))    ; of the last one being the
  37. (ship :answer :getm        '() '( m ))    ; value of the method
  38. (ship :answer :getname        '() '( name ))
  39. (ship :answer :getcaptain    '() '( captain ))
  40. (ship :answer :getregistry    '() '( registry ))
  41.  
  42. ;               formal
  43. ;               param
  44. ;               of
  45. ;               method
  46. (ship :answer :setx         '(to) '( (setq x to) ) )
  47. (ship :answer :setxv        '(to) '( (setq xv to) ) )
  48. (ship :answer :sety         '(to) '( (setq y to) ) )
  49. (ship :answer :setyv       '(to) '( (setq yv to) ) )
  50. (ship :answer :setm       '(to) '( (setq m to) ) )
  51. (ship :answer :setname     '(to) '( (setq name to) ) )
  52. (ship :answer :setcaptain  '(to) '( (setq captain to) ) )
  53. (ship :answer :setregistry '(to) '( (setq registry to) ) )
  54.  
  55. (ship :answer :sail '(time) 
  56.     ; the METHOD for sailing
  57.     '( (princ (list "sailing for " time " hours\n"))
  58.        ; note that this form is expressed in terms of objects:  "self"
  59.        ; is bound to the object being talked to during the execution
  60.        ; of its message.  It can ask itself to do things.
  61.        (self :setx (+  (self :getx)
  62.                (* (self :getxv) time)))
  63.        ; This form performs a parallel action to the above, but more
  64.        ; efficiently, and in this instance, more clearly
  65.        (setq y (+ y (* yv time)))
  66.        ; Cute message for return value.  Tee Hee.
  67.        "Sailing, sailing, over the bountiful chow mein..."))
  68.  
  69. ; <OBJECT: #12345667> is not terribly instructive.  How about a more
  70. ; informative print routine?
  71.  
  72. (ship :answer :print '() '((princ (list
  73.                 "SHIP NAME: " (self :getname) "\n"
  74.                 "REGISTRY: " (self :getregistry) "\n"
  75.                 "CAPTAIN IS: " (self :getcaptain) "\n"
  76.                 "MASS IS: " (self :getm) " TONNES\n"
  77.                 "CURRENT POSITION IS: " 
  78.                     (self :getx)    " X BY "
  79.                     (self :gety)    " Y\n"
  80.                 "SPEED IS: "
  81.                     (self :getxv)    " XV BY "
  82.                     (self :getyv)    " YV\n") ) ))
  83.  
  84. ; a function to make life easier
  85.  
  86. (defun newship (mass name registry captain &aux new)
  87.     (setq new (ship :new))
  88.     (new :setx 0)
  89.     (new :sety 0)
  90.     (new :setxv 0)
  91.     (new :setyv 0)
  92.     (new :setm mass)
  93.     (new :setname name)
  94.     (new :setcaptain captain)
  95.     (new :setregistry registry)
  96.     (new :print)
  97.     new)
  98.  
  99. ; and an example object.
  100.  
  101. (setq Bounty (newship 50 'Bounty 'England 'Bligh))
  102.