Commits

camlspotter committed e96c989

gVisualization => gChart

  • Participants
  • Parent commits 60013e6

Comments (0)

Files changed (12)

    include OMyMakefile
    export
 
+MyOCamlJSProgram(name, files) =
+    NATIVE_ENABLED = false
+
+    OCAML_PREINSTALLED_PACKS[] +=
+    OCAMLPACKS[] += lwt js_of_ocaml
+
+    public.OCAML_BYTE_LINK_FLAGS = -linkpkg # removes -custom
+
+    NO_INSTALL=true
+    MyOCamlProgram($(name), $(files))
+
+    $(name).js: $(name).run
+        js_of_ocaml $<
+
+    .DEFAULT: $(name).js
+
+    export # Need to export the rules for lwt and others
+
 Subdirs()
 
 setup.ml: _oasis
 name = "xJs"
 version = "0.0.1"
 description = "Extra things for js_of_ocaml"
-requires = "js_of_ocaml"
+requires = "js_of_ocaml, spotlib_js"
 archive(byte) = "xJs.cmo"
 archive(native) = "xJs.cmx"
 OCAMLPACKS[] =
     lwt
     js_of_ocaml
+    spotlib_js
 
 OCAMLDEPFLAGS= -syntax camlp4o -package lwt,js_of_ocaml.syntax
 OCAMLPPFLAGS= -syntax camlp4o -package lwt,js_of_ocaml.syntax
     std
     base
 
-    monad
-    xlist
-    option
-
-    URL
     xUnsafe
     http
-    gVisualization
+    gChart
     gMaps
     google
 
-open Base
+open Spotlib_js.Spot
 
 let encode s =
   let len = String.length s in
 let alert s = ignore (U.fun_call (U.variable "alert") [| U.inject (string s) |])
 let alertf fmt  = Printf.ksprintf alert fmt
 
-external (&) : ('a -> 'b) -> 'a -> 'b = "%apply"
-external (|>) : 'a -> ('a -> 'b) -> 'b =  "%revapply"
-let ( *< ) f g x = f (g x)
-let ( *> ) f g x = g (f x)
-
 let load_script url =
   let document = Dom_html.window##document in
   let script = document##createElement (!$ "script") in
 
 let set_onload f = 
   Dom_html.window##onload <- Dom.handler (fun _ -> f (); _false)
+
+let getElementById id =
+  Opt.to_option (Dom_html.window##document##getElementById (!$ id))
+
+open Spotlib_js.Spot
+
+module OptionFields = struct
+  module Make(A : sig
+    type key
+    type value
+  end) = struct
+    open A
+    type kvs = (key * value) list
+    type options = kvs -> kvs
+    let empty = id
+    let (++) = ( ** )
+    let make k f v0 kvs = (k, f v0) :: kvs
+    let run opts = opts []
+  end
+end
+
+module StringOptionFields = 
+  OptionFields.Make(struct type key = string type value = string end)
+
 val alertf : ('a, unit, string, unit) format4 -> 'a
 (** JS alert function, printf style *)
 
-external (&) : ('a -> 'b) -> 'a -> 'b = "%apply"
-external (|>) : 'a -> ('a -> 'b) -> 'b =  "%revapply"
-val ( *> ) : ('c -> 'a) -> ('a -> 'b) -> 'c -> 'b
-val ( *< ) : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
+val getElementById : string -> Dom_html.element Js.t option
 
 val load_script : string -> unit
 (** Append <script type="text/javascript" src="URL"/>
 *)
 
 val set_onload : (unit -> unit) -> unit
+
+module OptionFields : sig
+  module Make(A : sig
+    type key
+    type value
+  end) : sig
+    open A
+    type kvs = (key * value) list
+    type options
+    val empty : options
+    val (++) : options -> options -> options
+    val make : key -> ('a -> value) -> 'a -> options
+    val run : options -> kvs
+  end
+end
+
+module StringOptionFields : sig
+  type kvs = (string * string) list
+  type options
+  val empty : options
+  val (++) : options -> options -> options
+  val make : string -> ('a -> string) -> 'a -> options
+  val run : options -> kvs
+end
+(** google chart *)
+
+open Spotlib_js.Spot
+open Js
+open Std
+
+module DataTable = struct
+  class type t = object
+    method addColumn_withID : string_t (* type. Either "string", "number", "boolean", "date", "datetime" or "timeofday" *)
+                              -> string_t (* label *)
+                              -> string_t (* id *)
+                              -> unit meth
+
+    method addColumn : string_t (* type. Either "string", "number", "boolean", "date", "datetime" or "timeofday" *)
+                       -> string_t (* label *)
+                       -> unit meth
+
+    method addRows : 'a Js.t array_t array_t -> unit meth
+  end
+end
+
+module Chart = struct
+  class type t = object
+    method draw : DataTable.t Js.t -> 'options Js.t(* ? *) -> unit meth
+  end
+end
+
+(* Does not work: google.visualization is undefined
+   Use readonly_props
+      let cls = Unsafe.variable "google.visualization.DataTable"
+      let create () : dataTable Js.t = Unsafe.new_obj cls [| |]
+*)
+
+module Visualization = struct
+
+  class type t = object
+    (* methods and props begin with a Capital letter is prefixed with '_' in OCaml *)
+
+    (*
+      method _DataTable : dataTable Js.t readonly_prop 
+      (* Simple, but no jsnew interface.
+         for new, Unsafe.new_obj google##visualization##_DataTable_ [| |]
+      *)
+    *)
+
+    method _DataTable : DataTable.t Js.t constr readonly_prop 
+    method _PieChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
+    method _BarChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
+    method _ScatterChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
+  end
+end
+
+include Visualization
+
+let load () = 
+  Google.load !$"visualization" !$"1.0" 
+  & Unsafe.variable "{'packages':['corechart']}"
+
+(** [load ()] must be done before [get ()] *)
+let get () : t Js.t = Unsafe.variable "google.visualization"
+
+
+open Spotlib_js.Spot
 open Js
 
 open Std
   end
 end 
 
-module MapOptions : sig
+module MapOptions = struct
   type t
-  type elt
-  val center : LatLng.t Js.t -> elt
-  val zoom : int -> elt
-  val mapTypeId : MapTypeId.t -> elt
-  val ( ** ) : elt -> elt -> elt
-  val options : elt -> t
-end = struct
-  type t
-  type elt = (string * Unsafe.any) list -> (string * Unsafe.any) list
-  let ( ** ) = ( *< )
-  let center    (v : LatLng.t Js.t) st = ("center"   , Unsafe.inject v) :: st
-  let zoom      (v : int)           st = ("zoom"     , Unsafe.inject v) :: st
-  let mapTypeId (v : MapTypeId.t)   st = ("mapTypeId", Unsafe.inject & MapTypeId.to_js v) :: st 
-
-  let options f : t = f [] |> Array.of_list |> Unsafe.obj
+  include OptionFields.Make(struct type key = string type value = Unsafe.any end)
+  let center (v : LatLng.t Js.t)  = make "center" Unsafe.inject v
+  let zoom   (v : int)            = make "zoom"   Unsafe.inject v
+  let mapTypeId (v : MapTypeId.t) = make "mapTypeId" (Unsafe.inject ** MapTypeId.to_js) v
+  let run opts : t = run opts |> Array.of_list |> Unsafe.obj
 end
 
 module Map = struct
   end
 end
 
-module MarkerOptions : sig
+module MarkerOptions = struct
   type t
-  type elt
-  val position : LatLng.t Js.t -> elt
-  val map : Map.t Js.t -> elt
-  val title : js_string Js.t -> elt
-  val ( ** ) : elt -> elt -> elt
-  val options : elt -> t
-end = struct
-  type t
-  type elt = (string * Unsafe.any) list -> (string * Unsafe.any) list
-  let ( ** ) = ( *< )
-  let position (v : LatLng.t Js.t)  st = ("position" , Unsafe.inject v)   :: st
-  let map      (v : Map.t Js.t)     st = ("map"      , Unsafe.inject v)   :: st
-  let title    (v : js_string Js.t) st = ("title"    , Unsafe.inject & v) :: st 
-
-  let options f : t = f [] |> Array.of_list |> Unsafe.obj
+  include OptionFields.Make(struct type key = string type value = Unsafe.any end)
+  let position (v : LatLng.t Js.t)  = make "position" Unsafe.inject v
+  let map      (v : Map.t Js.t)     = make "map"      Unsafe.inject v
+  let title    (v : js_string Js.t) = make "title"    Unsafe.inject v
+  let run opts : t = run opts |> Array.of_list |> Unsafe.obj
 end
-
 module Marker = struct
   class type t = object
   end
 let load ?sensor ?callback key = 
   let q = 
     URL.make_query 
-    & List.filter_map (fun (k,v) ->
-        Option.map ~f:(fun v -> (k, v)) v)
-        [ "key", Some key;
-          "sensor", Option.map (function true -> "true" | false -> "false") sensor;
-          "callback", Option.map id]
+    & List.filter_map (fun (k,v) -> Option.map ~f:(fun v -> (k, v)) v)
+      [ "key", Some key;
+        "sensor", Option.map ~f:(function true -> "true" | false -> "false") sensor;
+        "callback", Option.map ~f:id callback]
   in
-  Base.load_script (Printf.sprintf "http://maps.googleapis.com/maps/api/js?%s" q);
+  Base.load_script (Printf.sprintf "http://maps.googleapis.com/maps/api/js?%s" q)
 
+let get () : t Js.t = Unsafe.variable "google.maps"
+
+let latlng (maps : t Js.t) lat lng = jsnew (maps##_LatLng) (lat, lng)
+
+let map (maps : t Js.t) div mapOptions = jsnew (maps##_Map) (div, mapOptions)
+
+let marker (maps : t Js.t) markerOptions = jsnew (maps##_Marker) (markerOptions)

lib/gVisualization.ml

-open Js
-open Std
-
-module DataTable = struct
-  class type t = object
-    method addColumn_withID : string_t (* type. Either "string", "number", "boolean", "date", "datetime" or "timeofday" *)
-                              -> string_t (* label *)
-                              -> string_t (* id *)
-                              -> unit meth
-
-    method addColumn : string_t (* type. Either "string", "number", "boolean", "date", "datetime" or "timeofday" *)
-                       -> string_t (* label *)
-                       -> unit meth
-
-    method addRows : 'a Js.t array_t array_t -> unit meth
-  end
-end
-
-module Chart = struct
-  class type t = object
-    method draw : DataTable.t Js.t -> 'options Js.t(* ? *) -> unit meth
-  end
-end
-
-(* Does not work: google.visualization is undefined
-   Use readonly_props
-      let cls = Unsafe.variable "google.visualization.DataTable"
-      let create () : dataTable Js.t = Unsafe.new_obj cls [| |]
-*)
-
-module Visualization = struct
-
-  class type t = object
-    (* methods and props begin with a Capital letter is prefixed with '_' in OCaml *)
-
-    (*
-      method _DataTable : dataTable Js.t readonly_prop 
-      (* Simple, but no jsnew interface.
-         for new, Unsafe.new_obj google##visualization##_DataTable_ [| |]
-      *)
-    *)
-
-    method _DataTable : DataTable.t Js.t constr readonly_prop 
-    method _PieChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
-    method _BarChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
-    method _ScatterChart : (Dom_html.element Js.t -> Chart.t Js.t) constr readonly_prop
-  end
-end
-
-include Visualization
   method load : string_t (* name *) -> string_t (* version *) -> 'option Js.t (* option *) -> unit meth
   method setOnLoadCallback : (unit -> unit) (* ? *) -> unit meth
 
-  method visualization : GVisualization.t Js.t readonly_prop
-  method maps          : GMaps.t          Js.t readonly_prop
 end
 
 let get_google : unit -> t Js.t = fun () -> Unsafe.variable "google"
 (** The variable "google" may not exist when API loading is delayed *)
 
+let load : string_t -> string_t -> 'option Js.t -> unit = 
+  fun name version option -> (get_google()) ## load (name, version, option)
 
-
+let setOnLoadCallback f = (get_google()) ## setOnLoadCallback (f)
 class type t = object
   method load : string_t (* name *) -> string_t (* version *) -> 'option Js.t (* option *) -> unit meth
   method setOnLoadCallback : (unit -> unit) (* ? *) -> unit meth
-
-  method visualization : GVisualization.t Js.t readonly_prop
-  method maps          : GMaps.t          Js.t readonly_prop
 end
 
 val get_google : unit -> t Js.t
-
-
+val load : string_t -> string_t -> 'option Js.t -> unit
+val setOnLoadCallback : (unit -> unit) -> unit
   include Unsafe
   include XUnsafe
 end
-
-module List = struct
-  include List
-  include Xlist
-end