• Compute a point on a torus
• Compute polygons on the surface of a torus
• Make a torus
• Make the torus look better

Problem 1 - Compute a point on a torus

(define M_PI 3.14159265358979323846)

(define (compute-point-on-torus 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 (* (+ major-radius 
		  (* minor-radius (cos phi))) 
	       (cos theta)))
	 (y (* minor-radius (sin phi)))
	 (z (* (+ major-radius
		  (* minor-radius (cos phi)))
	       (sin theta))))
    (vector x y z)))

Problem 2 - Compute polygons on the surface of a torus

(load "ps3-1")

(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))))))))
      '()))

Problem 3 - Make a torus

(load "ps3-2")

; (trace compute-torus-polygons)
; (trace compute-point-on-torus)

;;; 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))
  (send root 'addChild hints)

  ;; crease angle value of 0.7 makes torus look smooth

  (send (send hints 'creaseAngle) 'setValue 0.7)  
  (define coords (new-SoCoordinate3))
  (send root 'addChild coords)
  (define mat (new-SoMaterial))
  (send root 'addChild mat)
  (define face-set (new-SoFaceSet))
  (send root 'addChild face-set)
  (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! (send coords 'point) 0 points)
	       (send (send coords 'point) 'setNum num-points)
	       (let loop
		   ((i 0))
		 (send (send face-set 'numVertices) 'set1Value i 4)
		 (if (< i (/ num-points 4))
		     (loop (1+ i))))
	       (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))))))

(define viewer (new-SoXtExaminerViewer))
(send viewer 'show)

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

Problem 4 - Make the torus look better

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

$Id: index.html,v 1.1 1996/01/10 17:22:28 kbrussel Exp kbrussel $