Merge pull request #36 from k-okada/revert_21

revert Henry Baker's contribution of 2013 July, this breaks test code
euslisp · Jun 24, 2014 · 0f40893 · 0f40893
2 parents ad4efb6 + 6bc76c2
commit 0f40893
Show file tree

Hide file tree

Showing 2 changed files with 1 addition and 44 deletions.
diff --git 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
@@ -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)