Draw.ml

type floatPointType = {x: float, y: float};

type intPointType = {x: int, y: int};

type wCoordType =
  | WCoord floatPointType;

type gCoordType =
  | GCoord intPointType;

type gameStateType = {
  mutable drawables: list intPointType
};

let module Color = {
  let black = (0., 0., 0.);
  let yellow = (0.97, 0.7, 0.);
};

let windowSize = 800;

let windowSizef = float_of_int windowSize;

let toWorldCoord (WCoord {x, y}) => (
  x /. (windowSizef /. 2.) -. 1.,
  y /. (windowSizef /. 2.) -. 1.
);

let drawRect width::width height::height color::color position::(GCoord {x, y}) => {
  GlDraw.begins `quads;
  GlDraw.color color;
  let bottomLeft = WCoord {x: float_of_int x, y: float_of_int y};
  let topLeft = WCoord {x: float_of_int x, y: float_of_int @@ y + height};
  let topRight = WCoord {x: float_of_int @@ x + width, y: float_of_int @@ y + height};
  let bottomRight = WCoord {x: float_of_int @@ x + width, y: float_of_int y};
  List.iter GlDraw.vertex2 (List.map toWorldCoord [bottomLeft, topLeft, topRight, bottomRight]);
  GlDraw.ends ();
};

let draw gameState::gameState x::x y::y => {
  let mousePos = {x, y: windowSize - y};
  gameState.drawables = [
    {x: mousePos.x, y: mousePos.y},
    ...gameState.drawables
  ];
};

let drawPoint ({x, y}) => {
  drawRect
    width::20
    height::20
    color::Color.yellow
    position::(GCoord {x, y});
};

let render gameState::gameState () => {
  GlClear.clear [`color];
  GlMat.load_identity ();
  drawRect
    width::(windowSize)
    height::(windowSize)
    color::Color.black
    position::(GCoord {x: 0, y: 0});
  List.iter drawPoint gameState.drawables;
  Glut.swapBuffers ()
};

let () = {
  ignore @@ Glut.init Sys.argv;
  Glut.initWindowSize windowSize windowSize;
  Glut.initDisplayMode double_buffer::true ();
  ignore @@ Glut.createWindow title::"Reason Draw";
  let gameState = {drawables: []};
  GlMat.mode `modelview;
  Glut.motionFunc (draw gameState::gameState);
  Glut.displayFunc (render gameState::gameState);
  Glut.idleFunc cb::(Some Glut.postRedisplay);
  Glut.mainLoop ();
};