Computer Graphics Workshop '96 Lecture Notes

1/24/96

Today's topics
Going over problem sets

Today we will go over a few of the problems from the problem sets; specifically, the construction of the ValueSlider object from problem set and the construction of the fly viewer. We will also see a simple example of texture mapping of "live" video onto an Inventor object.

Cannon Fodder - Winifred Xu

;;Class: Computer Graphics Workshop (IAP)
;;Problem Set #4-2
;;Date: Jan 20, 1996
;;Name: Winifred Xu

;;;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;; Problem #2: Cannon fodder
;; practice using sensors

(define ps4-2V (new-SoXtExaminerViewer))
(-> ps4-2V 'setTitle "ps4-2V")
(-> ps4-2V 'setBackgroundColor (new-SbColor 0.37 0.27 1))
(-> ps4-2V 'show)

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


(define cannon-sep (new-SoSeparator))
(-> root 'addChild cannon-sep)

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

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

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


(define target-sep (new-SoSeparator))
(-> root 'addChild target-sep)

(define target-manip (new-SoHandleBoxManip))
(-> target-sep 'addChild target-manip)
(-> (-> target-manip 'translation) 'setValue 5 15 0)

(define target-mat (new-SoMaterial))
(-> target-sep 'addChild target-mat)

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

(-> ps4-2V 'setSceneGraph root)
(-> ps4-2V 'setViewing 0)


;;functions used to extract x and z values..

(define (extract-x target-manip)
  (let* ((coord (-> (-> target-manip 'translation) 'getValue))
	 (x (vector-ref (-> coord 'getValue) 0)))
    x))

(define (extract-z target-manip)
  (let* ((coord (-> (-> target-manip 'translation) 'getValue))
	 (z (vector-ref (-> coord 'getValue) 2)))
    z))

;; now we define the sensor-cb-func.
(define (field-sensor-cb user-data sensor)
  (let* ((x-value (extract-x target-manip))
	 (z-value (extract-z target-manip))
	 (white-color (-> (-> target-mat 'diffuseColor) 
			  'setValue 0.8 0.8 0.8)))

    (if (and (< x-value 1) (> x-value -1))
	(if (and (< z-value 1) (> z-value -1))
	    (-> (-> target-mat 'diffuseColor) 'setValue 1 0 0)
	    white-color)
	white-color)))


;; set up callback
(define callback-info (new-SchemeSoCBInfo))
(-> callback-info 'ref)
(-> (-> callback-info 'callbackName) 'setValue "field-sensor-cb")

;; construct the sensor:
(define field-sensor (new-SoFieldSensor (get-scheme-sensor-cb)
					(void-cast callback-info)))

;; hook up the field sensor with
;; the target-manip's translation field:

(-> field-sensor 'attach (-> target-manip 'translation))
(-> ps4-2V 'render)

;; thought I do have to change the original values to (5 15 0) 
;; instead of (5 15 2) to make it easier..
ValueSlider - Elliot Waingold

;;************************
;; Value-slider demo
;; by Elliot Waingold
;; January 24, 1996
;;************************

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

;; Constructor for the new value slider object type
(define new-ValueSlider
  (lambda (min-value max-value current-value title)
    
    ;; List of functions to call when value changed
    (define callback-list '())
    
    ;; Build the new scene graph
    (define root (new-SoSeparator))
    (send root 'ref)

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

    ;; Centered text with title and value displayed
    (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)))
    (send root 'addChild text)

    ;; The actual dragger
    (define dragger (new-SoTranslate1Dragger))
    (send (send dragger 'translation) 'setValue current-value -1 0) 
    (send root 'addChild dragger)

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

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

	    ;; Called every time the dragger is moved by the mouse
	    ((eq? message 'updateValue)
	     (lambda (self)
	       (let ((x-val (send
			     (send
			      (send dragger 'translation)
			      'getValue)
			     'operator-brackets
			     0)))

		 ;; Check to see if dragger is
		 ;; moving beyond boundaries
		 (if (and (<= x-val max-value)
			  (>= x-val min-value))
		     (set! current-value x-val)

		     ;; Stop dragger from moving beyond boundaries
		     (begin
		       (if (< x-val 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))))))

	       ;; Update the displayed value
	       (send (send text 'string) 'set1Value 1
		     (new-SbString (number->string current-value)))

	       ;; Call all of the registered callbacks
	       (for-each (lambda (f) (f current-value)) callback-list)))
	     
	    ;; Create a callback info object given callback name
	    ((eq? message 'getCallbackInfo)
	     (lambda (self name)
	       (define cb-info (new-SchemeSoCBInfo))
	       (send cb-info 'ref)
	       (send (send cb-info 'callbackName) 'setValue
		     (new-SbString name))
	       cb-info))

	    ;; This is the motion (value changed)
	    ;; callback we want called
	    ((eq? message 'getValueChangedCallback)
	     (lambda (self)
	       (lambda (user-data dragger)
		 (send self 'updateValue))))

	    ;; Register the main motion (value changed) callback
	    ((eq? message 'addValueChangedCallback)
	     (lambda (self name)
	       (send dragger 'addMotionCallback
		     (get-scheme-dragger-cb)
		     (void-cast (send self 'getCallbackInfo name)))))

	    ;; Register a user-defined callback 
	    ((eq? message 'addOutputCallback)
	     (lambda (self callback-function)
	       (set! callback-list
		     (cons callback-function callback-list))))
	    
	    (else (no-method message))))))
			
(load "torus.scm") 
       
;; This demo code is from the solution...

;; viewer for torus

(define viewer (new-SoXtExaminerViewer))
(send viewer 'show)
(send viewer 'setTitle "Torus Viewer")

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

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

;; 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)
(send slider-viewer 'setCameraType
      (SoOrthographicCamera::getClassTypeId))

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

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

(define major-radius-slider (new-ValueSlider 5
					     20
					     10
					     "Major radius"))
(define major-radius-slider-callback
  (send major-radius-slider 'getValueChangedCallback))
(send major-radius-slider 'addValueChangedCallback
      "major-radius-slider-callback")
(send slider-root 'addChild
      (send major-radius-slider 'getGeometry))

;; Transformation to keep some space between the sliders.

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

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

(define minor-radius-slider (new-ValueSlider 0 10 3 "Minor radius"))
(define minor-radius-slider-callback
  (send minor-radius-slider 'getValueChangedCallback))
(send minor-radius-slider 'addValueChangedCallback
      "minor-radius-slider-callback")
(send slider-root 'addChild
      (send minor-radius-slider 'getGeometry))

;; These size parameters were obtained experimentally

(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
(define (torus-major-radius-callback new-value)
  (send my-torus 'setMajorRadius new-value))
;; adding this callback to the ValueSlider
(send major-radius-slider 'addOutputCallback
      torus-major-radius-callback)

;; callback which changes torus' minor radius size
(define (torus-minor-radius-callback new-value)
  (send my-torus 'setMinorRadius new-value))
;; adding this callback to the ValueSlider
(send minor-radius-slider 'addOutputCallback
      torus-minor-radius-callback)
Fly viewer - Elliot Waingold

;;**********************
;; Fly-Through Viewer
;; by Elliot Waingold
;; January 20, 1996
;;**********************

;; Build initial scene graph

(define root (new-SoSeparator))
(-> root 'ref)
(define cam-kit (new-SoCameraKit))
(-> root 'addChild cam-kit)
(define event-callback (new-SoEventCallback))
(-> root 'addChild event-callback)

;; Viewer is based on SoXtExaminerViewer
(define fly-viewer (new-SoXtExaminerViewer))
(-> fly-viewer 'setSceneGraph root)
(-> fly-viewer 'show)

;; Extract parts of camera kit for easy access

(define cam (SO_GET_PART cam-kit "camera" SoCamera))
(-> (-> cam 'nearDistance) 'setValue 1.0)
(-> (-> cam 'farDistance) 'setValue 10000.0)
(define fly-transform (SO_GET_PART cam-kit "transform" SoTransform))

;; Define/initialize global positioning matrices

(define rotate-matrix (new-SbMatrix))
(-> rotate-matrix 'makeIdentity)
(define translate-matrix (new-SbMatrix))
(-> translate-matrix 'makeIdentity)

;; Other random global variables

(define x-angle 0.0)
(define y-angle 0.0)
(define last-normalized-x 0.0)
(define last-normalized-y 0.0)

;; So we don't start until mouse is first in window
(define last-event #f)

;; Constants

(define pi 3.14159265358979)
(define max-angular-velocity (/ pi 50.0))
(define forward-increment -1)
(define forward-speed 3)
(define x-axis (new-SbVec3f 1 0 0))
(define y-axis (new-SbVec3f 0 1 0))

;; Callback routines

;; Everytime a mouse button is pressed...
(define (mouse-event-cb user-data event-node)
  (let ((event (-> event-node 'getEvent)))
    (if (= 1
	   (SO_MOUSE_PRESS_EVENT event BUTTON1))    ;; Left button
	(set! forward-speed (+ forward-speed forward-increment))  
	(if (= 1
	       (SO_MOUSE_PRESS_EVENT event BUTTON2));; Middle button
	    (set! forward-speed
		  (- forward-speed forward-increment))))))

;; Everytime the mouse location changes...
(define location-event-cb
  
  ;; Allocate some variables here, so we don't waste time doing 
  ;; so inside the callback.
  (let ((x-rotation (new-SbRotation))
	(y-rotation (new-SbRotation))
	(z-vec (new-SbVec3f))
	(x-rot-matrix (new-SbMatrix))
	(y-rot-matrix (new-SbMatrix))
	(temp-matrix (new-SbMatrix)))
    (lambda (user-data event-node)
      (let* ((event (-> event-node 'getEvent))
	     
	     ;; Find out where the mouse is (in normalized coords)...
	     (norm-pos (-> event 'getNormalizedPosition
			   (-> fly-viewer 'getViewportRegion)))
	     (x-pos (-> norm-pos 'operator-brackets 0))
	     (y-pos (-> norm-pos 'operator-brackets 1))
	     
	     ;; Calculate the increment to the rotation angles
	     (x-ang-update (* max-angular-velocity (- y-pos 0.5)))
	     (y-ang-update (* max-angular-velocity (- 0.5 x-pos))))
	(set! x-angle (+ x-angle x-ang-update))
	(set! y-angle (+ y-angle y-ang-update))
	
	;; Create the rotations and the motion vector
	(-> x-rotation 'setValue x-axis x-angle)
	(-> y-rotation 'setValue y-axis y-angle)
	(-> z-vec 'setValue 0 0 forward-speed)
	
	;; Convert the rotations to matrices and
	;; compose them into one
	(-> x-rot-matrix 'setRotate x-rotation)
	(-> y-rot-matrix 'setRotate y-rotation)
	(-> rotate-matrix 'operator=
	    (SbMatrix::operator* x-rot-matrix y-rot-matrix))
	
	;; Prepare the motion translation 
	(-> (-> rotate-matrix 'inverse) 'multMatrixVec z-vec z-vec)
	(-> temp-matrix 'setTranslate z-vec)
	
	;; Compose the motion and current translations
	(-> translate-matrix 'operator=
	    (SbMatrix::operator* temp-matrix translate-matrix))
	
	;; Compose the rotation and total translation of the camera
	(-> fly-transform 'setMatrix
	    (SbMatrix::operator* rotate-matrix translate-matrix))
	
	;; Update some state variables
	(set! last-event #t)
	(set! last-normalized-x x-pos)
	(set! last-normalized-y y-pos)))))

;; Every time we have some spare processor cycles... 
(define idle-cb
  (let ((x-rotation (new-SbRotation))
	(y-rotation (new-SbRotation))
	(z-vec (new-SbVec3f))
	(x-rot-matrix (new-SbMatrix))
	(y-rot-matrix (new-SbMatrix))
	(temp-matrix (new-SbMatrix)))
    (lambda (user-data node)

      ;; Don't start servicing until 
      ;; first location event is triggered
      (if last-event
	  
	  ;; Do the same as the location callback,
	  ;; but use last-normalized-x and last-normalized-y
	  ;; instead of retrieving mouse location.
	  (let ((x-ang-update
		 (* max-angular-velocity (- last-normalized-y 0.5)))
		(y-ang-update
		 (* max-angular-velocity (- 0.5 last-normalized-x))))
	    (set! x-angle (+ x-angle x-ang-update))
	    (set! y-angle (+ y-angle y-ang-update))   
	    (-> x-rotation 'setValue x-axis x-angle)
	    (-> y-rotation 'setValue y-axis y-angle)
	    (-> z-vec 'setValue 0 0 forward-speed)
	    (-> x-rot-matrix 'setRotate x-rotation)
	    (-> y-rot-matrix 'setRotate y-rotation)
	    (-> rotate-matrix 'operator=
		(SbMatrix::operator* x-rot-matrix y-rot-matrix))
	    (-> (-> rotate-matrix 'inverse)
		'multMatrixVec z-vec z-vec)
	    (-> temp-matrix 'setTranslate z-vec)
	    (-> translate-matrix 'operator=
		(SbMatrix::operator* temp-matrix translate-matrix))
	    (-> fly-transform 'setMatrix
		(SbMatrix::operator* rotate-matrix translate-matrix))))
  
      ;; Idle sensors aren't automatically rescheduled,
      ;; so we must do it ourselves
      (-> idle-sensor 'schedule))))

;; Set up the callbacks

(define mouse-info (new-SchemeSoCBInfo))
(-> mouse-info 'ref)
(-> (-> mouse-info 'callbackName) 'setValue "mouse-event-cb")

;; Tell the event callback that we want to trap mouse button events
(-> event-callback 'addEventCallback
    (SoMouseButtonEvent::getClassTypeID)
    (get-scheme-event-callback-cb)
    (void-cast mouse-info))

(define location-info (new-SchemeSoCBInfo))
(-> location-info 'ref)
(-> (-> location-info 'callbackName) 'setValue "location-event-cb")
(-> (-> location-info 'affectsNode) 'setValue fly-transform)

;; Tell the event callback that we want to trap mouse motion events
(-> event-callback 'addEventCallback
    (SoLocation2Event::getClassTypeID)
    (get-scheme-event-callback-cb)
    (void-cast location-info))

(define idle-info (new-SchemeSoCBInfo))
(-> idle-info 'ref)
(-> (-> idle-info 'callbackName) 'setValue "idle-cb")
(-> (-> idle-info 'affectsNode) 'setValue fly-transform)

;; Create the idle sensor and schedule it
(define idle-sensor (new-SoIdleSensor (get-scheme-sensor-cb)
				      (void-cast idle-info)))
(-> idle-sensor 'schedule)

;; Demo code

(define dorm-room 
  (read-from-inventor-file "/mit/thingworld/Ivy/room.iv"))
(-> root 'addChild dorm-room)
Video Texture - Debajit Ghosh and Thad Starner

;; Texture mapping of video onto a sphere
;; Debajit Ghosh and Thad Starner, 1/23/96

(define v (new-SoXtExaminerViewer))
(-> v 'show)
(define root (new-SoSeparator))
(define sphere (new-SoSphere))
(define texture (new-SoTexture2))
(define mat (new-SoMaterial))
(-> root 'addChild mat)
(-> root 'addChild texture)
(-> root 'addChild sphere)
(-> (-> sphere 'radius) 'setValue 3.0)
(-> (-> mat 'specularColor) 'setValue 0.8 0.8 0.8)
(-> (-> mat 'shininess) 'setValue 0.9)
(-> v 'setSceneGraph root)
(chdir "/tmp")

(define idle-cb
  (lambda (user-data sensor)
    (begin
      (-> sensor 'schedule)
      (system "vidtomem -z 1/4")
      (-> (-> texture 'filename) 'setValue "/tmp/out-00000.rgb"))))

;; Callback information node for the idle sensor's callback
(define cb-info (new-SchemeSoCBInfo))
(-> cb-info 'ref)
(-> (-> cb-info 'callbackName) 'setValue (new-SbString "idle-cb"))

;; Creation and scheduling of the idle sensor
(define idle-sensor (new-SoIdleSensor (get-scheme-sensor-cb) 
				      (void-cast cb-info)))
(-> idle-sensor 'schedule)
Next lecture

Next time we will finish our coverage of Open Inventor with a discussion of engines, cameras, and lights.


Back to the CGW '96 home page

$Id: index.html,v 1.1 1996/01/24 19:27:00 kbrussel Exp $