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 | # ====================================================================== |
---|
10 | package require Rappture |
---|
11 | package require Tk |
---|
12 | package 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 | |
---|
22 | proc 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 | |
---|
63 | wm withdraw . |
---|
64 | |
---|
65 | # open the XML file containing the run parameters |
---|
66 | set xml [Rappture::library [lindex $argv 0]] |
---|
67 | set wavel [$xml get input.number(wavel).current] |
---|
68 | set wavel [Rappture::Units::convert $wavel -to nm -units off] |
---|
69 | |
---|
70 | set tooldir [file dirname [info script]] |
---|
71 | set psfile "plot[pid].ps" |
---|
72 | set 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. |
---|
78 | set width 720 |
---|
79 | set height 50 |
---|
80 | |
---|
81 | # load the hand image |
---|
82 | set 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. |
---|
85 | set x0 [image width $imh] |
---|
86 | set y0 [image height $imh] |
---|
87 | |
---|
88 | # create canvas big enough to hold images |
---|
89 | canvas .c -height [expr $height + $y0 + 100] -width [expr $width + $x0 + 50] |
---|
90 | |
---|
91 | # spectrum range |
---|
92 | set start 380 |
---|
93 | set stop 740 |
---|
94 | |
---|
95 | # calculate some offsets |
---|
96 | set x1 [expr $x0 + $width] |
---|
97 | set y1 [expr $y0 + $height] |
---|
98 | set xmid [expr {0.5*($x0+$x1)}] |
---|
99 | set dwl [expr ($stop - $start)/$width.0] |
---|
100 | |
---|
101 | # draw spectrum image |
---|
102 | set x $x0 |
---|
103 | for {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 |
---|
112 | set 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 | # |
---|
120 | set psdata [.c postscript -height [expr $height + $y0 + 100] -width [expr $width + $x0 + 50]] |
---|
121 | set fid [open $psfile w] |
---|
122 | puts $fid $psdata |
---|
123 | close $fid |
---|
124 | |
---|
125 | # convert postscript to png image |
---|
126 | set status [catch {exec convert $psfile $pngfile} result] |
---|
127 | |
---|
128 | if {$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... |
---|
140 | Rappture::result $xml |
---|
141 | exit 0 |
---|