## 1/17/97

Problems
Problem 1 - Cannon fodder

```;;; Problem 4-1

(define root (new-SoSeparator))
(-> root 'ref)

(define cannon-sep (new-SoSeparator))

(define cannon-base (new-SoCube))
(-> (-> cannon-base 'width) 'setValue 4)

(define cannon-xform (new-SoTransform))
(-> (-> cannon-xform 'translation) 'setValue 0 4.0 0)

(define cannon-tube (new-SoCylinder))
(-> (-> cannon-tube 'height) 'setValue 6.0)

(define target-sep (new-SoSeparator))

(define target-manip (new-SoHandleBoxManip))
(-> (-> target-manip 'translation) 'setValue 5 15 2)

(define target-mat (new-SoMaterial))

(define target (new-SoSphere))
(-> (-> target 'radius) 'setValue 0.5)

;; Definition of callback which the field sensor uses.
;; Each time the translation field of the manipulator changes,
;; this function automatically gets called.

(define (field-sensor-cb data sensor)
(let* ((target-translation (-> (-> target-manip 'translation) 'getValue))
(x (-> target-translation 'operator-brackets 0))
(y (-> target-translation 'operator-brackets 1))
(z (-> target-translation 'operator-brackets 2)))
(if (< y 7.5)
(-> (-> target-mat 'diffuseColor) 'setValue 0.8 0.8 0.8)
(let ((target-dist (sqrt (+ (* x x) (* z z)))))
(if (> target-dist 1.5)
(-> (-> target-mat 'diffuseColor) 'setValue 0.8 0.8 0.8)
(-> (-> target-mat 'diffuseColor) 'setValue 0.8 0.2 0.2))))))

;; Creation of the sensor.
(define field-sensor (sensor new-SoFieldSensor field-sensor-cb))

;; Attaching the field sensor to the translation field
(-> field-sensor 'attach (-> target-manip 'translation))

;; Make a viewer
(define viewer (examiner root))
;; Set viewing mode
(-> viewer 'setViewing 0)
```
Problem 2 - User interface for the torus

```;;; Problem 4-2

;; Function which creates a new ValueSlider object ("constructor")

(define (new-ValueSlider min-value max-value current-value title)

;; build internal scene graph for ValueSlider

(define root (new-SoSeparator))
(send root 'ref)

;; SoFont node changes size of font used for SoText3

(define font (new-SoFont))
(send (send font 'size) 'setValue 0.5)

;; SoText3 node for the text this object will display

(define text (new-SoText3))
(send (send text 'justification) 'setValue SoText3::CENTER)
(send (send text 'string) 'set1Value 0 (new-SbString title))
(send (send text 'string) 'set1Value 1 (new-SbString (number->string current-value)))

;; Dragger which this object uses

(define dragger (new-SoTranslate1Dragger))
(send (send dragger 'translation) 'setValue current-value -1 0)

;; List of functions we will call when slider's value changes

(define callback-list '())

;; Message passing system

(let ((self
(lambda (message)

;; Methods:

(cond
((eq? message 'getGeometry)
(lambda (self)
root))

;; Returns the callback that the dragger will call when its
;; value changes. *NOTE* that because this function is scoped
;; You can't do this in C++ (without a lot of effort)!
((eq? message 'getValueChangedCallback)
(lambda (self)
(lambda (user-data dragger)
(send self 'updateValue))))

;; Function which ultimately gets called
;; whenever the dragger moves.

((eq? message 'updateValue)
(lambda (self)
(let* ((vec (send (send dragger 'translation) 'getValue))
;; Get horizontal component of translation
(new-value (send vec 'operator-brackets 0)))
(if (and (>= new-value min-value)
(<= new-value max-value)) ;; constrain dragger
;; between min and max
(set! current-value new-value) ;; if true already,
;; do nothing

;; NOTE: The first and last of the following 4 steps can
;; only be performed in Inventor 2.1 or above.
;; Because of this, and because of apparent problems with
;; calling the value changed callback from within itself,
;; we are using a motion callback and ignoring steps
;; 1 and 4 in the list below.

;; If dragger is beyond min or max, do the following:
;; 1. Disable value changed callbacks
;; 2. Set the dragger's translation using the setValue
;;    method on its translation field
;; 3. Set our internal notion of the current value
;;    appropriately
;; 4. Reenable value changed callbacks.

(begin
(if (< new-value min-value)
(begin
(set! current-value min-value)
(send (send dragger 'translation) 'setValue
min-value -1 0))
(begin
(set! current-value max-value)
(send (send dragger 'translation) 'setValue
max-value -1 0)))))

;; Always update text to our notion of the current value.
(send (send text 'string) 'set1Value 1
(new-SbString (number->string current-value)))

;; call output callbacks
(for-each
(lambda (callback)
(callback current-value))
callback-list))))

(lambda (self callback-function)
(set! callback-list (cons callback-function callback-list))))

((eq? message 'getValue)
(lambda (self)
current-value))

(else (no-method message))))))
;; Set up dragger callback
(void-cast (callback-info (send self 'getValueChangedCallback))))
self))

;;
;; Torus
;;

(define root (new-SoSeparator))
(send root 'ref)

(define my-torus (new-Torus 10.0 3.0 20 10))
(send root 'addChild (send my-torus 'getGeometry))
(define viewer (examiner root))
(send viewer 'setTitle "Torus Viewer")

;;
;; User Interface for torus
;;

(define slider-root (new-SoSeparator))
(send slider-root 'ref)

;; Definition of slider for controlling major radius of torus.

;; Transformation to keep some space between the sliders.

(define slider-xform1 (new-SoTransform))
(send (send slider-xform1 'translation) 'setValue 0 -2 0)

;; Slider for controlling minor radius (thickness) of torus

;; These size parameters were obtained experimentally

;; Viewer for torus controls.
;; Note usage of setViewing method to switch to the arrow icon
;; and setCameraType to get an orthographic (no perspective) view.

(define slider-viewer (new-SoXtExaminerViewer))
(send slider-viewer 'show)
(send slider-viewer 'setTitle "Torus Controls")
(send slider-viewer 'setViewing 0)
;; setCameraType must be called before setSceneGraph
(send slider-viewer 'setCameraType (SoOrthographicCamera::getClassTypeId))
(send slider-viewer 'setSceneGraph slider-root)
(send slider-viewer 'setSize (new-SbVec2s 1092 215))
(send (send (send slider-viewer 'getCamera) 'position)
'setValue 9.72287178039551 -1.46681797504425 7.15330982208252)
(send (send (SoOrthographicCamera-cast (send slider-viewer 'getCamera))
'height) 'setValue 4.33807563781738)

;; callback which changes torus' major radius size
(lambda (new-value)

;; callback which changes torus' minor radius size
(lambda (new-value)
```