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
|
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
# $Id: index.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.
# A Tk/OpenGL widget demo using color-index mode.
package provide index 1.0
# 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]]/index[info sharedlibextension]
# create ::index namespace
namespace eval ::index {
}
proc ::index::setup {} {
wm title . "Color index demo"
togl .win -width 200 -height 200 -rgba false -double true -privatecmap false -time 10 -timer ::index::timer_cb -create ::index::create_cb -reshape ::index::reshape_cb -display ::index::display_cb
button .photo -text "Take Photo" -command ::index::take_photo
button .btn -text Quit -command exit
pack .win -expand true -fill both
pack .photo -expand true -fill both
pack .btn -expand true -fill both
}
proc ::index::take_photo {} {
image create photo img
.win takephoto img
img write image.ppm -format ppm
}
# Execution starts here!
if { [info script] == $argv0 } {
::index::setup
}
|
