Skip to content

Instantly share code, notes, and snippets.

@vrotaru
Created Nov 28, 2017
Embed
What would you like to do?
Updated example from OCaml GTK tutorial
open GObj
(* Draw text left, centre or right justified at point. (x,y) point is
* either top left, top middle or top right of text.
*)
let draw_text drawable font_description position (x, y) text : unit =
let context = Gdk.Screen.get_pango_context () in
let layout = Pango.Layout.create context in
let () = Pango.Layout.set_font_description layout font_description in
let () = Pango.Layout.set_text layout text in
let width, height = Pango.Layout.get_pixel_size layout in
let fore, back = None, None in
match position with
`Left ->
drawable#put_layout ~x ~y ?fore ?back layout
| `Centre ->
drawable#put_layout ~x:(x - width/2) ~y ?fore ?back layout
| `Right ->
drawable#put_layout ~x:(x - width) ~y ?fore ?back layout
(* Filled, black-outlined rectangle. *)
let draw_rectangle (drawable : GDraw.drawable)
fill_col (ll_x, ll_y) (tr_x, tr_y) =
let width = tr_x - ll_x in
let height = tr_y - ll_y in
drawable#set_foreground (`NAME fill_col);
drawable#rectangle ~x:ll_x ~y:ll_y ~width ~height ~filled:true ();
drawable#set_foreground `BLACK;
drawable#rectangle ~x:ll_x ~y:ll_y ~width ~height ~filled:false ()
(* This is the actual graph widget. *)
class graph font ?width ?height ?packing ?show array =
(* Constants. *)
let page_size = 10 in (* Number of bars on "page". *)
let max_y = 10 in (* Maximum on Y scale. *)
(* Number of data points. *)
let array_size = Array.length array in
(* Create the containing vbox. *)
let vbox = GPack.vbox ?width ?height ?packing ?show () in
(* Create the drawing area. *)
let da = GMisc.drawing_area ~packing:vbox#add () in
let drawable = lazy (new GDraw.drawable da#misc#window) in
(* Create the scrollbar. *)
let adjustment = GData.adjustment
~lower:0. ~upper:(float_of_int (array_size-1))
~step_incr:1. ~page_incr:(float_of_int page_size) () in
let scrollbar =
GRange.scrollbar `HORIZONTAL ~adjustment ~packing:vbox#pack () in
object (self)
inherit widget vbox#as_widget
initializer
ignore(da#event#connect#expose
~callback:(fun _ -> self#repaint (); false));
ignore(adjustment#connect#value_changed
~callback:(fun _ -> self#repaint ()))
(* The title of the graph. *)
val mutable title = "no title"
method set_title t = title <- t
method title = title
(* Repaint the widget. *)
method private repaint () =
let drawable = Lazy.force drawable in
let (width, height) = drawable#size in
drawable#set_background `WHITE;
drawable#set_foreground `WHITE;
drawable#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
drawable#set_foreground `BLACK;
(* Draw the title. *)
draw_text drawable font `Centre (width/2, 20) title;
(* Draw the axes. *)
drawable#line ~x:40 ~y:(height-40) ~x:(width-40) ~y:(height-40);
drawable#line ~x:40 ~y:(height-40) ~x:40 ~y:40;
(* Which part of the data to display? first .. first+page_size-1 *)
let first_bar = int_of_float adjustment#value in
let data = Array.sub array first_bar page_size in
let bar_width = (width - 80) / page_size in
(* Compute function mapping graph (x, y) to screen coordinates. *)
let map (x,y) =
(40 + x * bar_width, height-40 - y * (height-80) / max_y)
in
(* Draw the axes scales. *)
draw_text drawable font `Right (40, height-40) "0";
draw_text drawable font `Right (40, 40) (string_of_int max_y);
for i = 0 to page_size-1 do
let x = 40 + i * bar_width + bar_width/2 in
let y = height-35 in
let v = first_bar + i in
draw_text drawable font `Centre (x, y) (string_of_int v)
done;
(* Draw the data. *)
for i = 0 to page_size-1 do
let (ll_x,ll_y) = map (i, data.(i)) in
let (tr_x,tr_y) = map (i+1, 0) in
draw_rectangle drawable "red" (ll_x, ll_y) (tr_x, tr_y)
done;
()
end
(* Graph widget test program. *)
open GMain
open GdkKeysyms
open Graph
let locale = GtkMain.Main.init ()
let font = Printexc.print Pango.Font.from_string "Sans 12"
let main () =
let window = GWindow.window ~width:640 ~height:480
~title:"LablGtk graph widget demo" () in
let vbox = GPack.vbox ~packing:window#add () in
ignore @@ window#connect#destroy ~callback:Main.quit;
(* Menu bar *)
let menubar = GMenu.menu_bar ~packing:vbox#pack () in
let factory = new GMenu.factory menubar in
let accel_group = factory#accel_group in
let file_menu = factory#add_submenu "File" in
(* File menu *)
let factory = new GMenu.factory file_menu ~accel_group in
ignore @@ factory#add_item "Quit" ~key:_Q ~callback: Main.quit;
(* Data. *)
let array = Array.init 100 (fun _ -> Random.int 10) in
(* Create a graph in the main area. *)
let graph = new graph font ~packing:vbox#add array in
graph#set_title "Random data";
(* Display the windows and enter Gtk+ main loop *)
window#show ();
Main.main ()
let () =
main ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment