Commit 09e999a0 authored by Dave Cooper's avatar Dave Cooper
Browse files

manually brought in hwassy-protect changes to 3 files.

parent 8e4b57f9
Loading
Loading
Loading
Loading
Loading
+40 −12
Original line number Diff line number Diff line
@@ -366,21 +366,49 @@ of this brep. Exact supported format will be documented here when ready."
   ;;
   (local-box (the bounding-box))
   
   (%native-faces% (get-faces-from-brep *geometry-kernel* (the %native-brep%)))
   
   (%native-edges% (get-edges-from-brep *geometry-kernel* (the %native-brep%)))
   
   (%native-regions% (get-regions-from-brep *geometry-kernel* (the %native-brep%)))
   
   (%native-shells% (get-shells-from-brep *geometry-kernel* (the %native-brep%)))
   
   (%native-vertices% (get-vertices-from-brep *geometry-kernel* (the %native-brep%)))
   (%native-faces%
    (progn
      (assert (not (smlib::null-pointer-p (the %native-brep%))))
      (let ((candidates 
	      (get-faces-from-brep *geometry-kernel* (the %native-brep%))))
	(mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates)
	candidates)))
   
   (%native-edges%
    (progn
      (assert (not (smlib::null-pointer-p (the %native-brep%))))
      (let ((candidates 
	      (get-edges-from-brep *geometry-kernel* (the %native-brep%))))
	(mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates)
	candidates)))
   
   (%native-regions%
    (progn
      (assert (not (smlib::null-pointer-p (the %native-brep%))))
      (let ((candidates 
	      (get-regions-from-brep *geometry-kernel* (the %native-brep%))))
	(mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates)
	candidates)))
   
   (%native-shells%
    (progn
      (assert (not (smlib::null-pointer-p (the %native-brep%))))
      (let ((candidates 
	      (get-shells-from-brep *geometry-kernel* (the %native-brep%))))
	(mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates)
	candidates)))
   
   (%native-vertices%
    (progn
      (assert (not (smlib::null-pointer-p (the %native-brep%))))
      (let ((candidates 
	      (get-vertices-from-brep *geometry-kernel* (the %native-brep%))))
	(mapc #'(lambda(candidate)(assert (not (smlib::null-pointer-p candidate)))) candidates)
	candidates)))
   
   (faces-ht (let ((ht (make-hash-table :size (the faces number-of-elements))))
               (dolist (face (list-elements (the faces)) ht)
                 (setf (gethash (the-object face %native-face%) ht) face))))
   
   )
                 (setf (gethash (the-object face %native-face%) ht) face)))))

  
  :objects
+31 −20
Original line number Diff line number Diff line
@@ -108,8 +108,13 @@
   (%reversed?% nil)
   (%derivative?% nil)

   (native-curve (when (the native-curve-iw)
                   (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw))))
   (native-curve
    (let ((curve (get-nurbs-from-curve *geometry-kernel* (the native-curve-iw))))
      (unless curve
	(warn "native-curve attempted from apparently null-pointer native-curve-iw~%

Root-path is ~s~%" (the root-path)))
      curve))
   
   
   ("GDL Curve object. The corresponding UV curve for the primary surface on which this curve lies, if any. If
@@ -204,7 +209,9 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*."
      (make-array (length beziers) :initial-contents beziers)))
   

   (%lines-to-draw% (cond ((and (= (the degree) 1) (not (the rational?)))
   (%lines-to-draw%
    (when (the success?)
      (cond ((and (= (the degree) 1) (not (the rational?)))
	     (let ((control-points (the b-spline-data)))
	       (mapcar #'(lambda(start end)
			   (list start end))
@@ -214,15 +221,17 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*."
             (let ((points (the (equi-spaced-points 
				 (max 2 (floor (* (the total-length) )))))))
               (mapcar #'list points (rest points))))
                          (t nil)))
            (t nil))))


   (%curves-to-draw%
    (when (the success?)
      (unless (or *curve-tessellation?*
		  (near-to? (the total-length) 0))
	(if (typep self 'arc-curve)
	    (call-next-method)
	    (if (or (the %decomposed?%) (= (the %decomposed% curves number-of-elements) 1))
	    (if (or (the %decomposed?%)
		    (= (the %decomposed% curves number-of-elements) 1))
		(unless (and (= (the degree) 1) (not (the rational?)))
		  (when (list-elements (the beziers))
		    (let (result)
@@ -235,14 +244,16 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*."
			    (setq result (the-object bezier %curves-to-draw%))
			    (nconc result (the-object bezier %curves-to-draw%)))))))
		(append-elements (the %decomposed% curves) 
				 (the-element %curves-to-draw%))))))

				 (the-element %curves-to-draw%)))))))

   ;;(closed? (coincident-point? (the start) (the end) :tolerance (the closed-tolerance)))
   (closed? (coincident-point? (the start) (the end)))
   
   ("Boolean. This will be t if the curve is generated successfully, nil otherwise."
    success? (when (the native-curve) t))
    success? (if (the native-curve) t
		 ;; warn automatically returns nil
		 (warn "Curve at ~s success? is nil"
		       (the root-path))))
   
   ("Number. The lowest parameter value of the underlying mathematical definition for this parametric curve"
    u-min (multiple-value-bind (min max) (the parameter-bounds)
+7 −1
Original line number Diff line number Diff line
@@ -76,7 +76,13 @@ surface object, it does not make a copy)"
   
   (%schedule-finalization?% t)
   
   (native-surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw)))
   (native-surface
    (let ((surface (get-nurbs-from-surface *geometry-kernel* (the native-surface-iw))))
      (unless surface
	(error "native-surface attempted from apparently null-pointer native-surface-iw

Root-path is ~s~%" (the root-path)))
      surface))
   
   (native-pointer nil)