← Back to branch summary

~ubuntu-branches/ubuntu/vivid/grass/vivid-proposed

« back to all changes in this revision

Viewing changes to visualization/nviz/scripts/widgets.tcl

  • Committer: Package Import Robot
  • Author(s): Bas Couwenberg
  • Date: 2015-02-20 23:12:08 UTC
  • mfrom: (8.2.6 experimental)
  • Revision ID: package-import@ubuntu.com-20150220231208-1u6qvqm84v430b10
Tags: 7.0.0-1~exp1
* New upstream release.
* Update python-ctypes-ternary.patch to use if/else instead of and/or.
* Drop check4dev patch, rely on upstream check.
* Add build dependency on libpq-dev to grass-dev for libpq-fe.h.
* Drop patches applied upstream, refresh remaining patches.
* Update symlinks for images switched from jpg to png.

Show diffs side-by-side

added added

removed removed

Lines of Context:
visualization/nviz/scripts/widgets.tcl
1
 
##########################################################################
2
 
# Nviz 1.1
3
 
# USACERL 3/11/96
4
 
# further changes GRASS Development Team
5
 
# This file contains a palette of commonly used widgets.  It is
6
 
# expected that Nviz panels will be constructed using these widgets
7
 
# plus basic Tk functionality.
8
 
##########################################################################
9
 
# Update by Michael Barton, Arizona State University, Nov. 2006
10
 
#
11
 
# COPYRIGHT:    (C) 2006 GRASS Development Team
12
 
#
13
 
#               This program is free software under the GNU General Public
14
 
#               License (>=v2). Read the file COPYING that comes with GRASS
15
 
#               for details.
16
 
#
17
 
##########################################################################
18
 
if {![info exists Nauto_draw]} {set Nauto_draw 1}
19
 
 
20
 
##########################################################################
21
 
# procedure to drag canvas item
22
 
proc Nv_itemDrag {c info x y} {
23
 
        set lastx [St_get $info lastx]
24
 
        set lasty [St_get $info lasty]
25
 
        set item  [St_get $info item]
26
 
        set w [St_get $info width]
27
 
        set h [St_get $info height]
28
 
        set x [$c canvasx $x]
29
 
        set y [$c canvasy $y]
30
 
        if { $item == "puck"} {
31
 
        $c delete line
32
 
        $c create line $x $y [expr $w/2] [expr $h/2] -fill gray70 -arrow last -tags line
33
 
        }
34
 
        $c move $item [expr $x-$lastx] [expr $y-$lasty]
35
 
        St_set $info lastx $x
36
 
        St_set $info lasty $y
37
 
}
38
 
 
39
 
##########################################################################
40
 
# procedure to get current x-y position of widget
41
 
# Returns position as [list x y] ratio
42
 
##########################################################################
43
 
proc Nv_getXYPos { iname } {
44
 
        global Nv_
45
 
 
46
 
        set x [St_get $Nv_($iname) lastx]
47
 
        set y [St_get $Nv_($iname) lasty]
48
 
        set w [St_get $Nv_($iname) width]
49
 
        set h [St_get $Nv_($iname) height]
50
 
        set x [expr $x/($w + 0.0) ]
51
 
        set y [expr $y/($h + 0.0) ]
52
 
 
53
 
        return [list $x $y]
54
 
}
55
 
 
56
 
##########################################################################
57
 
# procedure to make x-y position "widget" as seen in Nviz
58
 
##########################################################################
59
 
proc Nv_mkXYScale {C {type puck} {name null} {height 100} {width 100} {x 50} {y 50} {cmd null} {upcmd null}} {
60
 
        global Nv_
61
 
        global Nauto_draw
62
 
 
63
 
        canvas $C  -relief sunken -borderwidth 3 -height $height -width $width -bg white
64
 
        set x1 [expr $x - 5]
65
 
        set x2 [expr $x + 5]
66
 
        set y1 [expr $y - 5]
67
 
        set y2 [expr $y + 5]
68
 
        if {[string compare $type puck] == 0} {
69
 
                #Draw North Arrow
70
 
                $C create text [expr $width - 2] [expr $height/2] -text [G_msg "E"] -fill black
71
 
                $C create text 3 [expr $height/2] -text [G_msg "W"] -fill black -anchor w
72
 
                $C create text [expr $width/2] 2 -text [G_msg "N"] -fill black -anchor n
73
 
                $C create text [expr $width/2] $height -text [G_msg "S"] -fill black -anchor s
74
 
                $C create line $x $y [expr $width/2] [expr $height/2] -tags line \
75
 
                   -fill gray70 -arrow last
76
 
                $C create oval $x1 $y1 $x2 $y2 -width 1 -outline gray70 -fill LightGoldenrod \
77
 
                        -tags puck
78
 
        } else {
79
 
                $C create line [expr 0 -$width] $x [expr 2 * $width] $x \
80
 
                        -width 1 -tags cross -fill gray70
81
 
                $C create line $y [expr 0 - $height] $y [expr 2*$height] \
82
 
                        -width 1 -tags cross -fill gray70
83
 
        }
84
 
        if {[string compare $name null] == 0} {set name $C.item}
85
 
        set Nv_($name) [St_create {item lastx lasty width height} $type $x $y $width $height]
86
 
        bind $C <1> "Nset_cancel 1"
87
 
        bind $C <1> "+ Nv_itemDrag $C $Nv_($name) %x %y; Nv_xyCallback $cmd $width $height %x %y "
88
 
        bind $C <B1-Motion> "Nv_itemDrag $C $Nv_($name) %x %y; Nv_xyCallback $cmd $width $height %x %y "
89
 
 
90
 
        bind $C <ButtonRelease> "Nv_itemDrag $C $Nv_($name) %x %y; Nv_xyCallback $upcmd $width $height %x %y; dodraw"
91
 
        return $C
92
 
}
93
 
 
94
 
proc dodraw {} {
95
 
        global Nauto_draw
96
 
        
97
 
        if {$Nauto_draw == 1} {
98
 
                Nset_cancel 0
99
 
                Ndraw_all
100
 
        } 
101
 
}
102
 
 
103
 
proc Nv_xyCallback { cmd w h x y } {
104
 
        global Nauto_draw
105
 
 
106
 
        if [string compare $cmd null] {
107
 
                set x [expr (1.0*$x)/$w]
108
 
                set y [expr (1.0*$y)/$h]
109
 
                $cmd $x $y
110
 
        }
111
 
}
112
 
 
113
 
##########################################################################
114
 
# procedure to change scale setting
115
 
##########################################################################
116
 
proc Nv_changeScale {S {v 0}} {
117
 
        global Nv_
118
 
        $S set $v
119
 
}
120
 
 
121
 
proc Nv_setEntry {E V} {
122
 
        $E delete 0 end; $E insert 0 $V
123
 
}
124
 
 
125
 
proc Nv_scaleCallback { S {who s} {decimal 0} {cmd null} {val 0} } {
126
 
        global Nauto_draw
127
 
        if {$who == "s"} {
128
 
                set val [expr $val/pow(10,$decimal)]
129
 
                Nv_setEntry $S.f.entry $val
130
 
        } elseif {$who == "e"} {
131
 
                set min [expr int([lindex [$S.scale configure -to] 4] / pow(10,$decimal))]
132
 
                set max [expr int([lindex [$S.scale configure -from] 4] / pow(10,$decimal))]
133
 
                if {$min > $max} {
134
 
                        set maxtmp $min
135
 
                        set min $max
136
 
                        set max $maxtmp
137
 
                        unset maxtmp
138
 
                }
139
 
                set val [$S.f.entry get]
140
 
                if {$val < $min} then {
141
 
                        $S.scale configure -to [expr int($val*pow(10,$decimal))]
142
 
                }
143
 
                if {$val > $max} then {
144
 
                        $S.scale configure -from [expr int($val*pow(10,$decimal))]
145
 
                }
146
 
                Nv_changeScale  $S.scale [expr int($val*pow(10,$decimal))]
147
 
        } elseif {$who == "b"} {
148
 
                Nv_changeScale  $S.scale $val
149
 
                set tmpval [expr $val/pow(10,$decimal)]
150
 
                Nv_setEntry $S.f.entry $tmpval
151
 
        }
152
 
 
153
 
        $cmd $val
154
 
}
155
 
 
156
 
proc Nv_floatscaleCallback { S {who s} {decimal 0} {cmd null} {val 0} } {
157
 
        # CMB Nov. 2006: As far as I can tell, decimal is completely ignored.
158
 
        #Scale
159
 
        if {$who == "s"} {
160
 
                set num [llength [split [expr int($val * 1)] ""]]
161
 
                if {$num == 1} {
162
 
                        if {$val < 0.05} {
163
 
                                #less than 0.05
164
 
                                set num [expr int($num + 2)]
165
 
                                set val [format %.5f $val]
166
 
                        } else {
167
 
                                #less than 10
168
 
                                set num [expr int($num + 4)]
169
 
                                set val [format %.3f $val]
170
 
                        }
171
 
                } else {
172
 
                        #greater than 10
173
 
                        set num [expr int($num + 3)]
174
 
                        set val [format %.2f $val]
175
 
                }
176
 
                $S.scale configure -digits $num
177
 
                Nv_setEntry $S.f.entry $val
178
 
                #Entry
179
 
        } elseif {$who == "e"} {
180
 
                set min [lindex [$S.scale configure -to] 4]
181
 
                set max [lindex [$S.scale configure -from] 4]
182
 
                set res [lindex [$S.scale configure -resolution] 4]
183
 
                set val [$S.f.entry get]
184
 
                set num [llength [split [expr int($val * 1)] ""]]
185
 
                if {$num == 1} {
186
 
                        set num [expr int($num + 4)]
187
 
                        if {$val < 0.05} {
188
 
                                set num [expr int($num + 2)]
189
 
                        }
190
 
                } else {
191
 
                        set num [expr int($num + 3)]
192
 
                }
193
 
                
194
 
                if {[expr $val < $min]} then {
195
 
                        $S.scale configure -to $val
196
 
                }
197
 
                if {[expr $val > $max]} then {
198
 
                        $S.scale configure -from $val
199
 
                }
200
 
                if {$val != 0} {
201
 
                        if {[expr abs($val)] < [expr abs($res)]} {
202
 
                                set res [expr abs($val)]
203
 
                        } else {
204
 
                                set res [expr $val/floor($val/$res)]
205
 
                        }
206
 
                        $S.scale configure -digits $num
207
 
                        $S.scale configure -resolution $res
208
 
                }
209
 
                Nv_changeScale  $S.scale $val
210
 
        } elseif {$who == "b"} {
211
 
                set min [lindex [$S.scale configure -to] 4]
212
 
                set max [lindex [$S.scale configure -from] 4]
213
 
                set res [lindex [$S.scale configure -resolution] 4]
214
 
                        set num [llength [split [expr int($val * 1)] ""]]
215
 
                if {$num == 1} {
216
 
                        set num [expr int($num + 4)]
217
 
                        set val [format %.3f $val]
218
 
                        if {$val < 0.05} {
219
 
                                set num [expr int($num + 2)]
220
 
                                set val [format %.5f $val]
221
 
                        }
222
 
                } else {
223
 
                        set num [expr int($num + 3)]
224
 
                        set val [format %.2f $val]
225
 
                }
226
 
                if {[expr $val < $min]} then {
227
 
                        $S.scale configure -to $val
228
 
                }
229
 
                if {[expr $val > $max]} then {
230
 
                        $S.scale configure -from $val
231
 
                }
232
 
                if {$val != 0} {
233
 
                        if {([expr abs($val)] < [expr abs($res)])} {
234
 
                                set res [expr abs($val)]
235
 
                        } else {
236
 
                                set res [expr abs($val/floor($val/$res))]
237
 
                        }
238
 
                        $S.scale configure -resolution $res
239
 
                }
240
 
 
241
 
                $S.scale configure -digits $num
242
 
                Nv_changeScale  $S.scale $val
243
 
                Nv_setEntry $S.f.entry $val
244
 
        }
245
 
        
246
 
        $cmd $val
247
 
 
248
 
}
249
 
 
250
 
##########################################################################
251
 
# procedures to make sliders
252
 
##########################################################################
253
 
proc Nv_mkScale { S {orient v} {name ---} {from 10000} {to 0} {curr 500} {cmd null} {decimal 0}} {
254
 
        global Nauto_draw
255
 
 
256
 
        frame $S
257
 
        frame $S.f
258
 
 
259
 
        if { $orient == "v" } {
260
 
                set side left
261
 
                set text_side top
262
 
                set orient v
263
 
        } else {
264
 
                set side top
265
 
                set text_side left
266
 
                set orient h
267
 
        }
268
 
 
269
 
        scale $S.scale -from $from -length 140 -showvalue 0 -orient $orient \
270
 
                -tickinterval 0 -to $to -width 13 \
271
 
                -activebackground gray80 -background gray90 \
272
 
                -command "Nv_scaleCallback $S s $decimal $cmd"
273
 
 
274
 
        label $S.f.label -text $name
275
 
        $S.scale set $curr
276
 
        Entry $S.f.entry -width 5 -borderwidth 2 -relief sunken \
277
 
                -command "
278
 
                        Nv_scaleCallback $S e $decimal $cmd
279
 
                        if {$Nauto_draw == 1} {
280
 
                                Nset_cancel 0
281
 
                                Ndraw_all
282
 
                        } 
283
 
                        "
284
 
 
285
 
        pack $S.scale -side $side -anchor e
286
 
        pack $S.f -side $side -anchor e
287
 
        pack $S.f.label -side $text_side
288
 
        pack $S.f.entry -side $text_side
289
 
 
290
 
        #Bind For Re-Draw Surface
291
 
        bind $S.scale <Any-ButtonRelease> {+
292
 
                if {![llength [info commands tkCancelRepeat]]} {
293
 
                        tk::unsupported::ExposePrivateCommand tkCancelRepeat
294
 
                }
295
 
                tkCancelRepeat
296
 
                if {![llength [info commands tkScaleEndDrag]]} {
297
 
                        tk::unsupported::ExposePrivateCommand tkScaleEndDrag
298
 
                }
299
 
                tkScaleEndDrag %W
300
 
                if {![llength [info commands tkScaleActivate]]} {
301
 
                        tk::unsupported::ExposePrivateCommand tkScaleActivate
302
 
                }
303
 
                tkScaleActivate %W %x %y
304
 
                if {$Nauto_draw == 1} {
305
 
                        Nset_cancel 0
306
 
                        Ndraw_all
307
 
                } 
308
 
        }
309
 
        
310
 
        return $S
311
 
}
312
 
 
313
 
proc Nv_mkFloatScale { S {orient v} {name ---} {from 10000} {to 0} {curr 500} {cmd null} {decimal 0}} {
314
 
        global Nauto_draw
315
 
        frame $S
316
 
        frame $S.f
317
 
 
318
 
        if { $orient == "v" } {
319
 
                set side left
320
 
                set text_side top
321
 
                set orient v
322
 
        } else {
323
 
                set side top
324
 
                set text_side left
325
 
                set orient h
326
 
        }
327
 
    
328
 
    # permits loading of 3D points without surface
329
 
    if {$name == [G_msg "height"] && $curr == inf} {
330
 
        set from 10000
331
 
        set to 0
332
 
        set curr 5000
333
 
    }
334
 
    if {$name == [G_msg "z-exag"] && $from == 0.0 && $to == 0.0 && $curr == 0.0 } {
335
 
        set from 10.0 
336
 
        set to 0.0 
337
 
        set curr 1.000000
338
 
    }
339
 
        
340
 
        #calculate number length for digits var
341
 
        set num [llength [split [expr int($curr * 1)] ""]]
342
 
        if {$num == 1} {
343
 
                set num [expr int($num + 4)]
344
 
                if {$curr < 0.05} {
345
 
                        set num [expr int($num + 2)]
346
 
                }
347
 
        } else {
348
 
                set num [expr int($num + 3)]
349
 
        }
350
 
 
351
 
        scale $S.scale -from $from -length 140 -showvalue 0 -orient $orient \
352
 
                -digits $num -resolution [expr -1.0 * (($to - $from)/140.0)] \
353
 
                -tickinterval 0 -to $to -width 13 \
354
 
                -command "Nv_floatscaleCallback $S s 0 $cmd " \
355
 
                -activebackground gray80 -background gray90
356
 
                
357
 
        label $S.f.label -text $name
358
 
        Entry $S.f.entry -width 5 -borderwidth 2 -relief sunken \
359
 
                -command "
360
 
                        Nv_floatscaleCallback $S e 0 $cmd
361
 
                        if {$Nauto_draw == 1} {
362
 
                                Nset_cancel 0
363
 
                                Ndraw_all
364
 
                        } 
365
 
                        "
366
 
 
367
 
        pack $S.scale -side $side
368
 
        pack $S.f -side $side
369
 
        pack $S.f.label -side $text_side
370
 
        pack $S.f.entry -side $text_side
371
 
 
372
 
        #Bind For Re-Draw Surface
373
 
        bind $S.scale <Any-ButtonRelease> {+
374
 
                if {![llength [info commands tkCancelRepeat]]} {
375
 
                        tk::unsupported::ExposePrivateCommand tkCancelRepeat
376
 
                }
377
 
                tkCancelRepeat
378
 
                if {![llength [info commands tkScaleEndDrag]]} {
379
 
                        tk::unsupported::ExposePrivateCommand tkScaleEndDrag
380
 
                }
381
 
                tkScaleEndDrag %W
382
 
                if {![llength [info commands tkScaleActivate]]} {
383
 
                        tk::unsupported::ExposePrivateCommand tkScaleActivate
384
 
                }
385
 
                tkScaleActivate %W %x %y
386
 
                if {$Nauto_draw == 1} {
387
 
                        Nset_cancel 0
388
 
                        Ndraw_all
389
 
                } 
390
 
        }
391
 
 
392
 
        Nv_floatscaleCallback $S b 0 $cmd $curr
393
 
 
394
 
        return $S
395
 
}
396
 
 
397
 
############################################################################
398
 
# procedure to make      pulldown menus for menu buttons
399
 
###########################################################################
400
 
proc Nv_mkMenu { P mname bnames underlines commands} {
401
 
        global Nv_
402
 
 
403
 
        menubutton $P -text $mname -menu $P.m -underline 0
404
 
        menu $P.m
405
 
        set j 0
406
 
        foreach i $bnames {
407
 
                set cmd [concat [lindex $commands $j] \"$i\"]
408
 
                set underline [lindex $underlines $j]
409
 
                if { [lindex $cmd 0] == "Separator"} {
410
 
                        $P.m add separator
411
 
                } elseif { [lindex $cmd 0] == "Cascade"} {
412
 
                        set menu_name [lindex $cmd 1]
413
 
                        set menu_build [lindex $cmd 2]
414
 
                        $P.m add cascade -label $i -underline $underline -menu \
415
 
                        $P.m.$menu_name
416
 
                        $menu_build $P.m.$menu_name
417
 
                } else {
418
 
                        $P.m add command -label $i -underline $underline -command \
419
 
                                "inform [concat $i]; $cmd"
420
 
                }
421
 
                incr j
422
 
        }
423
 
        
424
 
        return $P
425
 
}
426
 
 
427
 
proc incrEntry { E } {
428
 
        set val [$E get]
429
 
        if {[catch {incr val}]} {set val 1}
430
 
 
431
 
        $E delete 0 end
432
 
        $E insert 0 $val
433
 
}
434
 
proc decrEntry { E } {
435
 
        set val [$E get]
436
 
        if {[catch {incr val -1}]} {set val 1}
437
 
        if {$val < 1} {set val 1}
438
 
 
439
 
        $E delete 0 end
440
 
        $E insert 0 $val
441
 
}
442
 
 
443
 
 
444
 
proc Nv_mkArrows {A {name ""} {cmd null} {val 1} {orient v} } {
445
 
        global bit_map_path
446
 
        frame $A
447
 
        frame $A.f1
448
 
        frame $A.f2
449
 
 
450
 
        if { $orient == "v" } {
451
 
                set side left
452
 
                set text_side top
453
 
                set up up
454
 
                set down down
455
 
                set orient v
456
 
        } else {
457
 
                set side top
458
 
                set text_side left
459
 
                set up right
460
 
                set down left
461
 
                set orient h
462
 
        }
463
 
 
464
 
        button $A.f1.up -bitmap @$bit_map_path/$up -command "incrEntry $A.f2.entry; $cmd $A.f2.entry"
465
 
        button $A.f1.down -bitmap @$bit_map_path/$down -command "decrEntry $A.f2.entry; $cmd $A.f2.entry"
466
 
 
467
 
        pack $A.f1.up $A.f1.down -side $text_side
468
 
        label $A.f2.label -text $name
469
 
        entry $A.f2.entry -width 5      -relief flat
470
 
        $A.f2.entry delete 0 end
471
 
        $A.f2.entry insert 0 $val
472
 
        pack $A.f1 -side $side
473
 
        pack $A.f2.label -side $text_side
474
 
        pack $A.f2.entry -side $text_side
475
 
        pack $A.f2 -side $side
476
 
 
477
 
        return $A
478
 
}
479
 
############################################################
480
 
proc Nv_mkPanelname {P name} {
481
 
 
482
 
        frame $P.name -relief groove -borderwidth 2
483
 
        Label $P.name.label -text $name
484
 
        pack $P.name  -fill x -side top
485
 
        pack $P.name.label -expand 1
486
 
 
487
 
        return $P.name
488
 
}
489
 
 
490
 
#########################################################
491
 
proc Nv_mkAttbutton {P name} {
492
 
        frame $P.$name
493
 
        button $P.$name.b -text "$name" -anchor nw -width 10 \
494
 
        -command "mkAttPopup $P.$name.pop $name 1"
495
 
 
496
 
        set txt [get_curr_status $name]
497
 
 
498
 
        label $P.$name.l -text $txt -anchor ne
499
 
        pack $P.$name.b -side left
500
 
        pack $P.$name.l -side right
501
 
 
502
 
        return $P.$name
503
 
}
504
 
 
505
 
###################################################################
506
 
# makes sunken frame with a checkbutton for each item in list L
507
 
###################################################################
508
 
proc Nv_mkSurfacelist { P L C type} {
509
 
 
510
 
        frame $P -relief sunken
511
 
        set j 0
512
 
        foreach i $L {
513
 
                set name [Nget_map_name $i surf]
514
 
                checkbutton $P.$j  -relief flat -text $name -anchor w\
515
 
                        -command "change_surf_list $C $i" \
516
 
                        -variable "SL$P.$j"
517
 
                        if {0 != [$C surf_is_selected Nsurf$i]} {
518
 
                                $P.$j select
519
 
                        } else {
520
 
                                $P.$j deselect
521
 
                        }
522
 
        
523
 
                pack $P.$j -fill x -expand 1 -side top
524
 
                incr j
525
 
        }
526
 
 
527
 
        return $P
528
 
}
529
 
 
530
 
proc change_surf_list {C id} {
531
 
 
532
 
        if {0 != [$C surf_is_selected Nsurf$id]} {
533
 
                $C unselect_surf Nsurf$id
534
 
        } else {
535
 
                $C select_surf Nsurf$id
536
 
        }
537
 
 
538
 
}
539
 
 
540
 
proc auto_enable_data {id type} {
541
 
 
542
 
        if {$type == "vect"} {
543
 
                set list [Nget_vect_list]
544
 
                foreach i $list {
545
 
                        if {0 == [Nvect$i surf_is_selected Nsurf$id]} {
546
 
                                Nvect$i select_surf Nsurf$id
547
 
                        }
548
 
                }
549
 
        }
550
 
        if {$type == "site"} {
551
 
                        set list [Nget_site_list]
552
 
                        foreach i $list {
553
 
                                if {0 == [Nsite$i surf_is_selected Nsurf$id]} {
554
 
                                        Nsite$i select_surf Nsurf$id
555
 
                                }
556
 
                        }
557
 
        }
558
 
 
559
 
}
560
 
 
561
 
proc Nget_map_list { type } {
562
 
        set map_list ""
563
 
 
564
 
        switch $type {
565
 
                "surf"  { set map_list [Nget_surf_list] }
566
 
                "vect"  { set map_list [Nget_vect_list] }
567
 
                "site"  { set map_list [Nget_site_list] }
568
 
                "vol"   { set map_list [Nget_vol_list] }
569
 
        }
570
 
 
571
 
        return $map_list
572
 
}
573
 
 
574
 
proc Nget_map_name {id type} {
575
 
        switch $type {
576
 
                "surf" {
577
 
                        set map_name [Nsurf$id get_att topo]
578
 
                        if {[lindex $map_name 0] == "map"} then {
579
 
                                return [lindex $map_name 1]
580
 
                        } else {
581
 
                                return "constant#$id"
582
 
                        }
583
 
                }
584
 
                "vect" { return [Nvect$id get_att map] }
585
 
                "site" { return [Nsite$id get_att map] }
586
 
                "vol" { return [Nvol$id get_att map] }
587
 
        }
588
 
}
589
 
 
590
 
proc mkMapList { P type {cmd null}} {
591
 
        catch {destroy $P}
592
 
        set list [Nget_map_list $type]
593
 
        set name [Nget_current $type]
594
 
 
595
 
        if {[llength $list] == 0} {
596
 
                set name [G_msg "None Loaded"]
597
 
        } else {
598
 
                set n [lsearch $list $name]
599
 
                set list [lreplace $list $n $n]
600
 
                set name [Nget_map_name $name $type]
601
 
        }
602
 
 
603
 
        menubutton $P -text $name -menu $P.m -relief sunken
604
 
        menu $P.m -tearoff 0
605
 
        foreach i $list {
606
 
                set map_name [Nget_map_name $i $type]
607
 
                $P.m add command -label "$map_name" \
608
 
                        -command "inform Current $type: $i; set_new_curr $type $i; $cmd $i"
609
 
        }
610
 
 
611
 
 
612
 
        return $P
613
 
}
614
 
 
615
 
proc set_new_curr {type name} {
616
 
        global Nv_
617
 
 
618
 
        if { $name != 0 } then {
619
 
                set L [Nget_map_list $type]
620
 
                set n [lsearch -exact $L $name]
621
 
                #puts "NAME = [Nget_map_name $name $type] LIST = $L INTERNAL NAME: $name"
622
 
        }
623
 
 
624
 
        Nset_current $type $name
625
 
 
626
 
        # reset panel
627
 
        set cmd mk$type\Panel
628
 
        set W $Nv_(P_AREA).$type
629
 
        set pos [Q_get_pos $Nv_(Q) $Nv_($W)]
630
 
        $cmd $W
631
 
        Nv_openPanel $type $pos
632
 
}
633
 
 
634
 
 
635
 
############################################################
636
 
# These two routines replace equivalent routines in C code #
637
 
############################################################
638
 
proc Nget_current { type } {
639
 
        global Nv_
640
 
 
641
 
        switch $type {
642
 
        "surf" { return $Nv_(CurrSurf) }
643
 
        "vect" { return $Nv_(CurrVect) }
644
 
        "site" { return $Nv_(CurrSite) }
645
 
        "sdiff" { return $Nv_(CurrSdiff) }
646
 
        "vol"  { return $Nv_(CurrVol) }
647
 
        }
648
 
}
649
 
 
650
 
proc Nset_current { type id } {
651
 
        global Nv_
652
 
 
653
 
        switch $type {
654
 
        "surf" { set Nv_(CurrSurf) $id }
655
 
        "vect" { set Nv_(CurrVect) $id }
656
 
        "site" { set Nv_(CurrSite) $id }
657
 
        "sdiff" { set Nv_(CurrSdiff) $id }
658
 
        "vol"  { set Nv_(CurrVol) $id }
659
 
        }
660
 
}
661
 
 
662
 
# Quick routine to make a separator widget
663
 
proc Nv_makeSeparator { name } {
664
 
        canvas $name -relief raised -height 2m -width 5m -bg \#111111
665
 
}
666
 
 
667