home *** CD-ROM | disk | FTP | other *** search
/ Eagles Nest BBS 8 / Eagles_Nest_Mac_Collection_Disc_8.TOAST / Developer Tools⁄Additions / MacScheme20 / Graphics Examples / mandala.sch next >
Encoding:
Text File  |  1987-08-08  |  1.3 KB  |  34 lines  |  [TEXT/EDIT]
  1. ; This is a translation into Scheme of a graphics example that
  2. ; Apple distributes with the Smalltalk-80 programming system.
  3. ; (mandala x0 y0 r n) draws a mandala of radius r, centered at <x0, y0>,
  4. ; with n equally spaced vertices.  A picture is worth a thousand words;
  5. ; try:
  6. ;          (mandala 235 130 130 30)
  7. ;
  8. ; A graphics window must be open when this procedure is called.
  9.  
  10. (define (mandala x0 y0 radius npoints)
  11.   (move-to (+ x0 radius) y0)
  12.   (do ((x (make-vector npoints))
  13.        (y (make-vector npoints))
  14.        (i (-1+ npoints) (-1+ i))
  15.        (delta (/ (* 2 3.14159265) npoints))
  16.        (theta 0.0 (+ theta delta))
  17.        (x0 (* 1.0 x0))
  18.        (y0 (* 1.0 y0))
  19.        (radius (* 1.0 radius)))
  20.       ((negative? i)
  21.        (line-to (vector-ref x (- npoints 1))
  22.                 (vector-ref y (- npoints 1)))
  23.        (do ((i (- (quotient npoints 2) 1) (- i 1)))
  24.            ((negative? i))
  25.            (do ((j 0 (+ j 1)))
  26.                ((=? j npoints))
  27.                (move-to (vector-ref x j) (vector-ref y j))
  28.                (line-to
  29.                 (vector-ref x (remainder (+ j i) npoints))
  30.                 (vector-ref y (remainder (+ j i) npoints))))))
  31.       (vector-set! x i (round (+ x0 (* radius (cos theta)))))
  32.       (vector-set! y i (round (+ y0 (* radius (sin theta)))))
  33.       (line-to (vector-ref x i) (vector-ref y i))))
  34.