Source file gtkplot.ml
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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
type signal_type =
| Points of bool
| PiecewiseContinuous of bool
| LinearInterpolation
let points x = Points x
let piecewise = PiecewiseContinuous false
let square = PiecewiseContinuous true
let linear = LinearInterpolation
let len_history = ref 5000
let scope_title_height = 30
let scope_title_height = 30
let y_axis_width = 80
let x_axis_height = 20
let scope_padding_right = 30
let scope_offset_top = 5
let scope_offset_bottom = 5
let min_scope_height = 120
let max_scope_height = 1000
let min_scope_width = 200 + y_axis_width + scope_padding_right
let max_scope_width = 2500
let gridline_color = `NAME "#f2f2f2"
let sig_colors =
[|`NAME "red";
`NAME "blue";
`NAME "green";
`NAME "orange";
`NAME "brown";
`NAME "magenta";
`NAME "cyan";
|]
let num_sig_colors = Array.length sig_colors
let round x = int_of_float (floor (x +. 0.5))
let nearest_powten x = 10.0 ** (floor (log10 x +. 0.5));;
let float_to_string x =
let t = int_of_float (log10 x) in
if -4 <= t && t <= 3
then Printf.sprintf "%f" x
else Printf.sprintf "%e" x
let fill_drawable (d : GDraw.drawable) color =
let (mx, my) = d#size in
d#set_foreground color;
d#rectangle ~x:0 ~y:0 ~filled:true ~width:mx ~height:my ()
let icon_zoom_out_hor =
let icon_zoom_out_hor_data = [|
"16 16 7 1";
" c None";
". c #000000";
"+ c #505050";
"@ c #8F8F8F";
"# c #FFFFFF";
"$ c #3E3E3E";
"% c #6F6F6F";
" ";
" ";
" ";
" ";
" .......... ";
" .+@@@@@@+. ";
" . .@######@. . ";
"....$%####%$....";
"....$%####%$....";
" . .@######@. . ";
" .+@@@@@@+. ";
" .......... ";
" ";
" ";
" ";
" ";
|]
in
GdkPixbuf.from_xpm_data icon_zoom_out_hor_data
let icon_zoom_out_ver =
let icon_zoom_out_ver_data = [|
"16 16 6 1";
" c None";
". c #000000";
"+ c #505050";
"@ c #8F8F8F";
"# c #3E3E3E";
"$ c #FFFFFF";
" .. ";
" .... ";
" .. ";
" .. ";
" .......... ";
" .+@@##@@+. ";
" .@$$$$$$@. ";
" .@$$$$$$@. ";
" .@$$$$$$@. ";
" .@$$$$$$@. ";
" .+@@##@@+. ";
" .......... ";
" .. ";
" .. ";
" .... ";
" .. ";
|]
in
GdkPixbuf.from_xpm_data icon_zoom_out_ver_data
let icon_zoom_out =
let icon_zoom_out_data = [|
"16 16 7 1";
" c None";
". c #000000";
"+ c #505050";
"@ c #8F8F8F";
"# c #3E3E3E";
"$ c #FFFFFF";
"% c #6F6F6F";
" .. ";
" .... ";
" .. ";
" .. ";
" .......... ";
" .+@@##@@+. ";
" . .@$$$$$$@. . ";
"....#%$$$$%#....";
"....#%$$$$%#....";
" . .@$$$$$$@. . ";
" .+@@##@@+. ";
" .......... ";
" .. ";
" .. ";
" .... ";
" .. ";
|]
in
GdkPixbuf.from_xpm_data icon_zoom_out_data
let icon_zoom_in =
let icon_zoom_in_data = [|
"16 16 5 1";
" c None";
". c #000000";
"+ c #505050";
"@ c #8F8F8F";
"# c #FFFFFF";
" ";
" ";
" ";
" ";
" .......... ";
" .+@@@@@@+. ";
" .@######@. ";
" .@######@. ";
" .@######@. ";
" .@######@. ";
" .+@@@@@@+. ";
" .......... ";
" ";
" ";
" ";
" ";
|]
in
GdkPixbuf.from_xpm_data icon_zoom_in_data
class signal (n : string) (t : signal_type) =
object
val name = n
val ty = t
val data = Array.make !len_history 0.0
val mutable newval = 0.0
method name = name
method sample v = newval <- v
method tick i = data.(i) <- newval
method data i = data.(i)
method draw_sample (d : GDraw.drawable) pyv last (xt, yi) =
let y = pyv data.(yi) in
match ty with
| Points with_step -> begin
d#arc ~x:(xt - 2) ~y:(y - 2)
~width:4 ~height:4
~filled:true ();
if with_step then d#lines [(xt, max_int / 10); (xt, y)]
end
| PiecewiseContinuous false -> begin
d#arc ~x:(xt - 2) ~y:(y - 2)
~width:4 ~height:4
~filled:true ();
match last with
| None -> ()
| Some (lxt, lyi) ->
let ly = pyv data.(lyi) in
d#line lxt ly xt ly
end
| PiecewiseContinuous true -> begin
match last with
| None ->
d#arc ~x:(xt - 1) ~y:(y - 1)
~width:2 ~height:2
~filled:true ();
| Some (lxt, lyi) ->
let ly = pyv data.(lyi) in
d#line lxt ly xt ly;
d#line xt ly xt y
end
| LinearInterpolation -> begin
match last with
| None ->
d#arc ~x:(xt - 1) ~y:(y - 1)
~width:2 ~height:2
~filled:true ();
| Some (lxt, lyi) ->
let ly = pyv data.(lyi) in
d#line lxt ly xt y
end
end
class image_selection_box
?height ?width ?xalign ?yalign ?border_width ?packing ?callback
?(fill_horizontally = false) ?(fill_vertically = false)
?(x_offset = 0) ?(y_offset = 0)
()
=
let ebox = GBin.event_box ?border_width:border_width ?packing:packing () in
let img = GMisc.image
?height:height
?width:width
~packing:ebox#add
?xalign:xalign
?yalign:yalign
() in
let make_rect (x, y, x', y') =
let x, y = min x x', min y y'
and w, h = abs (x - x'), abs (y - y')
in (x, y, w, h) in
let no_last_coords = (0, 0, 0, 0) in
object (self)
val evbox = ebox
val image = img
val zoom_in_callback = callback
val mutable xi = 0
val mutable yi = 0
val mutable last_coords = no_last_coords
val mutable width = 0
val mutable height = 0
val fill_hor = fill_horizontally
val fill_ver = fill_vertically
method image = image
method redraw () =
if (last_coords <> no_last_coords) then self#draw last_coords
method private draw coords =
let (x, y, w, h) = make_rect coords in
let d = (image#pixmap :> GDraw.drawable) in
Gdk.GC.set_function d#gc `INVERT;
d#rectangle ~x:x ~y:y ~width:w ~height:h ~filled:true ();
last_coords <- coords
method private undraw =
if last_coords <> no_last_coords then
(self#draw last_coords; last_coords <- no_last_coords)
method private button_down ev =
if GdkEvent.Button.button ev <> 1 then false
else begin
let w, h = Gdk.Drawable.get_size image#misc#window in
width <- w;
height <- h;
xi <- if fill_horizontally then 0
else int_of_float (GdkEvent.Button.x ev);
yi <- if fill_vertically then 0
else int_of_float (GdkEvent.Button.y ev);
true
end
method private button_up ev =
if GdkEvent.Button.button ev <> 1
|| last_coords = no_last_coords then false
else begin
let (x, y, x', y') = last_coords in
self#undraw;
image#misc#draw None;
match zoom_in_callback with
| Some f ->
let hor_range =
if fill_hor then None
else Some (max 0 ((min x x') - x_offset),
max 0 ((max x x') - x_offset))
and ver_range =
if fill_ver then None
else Some (max 0 ((min y y') - y_offset),
max 0 ((max y y') - y_offset))
in f hor_range ver_range; true
| None -> true
end
method private hold_drag ev =
let x = if fill_horizontally then width
else int_of_float (GdkEvent.Motion.x ev)
and y = if fill_vertically then height
else int_of_float (GdkEvent.Motion.y ev)
in
let new_coords = (xi, yi, x, y) in
self#undraw;
self#draw new_coords;
image#misc#draw None;
true
initializer
ignore (evbox#event#connect#button_release ~callback:self#button_up);
ignore (evbox#event#connect#button_press ~callback:self#button_down);
ignore (evbox#event#connect#motion_notify ~callback:self#hold_drag);
evbox#event#add [`BUTTON1_MOTION]
end
class scope (yl : float) (yu : float) (sigs : signal list) =
object (self)
val mutable min_y = yl
val mutable max_y = yu
val mutable title = ""
method title = title
method set_yrange (yl, yu) = (min_y <- yl; max_y <- yu)
val signals =
let add_color (n, l) s =
((n + 1) mod num_sig_colors, (sig_colors.(n), s)::l)
in
snd (List.fold_left add_color (0, []) sigs)
val mutable scope_image = GMisc.image ()
val mutable yaxis_image = GMisc.image ()
val mutable redraw_zoomin = (fun () -> ())
val mutable zoom_in_hor = (fun _ -> ())
val mutable bgcolor = `WHITE
method set_bgcolor c = bgcolor <- c
method title_from_signals =
let add_markup (color, signal) =
let cname =
match color with
| `NAME n -> n
| `BLACK -> "black"
| `WHITE -> "white"
| `RGB (r, g, b) -> Printf.sprintf "#%02x%02x%02x" r g b
| `COLOR _ -> "black"
in
Printf.sprintf "<span foreground=\"%s\">%s</span>" cname signal#name
in
title <- String.concat ", " (List.map add_markup (List.rev signals))
method bind_to_window win_pack =
let scopebox = GPack.hbox ~packing:win_pack () in
let yaxis = new image_selection_box
~callback:self#zoom_in
~border_width:0
~xalign:0.0
~yalign:1.0
~packing:(scopebox#pack ~expand:false)
~fill_horizontally:true
()
in
let selbox = new image_selection_box
~callback:self#zoom_in
~border_width:0
~xalign:0.0
~yalign:1.0
~packing:(scopebox#pack ~expand:false)
()
in
yaxis_image <- yaxis#image;
scope_image <- selbox#image;
redraw_zoomin <- (fun () -> (selbox#redraw (); yaxis#redraw ()));
self#zoom_in
method set_zoom_in_hor f = zoom_in_hor <- f
method adjust w h =
let nh = h
and nw = w - y_axis_width - scope_padding_right + 1
in
let reallocate =
try
let ow, oh = scope_image#pixmap#size in
ow <> nw || oh <> nh
with Gpointer.Null -> true
in
if reallocate then begin
let scope_pixmap = GDraw.pixmap ~width:nw ~height:nh () in
scope_image#set_pixmap scope_pixmap;
let yaxis_pixmap = GDraw.pixmap ~width:y_axis_width ~height:nh () in
yaxis_image#set_pixmap yaxis_pixmap
end;
reallocate
method clear =
let pixmap = (scope_image#pixmap :> GDraw.drawable) in
fill_drawable pixmap `WHITE;
method draw_x_gridline x =
let pixmap = (scope_image#pixmap :> GDraw.drawable) in
let w, h = pixmap#size in
pixmap#set_foreground gridline_color;
pixmap#line x 0 x h
method draw_y_gridline y =
let pixmap = (scope_image#pixmap :> GDraw.drawable) in
let w, h = pixmap#size in
pixmap#set_foreground gridline_color;
pixmap#line 0 y w y
method private get_pixel_of_value h =
let axis_height = h - scope_offset_top - scope_offset_bottom in
let pyv =
let pixels_per_v = float axis_height /. (max_y -. min_y) in
fun v ->
min 32767 (max (-32767) (
(h - scope_offset_bottom
- int_of_float (pixels_per_v *. (v -. min_y)))))
in
(axis_height, pyv)
method private get_value_of_pixel h =
let axis_height = h - scope_offset_top - scope_offset_bottom in
let v_per_pixel = (max_y -. min_y) /. float axis_height
and my = min_y in
fun p -> (float (h - p) *. v_per_pixel) +. my
method private zoom_in hor_range ver_range =
let pixmap = (yaxis_image#pixmap :> GDraw.drawable) in
let _, h = pixmap#size in
let ptov = self#get_value_of_pixel h in
(match ver_range with
| None -> ()
| Some (yu, yl) -> (min_y <- max min_y (ptov yl);
max_y <- min max_y (ptov yu)));
zoom_in_hor hor_range
method draw_y_axis context =
let pixmap = (yaxis_image#pixmap :> GDraw.drawable) in
let w, h = pixmap#size in
let axis_height, pyv = self#get_pixel_of_value h in
let tick_l, tick_r = w - 7, w - 1 in
fill_drawable pixmap bgcolor;
pixmap#set_foreground `BLACK;
pixmap#line tick_r 0 tick_r h;
let dninc = (max 1 (axis_height / 100)) * 8 in
let vinc = nearest_powten ((max_y -. min_y) /. float dninc) in
let ninc = int_of_float ((max_y -. min_y) /. vinc) in
let layout = Pango.Layout.create context in
Pango.Layout.set_text layout "0E";
let _, lheight = Pango.Layout.get_pixel_size layout in
let npossible = max 1 (axis_height / (lheight + 6) + 1) in
let skipinc = if npossible >= ninc then 1 else ninc / npossible in
for i = 0 to ninc do
if i mod skipinc = 0 then begin
let v = min_y +. (float i *. vinc) in
let y = pyv v in
pixmap#lines [(tick_l,y); (tick_r,y)];
self#draw_y_gridline y;
Pango.Layout.set_text layout (float_to_string v);
let lwidth, _ = Pango.Layout.get_pixel_size layout in
pixmap#put_layout
~x:(tick_r - lwidth - 8)
~y:(y - lheight/2 + 1)
~fore:`BLACK layout
end
done
method draw (indices : unit -> (int * int) option) =
let pixmap = (scope_image#pixmap :> GDraw.drawable) in
let _, h = pixmap#size in
let _, pyv = self#get_pixel_of_value h in
let prev = ref None in
let rec iter () =
match indices () with
| None -> ()
| Some curr -> begin
let draw_sig (c, s) =
pixmap#set_foreground c;
s#draw_sample pixmap pyv !prev curr
in
List.iter draw_sig signals;
prev := Some curr;
iter ()
end
in
iter ();
redraw_zoomin ()
method private get_min_max (indices : unit -> (int * int) option) =
let rec iter (lv, uv) =
match indices () with
| None -> (lv, uv)
| Some (_, i) ->
let nlv = List.fold_left (fun l s -> min l (s#data i)) lv sigs
and nuv = List.fold_left (fun h s -> max h (s#data i)) uv sigs
in
iter (nlv, nuv)
in
iter (max_float, min_float)
method zoom_out_ver indices =
let lv, uv = self#get_min_max indices in
if (lv < min_y) || (uv > max_y)
then (min_y <- lv; max_y <- uv; true)
else let delta = (max_y -. min_y) *. 0.2 in
(min_y <- min_y -. delta;
max_y <- max_y +. delta;
false)
method zoom_fit indices =
let lv, uv = self#get_min_max indices in
min_y <- lv;
max_y <- uv
method tick i =
List.iter (fun (_, s) -> s#tick i) signals
initializer
self#title_from_signals
end
class window title initial_max_t (scs : scope list) =
let screen = Gdk.Screen.default () in
let w = truncate (float (Gdk.Screen.width ~screen:screen ()) *. 0.8) in
let h = truncate (float (Gdk.Screen.height ~screen:screen ()) *. 0.8) in
let w = GWindow.window ~title:title ~height:h ~width:w () in
let wbox = GPack.vbox ~packing:w#add () in
let xaxis_context = w#misc#create_pango_context in
let fontdesc = Pango.Font.from_string "Sans 7" in
let _ = xaxis_context#set_font_description fontdesc in
let default_cursor = Gdk.Cursor.create `CROSSHAIR in
let make_scope scope =
ignore (GMisc.label ~markup:scope#title ~height:scope_title_height
~packing:(wbox#pack) ());
let sbox = GPack.hbox ~packing:wbox#pack () in
let zoom_in_fn = scope#bind_to_window (fun w -> sbox#pack w) in
let butbox = GPack.vbox ~packing:sbox#pack () in
let xaxis = new image_selection_box
~callback:zoom_in_fn
~height:x_axis_height
~x_offset:y_axis_width
~border_width:0
~xalign:0.0
~yalign:0.0
~packing:wbox#pack
~fill_vertically:true
()
in
(scope, xaxis, (fun b -> butbox#pack b))
in
object (self)
val mutable min_t = 0.0
val mutable max_t = initial_max_t
val time = Array.make !len_history 0.0
val mutable curr_idx = 0
val mutable nsamples = 0
val window = w
val context = xaxis_context#as_context
val mutable bgcolor = `WHITE
val mutable scopes = List.map make_scope scs;
method private iter_scopes f =
List.iter (fun (s, _, _) -> f s) scopes
method private destroy () = GMain.Main.quit ()
method private sample_idx i =
let i = (if i < 0 then nsamples else 0) + i mod nsamples in
let time_len = Array.length time in
let base = if nsamples < time_len then 0 else curr_idx in
(base + i) mod time_len
method private time i = time.(self#sample_idx i)
method tick t =
let time_len = Array.length time in
time.(curr_idx) <- t;
self#iter_scopes (fun s -> s#tick curr_idx);
curr_idx <- (curr_idx + 1) mod time_len;
nsamples <- min (nsamples + 1) time_len;
let prev_idx = if nsamples = 1 then 0 else nsamples - 2 in
let t_delta = t -. self#time prev_idx in
if (t_delta > 0.0 && t > max_t) then begin
max_t <- max_t +. t_delta;
min_t <- min_t +. t_delta
end
method private get_x_axis =
let _, selbox, _ = List.hd scopes in
let pixmap = (selbox#image#pixmap :> GDraw.drawable) in
let w, _ = pixmap#size in
let axis_width = w - y_axis_width - scope_padding_right in
let pixels_per_t = float axis_width /. (max_t -. min_t) in
let pxt =
fun t -> int_of_float (pixels_per_t *. (t -. min_t))
in
pixmap, axis_width, pxt
method private get_time_of_pixel =
let _, selbox, _ = List.hd scopes in
let pixmap = (selbox#image#pixmap :> GDraw.drawable) in
let w, _ = pixmap#size in
let axis_width = w - y_axis_width - scope_padding_right in
let t_per_pixels = (max_t -. min_t) /. float axis_width
and mt = min_t in
fun p -> (float_of_int p *. t_per_pixels) +. mt
method private zoom_in_hor hor_range =
let ptot = self#get_time_of_pixel in
(match hor_range with
| None -> ()
| Some (xl, xu) -> (min_t <- max min_t (ptot xl);
max_t <- min max_t (ptot xu)));
self#draw
method adjust =
let _, selbox, _ = List.hd scopes in
let w, h = Gdk.Drawable.get_size window#misc#window in
let nw = min max_scope_width (max min_scope_width w) in
let pw =
try
let pixmap = (selbox#image#pixmap :> GDraw.drawable) in
fst (pixmap#size)
with Gpointer.Null -> -1
in
if nw <> pw then begin
let pixmap = GDraw.pixmap ~width:nw ~height:x_axis_height () in
List.iter (fun (_, selbox, _) -> selbox#image#set_pixmap pixmap) scopes
end;
let nsc = List.length scopes in
let sch = min max_scope_height (max min_scope_height
((h / nsc) - x_axis_height - scope_title_height))
and scw = min max_scope_width (max min_scope_width w)
in
let adjust_scope changed (sc, _, _) = sc#adjust scw sch || changed in
if List.fold_left adjust_scope (nw <> pw) scopes then self#draw
method private draw_x_axis =
let pixmap, axis_width, pxt = self#get_x_axis in
fill_drawable pixmap bgcolor;
pixmap#set_foreground `BLACK;
pixmap#line (y_axis_width - 1) 0 (axis_width + y_axis_width) 0;
self#iter_scopes (fun s -> s#clear);
let dninc = (max 5 (axis_width / 100)) * 2 in
let tinc = nearest_powten ((max_t -. min_t) /. float dninc) in
let ninc = int_of_float ((max_t -. min_t) /. tinc) in
let layout = Pango.Layout.create context in
Pango.Layout.set_text layout (float_to_string (min_t +. tinc));
let lwidth, _ = Pango.Layout.get_pixel_size layout in
let npossible = max 1 (axis_width / (lwidth * 2 + 15) + 1) in
let skipinc = if npossible >= ninc then 1 else ninc / npossible in
for i = 0 to ninc do
if i mod skipinc = 0 then begin
let t = min_t +. (float i *. tinc) in
let x = pxt t + y_axis_width in
pixmap#lines [(x,0); (x,8)];
self#iter_scopes (fun s -> s#draw_x_gridline (x - y_axis_width));
Pango.Layout.set_text layout (float_to_string t);
let lwidth, _ = Pango.Layout.get_pixel_size layout in
pixmap#put_layout
~x:(x - 2 - lwidth / 2)
~y:9
~fore:`BLACK layout
end
done
method private fold_samples f acc =
if nsamples = 0 then acc
else
let a = ref acc in
for i = 0 to nsamples - 1 do
a := f !a (self#time i)
done;
!a
method private get_iterator =
let _, _, pxt = self#get_x_axis in
let iterator all =
if nsamples = 0 then (fun () -> None)
else
let idx = ref 0 in
let lasti_gtmax i = i <> 0 && self#time (i - 1) > max_t in
let rec next () =
let i = !idx in
incr idx;
if i = nsamples || (not all && self#time i > max_t && lasti_gtmax i)
then None
else if (not all && self#time i < min_t && self#time (i + 1) < min_t)
then next ()
else
let sample_i = self#sample_idx i in
Some (pxt (time.(sample_i)), sample_i)
in next
in iterator
method draw =
self#draw_x_axis;
List.iter (fun (_, selbox, _) -> selbox#redraw ()) scopes;
let sample_points = self#get_iterator in
self#iter_scopes (fun s -> s#draw_y_axis context;
s#draw (sample_points false));
w#misc#draw None
method private zoom_out_hor fit_to_scope_only =
let f (low_t, high_t) t = (min low_t t, max high_t t) in
let low_t, high_t = self#fold_samples f (max_float, min_float) in
if nsamples > 0 then begin
min_t <- low_t;
if (max_t >= high_t && not fit_to_scope_only)
then max_t <- max_t +. 0.5 *. (max_t -. min_t)
else max_t <- high_t
end;
self#draw
method private zoom_fit =
if nsamples > 0 then begin
min_t <- self#time 0;
max_t <- self#time (nsamples - 1)
end;
self#draw
method private add_buttons (scope, _, pack_button) =
let add_button icon callback =
let image = GMisc.image ~pixbuf:icon () in
let button = GButton.button ~packing:pack_button () in
ignore (button#set_image (image :> GObj.widget));
ignore (button#connect#clicked ~callback:callback) in
let zoom_out_ver () =
(ignore (scope#zoom_out_ver (self#get_iterator true)); self#draw)
and zoom_out_hor () =
self#zoom_out_hor false in
let zoom_out_all () =
(self#zoom_out_hor (scope#zoom_out_ver (self#get_iterator true));
self#draw) in
let zoom_fit () =
(scope#zoom_fit (self#get_iterator true); self#zoom_fit)
in
add_button icon_zoom_out_hor zoom_out_hor;
add_button icon_zoom_out zoom_out_all;
add_button icon_zoom_out_ver zoom_out_ver;
add_button icon_zoom_in zoom_fit
method private show () =
bgcolor <- `COLOR (window#misc#style#bg `NORMAL);
self#iter_scopes
(fun s -> s#set_bgcolor bgcolor; s#set_zoom_in_hor self#zoom_in_hor);
ignore (window#misc#connect#size_allocate (fun _ -> self#adjust));
self#adjust
initializer
List.iter self#add_buttons scopes;
ignore (window#connect#destroy ~callback:self#destroy);
ignore (window#misc#connect#show ~callback:self#show);
window#set_allow_shrink true;
window#show ();
Gdk.Window.set_cursor window#misc#window default_cursor
end
let getSignals l = List.map (fun (a,b,_) -> (a,b)) l
let getValues l = List.map (fun (_,_,a) -> a) l
let signal (name, ty) = new signal name ty
let signal_l l = List.map (fun (name, ty) -> signal (name, ty)) l
let scope (yl, yu, signals) = new scope yl yu signals
let window (imax_t, scopes, scope_list) = new window imax_t scopes scope_list
let update (s, v) = s#sample v
let update_l (ls, l) = List.iter2 (fun s v -> update (s, v)) ls l
let tick (w, t) = (w#tick t; w#draw)