1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
(* $Id$ *)
open StdLabels
let check_cache ~cond ~create ~destroy = function
Some pm ->
if cond pm then pm else begin
destroy pm;
create ()
end
| None -> create ()
class timer ?packing ?show () =
let da = GMisc.drawing_area (*~width:200 ~height:200*) ?packing ?show () in
let context = da#misc#create_pango_context in
object (self)
inherit GObj.widget_full da#as_widget
val mutable talk = 25 * 60
val mutable buffer = 5 * 60
val mutable questions = 5 * 60
val mutable start = 0.
val mutable stop = 0.
val mutable timer = None
val mutable size = 0, 0
val mutable pixmap = None
method set_talk x = talk <- x * 60
method set_buffer x = buffer <- x * 60
method set_questions x = questions <- x * 60
method private to_angle t =
let total = float (talk + buffer + questions) in
float t /. total *. 360.
method draw =
let current =
if start = 0. then 0 else truncate (Unix.time () -. start) in
let {Gtk.x=x0; y=y0; width=width; height=height} =
da#misc#allocation in
let size = (min width height) * 49 / 50 in
let x = (width - size) / 2
and y = (height - size) / 2 in
let dr = check_cache pixmap
~cond:(fun pm -> pm#size = (width, height))
~destroy:(fun pm -> Gdk.Pixmap.destroy pm#pixmap)
~create:
(fun () ->
context#set_font_by_name ("sans " ^ string_of_int (size*2/13));
GDraw.pixmap ~width ~height ~window:da ())
in
pixmap <- Some dr;
dr#set_foreground `WHITE;
dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
let draw_arc ~color ~start ~stop =
dr#set_foreground (`NAME color);
dr#arc ~x ~y ~width:size ~height:size ~filled:true
~start:(450. -. self#to_angle stop)
~angle:(self#to_angle (stop - start) +. 1.) ()
in
draw_arc ~color:"blue" ~start:(-60)
~stop:(min current (talk+buffer+questions));
if current < talk then
draw_arc ~color:"green" ~start:current ~stop:talk;
if current < talk + buffer then
draw_arc ~color:"yellow"
~start:(max talk current) ~stop:(talk+buffer);
if current < talk + buffer + questions then
draw_arc ~color:"red"
~start:(max (talk+buffer) current) ~stop:(talk+buffer+questions);
dr#set_foreground `WHITE;
let size' = size * 3 / 5 in
dr#arc ~x:((width - size') / 2) ~y:((height - size') / 2)
~width:size' ~height:size' ~filled:true ();
let layout = context#create_layout in
Pango.Layout.set_text layout
(Printf.sprintf "%02d:%02d" (current/60) (current mod 60));
let (w,h) = Pango.Layout.get_pixel_size layout in
dr#put_layout ~x:((width-w)/2) ~y:((height-h)/2) ~fore:`BLACK layout;
(new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap
method start =
self#stop;
if start = 0. then start <- Unix.time ()
else start <- start +. Unix.time () -. stop;
stop <- 0.;
timer <-
Some(GMain.Timeout.add ~ms:1000 ~callback:(fun () -> self#draw; true));
self#draw
method stop =
if stop = 0. then stop <- Unix.time ();
match timer with None -> ()
| Some id ->
GMain.Timeout.remove id; timer <- None
method reset =
self#stop;
start <- 0.;
stop <- 0.;
self#draw
initializer
da#event#connect#expose ~callback:(fun _ -> self#draw; true); ()
end
let () =
GMain.init ();
let w = GWindow.window () in
w#connect#destroy ~callback:GMain.quit;
let hbox = GPack.hbox ~packing:w#add () in
let fr = GBin.frame ~border_width:3 ~shadow_type:`IN ~packing:hbox#add () in
let timer = new timer ~packing:fr#add () in
let vbox = GPack.vbox ~border_width:3 ~spacing:4 ~packing:hbox#pack () in
let make_spin ~label ~value ~callback =
GMisc.label ~text:label ~xalign:0. ~packing:vbox#pack ();
let x = GEdit.spin_button ~digits:0 ~packing:vbox#pack () in
x#adjustment#set_bounds ~lower:0. ~upper:999. ~step_incr:1. ();
x#adjustment#set_value (float value);
x#connect#value_changed ~callback:
(fun () -> callback x#value_as_int; timer#draw);
x
in
let talk = make_spin ~label:"Talk" ~value:25 ~callback:timer#set_talk
and buffer = make_spin ~label:"Buffer" ~value:5 ~callback:timer#set_buffer
and questions =
make_spin ~label:"Questions" ~value:5 ~callback:timer#set_questions in
let total =
make_spin ~label:"Total" ~value:35 ~callback:
(fun v ->
talk#set_value
(float (v - buffer#value_as_int - questions#value_as_int)))
in
let set_total () =
total#set_value (talk#value +. buffer#value +. questions#value) in
List.iter [talk;buffer;questions] ~f:
(fun (x:GEdit.spin_button) ->
ignore(x#connect#value_changed ~callback:set_total));
let start = GButton.button ~label:"Start" ~packing:vbox#pack () in
let stop = GButton.button ~label:"Stop" ~packing:vbox#pack () in
let reset = GButton.button ~label:"Reset" ~packing:vbox#pack () in
start#connect#clicked ~callback:(fun () -> timer#start);
stop#connect#clicked ~callback:(fun () -> timer#stop);
reset#connect#clicked ~callback:(fun () -> timer#reset);
w#show ();
GMain.main ()
|
