Source

clutter-ocaml / tests / test-gradient.ml

Full commit

open Clutter

let () =
  let white_data = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 4 in
  for i=0 to 3 do white_data.{i} = char_of_int 0xff done;
  let stage = ClutterStage.get_default () in
  let color = Color.rgb (0x80, 0x80, 0xff) in

  stage#set_color color;
  let tex = Cogl.Texture.new_from_data ~width:1 ~height:1 ~max_waste:(-1)
    ~auto_mipmap:false ~format:`RGBA_8888 ~internal_format:`ANY
    ~rowstride:4 ~data:white_data in

  
  let _ = stage#connect#paint
    (fun actor ->
       (*let stage = actor#get_stage in*)
       let width,height = stage#get_size in
       let zero = int_to_units 0 in
       let width_2 = int_to_units (width / 2) in
       Printf.printf "hey: %d width=%d\n%!" (Obj.magic (cfx_one ())) width;
       
       Printf.printf "test: %d\n%!" (Obj.magic (cfx_cast 2));
       Printf.printf "baby: %d\n%!"
	 (Obj.magic (cfx_one () /~ (cfx_cast 2)));
      
       let vertices = [|
	 {Cogl.Texture.x=zero; y=zero; z=cfx_cast 0;
	  tx=cfx_one () /~ (cfx_cast 2); ty=cfx_one () /~ (cfx_cast 2);
	  color=(Color.rgb (0xff,0x0,0x0))#obj };
	 {Cogl.Texture.x=width_2; y=zero; z=cfx_cast 0;
	  tx=cfx_one () /~ (cfx_cast 2); ty=cfx_one () /~ (cfx_cast 2);
	  color=(Color.rgb (0x0,0xff,0x0))#obj };
	 {Cogl.Texture.x=width_2; y=int_to_units height; z=cfx_cast 0;
	  tx=cfx_one () /~ (cfx_cast 2); ty=cfx_one () /~ (cfx_cast 2);
	  color=(Color.rgba (0x0,0xff,0x0,0x0))#obj };
	 {Cogl.Texture.x=zero; y=int_to_units height; z=cfx_cast 0;
	  tx=cfx_one () /~ (cfx_cast 2); ty=cfx_one () /~ (cfx_cast 2);	  
	  color=(Color.rgba (0xff,0x0,0x0,0x0))#obj };
       |] in
       Cogl.Texture.polygon tex ~vertices ~use_color:true
    ) in
  stage#show;
  clutter_main ();

  Cogl.Texture._unref tex