git.maemo.org Git - opencv/blob - apps/cvlkdemo/cvlkdemo.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 CVLkDemo {\r
  63         variable mainf\r
  64         variable tb\r
  65         variable statustext\r
  66 \r
  67     variable nb\r
  68 \r
  69         variable showtb 1\r
  70         variable showstb 1\r
  71         \r
  72     variable curcam\r
  73 \r
  74     variable curpage\r
  75     variable curframe\r
  76         variable curX "---"\r
  77         variable curY "---"\r
  78     \r
  79     variable pagesnum 0\r
  80     variable pagescount 0\r
  81     \r
  82     variable cams {}\r
  83     variable pages {}\r
  84 \r
  85     variable capturestate "0"\r
  86     variable trackstate "0"\r
  87     variable nightstate "0"\r
  88     variable cam "0"\r
  89 }\r
  90 \r
  91 proc CVLkDemo::Modify {} {\r
  92     set CVLkDemo::cam [.dlg.frame.cb getvalue]\r
  93 }\r
  94 \r
  95 proc CVLkDemo::longmenu {on} {\r
  96         if {$on} {\r
  97                 .menubar.file entryconfig 1 -state active\r
  98         } else {\r
  99                 .menubar.file entryconfig 1 -state disabled\r
 100         }\r
 101 }\r
 102 \r
 103 proc CVLkDemo::longstbar {on} {\r
 104         if {$on} {\r
 105                 pack $CVLkDemo::mainf.status.indf.f0 -side left -fill y -expand 1               \r
 106         } else {\r
 107                 pack forget $CVLkDemo::mainf.status.indf.f0             \r
 108         }\r
 109 }\r
 110 \r
 111 proc CVLkDemo::longbar {on} {\r
 112         if {$on} {\r
 113                 pack $CVLkDemo::tb.bbox1 -side left -anchor w\r
 114                 pack $CVLkDemo::tb.sep1 -side left -fill y -padx 4 -anchor w\r
 115                 pack $CVLkDemo::tb.bbox2 -side left -anchor w\r
 116                 pack $CVLkDemo::tb.sep2 -side left -fill y -padx 4 -anchor w\r
 117         } else {\r
 118                 pack forget $CVLkDemo::tb.sep2\r
 119                 pack forget $CVLkDemo::tb.bbox2\r
 120                 pack forget $CVLkDemo::tb.sep1\r
 121                 pack forget $CVLkDemo::tb.bbox1\r
 122         }\r
 123 }\r
 124 \r
 125 proc CVLkDemo::about {} {\r
 126     set dlg [Dialog .aboutdlg -parent . -modal local \\r
 127                  -separator 1           \\r
 128                  -title   "About CVLkDemo"      \\r
 129                  -side    right         \\r
 130                  -anchor  s                     \\r
 131                  -default 0]\r
 132     $dlg add -name ok -width 5\r
 133     \r
 134         set top [$dlg getframe]\r
 135             \r
 136         image create photo original -file [file join $::image_path pictures/CVLkDemo.gif]\r
 137         canvas $top.c -bd 2 -relief ridge -width 295 -height 195 \r
 138         $top.c create image 0 0 -anchor nw -image original\r
 139         pack $top.c -side top -expand yes -fill x\r
 140 \r
 141     set frame [frame $top.f -background white -bd 2 -relief ridge]\r
 142     set lab  [label $frame.lab1 -text \\r
 143                 "Program CVLkDemo v. 1.0 \nIntel corporation. 2001 y."  \\r
 144                            -background white -font {times 8}]\r
 145     pack $lab\r
 146     pack $frame -side top -expand yes -fill x -padx 2 -pady 2\r
 147 \r
 148     $dlg draw\r
 149     destroy $dlg\r
 150 }\r
 151 \r
 152 proc getvar {name value} {\r
 153     upvar $name localVar\r
 154     upvar $value lvalue\r
 155         \r
 156     set localVar $lvalue\r
 157 }\r
 158 \r
 159 proc CVLkDemo::raisetab { } {\r
 160     set CVLkDemo::curpage [$CVLkDemo::nb raise]\r
 161     set CVLkDemo::curframe [$CVLkDemo::nb getframe $CVLkDemo::curpage].lab\r
 162     set pos [lsearch $CVLkDemo::pages $CVLkDemo::curpage]\r
 163     set CVLkDemo::curcam [lindex $CVLkDemo::cams $pos]   \r
 164 }\r
 165 \r
 166 proc CVLkDemo::createtab {page text} {\r
 167     set path [$CVLkDemo::nb insert end $page -text $text \\r
 168               -raisecmd CVLkDemo::raisetab]\r
 169     \r
 170     label $path.lab -text "" -bg black -relief sunken\r
 171     pack $path.lab  -side top  -expand yes -fill both\r
 172 \r
 173     bind $path.lab <ButtonPress-1> {\r
 174         pButtonPress %x %y\r
 175         }\r
 176 \r
 177     bind $path.lab <ButtonRelease-1> {\r
 178         pButtonRelease %x %y\r
 179         }\r
 180 \r
 181     bind $path.lab <Motion> {\r
 182         pMotion %x %y\r
 183         }\r
 184 \r
 185     bind $path.lab <Configure> {\r
 186         pConfigure\r
 187         }\r
 188 }\r
 189 \r
 190 proc CVLkDemo::new {} {\r
 191     \r
 192     incr CVLkDemo::pagescount\r
 193     incr CVLkDemo::pagesnum\r
 194 \r
 195 \r
 196     if {$CVLkDemo::pagesnum == 1} {\r
 197         CVLkDemo::longmenu 1\r
 198         CVLkDemo::longbar 1\r
 199         CVLkDemo::longstbar 1\r
 200 \r
 201         set CVLkDemo::curpage p[expr $CVLkDemo::pagescount]\r
 202         lappend CVLkDemo::pages $CVLkDemo::curpage\r
 203         lappend CVLkDemo::cams $CVLkDemo::curcam\r
 204 \r
 205         set text [format "Camera %i" $CVLkDemo::pagescount]\r
 206         CVLkDemo::createtab $CVLkDemo::curpage $text\r
 207     \r
 208         $CVLkDemo::nb see [$CVLkDemo::nb pages end]\r
 209         $CVLkDemo::nb raise [$CVLkDemo::nb pages end]\r
 210         update\r
 211         pInitCamera\r
 212     } else {\r
 213     tk_dialog .mes {Message} { CVLkDemo support only one camera.} {} 0 OK" \r
 214     }\r
 215 }\r
 216 \r
 217 proc CVLkDemo::close {} {\r
 218 \r
 219         set pos [lsearch $CVLkDemo::cams $CVLkDemo::curcam]\r
 220         set $CVLkDemo::cams [lreplace $CVLkDemo::cams $pos $pos]\r
 221         set $CVLkDemo::pages [lreplace $CVLkDemo::pages $pos $pos]\r
 222 \r
 223     $CVLkDemo::nb delete $CVLkDemo::curpage 1\r
 224     \r
 225         if {$CVLkDemo::curcam != ""} {\r
 226                 #set ind [$CVLkDemo::tree index $CVLkDemo::curfile]\r
 227                 #$CVLkDemo::tree delete $CVLkDemo::curfile\r
 228         }\r
 229 \r
 230     set CVLkDemo::pagesnum [expr $CVLkDemo::pagesnum - 1]\r
 231 \r
 232         if {$CVLkDemo::pagesnum == 0} {\r
 233                 CVLkDemo::longmenu 0\r
 234                 CVLkDemo::longbar 0\r
 235                 #CVLkDemo::longstbar 0\r
 236                 set CVLkDemo::curcam ""\r
 237         } else {\r
 238                 set page [$CVLkDemo::nb pages end]\r
 239 \r
 240                 set pos [lsearch $CVLkDemo::pages $CVLkDemo::curpage]\r
 241                 set CVLkDemo::curcam [lindex $CVLkDemo::cams $pos]\r
 242                         \r
 243                 $CVLkDemo::nb see $page\r
 244         $CVLkDemo::nb raise $page\r
 245     }\r
 246     \r
 247     pCloseCamera\r
 248     $CVLkDemo::tb.bbox1.b0 configure -relief raised \\r
 249             -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]]\r
 250     set CVLkDemo::capturestate 0\r
 251 }\r
 252 \r
 253 proc CVLkDemo::capture {} {\r
 254 \r
 255     if { $CVLkDemo::capturestate == 1 } {\r
 256         $CVLkDemo::tb.bbox1.b0 configure -relief raised \\r
 257             -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]]\r
 258         set CVLkDemo::capturestate 0\r
 259         pStopCamera\r
 260         $CVLkDemo::tb.bbox1.b1 configure -state disable\r
 261     } else {\r
 262         $CVLkDemo::tb.bbox1.b0 configure -relief sunken \\r
 263             -image [Bitmap::get [file join $::image_path pictures/capture.gif]]\r
 264         set CVLkDemo::capturestate 1\r
 265         pStartCamera\r
 266         $CVLkDemo::tb.bbox1.b1 configure -state active\r
 267     }\r
 268 }\r
 269 \r
 270 proc CVLkDemo::track {} {\r
 271 \r
 272     if { $CVLkDemo::trackstate == 1 } {\r
 273         $CVLkDemo::tb.bbox1.b1 configure -relief raised \\r
 274             -image [Bitmap::get [file join $::image_path pictures/trackoff.gif]]\r
 275         set CVLkDemo::trackstate 0\r
 276         pResetTrack\r
 277         $CVLkDemo::tb.bbox1.b2 configure -state disable\r
 278     } else {\r
 279         $CVLkDemo::tb.bbox1.b1 configure -relief sunken \\r
 280             -image [Bitmap::get [file join $::image_path pictures/track.gif]]\r
 281         set CVLkDemo::trackstate 1\r
 282         pSetTrack\r
 283         $CVLkDemo::tb.bbox1.b2 configure -state active\r
 284     }\r
 285 }\r
 286 \r
 287 proc CVLkDemo::night {} {\r
 288 \r
 289     if { $CVLkDemo::nightstate == 1 } {\r
 290         $CVLkDemo::tb.bbox1.b2 configure -relief raised \\r
 291             -image [Bitmap::get [file join $::image_path pictures/nightoff.gif]]\r
 292         set CVLkDemo::nightstate 0\r
 293         pResetNight\r
 294     } else {\r
 295         $CVLkDemo::tb.bbox1.b2 configure -relief sunken \\r
 296             -image [Bitmap::get [file join $::image_path pictures/night.gif]]\r
 297         set CVLkDemo::nightstate 1\r
 298         pSetNight\r
 299     }\r
 300 }\r
 301 \r
 302 proc CVLkDemo::setvideo {} {\r
 303     pSetVideo\r
 304 }\r
 305 \r
 306 proc CVLkDemo::camera {} {\r
 307     pSetCameraOpt\r
 308 }\r
 309 \r
 310 proc CVLkDemo::create { } {\r
 311         variable prgindic 0\r
 312         variable prgtext\r
 313         ## Create intro\r
 314     ###################################################################\r
 315     set top [toplevel .intro -relief raised -borderwidth 2]\r
 316     wm withdraw $top\r
 317     wm overrideredirect $top 1\r
 318         \r
 319         image create photo original -file [file join $::image_path pictures/CVLkDemo.gif]\r
 320         canvas $top.c -bd 2 -relief ridge -width 295 -height 195 \r
 321         $top.c create image 0 0 -anchor nw -image original\r
 322         pack $top.c -side top -expand yes -fill x\r
 323 \r
 324     set frame [frame $top.f -background white -bd 2 -relief ridge]\r
 325     set lab1  [label $frame.lab1 -text "Please wait for loading..."     \\r
 326                            -background white -font {times 8}]\r
 327     set lab2  [label $frame.lab2 -textvariable CVLkDemo::prgtext        \\r
 328                            -background white -font {times 8} -width 35]\r
 329     set prg   [ProgressBar $frame.prg -width 50 -height 10              \\r
 330                            -background white -variable CVLkDemo::prgindic -maximum 7]\r
 331     pack $lab1 $prg $lab2\r
 332     pack $frame -side top -expand yes -fill x -padx 2 -pady 2\r
 333 \r
 334     BWidget::place $top 0 0 center\r
 335     wm deiconify $top\r
 336 \r
 337         ###################################################################\r
 338         \r
 339         set CVLkDemo::prgtext "Loading font..."\r
 340         update\r
 341         SelectFont::loadfont\r
 342 \r
 343         incr CVLkDemo::prgindic\r
 344         set CVLkDemo::prgtext   "Creating menu..."\r
 345     update\r
 346 \r
 347     #### Menu\r
 348     set menu {\r
 349         "&File" all file 0 {\r
 350             {command "&New" {} "New document" {} -command CVLkDemo::new}\r
 351                         {command "&Close" {} "Close the document" {} -state disable     \\r
 352                                 -command CVLkDemo::close}\r
 353                         {separator}\r
 354                         {command "E&xit" {} "Exit the program" {} -command exit}\r
 355         }\r
 356         "&View" all view 0 {\r
 357             {checkbutton "&Toolbar" {all view} "Show/hide toolbar" {}   \\r
 358                 -variable CVLkDemo::showtb      \\r
 359                 -command {$CVLkDemo::mainf showtoolbar 0 $CVLkDemo::showtb}\r
 360             }\r
 361                         {checkbutton "&Statusbar" {all view} "Show/hide statusbar" {}   \\r
 362                 -variable CVLkDemo::showstb     \\r
 363                 -command {\r
 364                                                         if {$CVLkDemo::showstb} {\r
 365                                                                 pack $CVLkDemo::mainf.botf -side bottom -fill x \r
 366                                                         } else {\r
 367                                                                 pack forget $CVLkDemo::mainf.botf\r
 368                                                         }\r
 369                                                  }\r
 370             }\r
 371         }\r
 372                 "&Options" all options 0 {\r
 373                         {command "Came&ra" {} "Colors & fonts setup" {} -command CVLkDemo::camera}\r
 374             {command "&Video" {} "Colors & fonts setup" {} -command CVLkDemo::setvideo}\r
 375                 }\r
 376                 "&Help" all help 0 {\r
 377                         {command "&About CVLKDemo" {} "Display the program info" {}     \\r
 378                          -command CVLkDemo::about}\r
 379         }\r
 380     }\r
 381 \r
 382     incr CVLkDemo::prgindic\r
 383         set CVLkDemo::prgtext   "Creating MainFrame..."\r
 384     update\r
 385 \r
 386     set CVLkDemo::mainf [MainFrame .mainf -menu $menu   \\r
 387                       -textvariable CVLkDemo::statustext]\r
 388 \r
 389     menu .menubar.edit -tearoff 0 -background $::default_normal_bg\r
 390     MainFrame::_create_entries .mainf .menubar.edit \\r
 391                 $::default_normal_bg {\\r
 392                         {command "Cu&t" {} "Cut the selection" {} -command cut}\r
 393                         {command "&Copy" {} "Copy the selection" {} -command copy}\r
 394                         {command "&Paste" {} "Paste the clipboard" {} -command paste}\r
 395                         {separator}\r
 396                         {command "&Go to.." {} "Move to a specified place" {} -command paste}\r
 397         }\r
 398 \r
 399         incr CVLkDemo::prgindic\r
 400         set CVLkDemo::prgtext   "Creating toolbar..."\r
 401     update\r
 402 \r
 403     #### toolbars creation\r
 404     set CVLkDemo::tb  [$CVLkDemo::mainf addtoolbar]\r
 405 \r
 406     set bbox [ButtonBox $CVLkDemo::tb.bbox0 -spacing 0 -padx 1 -pady 1]\r
 407     $bbox add -image [Bitmap::get [file join $::image_path pictures/new.gif]] \\r
 408         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 2  \\r
 409                 -padx 1 -pady 1 -helptext "Add new camera" -command CVLkDemo::new\r
 410     pack $bbox -side left -anchor w\r
 411     \r
 412     set sep [Separator $CVLkDemo::tb.sep0 -orient vertical]\r
 413     pack $sep -side left -fill y -padx 4 -anchor w\r
 414 \r
 415         set bbox [ButtonBox $CVLkDemo::tb.bbox1 -spacing 0 -padx 1 -pady 1]\r
 416     $bbox add -image [Bitmap::get [file join $::image_path pictures/captureoff.gif]] \\r
 417         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
 418                 -padx 1 -pady 1 -helptext "Start/Stop capture" -command CVLkDemo::capture\r
 419     $bbox add -image [Bitmap::get [file join $::image_path pictures/trackoff.gif]] \\r
 420         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
 421                 -padx 1 -pady 1 -helptext "Start/Stop tracking" -command CVLkDemo::track\r
 422     $bbox add -image [Bitmap::get [file join $::image_path pictures/nightoff.gif]] \\r
 423         -highlightthickness 0 -takefocus 0 -relief raised -borderwidth 2        \\r
 424                 -padx 1 -pady 1 -helptext "Turn On/Off night mode" -command CVLkDemo::night\r
 425 \r
 426         set sep [Separator $CVLkDemo::tb.sep1 -orient vertical]\r
 427 \r
 428     set bbox [ButtonBox $CVLkDemo::tb.bbox2 -spacing 0 -padx 1 -pady 1]\r
 429     $bbox add -image [Bitmap::get [file join $::image_path pictures/vidopt.gif]] \\r
 430         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1  \\r
 431                 -padx 1 -pady 1 -helptext "Set video format" \\r
 432                 -command CVLkDemo::setvideo \r
 433 \r
 434     $bbox add -image [Bitmap::get [file join $::image_path pictures/camopt.gif]] \\r
 435         -highlightthickness 0 -takefocus 0 -relief link -borderwidth 1  \\r
 436                 -padx 1 -pady 1 -helptext "Camera options"\\r
 437                 -command CVLkDemo::camera \r
 438 \r
 439     set sep [Separator $CVLkDemo::tb.sep2 -orient vertical]\r
 440 \r
 441     $CVLkDemo::tb.bbox1.b1 configure -state disable\r
 442     $CVLkDemo::tb.bbox1.b2 configure -state disable\r
 443     \r
 444     incr CVLkDemo::prgindic\r
 445     set CVLkDemo::prgtext   "Creating statusbar..."\r
 446     update\r
 447 \r
 448         $CVLkDemo::mainf addindicator\r
 449         $CVLkDemo::mainf.status.indf.f0 configure -relief flat\r
 450 \r
 451         label $CVLkDemo::mainf.status.indf.f0.l0  -relief sunken -borderwidth 1 \\r
 452         -takefocus 0 -highlightthickness 0 -textvariable CVLkDemo::curcam\r
 453         pack $CVLkDemo::mainf.status.indf.f0.l0 -side left -fill y -expand 1\r
 454 \r
 455         label $CVLkDemo::mainf.status.indf.f0.l1  -relief flat -borderwidth 1 \\r
 456         -takefocus 0 -highlightthickness 0 -text "X:"\r
 457         pack $CVLkDemo::mainf.status.indf.f0.l1 -side left -fill y -expand 1\r
 458 \r
 459         label $CVLkDemo::mainf.status.indf.f0.l2  -relief sunken -borderwidth 1 \\r
 460         -takefocus 0 -highlightthickness 0 -textvariable CVLkDemo::curX\r
 461         pack $CVLkDemo::mainf.status.indf.f0.l2 -side left -fill y -expand 1\r
 462 \r
 463         label $CVLkDemo::mainf.status.indf.f0.l3  -relief flat -borderwidth 1 \\r
 464         -takefocus 0 -highlightthickness 0 -text "Y:"\r
 465         pack $CVLkDemo::mainf.status.indf.f0.l3 -side left -fill y -expand 1\r
 466 \r
 467         label $CVLkDemo::mainf.status.indf.f0.l4  -relief sunken -borderwidth 1 \\r
 468         -takefocus 0 -highlightthickness 0 -textvariable CVLkDemo::curY\r
 469         pack $CVLkDemo::mainf.status.indf.f0.l4 -side left -fill y -expand 1\r
 470         pack forget $CVLkDemo::mainf.status.indf.f0\r
 471 \r
 472         set CVLkDemo::prgtext   "Creating manadger..."\r
 473     incr CVLkDemo::prgindic\r
 474     set CVLkDemo::nb [NoteBook $CVLkDemo::mainf.frame.nb -side top]\r
 475     pack $CVLkDemo::nb -fill both -expand yes -padx 1 -pady 1\r
 476     \r
 477         set CVLkDemo::prgtext   "Done"\r
 478     incr CVLkDemo::prgindic\r
 479 \r
 480     pack $CVLkDemo::mainf -fill both -expand yes\r
 481     update idletasks\r
 482 \r
 483         unset CVLkDemo::prgindic\r
 484         unset CVLkDemo::prgtext\r
 485 \r
 486     destroy .intro\r
 487 }\r
 488 \r
 489 proc main {} {\r
 490     package require BWidget\r
 491     wm withdraw .\r
 492     wm title . "CVLKDemo"\r
 493 \r
 494     CVLkDemo::create\r
 495 \r
 496     BWidget::place . 640 480 center\r
 497     wm deiconify .\r
 498     raise .\r
 499     wm geometry . 640x480\r
 500 \r
 501     focus -force .\r
 502 }\r
 503 \r
 504 main\r