open Sdl open Video open Window open Timer open Event open SDLGL open Draw open Glcaml let perspective fov aspect zNear zFar = let pi = 4.0 *. (atan 1.0) in let fH = (tan (fov /. 360.0 *. pi )) *. zNear in let fW = fH *. aspect in glFrustum (-.fW) fW (-.fH) fH zNear zFar;; let opengl_mipmaps s filter = let mipmaps = make_mipmaps s filter in let len = Array.length mipmaps in let bpp = (surface_bpp mipmaps.(0)) in let c, rgba = if ((bpp = 15) || (bpp = 32)) then 4, gl_rgba else 3, gl_rgb in glPixelStorei gl_pack_alignment 1; for i = 0 to (len - 1) do let w = (surface_width (mipmaps.(i))) and h = (surface_height (mipmaps.(i))) and pixels = (surface_pixels (mipmaps.(i))) in glTexImage2D gl_texture_2d i 3 w h 0 rgba gl_unsigned_byte pixels; done let light_ambient = [| 0.5; 0.5; 0.5; 1.0 |] let light_diffuse = [| 1.0; 1.0; 1.0; 1.0 |] let light_position = [|0.0; 0.0; 2.0; 1.0 |] let xrot = ref 0.1 let yrot = ref 0.1 let xspeed = ref 0.1 let yspeed = ref 0.1 let z = ref (-5.0) let light = ref true let filter = ref 2 let texture = Array.make 3 0 let load_gl_textures () = let s = load_bmp "data/crate.bmp" in let p = surface_pixels s in glGenTextures 3 texture; (* Texture 1: poor quality scaling *) glBindTexture gl_texture_2d texture.(0); glTexParameteri gl_texture_2d gl_texture_mag_filter gl_nearest; (* cheap scaling when image bigger than texture *) glTexParameteri gl_texture_2d gl_texture_min_filter gl_nearest; (* cheap scaling when image smalled than texture *) (* 2d texture, level of detail 0 (normal), 3 components (red, green, blue), x size from image, y size from image, border 0 (normal), rgb color data, unsigned byte data, and finally the data itself. *) glTexImage2D gl_texture_2d 0 3 (surface_width s) (surface_height s) 0 gl_rgb gl_unsigned_byte p; (* Texture 2: Linear scaling *) glBindTexture gl_texture_2d texture.(1); glTexParameteri gl_texture_2d gl_texture_mag_filter gl_linear; (* linear scaling when image bigger than texture *) glTexParameteri gl_texture_2d gl_texture_min_filter gl_linear; (* linear scaling when image smalled than texture *) (* 2d texture, level of detail 0 (normal), 3 components (red, green, blue), x size from image, y size from image, border 0 (normal), rgb color data, unsigned byte data, and finally the data itself. *) glTexImage2D gl_texture_2d 0 3 (surface_width s) (surface_height s) 0 gl_rgb gl_unsigned_byte p; (* Texture 3: Mipmapped scaling *) glBindTexture gl_texture_2d texture.(2); glTexParameteri gl_texture_2d gl_texture_mag_filter gl_linear; (* linear scaling when image bigger than texture *) glTexParameteri gl_texture_2d gl_texture_min_filter gl_linear_mipmap_linear; (* scale linearly + mipmap when image smalled than texture *) (* 2d texture, level of detail 0 (normal), 3 components (red, green, blue), x size from image, y size from image, border 0 (normal), rgb color data, unsigned byte data, and finally the data itself. *) glTexImage2D gl_texture_2d 0 3 (surface_width s) (surface_height s) 0 gl_rgb gl_unsigned_byte p; opengl_mipmaps s triangle (* A general OpenGL initialization function. Sets all of the initial parameters. *) let init_gl width height = load_gl_textures (); glViewport 0 0 width height; glClearColor 0.0 0.0 0.0 0.0; glClearDepth 1.0; glDepthFunc gl_less; glEnable gl_depth_test; glEnable gl_texture_2d; glShadeModel gl_smooth; glMatrixMode gl_projection; glLoadIdentity (); let aspect = (float_of_int width) /. (float_of_int height) in perspective 45.0 aspect 1.0 100.0; glMatrixMode gl_modelview; (* Set up lights *) glEnable gl_lighting; glLightfv gl_light1 gl_ambient light_ambient; glLightfv gl_light1 gl_diffuse light_diffuse; glLightfv gl_light1 gl_position light_position; glEnable gl_light1 let draw_gl_scene () = glClear (gl_color_buffer_bit lor gl_depth_buffer_bit) ; (* Clear The Screen And The Depth Buffer *) glLoadIdentity () ; (* Reset The View*) glTranslatef 0.0 0.0 !z ; (* move z units out from the screen. *) glRotatef !xrot 1.0 0.0 0.0 ; (* Rotate On The X Axis *) glRotatef !yrot 0.0 1.0 0.0 ; (* Rotate On The Y Axis *) glBindTexture gl_texture_2d texture.(!filter) ; (* choose the texture to use. *) glBegin gl_quads ; (* begin drawing a cube *) (* Front Face note that the texture's corners have to match the quad's corners *) glNormal3f 0.0 0.0 1.0 ; (* front face points out of the screen on z. *) glTexCoord2f 0.0 0.0 ; glVertex3f (-.1.0) (-.1.0) 1.0 ; (* Bottom Left Of The Texture and Quad *) glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 (-.1.0) 1.0 ; (* Bottom Right Of The Texture and Quad *) glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 1.0 ; (* Top Right Of The Texture and Quad *) glTexCoord2f 0.0 1.0 ; glVertex3f (-.1.0) 1.0 1.0 ; (* Top Left Of The Texture and Quad *) (* Back Face *) glNormal3f 0.0 0.0 (-.1.0) ; (* back face points into the screen on z. *) glTexCoord2f 1.0 0.0 ; glVertex3f (-.1.0) (-.1.0) (-.1.0) ; (* Bottom Right Of The Texture and Quad *) glTexCoord2f 1.0 1.0 ; glVertex3f (-.1.0) 1.0 (-.1.0) ; (* Top Right Of The Texture and Quad *) glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 1.0 (-.1.0) ; (* Top Left Of The Texture and Quad *) glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 (-.1.0) (-.1.0) ; (* Bottom Left Of The Texture and Quad *) (* Top Face *) glNormal3f 0.0 1.0 0.0 ; (* top face points up on y. *) glTexCoord2f 0.0 1.0 ; glVertex3f (-.1.0) 1.0 (-.1.0) ; (* Top Left Of The Texture and Quad *) glTexCoord2f 0.0 0.0 ; glVertex3f (-.1.0) 1.0 1.0 ; (* Bottom Left Of The Texture and Quad *) glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 1.0 1.0 ; (* Bottom Right Of The Texture and Quad *) glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 (-.1.0) ; (* Top Right Of The Texture and Quad *) (* Bottom Face *) glNormal3f 0.0 (-.1.0) 0.0 ; (* bottom face points down on y. *) glTexCoord2f 1.0 1.0 ; glVertex3f (-.1.0) (-.1.0) (-.1.0) ; (* Top Right Of The Texture and Quad *) glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 (-.1.0) (-.1.0) ; (* Top Left Of The Texture and Quad *) glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 (-.1.0) 1.0 ; (* Bottom Left Of The Texture and Quad *) glTexCoord2f 1.0 0.0 ; glVertex3f (-.1.0) (-.1.0) 1.0 ; (* Bottom Right Of The Texture and Quad *) (* Right face *) glNormal3f 1.0 0.0 0.0 ; (* right face points right on x. *) glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 (-.1.0) (-.1.0) ; (* Bottom Right Of The Texture and Quad *) glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 (-.1.0) ; (* Top Right Of The Texture and Quad *) glTexCoord2f 0.0 1.0 ; glVertex3f 1.0 1.0 1.0 ; (* Top Left Of The Texture and Quad *) glTexCoord2f 0.0 0.0 ; glVertex3f 1.0 (-.1.0) 1.0 ; (* Bottom Left Of The Texture and Quad *) (* Left Face *) glNormal3f (-.1.0) 0.0 0.0 ; (* left face points left on x. *) glTexCoord2f 0.0 0.0 ; glVertex3f (-.1.0) (-.1.0) (-.1.0) ; (* Bottom Left Of The Texture and Quad *) glTexCoord2f 1.0 0.0 ; glVertex3f (-.1.0) (-.1.0) 1.0 ; (* Bottom Right Of The Texture and Quad *) glTexCoord2f 1.0 1.0 ; glVertex3f (-.1.0) 1.0 1.0 ; (* Top Right Of The Texture and Quad *) glTexCoord2f 0.0 1.0 ; glVertex3f (-.1.0) 1.0 (-.1.0) ; (* Top Left Of The Texture and Quad *) glEnd (); (* done with the polygon. *) xrot := !xrot +. !xspeed; (* X Axis Rotation *) yrot := !yrot +. !yspeed (* Y Axis Rotation *) let callback k = if k.keystate = PRESSED then match (k.sym) with K_F -> filter := (!filter + 1) mod 3; K_L -> if !light = false then glEnable gl_lighting else glDisable gl_lighting; light := not !light; _ -> () (* Wait until a key is pressed or the window is closed *) let rec handle_events quit = draw_gl_scene (); swap_buffers (); if not quit then begin match poll_event () with Key k -> callback k; handle_events false; Quit -> handle_events true; _ -> handle_events false; end let main () = init [VIDEO]; let w = 640 and h = 480 and bpp = 32 in let _ = set_video_mode w h bpp [OPENGL] in set_caption "Jeff Molofee's GL Code Tutorial ... NeHe '99" "NeHe 07"; init_gl w h; handle_events false; quit () (* Program entry point *) let _ = try main () with SDL_failure m -> failwith m
This document was generated using caml2html