Commit 11d58265 authored by Dave Cooper's avatar Dave Cooper

added docs for cardinal, fixed bug in global-filleted-polyine when given only 2 vertex points.

parent 330fa5ce
...@@ -102,7 +102,8 @@ ...@@ -102,7 +102,8 @@
(set-frame-font (set-frame-font
(format (format
(case system-type (case system-type
(darwin "-apple-Courier_New-medium-normal-normal-*-%s-*-*-*-m-0-iso10646-1") (darwin "-*-Courier New-normal-normal-normal-*-%s-*-*-*-m-0-iso10646-1" ;; -apple-Courier_New-medium-normal-normal-*-%s-*-*-*-m-0-iso10646-1"
)
(windows-nt "-outline-Courier New-normal-normal-normal-mono-%s-*-*-*-c-*-iso8859-1") (windows-nt "-outline-Courier New-normal-normal-normal-mono-%s-*-*-*-c-*-iso8859-1")
(gnu/linux "-bitstream-Courier 10 Pitch-normal-normal-normal-*-%s-*-*-*-m-0-iso10646-1")) (gnu/linux "-bitstream-Courier 10 Pitch-normal-normal-normal-*-%s-*-*-*-m-0-iso10646-1"))
font-size)))) font-size))))
...@@ -196,6 +197,7 @@ ...@@ -196,6 +197,7 @@
(defvar gdl-startup-string nil) (defvar gdl-startup-string nil)
(setq gdl-startup-string (setq gdl-startup-string
(format (format
"(progn (unless (find-package :gendl) "(progn (unless (find-package :gendl)
......
...@@ -79,23 +79,30 @@ filleted-polyline." ...@@ -79,23 +79,30 @@ filleted-polyline."
(%renderer-info% (list :vrml? t :view-default :top)) (%renderer-info% (list :vrml? t :view-default :top))
(path-info (append (path-info (cond
(let ((first? t)) ((null (rest (the vertex-list)))
(mapcan (error "Vertex-list must contain at least two points."))
#'(lambda(straight curve-set)
(append (if first? (progn (setq first? nil) ((null (rest (rest (the vertex-list))))
(list :move (first straight) (list :move (first (the vertex-list)) :line (second (the vertex-list))))
:line (second straight)))
(list :line (second straight))) (t (append
(let ((first? t))
(apply #'append (mapcan
(mapcar #'(lambda(curve) #'(lambda(straight curve-set)
(cons :curve (rest (reverse curve)))) (append (if first? (progn (setq first? nil)
(reverse (the-object curve-set %curves-to-draw%)))))) (list :move (first straight)
(the straights) (list-elements (the fillets)))) :line (second straight)))
(list :line (second straight)))
(when (> (length (the straights)) (the fillets number-of-elements))
(list :line (second (lastcar (the straights))))))) (apply #'append
(mapcar #'(lambda(curve)
(cons :curve (rest (reverse curve))))
(reverse (the-object curve-set %curves-to-draw%))))))
(the straights) (list-elements (the fillets))))
(when (> (length (the straights)) (the fillets number-of-elements))
(list :line (second (lastcar (the straights)))))))))
(fillet-types (mapcar #'(lambda(test) (fillet-types (mapcar #'(lambda(test)
(if (the-object test valid?) 'fillet 'null-part)) (if (the-object test valid?) 'fillet 'null-part))
......
...@@ -22,10 +22,11 @@ ...@@ -22,10 +22,11 @@
(in-package :geom-base) (in-package :geom-base)
(define-object outline-specialization-mixin (base-object) (define-object outline-specialization-mixin (base-object)
:input-slots
((outline-objects (the hidden-children)))
:computed-slots :computed-slots
((outline-objects (the hidden-children)) ((local-box (bounding-box-from-list (the outline-objects)))
(local-box (bounding-box-from-list (the outline-objects)))
(outline-leaves (apply #'append (outline-leaves (apply #'append
......
This diff is collapsed.
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -30,7 +30,7 @@ to a Catmull-Rom Spline for nil tension-params (which means they all ...@@ -30,7 +30,7 @@ to a Catmull-Rom Spline for nil tension-params (which means they all
default to 0.0)." default to 0.0)."
:author "Dave Cooper, Genworks International") :author "Dave Cooper, Genworks International")
:input-slots (through-points :input-slots ("List of 3D Points. The points through which the curve will pass." through-points
(tension-params nil) (tension-params nil)
("Boolean. Indicates whether the curve should close back to its start point. Default is <tt>nil</tt>." ("Boolean. Indicates whether the curve should close back to its start point. Default is <tt>nil</tt>."
periodic? nil) periodic? nil)
......
...@@ -69,10 +69,12 @@ into a single curve." ...@@ -69,10 +69,12 @@ into a single curve."
(if (< (the fillet-curves number-of-elements) (the straight-curves number-of-elements)) (if (< (the fillet-curves number-of-elements) (the straight-curves number-of-elements))
(cons (the straight-curves last) tail) tail))) (cons (the straight-curves last) tail) tail)))
(fillet-curve-types (mapcar #'(lambda(fillet-index) (fillet-curve-types (let ((number-of-fillets (the fillets number-of-elements)))
(if (typep (the (fillets fillet-index)) 'geom-base::fillet) (unless (zerop number-of-fillets)
'arc-curve 'null-part)) (mapcar #'(lambda(fillet-index)
(list-of-numbers 0 (1- (the fillets number-of-elements)))))) (if (typep (the (fillets fillet-index)) 'geom-base::fillet)
'arc-curve 'null-part))
(list-of-numbers 0 (1- number-of-fillets)))))))
:hidden-objects :hidden-objects
(("GDL Sequence of GDL NURBS curve objects. The arc-curves representing the fillets." (("GDL Sequence of GDL NURBS curve objects. The arc-curves representing the fillets."
......
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