home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 13 / 13.iso / p / p030 / 2.ddi / SPIRAL.LSP < prev    next >
Encoding:
Lisp/Scheme  |  1988-08-10  |  2.0 KB  |  49 lines
  1. ;       This is a programming example.
  2. ;
  3. ;       Designed and implemented by Kelvin R. Throop in January 1985
  4. ;
  5. ;       This program constructs a spiral. It can be loaded and called 
  6. ;       by typing either "spiral" or the following:
  7. ;       (cspiral <# rotations> <base point> <growth per rotation>
  8. ;                <points per circle>).
  9. ;
  10.  
  11. (defun cspiral (ntimes bpoint cfac lppass / ang dist tp ainc dinc circle bs cs)
  12.         (setq cs (getvar "cmdecho"))    ; save old cmdecho and blipmode
  13.         (setq bs (getvar "blipmode"))
  14.         (setvar "blipmode" 0)           ; turn blipmode off
  15.         (setvar "cmdecho" 0)            ; turn cmdecho off
  16.         (setq circle (* 3.141596235 2))
  17.         (setq ainc (/ circle lppass))
  18.         (setq dinc (/ cfac lppass))
  19.         (setq ang 0.0)
  20.         (setq dist 0.0)
  21.         (command "pline" bpoint)        ; start spiral from base point and...
  22.         (repeat ntimes
  23.            (repeat lppass
  24.               (setq tp (polar bpoint (setq ang (+ ang ainc))
  25.                           (setq dist (+ dist dinc))))
  26.               (command tp)              ; continue to the next point...
  27.            )
  28.         )
  29.         (command)                       ; until done.
  30.         (setvar "blipmode" bs)          ; restore saved blipmode
  31.         (setvar "cmdecho" cs)           ; restore saved cmdecho
  32.         nil
  33. )
  34. ;
  35. ;       Interactive spiral generation
  36. ;
  37. (defun C:SPIRAL ( / nt bp cf lp)
  38.         (initget 1)                     ; bp must not be null
  39.         (setq bp (getpoint "\nCenter point: "))
  40.         (initget 7)                     ; nt must not be zero, neg, or null
  41.         (setq nt (getint "\nNumber of rotations: "))
  42.         (initget 3)                     ; cf must not be zero, or null
  43.         (setq cf (getdist "\nGrowth per rotation: "))
  44.         (initget 6)                     ; lp must not be zero or neg
  45.         (setq lp (getint "\nPoints per rotation <30>: "))
  46.         (cond ((null lp) (setq lp 30)))
  47.         (cspiral nt bp cf lp)
  48. )
  49.