Version 21 of Simple Canvas Demo

Updated 2010-06-23 23:20:42 by gold

HJG Shows a canvas-window and a few buttons to do some operations on it.

#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}

# demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
#: CanvasDemo: On button-click, draw something on the canvas

package require Tk

proc ClrCanvas {w} {
    $w delete "all"
}

proc DrawAxis {w} {
    set midX [expr { $::maxX / 2 }]
    set midY [expr { $::maxY / 2 }]
    $w create line 0     $midY  $::maxX   $midY  -tags "axis"
    $w create line $midX 0        $midX $::maxY  -tags "axis"
}

proc PaintText {w Txt} {
    global y
    incr y 10
    $w create text 20 $y -text $Txt -tags "text"
}

proc DrawBox {w} {
    global x1 y1 x2 y2 
    $w create rect  50  10  100  60  -tags "box"
    $w create rect $x1 $y1  $x2 $y2  -tags "box"
    incr x1 15
    incr x2 15
    incr y1 10
    incr y2 10
}

proc DrawFn1 {w} {
    $w create line 0 100  50 200  100 50  150 70  200 155  250 50  300 111  350 222\
             -tags "Fn1"  -smooth bezier
}

proc DrawFn2 {w} {
    set offY 0    ;# [expr { $::maxY / 2 }]

    for { set x 0 } { $x <= $::maxX } { incr x 5 } {
      set y [expr { rand() * $::maxY + $offY }]

     #puts "$x $y"
      if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" }
      set x0 $x
      set y0 $y
    }
}

#: Main :
frame .f1
frame .f2
pack  .f1 .f2

set maxX 320
set maxY 240
set y      0

set x1 120
set x2 150
set y1  50
set y2  80

canvas  .cv -width $maxX -height $maxY  -bg white
pack    .cv -in .f1

button  .b0 -text "Clear" -command { ClrCanvas .cv }
button  .b1 -text "Text"  -command { PaintText .cv "Canvas" }
button  .b2 -text "Axis"  -command { DrawAxis  .cv }
button  .b3 -text "Box"   -command { DrawBox   .cv }
button  .b4 -text "Fn1"   -command { DrawFn1   .cv }
button  .b5 -text "Fn2"   -command { DrawFn2   .cv }
pack .b0 .b1 .b2 .b3 .b4 .b5  -in .f2  -side left -padx 2

#catch {console show}

See also: Widgets on a canvas and Minimal scrolling canvas (if you need scrollbars)

Screenshots

gold added pix
WikiDbImage TCL_wiki_Simple_Canvas_Demo.PNG
http://farm5.static.flickr.com/4013/4714847391_1dbce38be3.jpg

Auxiliary code

Here is some auxiliary code which will raise or lower a green rectangular grid on canvas objects. One can install two bottons which will raise or lower grid depending on state variable ($state2).

#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}

# demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
#: CanvasDemo: On button-click, draw something on the canvas

package require Tk

proc ClrCanvas {w} {
    $w delete "all"
}

proc DrawAxis {w} {
    set midX [expr { $::maxX / 2 }]
    set midY [expr { $::maxY / 2 }]
    $w create line 0     $midY  $::maxX   $midY  -tags "axis" -width 2
    $w create line $midX 0        $midX $::maxY  -tags "axis" -width 2
}

proc PaintText {w Txt} {
    global y
    incr y 10
    $w create text 20 $y -text $Txt -tags "text"
}

proc DrawBox {w} {
    global x1 y1 x2 y2
    $w create rect  50  10  100  60  -tags "box"
    $w create rect $x1 $y1  $x2 $y2  -tags "box"
    incr x1 15
    incr x2 15
    incr y1 10
    incr y2 10
}

proc DrawFn1 {w} {
    $w create line 0 100  50 200  100 50  150 70  200 155  250 50  300 111  350 222\
             -tags "Fn1"  -smooth bezier -width 4
}

proc DrawFn2 {w} {
    set offY 0    ;# [expr { $::maxY / 2 }]

    for { set x 0 } { $x <= $::maxX } { incr x 5 } {
      set y [expr { rand() * $::maxY + $offY }]

     #puts "$x $y"
      if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2"-width 4 }
      set x0 $x
      set y0 $y
    }
}

#: Main :
frame .f1
frame .f2
pack  .f1 .f2

set maxX 320
set maxY 240
set y      0

set state2 1

set x1 120
set x2 150
set y1  50
set y2  80

set colorite seashell3
#canvas  .cv -width $maxX -height $maxY  -bg white

set state2 1    

#canvas .cv -width $maxX -height $maxY -bg white 
set oscwidth 1000 
set oschorizontal 500 
canvas .cv -width 400 -height 200 -scrollregion "0 0 $oscwidth $oschorizontal" \
        -xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \
        -background palegreen -highlightcolor DarkOliveGreen \
        -relief raised -border 10
scrollbar .corpsx -command " .cv xview" -orient horizontal
scrollbar .corpsy -command " .cv yview" -orient vertical
focus .cv 
proc refreshgrid { .cv state2} {
    global oscwidth oschorizontal colorite
    global grid
    set colorite blue 
    for {set x 0} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -tag grid -width 4}
    for {set y 0} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -tag grid -width 4} 
    .cv itemconfigure grid -fill honeydew 
    if { $state2 == 1 } { .cv raise grid ;} 
    if { $state2 == 2 } { .cv lower grid ;} 
}

pack    .cv -in .f1

button  .b0 -text "Clear" -command { ClrCanvas .cv }
button  .b1 -text "Text"  -command { PaintText .cv "Canvas" }
button  .b2 -text "Axis"  -command { DrawAxis  .cv }
button  .b3 -text "Box"   -command { DrawBox   .cv }
button  .b4 -text "Fn1"   -command { DrawFn1   .cv }
button  .b5 -text "Fn2"   -command { DrawFn2   .cv }

#pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 -in .f2  -side left -padx 2

#catch {console show}
#if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} }
button  .b6 -text "gridlower"   -command { refreshgrid .cv 2 } -background   $colorite

button  .b7 -text "gridover"   -command { refreshgrid .cv 1 } -background   $colorite
button  .b8 -text "exit"   -command { exit }

pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 .b8 -in .f2  -side left -padx 2

Second Version

 #!/bin/sh
 # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
 exec wish $0 ${1+"$@"}

 # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
 #: CanvasDemo: On button-click, draw something on the canvas
 # used code from Canvas moving objects and toggle tags
 #mainly to put in a measuring ball and screen coords on a label.
  package require Tk

set halo 2

 proc item:upd {w} {
 $w itemconfigure object -outline {}
 $w itemconfigure hover -outline red -width 5
 $w itemconfigure moveit -outline purple -width 5
 }

 proc item:move {w x y {init 0}} {
 global oldx oldy
 if $init {
  set oldx $x; set oldy $y
  $w addtag moveit closest $x $y $::halo
  $w dtag !moveable moveit
  $w raise moveit
 } else {
  $w move moveit [expr $x-$oldx] [expr $y-$oldy]
  set oldx $x; set oldy $y
 }
 item:upd $w
 }

 proc item:endmove {w x y} {
 $w dtag moveit
 item:upd $w
 }

 proc item:hover {w x y st} {
 if $st {
  $w addtag hover closest $x $y $::halo
  $w dtag !moveable hover
 } else {
  $w dtag hover
 }
 item:upd $w
 }

 proc item:toggletag {w x y tag} {
 set ttt tagtotoggle
 $w addtag $ttt closest $x $y $::halo $tag
 if {[lsearch [$w gettags $ttt] $tag] >= 0} {
  $w dtag ($ttt&&$tag) $tag
  item:hover $w $x $y 0
 } else {
  $w addtag $tag withtag ($ttt&&!$tag)
  item:hover $w $x $y 1
 }
 $w dtag $ttt
 }
  proc ClrCanvas {w} {
    $w delete "all"
  }

  proc DrawAxis {w} {
    #set midX [expr { $::maxX / 2 }]
    #set midY [expr { $::maxY / 2 }]
    set midX [expr { $::maxX / 2 }]
    set midY [expr { $::maxY / 2 }]

    $w create line 0     $midY  [expr $::maxX+80]   $midY  -tags "axis" -width 2
    $w create line $midX 0        $midX $::maxY  -tags "axis" -width 2
  }

  proc PaintText {w Txt} {
    global y
    incr y 30
    $w create text 40 $y -text $Txt -tags "text"
  }
 proc mint {w } {

catch {console show}

    $w create oval 150  110 170   130 -width 2 -fill red -outline gray -tags {object moveable}; 
    puts "test"
  }


  proc DrawBox {w} {
    global x1 y1 x2 y2
    $w create rect  50  200  100  80  -tags "box"
    $w create rect $x1 $y1  $x2 $y2  -tags "box"
    incr x1 15
    incr x2 15
    incr y1 10
    incr y2 10
  }


 proc lpick L {lindex $L [expr int(rand()*[llength $L])]; \
      #suchenwirth_subroutine;}
      set randomcolor  { AntiqueWhite3
      Bisque1 Bisque2 Bisque3  Bisque4  
      SlateBlue3 RoyalBlue1 SteelBlue2  
      DeepSkyBlue3  LightBlue1 DarkSlateGray1  
      Aquamarine2 DarkSeaGreen2 SeaGreen1 Bisque  
             Yellow1 IndianRed1 IndianRed2 Tan1 
      Tan4 red} ;









  proc DrawFn1 {w} {
    $w create line 0 100  50 200  100 50  150 70  200 155  250 50  300 111  350 222\
             -tags "Fn1"  -smooth bezier -width 4
  }

  proc DrawFn2 {w} {
    set offY 0    ;# [expr { $::maxY / 2 }]

    for { set x 0 } { $x <= $::maxX } { incr x 5 } {
      set y [expr { rand() * $::maxY + $offY }]

     #puts "$x $y"
      if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2"  }
      set x0 $x
      set y0 $y
    }
  }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 320
  set maxY 240


   set y      0

  set state2 1



  set x1 120
  set x2 150
  set y1  50
  set y2  80






  set colorite seashell3
  #canvas  .cv -width $maxX -height $maxY  -bg white


     set state2 1

#canvas .cv -width $maxX -height $maxY -bg white set oscwidth 1000 set oschorizontal 500 canvas .cv -width 400 -height 500 -scrollregion "0 0 $oscwidth $oschorizontal" \

        -xscrollcommand ".corpsx set" -yscrollcommand ".corpsy set" \
        -background palegreen -highlightcolor DarkOliveGreen \
        -relief raised -border 10

scrollbar .corpsx -command " .cv xview" -orient horizontal

 scrollbar .corpsy -command " .cv yview" -orient vertical
 focus .cv

proc refreshgrid { .cv state2} {

 global oscwidth oschorizontal colorite
 global grid
 set colorite blue

for {set x 10} {$x<$oscwidth} {incr x 50} {.cv create line $x 0 $x $oschorizontal -fill blue -tag grid -width 4}

 for {set y 20} {$y<$oschorizontal} {incr y 50} {.cv create line 0 $y $oschorizontal $y -fill blue  -tag grid -width 4}

.cv itemconfigure grid -fill blue 

 if { $state2 == 1 } { .cv raise grid ;}

if { $state2 == 2 } { .cv lower grid ;} }

   pack    .cv -in .f1

  button  .b0 -text "Clear" -command { ClrCanvas .cv }
  button  .b1 -text "Text"  -command { PaintText .cv "Canvas" }
  button  .b2 -text "Axis"  -command { DrawAxis  .cv }
  button  .b3 -text "Box"   -command { DrawBox   .cv }
  button  .b4 -text "Fn1"   -command { DrawFn1   .cv }
  button  .b5 -text "Fn2"   -command { DrawFn2   .cv }

  #pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7 -in .f2  -side left -padx 2


  #catch {console show}

#if { $state2 == 1 } { .cv raise grid ;} if { $state2 == 2 } { .cv lower grid ;} }

  button  .b6 -text "gridlower"   -command { refreshgrid .cv 2 } -background   $colorite  

  button  .b7 -text "gridover"   -command { refreshgrid .cv 1 } -background   $colorite  
   button  .b8 -text "exit"   -command { exit }
   button  .b9 -text "exit"   -command { exit }
   button  .b10 -text "scale^"   -command {.cv scale all 0 0 1.1 1.1 }
  button  .b11 -text "unscale<"   -command {.cv scale all 0 0 .9 .9 }
   button  .b12 -text "meas_ball"   -command { .cv create oval 150  110 170   130 -width 2 -fill red -outline gray -tags {object moveable}; }
   button  .b13 -text "ball"   -command { mint .cv; }
   button  .b14 -text "exit"   -command { exit }
     set info "0"
 label  .info -textvar info -just left
  pack .b0 .b1 .b2 .b3 .b4 .b5  .b6 .b7  -in .f2  -side left -padx 2
  pack .b8 .b9 .b10 .b11 .b12 .b13 .b14 .info -in .f3  -side left -padx 2
 .cv bind moveable <ButtonPress-1> {item:move %W %x %y 1;set info " %x %y ";puts "%x %y"}
 .cv bind moveable <ButtonRelease-1> {item:endmove %W %x %y;puts "%x %y"}
 .cv bind moveable <Enter> {item:hover %W %x %y 1;set info " %x %y "}
 .cv bind moveable <Leave> {item:hover %W %x %y 0;set info " %x %y "}
 .cv bind moveit <B1-Motion> {item:move %W %x %y;set info " %x %y "}
 .cv bind all <ButtonRelease-2> {item:toggletag %W %x %y moveable}

 #set info [format "x=%.2f y=%.2f" $x $y]
 # update item styles
 item:upd .cv
  #end of deck
  #end of deck
Category Example Category Graphics