Simple Canvas Demo

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

test of offsite image retrival

figure 1.

figure 2.

Auxiliary code

gold Here is some auxiliary code which will raise or lower a blue rectangular grid on canvas objects.One can install two buttons which will raise or lower grid depending on state variable ($state2). Used code from Canvas moving objects and toggle tags, mainly to put in a measuring ball and screen coords on a label. Canvas moving objects and toggle tags is found on this wiki. Canvas moving objects and toggle tags Also added some exit buttons.

Early 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

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 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 240 -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

Category Example

Category Graphics