home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / Programming / Source / winterp-1.13 / examples / scooter.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  2.5 KB  |  97 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         scooter.lsp
  5. ; RCS:          $Header: scooter.lsp,v 1.3 91/10/05 18:51:17 mayer Exp $
  6. ; Description:  a silly example that scoots (moves) windows around the
  7. ;        screen while changing their colors. This can really tie up your
  8. ;        X server and window manager, so be careful...
  9. ; Author:       Niels Mayer, HPLabs
  10. ; Created:      Sat Oct  5 18:49:55 1991
  11. ; Modified:     Sat Oct  5 18:50:52 1991 (Niels Mayer) mayer@hplnpm
  12. ; Language:     Lisp
  13. ; Package:      N/A
  14. ; Status:       X11r5 contrib tape release
  15. ;
  16. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  17. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  18. ;
  19. ; Permission to use, copy, modify, distribute, and sell this software and its
  20. ; documentation for any purpose is hereby granted without fee, provided that
  21. ; the above copyright notice appear in all copies and that both that
  22. ; copyright notice and this permission notice appear in supporting
  23. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  24. ; used in advertising or publicity pertaining to distribution of the software
  25. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  26. ; makes no representations about the suitability of this software for any
  27. ; purpose.  It is provided "as is" without express or implied warranty.
  28. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29.  
  30.  
  31. (setq top_w
  32.       (send OVERRIDE_SHELL_WIDGET_CLASS :new 
  33.         :xmn_geometry "+1+1"
  34.         ))
  35. (setq pb_w
  36.       (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed top_w
  37.         :XMN_LABEL_TYPE :pixmap
  38.         :XMN_LABEL_PIXMAP "/usr/include/X11/bitmaps/xlogo64"
  39.         ))
  40. (send top_w :realize)
  41.  
  42. (defun randomove()
  43.   (do
  44.    ((i 0 (1+ i)))
  45.    ((eq 100 i)
  46.     )
  47.    (send top_w :set_values
  48.      :xmn_x (random 1000)
  49.      :xmn_y (random 1000)
  50.      )
  51.    )
  52.   )
  53. (defun scoot(d)
  54.   (do
  55.    ((i 0 (1+ i))
  56.     (x 0 (+ d x))
  57.     (y 0 (+ d y)))
  58.    ((eq 100 i)
  59.     )
  60.    (send top_w :set_values
  61.      :xmn_x x
  62.      :xmn_y y
  63.      )
  64.    )
  65.   )
  66.  
  67.  
  68. (scoot 1)
  69. (scoot 5)
  70. (scoot 10)
  71.  
  72.  
  73. (defun colorize ()
  74.   (do* 
  75.    ((fp (open "/usr/lib/X11/rgb.txt" :direction :input))
  76.     (color
  77.      (fscanf-string fp "%*d %*d %*d %[^\n]\n")
  78.      (fscanf-string fp "%*d %*d %*d %[^\n]\n"))
  79.     (x 1 (1+ x))
  80.     (y 1 (1+ y))
  81.     )
  82.    ((null color)
  83.     (close fp)
  84.     )
  85.  
  86.    (send top_w :set_values 
  87.      :xmn_x x
  88.      :xmn_y y
  89.      )
  90.    (send pb_w :set_values
  91.      :xmn_background color)
  92. ;   (send pb_w :update_display)
  93.    ))
  94.  
  95. (colorize)
  96.  
  97.