Code: Select all
(tk "load C:/tcl/bin/ivrs.dll VRS")
(tk "if {[winfo exists .dw] == 1} {destroy .dw}")
(tk "toplevel .dw -background lightblue")
;# camera settings
(tk "global mview; set mview [new SceneThing]")
(tk "global mview; $mview append [new Camera {0 3 2} {0 0 0} 60]")
;# main thing
(tk "global mscene mview; set mscene [new SceneThing $mview]")
;# thing with floor
(tk "global menviron mscene; set menviron [new SceneThing $mscene]")
;# lightsources
(tk "global mscene; $mscene append [new DistantLight { -0.1 0 -1 } {1 1 1 1} 1.0 0.9]")
(tk "global mscene; $mscene append [new PointLight { 1 2 1 } {1 1 1 1} 1.0 0.8]")
;# thing with snowman
(tk "global msnowman mscene; set msnowman [new SceneThing $mscene]")
(tk "global mbody_ msnowman; set mbody_ [new SceneThing $msnowman]")
(tk "global mbody_ ;$mbody_ append [new ColorAttribute 1 1 1 ]")
(tk "global mbody_ ;$mbody_ append [new Scaling {1 0.9 1 }]")
(tk "global mbody_ ;$mbody_ append [new FaceStyle FaceStyle::Filled FaceStyle::Culled]")
(tk "global mbody_ ;$mbody_ append [new Sphere 0.5 {0 0.43 0}]")
(tk "global mbody_ ;$mbody_ append [new Sphere 0.35 {0 1.1 0}]")
(tk "global mbody_ ;$mbody_ append [new Sphere 0.25 {0 1.5 0}]")
(tk "global mbody_ ;$mbody_ append [new ColorAttribute { 0.7 0.7 1.0 1 }]")
(tk "global mbody_ ;$mbody_ append [new Box {-1 -0.08 -1 } { 1 0 1 }]")
(tk "global mface msnowman; set mface [new SceneThing $msnowman]")
(tk "global meyes_ mface; set meyes_ [new SceneThing $mface]")
(tk "global meyes_ ; $meyes_ append [new ColorAttribute 0.1 0.1 1.0]")
(tk "global meyes_ ; $meyes_ append [new Sphere 0.04 {-0.1 1.5 0.12}]")
(tk "global meyes_ ; $meyes_ append [new Sphere 0.04 { 0.1 1.5 0.12}]")
(tk "global mnose_ mface; set mnose_ [new SceneThing $mface]")
(tk "global mnose_ ; $mnose_ append [new ColorAttribute 1 0.5 0]")
(tk "global mnose_ ; $mnose_ append [new Cone {0 1.55 0.2} {0 1.35 0.22} 0.00 0.04]")
(tk "global mmouth_ mface; set mmouth_ [ new SceneThing $mface]")
(tk "global mmouth_ ; $mmouth_ append [new ColorAttribute 0.9 0.9 0]")
(tk "global mmouth_ ; $mmouth_ append [new Cylinder {-0.12 1.33 0.21} {.12 1.33 0.21} 0.05]")
;# store a few shapes so we can identify them later
(tk "global mbody_ ;[$mbody_ object 3] setObjectName {lower part}")
(tk "global mbody_ ;[$mbody_ object 4] setObjectName {middle part}")
(tk "global mbody_ ;[$mbody_ object 5] setObjectName {upper part}")
(tk "global mbody_ ;[$mbody_ object 7] setObjectName {box}")
(tk "global meyes_ ;[$meyes_ object 1] setObjectName {left eye}")
(tk "global meyes_ ;[$meyes_ object 2] setObjectName {right eye}")
(tk "global mnose_ ;[$mnose_ object 1] setObjectName {nose}")
(tk "global mmouth_ ;[$mmouth_ object 1] setObjectName {mouth}")
;# MENUS
(tk "frame .dw.mbar -border 1 -relief raised")
(tk "menubutton .dw.mbar.file -text File -menu .dw.mbar.file.m")
(tk "menu .dw.mbar.file.m")
(tk ".dw.mbar.file.m add command -label {quit} -command {destroy .; VRS cleanup}")
(tk "pack .dw.mbar.file -side left")
(tk "pack .dw.mbar -fill x")
;# build a 3D canvas
(tk "global canvas ;set canvas [ new TclCanvas .dw.toto 256 256 ]")
(tk "pack .dw.toto")
;# connect geometry graphs to the canvas
(tk "global canvas mview; $canvas append $mview")
(tk "global canvas mscene; $canvas append [new TrackBall $mscene]")
;# STATUS AREA
(tk "frame .dw.state -relief sunken -border 2")
(tk "global statustext; label .dw.state.msg -textvariable statustext -justify left -anchor w")
(tk "pack .dw.state -side bottom -fill x")
(tk "pack .dw.state.msg -side left -fill x")
http://hpwickern.bei.t-online.de/anmeld ... sp_vrs.png
More info on: Virtual Rendering System here: http://www.vrs3d.org/
I like it!
(Code ported from sample-demos of iVRS)