How to make an HTML5-Canvas game with OCaml

With a platformer game example

You can compile OCaml code to Javascript using the rescript compiler version 8.4.2.
It implements an OCaml 4.06.1 syntax.

It's planned that rescript removes the ocaml syntax in future versions, but don't worry you will always be able to use rescript 8.4.2, it will not disappear and this version is already mature enough to do everything you want with it.
Also maybe a fork will emerge when the ocaml syntax will be removed.

Let's start with a very simple example that just draws a rectangle in a canvas:

draw.ml

open Canvas

let () =
  let canvas = getElementById document "my_canvas" in
  let ctx = getContext canvas "2d" in

  fillStyle ctx "#DDD";
  fillRect ctx 180 100 240 200;
;;

'draw.ml' just draws a rectangle with ocaml.

canvas.res

type document  // abstract type for a document object
type context

@val external document: document = "document"
@val external window: Dom.element = "window"

@send external getElementById: (document, string) => Dom.element = "getElementById"
@send external getContext: (Dom.element, string) => context = "getContext"

@send external fillRect: (context, int, int, int, int) => unit = "fillRect"
@set external fillStyle: (context, string) => unit = "fillStyle"

'canvas.res' contains bindings to the javascript functions that we need.

Here are the commands to compile these 2 files:

bsc canvas.res
bsc -I . draw.ml > draw.js

The Javascript output is very readable, which is great for debugging:

Result: draw.js

// Generated by ReScript, PLEASE EDIT WITH CARE
'use strict';

var canvas = document.getElementById("my_canvas");

var ctx = canvas.getContext("2d");

ctx.fillStyle = "#DDD";
ctx.fillRect(180, 100, 240, 200);

/* canvas Not a pure module */

You can include this javascript file in an HTML file containing a canvas tag:

draw.html

<!DOCTYPE html>
<html>
<head>
<style rel="stylesheet" type="text/css">
body {
  background-color:#999;
}
canvas {
  background-color:#BBB;
  border:1px solid #666;
  margin:80px;
}
</style>
</head>
<body>

<canvas id="my_canvas" width="600" height="400">
</canvas>

<script>var exports = {};</script>
<script type="text/javascript" src="./draw.js"></script>

</body>
</html>

Now let's try to make a simple platformer game:

platformer.ml


module Rect : sig
  type t = {
    x: int;
    y: int;
    w: int;
    h: int;
  }

  val make1 : int * int * int * int -> t
  val make2 : pos:int * int -> dims:int * int -> t
  val make4 : int -> int -> int -> int -> t

  val has_intersection : t -> t -> bool

end = struct

  type t = {
    x: int;
    y: int;
    w: int;
    h: int;
  }

  let make1 (x, y, w, h) =
    { x; y; w; h }

  let make2 ~pos:(x, y) ~dims:(w, h) =
    { x; y; w; h }

  let make4 x y w h =
    { x; y; w; h }

  let has_intersection a b =

    (* Horizontal intersection *)
    let a_min = a.x in
    let a_max = a_min + a.w in
    let b_min = b.x in
    let b_max = b_min + b.w in

    let a_min = if (b_min > a_min) then b_min else a_min in
    let a_max = if (b_max < a_max) then b_max else a_max in

    if (a_max <= a_min) then false else

    (* Vertical intersection *)
    let a_min = a.y in
    let a_max = a_min + a.h in
    let b_min = b.y in
    let b_max = b_min + b.h in

    let a_min = if (b_min > a_min) then b_min else a_min in
    let a_max = if (b_max < a_max) then b_max else a_max in

    if (a_max <= a_min) then (false) else

    (true)
  ;;
end



let width, height = (320, 240)

type pos = int * int

type player_dir = {
  left: bool;
  right: bool;
  up: bool;
  down: bool;
}

type game_state = {
  pos: pos;   (* player position *)
  dir: player_dir;
  blocks: pos list;
  y_velocity: int;
}


type key_change = KeyDown | KeyUp


let canvas = Canvas.getElementById Canvas.document "my_canvas"
let ctx = Canvas.getContext canvas "2d"


let red   = "#F00"
let green = "#0F0"
let blue  = "#00F"
let black = "#000"


let fill_rect color (x, y) =
  Canvas.fillStyle ctx color;
  Canvas.fillRect ctx x y 20 20;
  ()
;;


let display_game state =
  let bg_color, blocks_color, player_color =
    (black, blue, red)
  in
  (* background *)
  Canvas.fillStyle ctx bg_color;
  Canvas.fillRect ctx 0 0 width height;

  (* player *)
  fill_rect player_color state.pos;

  (* level blocks *)
  List.iter (fill_rect blocks_color) state.blocks;
  ()
;;



let update_state {
    pos; dir; blocks;
    y_velocity;
  } =

  let r_blocks =
    List.map (fun pos ->
      Rect.make2 ~pos ~dims:(20, 20)
    ) blocks
  in

  let x, y = pos in

  let y_velocity =
    if dir.up then (y_velocity - 14) else  (* gravity *)
    (y_velocity)
  in

  let y_dest = (y + y_velocity) in

  let next =
    if y_velocity > 0 then succ else pred
  in

  (* iter every pixel until the requested destination
   * and check if the player collides with a level block
   *)
  let rec y_loop y =
    if y = y_dest then (y, y_velocity) else
    let y_prev = y in
    let y = next y in
    let player = Rect.make2 ~pos:(x, y) ~dims:(20, 20) in
    let has_intersection =
      List.fold_left (fun res r_block ->
        res || Rect.has_intersection player r_block
      ) false r_blocks
    in
    if has_intersection
    then (y_prev, 0)
    else y_loop y
  in
  let y, y_velocity = y_loop y in

  let x_prev = x in
  let x =
    if dir.left  then (x - 4) else
    if dir.right then (x + 4) else
    (x)
  in

  let player = Rect.make2 ~pos:(x, y) ~dims:(20, 20) in

  let has_intersection =
    List.fold_left (fun res r_block ->
      res || Rect.has_intersection player r_block
    ) false r_blocks
  in
  let x = if has_intersection then x_prev else x in

  let y_velocity = y_velocity + 1 in

  let pos =
    if y > 260
    then (80, 120)
    else (x, y)
  in

  let dir =
    if dir.up then { dir with up = false } else dir
  in

  {
    pos;
    dir;
    blocks;
    y_velocity;
  }



let () =
  let initial_state = {
    pos = (80, 140);
    blocks = [
      (  0, 200);
      ( 20, 200);
      ( 40, 200);
      ( 60, 180);

      ( 40, 160);
      ( 60, 160);
      ( 80, 160);
      (100, 160);
      (120, 100);
      (140, 120);

      (120, 200);
      (140, 220);
      (160, 220);
      (180, 220);
      (200, 220);
      (220, 220);
      (240, 220);
      (260, 220);
      (280, 220);
      (300, 200);
    ];
    y_velocity = 0;
    dir = {
      left = false;
      right = false;
      up = false;
      down = false;
    };
  } in

  let state = ref initial_state in

  let keychange_event key_change ev =
    let dir = !state.dir in
    let dir =
      match key_change, ev.Canvas.keyCode with
      | KeyDown, 37 -> { dir with left = true }   (* Left *)
      | KeyDown, 39 -> { dir with right = true }  (* Right *)
      | KeyDown, 38 -> { dir with up = true }     (* Up *)
      | KeyDown, 40 -> { dir with down = true }   (* Down *)

      | KeyUp, 37 -> { dir with left = false }    (* Left *)
      | KeyUp, 39 -> { dir with right = false }   (* Right *)
      | KeyUp, 38 -> { dir with up = false }      (* Up *)
      | KeyUp, 40 -> { dir with down = false }    (* Down *)

      | _ -> dir
    in
    state := { !state with dir }
  in

  let animate () =
    state := update_state !state;
    display_game !state;
    ()
  in

  Canvas.addKeyEventListener Canvas.window "keydown" (keychange_event KeyDown) true;
  Canvas.addKeyEventListener Canvas.window "keyup"   (keychange_event KeyUp) true;

  let _ = Canvas.setInterval animate (1000/18) in
  ()
;;

Here the calculation of x is made in a very simple way because the size of a block is a multiple of the x increment (20 and 4). If it's not the case you have to make a similar loop for x than what is done with y (y_loop).

Add some more bindings in 'canvas.res':

canvas.res


type key_event = {
  keyCode: int,
  key: string,
}

@send external addKeyEventListener: (Dom.element, string, key_event => unit, bool) => unit = "addEventListener"

type intervalID

@val external setInterval: (unit => unit, int) => intervalID = "setInterval"

Compile:

bsc canvas.res
bsc -I . platformer.ml > platformer.js
sed -i -e 's!.*require.*!!g' platformer.js

Here I replace all the 'requires' from the beginning of 'platformer.js' by 'caml-platform.js' included in the HTML page.
This file groups in a single file the javascript implementations of the usual ocaml functions that are located in 'bs-platform/lib/js/' from the rescript system.

It's possible to use a javascript bundler like 'esbuild' but the result is then not very readable anymore, and it also packs everything into a closed function which make it impossible to have interaction with the outside like buttons from an html form.

platformer.html

<!DOCTYPE html>
<html>
<head>
<style rel="stylesheet" type="text/css">
body {
  background-color:#999;
}
canvas {
  background-color:#BBB;
  border:1px solid #666;
  margin:80px;
}
</style>
</head>
<body>

<canvas id="my_canvas" width="320" height="240">
</canvas>

<script type="text/javascript" src="./caml-platform.js"></script>

<script>var exports = {};</script>
<script type="text/javascript" src="./platformer.js"></script>

</body>
</html>

See the result (move with arrows of the keyboard).

After we can add graphics with a tilemap like this.
The tilemap and the tileset have been made with the tool Tiled.

Find other examples with sources there.