(* http://creativecommons.org/licenses/publicdomain/ *)

(* This OCaml-OpenGL script is made to display sky-boxes.
   You can find very nice sky-boxes that this script can display here:
   http://www.humus.name/index.php?page=Textures  *)

#directory "+glMLite"
#load "GL.cma"
#load "Glu.cma"
#load "Glut.cma"
#load "jpeg_loader.cma"

open GL
open Glu
open Glut

let usage() =
  Printf.printf "%s <skybox-directory>\n" Sys.argv.(0);
  exit 1
;;

(* give the directory where to find the sky-box images *)
let skybox_images_dir =
  if Array.length Sys.argv < 2 then usage();
  Sys.argv.(1)
;;

(* loading textures *)

type image_data = {
  width : int;
  height : int;
  pixels : GL.image_data;
  internal_format : GL.InternalFormat.internal_format;
  pixel_data_format : pixel_data_format;
}


let load_textures() =
  let src_img =
    (* images files *)
    [| Filename.concat skybox_images_dir "negz.jpg";
       Filename.concat skybox_images_dir "negx.jpg";
       Filename.concat skybox_images_dir "posz.jpg";
       Filename.concat skybox_images_dir "posx.jpg";
       Filename.concat skybox_images_dir "posy.jpg";
       Filename.concat skybox_images_dir "negy.jpg"; |]
  in
  let read_jpeg filename =
    (* load one texture *)
    let pixels, width, height, _(*color_components*), color_space =
      Jpeg_loader.load_img (Jpeg_loader.Filename filename)
    in
    let internal_format, pixel_data_format =
      match color_space with
      | Jpeg_loader.JCS_RGB -> InternalFormat.GL_RGB, GL_RGB
      | Jpeg_loader.JCS_GRAYSCALE -> InternalFormat.GL_LUMINANCE, GL_LUMINANCE
      | _ -> invalid_arg "Error: texture not RGB, nor Grayscale"
    in
    {
      width = width;
      height = height;
      pixels = pixels;
      internal_format = internal_format;
      pixel_data_format = pixel_data_format;
    }
  in
  let image = Array.map read_jpeg src_img in  (* load images *)

  (* create OpenGL textures ids *)
  let textures = glGenTextures 6 in

  for i=0 to pred 6 do
    (* select the texture *)
    glBindTexture2D textures.(i);

    (* define the parameters of the textures *)
    (* how the texture should wrap in S direction *)
    glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_WRAP_S  GL_CLAMP);
    (* how the texture should wrap in T direction *)
    glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_WRAP_T  GL_CLAMP);
    (* how the texture lookup should be interpolated when the face is smaller than the texture *)
    glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MIN_FILTER  Min.GL_NEAREST);
    (* how the texture lookup should be interpolated when the face is bigger than the texture *)
    glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MAG_FILTER  Mag.GL_NEAREST);

    (* send the texture image to the renderer *)
    glTexImage2D TexTarget.GL_TEXTURE_2D  0  image.(i).internal_format  image.(i).width  image.(i).height 0
                 image.(i).pixel_data_format  GL_UNSIGNED_BYTE  image.(i).pixels;
  done;
  (textures)
;;

(* display sky-box *)
let display_sky_box ~size ~textures =
  glEnable GL_TEXTURE_2D;
  glColor3 1.0 1.0 1.0;
  glPushMatrix();
  glScale (-1.0) 1.0 1.0;

    (* front face *)
    glBindTexture2D textures.(2);
    glBegin GL_QUADS;
    glNormal3 (0.0) (0.0) (-1.0);
    glTexCoord2 0.0 0.0; glVertex3 (-.size) (  size) (  size);
    glTexCoord2 1.0 0.0; glVertex3 (  size) (  size) (  size);
    glTexCoord2 1.0 1.0; glVertex3 (  size) (-.size) (  size);
    glTexCoord2 0.0 1.0; glVertex3 (-.size) (-.size) (  size);
    glEnd();

    (* right face *)
    glBindTexture2D textures.(3);
    glBegin GL_QUADS;
    glNormal3 (-1.0) (0.0) (0.0);
    glTexCoord2 0.0 0.0; glVertex3 (  size) (  size) (  size);
    glTexCoord2 1.0 0.0; glVertex3 (  size) (  size) (-.size);
    glTexCoord2 1.0 1.0; glVertex3 (  size) (-.size) (-.size);
    glTexCoord2 0.0 1.0; glVertex3 (  size) (-.size) (  size);
    glEnd();

    (* back face *)
    glBindTexture2D textures.(0);
    glBegin GL_QUADS;
    glNormal3 0.0 0.0 1.0;
    glTexCoord2 0.0 0.0; glVertex3 (  size) (  size) (-.size);
    glTexCoord2 1.0 0.0; glVertex3 (-.size) (  size) (-.size);
    glTexCoord2 1.0 1.0; glVertex3 (-.size) (-.size) (-.size);
    glTexCoord2 0.0 1.0; glVertex3 (  size) (-.size) (-.size);
    glEnd();

    (* left face *)
    glBindTexture2D textures.(1);
    glBegin GL_QUADS;
    glNormal3 1.0 0.0 0.0;
    glTexCoord2 0.0 0.0; glVertex3 (-.size) (  size) (-.size);
    glTexCoord2 1.0 0.0; glVertex3 (-.size) (  size) (  size);
    glTexCoord2 1.0 1.0; glVertex3 (-.size) (-.size) (  size);
    glTexCoord2 0.0 1.0; glVertex3 (-.size) (-.size) (-.size);
    glEnd();

    (* top face *)
    glBindTexture2D textures.(4);
    glBegin GL_QUADS;
    glNormal3 (0.0) (-1.0) (0.0);
    glTexCoord2 0.0 0.0; glVertex3 (-.size) (  size) (-.size);
    glTexCoord2 1.0 0.0; glVertex3 (  size) (  size) (-.size);
    glTexCoord2 1.0 1.0; glVertex3 (  size) (  size) (  size);
    glTexCoord2 0.0 1.0; glVertex3 (-.size) (  size) (  size);
    glEnd();

    (* bottom face *)
    glBindTexture2D textures.(5);
    glBegin GL_QUADS;
    glNormal3 0.0 1.0 0.0;
    glTexCoord2 0.0 0.0; glVertex3 (-.size) (-.size) (  size);
    glTexCoord2 1.0 0.0; glVertex3 (  size) (-.size) (  size);
    glTexCoord2 1.0 1.0; glVertex3 (  size) (-.size) (-.size);
    glTexCoord2 0.0 1.0; glVertex3 (-.size) (-.size) (-.size);
    glEnd();

  glPopMatrix();
;;

let b_down = ref false
let anglex = ref (0)
let angley = ref (0)
let xold = ref 0
let yold = ref 0
let list_id = ref 0

(* load datas *)
let compile_list ~dirname =

  let textures = load_textures() in

  glNewList !list_id GL_COMPILE;
    display_sky_box ~size:8. ~textures;
  glEndList();
;;

(* callback display *)
let display () =
  glClear ~mask:[GL_COLOR_BUFFER_BIT; GL_DEPTH_BUFFER_BIT];

  glLoadIdentity();

  glRotate ~angle:(float(- !angley)) ~x:1.0 ~y:0.0 ~z:0.0;
  glRotate ~angle:(float(- !anglex)) ~x:0.0 ~y:1.0 ~z:0.0;

  glCallList !list_id;

  glFlush();
  glutSwapBuffers();
;;

(* callback reshape *)
let reshape ~width ~height =
  glMatrixMode GL_PROJECTION;
  glLoadIdentity();
  gluPerspective ~aspect:(float width /. float height)
                 ~fovy:80. ~zNear:0.2 ~zFar:60.;
  glViewport 0 0 width height;
  glMatrixMode GL_MODELVIEW;
  glutPostRedisplay();
;;

(* callback keyboard *)
let keyboard ~key ~x ~y =
  match key with
  | '\027'
  | 'q' -> exit(0)
  | _ -> ()
;;

(* callback mouse *)
let mouse ~button ~state ~x ~y =
  match button, state with
  (* if we press the left button *)
  | GLUT_LEFT_BUTTON, GLUT_DOWN ->
      b_down := true;
      xold := x;  (* save mouse position *)
      yold := y;
  (* if we release the left button *)
  | GLUT_LEFT_BUTTON, GLUT_UP ->
      b_down := false;
  | _ -> ()
;;

(* callback motion *)
let motion ~x ~y =
  if !b_down then  (* if the left button is down *)
  begin
 (* change the rotation angles according to the last position
    of the mouse and the new one *)
    anglex := !anglex + (!xold - x);
    angley := !angley + (!yold - y);
    glutPostRedisplay();
  end;

  xold := x;
  yold := y;
;;

(* main init of GL & Glut *)
let () =
  ignore(glutInit Sys.argv);

  glutInitDisplayMode[GLUT_RGB; GLUT_DOUBLE; GLUT_DEPTH];
  glutInitWindowPosition ~x:200 ~y:200;
  glutInitWindowSize ~width:800 ~height:600;

  ignore(glutCreateWindow ~title:("Fly-Box " ^ skybox_images_dir));

  glClearColor ~r:0.0 ~g:0.0 ~b:0.0 ~a:0.0;

  (* init openGL *)
  glEnable GL_DEPTH_TEST;

  list_id := glGenLists 1;
  compile_list ~dirname:skybox_images_dir;

  (* callback functions *)
  glutDisplayFunc ~display;
  glutReshapeFunc ~reshape;
  glutKeyboardFunc ~keyboard;
  glutMouseFunc ~mouse;
  glutMotionFunc ~motion;

  (* enter the main loop *)
  glutMainLoop();
;;