canvas_gradient.tcl0000755000175100010010000001041212152102130013401 0ustar  JarekNone# *- tcl -*-
# ### ### ### ######### ######### #########

# Copyright (c) 2013 Jarek Lewandowski (MaxJarek)
# Origin http://wiki.tcl.tk/6100
# Origin http://wiki.tcl.tk/37242
# Origin http://wiki.tcl.tk/9079
# OLL licensed (http://wiki.tcl.tk/10892)

# ### ### ### ######### ######### #########
## Requisites

package require Tk  8.5

namespace eval ::canvas {}

# ### ### ### ######### ######### #########
## Implementation.

proc ::canvas::gradient {canvas args} {

	gradient::DrawGradient $canvas {*}$args
	bind $canvas <Configure> [list ::canvas::gradient::DrawGradient %W {*}$args]

}

# ### ### ### ######### ######### #########
## Helper commands. Internal.

namespace eval ::canvas::gradient {}

proc ::canvas::gradient::getNextColor {i} {

upvar r1 r1
upvar g1 g1
upvar b1 b1
upvar rRatio rRatio
upvar gRatio gRatio
upvar bRatio bRatio

set nR [expr {int( $r1 + ($rRatio * $i) )}]
set nG [expr {int( $g1 + ($gRatio * $i) )}]
set nB [expr {int( $b1 + ($bRatio * $i) )}]

return [format "#%04X%04X%04X" $nR $nG $nB]

}
proc ::canvas::gradient::DrawGradient {canvas args} {

	set args [dict merge [subst {
		-direction x
		-color1 red
		-color2 green
		-type linear
	}] $args]
	
	set color1 [dict get $args -color1]
	set color2 [dict get $args -color2]
	set direction [dict get $args -direction]
	
	## Clear gradient
	$canvas delete gradient

	## Get current canvas width and height.
	set canWidthPx  [winfo width  $canvas]
	set canHeightPx [winfo height $canvas]
	
	## return if canvas too small
	if {$canWidthPx < 10 || $canHeightPx < 10} {return}
	
	## Get the distance 'distPx' (in pixels) over which
	## the 2 colors are to be gradiated.

	switch -exact -- $direction {
		x	{set distPx $canWidthPx}	
		y	{set distPx $canHeightPx}
		r	{
			set halfWidthPx [expr {int($canWidthPx / 2)}]
			set halfHeightPx [expr {int($canHeightPx / 2)}]
			set distPx [expr {max($halfHeightPx,$halfWidthPx)}]
			$canvas create rectangle  0 0 $canWidthPx $canHeightPx -tags gradient -fill $color2
		}
		d1 {
			set distPx [expr {$canWidthPx + $canHeightPx}]
		}
		d2 {
			set distPx [expr {$canWidthPx + $canHeightPx}]
		}
		default {
			return -code error "Invalid direction $direction"
		}
	}

	## Get RGB ranges.
	if {[catch {
		foreach {r1 g1 b1} [winfo rgb $canvas $color1] {}
		foreach {r2 g2 b2} [winfo rgb $canvas $color2] {}
	} err]} {
		return -code error $err
	}
   
   set rRange [expr {$r2 - $r1 + 0.0}]
   set gRange [expr {$g2 - $g1 + 0.0}]
   set bRange [expr {$b2 - $b1 + 0.0}]
   
   ## Calc the ratio of RGB-color-ranges to distance
   ## 'across' the canvas.

   set rRatio [expr {$rRange / $distPx}]
   set gRatio [expr {$gRange / $distPx}]
   set bRatio [expr {$bRange / $distPx}]

   ## Increment 'across' the canvas, drawing colored lines, ovals
   ## with canvas-'create line', create oval.

   if {$direction eq "d1"} {
   
		# drawing for diagonal direction, letf-top
		#
		for {set i 0} {$i <= $canHeightPx} {incr i} {
			catch {$canvas create line $i 0 0 $i -tags gradient -fill [getNextColor $i]}
		}
		set x $i;set c $i
		for {set i 0} {$i <= $canWidthPx} {incr i} {
			catch {$canvas create line $i $canHeightPx $x 0 -tags gradient -fill [getNextColor $c]}
			incr x
			incr c
		}
   
   } elseif {$direction eq "d2"} {
   
		# drawing for diagonal direction, left-bottom
		#
		set x 0
		for {set i $canHeightPx} {$i >= 0} {incr i -1} {
			catch {$canvas create line $x $canHeightPx 0 $i -tags gradient -fill [getNextColor $x]}
			incr x
		}
		set c $x
		for {set i 0} {$i <= $canWidthPx} {incr i} {
			catch {$canvas create line $i 0 $x $canHeightPx -tags gradient -fill [getNextColor $c]}
			incr x
			incr c
		}
   
   } else {
   
		for {set i $distPx} {$i >= 0} {incr i -1} {

			switch -exact -- $direction {
				x	{
					catch {$canvas create line $i 0 $i $canHeightPx -tags gradient -fill [getNextColor $i]}
				}
				y	{
					catch {$canvas create line 0 $i $canWidthPx $i -tags gradient -fill [getNextColor $i]}
				}
				r	{
					set xx1 [expr {$halfWidthPx + $i}]
					set xx2 [expr {$halfHeightPx + $i}]
					set xx3 [expr {$halfWidthPx - $i}]
					set xx4 [expr {$halfHeightPx - $i}]
					catch {$canvas create oval  $xx1 $xx2 $xx3 $xx4  -tags gradient -fill [getNextColor $i] -outline {}}
				}
				
			}
	  
		}
	}
}


# ### ### ### ######### ######### #########
## Ready

package provide canvas::gradient 0.1
returncanvas_gradient.man0000755000175100010010000000332012152104004013374 0ustar  JarekNone[comment {-*- tcl -*- doctools manpage}]
[manpage_begin canvas::gradient n 0.1]
[moddesc   {Variations on a canvas}]
[copyright {2013 Jarek Lewandowski, MaxJarek}]
[copyright {Origin http://wiki.tcl.tk/6100}]
[copyright {Origin http://wiki.tcl.tk/37242}]
[copyright {Origin http://wiki.tcl.tk/9079}]
[titledesc {Canvas with gradient}]
[require Tcl 8.5]
[require Tk 8.5]
[description]

This package provides a command to gradients on canvases.

[section API]

[list_begin definitions]

[call [cmd ::canvas::gradient] [arg pathName] [opt options]]

Creates gradient on the canvas [arg pathName].

[list_end]

[subsection Options]

[list_begin options]
[opt_def -direction ?direction?]

The value for this option select direction for the gradient. Package supports:

[list_begin opt]
[opt_def x]
	for horizontal gradient (default)
[opt_def y]
	for vertical gradient
[opt_def r]
	for radial gradient
[opt_def d1]
	for left_top diagonal gradient 
[opt_def d2]
	for left_bottom diagonal gradient
[opt_def r]
	for radial gradient
[list_end]

[opt_def -color1 ?color?]

The value for this option select starting color for gradient. Default is red.

[opt_def -color2 ?color?]

The value for this option select ending color for gradient. Default is green.

[opt_def -type ?type?]

The value for this option select calculation method for gradient. Package supports:

[list_begin opt]
[opt_def linear]
for linear calculation (default)
[list_end]



[list_end]

[section Example]

[example {
	package require canvas::gradient
	canvas .c
	canvas::gradient .c -direction x -color1 yellow -color2 blue
	pack .c -fill both -expand 1
}]

[keywords canvas gradients image]
[manpage_end]