CObjView.tcl 2.5 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980
  1. # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. # $Id: CObjView.tcl,v 1.4 2001/12/09 05:31:07 idiscovery Exp $
  4. #
  5. # Tix Demostration Program
  6. #
  7. # This sample program is structured in such a way so that it can be
  8. # executed from the Tix demo program "widget": it must have a
  9. # procedure called "RunSample". It should also have the "if" statment
  10. # at the end of this file so that it can be run as a standalone
  11. # program using tixwish.
  12. # This program demonstrates the use of the CObjView (Canvas Object
  13. # View) class.
  14. #
  15. # $Id: CObjView.tcl,v 1.4 2001/12/09 05:31:07 idiscovery Exp $
  16. proc RunSample {w} {
  17. label $w.lab -justify left -text \
  18. "Click on the buttons to add or delete canvas
  19. objects randomally. Notice the scrollbars automatically
  20. adjust to include all objects in the scroll-region."
  21. pack $w.lab -anchor c -padx 10 -pady 6 -side top
  22. frame $w.f
  23. pack $w.f -side bottom -fill y
  24. tixCObjView $w.c
  25. pack $w.c -expand yes -fill both -padx 4 -pady 2 -side top
  26. button $w.add -command "CVDemo_Add $w.c" -text Add -width 6
  27. button $w.del -command "CVDemo_Delete $w.c" -text Delete -width 6
  28. button $w.exit -command "destroy $w" -text Exit -width 6
  29. pack $w.add $w.del $w.exit -side left -padx 20 -pady 10 \
  30. -anchor c -expand yes -in $w.f
  31. }
  32. proc CVDemo_Add {cov} {
  33. # Generate four pseudo random numbers (x,y,w,h) to define the coordinates
  34. # of a rectangle object in the canvas.
  35. #
  36. set colors {red green blue white black gray yellow}
  37. set x [expr int(rand() * 400) - 120]
  38. set y [expr int(rand() * 400) - 120]
  39. set w [expr int(rand() * 120)]
  40. set h [expr int(rand() * 120)]
  41. # Create the canvas object
  42. #
  43. $cov subwidget canvas create rectangle $x $y [expr $x+$w] [expr $y+$h] \
  44. -fill [lindex $colors [expr int(rand() * [llength $colors])]]
  45. # Call the adjustscrollregion command to set the scroll bars so that all
  46. # objects are included in the scroll-region
  47. #
  48. $cov adjustscrollregion
  49. }
  50. proc CVDemo_Delete {cov} {
  51. set px [lindex [time update] 0]
  52. set w [$cov subwidget canvas]
  53. set items [$w find withtag all]
  54. if [string compare $items ""] {
  55. # There are items in the canvas, randomally delete one of them
  56. # and re-adjust the scroll-region
  57. #
  58. set toDelete [expr $px % [llength $items]]
  59. $w delete [lindex $items $toDelete]
  60. $cov adjustscrollregion
  61. }
  62. }
  63. if {![info exists tix_demo_running]} {
  64. wm withdraw .
  65. set w .demo
  66. toplevel $w; wm transient $w ""
  67. RunSample $w
  68. bind $w <Destroy> {after 10 exit}
  69. }