mirror of
https://github.com/NGSolve/netgen.git
synced 2024-12-25 21:40:33 +05:00
279 lines
9.7 KiB
Tcl
279 lines
9.7 KiB
Tcl
#!/bin/sh
|
|
# the next line restarts using tclsh \
|
|
exec tclsh "$0" "$@"
|
|
|
|
# $Id: texture.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.
|
|
|
|
|
|
# Togl texture map demo
|
|
|
|
package provide texture 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]]/texture[info sharedlibextension]
|
|
|
|
# create ::texture namespace
|
|
namespace eval ::texture {
|
|
}
|
|
|
|
# Called magnification filter changes
|
|
proc ::texture::new_magfilter {} {
|
|
global magfilter
|
|
mag_filter .f1.view $magfilter
|
|
}
|
|
|
|
|
|
# Called minification filter changes
|
|
proc ::texture::new_minfilter {} {
|
|
global minfilter
|
|
min_filter .f1.view $minfilter
|
|
}
|
|
|
|
|
|
# Called when texture image radio button changes
|
|
proc ::texture::new_image {} {
|
|
global image
|
|
teximage .f1.view $image
|
|
}
|
|
|
|
|
|
# Called when texture S wrap button changes
|
|
proc ::texture::new_swrap {} {
|
|
global swrap
|
|
swrap .f1.view $swrap
|
|
}
|
|
|
|
|
|
# Called when texture T wrap button changes
|
|
proc ::texture::new_twrap {} {
|
|
global twrap
|
|
twrap .f1.view $twrap
|
|
}
|
|
|
|
|
|
# Called when texture environment radio button selected
|
|
proc ::texture::new_env {} {
|
|
global envmode
|
|
envmode .f1.view $envmode
|
|
}
|
|
|
|
|
|
# Called when polygon color sliders change
|
|
proc ::texture::new_color { foo } {
|
|
global poly_red poly_green poly_blue
|
|
polycolor .f1.view $poly_red $poly_green $poly_blue
|
|
}
|
|
|
|
|
|
proc ::texture::new_coord_scale { name element op } {
|
|
global coord_scale
|
|
coord_scale .f1.view $coord_scale
|
|
}
|
|
|
|
proc ::texture::take_photo {} {
|
|
image create photo teximg
|
|
.f1.view takephoto teximg
|
|
teximg write image.ppm -format ppm
|
|
}
|
|
|
|
# Make the widgets
|
|
proc ::texture::setup {} {
|
|
global magfilter
|
|
global minfilter
|
|
global image
|
|
global swrap
|
|
global twrap
|
|
global envmode
|
|
global poly_red
|
|
global poly_green
|
|
global poly_blue
|
|
global coord_scale
|
|
global startx starty # location of mouse when button pressed
|
|
global xangle yangle
|
|
global xangle0 yangle0
|
|
global texscale texscale0
|
|
|
|
wm title . "Texture Map Options"
|
|
|
|
### Two frames: top half and bottom half
|
|
frame .f1
|
|
frame .f2
|
|
|
|
### The OpenGL window
|
|
togl .f1.view -width 250 -height 250 -rgba true -double true -depth true -create create_cb -reshape reshape_cb -display display_cb
|
|
|
|
|
|
### Filter radio buttons
|
|
frame .f1.filter -relief ridge -borderwidth 3
|
|
|
|
frame .f1.filter.mag -relief ridge -borderwidth 2
|
|
|
|
label .f1.filter.mag.label -text "Magnification Filter" -anchor w
|
|
radiobutton .f1.filter.mag.nearest -text GL_NEAREST -anchor w -variable magfilter -value GL_NEAREST -command ::texture::new_magfilter
|
|
radiobutton .f1.filter.mag.linear -text GL_LINEAR -anchor w -variable magfilter -value GL_LINEAR -command ::texture::new_magfilter
|
|
|
|
frame .f1.filter.min -relief ridge -borderwidth 2
|
|
|
|
label .f1.filter.min.label -text "Minification Filter" -anchor w
|
|
radiobutton .f1.filter.min.nearest -text GL_NEAREST -anchor w -variable minfilter -value GL_NEAREST -command ::texture::new_minfilter
|
|
radiobutton .f1.filter.min.linear -text GL_LINEAR -anchor w -variable minfilter -value GL_LINEAR -command ::texture::new_minfilter
|
|
radiobutton .f1.filter.min.nearest_mipmap_nearest -text GL_NEAREST_MIPMAP_NEAREST -anchor w -variable minfilter -value GL_NEAREST_MIPMAP_NEAREST -command ::texture::new_minfilter
|
|
radiobutton .f1.filter.min.linear_mipmap_nearest -text GL_LINEAR_MIPMAP_NEAREST -anchor w -variable minfilter -value GL_LINEAR_MIPMAP_NEAREST -command ::texture::new_minfilter
|
|
radiobutton .f1.filter.min.nearest_mipmap_linear -text GL_NEAREST_MIPMAP_LINEAR -anchor w -variable minfilter -value GL_NEAREST_MIPMAP_LINEAR -command ::texture::new_minfilter
|
|
radiobutton .f1.filter.min.linear_mipmap_linear -text GL_LINEAR_MIPMAP_LINEAR -anchor w -variable minfilter -value GL_LINEAR_MIPMAP_LINEAR -command ::texture::new_minfilter
|
|
|
|
pack .f1.filter.mag -fill x
|
|
pack .f1.filter.mag.label -fill x
|
|
pack .f1.filter.mag.nearest -side top -fill x
|
|
pack .f1.filter.mag.linear -side top -fill x
|
|
|
|
pack .f1.filter.min -fill both -expand true
|
|
pack .f1.filter.min.label -side top -fill x
|
|
pack .f1.filter.min.nearest -side top -fill x
|
|
pack .f1.filter.min.linear -side top -fill x
|
|
pack .f1.filter.min.nearest_mipmap_nearest -side top -fill x
|
|
pack .f1.filter.min.linear_mipmap_nearest -side top -fill x
|
|
pack .f1.filter.min.nearest_mipmap_linear -side top -fill x
|
|
pack .f1.filter.min.linear_mipmap_linear -side top -fill x
|
|
|
|
|
|
### Texture coordinate scale and wrapping
|
|
frame .f2.coord -relief ridge -borderwidth 3
|
|
frame .f2.coord.scale -relief ridge -borderwidth 2
|
|
label .f2.coord.scale.label -text "Max Texture Coord" -anchor w
|
|
entry .f2.coord.scale.entry -textvariable coord_scale
|
|
trace variable coord_scale w ::texture::new_coord_scale
|
|
|
|
frame .f2.coord.s -relief ridge -borderwidth 2
|
|
label .f2.coord.s.label -text "GL_TEXTURE_WRAP_S" -anchor w
|
|
radiobutton .f2.coord.s.repeat -text "GL_REPEAT" -anchor w -variable swrap -value GL_REPEAT -command ::texture::new_swrap
|
|
radiobutton .f2.coord.s.clamp -text "GL_CLAMP" -anchor w -variable swrap -value GL_CLAMP -command ::texture::new_swrap
|
|
|
|
frame .f2.coord.t -relief ridge -borderwidth 2
|
|
label .f2.coord.t.label -text "GL_TEXTURE_WRAP_T" -anchor w
|
|
radiobutton .f2.coord.t.repeat -text "GL_REPEAT" -anchor w -variable twrap -value GL_REPEAT -command ::texture::new_twrap
|
|
radiobutton .f2.coord.t.clamp -text "GL_CLAMP" -anchor w -variable twrap -value GL_CLAMP -command ::texture::new_twrap
|
|
|
|
pack .f2.coord.scale -fill both -expand true
|
|
pack .f2.coord.scale.label -side top -fill x
|
|
pack .f2.coord.scale.entry -side top -fill x
|
|
|
|
pack .f2.coord.s -fill x
|
|
pack .f2.coord.s.label -side top -fill x
|
|
pack .f2.coord.s.repeat -side top -fill x
|
|
pack .f2.coord.s.clamp -side top -fill x
|
|
|
|
pack .f2.coord.t -fill x
|
|
pack .f2.coord.t.label -side top -fill x
|
|
pack .f2.coord.t.repeat -side top -fill x
|
|
pack .f2.coord.t.clamp -side top -fill x
|
|
|
|
|
|
### Texture image radio buttons (just happens to fit into the coord frame)
|
|
frame .f2.env -relief ridge -borderwidth 3
|
|
frame .f2.env.image -relief ridge -borderwidth 2
|
|
label .f2.env.image.label -text "Texture Image" -anchor w
|
|
radiobutton .f2.env.image.checker -text "Checker" -anchor w -variable image -value CHECKER -command ::texture::new_image
|
|
radiobutton .f2.env.image.tree -text "Tree" -anchor w -variable image -value TREE -command ::texture::new_image
|
|
radiobutton .f2.env.image.face -text "Face" -anchor w -variable image -value FACE -command ::texture::new_image
|
|
pack .f2.env.image -fill x
|
|
pack .f2.env.image.label -side top -fill x
|
|
pack .f2.env.image.checker -side top -fill x
|
|
pack .f2.env.image.tree -side top -fill x
|
|
pack .f2.env.image.face -side top -fill x
|
|
|
|
|
|
### Texture Environment
|
|
label .f2.env.label -text "GL_TEXTURE_ENV_MODE" -anchor w
|
|
radiobutton .f2.env.modulate -text "GL_MODULATE" -anchor w -variable envmode -value GL_MODULATE -command ::texture::new_env
|
|
radiobutton .f2.env.decal -text "GL_DECAL" -anchor w -variable envmode -value GL_DECAL -command ::texture::new_env
|
|
radiobutton .f2.env.blend -text "GL_BLEND" -anchor w -variable envmode -value GL_BLEND -command ::texture::new_env
|
|
pack .f2.env.label -fill x
|
|
pack .f2.env.modulate -side top -fill x
|
|
pack .f2.env.decal -side top -fill x
|
|
pack .f2.env.blend -side top -fill x
|
|
|
|
### Polygon color
|
|
frame .f2.color -relief ridge -borderwidth 3
|
|
label .f2.color.label -text "Polygon color" -anchor w
|
|
scale .f2.color.red -label Red -from 0 -to 255 -orient horizontal -variable poly_red -command ::texture::new_color
|
|
scale .f2.color.green -label Green -from 0 -to 255 -orient horizontal -variable poly_green -command ::texture::new_color
|
|
scale .f2.color.blue -label Blue -from 0 -to 255 -orient horizontal -variable poly_blue -command ::texture::new_color
|
|
pack .f2.color.label -fill x
|
|
pack .f2.color.red -side top -fill x
|
|
pack .f2.color.green -side top -fill x
|
|
pack .f2.color.blue -side top -fill x
|
|
|
|
|
|
### Main widgets
|
|
pack .f1.view -side left -fill both -expand true
|
|
pack .f1.filter -side left -fill y
|
|
pack .f1 -side top -fill both -expand true
|
|
|
|
pack .f2.coord .f2.env -side left -fill both
|
|
pack .f2.color -fill x
|
|
pack .f2 -side top -fill x
|
|
|
|
button .photo -text "Take Photo" -command ::texture::take_photo
|
|
pack .photo -expand true -fill both
|
|
button .quit -text Quit -command exit
|
|
pack .quit -expand true -fill both
|
|
|
|
bind .f1.view <ButtonPress-1> {
|
|
set startx %x
|
|
set starty %y
|
|
set xangle0 $xangle
|
|
set yangle0 $yangle
|
|
}
|
|
|
|
bind .f1.view <B1-Motion> {
|
|
set xangle [expr $xangle0 + (%x - $startx) / 3.0 ]
|
|
set yangle [expr $yangle0 + (%y - $starty) / 3.0 ]
|
|
yrot .f1.view $xangle
|
|
xrot .f1.view $yangle
|
|
}
|
|
|
|
bind .f1.view <ButtonPress-2> {
|
|
set startx %x
|
|
set starty %y
|
|
set texscale0 $texscale
|
|
}
|
|
|
|
bind .f1.view <B2-Motion> {
|
|
set q [ expr ($starty - %y) / 400.0 ]
|
|
set texscale [expr $texscale0 * exp($q)]
|
|
texscale .f1.view $texscale
|
|
}
|
|
|
|
# set default values:
|
|
set minfilter GL_NEAREST_MIPMAP_LINEAR
|
|
set magfilter GL_LINEAR
|
|
set swrap GL_REPEAT
|
|
set twrap GL_REPEAT
|
|
set envmode GL_MODULATE
|
|
set image CHECKER
|
|
set poly_red 255
|
|
set poly_green 255
|
|
set poly_blue 255
|
|
set coord_scale 1.0
|
|
|
|
set xangle 0.0
|
|
set yangle 0.0
|
|
set texscale 1.0
|
|
}
|
|
|
|
|
|
# Execution starts here!
|
|
if { [info script] == $argv0 } {
|
|
::texture::setup
|
|
}
|