|
1 proc multiZone_open { filename } { |
|
2 # 1 means success |
|
3 global IMAGE_DISPLAY_WIN ZONING_SCALE_FACTOR DISPLAY_IMAGE XV xvprocess \ |
|
4 multiZone_display_open |
|
5 |
|
6 set open 1 |
|
7 |
|
8 if { $multiZone_display_open == $open } { |
|
9 focus .zoning_window |
|
10 } else { |
|
11 |
|
12 toplevel .zoning_window |
|
13 init_zoning_display .zoning_window |
|
14 } |
|
15 |
|
16 |
|
17 # puts stdout "Opening $filename" |
|
18 page_open $filename |
|
19 # Scale image to display |
|
20 set ZONING_SCALE_FACTOR .50 |
|
21 #[ max [expr 800.0/[get_page_height]] \ |
|
22 # [expr 800/[get_page_width]] ] |
|
23 |
|
24 # puts stdout "Done putting into page structure" |
|
25 if { 1 } { |
|
26 set display_height [expr $ZONING_SCALE_FACTOR * [get_page_height]] |
|
27 set display_width [expr $ZONING_SCALE_FACTOR * [get_page_width]] |
|
28 append geometry [expr int($display_width)] x [expr int($display_height)] |
|
29 # puts stdout "Displaying Image" |
|
30 if { $DISPLAY_IMAGE == $XV } { |
|
31 set xvprocess [exec xv $filename &] |
|
32 puts stdout "xvprocess $xvprocess" |
|
33 } else { |
|
34 # use the canvas... |
|
35 DISPLAY_INTERVALS .zoning_window.work_space $ZONING_SCALE_FACTOR |
|
36 FIND_LINES |
|
37 } |
|
38 } else { |
|
39 popup_image_failure_win |
|
40 } |
|
41 puts stdout "Determining Line boundaries" |
|
42 |
|
43 } |
|
44 |
|
45 |
|
46 proc init_zoning_display { window } { |
|
47 global ZONING_SCALE_FACTOR BACKGROUND FOREGROUND scroll_inc |
|
48 wm geometry $window 800x800 |
|
49 wm title $window "Zoning Window" |
|
50 wm minsize $window 400 300 |
|
51 $window configure -background $BACKGROUND |
|
52 |
|
53 |
|
54 set canvas_width 1000 |
|
55 set canvas_height 1000 |
|
56 |
|
57 canvas $window.work_space -bg white -xscrollcommand \ |
|
58 "$window.xscroller set" -yscrollcommand \ |
|
59 "$window.yscroller set" -xscrollincrement \ |
|
60 $scroll_inc -cursor {crosshair black gray} \ |
|
61 -width $canvas_width -height $canvas_height |
|
62 # two scrollbars |
|
63 scrollbar $window.xscroller -command "$window.work_space xview" -orient horizontal -background $BACKGROUND |
|
64 scrollbar $window.yscroller -command "$window.work_space yview" -background $BACKGROUND |
|
65 |
|
66 pack $window.xscroller -side bottom -fill x |
|
67 } |
|
68 |
|
69 proc max { a b } { |
|
70 if { [expr $a] > [expr $b] } { |
|
71 return $a |
|
72 } else { |
|
73 return $b |
|
74 } |
|
75 } |
|
76 |
|
77 |
|
78 |
|
79 |
|
80 |
|
81 set x_init 0 |
|
82 set y_init 0 |
|
83 set x_final 0 |
|
84 set y_final 0 |
|
85 |
|
86 set started_region 0 |
|
87 set region_count 0 |
|
88 |
|
89 |
|
90 proc initialize_region_grab { window } { |
|
91 # |
|
92 # |
|
93 # facilitates the grabbing of a rectangle of the window |
|
94 # using mouse button 1 |
|
95 # canvas subwindow must be called $window.work_space |
|
96 |
|
97 global x_init y_init x_final y_final started_region region_data region_list region_id arrow_in_progress current_arrow |
|
98 |
|
99 bind $window.work_space <ButtonPress-1> { |
|
100 if [expr ! $started_region] { |
|
101 grab set $window |
|
102 set x_init [$window.work_space canvasx %x] |
|
103 set y_init [$window.work_space canvasy %y] |
|
104 |
|
105 set region_id [$window.work_space create rectangle $x_init $y_init $x_init $y_init -outline black -width 3 ] |
|
106 $window.work_space itemconfigure $region_id -tags region$region_id |
|
107 |
|
108 set started_region 1 |
|
109 |
|
110 } |
|
111 } |
|
112 bind $window.work_space <ButtonRelease-1> { |
|
113 set x_final [$window.work_space canvasx %x] |
|
114 set y_final [$window.work_space canvasy %y] |
|
115 |
|
116 $window.work_space coords region$region_id $x_init $y_init $x_final $y_final |
|
117 |
|
118 |
|
119 # if finishing a rectangle, initialize its stuff in the array |
|
120 if {$x_init <= $x_final} { |
|
121 set region_data($region_id,x_init) $x_init |
|
122 set region_data($region_id,x_final) $x_final |
|
123 } else { |
|
124 set region_data($region_id,x_final) $x_init |
|
125 set region_data($region_id,x_init) $x_final |
|
126 } |
|
127 if {$y_init <= $y_final} { |
|
128 set region_data($region_id,y_init) $y_init |
|
129 set region_data($region_id,y_final) $y_final |
|
130 } else { |
|
131 set region_data($region_id,y_init) $y_final |
|
132 set region_data($region_id,y_final) $y_init |
|
133 } |
|
134 |
|
135 set region_data($region_id,next_region_id) 0 |
|
136 lappend region_list $region_id |
|
137 |
|
138 make_region_buttons $region_id |
|
139 |
|
140 set started_region 0 |
|
141 grab release $window |
|
142 } |
|
143 |
|
144 bind $window.work_space <B2-Motion> { |
|
145 if $arrow_in_progress { |
|
146 set curx [$window.work_space canvasx %x] |
|
147 set cury [$window.work_space canvasy %y] |
|
148 $window.work_space coords $current_arrow 0 0 $curx $cury |
|
149 } |
|
150 } |
|
151 bind $window.work_space <B1-Motion> { |
|
152 if $started_region { |
|
153 |
|
154 set curx [$window.work_space canvasx %x] |
|
155 set cury [$window.work_space canvasy %y] |
|
156 |
|
157 $window.work_space coords region$region_id $x_init $y_init $curx $cury |
|
158 |
|
159 |
|
160 } |
|
161 } |
|
162 bind $window <Leave> { |
|
163 # on leaving the display, release control of the mouse etc. |
|
164 # maybe make it scroll instead? |
|
165 if $started_region { |
|
166 grab release $window |
|
167 set started_region 0 |
|
168 $window.work_space coords region$region_id 0 0 0 0 |
|
169 } |
|
170 } |
|
171 } |
|
172 |
|
173 |
|
174 |
|
175 set arrow_in_progress 0 |
|
176 |
|
177 proc make_region_buttons {reg_id } { |
|
178 global region_data kill_button_data next_button_data arrow_in_progress current_arrow |
|
179 |
|
180 set x_init $region_data($reg_id,x_init) |
|
181 set y_init $region_data($reg_id,y_init) |
|
182 |
|
183 set next_num [$window.work_space create rectangle $x_init $y_init [expr $x_init + 40] [expr $y_init + 20] -tags "region$reg_id next_button$reg_id"] |
|
184 #statement above had -fill blue between 20 and -tags |
|
185 set next_button_data($next_num,reg_id) $reg_id |
|
186 $window.work_space bind next_button$reg_id <Double-2> { |
|
187 set reg_id $next_button_data([$window.work_space find withtag current],reg_id) |
|
188 if { $arrow_in_progress } { |
|
189 finish_arrow $reg_id |
|
190 } else { |
|
191 set canvas_x [$window.work_space canvasx %x] |
|
192 set canvas_y [$window.work_space canvasy %y] |
|
193 start_arrow $reg_id $canvas_x $canvas_y |
|
194 puts stdout "Starting an arrow at $canvas_x $canvas_y" |
|
195 } |
|
196 } |
|
197 set kill_num [$window.work_space create rectangle [expr $x_init] $y_init [expr $x_init + 20] [expr $y_init + 20] -fill red -tags "region$reg_id kill_button$reg_id"] |
|
198 set kill_button_data($kill_num,reg_id) $reg_id |
|
199 |
|
200 $window.work_space bind kill_button$reg_id <Double-2> { |
|
201 set reg_id $kill_button_data([$window.work_space find withtag current],reg_id) |
|
202 destroy_region $reg_id $window.work_space |
|
203 } |
|
204 } |
|
205 |
|
206 |
|
207 |
|
208 |
|
209 proc start_arrow { reg_id x_start y_start } { |
|
210 global arrow_in_progress next_button_data region_data current_arrow |
|
211 set path_name $window.work_space |
|
212 # start an arrow in the middle of the little red button |
|
213 |
|
214 |
|
215 |
|
216 set arrow [$window.work_space create line $x_start $y_start $x_start $y_start -width 3 -arrow last -arrowshape {6.0m 8.0m 1.5m} -fill blue -tags arrow$reg_id] |
|
217 |
|
218 set region_data($reg_id,arrow) $arrow |
|
219 set arrow_in_progress 1 |
|
220 set current_arrow $arrow |
|
221 } |
|
222 |
|
223 |
|
224 proc destroy_region { reg_id path_name } { |
|
225 $path_name delete region$reg_id |
|
226 puts stdout "Destroying $reg_id" |
|
227 } |
|
228 |
|
229 |
|
230 |
|
231 |
|
232 |
|
233 |
|
234 |