Update the changelog
[opencv] / apps / cvcsdemo / cvcsdemo.tcl
1 #########################################################################################\r
2 #\r
3 #  IMPORTANT: READ BEFORE DOWNLOADING, COPYING, INSTALLING OR USING.\r
4 #\r
5 #  By downloading, copying, installing or using the software you agree to this license.\r
6 #  If you do not agree to this license, do not download, install,\r
7 #  copy or use the software.\r
8 #\r
9 #\r
10 #                        Intel License Agreement\r
11 #                For Open Source Computer Vision Library\r
12 #\r
13 # Copyright (C) 2000, Intel Corporation, all rights reserved.\r
14 # Third party copyrights are property of their respective owners.\r
15 #\r
16 # Redistribution and use in source and binary forms, with or without modification,\r
17 # are permitted provided that the following conditions are met:\r
18 #\r
19 #   * Redistribution's of source code must retain the above copyright notice,\r
20 #     this list of conditions and the following disclaimer.\r
21 #\r
22 #   * Redistribution's in binary form must reproduce the above copyright notice,\r
23 #     this list of conditions and the following disclaimer in the documentation\r
24 #     and/or other materials provided with the distribution.\r
25 #\r
26 #   * The name of Intel Corporation may not be used to endorse or promote products\r
27 #     derived from this software without specific prior written permission.\r
28 #\r
29 # This software is provided by the copyright holders and contributors "as is" and\r
30 # any express or implied warranties, including, but not limited to, the implied\r
31 # warranties of merchantability and fitness for a particular purpose are disclaimed.\r
32 # In no event shall the Intel Corporation or contributors be liable for any direct,\r
33 # indirect, incidental, special, exemplary, or consequential damages\r
34 # (including, but not limited to, procurement of substitute goods or services;\r
35 # loss of use, data, or profits; or business interruption) however caused\r
36 # and on any theory of liability, whether in contract, strict liability,\r
37 # or tort (including negligence or otherwise) arising in any way out of\r
38 # the use of this software, even if advised of the possibility of such damage.\r
39 #\r
40 #\r
41 \r
42 if {$tcl_platform(platform) == "windows"} {\r
43     set default_normal_bg SystemButtonFace\r
44     set default_normal_fg SystemButtonText\r
45     set default_light_bg SystemScrollbar\r
46     set default_dark_bg SystemDisabledText\r
47     set default_window_bg SystemWindow\r
48     set default_window_fg SystemWindowText\r
49     set default_select_bg SystemHighlight\r
50     set default_select_fg SystemHighlightText\r
51 } else {\r
52     set default_normal_bg #909090\r
53     set default_normal_fg #000000\r
54     set default_light_bg #000000\r
55     set default_dark_bg #303030\r
56     set default_window_bg #909090\r
57     set default_window_fg #000000\r
58     set default_select_bg #000080\r
59     set default_select_fg #ffffff\r
60 }\r
61 \r
62 namespace eval CVCsDemo {\r
63         variable mainf\r
64     variable sclframe\r
65         variable tb\r
66         variable statustext\r
67 \r
68     variable nb\r
69 \r
70         variable showtb 1\r
71         variable showstb 1\r
72         \r
73     variable curcam\r
74 \r
75     variable curpage\r
76     variable curframe\r
77         variable curX "---"\r
78         variable curY "---"\r
79     \r
80     variable pagesnum 0\r
81     variable pagescount 0\r
82     \r
83     variable cams {}\r
84     variable pages {}\r
85 \r
86     variable capturestate "0"\r
87     variable pausestate "0"\r
88         variable avistate "0"\r
89     variable trackstate "0"\r
90     variable nightstate "0"\r
91     variable histstate "0"\r
92     variable cam "0"\r
93 }\r
94 \r
95 proc CVCsDemo::Modify {} {\r
96     set CVCsDemo::cam [.dlg.frame.cb getvalue]\r
97 }\r
98 \r
99 proc CVCsDemo::longmenu {on} {\r
100         if {$on} {\r
101                 .menubar.file entryconfig 1 -state active\r
102         } else {\r
103                 .menubar.file entryconfig 1 -state disabled\r
104         }\r
105 }\r
106 \r
107 proc CVCsDemo::longstbar {on} {\r
108         if {$on} {\r
109                 pack $CVCsDemo::mainf.status.indf.f0 -side left -fill y -expand 1               \r
110         } else {\r
111                 pack forget $CVCsDemo::mainf.status.indf.f0             \r
112         }\r
113 }\r
114 \r
115 proc CVCsDemo::longbar {on} {\r
116         if {$on} {\r
117                 pack $CVCsDemo::tb.bbox1 -side left -anchor w\r
118                 pack $CVCsDemo::tb.sep1 -side left -fill y -padx 4 -anchor w\r
119                 pack $CVCsDemo::tb.bbox2 -side left -anchor w\r
120                 pack $CVCsDemo::tb.sep2 -side left -fill y -padx 4 -anchor w\r
121         pack $CVCsDemo::tb.bbox3 -side left -anchor w\r
122                 pack $CVCsDemo::tb.sep3 -side left -fill y -padx 4 -anchor w\r
123         pack $CVCsDemo::tb.bbox4 -side left -anchor w\r
124         pack $CVCsDemo::sclframe -side bottom -expand no -anchor sw -fill x\r
125         } else {\r
126         pack forget $CVCsDemo::tb.bbox4\r
127         pack forget $CVCsDemo::tb.sep3\r
128                 pack forget $CVCsDemo::tb.bbox3\r
129                 pack forget $CVCsDemo::tb.sep2\r
130                 pack forget $CVCsDemo::tb.bbox2\r
131                 pack forget $CVCsDemo::tb.sep1\r
132                 pack forget $CVCsDemo::tb.bbox1\r
133         pack forget $CVCsDemo::sclframe\r
134         }\r
135 }\r
136 \r
137 proc CVCsDemo::about {} {\r
138     set dlg [Dialog .aboutdlg -parent . -modal local \\r
139                  -separator 1           \\r
140                  -title   "About CVCsDemo"      \\r
141                  -side    right         \\r
142                  -anchor  s                     \\r
143                  -default 0]\r
144     $dlg add -name ok -width 5\r
145     \r
146         set top [$dlg getframe]\r
147             \r
148         image create photo original -file [file join $::image_path pictures/CVCsDemo.gif]\r
149         canvas $top.c -bd 2 -relief ridge -width 295 -height 195 \r
150         $top.c create image 0 0 -anchor nw -image original\r
151         pack $top.c -side top -expand yes -fill x\r
152 \r
153     set frame [frame $top.f -background white -bd 2 -relief ridge]\r
154     set lab  [label $frame.lab1 -text \\r
155                 "Program CVCsDemo v. 1.0 \nIntel corporation. 2001 y."  \\r
156                            -background white -font {times 8}]\r
157     pack $lab\r
158     pack $frame -side top -expand yes -fill x -padx 2 -pady 2\r
159 \r
160     $dlg draw\r
161     destroy $dlg\r
162 }\r
163 \r
164 proc getvar {name value} {\r
165     upvar $name localVar\r
166     upvar $value lvalue\r
167         \r
168     set localVar $lvalue\r
169 }\r
170 \r
171 proc CVCsDemo::raisetab { } {\r
172     set CVCsDemo::curpage [$CVCsDemo::nb raise]\r
173     set CVCsDemo::curframe [$CVCsDemo::nb getframe $CVCsDemo::curpage].lab\r
174     set pos [lsearch $CVCsDemo::pages $CVCsDemo::curpage]\r
175     set CVCsDemo::curcam [lindex $CVCsDemo::cams $pos]   \r
176 }\r
177 \r
178 proc CVCsDemo::createtab {page text} {\r
179     set path [$CVCsDemo::nb insert end $page -text $text \\r
180               -raisecmd CVCsDemo::raisetab]\r
181     \r
182     label $path.lab -text "" -bg black -relief sunken\r
183     pack $path.lab  -side top  -expand yes -fill both\r
184 \r
185     bind $path.lab <ButtonPress-1> {\r
186         pButtonPress %x %y\r
187         }\r
188 \r
189     bind $path.lab <ButtonRelease-1> {\r
190         pButtonRelease %x %y\r
191         }\r
192 \r
193     bind $path.lab <Motion> {\r
194         pMotion %x %y\r
195         }\r
196 \r
197     bind $path.lab <Configure> {\r
198         pConfigure\r
199         }\r
200 }\r
201 \r
202 proc CVCsDemo::new {} {\r
203 \r
204         if {$CVCsDemo::pagesnum == 0} {\r
205                 set CVCsDemo::avistate "0"\r
206     \r
207                 incr CVCsDemo::pagescount\r
208                 incr CVCsDemo::pagesnum\r
209 \r
210         CVCsDemo::longmenu 1\r
211         CVCsDemo::longbar 1\r
212         CVCsDemo::longstbar 1\r
213 \r
214         set CVCsDemo::curpage p[expr $CVCsDemo::pagescount]\r
215         lappend CVCsDemo::pages $CVCsDemo::curpage\r
216         lappend CVCsDemo::cams $CVCsDemo::curcam\r
217 \r
218         set text [format "Camera %i" $CVCsDemo::pagescount]\r
219         CVCsDemo::createtab $CVCsDemo::curpage $text\r
220     \r
221         $CVCsDemo::nb see [$CVCsDemo::nb pages end]\r
222         $CVCsDemo::nb raise [$CVCsDemo::nb pages end]\r
223         update\r
224         pInitCamera\r
225     } else {\r
226                 tk_dialog .mes {Message} { CVCsDemo support only one camera.} {} 0 OK" \r
227     }\r
228 }\r
229 \r
230 proc CVCsDemo::close {} {\r
231 \r
232         set pos [lsearch $CVCsDemo::cams $CVCsDemo::curcam]\r
233         set $CVCsDemo::cams [lreplace $CVCsDemo::cams $pos $pos]\r
234         set $CVCsDemo::pages [lreplace $CVCsDemo::pages $pos $pos]\r
235 \r
236     $CVCsDemo::nb delete $CVCsDemo::curpage 1\r
237     \r
238         if {$CVCsDemo::curcam != ""} {\r
239                 #set ind [$CVCsDemo::tree index $CVCsDemo::curfile]\r
240                 #$CVCsDemo::tree delete $CVCsDemo::curfile\r
241         }\r
242 \r
243     set CVCsDemo::pagesnum [expr $CVCsDemo::pagesnum - 1]\r
244 \r
245         if {$CVCsDemo::pagesnum == 0} {\r
246                 CVCsDemo::longmenu 0\r
247                 CVCsDemo::longbar 0\r
248                 #CVCsDemo::longstbar 0\r
249                 set CVCsDemo::curcam ""\r
250         } else {\r
251                 set page [$CVCsDemo::nb pages end]\r
252 \r
253                 set pos [lsearch $CVCsDemo::pages $CVCsDemo::curpage]\r
254                 set CVCsDemo::curcam [lindex $CVCsDemo::cams $pos]\r
255                         \r
256                 $CVCsDemo::nb see $page\r
257         $CVCsDemo::nb raise $page\r
258     }\r
259     \r
260     if {$CVCsDemo::avistate == 0} {\r
261                 pCloseCamera\r
262         } else {\r
263                 pStopAvi\r
264         }\r
265 \r
266     $CVCsDemo::tb.bbox1.b0 configure -relief raised \\r
267             -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]]\r
268     set CVCsDemo::capturestate 0\r
269 }\r
270 \r
271 proc CVCsDemo::pause {} {\r
272         \r
273         if { $CVCsDemo::pausestate == 1 } {\r
274         $CVCsDemo::tb.bbox1.b1 configure -relief raised \\r
275             -image [Bitmap::get [file join $::image_path pictures/pause.gif]]\r
276         set CVCsDemo::pausestate 0\r
277                 \r
278                 if {$CVCsDemo::avistate == 0} {\r
279                         pResumeCamera\r
280                 } else {\r
281                         pResumeAvi\r
282                 }\r
283 \r
284         #$CVCsDemo::tb.bbox1.b1 configure -state disable\r
285                 #$CVCsDemo::tb.bbox2.b0 configure -state disable\r
286         #$CVCsDemo::tb.bbox2.b1 configure -state disable\r
287         #$CVCsDemo::tb.bbox2.b2 configure -state disable\r
288     } else {\r
289         $CVCsDemo::tb.bbox1.b1 configure -relief sunken \\r
290             -image [Bitmap::get [file join $::image_path pictures/pause.gif]]\r
291         set CVCsDemo::pausestate 1\r
292 \r
293         if {$CVCsDemo::avistate == 0} {\r
294                         pPauseCamera\r
295                 } else {\r
296                         pPauseAvi\r
297                 }\r
298 \r
299         #$CVCsDemo::tb.bbox1.b1 configure -state active\r
300                 #$CVCsDemo::tb.bbox2.b0 configure -state active\r
301         #$CVCsDemo::tb.bbox2.b1 configure -state disable\r
302         #$CVCsDemo::tb.bbox2.b2 configure -state disable\r
303     }\r
304 }\r
305 \r
306 proc CVCsDemo::capture {} {\r
307         \r
308         if { $CVCsDemo::capturestate == 1 } {\r
309         $CVCsDemo::tb.bbox1.b0 configure -relief raised \\r
310             -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]]\r
311         set CVCsDemo::capturestate 0\r
312         pStopCamera\r
313 \r
314         $CVCsDemo::tb.bbox1.b1 configure -state disable\r
315                 $CVCsDemo::tb.bbox2.b0 configure -state disable\r
316         $CVCsDemo::tb.bbox2.b1 configure -state disable\r
317         $CVCsDemo::tb.bbox2.b2 configure -state disable\r
318     } else {\r
319         $CVCsDemo::tb.bbox1.b0 configure -relief sunken \\r
320             -image [Bitmap::get [file join $::image_path pictures/capture.gif]]\r
321         set CVCsDemo::capturestate 1\r
322 \r
323         if {$CVCsDemo::avistate == 0} {\r
324                         pStartCamera\r
325                 } else {\r
326                         pStartAvi\r
327                 }\r
328 \r
329         $CVCsDemo::tb.bbox1.b1 configure -state active\r
330                 $CVCsDemo::tb.bbox2.b0 configure -state active\r
331         $CVCsDemo::tb.bbox2.b1 configure -state disable\r
332         $CVCsDemo::tb.bbox2.b2 configure -state disable\r
333     }\r
334 }\r
335 \r
336 proc CVCsDemo::track {} {\r
337 \r
338     if { $CVCsDemo::trackstate == 1 } {\r
339         $CVCsDemo::tb.bbox2.b0 configure -relief raised \\r
340             -image [Bitmap::get [file join $::image_path pictures/trackoff.gif]]\r
341         set CVCsDemo::trackstate 0\r
342         pResetTrack\r
343         $CVCsDemo::tb.bbox2.b1 configure -state disable\r
344         $CVCsDemo::tb.bbox2.b2 configure -state disable\r
345     } else {\r
346         $CVCsDemo::tb.bbox2.b0 configure -relief sunken \\r
347             -image [Bitmap::get [file join $::image_path pictures/track.gif]]\r
348         set CVCsDemo::trackstate 1\r
349         pSetTrack\r
350         $CVCsDemo::tb.bbox2.b1 configure -state active\r
351         $CVCsDemo::tb.bbox2.b2 configure -state active\r
352     }\r
353 }\r
354 \r
355 proc CVCsDemo::night {} {\r
356 \r
357     if { $CVCsDemo::nightstate == 1 } {\r
358         $CVCsDemo::tb.bbox2.b1 configure -relief raised \\r
359             -image [Bitmap::get [file join $::image_path pictures/nightoff.gif]]\r
360         set CVCsDemo::nightstate 0\r
361         pResetNight\r
362         $CVCsDemo::tb.bbox2.b2 configure -state active\r
363     } else {\r
364         $CVCsDemo::tb.bbox2.b1 configure -relief sunken \\r
365             -image [Bitmap::get [file join $::image_path pictures/night.gif]]\r
366         set CVCsDemo::nightstate 1\r
367         pSetNight\r
368         $CVCsDemo::tb.bbox2.b2 configure -state disable\r
369     }\r
370 }\r
371 \r
372 proc CVCsDemo::gist {} {\r
373 \r
374     if { $CVCsDemo::histstate == 1 } {\r
375         $CVCsDemo::tb.bbox2.b2 configure -relief raised \\r
376             -image [Bitmap::get [file join $::image_path pictures/gist.gif]]\r
377         set CVCsDemo::histstate 0\r
378         pResetHist\r
379         $CVCsDemo::tb.bbox2.b1 configure -state active\r
380     } else {\r
381         $CVCsDemo::tb.bbox2.b2 configure -relief sunken \\r
382             -image [Bitmap::get [file join $::image_path pictures/gist.gif]]\r
383         set CVCsDemo::histstate 1\r
384         pSetHist\r
385         $CVCsDemo::tb.bbox2.b1 configure -state disable\r
386     }\r
387 }\r
388 \r
389 proc CVCsDemo::setvideo {} {\r
390     pSetVideo\r
391 }\r
392 \r
393 proc CVCsDemo::camera {} {\r
394     pSetCameraOpt\r
395 }\r
396 \r
397 proc CVCsDemo::create { } {\r
398         variable prgindic 0\r
399         variable prgtext\r
400         ## Create intro\r
401     ###################################################################\r
402     set top [toplevel .intro -relief raised -borderwidth 2]\r
403     wm withdraw $top\r
404     wm overrideredirect $top 1\r
405         \r
406         image create photo original -file [file join $::image_path pictures/CVCsDemo.gif]\r
407         canvas $top.c -bd 2 -relief ridge -width 295 -height 195 \r
408         $top.c create image 0 0 -anchor nw -image original\r
409         pack $top.c -side top -expand yes -fill x\r
410 \r
411     set frame [frame $top.f -background white -bd 2 -relief ridge]\r
412     set lab1  [label $frame.lab1 -text "Please wait for loading..."     \\r
413                            -background white -font {times 8}]\r
414     set lab2  [label $frame.lab2 -textvariable CVCsDemo::prgtext        \\r
415                            -background white -font {times 8} -width 35]\r
416     set prg   [ProgressBar $frame.prg -width 50 -height 10              \\r
417                            -background white -variable CVCsDemo::prgindic -maximum 7]\r
418     pack $lab1 $prg $lab2\r
419     pack $frame -side top -expand yes -fill x -padx 2 -pady 2\r
420 \r
421     BWidget::place $top 0 0 center\r
422     wm deiconify $top\r
423 \r
424         ###################################################################\r
425         \r
426         set CVCsDemo::prgtext "Loading font..."\r
427         update\r
428         SelectFont::loadfont\r
429 \r
430         incr CVCsDemo::prgindic\r
431         set CVCsDemo::prgtext   "Creating menu..."\r
432     update\r
433 \r
434     #### Menu\r
435     set menu {\r
436         "&File" all file 0 {\r
437             {command "&New" {} "New document" {} -command CVCsDemo::new}\r
438                         {command "&Close" {} "Close the document" {} -state disable     \\r
439                                 -command CVCsDemo::close}\r
440                         {separator}\r
441                         {command "E&xit" {} "Exit the program" {} -command exit}\r
442         }\r
443         "&View" all view 0 {\r
444             {checkbutton "&Toolbar" {all view} "Show/hide toolbar" {}   \\r
445                 -variable CVCsDemo::showtb      \\r
446                 -command {$CVCsDemo::mainf showtoolbar 0 $CVCsDemo::showtb}\r
447             }\r
448                         {checkbutton "&Statusbar" {all view} "Show/hide statusbar" {}   \\r
449                 -variable CVCsDemo::showstb     \\r
450                 -command {\r
451                                                         if {$CVCsDemo::showstb} {\r
452                                                                 pack $CVCsDemo::mainf.botf -side bottom -fill x \r
453                                                         } else {\r
454                                                                 pack forget $CVCsDemo::mainf.botf\r
455                                                         }\r
456                                                  }\r
457             }\r
458         }\r
459                 "&Options" all options 0 {\r
460                         {command "Came&ra" {} "Colors & fonts setup" {} -command CVCsDemo::camera}\r
461             {command "&Video" {} "Colors & fonts setup" {} -command CVCsDemo::setvideo}\r
462                 }\r
463                 "&Help" all help 0 {\r
464                         {command "&About CVCsDemo" {} "Display the program info" {}     \\r
465                          -command CVCsDemo::about}\r
466         }\r
467     }\r
468 \r
469     incr CVCsDemo::prgindic\r
470         set CVCsDemo::prgtext   "Creating MainFrame..."\r
471     update\r
472 \r
473     set CVCsDemo::mainf [MainFrame .mainf -menu $menu   \\r
474                       -textvariable CVCsDemo::statustext]\r
475 \r
476     menu .menubar.edit -tearoff 0 -background $::default_normal_bg\r
477     MainFrame::_create_entries .mainf .menubar.edit \\r
478                 $::default_normal_bg {\\r
479                         {command "Cu&t" {} "Cut the selection" {} -command cut}\r
480                         {command "&Copy" {} "Copy the selection" {} -command copy}\r
481                         {command "&Paste" {} "Paste the clipboard" {} -command paste}\r
482                         {separator}\r
483                         {command "&Go to.." {} "Move to a specified place" {} -command paste}\r
484         }\r
485 \r
486         incr CVCsDemo::prgindic\r
487         set CVCsDemo::prgtext   "Creating toolbar..."\r
488     update\r
489 \r
490     #### toolbars creation\r
491     set CVCsDemo::tb  [$CVCsDemo::mainf addtoolbar]\r
492 \r
493     set bbox [ButtonBox $CVCsDemo::tb.bbox0 -spacing 0 -padx 1 -pady 1]\r
494     $bbox add -image [Bitmap::get [file join $::image_path pictures/new.gif]] \\r
495         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 2  \\r
496                 -padx 1 -pady 1 -helptext "Add new camera" -command CVCsDemo::new\r
497         $bbox add -image [Bitmap::get [file join $::image_path pictures/open.gif]] \\r
498         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 2  \\r
499                 -padx 1 -pady 1 -helptext "Load Avi" -command pInitAvi\r
500     pack $bbox -side left -anchor w\r
501     \r
502     set sep [Separator $CVCsDemo::tb.sep0 -orient vertical]\r
503     pack $sep -side left -fill y -padx 4 -anchor w\r
504 \r
505         set bbox [ButtonBox $CVCsDemo::tb.bbox1 -spacing 0 -padx 1 -pady 1]\r
506     $bbox add -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]] \\r
507         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
508                 -padx 1 -pady 1 -helptext "Start/Stop capture" -command CVCsDemo::capture\r
509         $bbox add -image [Bitmap::get [file join $::image_path pictures/pause.gif]] \\r
510         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
511                 -padx 1 -pady 1 -helptext "Pause" -command CVCsDemo::pause -state disable\r
512            \r
513     set sep [Separator $CVCsDemo::tb.sep1 -orient vertical]\r
514 \r
515     set bbox [ButtonBox $CVCsDemo::tb.bbox2 -spacing 0 -padx 1 -pady 1]\r
516     $bbox add -image [Bitmap::get [file join $::image_path pictures/trackoff.gif]] \\r
517         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
518                 -padx 1 -pady 1 -helptext "Start/Stop tracking" -command CVCsDemo::track\r
519     $bbox add -image [Bitmap::get [file join $::image_path pictures/nightoff.gif]] \\r
520         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
521                 -padx 1 -pady 1 -helptext "Turn On/Off night mode" -command CVCsDemo::night\r
522     $bbox add -image [Bitmap::get [file join $::image_path pictures/gist.gif]] \\r
523         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
524                 -padx 1 -pady 1 -helptext "Turn On/Off histogram mode" -command CVCsDemo::gist\r
525 \r
526 \r
527         set sep [Separator $CVCsDemo::tb.sep2 -orient vertical]\r
528 \r
529     set bbox [ButtonBox $CVCsDemo::tb.bbox3 -spacing 0 -padx 1 -pady 1]\r
530     $bbox add -image [Bitmap::get [file join $::image_path pictures/vidopt.gif]] \\r
531         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1  \\r
532                 -padx 1 -pady 1 -helptext "Set video format" \\r
533                 -command CVCsDemo::setvideo \r
534     $bbox add -image [Bitmap::get [file join $::image_path pictures/camopt.gif]] \\r
535         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1  \\r
536                 -padx 1 -pady 1 -helptext "Camera options"\\r
537                 -command CVCsDemo::camera \r
538 \r
539     set sep [Separator $CVCsDemo::tb.sep3 -orient vertical]\r
540 \r
541     set bbox [ButtonBox $CVCsDemo::tb.bbox4 -spacing 0 -padx 1 -pady 1]\r
542     \r
543     set CVCsDemo::sclframe [frame $CVCsDemo::mainf.sclf]\r
544     set lab1 [label $CVCsDemo::sclframe.lab1 -text "Bins:"]\r
545     set scl1 [scale $CVCsDemo::sclframe.scale1 -orient horizontal -length 32 -from 1 -to 255 \\r
546             -command "pSetBins" -tickinterval 254]\r
547     set lab2 [label $CVCsDemo::sclframe.lab2 -text "S:"]\r
548     set scl2 [scale $CVCsDemo::sclframe.scale2 -orient horizontal -length 32 -from 0 -to 255 \\r
549             -command "pSetS" -tickinterval 255]\r
550     set lab3 [label $CVCsDemo::sclframe.lab3 -text "V1:"]\r
551     set scl3 [scale $CVCsDemo::sclframe.scale3 -orient horizontal -length 32 -from 0 -to 255 \\r
552             -command "pSetV1" -tickinterval 255]\r
553     set lab4 [label $CVCsDemo::sclframe.lab4 -text "V2:"]\r
554     set scl4 [scale $CVCsDemo::sclframe.scale4 -orient horizontal -length 32 -from 0 -to 255 \\r
555             -command "pSetV2" -tickinterval 255]\r
556 \r
557     pack $lab1 -side left -expand no -anchor n\r
558     pack $scl1 -side left -expand yes -anchor n -fill x\r
559     pack $lab2 -side left -expand no -anchor n\r
560     pack $scl2 -side left -expand yes -anchor n -fill x\r
561     pack $lab3 -side left -expand no -anchor n\r
562     pack $scl3 -side left -expand yes -anchor n -fill x\r
563     pack $lab4 -side left -expand no -anchor n\r
564     pack $scl4 -side left -expand yes -anchor n -fill x\r
565     \r
566     $scl1 set 10\r
567     $scl2 set 20\r
568     $scl3 set 40\r
569     $scl4 set 255\r
570 \r
571     $CVCsDemo::tb.bbox2.b0 configure -state disable\r
572     $CVCsDemo::tb.bbox2.b1 configure -state disable\r
573     $CVCsDemo::tb.bbox2.b2 configure -state disable\r
574 \r
575     incr CVCsDemo::prgindic\r
576     set CVCsDemo::prgtext   "Creating statusbar..."\r
577     update\r
578 \r
579         $CVCsDemo::mainf addindicator\r
580         $CVCsDemo::mainf.status.indf.f0 configure -relief flat\r
581 \r
582         label $CVCsDemo::mainf.status.indf.f0.l0  -relief sunken -borderwidth 1 \\r
583         -takefocus 0 -highlightthickness 0 -textvariable CVCsDemo::curcam\r
584         pack $CVCsDemo::mainf.status.indf.f0.l0 -side left -fill y -expand 1\r
585 \r
586         label $CVCsDemo::mainf.status.indf.f0.l1  -relief flat -borderwidth 1 \\r
587         -takefocus 0 -highlightthickness 0 -text "X:"\r
588         pack $CVCsDemo::mainf.status.indf.f0.l1 -side left -fill y -expand 1\r
589 \r
590         label $CVCsDemo::mainf.status.indf.f0.l2  -relief sunken -borderwidth 1 \\r
591         -takefocus 0 -highlightthickness 0 -textvariable CVCsDemo::curX\r
592         pack $CVCsDemo::mainf.status.indf.f0.l2 -side left -fill y -expand 1\r
593 \r
594         label $CVCsDemo::mainf.status.indf.f0.l3  -relief flat -borderwidth 1 \\r
595         -takefocus 0 -highlightthickness 0 -text "Y:"\r
596         pack $CVCsDemo::mainf.status.indf.f0.l3 -side left -fill y -expand 1\r
597 \r
598         label $CVCsDemo::mainf.status.indf.f0.l4  -relief sunken -borderwidth 1 \\r
599         -takefocus 0 -highlightthickness 0 -textvariable CVCsDemo::curY\r
600         pack $CVCsDemo::mainf.status.indf.f0.l4 -side left -fill y -expand 1\r
601         pack forget $CVCsDemo::mainf.status.indf.f0\r
602 \r
603         set CVCsDemo::prgtext   "Creating manadger..."\r
604     incr CVCsDemo::prgindic\r
605     set CVCsDemo::nb [NoteBook $CVCsDemo::mainf.frame.nb -side top]\r
606     pack $CVCsDemo::nb -fill both -expand yes -padx 1 -pady 1\r
607     \r
608         set CVCsDemo::prgtext   "Done"\r
609     incr CVCsDemo::prgindic\r
610 \r
611     pack $CVCsDemo::mainf -fill both -expand yes\r
612     update idletasks\r
613 \r
614         unset CVCsDemo::prgindic\r
615         unset CVCsDemo::prgtext\r
616 \r
617     destroy .intro\r
618 }\r
619 \r
620 proc main {} {\r
621     package require BWidget\r
622     wm withdraw .\r
623     wm title . "CVCsDemo"\r
624 \r
625     CVCsDemo::create\r
626 \r
627     BWidget::place . 640 480 center\r
628     wm deiconify .\r
629     raise .\r
630     wm geometry . 640x480\r
631 \r
632     focus -force .\r
633 }\r
634 \r
635 main\r