open Tsdl;
open Tgl4;
open Result;

/* the bind operator for the exception monad, for quick error
handling */
let (>>=) = (x, f) => switch x {
  | Ok(v) => f(v)
  | Error(e) => Error(e)
};

/* our vertex shader takes a 2d position and renders it on the screen,
and that's it */
let vertex_shader =
  "#version 130
in vec2 position;
void main() {
  gl_Position = vec4(position, 0.0, 1.0);
}
";

/* our fragment shader just draws white */
let fragment_shader =
  "#version 130
out vec4 out_color;
void main() {
  out_color = vec4(1.0, 1.0, 1.0, 1.0);
}
";

/* we use a lot of Bigarrays, which are contiguous chunks of memory
that we can hand off to C */
let bigarray_create = (k, len) => Bigarray.(Array1.create(k, c_layout, len));

/* our vertex data is [0.0, 0.5, 0.5, -0.5, -0.5, -0.5], but in a
contiguous array of memory */
let vertices = {
  open Bigarray.Array1;
  let arr = bigarray_create(Bigarray.float32, 6);
  set(arr, 0, 0.0);
  set(arr, 1, 0.5);
  set(arr, 2, 0.5);
  set(arr, 3, -0.5);
  set(arr, 4, -0.5);
  set(arr, 5, -0.5);
  arr
};

/* This takes a function which expects to fill a buffer with a single
32-bit integer; this will call that function and then conver it to an
OCaml integer */
let buf_to_int = (f) => {
  let a = bigarray_create(Bigarray.int32, 1);
  f(a);
  Int32.to_int (Bigarray.Array1.get(a, 0))
};

/* This takes a function that expects to use a buffer containing a
   single 32-bit integer as well as an integer itself; this will
   convert the integer into a buffer and then call the function on
   it */
let int_as_buf = (f, i) => {
  let a = bigarray_create(Bigarray.int32, 1);
  Bigarray.Array1.set(a, 0, Int32.of_int(i));
  f(a)
};

/* Like buf_to_int, but for an arbitrary-sized string */
let get_string = (len, f) => {
  let a = bigarray_create(Bigarray.char, len);
  f(a);
  Gl.string_of_bigarray(a)
};



/* The first thing to do is to get a new window from SDL and then
initialize an OpenGL context in that window. */
let window = () => {
  Sdl.init(Sdl.Init.video) >>= () =>
  Sdl.create_window(~w=640, ~h=480, "test", Sdl.Window.opengl) >>= (w) =>
  Sdl.gl_create_context(w) >>= (ctx) =>
  Sdl.gl_make_current(w, ctx) >>= () =>
    Ok((w, ctx))
};

/* This compiles a shader, producing an informative error message if
the compilation process fails. */
let compile_shader = (typ, src) => {
  let shader = Gl.create_shader(typ);
  Gl.shader_source(shader, src);
  Gl.compile_shader(shader);
  if (buf_to_int(Gl.get_shaderiv(shader, Gl.compile_status)) == Gl.true_) {
    Ok(shader)
  } else {
    let len = buf_to_int(Gl.get_shaderiv(shader, Gl.info_log_length));
    let log = get_string(len, (Gl.get_shader_info_log(shader, len, None)));
    Gl.delete_shader(shader);
    Error(`Msg(log))
  }
};

/* This links our two shaders together into a single OpenGL program,
again producing an informative error message if it fails. */
let create_program = () => {
  compile_shader(Gl.vertex_shader, vertex_shader) >>= (vertex) =>
  compile_shader(Gl.fragment_shader, fragment_shader) >>= (fragment) => {
    let program = Gl.create_program();
    Gl.attach_shader(program, vertex);
    Gl.attach_shader(program, fragment);
    Gl.link_program(program);
    if (buf_to_int(Gl.get_programiv(program, Gl.link_status)) == Gl.true_) {
      Ok(program)
    } else {
      let len = buf_to_int(Gl.get_programiv(program, Gl.info_log_length));
      let log = get_string(len, (Gl.get_program_info_log(program, len, None)));
      Gl.delete_program(program);
      Error(`Msg(log))
    }
  }
};


/* This initializes a vertex array and a vertex buffer using our
vertex information above. */
let init_scene = (program) => {
  let array = buf_to_int(Gl.gen_vertex_arrays(1));
  Gl.bind_vertex_array(array);

  let buffer = buf_to_int(Gl.gen_buffers(1));
  Gl.bind_buffer(Gl.array_buffer, buffer);
  Gl.buffer_data(
    Gl.array_buffer,
    Gl.bigarray_byte_size(vertices),
    Some(vertices),
    Gl.static_draw
  );

  /* This bit is first telling OpenGL where our fragment data can be
  found */
  Gl.bind_frag_data_location(program, 0, "out_color");
  /* and then asking it the location of the position attribute */
  let pos_attr = Gl.get_attrib_location(program, "position");
  /* and finally telling OpenGL that the stuff in our vertex buffer
  corresponds to the aforementioned "position" attribute */
  Gl.enable_vertex_attrib_array(pos_attr);
  /* and tells OpenGL that it consists of two floats with no stride
  and no offset. */
  Gl.vertex_attrib_pointer(pos_attr, 2, Gl.float, false, 0, `Offset(0));

  /* We return these for later use! */
  (array, buffer)
};


let draw = (program, buffer, w) => {
  /* we clear the background color to a pleasing robin's-egg blue */
  Gl.clear_color(0.3, 0.6, 0.9, 1.0);
  Gl.clear(Gl.color_buffer_bit);

  /* we tell OpenGL we want to use that program we made earlier, and
  the array buffer we created earlier, too */
  Gl.use_program(program);
  Gl.bind_buffer(Gl.array_buffer, buffer);
  /* and tell it to draw the first 3 things in that array buffer as
  triangles */
  Gl.draw_arrays(Gl.triangles, 0, 3);
  /* and then clear that shit out. (We can skip this step, to be fair,
  but it's good to get in the habit for later.) */
  Gl.bind_buffer(Gl.array_buffer, 0);
  Gl.use_program(0);

  /* and finally swap the window! */
  Sdl.gl_swap_window(w)
};


/* The drawing function here is of type () -> () so we can pass in a
closure and not have to pass other data down the chain */
let event_loop = (draw, w) => {
  let e = Sdl.Event.create();
  /* these helper functions are just to reduce the verbosity down
  below */
  let keycode = (e) => Sdl.Scancode.enum(Sdl.Event.(get(e, keyboard_scancode)));
  let event = (e) => Sdl.Event.(enum (get(e, typ)));
  /* the crunchy center is a loop that draws and then dispatches on
  the relevant events */
  let rec loop = () => {
    draw ();
    Sdl.wait_event(Some(e)) >>= () =>
    switch (event(e)) {
    | `Quit => Ok ()
    | `Key_down when keycode(e) == `Escape => Ok ()
    | `Key_down when keycode(e) == `Q => Ok ()
    | _ => loop ()
    }
  };
  loop ()
};


/* and the main function! */
let main = () => {
  /* create the window */
  window () >>= ((w, ctx)) =>
  /* create the program */
  create_program () >>= (program) => {
    /* create the vertex data */
    let (array, buffer) = init_scene(program);
    /* run the event loop with the relevant drawing function */
    event_loop(() => draw(program,array, w), w) >>= () => {
      /* and clean it all up! */
      int_as_buf(Gl.delete_vertex_arrays(1), array);
      int_as_buf(Gl.delete_buffers(1), buffer);
      Gl.delete_program(program);
      Sdl.gl_delete_context(ctx);
      Sdl.destroy_window(w);
      Sdl.quit();
      /* s'all good yo */
      Ok()
    }
  }
};

/* and, at the top-level, run it and print any error messages we
get. */
switch (main()) {
  | Ok() => ()
  | Error(`Msg(e)) => {
      Sdl.log("%s", e);
      exit(1)
    };
};