Version 5 of Google Chart API Wrapper

Updated 2008-10-23 15:41:21 by jscottb
 A Quick and dirty Google Chart wrapper.

 if 0 {
 Google Chart API [http://code.google.com/apis/chart] Tcl wrapper.
 [Scott Beasley] 2008-10-22
 }

 ######################################################
 # Simple package to generate Google charts from tcl.
 #
 # License: Do as you wish.  No Warranty given.
 # 
 # Scott Beasley 10-21-2008
 ######################################################

 package provide googlecharts
 package require autoproxy

 namespace eval GoogleChart {
    # See http://code.google.com/apis/chart/ for info
    # on the Google chart api.

    proc GChart {chart_hnd type {wid 250} {hgt 200}} {
       upvar $chart_hnd chart_array

       set chart_array(type) $type
       set chart_array(width) $wid
       set chart_array(height) $hgt
       set chart_array(low) 0
       set chart_array(high) 0
    }

    proc GChartSize {chart_hnd wid hgt} {
       upvar $chart_hnd chart_array

       set chart_array(width) $wid
       set chart_array(height) $hgt
    }      

    proc GChartRange {chart_hnd low high} {
       upvar $chart_hnd chart_array

       set chart_array(low) $low
       set chart_array(high) $high
    }      

    proc GChartType {chart_hnd type} {
       upvar $chart_hnd chart_array

       set chart_array(type) $type
    }

    proc GChartTitle {chart_hnd title {color "0000ff"} {size 12}} {
       upvar $chart_hnd chart_array

       regsub -all " " $title {+} title
       set chart_array(title) $title
       set chart_array(titlecolor) $color
       set chart_array(titlesize) $size
    }

    proc GChartLegend {chart_hnd legend {side r}} {
       upvar $chart_hnd chart_array

       set chart_array(legend) $legend
       set chart_array(legendside) $side
    }

    proc GChartAddDataSet {chart_hnd data} {
       upvar $chart_hnd chart_array

       if {[info exists chart_array(data)]} {
          lappend chart_array(data) $data
       } else {         
          set chart_array(data) $data
       }         
    }

    proc GChartLables {chart_hnd lables} {
       upvar $chart_hnd chart_array

       set chart_array(lables) $lables
    }

    proc GChartLableOrder {chart_hnd order} {
       upvar $chart_hnd chart_array

       set chart_array(lableorder) $order
    }

    proc GChartColors {chart_hnd colors} {
       upvar $chart_hnd chart_array

       set chart_array(colors) $colors
    }

    proc GChartPlotToURL {chart_hnd} {
       upvar $chart_hnd chart_array

       return [build_plot_URL chart_array]
    }

    proc GChartPlotToMemory {chart_hnd} {
       upvar $chart_hnd chart_array

       set url [build_plot_URL chart_array]
       set toc [http::geturl $url]
       set chart_graph [http::data $toc]

       upvar $toc state
       if {$state(type) ne {image/png}} {
          http::cleanup $toc
          return -code error {}
       } else {
          http::cleanup $toc
          return $chart_graph
       }
    }

    proc GChartPlotToChannel {chart_hnd chan} {
       upvar $chart_hnd chart_array

       set url [build_plot_URL chart_array]
       set toc [http::geturl $url -channel $chan]

       upvar $toc state
       if {$state(type) ne {image/png}} {
          http::cleanup $toc
          return -code error 1
       } else {
          http::cleanup $toc
          return 0
       }
    }

    proc GChartPlotToFile {chart_hnd filename} {
       upvar $chart_hnd chart_array

       set url [build_plot_URL chart_array]
       set fd [open $filename "w"]
       fconfigure $fd -translation binary
       set toc [http::geturl $url -channel $fd]
       close $fd

       upvar $toc state
       if {$state(type) ne {image/png}} {
          http::cleanup $toc
          return -code error 1
       } else {
          http::cleanup $toc
          return 0
       }
    }

    proc build_plot_URL {chart_hnd} {
       upvar $chart_hnd chart_array

       set range {}      
       if {$chart_array(high) != 0} {
          set range "&chds=$chart_array(low),$chart_array(high)&"         
       }

       set UrlLineOut {}
       append UrlLineOut {http://chart.apis.google.com/chart?} \
                         "cht=$chart_array(type)" $range
       set lable_hdr {chxl=}
       set data_hdr {chd=t:}
       set colors_hdr {chco=}
       set legend_hdr {}
       set title_hdr {}

       foreach data $chart_array(data) {
          if {$data == {}} {
             break            
          }

          foreach data_entry $data {
             append data_hdr $data_entry ","
          }

          append data_hdr "|"
       }

       set iLabeleSetCnt 0      
       foreach lables $chart_array(lables) {
          append lable_hdr $iLabeleSetCnt ":|"
          incr iLabeleSetCnt
          foreach lable_text $lables {
             append lable_hdr $lable_text "|"
          }
       }

       set lable_hdr [string trimright $lable_hdr "|"]

       foreach color $chart_array(colors) {
          append colors_hdr $color ","
       }

       if {[info exists chart_array(title)]} {
          set title_hdr "&chtt=$chart_array(title)&chts=$chart_array(titlecolor),$chart_array(titlesize)&"
       }

       if {[info exists chart_array(legend)]} {
          set legend_hdr {&chdl=}
          foreach legend $chart_array(legend) {
             append legend_hdr $legend "|"
          }

          set legend_hdr [string trimright $legend_hdr "|"]
          append legend_hdr "&chdlp=$chart_array(legendside)&"
       }

       set data_hdr [string trimright $data_hdr ",|"]
       set colors_hdr [string trimright $colors_hdr ","]
       append UrlLineOut $lable_hdr "&chs=$chart_array(width)" "x" \
                         "$chart_array(height)&chxt=$chart_array(lableorder)" \
                         "&$data_hdr&$colors_hdr$title_hdr$legend_hdr"

       return $UrlLineOut
    }
 }

 set IWANTTOTEST 1
 if {$IWANTTOTEST == 1} {
    #
    # The autoproxy package is used to get at the http package.
    # You will need to conect to your proxy before the charts
    # can be generated.  Not needed if you are JUST generating
    # a URL for later use or if you are not behind a proxy server.
    #
    autoproxy::init
    autoproxy::configure -basic -username joeuser -password joespasswd

    #
    # See the Google chart api site for more details on types etc...
    #
    #::GoogleChart::GChart my_chart "bvg"
    ::GoogleChart::GChart my_chart "p3"
    ::GoogleChart::GChartSize my_chart 250 150
    ::GoogleChart::GChartRange my_chart 0 100
    ::GoogleChart::GChartAddDataSet my_chart {{1 2 3 4 5}}
    ::GoogleChart::GChartLables my_chart {{Jan Feb Mar Apr May} {1 2 3 4 5}}
    ::GoogleChart::GChartLableOrder my_chart {x,y}
    ::GoogleChart::GChartColors my_chart "0000ff"
    ::GoogleChart::GChartTitle my_chart {Foo Bar} "ff0000" 20
    ::GoogleChart::GChartLegend my_chart {Jan Feb Mar Apr May} l
    set fd [open "chart.png" "w"]
    fconfigure $fd -translation binary
    #puts -nonewline $fd [::GoogleChart::GChartPlotToMemory my_chart]
    ::GoogleChart::GChartPlotToChannel my_chart $fd
    close $fd
    puts [::GoogleChart::GChartPlotToURL my_chart]
 }