Interactively putting items on a canvas

Arjen Markus (12 february 2018) The program below is an attempt to create a facility to interactively put items on a canvas. For the moment it does not do much more than allowing you to define a circle or a rectangle, but it is easy to expand it for any of the standard types of canvas items. My intention is not to make a new full-fledged graphical editor, but rather to provide a small tool that can be used flexibly. For instance, I fairly often use the canvas to sketch a drawing or a schema and most of the time I do that by typing the object creation commands, test the results and edit the code to improve the drawing until the result is to my liking. That is a rather tedious procedure and I hope the code below will allow me to accelerate such editing. Mind you, it is not intended for highly detailed drawings.

As for the code below: I use TclOO to keep track of all manner of variables - they should not bother the user - and the drawing procedures are "modal" by using the vwait command. I needed some of the introspection commands of TclOO to achieve this all, but it works and it is convenient.

# canvasEdit.tcl --
#     Straightforward implementation of a package to edit
#     objects on the canvas graphically.
#

#
# First: can I link a global variable with an object variable?
#

::oo::class create canvasEdit {
    variable location
    variable canvas
    variable typeHandler
    variable coords
    variable item

    constructor {_canvas} {
        variable location
        variable canvas
        variable item

        set canvas $_canvas
        bind $canvas <Motion>      [list [self object] handleMove %x %y]
        bind $canvas <ButtonPress> [list [self object] handlePress %x %y]

        set item ""
    }

    method handleMove {x y} {
        variable location
        variable typeHandler
        set location "X, Y: $x, $y"

        my $typeHandler Move $x $y
    }

    method handlePress {x y} {
        variable location
        variable typeHandler
        set location "X, Y: $x, $y"

        my $typeHandler Press $x $y
    }

    method link {varname} {
        variable location
        upvar #0 $varname [namespace which -variable location]
    }

    method edit {type} {
        variable typeHandler
        variable wait
        variable item

        if { $type ni [info object methods [self object] -all] } {
            return -code error "Unknown canvas object type: $type"
        }

        set item ""
        set typeHandler $type

        vwait [namespace which -variable wait]

        set typeHandler Default

        return $item
    }

    method Default {event x y} {
        # Nothing to do
    }

    method circle {event x y} {
        variable canvas
        variable item
        variable coords
        variable wait
        if { $event eq "Move" } {
            if { $item ne "" } {
                lassign $coords xc yc
                set dx [expr {$x-$xc}]
                set dy [expr {$y-$yc}]
                set rad [expr {hypot($dx,$dy)}]
                set xtop    [expr {$xc - $rad}]
                set ytop    [expr {$yc - $rad}]
                set xbottom [expr {$xc + $rad}]
                set ybottom [expr {$yc + $rad}]

                $canvas coords $item $xtop $ytop $xbottom $ybottom
            } else {
                return
            }
        } else {
            if { $item ne "" } {
                # We have two points, so we are done
                set wait 1
            } else {
                # We have a centre
                set coords [list $x $y]
                set item [$canvas create oval [expr {$x-2}] [expr {$y-2}] [expr {$x+2}] [expr {$y+2}]]
            }
        }
    }

    method rectangle {event x y} {
        variable canvas
        variable item
        variable coords
        variable wait
        if { $event eq "Move" } {
            if { $item ne "" } {
                lassign $coords xtop ytop
                $canvas coords $item $xtop $ytop $x $y
            } else {
                return
            }
        } else {
            if { $item ne "" } {
                # We have two points, so we are done
                set wait 1
            } else {
                # We have a centre
                set coords [list $x $y]
                set item [$canvas create rectangle $x $y [expr {$x+2}] [expr {$y+2}]]
            }
        }
    }
}

grid [canvas .c]                                     -sticky news
grid [label  .l -textvariable mytext -relief sunken] -sticky news

set e [canvasEdit new .c]

$e link mytext  ;# This enables us to see the primitive text containing the current coordinates

catch {
    console show
}

# This will provoke an error - there is no "lattice" handler
#$e edit lattice

# Now we can edit a circle and get the canvas item ID for it
#puts [$e edit circle]
puts [$e edit rectangle]

Category Toys

Category Editor