• Compute a point on a torus
• Make a FaceSet torus
• Make the torus look better
• Make a QuadMesh torus

Problem 1 - Compute a point on a torus

(define M_PI 3.14159265358979323846)

(define (compute-torus-major-vector major-radius
				    x-res
				    x-index)
  (let* ((theta (* (* 2.0 M_PI) (/ x-index x-res)))
	 (x (* major-radius (cos theta)))
	 (y 0.0)
	 (z (* major-radius (sin theta))))
    (new-SbVec3f x y z)))
    
(define (compute-torus-minor-vector major-radius
				    minor-radius
				    x-res
				    y-res
				    x-index
				    y-index)
  (let* ((theta (* (* 2.0 M_PI) (/ x-index x-res)))
	 (phi (* (* 2.0 M_PI) (/ y-index y-res)))
	 (x (* (* minor-radius (cos phi))
	       (cos theta)))
	 (y (* minor-radius (sin phi)))
	 (z (* (* minor-radius (cos phi))
	       (sin theta))))
    (new-SbVec3f x y z)))

(define (compute-point-on-torus major-radius
				minor-radius
				x-res
				y-res
				x-index
				y-index)
  (let ((major-vector (compute-torus-major-vector major-radius
						  x-res
						  x-index))
	(minor-vector (compute-torus-minor-vector major-radius
						  minor-radius
						  x-res
						  y-res
						  x-index
						  y-index)))
    (-> major-vector 'operator+ minor-vector)))

Problem 2 - Make a FaceSet torus

(load "ps3-1")

;; compute-torus-polygons was given in the problem set
(define (compute-torus-polygons major-radius
				minor-radius
				x-res
				y-res
				x-index
				y-index)
  (if (not (= y-index y-res))
      (begin
	(let ((p1 (compute-point-on-torus major-radius
					  minor-radius
					  x-res
					  y-res
					  x-index
					  y-index))
	      (p2 (compute-point-on-torus major-radius
					  minor-radius
					  x-res
					  y-res
					  x-index
					  (1+ y-index)))

	      (p3 (compute-point-on-torus major-radius
					  minor-radius
					  x-res
					  y-res
					  (1+ x-index)
					  (1+ y-index)))
	      (p4 (compute-point-on-torus major-radius
					  minor-radius
					  x-res
					  y-res
					  (1+ x-index)
					  y-index)))
	  (if (= x-index (- x-res 1))
	      (cons p1 
		    (cons p2 
			  (cons p3 
				(cons p4
				      (compute-torus-polygons
				         major-radius
					 minor-radius
					 x-res
					 y-res
					 0
					 (1+ y-index))))))
	      (cons p1
		    (cons p2
			  (cons p3
				(cons p4
				      (compute-torus-polygons
				         major-radius
					 minor-radius
					 x-res
					 y-res
					 (1+ x-index)
					 y-index))))))))
      '()))

;;; SICP-ish simple object system for dealing similarly
;;; with Scheme and C++ objects using "send"

(define (send object message . args)
  (if (C++-object? object)
      (eval `(-> ,object ',message ,@args))
      (let ((method (get-method object message)))
	(if (not (no-method? method))
	    (apply method (cons object args))
	    (error "No method named" message)))))

(define (get-method object message)
  (object message))

(define (no-method method)
  'no-method)

(define (no-method? method)
  (eq? method 'no-method))

(define (new-Torus major-radius 
		   minor-radius
		   x-res
		   y-res)
  (define root (new-SoSeparator))
  (send root 'ref)
  (define hints (new-SoShapeHints))
  (define coords (new-SoCoordinate3))
  (define mat (new-SoMaterial))
  (define face-set (new-SoFaceSet))

  (send root 'addChild hints)
  (send (send hints 'creaseAngle) 'setValue 0.5)
  (send (send hints 'shapeType) 'setValue
	SoShapeHints::SOLID)
  (send (send hints 'vertexOrdering) 'setValue
	SoShapeHints::COUNTERCLOCKWISE)
  (send root 'addChild coords)
  (send root 'addChild mat)
  (send root 'addChild face-set)
  (let ((self
	 (lambda (message)
	   (cond ((eq? message 'getGeometry)
		  (lambda (self)
		    root))

		 ((eq? message 'generate)
		  (lambda (self)
		    (let* ((points (compute-torus-polygons major-radius
							   minor-radius
							   x-res
							   y-res
							   0
							   0))
			   (num-points (length points)))

		      ;; set-mfield-values! sets the values of the passed
		      ;; mfield, starting at the given index, from the
		      ;; passed list of values.
		      ;; Note that the elements of this list must be valid
		      ;; objects for use in the set1Value method.
		      (set-mfield-values! (send coords 'point) 0 points)
		      ;; Truncate list if necessary (i.e., when
		      ;; reducing resolution)
		      (send (send coords 'point) 'setNum num-points)

		      ;; update the values in the face set: 
		      ;; (num-points / 4) polygons of four vertices each.
		      (let loop
			  ((i 0))
			(send (send face-set 'numVertices) 'set1Value i 4)
			(if (< i (/ num-points 4))
			    (loop (1+ i))))
		      ;; Truncate numVertices as well, if necessary
		      (send (send face-set 'numVertices) 'setNum
			    (/ num-points 4)))))
		 
		 ((eq? message 'setColor)
		  (lambda (self r g b)
		    (send (send mat 'diffuseColor) 'setValue r g b)))

		 ((eq? message 'setCreaseAngle)
		  (lambda (self new-angle)
		    (send (send hints 'creaseAngle) 'setValue new-angle)))

		 ((eq? message 'setVertexOrdering)
		  (lambda (self new-ordering)
		    (send (send hints 'vertexOrdering)
			  'setValue new-ordering)))

		 ((eq? message 'setShapeType)
		  (lambda (self new-type)
		    (send (send hints 'shapeType) 'setValue new-type)))

		 ((eq? message 'setMajorRadius)
		  (lambda (self new-major-radius)
		    (set! major-radius new-major-radius)
		    (send self 'generate)))

		 ((eq? message 'setMinorRadius)
		  (lambda (self new-minor-radius)
		    (set! minor-radius new-minor-radius)
		    (send self 'generate)))

		 ((eq? message 'setHorizResolution)
		  (lambda (self new-horiz-res)
		    (set! x-res new-horiz-res)
		    (send self 'generate)))

		 ((eq? message 'setVertResolution)
		  (lambda (self new-vert-res)
		    (set! y-res new-vert-res)
		    (send self 'generate)))

		 (else (no-method message))))))

    ;;; Initialization code goes here
    (send self 'generate) ;; generate when first constructed
    self))

(define my-torus (new-Torus 10.0 3.0 20 10))
(define viewer (examiner (send my-torus 'getGeometry)))

Problem 3 - Make the torus look better

The solution for this problem is included in the above torus object.

Problem 4 - Make a QuadMesh torus

(load "ps3-1")

;; compute-torus-points was given in the problem set
(define (compute-torus-points major-radius
			      minor-radius
			      x-res
			      y-res)
  (define (vert-loop vert-step horiz-step)
    (if (<= vert-step y-res)
	(cons (compute-point-on-torus major-radius 
				      minor-radius
				      x-res
				      y-res
				      horiz-step
				      vert-step)
	      (vert-loop (1+ vert-step) horiz-step))
	'()))
  (define (horiz-loop step)
    (if (<= step x-res)
	(cons (vert-loop 0 step)
	      (horiz-loop (1+ step)))
	'()))
  (let ((slices-list (horiz-loop 0)))
    (apply append slices-list)))

;;; SICP-ish simple object system for dealing similarly
;;; with Scheme and C++ objects using "send"

(define (send object message . args)
  (if (C++-object? object)
      (eval `(-> ,object ',message ,@args))
      (let ((method (get-method object message)))
	(if (not (no-method? method))
	    (apply method (cons object args))
	    (error "No method named" message)))))

(define (get-method object message)
  (object message))

(define (no-method method)
  'no-method)

(define (no-method? method)
  (eq? method 'no-method))

(define (new-Torus major-radius 
		   minor-radius
		   x-res
		   y-res)
  (define root (new-SoSeparator))
  (send root 'ref)
  (define hints (new-SoShapeHints))
  (define coords (new-SoCoordinate3))
  (define mat (new-SoMaterial))
  (define quad-mesh (new-SoQuadMesh))

  (send root 'addChild hints)
  (send (send hints 'creaseAngle) 'setValue 0.5)
  (send (send hints 'shapeType) 'setValue
	SoShapeHints::SOLID)
  (send (send hints 'vertexOrdering) 'setValue
	SoShapeHints::CLOCKWISE)
  (send root 'addChild coords)
  (send root 'addChild mat)
  (send root 'addChild quad-mesh)
  (let ((self
	 (lambda (message)
	   (cond ((eq? message 'getGeometry)
		  (lambda (self)
		    root))

		 ((eq? message 'generate)
		  (lambda (self)
		    (let* ((points (compute-torus-points major-radius
							 minor-radius
							 x-res
							 y-res))
			   (num-points (length points)))
		      ;; Same code as in ps3-2
		      (set-mfield-values! (send coords 'point) 0 points)
		      (send (send coords 'point) 'setNum num-points)
		      ;; Set up the verticesPerRow and verticesPerColumn
		      ;; fields for the QuadMesh node.
		      (send (send quad-mesh 'verticesPerRow) 'setValue
			    (1+ y-res))
		      (send (send quad-mesh 'verticesPerColumn) 'setValue
			    (1+ x-res)))))
		 
		 ((eq? message 'setColor)
		  (lambda (self r g b)
		    (send (send mat 'diffuseColor) 'setValue r g b)))

		 ((eq? message 'setCreaseAngle)
		  (lambda (self new-angle)
		    (send (send hints 'creaseAngle) 'setValue new-angle)))

		 ((eq? message 'setVertexOrdering)
		  (lambda (self new-ordering)
		    (send (send hints 'vertexOrdering)
			  'setValue new-ordering)))

		 ((eq? message 'setShapeType)
		  (lambda (self new-type)
		    (send (send hints 'shapeType) 'setValue new-type)))

		 ((eq? message 'setMajorRadius)
		  (lambda (self new-major-radius)
		    (set! major-radius new-major-radius)
		    (send self 'generate)))

		 ((eq? message 'setMinorRadius)
		  (lambda (self new-minor-radius)
		    (set! minor-radius new-minor-radius)
		    (send self 'generate)))

		 ((eq? message 'setHorizResolution)
		  (lambda (self new-horiz-res)
		    (set! x-res new-horiz-res)
		    (send self 'generate)))

		 ((eq? message 'setVertResolution)
		  (lambda (self new-vert-res)
		    (set! y-res new-vert-res)
		    (send self 'generate)))

		 (else (no-method message))))))

    ;;; Initialization code goes here
    (send self 'generate) ;; generate when first constructed
    self))

(define my-torus (new-Torus 10.0 3.0 20 10))
(define viewer (examiner (send my-torus 'getGeometry)))

$Id: index.html,v 1.5 1997/01/10 18:42:05 kbrussel Exp $