1#/*****************************************************************************
2# *
3# *  Elmer, A Finite Element Software for Multiphysical Problems
4# *
5# *  Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland
6# *
7# *  This program is free software; you can redistribute it and/or
8# *  modify it under the terms of the GNU General Public License
9# *  as published by the Free Software Foundation; either version 2
10# *  of the License, or (at your option) any later version.
11# *
12# *  This program is distributed in the hope that it will be useful,
13# *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14# *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# *  GNU General Public License for more details.
16# *
17# *  You should have received a copy of the GNU General Public License
18# *  along with this program (in file fem/GPL-2); if not, write to the
19# *  Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20# *  Boston, MA 02110-1301, USA.
21# *
22# *****************************************************************************/
23
24#*******************************************************************************
25#*
26#* Contours display parameter settings
27#*
28#*******************************************************************************
29#*
30#*                     Author:       Juha Ruokolainen
31#*
32#*                    Address: CSC - IT Center for Science Ltd.
33#*                                Keilaranta 14, P.O. BOX 405
34#*                                  02101 Espoo, Finland
35#*                                  Tel. +358 0 457 2723
36#*                                Telefax: +358 0 457 2302
37#*                              EMail: Juha.Ruokolainen@csc.fi
38#*
39#*                       Date: 26 Sep 1995
40#*
41#*                Modified by:
42#*
43#*       Date of modification:
44#*
45#*******************************************************************************
46#
47#
48
49#
50#
51# 23 Apr 1996
52#
53
54set ContourLineStyle   0
55set ContourQuality     1
56set ContourRadius      1
57set ContourColor       "none"
58set ContourContour     "none"
59set ContourColorMin    0.0
60set ContourColorMax    1.0
61
62set ContourLines         5
63set CurrentLines         0
64
65set ContourActive        0
66set ContourColorMap(0,R) 0
67set ContourColorMap(0,G) 0
68set ContourColorMap(0,B) 0
69
70proc contour_set_color { win args } {
71    global ContourColorMap ContourActive
72
73    set R [$win.red get]
74    set G [$win.grn get]
75    set B [$win.blu get]
76
77    set R [@ int($R*2.55+0.5)]
78    set G [@ int($G*2.55+0.5)]
79    set B [@ int($B*2.55+0.5)]
80
81    set value [format "#%02x%02x%02x" $R $G $B]
82    .contour.cont.values.fr$ContourActive.valuecolor configure -back $value
83}
84
85proc contour_set_value_array { lines ColorMin ColorMax } {
86    global ContourValues
87
88    if {  $lines > 0 } {
89       do i 0 [@ $lines-1] {
90         set t [@ ($i+1.0)/($lines+1.0)]
91         set ContourValues($i) [@ (1-$t)*$ColorMin + $t*$ColorMax]
92       }
93    }
94}
95
96proc contour_set_values { win lines ColorMin ColorMax } {
97    global CurrentLines ContourValues colmap colmap_size ContourColorMap
98    global ContourValues ContourColorMin ContourColorMax
99
100    if {  $lines > 0 } {
101
102       do i 0 [@ $CurrentLines-1] {
103           if { [winfo exists $win.fr$i.value] } { destroy $win.fr$i.value }
104           if { [winfo exists $win.fr$i.valuecolor] } { destroy $win.fr$i.valuecolor }
105           if { [winfo exists $win.fr$i] } { destroy $win.fr$i }
106       }
107
108       contour_set_value_array $lines $ColorMin $ColorMax
109
110       do i 0 [@ $lines-1] {
111           set a [@ $ContourColorMax - $ContourColorMin]
112           set b [@ $ContourValues($i)-$ContourColorMin]
113
114           if { $a==0 } { set a 1.0 }
115           set t [@ int(($colmap_size-1.0)*$b/$a+0.5)]
116
117           frame $win.fr$i
118           entry $win.fr$i.value -textvariable ContourValues($i) -width 12
119           pack $win.fr$i.value -side left
120
121           button $win.fr$i.valuecolor \
122              -back $colmap([@ ($t<0)?0:($t>=$colmap_size)?$colmap_size-1:$t]) \
123              -command "set ContourActive $i"
124           pack $win.fr$i.valuecolor -side left
125
126           pack $win.fr$i
127
128           bind $win.fr$i.value <Return> {
129                    set val [%W get];
130                    set a [@ $ContourColorMax - $ContourColorMin];
131                    set b [@ $val - $ContourColorMin];
132                    set t [@  int(($colmap_size-1.0)*$b/$a+0.5)];
133                    if { $t < 0 } { set t 0 }
134                    if { $t >= $colmap_size } { set t [@ $colmap_size-1] }
135                    %Wcolor configure -back $colmap($t);
136                }
137       }
138
139       set CurrentLines $lines
140    }
141}
142
143proc contour_edit { } {
144    global ContourLines ContourLineStyle ContourQuality ContourRadius
145    global ContourColor ContourContour ContourColorMin ContourColorMax
146    global ContourColorSetMinMax
147
148    if { [winfo exists .contour] } {
149        wm iconify .contour
150        wm deiconify .contour
151        return
152    }
153
154    toplevel .contour
155    place_window .contour
156
157    frame .contour.cont
158    label .contour.cont.label -text "Number Of Contours: "
159    entry .contour.cont.entry -width 5 -textvariable ContourLines -relief sunken
160
161    bind .contour.cont.entry <Return> { contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
162
163    frame .contour.cont.values
164# -yscrollcommand ".contour.cont.values.scroll set" -width 200 -height 200
165#    scrollbar .contour.cont.values.scroll -command ".contour.cont.values yview"
166
167    pack .contour.cont -side top
168    pack .contour.cont.label -side left
169    pack .contour.cont.entry -side left -fill x
170
171    contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax
172    pack .contour.cont.values -side top
173#   pack .contour.cont.values.scroll -side left -expand 1 -fill both
174
175#
176# Generate ...
177#
178    frame .contour.set
179    label .contour.set.min_lab -text "Min: "
180
181    entry .contour.set.min -width 10 -textvariable ContourColorMin
182    bind .contour.set.min <Return> { contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
183
184    label .contour.set.max_lab -text "Max: "
185
186    entry .contour.set.max -width 10 -textvariable ContourColorMax
187    bind .contour.set.max <Return> { contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
188
189#    button .contour.set.gen -text "Generate" -command { \
190#         contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
191
192    checkbutton .contour.set.keep -text "Keep" -variable ContourColorSetMinMax -command { \
193         contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
194
195    pack .contour.set.min_lab -side left
196    pack .contour.set.min -side left
197    pack .contour.set.max_lab -side left
198    pack .contour.set.max -side left
199#    pack .contour.set.gen -side left
200    pack .contour.set.keep -side left
201    pack .contour.set -side top
202
203# color sliders
204#
205#    frame .contour.rgb
206#    slider .contour.rgb.red -orient horizontal -command { contour_set_color .contour.rgb } \
207#             -from 0 -to 100 -troughcolor red -digit 4 -resol 0.5
208#    slider .contour.rgb.grn -orient horizontal -command { contour_set_color .contour.rgb } \
209#             -from 0 -to 100 -troughcolor green -digit 4 -resol 0.5
210#    slider .contour.rgb.blu -orient horizontal -command { contour_set_color .contour.rgb } \
211#            -from 0 -to 100 -troughcolor blue -digit 4 -tick 25 -resol 0.5
212#
213#    pack .contour.rgb.red -side left -expand 1 -fill x
214#    pack .contour.rgb.grn -side left -expand 1 -fill x
215#    pack .contour.rgb.blu -side left -expand 1 -fill x
216#
217#    pack .contour.rgb.red -side top -fill x
218#    pack .contour.rgb.grn -side top -fill x
219#    pack .contour.rgb.blu -side top  -fill x
220#    pack .contour.rgb -side top -expand 1 -fill both
221#
222#
223#
224    frame .contour.line
225    label .contour.line.label -text "Line Style: "
226    radiobutton .contour.line.line -value 0 -variable ContourLineStyle -text "Line"
227    radiobutton .contour.line.cyli -value 1 -variable ContourLineStyle -text "Solid"
228
229    pack .contour.line -side top
230    pack .contour.line.label -side left
231    pack .contour.line.line -side left -fill x
232    pack .contour.line.cyli -side left  -fill x
233
234    frame .contour.qual
235    label .contour.qual.label -text "Line Quality: "
236    entry .contour.qual.entry -relief sunken -width 5 -textvariable ContourQuality
237
238    pack .contour.qual -side top
239    pack .contour.qual.label -side left
240    pack .contour.qual.entry -side left -fill x
241
242    frame .contour.radi
243    label .contour.radi.label -text "Width Scale: "
244    entry .contour.radi.entry -relief sunken -width 5 -textvariable ContourRadius
245
246    pack .contour.radi -side top
247    pack .contour.radi.label -side left
248    pack .contour.radi.entry -side left -fill x
249
250#
251#
252#
253#    frame .contour.iso
254#    label .contour.iso.label -text "Contour Variable: "
255#    button .contour.iso.but -textvariable ContourContour       \
256#              -command { set ContourContour [make_scalar_list]; \
257#                        UpdateVariable "ContourContour";        \
258#                        contour_set_values .contour.cont.values $ContourLines }
259#
260#    UpdateVariable "ContourContour"
261#    contour_set_values .contour.cont.values $ContourLines
262#
263#    pack .contour.iso -side top
264#    pack .contour.iso.label -side left
265#    pack .contour.iso.but -side left -fill x
266#
267#
268#
269    frame .contour.vari
270    label .contour.vari.label -text "Color Variable: "
271    button .contour.vari.but -textvariable ContourColor       \
272              -command { set ContourColor [make_scalar_list]; \
273                         UpdateVariable "ContourColor";       \
274                         .contour.set.min configure -textvariable ContourColorMin; \
275                         .contour.set.max configure -textvariable ContourColorMax; \
276                         contour_set_values .contour.cont.values $ContourLines $ContourColorMin $ContourColorMax }
277
278    UpdateVariable "ContourColor"
279
280    pack .contour.vari -side top
281    pack .contour.vari.label -side left
282    pack .contour.vari.but -side left -fill x
283#
284#
285#
286
287
288    frame .contour.buttons
289    button .contour.buttons.apply -text "Apply" -command "UpdateObject; play"
290    button .contour.buttons.close -text "Close" -command "destroy .contour"
291
292    pack .contour.buttons -side top
293    pack .contour.buttons.apply -side left
294    pack .contour.buttons.close -side left -fill x
295}
296
297contour_set_value_array $ContourLines $ContourColorMin $ContourColorMax
298