# Balloon Functions
# 
# This file contains functions to render balloons.
#
# TODO: determine whether Cruise holds copyright
# Copyright (C) 1999-2002 David Gale <cruise@openverse.com>
# For more information visit http://www.openverse.com/
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307,
# USA.

# TODO: use global colors

namespace eval balloon {}
# Plot a balloon tagged $tag on canvas $cnv with the callout pointing to $x, $y
# args:	-side: default callout side; one of left, top, right, bottom, or hide
#	-calc-side: calculate which side to place callout? (boolean)
#	-margin: minimum distance from canvas edge
#	-clip: clip balloon to margin? (boolean)
#	-min-width: minimum balloon width
#	-min-height: minimum balloon height
#	-text: text placed inside balloon
#	-font: font used for text
#	-text-width: width at which to wrap text
#	-icon: icon placed alongside text
#	-fill: color used for inside balloon border
#	-outline: color used for balloon border
#	-foreground: text color
#	-shadow: text shadow color
#	-opacity: shadow opacity; from 0.0 to 1.0
#	-extra-tags: additional tags to use
proc balloon::create {x y cnv tag args} {
	# Determine canvas size
	set right [expr [winfo width $cnv] - 1]
	set bottom [expr [winfo height $cnv] - 1]

	# Defaults
	set callout_side "left"
	set calc_side 1
	set margin 10
	set clip 1
	set balloon_w 25
	set balloon_h 25
	set msg ""
	set balloon_font ""
	set text_width 240
	set icon ""
	set fill "white"
	set outline "black"
	set foreground "black"
	set shadow "black"
	set opacity 0.35
	set ex_tags {}

	# Parse extra arguments
	while 1 {
		if ![arg_pop arg args] break
		switch -- $arg {
		"-side" {arg_pop callout_side args}
		"-calc-side" {arg_pop calc_side args}
		"-margin" {arg_pop margin args}
		"-clip" {arg_pop clip args}
		"-min-width" {arg_pop balloon_w args}
		"-min-height" {arg_pop balloon_h args}
		"-text" {arg_pop msg args}
		"-font" {arg_pop fnt args; set balloon_font "-font [list $fnt]"}
		"-text-width" {arg_pop text_width args}
		"-icon" {arg_pop icon args}
		"-fill" {arg_pop fill args}
		"-outline" {arg_pop outline args}
		"-foreground" {arg_pop foreground args}
		"-shadow" {arg_pop shadow args}
		"-opacity" {arg_pop opacity args}
		"-extra-tags" {arg_pop ex_tags args}
		}
	}

	# Render the text (offscreen)
	if {$msg != ""} {
		# First, create the text
		set common "\$cnv create text -1000 -1000 -text \$msg\
				$balloon_font -width \$text_width -tags\
				\[lunion \$tag \$ex_tags \$which\]"
		set which "$tag-t4"; eval $common -fill $foreground
		if {$opacity > 0.0} {
			set fg [winfo rgb $cnv $shadow]
			set bg [winfo rgb $cnv $fill]

			set color [interp_color $bg $fg [expr $opacity / 2]]
			set which "$tag-t1"; eval $common -fill $color
			set which "$tag-t2"; eval $common -fill $color

			set color [interp_color $bg $fg $opacity]
			set which "$tag-t3"; eval $common -fill $color
		}

		# Now gauge the size of the text (and therefore the balloon)
		set box [$cnv bbox "$tag-t4"]
		set text_w [expr [lindex $box 2] - [lindex $box 0]]
		set text_h [expr [lindex $box 3] - [lindex $box 1]]
		set balloon_w [max $balloon_w [expr $text_w + 15]]
		set balloon_h [max $balloon_h [expr $text_h + 15]]
	} else {
		set text_w 0
		set text_h 0
	}

	# Render the icon (offscreen)
	if {$icon != ""} {
		$cnv create image -1000 -1000 -image $icon -tag [lunion $tag\
				$ex_tags "$tag-i"]
		set box [$cnv bbox "$tag-i"]
		set icon_w [expr [lindex $box 2] - [lindex $box 0]]
		set icon_h [expr [lindex $box 3] - [lindex $box 1]]
		if {$msg != ""} {
			incr balloon_w [expr $icon_w + 4]
		} else {
			set balloon_w [max $balloon_w [expr $icon_w + 7]]
		}
		set balloon_h [max $balloon_h [expr $icon_h + 7]]
	} else {
		set icon_w 0
		set icon_h 0
	}

	# Clip coordinates
	if $clip {
		if {$x < $margin} {
			set x $margin
		} elseif [expr $x > $right - $margin] {
			set x [expr $right - $margin]
		}
		if {$y < $margin} {
			set y $margin
		} elseif [expr $y > $bottom - $margin] {
			set y [expr $bottom - $margin]
		}
	}

	# Determine callout placement
	if $calc_side {
		if [expr $y < $margin + 12] {
			if [expr $x < $margin + 12 || $x > $right - $margin -\
					12] {
				set callout_side "hide"
			} else {
				set callout_side "top"
			}
		} elseif [expr $y > $bottom - $margin - 12] {
			if [expr $x < $margin + 12 || $x > $right - $margin -\
					12] {
				set callout_side "hide"
			} else {
				set callout_side "bottom"
			}
		} elseif [expr $x - $balloon_w < $margin + 12] {
			set callout_side "left"
		} elseif [expr $x + $balloon_w > $right - $margin - 12] {
			set callout_side "right"
		}
		if {($callout_side == "left" && [expr $x + $balloon_w >\
				$right - $margin - 12]) || ($callout_side ==\
				"right" && [expr $x - $balloon_w < $margin +\
				12])} {
			if [expr $x - $balloon_w < $margin + 12 ||\
					$x + $balloon_w > $margin - 12] {
				set callout_side "hide"
			} elseif [expr $y - $balloon_h < $margin + 12] {
				set callout_side "top"
			} else {
				set callout_side "bottom"
			}
		}
	}

	# Decide balloon coordinates
	switch -- $callout_side {
	"left" - "right" - "hide" {
		if [expr $y + $balloon_h / 2 > $bottom - $margin && $clip] {
			# Place against bottom
			set t [expr $bottom - $margin - $balloon_h]
			set b [expr $bottom - $margin]
		} elseif [expr $y - $balloon_h / 2 < $margin && $clip] {
			# Place against top
			set t $margin
			set b [expr $balloon_h + $margin]
		} else {
			# Somewhere in the middle
			set t [expr $y - $balloon_h / 2]
			set b [expr $y + $balloon_h / 2]
		}
	}}
	switch -- $callout_side {
	"top" - "bottom" - "hide" {
		if [expr $x + $balloon_w / 2 > $right - $margin && $clip] {
			# Place against right
			set l [expr $right - $margin - $balloon_w]
			set r [expr $right - $margin]
		} elseif [expr $x - $balloon_w / 2 < $margin && $clip] {
			# Place against left
			set l $margin
			set r [expr $balloon_w + $margin]
		} else {
			 # Somewhere in the middle
			 set l [expr $x - $balloon_w / 2]
			 set r [expr $x + $balloon_w / 2]
		}
	}}
	switch -- $callout_side {
	"left" {set l [expr $x + 10]; set r [expr $l + $balloon_w]}
	"top" {set t [expr $y + 10]; set b [expr $t + $balloon_h]}
	"right" {set r [expr $x - 10]; set l [expr $r - $balloon_w]}
	"bottom" {set b [expr $y - 10]; set t [expr $b - $balloon_h]}
	}

	set tags [lunion $tag $ex_tags]

	# Upper left
	$cnv create arc $l $t [expr $l + 14] [expr $t + 14] -start 90\
			-extent 90 -outline $fill -fill $fill -tag $tags
	$cnv create arc $l $t [expr $l + 14] [expr $t + 14] -start 90\
			-extent 90 -outline $outline -style arc -tag $tags

	# Upper right
	$cnv create arc $r $t [expr $r - 14] [expr $t + 14] -start 0\
			-extent 90 -outline $fill -fill $fill -tag $tags
	$cnv create arc $r $t [expr $r - 14] [expr $t + 14] -start 0\
			-extent 90 -outline $outline -style arc -tag $tags
	
	# Lower left
	$cnv create arc $l $b [expr $l + 14] [expr $b - 14] -start 180\
			-extent 90 -outline $fill -fill $fill -tag $tags
	$cnv create arc $l $b [expr $l + 14] [expr $b - 14] -start 180\
			-extent 90 -outline $outline -style arc -tag $tags
	
	# Lower right
	$cnv create arc $r $b [expr $r - 14] [expr $b - 14] -start 270\
			-extent 90 -outline $fill -fill $fill -tag $tags
	$cnv create arc $r $b [expr $r - 14] [expr $b - 14] -start 270\
			-extent 90 -outline $outline -style arc -tag $tags

	# Fill
	$cnv create rectangle [expr $l + 7] $t [expr $r - 7] $b\
			-outline $fill -fill $fill -tag $tags
	$cnv create rectangle $l [expr $t + 7] $r [expr $b - 7]\
			-outline $fill -fill $fill -tag $tags

	# Sides
	$cnv create line $l [expr $t + 7] $l [expr $b - 6] -fill $outline\
			-tag $tags
	$cnv create line [expr $l + 7] $t [expr $r - 6] $t -fill $outline\
			-tag $tags
	$cnv create line $r [expr $t + 7] $r [expr $b - 6] -fill $outline\
			-tag $tags
	$cnv create line [expr $l + 6] $b [expr $r - 6] $b -fill $outline\
			-tag $tags

	# Render the callout
	switch -- $callout_side {
	"left" {
		$cnv create polygon $l [expr $y - 5] $l [expr $y + 5] $x $y\
				-fill $fill -outline $outline -tag $tags
		$cnv create line $l [expr $y - 4] $l [expr $y + 5] -fill $fill\
				-tag $tags
	} "top" {
		$cnv create polygon [expr $x - 5] $t [expr $x + 5] $t $x $y\
			-fill $fill -outline $outline -tag $tags
		$cnv create line [expr $x - 4] $t [expr $x + 5] $t -fill $fill\
			-tag $tags
	} "right" {
		$cnv create polygon $r [expr $y - 5] $r [expr $y + 5] $x $y\
				-fill $fill -outline $outline -tag $tags
		$cnv create line $r [expr $y - 4] $r [expr $y + 5] -fill $fill\
				-tag $tags
	} "bottom" {
		$cnv create polygon [expr $x - 5] $b [expr $x + 5] $b $x $y\
			-fill $fill -outline $outline -tag $tags
		$cnv create line [expr $x - 4] $b [expr $x + 5] $b -fill $fill\
			-tag $tags

	}}

	# Find the center of the balloon
	set text_x [expr ($l + $r) / 2]
	set text_y [expr ($t + $b) / 2 + 1]

	# Put the icon in place
	if {$icon != ""} {
		if {$callout_side == "right"} {
			incr text_x [expr -$icon_w / 2]
			set icon_x [expr $r - 4]
			set anchor "e"
		} else {
			incr text_x [expr $icon_w / 2]
			set icon_x [expr $l + 4]
			set anchor "w"
		}
		$cnv itemconfigure "$tag-i" -anchor $anchor
		$cnv coords "$tag-i" $icon_x $text_y
		$cnv raise "$tag-i"
	}


	# Put the text in place
	if {$msg != ""} {
		if {$opacity > 0.0} {
			$cnv coords "$tag-t1" [expr $text_x + 1] $text_y
			$cnv coords "$tag-t2" $text_x [expr $text_y + 1]
			$cnv coords "$tag-t3" [expr $text_x + 1]\
					[expr $text_y + 1]
			for {set i 1} {$i < 4} {incr i} {$cnv raise "$tag-t$i"}
		}
		$cnv coords "$tag-t4" $text_x $text_y
		$cnv raise "$tag-t4"
	}
}