home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / STklos / Examples / E1.stklos < prev    next >
Encoding:
Text File  |  1995-01-01  |  1.9 KB  |  60 lines
  1. ;;;;
  2. ;;;; E x a m p l e 1 .  s t k
  3. ;;;;
  4. ;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date:  5-Aug-1994 11:11
  16. ;;;; Last file update:  5-Aug-1994 16:41 
  17.  
  18.  
  19. (require "Canvas")
  20.  
  21. ;;;; Create canvas
  22. (define c (make <Canvas>))
  23. (pack c)
  24.  
  25. ;;;; Create items
  26. (define r1 (make <Rectangle> :parent c :coords '(  0   0  50  50) :fill "blue"))
  27. (define r2 (make <Rectangle> :parent c :coords '( 50  50 100 100) :fill "red"))
  28. (define o1 (make <Oval>      :parent c :coords '(100 100 150 150) :fill "blue"))
  29. (define o2 (make <Oval>      :parent c :coords '(150 150 200 200) :fill "red"))
  30.  
  31.  
  32. ;;; Define some families
  33. (define rectangles (make <Canvas-group> :parent c))
  34. (define ovals      (make <Canvas-group> :parent c))
  35. (define blue       (make <Canvas-group> :parent c))
  36. (define red       (make <Canvas-group> :parent c))
  37.  
  38. ;;;; And add members of these families
  39. (add-to-group rectangles r1 r2)
  40. (add-to-group ovals      o1 o2)
  41. (add-to-group blue       r1 o1)
  42. (add-to-group red        r2 o2)
  43.  
  44. ;;;; Work with group
  45. (move rectangles 100 100)
  46. (move ovals -100 -100)
  47. (move blue 100 0)
  48. (destroy red)
  49.  
  50. ;;;; Find the items of a group
  51. (format #t "items of group blue ~s\n" (items-of-group blue))
  52.  
  53. ;;;; delete an item of a group
  54. (delete-from-group blue r1)
  55. (format #t "items of group blue ~s\n" (items-of-group blue))
  56. (destroy blue)
  57.  
  58. ;;; Only the blue square (r1) is alive....
  59.  
  60.