1 ! Copyright (C) 2011 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors arrays assocs combinators formatting
5 http.client images.http images.loader images.loader.private
6 images.viewer kernel math math.order present sequences splitting
11 TUPLE: chart type width height title data data-scale labels
12 background foreground margin bar-width ;
14 : <chart> ( type -- chart )
22 : x,y ( seq -- str ) [ present ] map "," join ;
24 : x|y ( seq -- str ) [ present ] map "|" join ;
26 : chd ( chart seq -- chart )
28 [ infimum 0 min ] [ supremum 0 max ] bi 2array
32 : chl ( chart seq -- chart ) x|y >>labels ;
34 : chd/chl ( chart assoc -- chart )
35 [ values chd ] [ keys chl ] bi ;
39 : <pie> ( assoc -- chart )
40 [ "p" <chart> ] dip chd/chl ;
42 : <pie-3d> ( assoc -- chart )
43 [ "p3" <chart> ] dip chd/chl ;
45 : <bar> ( assoc -- chart )
46 [ "bvs" <chart> ] dip chd/chl ;
48 : <line> ( seq -- chart )
49 [ "lc" <chart> ] dip chd ;
51 : <line-xy> ( seq -- chart )
52 [ "lxy" <chart> ] dip [ keys ] [ values ] bi
53 [ x,y ] bi@ "|" glue >>data ;
55 : <scatter> ( seq -- chart )
56 [ "s" <chart> ] dip [ keys ] [ values ] bi
57 [ x,y ] bi@ "|" glue >>data ;
59 : <sparkline> ( seq -- chart )
60 [ "ls" <chart> ] dip chd ;
62 : <radar> ( seq -- chart )
63 [ "rs" <chart> ] dip chd ;
65 : <qr-code> ( str -- chart )
66 [ "qr" <chart> ] dip 1array chl ;
68 : <formula> ( str -- chart )
69 [ "tx" <chart> ] dip 1array chl f >>width f >>height ;
73 : rgba>hex ( rgba -- hex )
74 [ red>> ] [ green>> ] [ blue>> ] tri
75 [ 255 * >integer ] tri@ "%02X%02X%02X" sprintf ;
77 : chart>url ( chart -- url )
78 [ URL" http://chart.googleapis.com/chart" clone ] dip {
79 [ type>> "cht" set-query-param ]
81 [ width>> ] [ height>> ] bi 2dup and [
82 "%sx%s" sprintf "chs" set-query-param
85 [ title>> "chtt" set-query-param ]
86 [ data>> "t:" prepend "chd" set-query-param ]
87 [ data-scale>> [ "chds" set-query-param ] when* ]
88 [ labels>> "chl" set-query-param ]
91 rgba>hex "bg,s," prepend "chf" set-query-param
96 rgba>hex "chco" set-query-param
99 [ margin>> [ x,y "chma" set-query-param ] when* ]
100 [ bar-width>> [ "chbh" set-query-param ] when* ]
105 : chart. ( chart -- )
106 chart>url present dup length 2000 < [ http-image. ] [
107 "?" split1 swap http-post nip
108 "png" (image-class) load-image* image.