← Back to branch summary

~ubuntu-branches/ubuntu/wily/marionnet/wily

« back to all changes in this revision

Viewing changes to chip/wGButton.ml

  • Committer: Package Import Robot
  • Author(s): Lucas Nussbaum
  • Date: 2013-03-29 15:57:12 UTC
  • Revision ID: package-import@ubuntu.com-20130329155712-o0b9b96w8av68ktq
Tags: upstream-0.90.6+bzr407
Import upstream version 0.90.6+bzr407

Show diffs side-by-side

added added

removed removed

Lines of Context:
chip/wGButton.ml
 
1
 
 
2
class button_wire_tuple ~owner ~system =
 
3
 let clicked  = Chip.wcounter ~name:(owner^"#clicked") ~system () in
 
4
 let enter    = Chip.wcounter ~name:(owner^"#enter")   ~system () in
 
5
 let leave    = Chip.wcounter ~name:(owner^"#leave")   ~system () in
 
6
 let pressed  = Chip.wcounter ~name:(owner^"#pressed") ~system () in
 
7
 let released = Chip.wcounter ~name:(owner^"#clicked") ~system () in
 
8
object
 
9
 method clicked  = clicked
 
10
 method enter    = enter
 
11
 method leave    = leave
 
12
 method pressed  = pressed
 
13
 method released = released
 
14
 
 
15
 method destroy () =
 
16
  clicked#destroy ();
 
17
  enter#destroy ();
 
18
  leave#destroy ();
 
19
  pressed#destroy ();
 
20
  released#destroy ()
 
21
end
 
22
 
 
23
type button_signal = Clicked | Enter | Leave | Pressed | Released
 
24
 
 
25
class button
 
26
 ?name
 
27
 ?parent
 
28
 (system:Chip.system)
 
29
 obj =
 
30
 let name = match name with None -> Chip.fresh_wire_name "button" | Some x -> x in
 
31
 let wire = new button_wire_tuple ~owner:name ~system in
 
32
object (self)
 
33
 inherit GButton.button (obj : Gtk.button Gtk.obj) as self_as_gbutton
 
34
 method wire = wire
 
35
 
 
36
 inherit [ button_signal, (int * int * int * int * int)] Chip.wire ~name ?parent system as self_as_wire
 
37
 
 
38
 method destroy () =
 
39
  wire#destroy ();
 
40
  self_as_wire#destroy ();
 
41
  self_as_gbutton#destroy ()
 
42
 
 
43
 method reset () = assert false (* unused! *)
 
44
 
 
45
 method set_alone = function
 
46
 | Clicked  -> wire#clicked#set ()
 
47
 | Enter    -> wire#enter#set ()
 
48
 | Leave    -> wire#leave#set ()
 
49
 | Pressed  -> wire#pressed#set ()
 
50
 | Released -> wire#released#set ()
 
51
 
 
52
 method get_alone =
 
53
  (wire#clicked#get,
 
54
   wire#enter#get,
 
55
   wire#leave#get,
 
56
   wire#pressed#get,
 
57
   wire#released#get)
 
58
 
 
59
  method to_dot =
 
60
   Printf.sprintf "%d [shape=record, label=\"%s (%d) | {|{%s}|}\"];"
 
61
     self#id
 
62
     self#name
 
63
     self#id
 
64
     (Chip.dot_record_of_port_names
 
65
         [wire#clicked#name;
 
66
          wire#enter#name;
 
67
          wire#leave#name;
 
68
          wire#pressed#name;
 
69
          wire#released#name ])
 
70
 
 
71
initializer
 
72
 ignore (self#connect#clicked  ~callback:(wire#clicked#set));
 
73
 ignore (self#connect#enter    ~callback:(wire#enter#set));
 
74
 ignore (self#connect#leave    ~callback:(wire#leave#set));
 
75
 ignore (self#connect#pressed  ~callback:(wire#pressed#set));
 
76
 ignore (self#connect#released ~callback:(wire#released#set));
 
77
 let p = (Some self#as_common) in
 
78
  wire#clicked#set_parent  p;
 
79
  wire#enter#set_parent    p;
 
80
  wire#leave#set_parent    p;
 
81
  wire#pressed#set_parent  p;
 
82
  wire#released#set_parent p;
 
83
  ()
 
84
end
 
85
 
 
86
let pack_return create p ?packing ?show () =
 
87
 GObj.pack_return (create p) ~packing ~show
 
88
 
 
89
let button ?name ?parent (system:Chip.system) ?label =
 
90
  GtkButton.Button.make_params [] ?label ~cont:(
 
91
  pack_return (fun p -> new button ?name ?parent system (GtkButton.Button.create p)))