1/13/97

Problems
Problem 1 - Compute a point on a torus

(define M_PI 3.14159265358979323846)

x-res
x-index)
(let* ((theta (* (* 2.0 M_PI) (/ x-index x-res)))
(y 0.0)
(new-SbVec3f x y z)))

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)))
(z (* (* minor-radius (cos phi))
(sin theta))))
(new-SbVec3f x y z)))

x-res
y-res
x-index
y-index)
x-res
x-index))
x-res
y-res
x-index
y-index)))
(-> major-vector 'operator+ minor-vector)))
Problem 2 - Make a FaceSet torus

;; compute-torus-polygons was given in the problem set
x-res
y-res
x-index
y-index)
(if (not (= y-index y-res))
(begin
x-res
y-res
x-index
y-index))
x-res
y-res
x-index
(1+ y-index)))

x-res
y-res
(1+ x-index)
(1+ y-index)))
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
x-res
y-res
0
(1+ y-index))))))
(cons p1
(cons p2
(cons p3
(cons p4
(compute-torus-polygons
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))

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 (send hints 'creaseAngle) 'setValue 0.5)
(send (send hints 'shapeType) 'setValue
SoShapeHints::SOLID)
(send (send hints 'vertexOrdering) 'setValue
SoShapeHints::COUNTERCLOCKWISE)
(let ((self
(lambda (message)
(cond ((eq? message 'getGeometry)
(lambda (self)
root))

((eq? message 'generate)
(lambda (self)
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)))

(send self 'generate)))

(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

;; compute-torus-points was given in the problem set
x-res
y-res)
(define (vert-loop vert-step horiz-step)
(if (<= vert-step y-res)
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))

x-res
y-res)
(define root (new-SoSeparator))
(send root 'ref)
(define hints (new-SoShapeHints))
(define coords (new-SoCoordinate3))
(define mat (new-SoMaterial))

(send (send hints 'creaseAngle) 'setValue 0.5)
(send (send hints 'shapeType) 'setValue
SoShapeHints::SOLID)
(send (send hints 'vertexOrdering) 'setValue
SoShapeHints::CLOCKWISE)
(let ((self
(lambda (message)
(cond ((eq? message 'getGeometry)
(lambda (self)
root))

((eq? message 'generate)
(lambda (self)
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.
(1+ y-res))
(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)))

(send self 'generate)))

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