extra/google/charts/charts.factor

   1 ! Copyright (C) 2011 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors arrays assocs combinators formatting
   5 http.client images.http images.loader images.loader.private
   6 images.viewer kernel math math.functions math.order present
   7 sequences splitting urls ;
   8
   9 IN: google.charts
  10
  11 TUPLE: chart type width height title data data-scale labels
  12 background foreground margin bar-width ;
  13
  14 : <chart> ( type -- chart )
  15     chart new
  16         swap >>type
  17         320 >>width
  18         240 >>height ;
  19
  20 <PRIVATE
  21
  22 : x,y ( seq -- str ) [ present ] map "," join ;
  23
  24 : x|y ( seq -- str ) [ present ] map "|" join ;
  25
  26 : chd ( chart seq -- chart )
  27     [ x,y >>data ] [
  28         [ infimum 0 min ] [ supremum 0 max ] bi 2array
  29         x,y >>data-scale
  30     ] bi ;
  31
  32 : chl ( chart seq -- chart ) x|y >>labels ;
  33
  34 : chd/chl ( chart assoc -- chart )
  35     [ values chd ] [ keys chl ] bi ;
  36
  37 PRIVATE>
  38
  39 : <pie> ( assoc -- chart )
  40     [ "p" <chart> ] dip chd/chl ;
  41
  42 : <pie-3d> ( assoc -- chart )
  43     [ "p3" <chart> ] dip chd/chl ;
  44
  45 : <bar> ( assoc -- chart )
  46     [ "bvs" <chart> ] dip chd/chl ;
  47
  48 : <line> ( seq -- chart )
  49     [ "lc" <chart> ] dip chd ;
  50
  51 : <line-xy> ( seq -- chart )
  52     [ "lxy" <chart> ] dip [ keys ] [ values ] bi
  53     [ x,y ] bi@ "|" glue >>data ;
  54
  55 : <scatter> ( seq -- chart )
  56     [ "s" <chart> ] dip [ keys ] [ values ] bi
  57     [ x,y ] bi@ "|" glue >>data ;
  58
  59 : <sparkline> ( seq -- chart )
  60     [ "ls" <chart> ] dip chd ;
  61
  62 : <radar> ( seq -- chart )
  63     [ "rs" <chart> ] dip chd ;
  64
  65 : <qr-code> ( str -- chart )
  66     [ "qr" <chart> ] dip 1array chl ;
  67
  68 : <formula> ( str -- chart )
  69     [ "tx" <chart> ] dip 1array chl f >>width f >>height ;
  70
  71 <PRIVATE
  72
  73 : rgba>hex ( rgba -- hex )
  74     [ red>> ] [ green>> ] [ blue>> ] tri
  75     [ 255 * round >integer ] tri@ "%02X%02X%02X" sprintf ;
  76
  77 : chart>url ( chart -- url )
  78     [ URL" http://chart.googleapis.com/chart" clone ] dip {
  79         [ type>> "cht" set-query-param ]
  80         [
  81             [ width>> ] [ height>> ] bi 2dup and [
  82                 "%sx%s" sprintf "chs" set-query-param
  83             ] [ 2drop ] if
  84         ]
  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 ]
  89         [
  90             background>> [
  91                 rgba>hex "bg,s," prepend "chf" set-query-param
  92             ] when*
  93         ]
  94         [
  95             foreground>> [
  96                 rgba>hex "chco" set-query-param
  97             ] when*
  98         ]
  99         [ margin>> [ x,y "chma" set-query-param ] when* ]
 100         [ bar-width>> [ "chbh" set-query-param ] when* ]
 101     } cleave ;
 102
 103 PRIVATE>
 104
 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.
 109     ] if ;