#	------------------------------------------------------------
#   Copyright (c) 2016-2016
#	Q.W.Page Associates Inc.
#	www.qwpage.com
#	All rights reserved.
#	------------------------------------------------------------
::namespace eval ::qw::barchart_simple {
	/* {
    Started with a simple barchart by Richard Suchenwirth 2005-02-27.
	See http://wiki.tcl.tk/13680
    */ }
    ::proc bars_draw {sargs} {
        /* {
		Charts a series where series is list of structures with the form
        .value xx .text xxx .color zzz.
        */ }
        ::set Canvas [::sargs::get $sargs .canvas];
        ::set x0 [::sargs::get $sargs .x0];
        ::set y0 [::sargs::get $sargs .y0];
        ::set x1 [::sargs::get $sargs .x1];
        ::set y1 [::sargs::get $sargs .y1];
        ::set Series [::sargs::get $sargs .series];
        ::set Values 0;
        ::foreach Bar $Series {
			#::lappend Values [lindex $Bar 1]
			::lappend Values [::sargs::get $Bar .value]
        }
        ::set top [round_up .value [max .list $Values]];
        ::set bot [round_down .value [min .list $Values]];
        ::set f [yscale .canvas $Canvas .x0 $x0 .y0 $y0 .y1 $y1 .min $bot .max $top]
        ::set x [expr $x0+30]
        ::set dx [expr ($x1-$x0-$x)/[::llength $Series]]
        ::set y3 [expr $y1-20]
        ::set y4 [expr $y1+10]
        $Canvas create poly $x0 $y4 [expr $x0+30] $y3  $x1 $y3 [expr $x1-20] $y4 -fill gray65
        ::set dxw [expr $dx*6/10]
        foreach Bar $Series {
            ::set Text [::sargs::get $Bar .text]
            ::set Value [::sargs::get $Bar .value]
            ::set Color [::sargs::get $Bar .color]
            ::set y [expr {round($y1-($Value*$f))}]
            ::set y1a $y1
            ::if {$y>$y1a} {swap y y1a}
            ::set tag [expr {$Value<0? "d": ""}]
            3d_bar_draw .canvas $Canvas .x0 $x .y0 $y .x1 [expr $x+$dxw] .y1 $y1a .canvas_options [::list -fill $Color -tag $tag];
            $Canvas create text [expr {$x+12}] [expr {$y-12}] -text $Value
            $Canvas create text [expr {$x+12}] [expr {$y1a+2}] -text $Text -anchor n
            incr x $dx
        }

        ::set AverageValue [::sargs::get $sargs .average.value];
        ::set AverageText [::sargs::get $sargs .average.text];
        ::if {$AverageValue ne ""} {
            ::set Width [$Canvas cget -width];
            ::set AverageY [expr {round($y1-($AverageValue*$f))}]
            $Canvas create line 10 $AverageY $Width $AverageY -dash {20 20};
            $Canvas create text [::expr {$Width-100}] [::expr {$AverageY-10}] -text "$AverageText $AverageValue";
        }
        $Canvas lower d
    }
	::proc canvas_draw {sargs} {
		/* {
		Draws the barchart on the specified canvas.
        */ }
		::set sargs [::sargs::+= [::sargs \
			.width 780 \
            .height 480 \
			.title_area_height 50 \
			.caption_area_height 30 \
			.color darkslategray1 \
			.background white \
			.title "" \
			.series {} \
        ] $sargs];
		::set Width [::sargs::get $sargs .width];
		::set Height [::sargs::get $sargs .height];
		::set TitleAreaHeight [::sargs::get $sargs .title_area_height];
		::set CaptionAreaHeight [::sargs::get $sargs .caption_area_height];
		#::set Width [::expr {int(double(780)/double(13)*double([::llength [::sargs::get $sargs .series]]))}];
		::set BarHeight [::expr {$Height-$TitleAreaHeight-$CaptionAreaHeight}];
		::set Background [::sargs::get $sargs .background];
		::set Canvas [::sargs::get $sargs .canvas];
        ::if {![::winfo exists $Canvas]} {
			::qw::throw "Canvas widget \"$Canvas\" does not exist.";
		}
		::set Series [::sargs::get $sargs .series];
		::set TeamAverage [::sargs::get $sargs .average];
		bars_draw $sargs \
			.canvas $Canvas \
            .x0 10 \
            .y0 20 \
            .x1 $Width \
            .y1 $BarHeight \
        ;
		::set Title [::sargs::get $sargs .title];
		::if {$Title ne ""} {
#             $Canvas create text 20 240 -anchor c -font {Helvetica 18} -text $Title;
             $Canvas create text [::expr {$Width/2}] [::expr {$Height-$TitleAreaHeight/2}] -font {Helvetica 18} -text $Title;
        }
    }
	::proc image_file_create {sargs} {
		/* {
		Creates a temporary canvas and renders the chart into it, then exports to
        the specified image file in the specified image format.

        Limitation: The canvas must be rendered on the screen and hence must fit
        the screen. Only known way around this is to render postscript.
        */ }
		::set sargs [::sargs::+= [::sargs \
			.width 780 \
            .height 480 \
			.title_area_height 50 \
			.caption_area_height 30 \
			.color darkslategray1 \
			.background white \
			.title "" \
			.series {} \
        ] $sargs];
		::set Width [::sargs::get $sargs .width];
		::set Height [::sargs::get $sargs .height];
		::set TitleAreaHeight [::sargs::get $sargs .title_area_height];
		::set CaptionAreaHeight [::sargs::get $sargs .caption_area_height];
		#::set Width [::expr {int(double(780)/double(13)*double([::llength [::sargs::get $sargs .series]]))}];
		::set BarHeight [::expr {$Height-$TitleAreaHeight-$CaptionAreaHeight}];
		::set Background [::sargs::get $sargs .background];
		::set File [::sargs::get $sargs .image.file];
		::if {$File eq ""} {
			::qw::throw "Image file was not to be specified.";
        }
		::set Type [::sargs::get $sargs .image.type]
		::set Type [::string trim $Type];
		::set Type [::string tolower $Type];
		::switch -- $Type {
			gif {
            }
            default {
				::qw::throw "Encountered invalid image type \"$Type\".";
            }
        }
		::for {::set i 0} {[::winfo exists .barchart_simple_toplevel$i]} {::incr i;} {
        }
		::set Toplevel [::toplevel .barchart_simple_toplevel$i];
		::qw::toplevel_add .toplevel $Toplevel;
		::set Canvas $Toplevel.canvas;
		::qw::finally [::list ::destroy $Toplevel];
        ::canvas $Canvas -width $Width -height $Height -background $Background;
        ::pack $Canvas;
		canvas_draw $sargs .canvas $Canvas;
		::update;
		::switch -- $Type {
			gif {
                ::set Image [::image create photo -format window -data $Canvas];
                $Image write $File -format GIF;
                ::image delete $Image;
            }
        }
    }
    ::proc 3d_bar_draw {sargs} {
        /* {
        Draws a bar as a 3-d object, using parallelograms for depth.
        */ }
		::set Canvas [::sargs::get $sargs .canvas];
		::set x0 [::sargs::get $sargs .x0];
		::set y0 [::sargs::get $sargs .y0];
		::set x1 [::sargs::get $sargs .x1];
		::set y1 [::sargs::get $sargs .y1];
		::set CanvasOptions [::sargs::get $sargs .canvas_options];
        ::set d [expr {($x1-$x0)/3}]
        ::set x2 [expr {$x0+$d+1}]
        ::set x3 [expr {$x1+$d}]
        ::set y2 [expr {$y0-$d+1}]
        ::set y3 [expr {$y1-$d-1}]
#        ::set id [eval [list $Canvas create rect] $args]
        ::set id [::eval [::list $Canvas create rect $x0 $y0 $x1 $y1] $CanvasOptions];
        ::set fill [$Canvas itemcget $id -fill]
        ::set tag [$Canvas gettags $id]
        $Canvas create poly $x0 $y0 $x2 $y2 $x3 $y2 $x1 $y0 -fill [dim .color $fill .factor 0.8] -outline black
        $Canvas create poly $x1 $y1 $x3 $y3 $x3 $y2 $x1 $y0 -fill [dim .color $fill .factor 0.6] -outline black -tag $tag
    }
	::proc dim {sargs} {
		/* {
		For a more plastic look, the fill color of the polygons is reduced in
        brightness ("dimmed").
        */ }
		::set Color [::sargs::get $sargs .color];
		::set Factor [::sargs::get $sargs .factor];
        ::foreach Component {Red Green Blue} n [winfo rgb . $Color] d [::winfo rgb . white] {
			::set $Component [::expr int(255.*$n/$d*$Factor)];
		}
		::return [::format #%02x%02x%02x $Red $Green $Blue];
    }
	::proc yscale {sargs} {
		/* {
		Draw a simple scale for the y axis, and return the scaling factor.
        */ }
		::set Canvas [::sargs::get $sargs .canvas];
		::set x0 [::sargs::get $sargs .x0];
		::set y0 [::sargs::get $sargs .y0];
		::set y1 [::sargs::get $sargs .y1];
		::set Min [::sargs::get $sargs .min];
		::set Max [::sargs::get $sargs .max];
		::set dy [::expr {$y1-$y0}];
		::regexp {([1-9]+)} $Max -> prefix;
    	::if {![::info exists prefix]} {
			#rwb_debug
			::qw::throw "This command is currently disabled.";
        }
    	::set stepy [::expr {1.*$dy/$prefix}];
    	::set step [::expr {$Max/$prefix}];
		::set y $y0;
		::set label $Max;
		::while {$label>=$Min} {
			$Canvas create text $x0 $y -text $label -anchor w;
			::set y [::expr {$y+$stepy}];
			::set label [::expr {$label-$step}];
		}
		::return [::expr {$dy/double($Max)}];
	}
    ::proc max {sargs} {
		::set List [::sargs::get $sargs .list];
        ::set Result [::lindex $List 0];
        ::foreach Value [::lrange $List 1 end] {
            ::if {$Value>$Result} {
                ::set Result $Value;
            }
        }
        ::return $Result;
    }
    ::proc min {sargs} {
		::set List [::sargs::get $sargs .list];
        ::set Result [::lindex $List 0];
        ::foreach Value [::lrange $List 1 end] {
            ::if {$Value<$Result} {
                ::set Result $Value;
            }
        }
        ::return $Result;
    }
    ::proc swap {_a _b} {
		::upvar 1 $_a a $_b b
        ::foreach {a b} [::list $b $a] {
        	break;
		}
    }
    ::proc round_up {sargs} {
        /* {
        Interesting regular expression to break up a number.
        */ }
        ::set n [::sargs::get $sargs .value];
        ::regexp {(.+)e([+-])0*(.+)} [::format %e $n] -> Mantissa Sign Exponent
        ::set Exponent [::expr $Sign$Exponent]
        ::if {abs($Mantissa)<1.5} {
            ::set Mantissa [::expr {$Mantissa*10}];
            ::incr Exponent -1;
        }
#        ::set t [::expr {round($Mantissa $Direction 0.49)*pow(10,$Exponent)}];
        ::set t [::expr round($Mantissa+0.49)*pow(10,$Exponent)];
        ::if {$Exponent>=0} {
            ::return [::expr int($t)];
        }
        ::return $t;
    }
    ::proc round_down {sargs} {
        /* {
        Interesting regular expression to break up a number.
        */ }
        ::set n [::sargs::get $sargs .value];
        ::regexp {(.+)e([+-])0*(.+)} [::format %e $n] -> Mantissa Sign Exponent
        ::set Exponent [::expr $Sign$Exponent]
        ::if {abs($Mantissa)<1.5} {
            ::set Mantissa [::expr {$Mantissa*10}];
            ::incr Exponent -1;
        }
#        ::set t [::expr {round($Mantissa $Direction 0.49)*pow(10,$Exponent)}];
        ::set t [::expr round($Mantissa-0.49)*pow(10,$Exponent)];
        ::if {$Exponent>=0} {
            ::return [::expr int($t)];
        }
        ::return $t;
    }
}