File: double.tcl

package info (click to toggle)
mgltools-opengltk 1.5.7-1
  • links: PTS, VCS
  • area: non-free
  • in suites: stretch
  • size: 8,592 kB
  • ctags: 38,393
  • sloc: ansic: 98,617; python: 3,818; cpp: 1,943; sh: 1,332; tcl: 1,127; makefile: 65
file content (109 lines) | stat: -rw-r--r-- 3,079 bytes parent folder | download | duplicates (4)
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
104
105
106
107
108
109
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# $Id: double.tcl,v 1.4 2009/03/30 23:37:11 vareille Exp $

# Togl - a Tk OpenGL widget
# Copyright (C) 1996  Brian Paul and Ben Bederson
# See the LICENSE file for copyright details.


# $Log: double.tcl,v $
# Revision 1.4  2009/03/30 23:37:11  vareille
# win32 is back to togl1.7
#
# Revision 1.2  2006/09/27 19:05:22  vareille
# introduced togl 1.7 + addition of 'getCurrentContext'
#
# Revision 1.5  2001/12/20 13:59:31  beskow
# Improved error-handling in togl.c in case of window creation failure
# Added pkgIndex target to makefile
# Updated documentation to reflect stubs-interface (Togl.html + new README.stubs)
# Added tk8.4a3 headers
# Removed obsolete Tk internal headers
#
# Revision 1.4  2001/01/29 18:11:53  brianp
# Jonas Beskow's changes to use Tcl/Tk stub interface
#
# Revision 1.3  1998/03/12 03:52:31  brianp
# now sharing display lists between the widgets
#
# Revision 1.2  1996/10/23 23:31:56  brianp
# added -ident options to togl calls
#
# Revision 1.1  1996/10/23 23:17:22  brianp
# Initial revision
#


# An Tk/OpenGL widget demo with two windows, one single buffered and the
# other double buffered.

load [file dirname [info script]]/double[info sharedlibextension]

proc setup {} {
    wm title . "Single vs Double Buffering"

    frame .f1

    # create first Togl widget
    togl .f1.o1 -width 200 -height 200  -rgba true  -double false -depth true -ident Single

    # create second Togl widget, share display lists with first widget
    togl .f1.o2 -width 200 -height 200  -rgba true  -double true -depth true -ident Double -sharelist Single

    scale  .sx   -label {X Axis} -from 0 -to 360 -command {setAngle x} -orient horizontal
    scale  .sy   -label {Y Axis} -from 0 -to 360 -command {setAngle y} -orient horizontal
    button .btn  -text Quit -command exit

    bind .f1.o1 <B1-Motion> {
	motion_event [lindex [%W config -width] 4] \
		     [lindex [%W config -height] 4] \
		     %x %y
    }

    bind .f1.o2 <B1-Motion> {
	motion_event [lindex [%W config -width] 4] \
		     [lindex [%W config -height] 4] \
		     %x %y
    }

    pack .f1.o1 .f1.o2  -side left -padx 3 -pady 3 -fill both -expand t
    pack .f1  -fill both -expand t
    pack .sx  -fill x
    pack .sy  -fill x
    pack .btn -fill x
}



# This is called when mouse button 1 is pressed and moved in either of
# the OpenGL windows.
proc motion_event { width height x y } {
    .f1.o1 setXrot [expr 360.0 * $y / $height]
    .f1.o2 setXrot [expr 360.0 * $y / $height]
    .f1.o1 setYrot [expr 360.0 * ($width - $x) / $width]
    .f1.o2 setYrot [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 setAngle {axis value} {
    global xAngle yAngle zAngle

    switch -exact $axis {
	x {.f1.o1 setXrot $value
	   .f1.o2 setXrot $value}
	y {.f1.o1 setYrot $value
	   .f1.o2 setYrot $value}
    }
}

# Execution starts here!
setup