Commit be2571d3 authored by Dave Cooper's avatar Dave Cooper

formatting and pseudo-inputs for surface primitives

parent 96bd9fb0
......@@ -4,6 +4,7 @@
*.fas
*.xfasl
*.dx64fsl
*.64xfasl
*.lib
bin
*~
......
......@@ -405,8 +405,9 @@ The error was: ~a
((:div :class "outer-south ui-widget pane")
((:div :class "footer ui-widget-header")
((:span :class "fltrt")
"powered by " ((:a :href "http://www.genworks.com" :target "_new")"Genworks GDL")
(if (glisp:featurep :smlib) ", " " and ")
"powered by "
((:a :href "http://www.genworks.com" :target "_new") "Genworks GDL")
(str (if (glisp:featurep :smlib) ", " " and "))
((:a :href "http://www.quicklisp.org" :target "_new")"Quicklisp")
(if (glisp:featurep :smlib)
(progn
......
......@@ -56,6 +56,28 @@ of the objects themselves is returned.
;; FLAG -- rewrite the following without using apply so we don't risk
;; hitting function argument limit.
;;
(defmacro append-elements (aggregate &optional expression filter)
"List of Objects [Macro]. Returns an appended list of <tt>expression</tt> from each element of an aggregate,
with an optional filter.
:arguments (aggregate \"GDL aggregate object. (e.g. from a <tt>:sequence (:size ..)</tt> <tt>:object</tt> specification).\")
:&optional (expression \"Expression using <tt>the-element</tt>. Similar to a <tt>the-object</tt> reference, which should return a list.\")"
(unless expression (error "append-elements requires an expression keyword argument, using the-element.~%"))
(let ((result (gensym)) (value (gensym)))
`(let ((,result nil))
(dolist (%object% (the-object ,aggregate :list-elements))
(let ((,value ,expression))
(let ((,value (funcall (or ,filter #'identity) ,value)))
(if (null ,result)
(setq ,result ,value)
(nconc ,result ,value)))))
,result)))
#+nil
(defmacro append-elements (aggregate &optional expression filter)
"List of Objects [Macro]. Returns an appended list of <tt>expression</tt> from each element of an aggregate,
with an optional filter.
......
......@@ -79,38 +79,44 @@ then this defaults to the approximation-tolerance-adaptive."
(define-object boolean-merge (boolean-tolerance-mixin brep)
:documentation (:description "Generalized Merge container for doing boolean operations. This is not to be used directly, but is
mixed into subtracted-solid, united-solid, intersected-solid, and separated-solid.
The specific operation is specified in the respective subclass.")
:documentation (:description "Generalized Merge container for doing
boolean operations. This is not to be used directly, but is mixed
into subtracted-solid, united-solid, intersected-solid, and
separated-solid. The specific operation is specified in the respective
subclass.")
:input-slots
(
("GDL Brep object or object containing a brep. First of the breps to be merged"
brep nil)
"GDL Brep object or object containing a brep, or list of brep objects or object containing a brep.
Second (or rest) of the breps to be merged into the given <tt>brep</tt>"
other-brep
"GDL Brep object or object containing a brep, or list of brep
objects or object containing a brep. Second (or rest) of the breps to
be merged into the given <tt>brep</tt>"
other-brep
operation
("Boolean. If set to non-nil, throw warning but not error if any of the input breps has more than
one infinite region. Defaults to *boolean-allow-multiple-regions?*, which itself defaults to nil."
allow-multiple-regions? *boolean-allow-multiple-regions?*)
("Boolean. If set to non-nil, throw warning but not error if any of
the input breps has more than one non-infinite region. Defaults to
*boolean-allow-multiple-regions?*, which itself defaults to nil."
allow-multiple-regions? *boolean-allow-multiple-regions?*)
("Boolean. If set to non-nil, we throw an error instead of a warning if the resulting brep does not
pass the built-in validation test. If nil, we throw a warning but continue to return the resulting brep.
Defaults to *boolean-error-on-invalid-brep?* which itself defaults to t."
error-on-invalid? *boolean-error-on-invalid-brep?*)
("Boolean. If set to non-nil, we throw an error instead of a
warning if the resulting brep does not pass the built-in validation
test. If nil, we throw a warning but continue to return the resulting
brep. Defaults to *boolean-error-on-invalid-brep?* which itself
defaults to t." error-on-invalid? *boolean-error-on-invalid-brep?*)
("Number. Defaults to *angle-tolerance-radians-default*." angle-tolerance *angle-tolerance-radians-default*)
("Number. Defaults to *angle-tolerance-radians-default*."
angle-tolerance *angle-tolerance-radians-default*)
("Boolean. Indicates whether we should try to sew and orient the resulting brep. Usually a good idea
and this is defaulted to t, except for merged-solid where we default this to nil."
sew-and-orient? t)
("Boolean. Indicates whether we should try to sew and orient the
resulting brep. Usually a good idea and this is defaulted to t, except
for merged-solid where we default this to nil." sew-and-orient? t)
(manifold? t))
......@@ -122,7 +128,6 @@ and this is defaulted to t, except for merged-solid where we default this to nil
(%merge-and-brep
(progn
(when (or (> (the first-brep regions number-of-elements) 2)
(not (every #'(lambda(number) (<= number 2))
(mapcar #'(lambda(object) (the-object object regions number-of-elements))
......@@ -189,8 +194,6 @@ and this is defaulted to t, except for merged-solid where we default this to nil
;;
;;(tag-edges *geometry-kernel* current-brep (get-long *geometry-kernel* current-brep))
;;
(ecase (the operation)
((:difference :union :intersection :merge)
(list :merge-container merge-container :native-brep current-brep))
......@@ -204,18 +207,13 @@ and this is defaulted to t, except for merged-solid where we default this to nil
(not (every #'(lambda(number) (<= number 2))
(mapcar #'(lambda(object) (the-object object regions number-of-elements))
(the rest-breps)))))
(let ((message (format nil "~%~%in ~a -~%~%Attempting booleans where brep has ~~a non-infinite regions.~%"
(cons 'the (reverse (the root-path))))))
(if (the allow-multiple-regions?)
(warn message
(1- (the first-brep regions number-of-elements)))
(error message
(1- (the first-brep regions number-of-elements))))))
(warn message (1- (the first-brep regions number-of-elements)))
(error message (1- (the first-brep regions number-of-elements))))))
(if (and (the first-brep)
(null (the rest-breps)))
(if (and (the first-brep) (null (the rest-breps)))
(progn
(warn "Boolean operation invoked on a single brep, this has no effect and
returns the original brep.
......
......@@ -143,16 +143,20 @@ The default is T."
display-iso-curves-wireframe? (not *brep-wireframe-tessellation?*)
:settable)
("Boolean. Determines whether the tessellation grid-lines of the brep are used for wireframe display.
The default is NIL."
display-tessellation-lines-wireframe? *brep-wireframe-tessellation?*
:settable)
("Plist with keys :n-u and :n-v. The number of isoparametric curves to be displayed in each direction.
This value comes from the value of :isos on the display-controls if that exists, and defaults
to *isos-default* otherwise."
isos (getf (the display-controls) :isos *brep-isos-default*)
:defaulting :settable)
:settable)
("Boolean. Determines whether the tessellation grid-lines of the brep are used for wireframe display.
The default is NIL."
display-tessellation-lines-wireframe? *brep-wireframe-tessellation?*
:settable)
("Number. Overall tolerance for the created brep solid. Defaults to nil.
......
......@@ -24,7 +24,7 @@
(define-object region (geometry-kernel-object-mixin base-object)
:input-slots (%native-region%)
:input-slots (%native-region% %native-brep% brep)
:computed-slots ((%native-shells% (get-shells-from-region *geometry-kernel* (the %native-region%))))
......
......@@ -24,4 +24,4 @@
(define-object brep-shell (geometry-kernel-object-mixin base-object)
:input-slots (%native-shell%))
:input-slots (%native-shell% %native-brep% brep))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment