#!/usr/local/bin/wish

source stooop.tcl

proc graphic::graphic {this canvas item} {
    set graphic($this,canvas) $canvas
    set graphic($this,item) $item
    $canvas bind $item <Button1-Motion> "graphic::moveTo $this %x %y"
    $canvas bind $item <ButtonRelease-1> "capture $this"
}

proc graphic::~graphic {this} {
    $graphic($this,canvas) delete $graphic($this,item)
}

virtual proc graphic::add {this object}

virtual proc graphic::moveBy {this x y} {
    $graphic($this,canvas) move $graphic($this,item) $x $y
}

virtual proc graphic::moveTo {this x y} {
    set coordinates [$graphic($this,canvas) coords $graphic($this,item)]
    $graphic($this,canvas) move $graphic($this,item) [expr $x-[lindex $coordinates 0]] [expr $y-[lindex $coordinates 1]]
}


proc picture::picture {this canvas} graphic {
    $canvas [$canvas create rectangle 0 0 100 80 -outline red -width 2]
} {
    set picture($this,graphics) {}
}

proc picture::~picture {this} {
    # should we delete children here?
}

proc picture::add {this object} {
    if {$object==$this} {
        # cannot add self
        return 0
    }
    set coordinates [$graphic($this,canvas) coords $graphic($object,item)]
    set x [lindex $coordinates 0]
    set y [lindex $coordinates 1]
    set box [$graphic($this,canvas) bbox $graphic($this,item)]
    if {($x>=[lindex $box 0])&&($x<=[lindex $box 2])&&($y>=[lindex $box 1])&&($y<=[lindex $box 3])} {
        if {[lsearch -exact $picture($this,graphics) $object]<0} {
            # make sure it is not already captured
            lappend picture($this,graphics) $object
        }
        return 1
    }
    return 0
}

proc picture::moveBy {this x y} {
    # move children first
    foreach object $picture($this,graphics) {
        graphic::moveBy $object $x $y
    }
    # finally move self using base class implementation
    ::graphic::moveBy $this $x $y
}

proc picture::moveTo {this x y} {
    set coordinates [$graphic($this,canvas) coords $graphic($this,item)]
    picture::moveBy $this [expr $x-[lindex $coordinates 0]] [expr $y-[lindex $coordinates 1]]
}

proc oval::oval {this canvas} graphic {
    $canvas [$canvas create oval 0 0 22 12 -fill green]
} {}

proc oval::~oval {this} {}

proc oval::add {this object} {return 0}

proc rectangle::rectangle {this canvas} graphic {
    $canvas [$canvas create rectangle 0 0 20 10 -fill cyan]
} {}

proc rectangle::~rectangle {this} {}

proc rectangle::add {this object} {return 0}

set graphics {}

proc capture {moved} {
    global graphics

    foreach object $graphics {
        if {[graphic::add $object $moved]} {
            return 1
        }
    }
    return 0
}


bind . <q> exit

set canvas [canvas .canvas -highlightthickness 0 -width 500 -height 400]
pack $canvas -fill both -expand 1

label .create -text Create:
button .picture -text Picture -command {lappend graphics [new picture $canvas]}
button .rectangle -text Rectangle -command {lappend graphics [new rectangle $canvas]}
button .oval -text Oval -command {lappend graphics [new oval $canvas]}
button .exit -text Exit -command exit

button .clear -text Clear -command {
    eval delete $graphics
    set graphics {}
}

pack .create .picture .rectangle .oval -side left
pack .exit .clear -side right
