#! /usr/bin/env ocaml
(* {{{ COPYING *)
(*
 * Copyright (C) 2005 Florent Monnier
 *
 * This is a simple OCaml/openGL image viewer.
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * http://www.fsf.org/licensing/licenses/gpl.html
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not,
 * write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
 *
 * Contact: monnier.florent (Φ) gmail.com
 *
 * }}} *)
(* {{{ compilation *)
(*

ocamlopt unix.cmxa \
      -I +lablGL lablgl.cmxa lablglut.cmxa \
      -I +imageMagick magick.cmxa \
      image-viewer.ml -o glov

)* }}} *)
(* {{{ deps *)

#directory "+lablGL" ;;
#load "lablgl.cma" ;;
#load "lablglut.cma" ;;

#directory "+imageMagick" ;;
#load "magick.cma" ;;

#load "unix.cma" ;;

(* }}} *)

(* {{{ parse arg *)

let verbose = ref false
let fullscreen = ref false
let diaporama  = ref false
let image_name = ref ""
let img_list = ref []

let _ =
  Arg.parse
    [ ( "-v", Arg.Set  verbose,    "verbose" );
      ( "-f", Arg.Set  fullscreen, "fullscreen" );
      ( "-d", Arg.Set  diaporama,  "diaporama" );
      ( "-i", Arg.String (fun i -> image_name := i), "image" ) ]
    (fun img -> img_list := img::!img_list)
    ("Image Viewer")

(* }}} *)
(* {{{ gpl notice *)

let gpl_notice () =
  let program_name = Filename.basename Sys.argv.(0) in

  let user_name =
    try Sys.getenv "USER"
    with Not_found -> ""
  in

  if user_name <> "blue_prawn" then
  Printf.printf "
    %s, Copyright (C) 2005 Florent Monnier
    %s comes with ABSOLUTELY NO WARRANTY. This is free software,
    and you are welcome to redistribute it under the GPL license conditions.\n\n"
  program_name
  program_name ;

  flush_all ()

(* }}} *)

(* {{{ file_exists *)

let file_exists filename =
  if Sys.file_exists filename
  then
    true
  else
    begin
      prerr_endline (Printf.sprintf "Error: file '%s' does not exist" filename);
      false
    end

(* }}} *)
(* {{{ is_readable *)

let is_readable filename =
  try
    ignore(open_in filename);
    true
  with _ ->
    begin
      prerr_endline (Printf.sprintf "Error: file '%s' is not readable" Sys.argv.(1));
      false
    end

(* }}} *)

(* {{{ is_file *)

let is_file filename =
  if Sys.file_exists filename
  then
    begin
      let file_stat = Unix.stat filename in
      match file_stat.Unix.st_kind with
      | Unix.S_REG -> true;
      | _ -> false;
    end
  else
    false

(* }}} *)
(* {{{ is_dir *)

let is_dir dirname =
  if Sys.file_exists dirname
  then
    begin
      let file_stat = Unix.stat dirname in
      match file_stat.Unix.st_kind with
      | Unix.S_DIR -> true;
      | _ -> false;
    end
  else
    false

(* }}} *)

(* {{{ file_get_contents *)

let file_get_contents filename =
  let rec read ic =
    try
      let i = input_line ic in
      i::read ic
    with End_of_file -> []
  in

  let buf = Buffer.create 4096 in

  let lines =
    let ic = open_in filename in
    read ic
  in

  let foreach line =
    Buffer.add_string buf (line ^ "\n")
  in
  List.iter foreach lines ;
  let contents = Buffer.contents buf in
  Buffer.reset buf ;
  contents


(* }}} *)
(* {{{ chan_get_contents *)

let chan_get_contents chan =
  let rec read ic =
    try
      let i = input_line ic in
      i::read ic
    with End_of_file -> []
  in

  let buf = Buffer.create 4096 in

  let lines = read chan
  in
  let foreach line =
    Buffer.add_string buf (line ^ "\n")
  in
  List.iter foreach lines ;

  let contents = Buffer.contents buf in
  Buffer.reset buf ;
  contents


(* }}} *)
(* {{{ round *)

let closest_float f =
  let _floor = floor f in
  let _ceil = ceil f in
  if (f -. _floor) < (_ceil -. f)
  then _floor
  else _ceil


let round f d =
  let decal = 10. ** (float d) in
  let f = closest_float (f *. decal) in
  let f = (f /. decal) in
  f

(* }}} *)

(* {{{ get_closer_size *)

(* returns the closer suitable openGL image size *)

let get_closer_size t_img =
  let w = Magick.Imper.get_image_width  t_img
  and h = Magick.Imper.get_image_height t_img in

  let average = (w + h) / 2 in

  let rec loop dim =
    let curt_dim__average__distance = abs (dim - average)
    and succ_dim__average__distance = abs ((dim * 2) - average)
    in
    if succ_dim__average__distance < curt_dim__average__distance
    then
      loop (dim * 2)
    else
      dim
  in
  let return = loop 2 in

  if !verbose then
    begin
      Printf.printf "\t(width, height) = (%d, %d)\n" w h;
      Printf.printf "\taverage = %d\n" average;
      Printf.printf "\tcloser dim = %d\n" return;
      flush_all();
    end;

  return

(* }}} *)
(* {{{ get_floor_size *)

(* returns the floor suitable openGL image size *)

let get_floor_size t_img =
  let w = Magick.Imper.get_image_width  t_img
  and h = Magick.Imper.get_image_height t_img in

  let average = (w + h) / 2 in

  let rec loop dim =
    if dim > average
    then
      (dim / 2)
    else
      loop (dim * 2)
  in
  let return = loop 2 in

  if !verbose then
    begin
      Printf.printf "\t(width, height) = (%d, %d)\n" w h;
      Printf.printf "\taverage = %d\n" average;
      Printf.printf "\tceil dim = %d\n" return;
      flush_all();
    end;

  return

(* }}} *)
(* {{{ get_ceil_size *)

(* returns the ceil suitable openGL image size *)

let get_ceil_size t_img =
  let w = Magick.Imper.get_image_width  t_img
  and h = Magick.Imper.get_image_height t_img in

  let average = (w + h) / 2 in

  let rec loop dim =
    if dim > average
    then
      dim
    else
      loop (dim * 2)
  in
  let return = loop 2 in

  if !verbose then
    begin
      Printf.printf "\t(width, height) = (%d, %d)\n" w h;
      Printf.printf "\taverage = %d\n" average;
      Printf.printf "\tceil dim = %d\n" return;
      flush_all();
    end;

  return

(* }}} *)

(* {{{ make_image *)

let make_image image_name =
  (*
  (* {{{ test if file exists *)
  if not(Sys.file_exists image_name)
  then
    begin
      prerr_endline (Printf.sprintf "Error: file '%s' does not exist" image_name);
      exit 1;
    end;
  (* }}} *)
  (* {{{ test if file is readable *)
  begin
    try ignore(open_in(image_name))
    with _ ->
      begin
        prerr_endline (Printf.sprintf "Error: file '%s' is not readable" image_name);
        exit 1;
      end
  end;
  (* }}} *)
  *)
  if not (Magick.Imper.ping_image image_name) then
    begin
      prerr_endline (Printf.sprintf "Error: cannot access image '%s'" image_name);
      exit 1;
    end;

  let t_img =
    try
      let _t = Magick.Imper.read_image image_name in
      (*
      Printf.printf "    image %s loaded\n" image_name; flush_all();
      *)
      _t
    with _ ->
      let (width, height, pseudo_format) = (200, 150, "pattern:checkerboard") in
      let _t = Magick.Imper.get_image ~width ~height ~pseudo_format in
      Printf.printf "\tcannot load image %s\n" image_name; flush_all();
      _t
  in

  let image_width  = Magick.Imper.get_image_width t_img
  and image_height = Magick.Imper.get_image_height t_img in

  (*
  ratio <- (float image_width) /. (float image_height);
  *)
  let ratio = (float image_width) /. (float image_height) in

  (*
  let exec_time_start = Unix.gettimeofday () in
  *)

  (*
  let image_size = get_closer_size t_img in
  let image_size = get_ceil_size t_img in
  let image_size = 256 in
  *)
  let image_size = get_floor_size t_img in
  (*
  Magick.Imper.resize t_img image_size image_size Magick.Imper.QuadraticFilter 1.0;
  Magick.Imper.resize t_img image_size image_size Magick.Imper.LanczosFilter 1.0; (* quality resizing (slow) *)
  Magick.Imper.scale t_img image_size image_size;  (* medium resizing *)
  *)
  Magick.Imper.sample t_img image_size image_size;  (* very fast resizing (low quality) *)

  (*
  let exec_time_final = Unix.gettimeofday () in
  let exec_time = exec_time_final -. exec_time_start in
  Printf.printf "  resizing image in %.3fs\n" exec_time; flush_all();
  *)

  let image_width  = image_size
  and image_height = image_size in

  (*
  let pixel_matrix = Magick.Imper.get_raw_without_alpha t_img in

  let gl_image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in
  for i = 0 to image_width - 1 do
    let _pixel_matrix = pixel_matrix.(i) in
    for j = 0 to image_height - 1 do
      let (r, g, b) = _pixel_matrix.(j) in
      Raw.sets (GlPix.to_raw gl_image) ~pos:(3*(i*image_height+j)) [|r/256;g/256;b/256|]
    done
  done;
  *)

  (*
  let pixel_matrix = Magick.Imper.get_raw4 t_img in

  let gl_image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in
  for i = 0 to image_width - 1 do
    for j = 0 to image_height - 1 do
      let (r, g, b) = pixel_matrix.((image_width * j) + i) in
      Raw.sets (GlPix.to_raw gl_image) ~pos:(3*(i*image_height+j)) [|r/256;g/256;b/256|]
    done
  done;
  *)

  (*
  let pixel_matrix = Magick.Imper.get_raw5 t_img in

  let gl_image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in
  for i = 0 to image_width - 1 do
    for j = 0 to image_height - 1 do
      let index = i*image_height+j in
      let (r, g, b) = pixel_matrix.(index) in
      Raw.sets (GlPix.to_raw gl_image) ~pos:(3*index) [|r/256;g/256;b/256|]
    done
  done;
  *)

  (*
  *)
  let exec_time_start = Unix.gettimeofday () in

  let pixel_matrix = Magick.Imper.get_raw_gl_indexed_without_alpha t_img in

  let gl_image = GlPix.create `ubyte ~format:`rgb ~width:image_width ~height:image_height in
  for i = 0 to image_width * image_height - 1 do
      let (r, g, b) = pixel_matrix.(i) in
      Raw.sets (GlPix.to_raw gl_image) ~pos:(3*i) [|r/256;g/256;b/256|]
  done;

  let exec_time_final = Unix.gettimeofday () in
  let exec_time = exec_time_final -. exec_time_start in
  Printf.printf "  transfer = %.4f s\n" exec_time; flush_all();
  (*
  *)

  (gl_image, ratio)

(* }}} *)


(* {{{ image_obj *)

class image_obj image_filename_init =
  object(self)
    (* {{{ Variables *)

    val mutable image_filename = image_filename_init
    val mutable gl_id = (None : GlList.t option)
    val mutable position = (0.0, 0.0, 0.0)
    val mutable rot_y = 0.0
    val mutable x = 2.0
    (*
    val mutable gl_image = (None : GlPix.t (`ubyte, `rgb) option)
    *)
    val mutable tex_id = (None : GlTex.texture_id option)

    (* }}} *)

    (* {{{ display *)

    method display =
      GlMat.push();
        GlMat.translate3 position;
        GlMat.rotate ~angle:rot_y ~y:1.0 ();
        begin
          match gl_id with
          | Some id -> GlList.call id;
          | None -> self#draw;
        end;
      GlMat.pop();

      (*
      Printf.printf "\timg=%s\n" image_filename; flush_all();
      *)

    (* }}} *)
    (* {{{ draw *)

    method private draw =
      (*
      GlTex.image2d gl_image;
      *)
      begin
        match tex_id with
        | Some texid -> GlTex.bind_texture ~target:`texture_2d texid;
        | None -> ();
      end;

      GlDraw.begins `quads;
        GlTex.coord2(1.0, 0.0);  GlDraw.vertex3((-. x), -2.0, 0.0);
        GlTex.coord2(0.0, 0.0);  GlDraw.vertex3((-. x),  2.0, 0.0);
        GlTex.coord2(0.0, 1.0);  GlDraw.vertex3(    x ,  2.0, 0.0);
        GlTex.coord2(1.0, 1.0);  GlDraw.vertex3(    x , -2.0, 0.0);
      GlDraw.ends();

    (* }}} *)
    (* {{{ compile *)

    method compile =
      begin
        match gl_id with
        | Some id -> GlList.delete id;
        | None -> ()
      end;
      let id = GlList.create `compile in
      self#draw;
      GlList.ends();
      gl_id <- Some(id);

    (* }}} *)

    (* {{{ Initializer *)

    initializer

      let (_gl_image, ratio) = make_image image_filename in
      x <- 2.0 *. ratio;
      (*
      gl_image <- _gl_image;
      *)
      let id = GlList.create `compile in
      GlTex.image2d _gl_image;
      self#draw;
      GlList.ends();
      gl_id <- Some(id);
      (*
      *)
      (*
      GlTex.image2d _gl_image;
      let _tex_id = GlTex.gen_texture () in
      tex_id <- Some(_tex_id);
      *)

      GlPix.store (`unpack_alignment 1);
      (*
      GlTex.image2d gl_image;
      *)
      List.iter (GlTex.parameter ~target:`texture_2d)
        [ `wrap_s `clamp;
          `wrap_t `clamp;
          `mag_filter `nearest;
          `min_filter `nearest ];
      (*
      GlTex.parameter ~target:`texture_2d (`mag_filter `linear);
      GlTex.parameter ~target:`texture_2d (`min_filter `linear_mipmap_linear);
      *)
      GlTex.env (`mode `decal);
      Gl.enable `texture_2d;
      GlDraw.shade_model `flat;

    (* }}} *)
  end
(* }}} *)



class image_viewer =
  object(self)
    (* {{{ Variables *)

    val mutable images = ([] : image_obj list)
    (*
    *)
    (* val mutable idle_count = 0 *)

    (* Image change delay for slide show *)
    val mutable ch_delay = 1000 * 2
    (* The timer callback is called every [ch_delay] mili-seconds
       1000 make it called every second. *)

    val mutable ratio = 1.0
    val mutable x = 2.0

    val mutable old_x = 0
    val mutable old_y = 0

    val mutable presse = false

    val mutable tran_x = 0.0
    val mutable tran_y = 0.0
    val mutable tran_z = 0.1

    val mutable tran_factor = 0.3
    val tran_factor_static = 0.02
    val tran_factor_step = 0.9

    val mutable window_width  = 800
    val mutable window_height = 600

    val mutable current_image = 0
    val mutable slide_show = false

    (* }}} *)

    (* {{{ slide_show *)

    method slide_show value =
      slide_show <- value;

    (* }}} *)
    (* {{{ add_image *)

    method add_image img =
      images <- img :: images;
    (*
    *)

    (* }}} *)

    (* {{{ Display *)

    method display_view =
      GlClear.clear [`color;`depth];
      (*
      GlMat.load_identity ();
      *)


      GlMat.push ();
        GlMat.translate3 (tran_x, tran_y, tran_z);

        (*
        GlDraw.begins `quads;
          GlTex.coord2(1.0, 0.0);  GlDraw.vertex3((-. x), -2.0, 0.0);
          GlTex.coord2(0.0, 0.0);  GlDraw.vertex3((-. x),  2.0, 0.0);
          GlTex.coord2(0.0, 1.0);  GlDraw.vertex3(    x ,  2.0, 0.0);
          GlTex.coord2(1.0, 1.0);  GlDraw.vertex3(    x , -2.0, 0.0);
        GlDraw.ends ();
        *)

        (*
        List.iter (fun img -> img#display) images;
        *)
        let c_img = List.nth images current_image in
        c_img#display;

      GlMat.pop ();

      Gl.flush ();
      Glut.swapBuffers ();

    (* }}} *)
    (* {{{ Reshape *)

    method reshape ~w ~h=
      (*
      let _ratio = (float w) /. (float h) in
      GlDraw.viewport 0 0 w h;
      GlMat.mode `projection;
      GlMat.load_identity ();
      GluMat.perspective ~fovy:45.0 ~aspect:_ratio ~z:(0.1, 100.0);
      GlMat.mode `modelview;
      GlMat.load_identity ();
      window_width  <- w;
      window_height <- h;
      *)
      GlDraw.viewport ~x:0 ~y:0 ~w ~h;
      GlMat.mode `projection;
      GlMat.load_identity ();
      GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(0.0001, 80.0);
      GlMat.mode `modelview;
      GlMat.load_identity ();
      GlMat.translate ~z:(-3.6) ();
      window_width  <- w;
      window_height <- h;

    (* }}} *)

    (* {{{ Keyboard *)

    method keyboard ~key ~x ~y =

      Glut.setCursor Glut.CURSOR_NONE;

      match (char_of_int key) with
      | 'q' -> exit 0;
      | 'Q' -> exit 0;

      | '+' -> self#zoom_in;
      | '-' -> self#zoom_out;

      | '6' -> self#grab ~mv_x:4 ~mv_y:0;
      | '4' -> self#grab ~mv_x:(-4) ~mv_y:0;
      | '8' -> self#grab ~mv_x:0 ~mv_y:(-4);
      | '2' -> self#grab ~mv_x:0 ~mv_y:4;

      | 'f' -> Glut.fullScreen ();
      | 'z' -> Gl.enable  `depth_test; Glut.postRedisplay(); print_endline "Gl.enable `depth_test";
      | 'Z' -> Gl.disable `depth_test; Glut.postRedisplay(); print_endline "Gl.disable `depth_test";
      | 'd' -> (* List.iter (fun img -> img#dump) images; *) ();
      (* {{{
      | 'l' -> Gl.polygonMode [`front_and_back; `line]; Glut.postRedisplay();
      }}} *)
      | _ ->
          match key with
          | 27  (* ESC *)    -> exit 0;
          | 17  (* Ctrl+Q *) -> exit 0;
          | 13  (* Return *) -> ();
          (*
          | _ -> print_endline (Printf.sprintf "key %d pressed %c" key (char_of_int key))
          *)
          | _ -> ()

    (* }}} *)
    (* {{{ Special Keys *)

    method special_key ~key ~x ~y =

      Glut.setCursor Glut.CURSOR_NONE;

      match key with
      | Glut.KEY_LEFT      -> self#prev_img;
      | Glut.KEY_RIGHT     -> self#next_img;
      | Glut.KEY_DOWN      -> ();
      | Glut.KEY_UP        -> ();
      | Glut.KEY_PAGE_DOWN -> ();
      | Glut.KEY_PAGE_UP   -> ();
      | Glut.KEY_HOME      -> self#first_img;
      | Glut.KEY_END       -> self#last_img;
      | Glut.KEY_INSERT    -> ();
      | Glut.KEY_F1        -> ();
      | _ -> ();

    (* }}} *)
    (* {{{ Next Prev *)

    method private prev_img =
      (*
      current_image <- max (current_image - 1) 0;
      *)

      current_image <- current_image - 1;

      if current_image < 0
      then current_image <- ((List.length images) - 1);

      Glut.postRedisplay ();


    method private next_img =
      (*
      current_image <- min (current_image + 1) ((List.length images) - 1);
      *)

      current_image <- current_image + 1;

      if current_image > ((List.length images) - 1)
      then current_image <- 0;

      Glut.postRedisplay ();


    method private first_img =
      current_image <- 0;
      Glut.postRedisplay ();

    method private last_img =
      current_image <- ((List.length images) - 1);
      Glut.postRedisplay ();

    (* }}} *)

    (* {{{ Zoom *)

    method zoom_in =
      if tran_z < 2.8 then
        begin
          tran_z <- tran_z +. 0.4;
          (* Printf.printf "\tz=%f\n" tran_z; flush_all(); *)
          tran_factor <- tran_factor *. tran_factor_step;
          Glut.postRedisplay ();
        end

    method zoom_out =
      tran_z <- tran_z -. 0.4;
      tran_factor <- tran_factor /. tran_factor_step;
      Glut.postRedisplay ();

    (* }}} *)
    (* {{{ Mouse *)

    method mouse ~button ~state ~x ~y =

      match button, state with
        | Glut.LEFT_BUTTON,    Glut.DOWN -> self#next_img;
        | Glut.LEFT_BUTTON,    Glut.UP   -> Glut.setCursor Glut.CURSOR_NONE;
        | Glut.RIGHT_BUTTON,   Glut.DOWN -> self#prev_img;
        | Glut.RIGHT_BUTTON,   Glut.UP   -> Glut.setCursor Glut.CURSOR_NONE;
        | Glut.MIDDLE_BUTTON,  Glut.DOWN -> Glut.setCursor Glut.CURSOR_INHERIT; presse <- true; old_x <- x; old_y <- y;
        | Glut.MIDDLE_BUTTON,  Glut.UP   -> Glut.setCursor Glut.CURSOR_NONE; presse <- false;
        | Glut.OTHER_BUTTON a, Glut.DOWN -> begin match a with 3 -> self#zoom_in | 4 -> self#zoom_out | _ -> () end;
        | Glut.OTHER_BUTTON a, Glut.UP   -> ();

    (* }}} *)
    (* {{{ Motion *)

    method motion ~x ~y =
      if presse then
        begin
          (*
          Printf.printf "\tx y old_x old_y = %d %d %d %d\n" x y old_x old_y; flush_all();
          *)
          self#grab (x - old_x) (y - old_y);
          (*
          Printf.printf "\ttran_x tran_y = %f %f\n" tran_x tran_y; flush_all();
          *)
        end;

      old_x <- x;
      old_y <- y;
      (*
      Printf.printf "."; flush_all();
      *)

    method private grab ~mv_x ~mv_y =
      tran_x <- tran_x +. ((float mv_x) *. tran_factor_static *. tran_factor);
      tran_y <- tran_y -. ((float mv_y) *. tran_factor_static *. tran_factor);
      Glut.postRedisplay ();

    (* }}} *)
    (* {{{ Passive *)

    method passive ~x ~y =
      Glut.setCursor Glut.CURSOR_INHERIT;

      Glut.timerFunc ~ms:800 ~cb:(fun ~value -> self#hide_cursor ~value) ~value:0 ;

    (* }}} *)

    (* {{{ Idle *

    method idle =
      idle_count <- succ idle_count

    * }}} *)
    (* {{{ Timer *)

    method timer ~value =
      if slide_show then
        begin
          (*
          List.iter (fun img -> img#rotate 5.0) images;
          *)

          Printf.printf " dia T=%d\n" value; flush_all();
          self#next_img;

          Glut.postRedisplay();
          (*
          Glut.timerFunc ~ms:ch_delay ~cb:(fun ~value -> self#timer ~value) ~value:0;
          *)
          Glut.timerFunc ~ms:ch_delay ~cb:(fun ~value -> self#timer ~value) ~value:(succ value);
        end

    (* }}} *)
    (* {{{ Hide Cursor *)

    method hide_cursor ~value =

      Glut.setCursor Glut.CURSOR_NONE;

    (* }}} *)

    (* {{{ Initializer *)

    initializer
      (* Glut initialisation *)
      ignore(Glut.init Sys.argv);

      (* Display parameters *)
      Glut.initDisplayMode ~alpha:true ~depth:true ~double_buffer:true ();
      (* Glut.initDisplayMode ~alpha:true ~depth:true (); *)

      (* Size and position of the window *)
      if not !fullscreen then
        begin
          Glut.initWindowSize ~w:window_width ~h:window_height;
          Glut.initWindowPosition ~x:0 ~y:18;
        end;

      let window_title = Filename.basename Sys.argv.(0) in
      ignore(Glut.createWindow ~title:window_title);  (* Creation of the window *)

      (* {{{ inits *)

      (*
      GlDraw.shade_model `smooth;
      GlClear.depth 1.0;
      GlFunc.depth_func `lequal;
      GlMisc.hint `perspective_correction `nicest;
      *)
      GlClear.color (0.0, 0.0, 0.0);
      Gl.enable `depth_test;
      GlFunc.depth_func `less;

      (*
      let gl_image = self#make_image Sys.argv.(1) in
      *)
      (*
      let (gl_image, _ratio) = make_image Sys.argv.(1) in
      ratio <- _ratio;
      x <- 2.0 *. ratio;
      *)

      GlPix.store (`unpack_alignment 1);
      (*
      GlTex.image2d gl_image;
      *)
      List.iter (GlTex.parameter ~target:`texture_2d)
        [ `wrap_s `clamp;
          `wrap_t `clamp;
          `mag_filter `nearest;
          `min_filter `nearest ];
      GlTex.env (`mode `decal);
      Gl.enable `texture_2d;
      GlDraw.shade_model `flat;

      (* }}} *)
      (* {{{ Callbacks *)

      Glut.displayFunc (fun () -> self#display_view);
      Glut.reshapeFunc (fun ~w ~h -> self#reshape ~w ~h);

      Glut.keyboardFunc (fun ~key ~x ~y -> self#keyboard ~key ~x ~y);
      Glut.specialFunc (fun ~key ~x ~y -> self#special_key ~key ~x ~y);

      Glut.mouseFunc (fun ~button ~state ~x ~y -> self#mouse ~button ~state ~x ~y);
      Glut.motionFunc (fun ~x ~y -> self#motion ~x ~y);
      Glut.passiveMotionFunc (fun ~x ~y -> self#passive ~x ~y);

      Glut.timerFunc ~ms:ch_delay ~cb:(fun ~value -> self#timer ~value) ~value:0 ;
      (*
      Glut.idleFunc (Some (fun () -> self#idle));
      *)

      (* }}} *)

    (* }}} *)
  end


(* {{{ main *)

let _ =
  gpl_notice ();
  let sc = new image_viewer in

  (* {{{ load image file names *)

  let load_image filename =
    try
      (*if is_file filename then*)
      if Magick.Imper.ping_image filename then
        begin
          let img = new image_obj filename in
          sc#add_image img
        end
    with _ -> ()
  in
  if (Array.length Sys.argv) > 1
  then
    for f = 1 to ((Array.length Sys.argv) -1)
    do
      load_image Sys.argv.(f);
    done;

  (* }}} *)

  if !fullscreen then
    Glut.fullScreen();

  if !diaporama then
    sc#slide_show true;

  GluMat.perspective ~fovy:60.0 ~aspect:(1.0 *. float 800 /. float 600) ~z:(0.0001, 80.0);

  Glut.postRedisplay();
  Glut.mainLoop();

(* }}} *)

(*  vim:cindent sw=2 ts=2 sts=2 et fdm=marker
 *)