1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
# $Id: stereo.tcl,v 1.2 2009/05/14 20:43:34 vareille Exp $
# Togl - a Tk OpenGL widget
# Copyright (C) 1996 Brian Paul and Ben Bederson
# Copyright (C) 2006-2007 Greg Couch
# See the LICENSE file for copyright details.
# add parent directory to path to find Togl's pkgIndex in current directory
if { [file exists pkgIndex.tcl] } {
set auto_path [linsert $auto_path 0 ..]
}
# following load also loads Tk and Togl packages
load [file dirname [info script]]/stereo[info sharedlibextension]
# create ::stereo namespace
namespace eval ::stereo {
}
proc stereo::setup {} {
grid rowconfigure . 0 -weight 1 -minsize 200p
grid columnconfigure . 1 -weight 1 -minsize 200p
labelframe .c -text "Stereo mode:"
grid .c -sticky nw -padx 2 -pady 2 -ipadx 2 -ipady 1
# add "nvidia" to list below when it works
foreach {b} {none native sgioldstyle anaglyph cross-eye wall-eye DTI "left eye" "right eye" } {
set name [string map {- _ " " _} $b]
button .c.b$name -text "$b" -command "::stereo::makeGraphics {$b}"
pack .c.b$name -fill x -padx 2 -pady 1
}
scale .sx -label {X Axis} -from 0 -to 360 -command {::stereo::setAngle x} -orient horizontal
grid .sx -columnspan 2 -sticky ew
scale .sy -label {Y Axis} -from 0 -to 360 -command {::stereo::setAngle y} -orient horizontal
grid .sy -columnspan 2 -sticky ew
if {[string first IRIX $::tcl_platform(os)] != -1} {
label .irix -justify left -wraplength 250p -text "Use /usr/gfx/setmon or /usr/bin/X11/xsetmon to change video mode for native stereo (eg., 1024x768_120s) or sgioldstyle stereo (eg., str_bot) and back."
grid .irix -sticky new -columnspan 2
}
button .quit -text Close -command exit
grid .quit -sticky se -columnspan 2 -padx 2 -pady 2
frame .f -relief groove -borderwidth 2 -bg black
grid .f -row 0 -column 1 -sticky news
label .f.gr -wraplength 100p -bg black -fg white -text "To start, choose a stereo mode from the choices on the left."
pack .f.gr -anchor center -expand 1
bind . <Key-Escape> {exit}
}
proc stereo::makeGraphics {mode} {
destroy .f.gr
set name ".f.gr"
set width 200
set height 200
if { "$mode" == "nvidia" } {
set mode "nvidia consumer stereo"
set name ".gr"
foreach s [grid slaves .] {
grid forget $s
}
wm attributes . -fullscreen 1
set width [winfo screenwidth .]
set height [winfo screenheight .]
}
if { [catch { togl $name -width $width -height $height -rgba true -stereo "$mode" -double true -depth true -ident "$mode" -create create_cb -display display_cb -reshape reshape_cb -eyeseparation 0.05 -convergence 2.0 } error] } {
label $name -wraplength 100p -bg black -fg white -text "$error\n\nMake another choice from the stereo modes on the left."
}
pack $name -expand 1 -fill both
bind $name <B1-Motion> {
::stereo::motion_event %W [lindex [%W config -width] 4] \
[lindex [%W config -height] 4] %x %y
}
}
# This is called when mouse button 1 is pressed and moved
proc stereo::motion_event { widget width height x y } {
setXrot $widget [expr 360.0 * $y / $height]
setYrot $widget [expr 360.0 * ($width - $x) / $width]
# .sx set [expr 360.0 * $y / $height]
# .sy set [expr 360.0 * ($width - $x) / $width]
.sx set [getXrot]
.sy set [getYrot]
}
# This is called when a slider is changed.
proc stereo::setAngle {axis value} {
global xAngle yAngle zAngle
# catch because .f.gr might be a label instead of a Togl widget
catch {
switch -exact $axis {
x {setXrot .f.gr $value}
y {setYrot .f.gr $value}
}
}
}
if { [info script] == $argv0 } {
::stereo::setup
}
|
