(*
   This code was created by Jeff Molofee '99 (ported to Linux/GLUT by Richard Campbell '99)
  
   If you've found this code useful, please let me know.
  
   Visit me at www.demonews.com/hosted/nehe
   (email Richard Campbell at ulmont@bellsouth.net)
  
   It was modified heavily by Daniel Davis to get rid of Glut (Blah!) and the Tab characters (double Blah!)
   Daniel (planetes@mediaone.net)
   I should note that this was completed on a custom Linux (see www.linuxfromscratch.org)
   using XFree86 4.0.1 with DRI cvs code and a 3dfx Voodoo3 card.
*)
(* Ported from C to OCaml by Florent Monnier *)

open GL                 (* Module For The OpenGL Library *)
open Glu                (* Module For The GLu Library *)
open Xlib               (* Standard X module for Xlib library *)
open Keysym_match       (* Module to provide keyboard functionality under X *)
open GLX                (* Module For The X library for OpenGL *)

(* Global variables *)

let fXRotation = ref 0.0
let fYRotation = ref 0.0
let fXSpeed = ref 0.0
let fYSpeed = ref 0.0
let z = ref(-5.0)

let lightAmbient =  (0.5, 0.5, 0.5, 1.0)
let lightDiffuse =  (1.0, 1.0, 1.0, 1.0)
let lightPosition = (0.0, 0.0, 2.0, 1.0)
let filter = ref 0                             (* Which Filter To Use *)
let light = ref false                          (* Light switch *)
let fogMode= [| GL_EXP; GL_EXP2; GL_LINEAR |]  (* Storage For Three Types Of Fog *)
let fogfilter = ref 0                          (* Which Fog Mode To Use *)
let fogColor = (0.5, 0.5, 0.5, 1.0)            (* Fog Color *)

let ( += ) a b =
  a := !a +. b;
;;

let ( -= ) a b =
  a := !a -. b;
;;


(* Load Bitmaps And Convert To Textures *)
let loadGLTextures() =
  (* Load Texture *)
  let image_data, dimensionX, dimensionY, tex_internal_fmt, pixel_data_fmt =
    Png_loader.load_img (Filename "Data/lesson16/crate.png")
  in

  let iTexture = glGenTextures 3 in            (* Create Three Textures *)

  (* Create Nearest Filtered Texture *)
  glBindTexture BindTex.GL_TEXTURE_2D iTexture.(0);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MAG_FILTER Mag.GL_NEAREST);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MIN_FILTER Min.GL_NEAREST);
  glTexImage2D TexTarget.GL_TEXTURE_2D 0 (Cnst 3) dimensionX dimensionY 0 GL_RGB GL_UNSIGNED_BYTE image_data;

  (* Create Linear Filtered Texture *)
  glBindTexture BindTex.GL_TEXTURE_2D iTexture.(1);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MAG_FILTER Mag.GL_LINEAR);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MIN_FILTER Min.GL_LINEAR);
  glTexImage2D TexTarget.GL_TEXTURE_2D 0 (Cnst 3) dimensionX dimensionY 0 GL_RGB GL_UNSIGNED_BYTE image_data;

  (* Create MipMapped Texture *)
  glBindTexture BindTex.GL_TEXTURE_2D iTexture.(2);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MAG_FILTER Mag.GL_LINEAR);
  glTexParameter TexParam.GL_TEXTURE_2D (TexParam.GL_TEXTURE_MIN_FILTER Min.GL_LINEAR_MIPMAP_NEAREST);
  gluBuild2DMipmaps (Cnst 3) dimensionX dimensionY GL_RGB GL_UNSIGNED_BYTE image_data;

  (iTexture)
;;


(* Function to construct and initialize X-windows Window *)
let xInitWindow ~argv =
  (* Open the Display *)
  let dpDisplay = xOpenDisplay "" in

  (* Check for GLX extension to X-Windows *)
  glXQueryExtension dpDisplay;

  (* Buffer parameters for Double Buffering *)
  let dblBuf = [ Visual. GLX_RGBA;
                 Visual. GLX_RED_SIZE  1;
                 Visual. GLX_GREEN_SIZE  1;
                 Visual. GLX_BLUE_SIZE  1;
                 Visual. GLX_DEPTH_SIZE  12;
                 Visual. GLX_DOUBLEBUFFER; ] in

  (* Grab a doublebuffering RGBA visual as defined in dblBuf *)
  let xvVisualInfo = glXChooseVisual dpDisplay (xDefaultScreen dpDisplay) dblBuf in

  (* Create a window context *)
  let glXContext = glXCreateContext dpDisplay xvVisualInfo None true in

  let viscont = xVisualInfo_datas xvVisualInfo in

  (* Create the color map for the new window *)
  let cmColorMap = xCreateColormap dpDisplay
                                   (xRootWindow dpDisplay viscont.screen_number)
                                   viscont.visual AllocNone in

  let winAttributes = new_win_attr() in
  winAttributes.set_colormap cmColorMap;
  winAttributes.set_border_pixel (xBlackPixel dpDisplay (xDefaultScreen dpDisplay));
  winAttributes.set_event_mask [ ExposureMask; ButtonPressMask; StructureNotifyMask;
                                 KeyPressMask ];

  (* Create the actual window object *)
  let win = xCreateWindow dpDisplay
                          (xRootWindow dpDisplay viscont.screen_number)
                          0 0
                          640 480                   (* Horizontal /  Veritical Size *)
                          0
                          viscont.depth
                          InputOutput
                          viscont.visual
                          [CWBorderPixel; CWColormap; CWEventMask]
                          winAttributes.attr in

  (* Set the standard properties for the window. *)
  xSetStandardProperties dpDisplay
                         win
                         "Daniel Davis's Fog Tutorial ... NeHe '99"
                         "lesson16"
                         None
                         Sys.argv
                         (new_xSizeHints());

  (* Establish new event *)
  let wmDeleteWindow = xInternAtom dpDisplay "WM_DELETE_WINDOW" false in
  xSetWMProtocols dpDisplay win wmDeleteWindow 1;

  (* Convert to a glx drawable *)
  let dwin = glXDrawable_of_window win in

  (* Bind the OpenGL context to the newly created window. *)
  glXMakeCurrent dpDisplay dwin glXContext;

  (* Make the new window the active window. *)
  xMapWindow dpDisplay win;

  (dpDisplay, dwin, wmDeleteWindow)
;;


(* A general OpenGL initialization function.  Sets all of the initial parameters. *)
let initGL ~width ~height =                      (* We call this right after our OpenGL window is created. *)
  let iTexture = loadGLTextures() in             (* Load Texture from file. *)

  glEnable GL_TEXTURE_2D;                        (* Enable 2D texture matrix *)
  glShadeModel GL_SMOOTH;                        (* Set shading to smooth *)

  glClearColor 0.5 0.5 0.5 1.0;                  (* This Will Clear The Background Color To Black *)
  glClearDepth 1.0;                              (* Enables Clearing Of The Depth Buffer *)
  glEnable GL_DEPTH_TEST;                        (* Enables Depth Testing *)
  glDepthFunc GL_LEQUAL;                         (* Type of Depth Test to perform *)
  glHint GL_PERSPECTIVE_CORRECTION_HINT  GL_NICEST; (* Really nice perspective calculations *)

  glLight (GL_LIGHT 1) (Light.GL_AMBIENT  lightAmbient);  (* Setup The Ambient Light *)
  glLight (GL_LIGHT 1) (Light.GL_DIFFUSE  lightDiffuse);  (* Setup The Diffuse Light *)
  glLight (GL_LIGHT 1) (Light.GL_POSITION lightPosition); (* Position The Light *)
  glEnable GL_LIGHT1;                            (* Enable Light One *)

  glFog (GL_FOG_MODE fogMode.(!fogfilter));      (* Fog Mode *)
  glFog (GL_FOG_COLOR fogColor);                 (* Set Fog Color *)
  glFog (GL_FOG_DENSITY 0.35);                   (* How Dense Will The Fog Be *)
  glHint GL_FOG_HINT  GL_DONT_CARE;              (* Fog Hint Value *)
  glFog (GL_FOG_START 1.0);                      (* Fog Start Depth *)
  glFog (GL_FOG_END 5.0);                        (* Fog End Depth *)
  glEnable GL_FOG;                               (* Enables GL_FOG *)

  (iTexture)
;;


(* The function called when our window is resized (which shouldn't happen, because we're fullscreen) *)
let reSizeGLScene ~width ~height =
  let height =
    if height = 0                                (* Prevent A Divide By Zero If The Window Is Too Small *)
    then 1
    else height
  in
  glViewport 0 0 width height;                   (* Reset The Current Viewport And Perspective Transformation *)

  glMatrixMode GL_PROJECTION;
  glLoadIdentity();

  gluPerspective 45.0 (float width /. float height) 0.1 100.0;
  glMatrixMode GL_MODELVIEW;
;;


(* The function to draw the screendrawing function. *)
let drawGLScene dpDisplay dwin iTexture =
  glClear [GL_COLOR_BUFFER_BIT; GL_DEPTH_BUFFER_BIT]; (* Clear The Screen And The Depth Buffer *)
  glLoadIdentity();                              (* Reset The View *)
  glTranslate 0.0 0.0 !z;

  glRotate !fXRotation 1.0 0.0 0.0;
  glRotate !fYRotation 0.0 1.0 0.0;

  glBindTexture BindTex.GL_TEXTURE_2D iTexture.(!filter);

  glBegin GL_QUADS;
    (* Front Face *)
    glNormal3 0.0 0.0 1.0;
    glTexCoord2 0.0 0.0;  glVertex3 (-1.0) (-1.0) ( 1.0);
    glTexCoord2 1.0 0.0;  glVertex3 ( 1.0) (-1.0) ( 1.0);
    glTexCoord2 1.0 1.0;  glVertex3 ( 1.0) ( 1.0) ( 1.0);
    glTexCoord2 0.0 1.0;  glVertex3 (-1.0) ( 1.0) ( 1.0);
    (* Back Face *)
    glNormal3 0.0 0.0 (-1.0);
    glTexCoord2 1.0 0.0;  glVertex3 (-1.0) (-1.0) (-1.0);
    glTexCoord2 1.0 1.0;  glVertex3 (-1.0) ( 1.0) (-1.0);
    glTexCoord2 0.0 1.0;  glVertex3 ( 1.0) ( 1.0) (-1.0);
    glTexCoord2 0.0 0.0;  glVertex3 ( 1.0) (-1.0) (-1.0);
    (* Top Face *)
    glNormal3 0.0 1.0 0.0;
    glTexCoord2 0.0 1.0;  glVertex3 (-1.0) ( 1.0) (-1.0);
    glTexCoord2 0.0 0.0;  glVertex3 (-1.0) ( 1.0) ( 1.0);
    glTexCoord2 1.0 0.0;  glVertex3 ( 1.0) ( 1.0) ( 1.0);
    glTexCoord2 1.0 1.0;  glVertex3 ( 1.0) ( 1.0) (-1.0);
    (* Bottom Face *)
    glNormal3 0.0 (-1.0) 0.0;
    glTexCoord2 1.0 1.0;  glVertex3 (-1.0) (-1.0) (-1.0);
    glTexCoord2 0.0 1.0;  glVertex3 ( 1.0) (-1.0) (-1.0);
    glTexCoord2 0.0 0.0;  glVertex3 ( 1.0) (-1.0) ( 1.0);
    glTexCoord2 1.0 0.0;  glVertex3 (-1.0) (-1.0) ( 1.0);
    (* Right face *)
    glNormal3 1.0 0.0 0.0;
    glTexCoord2 1.0 0.0;  glVertex3 ( 1.0) (-1.0) (-1.0);
    glTexCoord2 1.0 1.0;  glVertex3 ( 1.0) ( 1.0) (-1.0);
    glTexCoord2 0.0 1.0;  glVertex3 ( 1.0) ( 1.0) ( 1.0);
    glTexCoord2 0.0 0.0;  glVertex3 ( 1.0) (-1.0) ( 1.0);
    (* Left Face *)
    glNormal3 (-1.0) 0.0 0.0;
    glTexCoord2 0.0 0.0;  glVertex3 (-1.0) (-1.0) (-1.0);
    glTexCoord2 1.0 0.0;  glVertex3 (-1.0) (-1.0) ( 1.0);
    glTexCoord2 1.0 1.0;  glVertex3 (-1.0) ( 1.0) ( 1.0);
    glTexCoord2 0.0 1.0;  glVertex3 (-1.0) ( 1.0) (-1.0);
  glEnd();

  fXRotation += !fXSpeed;
  fYRotation += !fYSpeed;

  (* since this is double buffered, swap the buffers to display what just got drawn. *)
  glXSwapBuffers dpDisplay dwin;
;;


(* The function called whenever a key is pressed. *)
let keyPressed dpDisplay ~key =

  (* If escape is pressed, kill everything. *)
  match keysym_var key with
  | XK_Escape ->
      xCloseDisplay dpDisplay;

      (* exit the program...normal termination. *)
      exit(0);

  | XK_L
  | XK_l ->
      light := not !light;
      if !light
      then glEnable GL_LIGHTING
      else glDisable GL_LIGHTING;

  | XK_F
  | XK_f ->
      incr filter;
      if (!filter > 2)
      then filter := 0;

  | XK_G
  | XK_g ->
      incr fogfilter;
      if !fogfilter > 2 then
        fogfilter := 0;

      glFog (GL_FOG_MODE fogMode.(!fogfilter));

  | XK_Page_Up ->
      z -= 0.02;

  | XK_Page_Down ->
      z += 0.02;

  | XK_Up ->
      fXSpeed -= 0.01;

  | XK_Down ->
      fXSpeed += 0.01;

  | XK_Left ->
      fYSpeed -= 0.01;

  | XK_Right ->
      fYSpeed += 0.01;

  | _ -> ()
;;


let xMainLoop (dpDisplay, dwin, wmDeleteWindow) iTexture =
  let needRedraw = ref false in

  let event = new_xEvent() in
  while true do
    if xPending dpDisplay > 0 then  (* While more events are pending, continue processing. *)
    begin
      (* Get the current event from the system queue. *)
      xNextEvent dpDisplay event;

      (* Process the incoming event. *)
      begin match xEventType event with
      | Expose ->
          needRedraw := true;

      (* If window moves, redraw it. *)
      | MotionNotify ->
          needRedraw := true;

      (* If a key was pressed, get keystroke and called the processing function. *)
      | KeyPress ->
          let ks = xLookupKeysym (to_xKeyEvent event) 0 in
          keyPressed dpDisplay ks;

      (* If the screen was resized, call the appropriate function. *)
      | ConfigureNotify ->
          let d = xConfigureEvent_datas(to_xConfigureEvent event) in
          reSizeGLScene d.conf_width d.conf_height;

      | ButtonPress ->
          ()

      (* Process any custom messages. *)
      | ClientMessage ->
          if xEvent_xclient_data(to_xClientMessageEvent event) = wmDeleteWindow then
          begin
            xCloseDisplay dpDisplay;
            exit(0);
          end;

      | _ -> ()
      end;
    end;

    (* If redraw flag is set, redraw the window. *)
    (* if !needRedraw then *)
    begin
      drawGLScene dpDisplay dwin iTexture;
    end;
  done;
;;


(* main *)
let () =
  (* Initialize our window. *)
  let xStuff = xInitWindow Sys.argv in

  (* Initialize OpenGL routines *)
  let iTexture = initGL 640 480 in

  (* Start Event Processing Engine *)
  xMainLoop xStuff iTexture;
;;