Commit 134dc859 authored by Dave Cooper's avatar Dave Cooper
Browse files

started adding test color and strings to hw assembly output

parent d4b9089b
This diff is collapsed.
......@@ -48,3 +48,36 @@
(register-test-definition 'b-spline-curve-test)
(define-object b-spline-curve-test-2 (base-object)
:input-slots
((control-points (list (make-point 0 0 0)
(make-point 2 3.0 0.0)
(make-point 4 2.0 0.0)
(make-point 5 0.0 0.0)
(make-point 4 -2.0 0.0)
(make-point 2 -3.0 0.0)
(make-point 0 0 0))))
:computed-slots ((child-orientation (alignment :rear (rotate-vector-d (the (face-normal-vector :rear))
45
(the (face-normal-vector :right))))))
:objects
((global-curve :type 'b-spline-curve
:degree 1
:control-points (the control-points)
:orientation (the child-orientation))
(local-curve :type 'b-spline-curve
:degree 1
:local? t
:control-points (the control-points)
:orientation (the child-orientation))))
......@@ -215,16 +215,45 @@
(define-object fitted-curve-test-4 (fitted-curve)
:input-slots
((degree 1))
:computed-slots
((smooth-corners? nil)
;;(parameterization :chordlength)
(degree 1)
(points (list (make-point -1 -2 0)
(make-point -1 2 0)
(make-point 1 2 0)
(make-point 1 -2 0)
(make-point -1 -2 0)))))
(dolist (symbol '(fitted-curve-test fitted-curve-test-2 fitted-curve-test-3 fitted-curve-test-4))
(register-test-definition symbol))
(define-object fitted-curve-test-local-global (base-object)
:computed-slots ((child-orientation (alignment :rear (rotate-vector-d (the (face-normal-vector :rear))
45
(the (face-normal-vector :right))))))
:objects
((local-degree-1 :type 'fitted-curve-test-4
:orientation (the child-orientation)
:local? t)
(local-degree-3 :type 'fitted-curve-test-4
:orientation (the child-orientation)
:local? t
:degree 3)
(global-degree-1 :type 'fitted-curve-test-4
:orientation (the child-orientation))
(global-degree-3 :type 'fitted-curve-test-4
:orientation (the child-orientation)
:degree 3)))
......@@ -129,12 +129,17 @@ If any of the weights are different from 1.0, it is Rational."
Default is a value of 1.0 for each weight, resulting in a nonrational curve."
weights (make-list (length (the control-points)) :initial-element 1.0))
("Boolean. Indicates whether the inputted control-points should be considered in local coordinate system of this object. Default is nil."
local? nil)
(surface nil)
)
:computed-slots
((native-curve (make-b-spline-curve *geometry-kernel* (the control-points)
((native-curve (make-b-spline-curve *geometry-kernel* (if (the local?)
(mapcar #'(lambda(point) (the (local-to-global point)))
(the control-points))
(the control-points))
(mapcar #'to-double-float (the weights)) (the degree) (the knot-vector) ))
......
......@@ -193,10 +193,11 @@ built-from curve, if one exists, otherwise defaults to the *display-tolerance*."
(%lines-to-draw% (cond ((and (= (the degree) 1) (not (the rational?)))
(mapcar #'(lambda(start end)
(list start end))
(the control-points)
(rest (the control-points))))
(let ((control-points (the b-spline-data)))
(mapcar #'(lambda(start end)
(list start end))
control-points
(rest control-points))))
(*curve-tessellation?*
(let ((points (the (equi-spaced-points
(max 2 (floor (* (the total-length) )))))))
......
......@@ -85,10 +85,21 @@ A <tt>nil</tt> value indicates that no data reduction is to be attempted. Defaul
interpolant? t)
(knot-multiplicity :multiple)
)
("Boolean. Indicates whether the inputted control-points should be considered in local coordinate system of this object. Default is nil."
local? nil))
:computed-slots
((native-curve
((effective-points (if (the local?)
(mapcar #'(lambda(point) (the (local-to-global point))) (the points))
(the points)))
(effective-vectors (if (the local?)
(mapcar #'(lambda(vector) (the (local-to-global vector))) (the vectors))
(the vectors)))
(native-curve
(progn
(when (and (the vectors)
(member (the vector-type) (list :tangents :normals))
......@@ -104,7 +115,7 @@ A <tt>nil</tt> value indicates that no data reduction is to be attempted. Defaul
(unless degree-ok?
(error "The degree of a fitted-curve must be less than or equal to the number of control points."))
(interpolate-curve
*geometry-kernel* (the points) (the degree) (the parameterization) :vectors (the vectors)
*geometry-kernel* (the effective-points) (the degree) (the parameterization) :vectors (the effective-vectors)
:vector-type (the vector-type) :interpolant? (the interpolant?)
:knot-multiplicity (the knot-multiplicity)
:tolerance (the tolerance)))
......
......@@ -43,6 +43,7 @@
(cad-output-assembly-tree (&optional (assembly-instance (let ((assembly (make-assembly-instance)))
(set-format-slot assembly assembly)
assembly)))
(dolist (child (the children))
(if (the-object child children)
;;
......@@ -52,14 +53,11 @@
;; FLAG -- add object also in case there is actual geometry here.
;;
(let ((child-assembly-instance (make-assembly-instance)))
(write-the-object child (cad-output-assembly-tree child-assembly-instance))
(smlib::hwassembly-addsubassembly (smlib::hwstdautoptr-hwassemblyinstance-getassembly
assembly-instance)
child-assembly-instance)
)
child-assembly-instance))
;;
;; Add objects
......@@ -85,6 +83,13 @@
(define-lens (nurbs brep) ()
:output-functions
((cad-output-assembly (assembly-instance)
(smlib::iwaobject-addname (the %native-brep%)
(smlib::iw-context *geometry-kernel*)
(uffi:with-cstring (cstring "hey now")
cstring))
(smlib::iwaobject-addcolor (the %native-brep%)
(smlib::iw-context *geometry-kernel*)
1.0 0.0 0.0)
(smlib::hwassembly-addbrep (smlib::hwstdautoptr-hwassemblyinstance-getassembly assembly-instance)
(the %native-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