File: panel_scale.tcl

package info (click to toggle)
grass 6.0.2-6
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 40,044 kB
  • ctags: 31,303
  • sloc: ansic: 321,125; tcl: 25,676; sh: 11,176; cpp: 10,098; makefile: 5,025; fortran: 1,846; yacc: 493; lex: 462; perl: 133; sed: 1
file content (159 lines) | stat: -rw-r--r-- 4,888 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
# 4/4/95
# M. Astley
# USACERL, blah blah blah
##########################################################################
# 
# Panel to facilitate scale placement for finishing images produced
# by nviz.
#
##########################################################################

# Changes
#

# Panel specific globals
global Nv_

# Font Type: Times, Helvetica, Courier
# set Nv_(labelFontType) Times

# Font Weight: Italic, Bold
# set Nv_(labelFontWeight) Bold

# Font Point Size: varies
# set Nv_(labelFontSize) 12

##########################################################################

proc mkscalePanel { BASE } {
    global Nv_

    set panel [St_create {window name size priority} $BASE "Scale" 2 5]
    frame $BASE -relief groove -borderwidth 2
    Nv_mkPanelname $BASE "Scale Panel"
    
    ##########################################################################
    # This section contains widgets for placing a scale object
    frame $BASE.place_scale -relief groove -bd 5
    set rbase $BASE.place_scale

    button $rbase.place -text "Place Scale Object"
    frame $rbase.types
    pack $rbase.place $rbase.types
    frame $rbase.types.left
    frame $rbase.types.right
    radiobutton $rbase.types.left.solid  -text "Solid" -anchor w
    radiobutton $rbase.types.left.wire   -text "Wire"  -anchor w
    radiobutton $rbase.types.right.cube  -text "Cube"  -anchor w
    radiobutton $rbase.types.right.plane -text "Plane" -anchor w
    pack $rbase.types.left.solid $rbase.types.left.wire   -anchor w
    pack $rbase.types.right.cube $rbase.types.right.plane -anchor w
    pack $rbase.types.left $rbase.types.right -side left
    frame $rbase.bottom
    pack $rbase.bottom -side bottom
    button $rbase.bottom.place2 -text "Place Arrow" \
	-command "bind $Nv_(TOP).canvas <Button> {place_narrow %W %x %y }"
    checkbutton $rbase.bottom.narrow -text "North Arrow" -anchor w \
	-variable n_arrow -onvalue 1 -offvalue 0 
    pack $rbase.bottom.place2 $rbase.bottom.narrow -expand no -side left

    ##########################################################################
    # Separator
    Nv_makeSeparator $BASE.sep1

    ##########################################################################
    # This section contains widgets for draw ruler functionality
    frame $BASE.draw_ruler -relief groove -bd 5
    set rbase $BASE.draw_ruler

    button $rbase.draw -text "Draw Ruler" -command "draw_fringe"

    frame $rbase.where
    frame $rbase.where.top
    frame $rbase.where.bot
    label $rbase.where.top.nwl -text "NW"
    label $rbase.where.top.nel -text "NE"
    label $rbase.where.bot.swl -text "SW"
    label $rbase.where.bot.sel -text "SE"
    checkbutton $rbase.where.top.nwc -width 0 \
        -variable fringe_nw -onvalue 1 -offvalue 0
    checkbutton $rbase.where.top.nec -width 0 \
        -variable fringe_ne -onvalue 1 -offvalue 0
    checkbutton $rbase.where.bot.swc -width 0 \
        -variable fringe_sw -onvalue 1 -offvalue 0
    checkbutton $rbase.where.bot.sec -width 0 \
        -variable fringe_se -onvalue 1 -offvalue 0
    pack $rbase.where.top.nwl $rbase.where.top.nwc \
	$rbase.where.top.nec $rbase.where.top.nel -side left
    pack $rbase.where.bot.swl $rbase.where.bot.swc \
	$rbase.where.bot.sec $rbase.where.bot.sel -side left
    pack $rbase.where.top $rbase.where.bot 
    
    frame $rbase.elev
    frame $rbase.elev.entries
    frame $rbase.elev.text

    entry $rbase.elev.entries.min -width 8 -relief sunken
    entry $rbase.elev.entries.max -width 8 -relief sunken
    pack $rbase.elev.entries.min $rbase.elev.entries.max

    label $rbase.elev.text.one -text "<- elev ->" -width 10
    label $rbase.elev.text.two -text "size"       -width 10
    pack $rbase.elev.text.one $rbase.elev.text.two

    checkbutton $rbase.elev.auto -text "Auto"

    pack $rbase.elev.entries $rbase.elev.text \
	$rbase.elev.auto -side left -anchor n

    button $rbase.color -text "Color" \
	-bg \#ffffff -width 8 \
	-command "change_label_color $rbase.color"

    pack $rbase.draw $rbase.where $rbase.elev $rbase.color -expand no

    ##########################################################################
    # Pack all frames and exit
    pack $BASE.place_scale -fill x
    pack $BASE.sep1 -fill x
    pack $BASE.draw_ruler -fill x

    return $panel
}
#############################################################

######################
proc draw_fringe {} {
global Nv_
global fringe_nw fringe_ne fringe_sw fringe_se
    
set surf [Nget_current surf]
Ndraw_fringe $surf $fringe_nw $fringe_ne $fringe_sw $fringe_se
    
} 

###########################
proc place_narrow {W x y} {
global Nv_ n_arrow

set y [expr $Nv_(height) - $y]

#Draw North Arrow at selected point
if {$n_arrow == 1} {
    set curr [Nget_current surf]
    if {$curr} {
    Ndraw_Narrow $x $y $curr 
    }
#remove canvas binding
    bind $W <Button> {}
}

}