File: simple.ml

package info (click to toggle)
lablgl 1:1.05-3
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,444 kB
  • sloc: ansic: 8,270; ml: 6,118; tcl: 342; makefile: 294; xml: 84; perl: 12
file content (35 lines) | stat: -rw-r--r-- 1,050 bytes parent folder | download | duplicates (4)
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
(* $Id: simple.ml,v 1.10 2002-04-27 02:35:45 garrigue Exp $ *)

open Tk

let main () =
  (* Aux.init_display_mode [`rgb;`single;`depth];
  Aux.init_position ~x:0 ~y:0 ~w:500 ~h:500;
  Aux.init_window ~title:"LablGL"; *)
  let top = openTk () in
  let togl =
    Togl.create top ~width:500 ~height:500 ~rgba:true ~depth:true ~double:true
  in
  Wm.title_set top "LablGL";
  pack ~fill:`Both [togl];
  Togl.display_func togl ~cb:
    begin fun () ->
      GlClear.color (0.0, 0.0, 0.0);
      GlClear.clear [`color];
      GlDraw.color (1.0, 1.0, 1.0);
      GlMat.mode `projection;
      GlMat.load_identity ();
      GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0);
      GlDraw.begins `polygon;
      GlDraw.vertex ~x:(-0.5) ~y:(-0.5) ();
      GlDraw.vertex ~x:(-0.5) ~y:(0.5) ();
      GlDraw.vertex ~x:(0.5) ~y:(0.5) ();
      GlDraw.vertex ~x:(0.5) ~y:(-0.5) ();
      GlDraw.ends ();
      Gl.flush ();
      Togl.swap_buffers togl
    end;
  ignore (Timer.add ~ms:10000 ~callback:(fun () -> destroy top));
  mainLoop ()

let _ = main ()