package zelus-gtk

  1. Overview
  2. Docs

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) ( (* limit pixels to avoid "wraparound" *)
          (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;

      (* by default, two markers every 100 pixels, with at least 2
         and prefer 'clean' powers of ten *)
      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

  (* Add two or three rows for each scope:
       title (optional), scope box, xaxis image *)
  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 =
      (* first sample = 0, nsamples, 2 * nsamples, ...
         last  sample = -1, nsamples - 1, ... *)
      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);

      (* by default, two markers every 100 pixels, but insist on having
         at least 10 and prefer 'clean' powers of ten *)
      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

      (* calculate the number of labels possible for the given width *)
      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

      (* draw the markers and labels *)
      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)
OCaml

Innovation. Community. Security.