/usr/share/togl/gears.tcl is in togl-demos 1.7-12ubuntu1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 | #!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"
# Togl - a Tk OpenGL widget
# Copyright (C) 1996-1997 Brian Paul and Ben Bederson
# See the LICENSE file for copyright details.
#
# Test Togl using GL Gears Demo
#
# Copyright (C) 1997 Philip Quaife
#
load [file dirname [info script]]/gears[info sharedlibextension]
proc setup {} {
global startx starty xangle0 yangle0 xangle yangle RotCnt
global vTime
set RotCnt 1
set xangle 0.0
set yangle 0.0
set vTime 100
wm title . "Rotating Gear Widget Test"
label .t -text "Click and drag to rotate image"
pack .t -side top -padx 2 -pady 10
frame .f
pack .f -side top
button .f.n1 -text " Add " -command AutoRot
button .f.r1 -text "Remove" -command DelRot
button .f.b1 -text " Quit " -command exit
entry .f.t -width 4 -textvariable vTime
pack .f.n1 .f.t .f.r1 .f.b1 -side left -anchor w -padx 5
newRot .w0 10
}
proc AutoRot {} {
global RotCnt vTime
newRot .w$RotCnt $vTime
set RotCnt [expr $RotCnt + 1]
}
proc DelRot {} {
global RotCnt vTime
if { $RotCnt != 0 } {
set RotCnt [expr $RotCnt - 1]
destroy .w$RotCnt
}
}
proc newRot {win {tick 100} } {
togl $win -width 200 -height 200 -rgba true -double true -depth true -privatecmap false -time $tick
bind $win <ButtonPress-1> {RotStart %x %y %W}
bind $win <B1-Motion> {RotMove %x %y %W}
pack $win -expand true -fill both
}
proc RotStart {x y W } {
global startx starty xangle0 yangle0 xangle yangle
set startx $x
set starty $y
set vPos [$W position]
set xangle0 [lindex $vPos 0]
set yangle0 [lindex $vPos 1]
}
proc RotMove {x y W} {
global startx starty xangle0 yangle0 xangle yangle
set xangle [expr $xangle0 + ($x - $startx) ]
set yangle [expr $yangle0 + ($y - $starty) ]
$W rotate $xangle $yangle
}
setup
|