Commit 4fd5f47b authored by Dave Cooper's avatar Dave Cooper

added ifs-output data for cone and cylinder.

parent 7bdc1be9
# Lines starting with '#' are considered comments.
# Ignore any file named foo.txt.
*.fasl
*.xfasl
bin
*~
.DS_Store
......
......@@ -28,19 +28,46 @@
:radius-1 2 :radius-2 0.5)
(traffic-cone :type 'traffic-cone
:center (translate (the center) :left 5 :up (half (the-child length)))
:orientation (alignment :rear (the (face-normal-vector :top)))
:length 1
:radius 0.5
:radius-1 0.5
;;:arc pi
)
(silo :type 'silo
:radius 1
:arc (* 3/2 pi)
;;:arc (* 3/2 pi)
:length 5
:orientation (alignment :rear (the (face-normal-vector :top)))
:center (translate (the center) :right 4 :rear 12 :top (half (the-child length))))))
(define-object silo (cylinder)
:computed-slots ((display-controls (list :color :blue))))
(define-object traffic-cone (cone)
:computed-slots ((display-controls (list :color :yellow))))
(define-object silo (base-object)
:input-slots (radius)
:computed-slots ((display-controls (list :color :blue)))
:objects
((roof :type 'sphere
:display-controls (list :color :yellow)
:center (translate (the center) :rear (half (the length)))
:pass-down (radius))
(tower :type 'cylinder
:pass-down (radius length))))
(define-object teepee (cone)
:computed-slots ((display-controls (list :color :brown))))
:computed-slots ((display-controls (list :color :brown))
(bottom-cap? nil)
(closed? t)))
(define-object tree (cone)
......
......@@ -164,7 +164,7 @@ Removing output function: ~a for view of format: ~a on object definition: ~s wit
,(if has-declare? (first body) `(declare))
(block ,(make-keyword attr-sym) ,@(if has-declare? (rest body) body))) ,args-arg))))
(declare (ignorable ,method))
(eval-when (compile load eval) (glisp:begin-redefinitions-ok))
(eval-when (:compile-toplevel :load-toplevel :execute) (glisp:begin-redefinitions-ok))
,(when (and *compile-for-dgdl?* (not remote?))
`(defmethod ,attr-sym ((format ,format) (self gdl-remote) (skin ,skin) &rest ,args-arg)
,(when (and *compile-documentation-database?* attr-remarks) attr-remarks)
......@@ -173,7 +173,7 @@ Removing output function: ~a for view of format: ~a on object definition: ~s wit
(block ,(make-keyword attr-sym)
(the (send-output (:apply (cons ,(make-keyword attr-sym)
(cons *%format%* ,args-arg))))))))))
(eval-when (compile load eval) (glisp:end-redefinitions-ok))
(eval-when (:compile-toplevel :load-toplevel :execute) (glisp:end-redefinitions-ok))
,(when (and *compile-documentation-database?* attr-remarks)
`(when *load-documentation-database?* (setf (documentation ,method nil) ,attr-remarks))))))))
......
......@@ -21,7 +21,7 @@
(in-package :geom-base)
(define-object cone (cylinder ifs-output-mixin)
(define-object cone ( cylinder)
:documentation (:description "A pyramid with a circular cross section, with its vertex above
the center of its base. Partial cones and hollow cones are supported."
......@@ -46,8 +46,10 @@ the center of its base. Partial cones and hollow cones are supported."
(
("Number. The radius of the top end of the cone."
radius-1 (the :radius))
("Number. The radius of the bottom end of the cone."
radius-2 (the :radius))
radius-2 0)
("Number. The radius of the inner hollow part at the top end for a hollow cone."
inner-radius-1 (the :inner-radius))
("Number. The radius of the inner hollow part at the bottom end for a hollow cone."
......@@ -58,10 +60,11 @@ the center of its base. Partial cones and hollow cones are supported."
((width (twice (max (the radius-1) (the radius-2))))
(height (the width))
(polygons-for-ifs (when (or (the inner-radius)
(not (zerop (the radius-2)))
(not (near-to? (the arc) 2pi)))
(the %polygons-for-ifs%)))))
(simple? (and (not (the inner-radius))
(zerop (the radius-2))
(near-to? (the arc) 2pi)))
))
......@@ -22,7 +22,7 @@
(in-package :geom-base)
(define-object cylinder (arcoid-mixin base-object)
(define-object cylinder (ifs-output-mixin arcoid-mixin base-object)
:documentation (:description "An extrusion of circular cross section in which the
centers of the circles all lie on a single line (i.e., a right circular cylinder).
......@@ -68,6 +68,10 @@ Partial cylinders and hollow cylinders are supported."
(radius-1 (the :radius))
(radius-2 (the :radius))
("Boolean. Indicates that a partial cylinder (or cone) should have a closed gap."
closed? nil)
(inner-radius-1 (the :inner-radius))
(inner-radius-2 (the :inner-radius))
(inner? nil)
......@@ -175,7 +179,28 @@ Partial cylinders and hollow cylinders are supported."
(list (if hollow? (the :inner-cylinder (:end-arcs 1) :end)
(the :end)) (the (:end-arcs 1) :end)))))
(center-line (list (the (:end-arcs 0) :center) (the (:end-arcs 1) :center))))
(center-line (list (the (:end-arcs 0) :center) (the (:end-arcs 1) :center)))
(polygons-for-ifs (unless (the simple?)
;;
;; FLAG -- For cones at least: fill in with more intermediate arcs, to get better aspect triangles.
;;
(let ((top-points (the (end-arcs 1) (equi-spaced-points (the number-of-sections))))
(bottom-points (the (end-arcs 0) (equi-spaced-points (the number-of-sections)))))
(append (mapcar #'(lambda(p1 p2 p3 p4) (list p1 p2 p4 p3))
top-points bottom-points (rest top-points) (rest bottom-points))
(when (the top-cap?) (list top-points))
(when (the bottom-cap?) (list bottom-points))
(when (the closed?) (list (list (first top-points)
(first bottom-points)
(lastcar bottom-points)
(lastcar top-points))))))))
(simple? (and (not (the inner-radius))
(near-to? (the arc) 2pi)))
)
:hidden-objects
......
......@@ -39,7 +39,7 @@
(write-the material-properties))
(when (getf (the display-controls) :linetype)
(write-the line-properties))))
(:IndexedFaceSet :creaseAngle "1.0"
(:IndexedFaceSet :creaseAngle "1.571"
:solid "false"
:coordIndex formatted-vertices
(:Coordinate :point (format nil "~{~a~^, ~}"
......@@ -367,14 +367,16 @@
(
(shape
()
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (write-the material-properties))
(:Cone :bottomRadius (the radius-1)
:topRadius (the radius-2)
:height (the length)
:bottom (when (the bottom-cap?) "TRUE")
))))))
(if (the simple?)
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (write-the material-properties))
(:Cone :bottomRadius (the radius-1)
:topRadius (the radius-2)
:height (the length)
:bottom (when (the bottom-cap?) "TRUE"))))
(call-next-method)))))
(define-lens (x3d sphere)()
......@@ -396,13 +398,15 @@
(
(shape
()
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (write-the material-properties))
(:Cylinder :radius (the radius)
:height (the length)))))
)
)
(if (the simple?)
(cl-who:with-html-output (*stream* nil :indent nil)
(:Shape
(:Appearance (write-the material-properties))
(:Cylinder :radius (the radius)
:height (the length))))
(call-next-method)))))
(define-lens (x3d box)()
:output-functions
......@@ -451,6 +455,7 @@
(:Shape
(:Appearance (write-the material-properties))
((:IndexedFaceSet :solid "false"
:creaseAngle "1.571"
:coordIndex (format nil "~{~{~a~^ ~}~^ -1 ~}" (the ifs-indices)))
((:Coordinate :point (format nil "~{~{~a~^ ~}~^ ~}"
(map 'list #'(lambda(point)
......
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