;;; --------------------------------------------------------------------------;
;;; RPOLY.LSP
;;;   Copyright (C) 1990 by Autodesk, Inc.
;;;  
;;;   Permission to use, copy, modify, and distribute this software and its
;;;   documentation for any purpose and without fee is hereby granted.  
;;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. 
;;;   ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF 
;;;   MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;;   Written by Kelvin R. Throop in October 1985
;;;
;;;   Based on the technique described in Philip J. Davis,
;;;   "Circulant Matrices", Wiley 1979.
;;;
;;; --------------------------------------------------------------------------;
;;; DESCRIPTION
;;;
;;;   Refinement of a random polygon by iterative replacement of
;;;   its vertices by the midpoints of its edges.  This miraculously
;;;   transforms most random polygons into an ellipse-shaped convex
;;;   polygon.
;;;
;;;   Added error checking and an error function - April 1988
;;;
;;;   Added version number, line rubberbanding and the ability to 
;;;   retain each iteration of the polygon. Jeff Wilson 12June1990
;;;
;;; --------------------------------------------------------------------------;
(defun drawpoly (p / dp dl)
  (setq dp p)
  (setq dl (length p))
  (command "pline")
  (repeat dl
    (command (car dp))
    (setq dp (cdr dp))
  )
  (command "c")
)

(defun myerror (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setvar "cmdecho" ocmd)             ; Restore saved modes
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)

(defun C:RPOLY (/ olderr ocmd oblp cycno pl p pvert cyc plast pn pe pc delpoly)
  (princ "\nRefine Polygon, Version 1.1 by Autodesk,Inc.")
  (setq olderr  *error*
        *error* myerror)
  (setq ocmd (getvar "cmdecho"))
  (setq oblp (getvar "blipmode"))
  (setvar "cmdecho" 0)
  (setq cycno 0)
  (setq pl nil)
  (command "undo" "mark")
  (setq p1 (getpoint "\nFirst point: "))
  (setq pl (cons p1 pl))
  (while (setq p (getpoint p1 "\nNext point: "))
    (command "line" p1 p "")
    (setq p1 p)
    (setq pl (cons p pl))
  )
  (command "undo" "back")
  (setvar "blipmode" 0)
  (setq pvert (length pl))
  (if pl 
    (progn
      (drawpoly pl)
      (initget 6)
      (while (setq cyc (getint "\nNumber of cycles: "))
        (initget "Yes No")
        (setq delpoly 
          (getkword "Retain polygon at each cycle? <Y>/N: ")
        )
        (princ "Cycles:")
        (repeat cyc
          (setq plast (nth (1- pvert) pl))
          (setq pn nil)
          (setq pe pl)
          (repeat pvert
            (setq pc (car pe))
            (setq pe (cdr pe))
            (setq pn (cons (list (/ (+ (car pc) (car plast)) 2)
                                 (/ (+ (cadr pc) (cadr plast)) 2))
                           pn)
            )
            (setq plast pc)
          )
          (setq pl pn)
          (setq cycno (1+ cycno))
          (princ " ")
          (princ cycno)
          (if (cond 
                ((= delpoly "No") t)
                (t nil)
              )
            (command "erase" "l" "")
          )
          (drawpoly pn)
        )
        (initget 6)
      )
    )
  )
  (setvar "cmdecho" ocmd)
  (setvar "blipmode" oblp)
  (setq *error* olderr)               ; Restore old *error* handler
  (princ)
)