(* Copyright (c) 1993-1997, Silicon Graphics, Inc.
 * ALL RIGHTS RESERVED 
 * Permission to use, copy, modify, and distribute this software for 
 * any purpose and without fee is hereby granted, provided that the above
 * copyright notice appear in all copies and that both the copyright notice
 * and this permission notice appear in supporting documentation, and that 
 * the name of Silicon Graphics, Inc. not be used in advertising
 * or publicity pertaining to distribution of the software without specific,
 * written prior permission. 
 *
 * THE MATERIAL EMBODIED ON THIS SOFTWARE IS PROVIDED TO YOU "AS-IS"
 * AND WITHOUT WARRANTY OF ANY KIND, EXPRESS, IMPLIED OR OTHERWISE,
 * INCLUDING WITHOUT LIMITATION, ANY WARRANTY OF MERCHANTABILITY OR
 * FITNESS FOR A PARTICULAR PURPOSE.  IN NO EVENT SHALL SILICON
 * GRAPHICS, INC.  BE LIABLE TO YOU OR ANYONE ELSE FOR ANY DIRECT,
 * SPECIAL, INCIDENTAL, INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY
 * KIND, OR ANY DAMAGES WHATSOEVER, INCLUDING WITHOUT LIMITATION,
 * LOSS OF PROFIT, LOSS OF USE, SAVINGS OR REVENUE, OR THE CLAIMS OF
 * THIRD PARTIES, WHETHER OR NOT SILICON GRAPHICS, INC.  HAS BEEN
 * ADVISED OF THE POSSIBILITY OF SUCH LOSS, HOWEVER CAUSED AND ON
 * ANY THEORY OF LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE
 * POSSESSION, USE OR PERFORMANCE OF THIS SOFTWARE.
 * 
 * US Government Users Restricted Rights 
 * Use, duplication, or disclosure by the Government is subject to
 * restrictions set forth in FAR 52.227.19(c)(2) or subparagraph
 * (c)(1)(ii) of the Rights in Technical Data and Computer Software
 * clause at DFARS 252.227-7013 and/or in similar or successor
 * clauses in the FAR or the DOD or NASA FAR Supplement.
 * Unpublished-- rights reserved under the copyright laws of the
 * United States.  Contractor/manufacturer is Silicon Graphics,
 * Inc., 2011 N.  Shoreline Blvd., Mountain View, CA 94039-7311.
 *
 * OpenGL(R) is a registered trademark of Silicon Graphics, Inc.
 *)

(*  font.ml
 *
 *  Draws some text in a bitmapped font.  Uses glBitmap() 
 *  and other pixel routines.  Also demonstrates use of 
 *  display lists.
 *)
open GL
open Glu
open Glut

let space =
  Bigarray.Array1.of_array Bigarray.int8_unsigned Bigarray.c_layout
    [| 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00; 0x00 |]

let _letters = [|
    [| 0x00; 0x00; 0xc3; 0xc3; 0xc3; 0xc3; 0xff; 0xc3; 0xc3; 0xc3; 0x66; 0x3c; 0x18 |]; 
    [| 0x00; 0x00; 0xfe; 0xc7; 0xc3; 0xc3; 0xc7; 0xfe; 0xc7; 0xc3; 0xc3; 0xc7; 0xfe |]; 
    [| 0x00; 0x00; 0x7e; 0xe7; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xe7; 0x7e |]; 
    [| 0x00; 0x00; 0xfc; 0xce; 0xc7; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc7; 0xce; 0xfc |]; 
    [| 0x00; 0x00; 0xff; 0xc0; 0xc0; 0xc0; 0xc0; 0xfc; 0xc0; 0xc0; 0xc0; 0xc0; 0xff |]; 
    [| 0x00; 0x00; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xfc; 0xc0; 0xc0; 0xc0; 0xff |]; 
    [| 0x00; 0x00; 0x7e; 0xe7; 0xc3; 0xc3; 0xcf; 0xc0; 0xc0; 0xc0; 0xc0; 0xe7; 0x7e |]; 
    [| 0x00; 0x00; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xff; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3 |]; 
    [| 0x00; 0x00; 0x7e; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x7e |]; 
    [| 0x00; 0x00; 0x7c; 0xee; 0xc6; 0x06; 0x06; 0x06; 0x06; 0x06; 0x06; 0x06; 0x06 |]; 
    [| 0x00; 0x00; 0xc3; 0xc6; 0xcc; 0xd8; 0xf0; 0xe0; 0xf0; 0xd8; 0xcc; 0xc6; 0xc3 |]; 
    [| 0x00; 0x00; 0xff; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0 |]; 
    [| 0x00; 0x00; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xdb; 0xff; 0xff; 0xe7; 0xc3 |]; 
    [| 0x00; 0x00; 0xc7; 0xc7; 0xcf; 0xcf; 0xdf; 0xdb; 0xfb; 0xf3; 0xf3; 0xe3; 0xe3 |]; 
    [| 0x00; 0x00; 0x7e; 0xe7; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xe7; 0x7e |]; 
    [| 0x00; 0x00; 0xc0; 0xc0; 0xc0; 0xc0; 0xc0; 0xfe; 0xc7; 0xc3; 0xc3; 0xc7; 0xfe |]; 
    [| 0x00; 0x00; 0x3f; 0x6e; 0xdf; 0xdb; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0x66; 0x3c |]; 
    [| 0x00; 0x00; 0xc3; 0xc6; 0xcc; 0xd8; 0xf0; 0xfe; 0xc7; 0xc3; 0xc3; 0xc7; 0xfe |]; 
    [| 0x00; 0x00; 0x7e; 0xe7; 0x03; 0x03; 0x07; 0x7e; 0xe0; 0xc0; 0xc0; 0xe7; 0x7e |]; 
    [| 0x00; 0x00; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0xff |]; 
    [| 0x00; 0x00; 0x7e; 0xe7; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3 |]; 
    [| 0x00; 0x00; 0x18; 0x3c; 0x3c; 0x66; 0x66; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3 |]; 
    [| 0x00; 0x00; 0xc3; 0xe7; 0xff; 0xff; 0xdb; 0xdb; 0xc3; 0xc3; 0xc3; 0xc3; 0xc3 |]; 
    [| 0x00; 0x00; 0xc3; 0x66; 0x66; 0x3c; 0x3c; 0x18; 0x3c; 0x3c; 0x66; 0x66; 0xc3 |]; 
    [| 0x00; 0x00; 0x18; 0x18; 0x18; 0x18; 0x18; 0x18; 0x3c; 0x3c; 0x66; 0x66; 0xc3 |]; 
    [| 0x00; 0x00; 0xff; 0xc0; 0xc0; 0x60; 0x30; 0x7e; 0x0c; 0x06; 0x03; 0x03; 0xff |];
  |]

let letters = Array.map (Bigarray.Array1.of_array Bigarray.int8_unsigned Bigarray.c_layout) _letters

let fontOffset = ref 0


let makeRasterFont() =
  glPixelStorei GL_UNPACK_ALIGNMENT 1;

  fontOffset := glGenLists 128;
  let j = ref(int_of_char 'A') in
  for i = 0 to pred 26 do
    glNewList (!fontOffset + !j) GL_COMPILE;
    glBitmap 8 13 0.0 2.0 10.0 0.0 letters.(i);
    glEndList();
    incr j;
  done;
  glNewList (!fontOffset + (int_of_char ' ')) GL_COMPILE;
  glBitmap 8 13 0.0 2.0 10.0 0.0 space;
  glEndList();
;;

let init() =
  glShadeModel GL_FLAT;
  makeRasterFont();
;;

(* convert a string to a char array *)
let explode s =
  Array.init (String.length s) (fun i -> s.[i])
;;

let printString ~s =
  glPushAttrib [Attrib.GL_LIST_BIT];
  glListBase !fontOffset;
  let s = explode s in
  glCallLists (Array.map (fun s -> int_of_char s) s);
  glPopAttrib ();
;;

(* Everything above this line could be in a library 
 * that defines a font.  To make it work, you've got 
 * to call makeRasterFont() before you start making 
 * calls to printString().
 *)
let display() =
  let white = (1.0, 1.0, 1.0) in

  glClear [GL_COLOR_BUFFER_BIT];
  glColor3v white;

  glRasterPos2i 20 60;
  printString "THE QUICK BROWN FOX JUMPS";
  glRasterPos2i 20 40;
  printString "OVER A LAZY DOG";
  glFlush ();
;;

let reshape ~width:w ~height:h =
  glViewport 0 0 w h;
  glMatrixMode GL_PROJECTION;
  glLoadIdentity();
  glOrtho 0.0 (float w) 0.0 (float h) (-1.0) (1.0);
  glMatrixMode GL_MODELVIEW;
;;

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

(*  Main Loop
 *  Open window with initial window size, title bar, 
 *  RGBA display mode, and handle input events.
 *)
let () =
  let _ = glutInit Sys.argv in
  glutInitDisplayMode [GLUT_SINGLE; GLUT_RGB];
  glutInitWindowSize 300 100;
  glutInitWindowPosition 100 100;
  let _ = glutCreateWindow Sys.argv.(0) in
  init();
  glutReshapeFunc ~reshape;
  glutKeyboardFunc ~keyboard;
  glutDisplayFunc ~display;
  glutMainLoop();
;;