source: trunk/examples/canvas/waveln.tcl @ 5348

Last change on this file since 5348 was 3177, checked in by mmc, 8 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.

File size: 4.1 KB
Line 
1# ----------------------------------------------------------------------
2#  EXAMPLE: Rappture <number> elements
3# ======================================================================
4#  AUTHOR:  Michael McLennan, Purdue University
5#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
6#
7#  See the file "license.terms" for information on usage and
8#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9# ======================================================================
10package require Rappture
11package require Tk
12package require Img
13
14# ---------------------------------------------------------------------
15# USAGE: wave2RGB <wavelength>
16#
17# Given a visible wavelength in nm, returns a Tk color of the form
18# #RRGGBB. Returns black for nonvisible wavelengths.  Based on code from
19# Dan Bruton (astro@tamu.edu) http://www.physics.sfasu.edu/astro/color/spectra.html
20# ----------------------------------------------------------------------
21
22proc wave2RGB {wl} {
23    if {$wl < 380 || $wl > 780} {
24        return black
25    }
26    set gamma 0.8
27    set r 0.0
28    set g 0.0
29    set b 0.0
30    if {$wl <= 440} {
31        set r [expr (440.0 - $wl) / 60.0]
32        set b 1.0
33    } elseif {$wl <= 490} {
34        set g [expr ($wl - 440.0) / 50.0]
35        set b 1.0
36    } elseif {$wl <= 510} {
37        set g 1.0
38        set b [expr (510.0 - $wl) / 20.0]
39    } elseif {$wl <= 580} {
40        set g 1.0
41        set r [expr ($wl - 510.0) / 70.0]
42    } elseif {$wl <= 645} {
43        set r 1.0
44        set g [expr (645.0 - $wl) / 65.0]
45    } else {
46        set r 1.0
47    }
48
49    if {$wl > 700} {
50        set sss [expr 0.3 + 0.7 * (780.0 - $wl) / 80.0]
51    } elseif {$wl < 420} {
52        set sss [expr 0.3 + 0.7 * ($wl - 380.0) / 40.0]
53    } else {
54        set sss 1.0
55    }
56    set r [expr int(255.0 * pow(($sss * $r), $gamma))]
57    set g [expr int(255.0 * pow(($sss * $g), $gamma))]
58    set b [expr int(255.0 * pow(($sss * $b), $gamma))]
59    return [format "#%.2X%.2X%.2X" $r $g $b]
60}
61
62
63wm withdraw .
64
65# open the XML file containing the run parameters
66set xml [Rappture::library [lindex $argv 0]]
67set wavel [$xml get input.number(wavel).current]
68set wavel [Rappture::Units::convert $wavel -to nm -units off]
69
70set tooldir [file dirname [info script]]
71set psfile "plot[pid].ps"
72set pngfile "plot[pid].png"
73
74
75# height and width of spectrum image
76# It will get scaled to fit window, but render at high
77# resolution so it looks good when large.
78set width 720
79set height 50
80
81# load the hand image
82set imh [image create photo -file [file join $tooldir hand.gif]]
83
84# Where to place the spectrum image. Leave room for the hand above it.
85set x0 [image width $imh]
86set y0 [image height $imh]
87
88# create canvas big enough to hold images
89canvas .c -height [expr $height + $y0 + 100] -width [expr $width + $x0 + 50]
90
91# spectrum range
92set start 380
93set stop 740
94
95# calculate some offsets
96set x1 [expr $x0 + $width]
97set y1 [expr $y0 + $height]
98set xmid [expr {0.5*($x0+$x1)}]
99set dwl [expr ($stop - $start)/$width.0]
100
101# draw spectrum image
102set x $x0
103for {set wl $start} {$wl < $stop} {set wl [expr $wl + $dwl]} {
104    set color [wave2RGB $wl]
105    .c create rectangle $x $y0 [expr $x+1] $y1 -outline "" -fill $color
106    incr x
107}
108.c create rectangle $x0 $y0 $x1 $y1 -outline black -fill ""
109.c create text $xmid [expr {$y1+20}] -anchor n -text "Visible Spectrum" -font "Helvetica 18"
110
111# now place the hand image
112set x [expr {($x1-$x0)/double($stop-$start) * ($wavel-380) + $x0}]
113.c create image $x $y0 -image $imh
114.c create text $x [expr {$y0-25}] \
115    -anchor s -text "$wavel nm" -font "Helvetica 14"
116
117#
118# Convert the PostScript from the canvas into an image.
119#
120set psdata [.c postscript -height [expr $height + $y0 + 100] -width [expr $width + $x0 + 50]]
121set fid [open $psfile w]
122puts $fid $psdata
123close $fid
124
125# convert postscript to png image
126set status [catch {exec convert $psfile $pngfile} result]
127
128if {$status == 0} {
129    set dest [image create photo -format png -file $pngfile]
130    $xml put output.image(diagram).current [$dest data -format png]
131    $xml put output.image(diagram).about.label "Visible Spectrum"
132    file delete -force $psfile $pngfile
133} else {
134    puts stderr "ERROR during postscript conversion:\n$result"
135    file delete -force $psfile $pngfile
136    exit 1
137}
138
139# save the updated XML describing the run...
140Rappture::result $xml
141exit 0
Note: See TracBrowser for help on using the repository browser.