From: Maurizio Colucci <seguso.forever at tin.it>
To: lablgtk <lablgtk at kaba.or.jp>
Subject: Texture mapping nightmare
Date: Sun, 22 Aug 2004 15:22:56 +0200
MIME-Version: 1.0
Content-Disposition: inline
Content-Type: text/plain;
  charset="us-ascii"
Content-Transfer-Encoding: 7bit
Message-Id: <200408221522.57157.seguso.forever at tin.it>

Hello again :-P

I am sorry for the flooding, but after 3 days of work I still don't understand 
why the texture does not appear. A white square is drawn, whereas it should 
be textured. 

I have removed all possible sources of errors (I don't use gdkPixbuf for 
example), and I don't know how to simplify this anymore. 

The same sequence of calls works in C.

I really need help OR a simple helloworld example with texture mapping 
(texturesurf.ml is too difficult: it uses curved surfaces, it does no 
bind_texture and gen_texture call, and apart from that I don't understand 
what I am doing different).

Thanks for any help.


(* Simple program that displays a textured triangle on the screen. The
   texture is hard-coded, i.e. not loaded from file. *)

open List

(* "accumulate l f state" invokes f on each element of l, but
   threading a state. This means that

   f x state

   is called for each x in l, but each time with the state produced
   by the previous call.

   Example:

   accumulate [1;2;4] f initial_state

   means

   let st1 = f 1 initial_state in 
   let st2 = f 2 st1 in 
   f 4 st2

*)

let rec accumulate ~list ~f ~state =
  match list with
      [] -> state
    | h::t -> 
	let state' = f h state in
	accumulate ~list:t ~f:f ~state:state'

type vec2d = {x2:float; y2:float}

type texture = { texture_handle: GlTex.texture_id ; 
		 texture_size: vec2d }




let create_texture2 () = 
  let fill_glpix glp wt ht = 
    let pi = acos (-1.0) in 
    let raw = GlPix.to_raw glp
    and pos = GlPix.raw_pos glp in
    for i = 0 to wt - 1 do
      let ti = 2.0 *. pi *. float i /. float wt in
      for j = 0 to ht - 1 do
	let tj = 2.0 *. pi *. float j /. float ht in
	Raw.sets raw ~pos:(pos ~x:j ~y:i)
	  (Array.map (fun x -> truncate (127.0 *. (1.0 +. x)))
	     [|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]);
      done;
    done
  in
  let id = GlTex.gen_texture () in
  GlTex.bind_texture `texture_2d id;
  let wt = 64 in
  let ht = 64 in
  let glp =
    GlPix.create `ubyte ~height:ht ~width:wt ~format:`rgb in
  fill_glpix glp wt ht;
  GlTex.image2d glp;
  { texture_handle =  id; 
    texture_size =  {x2 = float wt ; y2 = float ht}}


type my_event = Resize of int * int  | Redraw |  Init | Destroy

let pending_events = ref []

let get_pending_events () = 
  let exit = Glib.Main.iteration true (* calls one or more callbacks
					 and fills pending_events *)
  in
  let p = !pending_events  in
  pending_events := [];
  p


let manage_event ev (tex, area, quit) = 
  match ev with
      Destroy -> (tex, area, true)
    | Resize (wt, ht) ->
	print_endline "my_opengl_reshape called";
	area#make_current ();
	GlDraw.viewport 0 0 wt ht;
	GlMat.mode `projection;
	GlMat.load_identity ();
	GlMat.ortho (0.0, float wt) (float ht, 0.0) (-1.0, 0.0) ;
	(tex, area, false)
    | Redraw ->
	area#make_current ();
	GlClear.clear [`color];
	let pos = {x2 = 20. ; y2 = 20.} in
	GlDraw.color (0.8, 0.8, 0.8);
	GlTex.bind_texture `texture_2d tex.texture_handle;
	Gl.enable `texture_2d;
	GlDraw.begins `triangle_fan;
	GlTex.coord2 (0.,  0.) ;
	GlDraw.vertex2 (pos.x2, pos.y2);
	GlTex.coord2 (1., 0.);
	GlDraw.vertex2 (pos.x2 +. tex.texture_size.x2, pos.y2);
	GlTex.coord2 (1., 1.);
	GlDraw.vertex2 (pos.x2 +. tex.texture_size.x2, pos.y2 +. 
tex.texture_size.y2);
	GlTex.coord2 (0., 1.);
	GlDraw.vertex2 (pos.x2 , pos.y2 +. tex.texture_size.y2);
	GlDraw.ends ();

	Gl.flush ();
	area#swap_buffers ();
	(tex, area, false)
    | Init ->
	print_endline "my_opengl_init called";
	area#make_current ();
	GlDraw.shade_model `flat;
	GlClear.color (0.1, 0.02, 0.0);
	Gl.disable `depth_test;
	Gl.enable `blend;
	GlFunc.blend_func `src_alpha `one_minus_src_alpha;
	Gl.enable `alpha_test;
	Gl.enable `line_smooth;
	Gl.enable `point_smooth;
	GlFunc.alpha_func `greater 0.0 ;
	(tex, area, false)




let rec main_loop area tex =
  let evlist = get_pending_events () in
  let (_, _, quit) = accumulate ~f:manage_event ~list:evlist
    ~state:(tex, area, false) in
  if quit then () else main_loop area tex



let main () =
  
  let delete_event ev =
    print_endline "Delete event occurred";
    flush stdout;
    false (* false = quit *)  in
  
  let reshape_callback ~width ~height = 
    pending_events := append !pending_events [Resize (width, height)] in
  let realize_callback () = 
    pending_events := append !pending_events [Init] in
  let display_callback () = 
    pending_events := append !pending_events [Redraw] in
   let destroy () = 
     pending_events := append !pending_events [Destroy] in 
  let locale = GtkMain.Main.init () in
  let window = GWindow.window  () in
  let _ = window#event#connect#delete ~callback:delete_event in
  let _ = window#connect#destroy ~callback:destroy in 
  let ar = GlGtk.area [`USE_GL ; `RGBA; `DOUBLEBUFFER] ~packing:window#add 
~show:true () in 
  let _ = ar#connect#reshape ~callback: reshape_callback in
  let _ = ar#connect#realize ~callback: realize_callback in
  let _ = ar#connect#display ~callback: display_callback in
  (*   window#maximize (); *)
  window#show ();
  let tex = create_texture2 () in
  main_loop ar tex


let _ = main ()


-- 
Maurizio Colucci
http://logicaldesktop.sourceforge.net