#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
  exec wish8.4 "$0" ${1+"$@"}

## Check Tk version:
package require Tk 8.3

if {$::tcl_version == "8.3" && ![package vsatisfies $::tcl_patchLevel 8.3.3]} {
    tk_messageBox -type ok -icon error \
	    -message "  =====> TkDND requires at least tk8.3.3! <====="
    exit 1
}

## Load tkdnd package...
set DIR [file dirname [file normalize [info script]]]
## Make sure that we can find the tkdnd package even if the user has not yet
## installed the package.
lappend auto_path [file dirname $DIR] [file dirname $DIR]/lib
package require tkdnd
after idle "init"


#------------------------------------------------------------------------------
#	Step 1: A source with actions
#------------------------------------------------------------------------------

# create the source window
label .source -text "source" -relief groove -bd 2 -width 20
pack .source -pady 5
# tells the DND protocol source can deliver textual data
dnd bindsource .source text/plain {return "testing DND"}
# bind DND: on left button, default copy action
#           on right button, define an list via 'ask' action
bind .source <1> { status ""; update; dnd drag %W -actions {copy move link} }
bind .source <3> { status ""; update; dnd drag %W -actions {ask copy move link} \
                      -descriptions {{Select Action} {Copy} {Move} {Link}} }

# defines the target window
label .target1 -text "drop zone" -relief raised -bd 1 -width 20
pack .target1 -pady 5
# tells the DND protocol target can handle textual data
dnd bindtarget .target1 text/plain <Drop> {status "\[target1\] type='%T', data='%D', action='%A'"}


#------------------------------------------------------------------------------
#	Step 2: Do some work on target
#------------------------------------------------------------------------------

# defines a target window
label .target2 -text "drop zone with bell" -relief raised -bd 1 -width 20
pack .target2 -pady 5
# ring a bell when we enter in target2
# NOTE: we use the "default" action which means to use the action as
#       initiated by the source
dnd bindtarget .target2 text/plain <DragEnter> {bell; return "default"}

dnd bindtarget .target2 text/plain <Drop> {status "\[target2\] type='%T', data='%D', action='%A'"}


#------------------------------------------------------------------------------
#	Step 3: Force an action
#------------------------------------------------------------------------------

# defines a target window
label .target3 -text "drop zone (link)" -relief raised -bd 1 -width 20
pack .target3 -pady 5
# force a 'link' action
# NOTE: this overwrite the desired action from drag (compare the behaviour
#       of target3 and target2)
dnd bindtarget .target3 text/plain <Drag> {return "link"}

dnd bindtarget .target3 text/plain <Drop> {status "\[target3\] type='%T', data='%D', action='%A'"}


#------------------------------------------------------------------------------
#	Step 4: Define the action during the drag
#------------------------------------------------------------------------------

# defines a target window
label .target4 -text "drop zone (link/move)" -relief raised -bd 1 -width 20
pack .target4 -pady 5
# 'link' action or 'move' action depending of position
dnd bindtarget .target4 text/plain <Drag> {
	if {%x < [winfo width %W]/2} {
		return "link"
	} else {
		return "move"
	}
}

dnd bindtarget .target4 text/plain <Drop> {status "\[target4\] type='%T', data='%D', action='%A'"}



#==============================================================================
#	END
#==============================================================================

proc status {msg} {
	.status configure -text $msg
}

proc help {} {
	toplevel .help
	wm title .help "Help for tutorial"
	text .help.t -font {Helvetica -12}
	bindtags .help.t {.t .help all}
	pack .help.t -fill both -expand true
	.help.t tag configure bigbold -font {Helvetica -16 bold}
	.help.t tag configure bold -font {Helvetica -12 bold}
	.help.t insert end "Source\n" bigbold \
			"\nHandles the following type:    text/plain = \"testing DND\"" normal

	.help.t insert end "\n\nDrop zone \[target1\]\n" bigbold \
			"\nAccepts:    text/plain" normal
	.help.t insert end "\n\nDrop zone with bell \[target2\]\n" bigbold \
			"\nAccepts:    text/plain, ring a bell when mouse enter the zone" normal
	.help.t insert end "\n\nDrop zone (link) \[target3\]\n" bigbold \
			"\nAccepts:    text/plain, force an action of type 'link'" normal
	.help.t insert end "\n\nDrop zone (link/move)       \[target4\]\n" bigbold \
			"\nAccepts:    text/plain, dynamically change the action. Link on left side, move on right side." normal
}

proc init {} {
	wm title . "Tutorial 1: The actions"

	label .status -relief sunken -bd 1 -width 60 -anchor w
	pack .status -side bottom -fill x
	pack [frame .sep -height 10] -side bottom -fill x
	pack propagate .status 0

	help
}
