diff --git a/lisp/geo/primt.l b/lisp/geo/primt.l index d6e37a95a..e69dceeb1 100644 --- a/lisp/geo/primt.l +++ b/lisp/geo/primt.l @@ -701,7 +701,7 @@ hedron is an icosahedron or a gdome of lower level" ;; -#| + (defun make-body-from-vertices (face-vertices &optional (klass *body-class*)) ; face-vertices=(list #f(x1 y1 z1) #f(x2 y2 z2) ...) ... #|(setq a @@ -728,29 +728,6 @@ hedron is an icosahedron or a gdome of lower level" (setq bod (instance *body-class* :init :faces (nreverse faces))) (send bod :csg (list (cons :body-from-vertices face-vertices))) bod) ) -|# -;; 2014.5.21 add Henry Baker's contribution of 2013.8.31 -(defun make-body-from-vertices (face-vertices &optional (klass *body-class*)) - ; face-vertices=(list #f(x1 y1 z1) #f(x2 y2 z2) ...) ... - (let* ((vlist (mapcar #'list - (remove-duplicates - (apply #'append face-vertices) - :test #'equal))) - (vhash (make-hash-table :size (* 2 (length vlist)) :test #'equal)) - faces bod) - (dolist (vlist-entry vlist) ; Populate hash table. - (or (gethash (car vlist-entry) vhash) - (setf (gethash (car vlist-entry) vhash) vlist-entry))) - (dolist (fverts face-vertices) - (let ((fvlist)) - (dolist (fv fverts) - ;; (push (assoc fv vlist) fvlist) - ;; (push (assoc fv vlist :test #'equal) fvlist) ; *** Too slow !!! *** - (push (gethash fv vhash) fvlist)) - (push (make-face-from-vertices (nreverse fvlist)) faces)) ) - (setq bod (instance *body-class* :init :faces (nreverse faces))) - (send bod :csg (list (cons :body-from-vertices face-vertices))) - bod) ) diff --git a/lisp/l/common.l b/lisp/l/common.l index 40c4385fa..d2c8fa35f 100644 --- a/lisp/l/common.l +++ b/lisp/l/common.l @@ -620,29 +620,9 @@ if pos is bigger than the length of list, item is nconc'ed at the tail" ((memq (car l) (cdr l)) (unique (cdr l))) (t (cons (car l) (unique (cdr l)))))) -#| (defun remove-duplicates (seq &key (test #'eq) (test-not) (key #'identity) (start 0) (end 1000000)) (system::raw-remove-duplicates seq test test-not key start end)) -|# -;; 2014.5.21 add Henry Baker's contribution of 2013.7.22, 2013.8.31 -(defun remove-duplicates (seq &key (key #'identity) - (test #'eq) (test-not) - (start 0) (end (length seq))) - (if (and (or (eq test #'eq) (eq test #'eql) (eq test #'equal)) - (> end 100)) - (let* ((htab (make-hash-table :size (* 2 (length seq)) :test test))) - (let* ((res - (remove-if - #'(lambda (k) - (let* ((v (gethash k htab))) - (unless v (setf (gethash k htab) t)) - v)) - seq - :start start :end end :key key))) - res)) - (system::raw-remove-duplicates seq test test-not key start end))) - (defun extream (seq test &optional (key #'identity)) (if (null seq)