mirror of
https://github.com/NGSolve/netgen.git
synced 2024-11-15 10:28:34 +05:00
51 lines
1.3 KiB
Tcl
51 lines
1.3 KiB
Tcl
|
#!/bin/sh
|
||
|
|
# the next line restarts using tclsh \
|
||
|
|
exec tclsh "$0" "$@"
|
||
|
|
|
||
|
|
# $Id: index.tcl,v 1.8 2007/08/03 16:48:50 gregcouch 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
|
||
|
|
}
|