]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/gtkRange.ml
- DoubleTypeInference.does_not_occur exposed
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / gtkRange.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open Tags
6 open GtkBase
7
8 module Progress = struct
9   let cast w : progress obj = Object.try_cast w "GtkProgress"
10   external set_show_text : [>`progress] obj -> bool -> unit
11       = "ml_gtk_progress_set_show_text"
12   external set_text_alignment :
13       [>`progress] obj -> ?x:float -> ?y:float -> unit -> unit
14       = "ml_gtk_progress_set_show_text"
15   external set_format_string : [>`progress] obj -> string -> unit
16       = "ml_gtk_progress_set_format_string"
17   external set_adjustment : [>`progress] obj -> [>`adjustment] obj -> unit
18       = "ml_gtk_progress_set_adjustment"
19   external configure :
20       [>`progress] obj -> current:float -> min:float -> max:float -> unit
21       = "ml_gtk_progress_configure"
22   external set_percentage : [>`progress] obj -> float -> unit
23       = "ml_gtk_progress_set_percentage"
24   external set_value : [>`progress] obj -> float -> unit
25       = "ml_gtk_progress_set_value"
26   external get_value : [>`progress] obj -> float
27       = "ml_gtk_progress_get_value"
28   external get_percentage : [>`progress] obj -> float
29       = "ml_gtk_progress_get_current_percentage"
30   external set_activity_mode : [>`progress] obj -> bool -> unit
31       = "ml_gtk_progress_set_activity_mode"
32   external get_current_text : [>`progress] obj -> string
33       = "ml_gtk_progress_get_current_text"
34   external get_adjustment : [>`progress] obj -> adjustment obj
35       = "ml_gtk_progress_get_adjustment"
36   let set ?value ?percentage ?activity_mode
37       ?show_text ?format_string ?text_xalign ?text_yalign w =
38     may value ~f:(set_value w);
39     may percentage ~f:(set_percentage w);
40     may activity_mode ~f:(set_activity_mode w);
41     may show_text ~f:(set_show_text w);
42     may format_string ~f:(set_format_string w);
43     if text_xalign <> None || text_yalign <> None then
44       set_text_alignment w ?x:text_xalign ?y:text_yalign ()
45 end
46
47 module ProgressBar = struct
48   let cast w : progress_bar obj = Object.try_cast w "GtkProgressBar"
49   external create : unit -> progress_bar obj = "ml_gtk_progress_bar_new"
50   external create_with_adjustment : [>`adjustment] obj -> progress_bar obj
51       = "ml_gtk_progress_bar_new_with_adjustment"
52   external set_bar_style :
53       [>`progressbar] obj -> [`CONTINUOUS|`DISCRETE] -> unit
54       = "ml_gtk_progress_bar_set_bar_style"
55   external set_discrete_blocks : [>`progressbar] obj -> int -> unit
56       = "ml_gtk_progress_bar_set_discrete_blocks"
57   external set_activity_step : [>`progressbar] obj -> int -> unit
58       = "ml_gtk_progress_bar_set_activity_step"
59   external set_activity_blocks : [>`progressbar] obj -> int -> unit
60       = "ml_gtk_progress_bar_set_activity_blocks"
61   external set_orientation :
62       [>`progressbar] obj -> Tags.progress_bar_orientation -> unit
63       = "ml_gtk_progress_bar_set_orientation"
64   let set ?bar_style ?discrete_blocks ?activity_step ?activity_blocks w =
65     let may_set f opt = may opt ~f:(f w) in
66     may_set set_bar_style bar_style;
67     may_set set_discrete_blocks discrete_blocks;
68     may_set set_activity_step activity_step;
69     may_set set_activity_blocks activity_blocks
70 end
71
72 module Range = struct
73   let cast w : range obj = Object.try_cast w "GtkRange"
74   external coerce : [>`range] obj -> range obj = "%identity"
75   external get_adjustment : [>`range] obj -> adjustment obj
76       = "ml_gtk_range_get_adjustment"
77   external set_adjustment : [>`range] obj -> [>`adjustment] obj -> unit
78       = "ml_gtk_range_set_adjustment"
79   external set_update_policy : [>`range] obj -> update_type -> unit
80       = "ml_gtk_range_set_update_policy"
81   let set ?adjustment ?update_policy w =
82     may adjustment ~f:(set_adjustment w);
83     may update_policy ~f:(set_update_policy w)
84 end
85
86 module Scale = struct
87   let cast w : scale obj = Object.try_cast w "GtkScale"
88   external hscale_new : [>`adjustment] optobj -> scale obj
89       = "ml_gtk_hscale_new"
90   external vscale_new : [>`adjustment] optobj -> scale obj
91       = "ml_gtk_vscale_new"
92   let create ?adjustment (dir : orientation) =
93     let create = if dir = `HORIZONTAL then hscale_new else vscale_new  in
94     create (Gpointer.optboxed adjustment)
95   external set_digits : [>`scale] obj -> int -> unit
96       = "ml_gtk_scale_set_digits"
97   external set_draw_value : [>`scale] obj -> bool -> unit
98       = "ml_gtk_scale_set_draw_value"
99   external set_value_pos : [>`scale] obj -> position -> unit
100       = "ml_gtk_scale_set_value_pos"
101   external get_value_width : [>`scale] obj -> int
102       = "ml_gtk_scale_get_value_width"
103   external draw_value : [>`scale] obj -> unit
104       = "ml_gtk_scale_draw_value"
105   let set ?digits ?draw_value ?value_pos w =
106     may digits ~f:(set_digits w);
107     may draw_value ~f:(set_draw_value w);
108     may value_pos ~f:(set_value_pos w)
109 end
110
111 module Scrollbar = struct
112   let cast w : scrollbar obj = Object.try_cast w "GtkScrollbar"
113   external hscrollbar_new : [>`adjustment] optobj -> scrollbar obj
114       = "ml_gtk_hscrollbar_new"
115   external vscrollbar_new : [>`adjustment] optobj -> scrollbar obj
116       = "ml_gtk_vscrollbar_new"
117   let create ?adjustment (dir : orientation) =
118     let create = if dir = `HORIZONTAL then hscrollbar_new else vscrollbar_new
119     in create (Gpointer.optboxed adjustment)
120 end
121
122 module Ruler = struct
123   let cast w : ruler obj = Object.try_cast w "GtkRuler"
124   external hruler_new : unit -> ruler obj = "ml_gtk_hruler_new"
125   external vruler_new : unit -> ruler obj = "ml_gtk_vruler_new"
126   let create (dir : orientation) =
127     if dir = `HORIZONTAL then hruler_new () else vruler_new ()
128   external set_metric : [>`ruler] obj -> metric_type -> unit
129       = "ml_gtk_ruler_set_metric"
130   external set_range :
131       [>`ruler] obj ->
132       lower:float -> upper:float -> position:float -> max_size:float -> unit
133       = "ml_gtk_ruler_set_range"
134   external get_lower : [>`ruler] obj -> float = "ml_gtk_ruler_get_lower"
135   external get_upper : [>`ruler] obj -> float = "ml_gtk_ruler_get_upper"
136   external get_position : [>`ruler] obj -> float = "ml_gtk_ruler_get_position"
137   external get_max_size : [>`ruler] obj -> float = "ml_gtk_ruler_get_max_size"
138   let set_range ?lower ?upper ?position ?max_size w =
139     set_range w ~lower:(may_default get_lower w ~opt:lower)
140       ~upper:(may_default get_upper w ~opt:upper)
141       ~position:(may_default get_position w ~opt:position)
142       ~max_size:(may_default get_max_size w ~opt:max_size)
143   let set ?metric ?lower ?upper ?position ?max_size w =
144     may metric ~f:(set_metric w);
145     if lower <> None || upper <> None || position <> None || max_size <> None
146     then set_range w ?lower ?upper ?position ?max_size
147 end