# Copyright (C) 2013 by S. Serper, email : [email protected]
#
# The author  hereby grant permission to use,  copy, modify, distribute,
# and  license this  software  and its  documentation  for any  purpose,
# provided that  existing copyright notices  are retained in  all copies
# and that  this notice  is included verbatim  in any  distributions. No
# written agreement, license, or royalty  fee is required for any of the
# authorized uses.  Modifications to this software may be copyrighted by
# their authors and need not  follow the licensing terms described here,
# provided that the new terms are clearly indicated on the first page of
# each file where they apply.
#
# IN NO  EVENT SHALL THE AUTHOR  OR DISTRIBUTORS BE LIABLE  TO ANY PARTY
# FOR  DIRECT, INDIRECT, SPECIAL,  INCIDENTAL, OR  CONSEQUENTIAL DAMAGES
# ARISING OUT  OF THE  USE OF THIS  SOFTWARE, ITS DOCUMENTATION,  OR ANY
# DERIVATIVES  THEREOF, EVEN  IF THE  AUTHOR  HAVE BEEN  ADVISED OF  THE
# POSSIBILITY OF SUCH DAMAGE.
#
# THE  AUTHOR  AND DISTRIBUTORS  SPECIFICALLY  DISCLAIM ANY  WARRANTIES,
# INCLUDING,   BUT   NOT  LIMITED   TO,   THE   IMPLIED  WARRANTIES   OF
# MERCHANTABILITY,  FITNESS   FOR  A  PARTICULAR   PURPOSE,  AND
# NON-INFRINGEMENT.  THIS  SOFTWARE IS PROVIDED  ON AN "AS  IS" BASIS,
# AND  THE  AUTHOR  AND  DISTRIBUTORS  HAVE  NO  OBLIGATION  TO  PROVIDE
# MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

# Call Usage: 
#  ::selectionBox::createBindings4 \
#    <toplevel path>  : mandatory argument to enable selection box for specified toplevel 
#    ?procdure call?  : optional, proc to call when user releases the selection box 
#    ?Button?         : optional, keyboard button to press simultaneously to draw selection box
#    ?Xoffs?          : optional, to specify x-offset to compensate for the toplevel frame-dimensions 
#    ?Yoffs?          : optional, to specify y-offset to compensate for the toplevel frame-dimensions

namespace eval ::selectionBox {
  proc create {X Y x y} {
    toplevel .t
    wm geometry .t "2x2+$X+$Y"
    wm attributes .t -topmost 1 -alpha 0.75
    wm overrideredirect .t 1
    pack [canvas .t.c -bd 0 -highlightthickness 0] -anchor ne -side left -expand 1 -fill both
    .t.c create rect 1 1 [expr $x-2] [expr $y-2] -fill gray80 -outline black -dash {2 4} -tag drect
    set ::selectionBox::Box(startX) $X
    set ::selectionBox::Box(startY) $Y
  }
  
  proc modify {X Y x y} {
    set x [expr $X - $::selectionBox::Box(startX)+2]
    set y [expr $Y - $::selectionBox::Box(startY)+2]
    set geo [split [split [wm geo $::selectionBox::Box(parent)] x] +]
    if {($x+$::selectionBox::Box(startX)-$::selectionBox::Box(pXoffs))>=([lindex $geo 0 0]+[lindex $geo 1])} {
      set x [lindex [split [split [wm geo .t] x] +] 0 0]
    }
    if {($y+$::selectionBox::Box(startY)-$::selectionBox::Box(pYoffs))>=([lindex $geo 0 1]+[lindex $geo 2])} {
      set y [lindex [split [split [wm geo .t] x] +] 0 1]
    }
    if {![catch {wm geometry .t "${x}x${y}"}]} {.t.c coords drect 1 1 [expr $x-2] [expr $y-2]}
  }
  
  proc createBindings4 {w {procall ""} {Button Control} {Xoffs 4} {Yoffs 27}} {
    set ::selectionBox::Box(pXoffs) $Xoffs
    set ::selectionBox::Box(pYoffs) $Yoffs
    set ::selectionBox::Box(parent) $w
    set ::selectionBox::proc        $procall
    if {$Button!=""} {set Button "$Button-"}
  
    bind $w <${Button}Button1-Motion> {+;
      if {![catch {winfo class .t}]} {
        ::selectionBox::modify %X %Y %x %y
      } {
        ::selectionBox::create %X %Y %x %y
      }
    }
    
    bind $w <${Button}ButtonRelease-1> {+;
      if {![catch {set ::selectionBox::Box(crds) [wm geo .t]}]} {
        catch {$::selectionBox::proc}
        destroy .t
      }
    }
  }
}

# -------------------------- TEST CASE -----------------------------------------
::selectionBox::createBindings4 . myproc

proc myproc {} {
  # insert any further customization of the selected area here...
  tk_messageBox -message "user selected the following geometry dimensions: $::selectionBox::Box(crds)"
}