home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / comp / lang / lisp / mcl / 1075 < prev    next >
Encoding:
Text File  |  1992-07-25  |  1.0 KB  |  33 lines

  1. Path: sparky!uunet!olivea!apple!cambridge.apple.com!cchien@gmuvax2.gmu.edu
  2. From: cchien@gmuvax2.gmu.edu (Chang-Hong Chien)
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: My tiny program
  5. Message-ID: <9207250931.AA14950@gmuvax2.gmu.edu>
  6. Date: 25 Jul 92 09:31:50 GMT
  7. Sender: info-mcl-request@cambridge.apple.com
  8. Lines: 20
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10. Original-To: info-mcl@cambridge.apple.com
  11. Original-Cc: jipan@gmuvax2.gmu.edu
  12.  
  13. The source code should be :
  14.  
  15. ;;; "Drop a ball"
  16.  
  17. (defparameter *w* (make-instance 'window))
  18. (defvar *v* 1)(defvar *h* 1)(defvar *height* 20)
  19. (defun visiable() (set-fore-color *w* *red-color*))
  20. (defun invisiable() (set-fore-color *w* *blue-color*))
  21.  
  22. (while (< *height* 120)
  23. (If (oddp *h*) (visiable) (invisiable))
  24. (rlet((r :rect :top (+ 20 *V*) :left (+ 20 *h*):bottom (+ 30 *V*)
  25.          :right (+ 30 *h*)))
  26.           (with-focused-view *w*
  27.             (#_paintroundrect r 130 130)))
  28. (setf *v* (+ *v* 31) *h* (+ *h* 51) init-height (+ init-height *v*)))
  29. (setf init-height 20)
  30.  
  31.  
  32.                                 -Chien
  33.