Computer Graphics Workshop '96 Lecture Notes | 1/24/96 |
;;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..
;;************************
;; 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-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)
;; 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)
$Id: index.html,v 1.1 1996/01/24 19:27:00 kbrussel Exp $