typing the gui

typing the gui

type Modeler.objects = { cube: (float, float, float); id: hidden_id } ;

type Modeler.scene = { selection: option(Modeler.objects); others: list(Modeler.objects) };

type Modeler.tool.mode = {selection} / {add_cube} ;

type Modeler.modeler = {
  address: string;
  scene: Modeler.scene;
  mode: Modeler.tool.mode
} ;

Scene = {{
  empty() = { selection=Option.some({cube=(0.0, 0.0, -3.0); id=CHF()}); others=[ {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ] };

  add_cube(scene, where) = { scene with others=List.cons({cube=(where.x, where.y, where.z); id=CHF()}, scene.others) };

  selection(scene, possible_target) =
    match (possible_target, scene.selection) with
    | ({none}, {none}) -> scene
    | ({none}, {~some}) -> { selection=Option.none; others=List.cons(some, scene.others) }
    | ({~some}, osel) ->
      //we put back the sel with others
      others = Option.switch((sel -> List.cons(sel, scene.others)), scene.others, osel);
      //we retrieve the new sel
      (new_sel, others) = List.extract_p((elt -> elt.id == some), others);
      do if Option.is_none(new_sel) then Log.error("Scene", "a selection failed to find the corresponding object");
      { selection=new_sel; ~others }
    end ;

}} ;

Modeler = {{
  empty(scene_url) = { address=scene_url; scene=Scene.empty(); mode={selection} } ;

  use_tool(modeler, where, possible_target) =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' in mode: '{modeler.mode}'");
    match modeler.mode with
    | {add_cube} -> { modeler with scene=Scene.add_cube(modeler.scene, where) }
    | {selection} -> { modeler with scene=Scene.selection(modeler.scene, possible_target) }
    end ;

  change_tool(modeler, new_mode) = { modeler with mode=new_mode };

}} ;

type GuiModeler.t = {
  modeler: Modeler.modeler;
  subjects: { mode: subject(Modeler.tool.mode) }
} ;

@client GuiModeler = {{

  empty(scene_url) : GuiModeler.t =
    modeler = Modeler.empty(scene_url);
    subjects = { mode=Observable.make(modeler.mode) };
    { ~modeler; ~subjects };

  @private on_message(state : GuiModeler.t, message) =
    set_modeler(modeler) = { set={ state with ~modeler } } ;
    set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(state) = { set=state };
    match message with
    | {click_on_scene; ~where; ~possible_target} -> set_modeler(Modeler.use_tool(state.modeler, where, possible_target))
    | {change_tool=new_mode} ->
      modeler = Modeler.change_tool(state.modeler, new_mode);
      subjects = { state.subjects with mode=Observable.change_state(new_mode, state.subjects.mode) };
      set({ ~subjects; ~modeler })
    end ;

  setup_menu(parent_sel, channel, s_mode) : void =
    f(some_mode) = match some_mode with
      | {selection} -> (<>*Sel*</>, <>Cube</>)
      | {add_cube} -> (<>Sel</>, <>*Cube*</>)
      end ;
    (id_a, id_b) = (Random.string(7), Random.string(7));
    on_mode_change =
      then_do(new_mode) =
        (text_a, text_b) = f(new_mode);
        Dom.transform([#{id_a}<- text_a, #{id_b}<- text_b]);
      { si=(->true); ~then_do; else_autoclean };
    do Observable.register(on_mode_change, s_mode);
    menu =
      s(x) = (_ -> Session.send(channel, {change_tool=x}));

. | .
;
    ignore(Dom.put_at_start(parent_sel, Dom.of_xhtml(menu)));

  init(scene_url, parent_sel:dom, width, height) : void =
    id_canvas_canvas = "canvas_canvas" ;
    fail_msg =
      <>It seems that your browser and/or graphics card are incompatible with Webgl.Learn a little more about webgl support</> ;
    and_do(_) =
      (channel, get_scene, get_subjects) =
        (channel, get_state) = SessionExt.make_with_getter(empty(scene_url), on_message);
        (channel, (-> get_state().modeler.scene), (->get_state().subjects)) ;
      mouse_listener(e) = match e with
        | { mousedown; ~pos; ~possible_target } -> Session.send(channel, {click_on_scene; where={x=pos.f1; y=pos.f2; z=pos.f3}; ~possible_target})
        end ;
      res = initGL(#{id_canvas_canvas}, width, height, get_scene, mouse_listener) ;
      if Outcome.is_failure(res) then ignore(Dom.put_replace(parent_sel, Dom.of_xhtml(fail_msg))) else setup_menu(parent_sel, channel, get_subjects().mode);
    base =
      <canvas width={width} height={height} id=#{id_canvas_canvas} onready={and_do} ></canvas>;
    ignore(Dom.put_inside(parent_sel, Dom.of_xhtml(base)));

}}

type Modeler.objects = { cube: (float, float, float); id: hidden_id } ;

type Modeler.scene = { selection: option(Modeler.objects); others: list(Modeler.objects) };

type Modeler.tool.mode = {selection} / {add_cube} ;

type Modeler.modeler = {
  address: string;
  scene: Modeler.scene;
  mode: Modeler.tool.mode
} ;

Scene = {{
  empty() = { selection=Option.some({cube=(0.0, 0.0, -3.0); id=CHF()}); others=[ {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ] };

  add_cube(scene, where) = { scene with others=List.cons({cube=(where.x, where.y, where.z); id=CHF()}, scene.others) };

  selection(scene, possible_target) =
    match (possible_target, scene.selection) with
    | ({none}, {none}) -> scene
    | ({none}, {~some}) -> { selection=Option.none; others=List.cons(some, scene.others) }
    | ({~some}, osel) ->
      //we put back the sel with others
      others = Option.switch((sel -> List.cons(sel, scene.others)), scene.others, osel);
      //we retrieve the new sel
      (new_sel, others) = List.extract_p((elt -> elt.id == some), others);
      do if Option.is_none(new_sel) then Log.error("Scene", "a selection failed to find the corresponding object");
      { selection=new_sel; ~others }
    end ;

}} ;

Modeler = {{
  empty(scene_url) = { address=scene_url; scene=Scene.empty(); mode={selection} } ;

  use_tool(modeler, where, possible_target) =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' in mode: '{modeler.mode}'");
    match modeler.mode with
    | {add_cube} -> { modeler with scene=Scene.add_cube(modeler.scene, where) }
    | {selection} -> { modeler with scene=Scene.selection(modeler.scene, possible_target) }
    end ;

  change_tool(modeler, new_mode) = { modeler with mode=new_mode };

}} ;

@client GuiModeler = {{

  empty(scene_url) =
    modeler = Modeler.empty(scene_url);
    subjects = { mode=Observable.make(modeler.mode) };
    { ~modeler; ~subjects };

  @private on_message(state, message) =
    set_modeler(modeler) = { set={ state with ~modeler } } ;
    set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(state) = { set=state };
    match message with
    | {click_on_scene; ~where; ~possible_target} -> set_modeler(Modeler.use_tool(state.modeler, where, possible_target))
    | {change_tool=new_mode} ->
      modeler = Modeler.change_tool(state.modeler, new_mode);
      subjects = { state.subjects with mode=Observable.change_state(new_mode, state.subjects.mode) };
      set({ ~subjects; ~modeler })
    end ;

  setup_menu(parent_sel, channel, s_mode) : void =
    f(some_mode) = match some_mode with
      | {selection} -> (<>*Sel*</>, <>Cube</>)
      | {add_cube} -> (<>Sel</>, <>*Cube*</>)
      end ;
    (id_a, id_b) = (Random.string(7), Random.string(7));
    on_mode_change =
      then_do(new_mode) =
        (text_a, text_b) = f(new_mode);
        Dom.transform([#{id_a}<- text_a, #{id_b}<- text_b]);
      { si=(->true); ~then_do; else_autoclean };
    do Observable.register(on_mode_change, s_mode);
    menu =
      s(x) = (_ -> Session.send(channel, {change_tool=x}));

. | .
;
    ignore(Dom.put_at_start(parent_sel, Dom.of_xhtml(menu)));

  init(scene_url, parent_sel:dom, width, height) : void =
    id_canvas_canvas = "canvas_canvas" ;
    fail_msg =
      <>It seems that your browser and/or graphics card are incompatible with Webgl.Learn a little more about webgl support</> ;
    and_do(_) =
      (channel, get_scene, get_subjects) =
        (channel, get_state) = SessionExt.make_with_getter(empty(scene_url), on_message);
        (channel, (-> get_state().modeler.scene), (->get_state().subjects)) ;
      mouse_listener(e) = match e with
        | { mousedown; ~pos; ~possible_target } -> Session.send(channel, {click_on_scene; where={x=pos.f1; y=pos.f2; z=pos.f3}; ~possible_target})
        end ;
      res = initGL(#{id_canvas_canvas}, width, height, get_scene, mouse_listener) ;
      if Outcome.is_failure(res) then ignore(Dom.put_replace(parent_sel, Dom.of_xhtml(fail_msg))) else setup_menu(parent_sel, channel, get_subjects().mode);
    base =
      <canvas width={width} height={height} id=#{id_canvas_canvas} onready={and_do} ></canvas>;
    ignore(Dom.put_inside(parent_sel, Dom.of_xhtml(base)));

}}


basic setup for selection mode on the scene

type Modeler.objects = { cube: (float, float, float); id: hidden_id } ;

type Modeler.scene = list(Modeler.objects) ;

type Modeler.mode = {selection} / {add_cube} ;

type Modeler = {
  address: string;
  scene: Modeler.scene;
  mode: Modeler.mode
} ;

Scene = {{
  empty() = [ {cube=(0.0, 0.0, -3.0); id=CHF()}, {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ] ;

  add_cube(scene, where) = List.cons({cube=(where.x, 0.0, where.z); id=CHF()}, scene) ;

}}

@client GuiModeler = {{

  @private on_message(state : Modeler, message) = match message with
    | {click_on_scene; ~where} ->
      match state.mode with
      | {add_cube} -> { set={ state with scene=Scene.add_cube(state.scene, where) }}
      | {selection} -> {unchanged}
      end
    | _ -> {unchanged}
    end ;

  init(scene_url, canvas_sel, width, height) : outcome =
    org_state = {
      address=scene_url; scene=Scene.empty(); mode={selection}
      } ;
    (channel, get_scene) =
      (channel, get_state) = SessionExt.make_with_getter(org_state, on_message);
      (channel, (-> get_state().scene)) ;
    mouse_listener(e) = match e with
      | { mousedown; ~x; ~z } -> Session.send(channel, {click_to_scene; where={~x; ~z}})
      end ;
    res = initGL(canvas_sel, width, height, get_scene, mouse_listener) ;
    match res with
    | {success} ->

      res
    | _ -> res
    end ;

}}

type Modeler.objects = { cube: (float, float, float); id: hidden_id } ;

type Modeler.scene = list(Modeler.objects) ;

type Modeler = {
  address: string;
  scene: Modeler.scene
} ;

Scene = {{
  empty() = [ {cube=(0.0, 0.0, -3.0); id=CHF()}, {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ] ;

  add_cube(scene, where) = List.cons({cube=(where.x, 0.0, where.z); id=CHF()}, scene) ;

}}

@client GuiModeler = {{

  @private on_message(state : Modeler, message) = match message with
    | {add_to_scene; ~where} ->
      { set={ state with scene=Scene.add_cube(state.scene, where) }}
    | _ -> {unchanged}
    end ;

  init(scene_url, canvas_sel, width, height) : outcome =
    org_state = {
      address=scene_url; scene=Scene.empty()
      } ;
    (channel, get_scene) =
      (channel, get_state) = SessionExt.make_with_getter(org_state, on_message);
      (channel, (-> get_state().scene)) ;
    mouse_listener(e) = match e with
      | { mousedown; ~x; ~z } -> Session.send(channel, {add_to_scene; where={~x; ~z}})
      end ;
    res = initGL(canvas_sel, width, height, get_scene, mouse_listener) ;
    match res with
    | {success} ->

      res
    | _ -> res
    end ;

}}


little reorganisation of code

little reorganisation of code

type engine.color = (float, float, float);

@private random_color() : engine.color =
  // we draw color with float, but we read them back as integer
  r() = float_of_int(Random.int(256)) / 255.;
  (r(), r(), r());

type object = {
  vertexPositions: Webgl.WebGLBuffer;
  itemSize: int;
  numItems: int;
  vertexNormals: Webgl.WebGLBuffer;
  vertexIndexs: Webgl.WebGLBuffer;
  picking_color: engine.color;
  id: hidden_id
}

display(eng, pMatrix, mvMatrix, position, object, overide_color_for_picking, is_selected) =
  gl = eng.context; shaderProgram = eng.shaderProgram;
  color =
    if overide_color_for_picking then object.picking_color
    else if is_selected then (0.7, 0., 0.) else (0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, color.f1, color.f2, color.f3);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.vertexPositions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.vertexNormals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), object.vertexIndexs);

  mvMatrix = Stack.update_and_push(mvMatrix, (o, n -> mat4.translate(o, vec3.from_public(position), n))) ;
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);
  void
;

Cube = {{
  create(gl, id) =
    //define our vertex positions as a list
    vertices = [
        // Front face
        -1.0, -1.0,  1.0,
         1.0, -1.0,  1.0,
         1.0,  1.0,  1.0,
        -1.0,  1.0,  1.0,

        // Back face
        -1.0, -1.0, -1.0,
        -1.0,  1.0, -1.0,
         1.0,  1.0, -1.0,
         1.0, -1.0, -1.0,

        // Top face
        -1.0,  1.0, -1.0,
        -1.0,  1.0,  1.0,
         1.0,  1.0,  1.0,
         1.0,  1.0, -1.0,

        // Bottom face
        -1.0, -1.0, -1.0,
         1.0, -1.0, -1.0,
         1.0, -1.0,  1.0,
        -1.0, -1.0,  1.0,

        // Right face
         1.0, -1.0, -1.0,
         1.0,  1.0, -1.0,
         1.0,  1.0,  1.0,
         1.0, -1.0,  1.0,

        // Left face
        -1.0, -1.0, -1.0,
        -1.0, -1.0,  1.0,
        -1.0,  1.0,  1.0,
        -1.0,  1.0, -1.0,
      ];
    vertexNormals = [
      // Front
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,

      // Back
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,

      // Top
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,

      // Bottom
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,

      // Right
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,

      // Left
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0
    ];
    cubeVertexIndices = [
              0, 1, 2,      0, 2, 3,    // Front face
              4, 5, 6,      4, 6, 7,    // Back face
              8, 9, 10,     8, 10, 11,  // Top face
              12, 13, 14,   12, 14, 15, // Bottom face
              16, 17, 18,   16, 18, 19, // Right face
              20, 21, 22,   20, 22, 23  // Left face
          ];
    //global variable to hold the cube buffer
    //We create a buffer for the cube's vertex positions.
    cubeVertexPositionBuffer = Webgl.createBuffer(gl);
    //tells WebGL that any following operations that act on buffers should use the one we specify
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), cubeVertexPositionBuffer);
    //Now, we create a Float32Array object based on our list,
    //and tell WebGL to use it to fill the current buffer
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl), Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)), Webgl.STATIC_DRAW(gl));
    cubeVertexNormalBuffer = Webgl.createBuffer(gl);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), cubeVertexNormalBuffer);
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl), Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertexNormals)), Webgl.STATIC_DRAW(gl));
    cubeVertexIndexBuffer = Webgl.createBuffer(gl);
    do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), cubeVertexIndexBuffer);
    do Webgl.bufferData(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), Webgl.Uint16Array.to_ArrayBuffer(Webgl.Uint16Array.from_int_list(cubeVertexIndices)), Webgl.STATIC_DRAW(gl));
    { vertexPositions=cubeVertexPositionBuffer; itemSize=3; numItems=24; vertexNormals=cubeVertexNormalBuffer; vertexIndexs=cubeVertexIndexBuffer; picking_color=random_color(); ~id } : object
  ;

}}

type engine.color = (float, float, float);

@private random_color() : engine.color =
  // we draw color with float, but we read them back as integer
  r() = float_of_int(Random.int(256)) / 255.;
  (r(), r(), r());

type object = {
  vertexPositions: Webgl.WebGLBuffer;
  itemSize: int;
  numItems: int;
  vertexNormals: Webgl.WebGLBuffer;
  vertexIndexs: Webgl.WebGLBuffer;
  picking_color: engine.color;
  id: hidden_id
}

display(eng, pMatrix, mvMatrix, position, object, overide_color_for_picking, is_selected) =
  gl = eng.context; shaderProgram = eng.shaderProgram;
  color =
    if overide_color_for_picking then object.picking_color
    else if is_selected then (0.7, 0., 0.) else (0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, color.f1, color.f2, color.f3);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.vertexPositions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.vertexNormals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), object.vertexIndexs);

  mvMatrix = Stack.update_and_push(mvMatrix, (o, n -> mat4.translate(o, vec3.from_public(position), n))) ;
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);
  void
;

Cube = {{
  create(gl, id) =
    //global variable to hold the cube buffer
    //We create a buffer for the cube's vertex positions.
    cubeVertexPositionBuffer = Webgl.createBuffer(gl);
    //tells WebGL that any following operations that act on buffers should use the one we specify
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), cubeVertexPositionBuffer);
    //define our vertex positions as a list
    vertices = [
        // Front face
        -1.0, -1.0,  1.0,
         1.0, -1.0,  1.0,
         1.0,  1.0,  1.0,
        -1.0,  1.0,  1.0,

        // Back face
        -1.0, -1.0, -1.0,
        -1.0,  1.0, -1.0,
         1.0,  1.0, -1.0,
         1.0, -1.0, -1.0,

        // Top face
        -1.0,  1.0, -1.0,
        -1.0,  1.0,  1.0,
         1.0,  1.0,  1.0,
         1.0,  1.0, -1.0,

        // Bottom face
        -1.0, -1.0, -1.0,
         1.0, -1.0, -1.0,
         1.0, -1.0,  1.0,
        -1.0, -1.0,  1.0,

        // Right face
         1.0, -1.0, -1.0,
         1.0,  1.0, -1.0,
         1.0,  1.0,  1.0,
         1.0, -1.0,  1.0,

        // Left face
        -1.0, -1.0, -1.0,
        -1.0, -1.0,  1.0,
        -1.0,  1.0,  1.0,
        -1.0,  1.0, -1.0,
      ];
    vertexNormals = [
      // Front
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,
       0.0,  0.0,  1.0,

      // Back
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,
       0.0,  0.0, -1.0,

      // Top
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,
       0.0,  1.0,  0.0,

      // Bottom
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,
       0.0, -1.0,  0.0,

      // Right
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,
       1.0,  0.0,  0.0,

      // Left
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0,
      -1.0,  0.0,  0.0
    ];
    cubeVertexIndices = [
              0, 1, 2,      0, 2, 3,    // Front face
              4, 5, 6,      4, 6, 7,    // Back face
              8, 9, 10,     8, 10, 11,  // Top face
              12, 13, 14,   12, 14, 15, // Bottom face
              16, 17, 18,   16, 18, 19, // Right face
              20, 21, 22,   20, 22, 23  // Left face
          ];
    //Now, we create a Float32Array object based on our list,
    //and tell WebGL to use it to fill the current buffer
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl), Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)), Webgl.STATIC_DRAW(gl));
    //this 9-element buffer actually represents three separate vertex
    //positions (numItems), each of which is made up of three numbers (itemSize).
    //do Webgl.set_itemSize(cubeVertexPositionBuffer, 3);
    //do Webgl.set_numItems(cubeVertexPositionBuffer, 4);
    cubeVertexNormalBuffer = Webgl.createBuffer(gl);
    //tells WebGL that any following operations that act on buffers should use the one we specify
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), cubeVertexNormalBuffer);
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl), Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertexNormals)), Webgl.STATIC_DRAW(gl));
    cubeVertexIndexBuffer = Webgl.createBuffer(gl);
    do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), cubeVertexIndexBuffer);
    do Webgl.bufferData(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), Webgl.Uint16Array.to_ArrayBuffer(Webgl.Uint16Array.from_int_list(cubeVertexIndices)), Webgl.STATIC_DRAW(gl));
    { vertexPositions=cubeVertexPositionBuffer; itemSize=3; numItems=24; vertexNormals=cubeVertexNormalBuffer; vertexIndexs=cubeVertexIndexBuffer; picking_color=random_color(); ~id } : object
  ;

}}


[fix] big project: reduce the number of files actually listened

/** opa-dynamic
  * Monitor a directory conataining a project, recompiles it and relaunch it when needed
  */

import stdlib.io.file
import stdlib.core.concurrency
import stdlib.system

do Scheduler.sleep(1, -> main(CommandLine.filter(CommandLineConf)) ) // Workaround

@expand
debug = #<Ifstatic:DEBUG> s -> println("[DEBUG] {s}") #<Else> _ -> void #<End>

type config.notifier = {notify_send} / {terminal_notifier} / {none}

/** Configuration for one project directory */
type config = {
  command : list(string) // list of command , inferred if empty
  directory : string     // project directory
  avoid_dir : list(string)
  avoid_ext : list(string)
  avoid_prefix : list(string)
  launch : bool
  opa_opt : string
  notifier : config.notifier
}

// Add browser support, launch and reload
DConfig = {{
  /** Control grouping delay of sequential events */
  grouping_delay = Duration.ms(300)
  config = {
    command = [] // empty => inferred
    directory="."
    avoid_dir=[".git", "_build", "_tracks","node_modules"]
    avoid_ext=[".opx", "_depends"/*opa*/, ".log", ".bak", ".old", "~"/*emacs*/, ".exe"]
    avoid_prefix =[ ".#"/*emacs*/, "#" ]
    launch = true
    opa_opt = ""
    notifier = {notify_send}
  }
}}

CommandLineConf = {{
  title = "OpaDyn"
  init = DConfig.config
  anonymous = []
  parsers = [
    CommandLine.string(["--src-dir"],"Directory to auto-build","directory(={init.directory})"){
     s,c -> {c with directory = s}
    },
    CommandLine.string(["--avoid-dir"],"Directory to avoid","directory(={init.avoid_dir})"){
     s,c -> {c with avoid_dir=[s|c.avoid_dir]}
    },
    CommandLine.string(["--avoid-ext"],"Extension to avoid","extension(={init.avoid_ext})"){
     s,c -> {c with avoid_ext=[s|c.avoid_ext]}
    },
    CommandLine.string(["--command"],"Command to build","command(=inferred)"){
     s,c -> {c with command = [s|c.command]}
    },
    CommandLine.string(["--opa-opt"],"Option for opa command","opt"){
     s,c -> {c with opa_opt = "{c.opa_opt} {s}"}
    },
    CommandLine.switch(["--no-launch"],"Last command is not a launch command"){
     c -> {c with launch = false}
    },
    cases = [
      ("no", {none}),
      ("linux", {notify_send}),
      ("mac"  , {terminal_notifier}),
      ("windows", {none})
    ]
    CommandLine.case(["--notifier"],cases,
     "Force platform notifier", String.concat(" or ",List.map(_.f1, cases))
    ){
     n,c -> {c with notifier = n}
    },
  ]
}} : CommandLine.family(config)

avoid_file(config)(file) =
      List.mem(file,config.avoid_dir)
  ||  List.exists(String.has_suffix(_,file), config.avoid_ext)
  ||  List.exists(String.has_prefix(_,file), config.avoid_prefix)

type command_queue_state = MutexRef.t({
  need : bool
  in_progress : option(Date.date) // Some => in progress
})

type job = {
  name : string
  command : -> void
}

/** projecting a function to an exclusive access queue,
    only one function can be executed at the same time,
    new execution demand during a previous exectution will be merge into one exectution
    new execution demand that are very near in time are merged
*/
exclusive_queue(command: -> void) = (

  stateR = MutexRef.create({need=false progress=none})
  finished() = do debug("XQUEUE FINISHED") MutexRef.update(stateR){ state -> {state with progress=none} }
  start() = do debug("XQUEUE START") MutexRef.update(stateR){ state -> {state with progress=some(Date.now()) need=false} }
  consume_need()  = MutexRef.exclusive(stateR){ ->
    state = MutexRef.get(stateR)
    do debug("XQUEUE CONSUME NEED {state}")
    do MutexRef.set(stateR, {MutexRef.get(stateR) with need=false})
    state.need
  }
  rec proceed(id) =
    do debug("TRY PROCEED {id}")
    if MutexRef.get(stateR).progress!=none then debug("STILL IN PROGRESS") else
    do debug("PROCEED")
    do start()
    do command()
    do finished()
    if consume_need() then proceed(id)
    else debug("XQUEUE END LOOP, WAITING")

  -> MutexRef.update(stateR){ state ->
    // any transition to need=true without any in_progress work starts a new proceed_loop
    if state.need then do debug("STILL IN NEED") state else
    need = match state.progress
      {none} -> true
      {some=t} ->
        dt = Date.between(t,Date.now())
        do debug("DT = {Duration.in_milliseconds(dt)} ms")
        dt > DConfig.grouping_delay // if far enough after starting progress
      end
    do if need then Scheduler.push( -> proceed(Random.string(4)) )
    do debug("NEED = {need}")
    {state with ~need}
  }

)

/**
  * Listening a set of file, and triggering command on any change that is not about avoided files.
  */
job_on_files_changes(avoid_file,files,_name,command)=
  command=exclusive_queue(command)
  handler_map = MutexRef.create(StringMap.empty)
  _remove_file(file) = MutexRef.update(handler_map){
    map -> StringMap.remove(file, map)
  }
  command_if_not_avoid(file) = if not(avoid_file(file)) then command() else debug("AVOIDED {file}")
  add_file(file) =
    do debug("Listen {file} ")
    is_directory = File.is_directory(file)
    if not(is_directory) then void else
    handler = File.onchange(file,none){file1, event ->
      do  debug("EVENT[{file} {file1}] = {Debug.dump(event)}")
      match event
      {change=file2} ->
        do if is_directory then debug("file-change") else debug("mod-or-delete")
        command_if_not_avoid(file2)
      {rename=file2} ->
        do if is_directory then debug("new-or-delete") // TODO : HANDLE NEW FILE LISTENING HERE
                           else debug("delete")
        command_if_not_avoid(file2)
    }
    do MutexRef.update(handler_map){ map ->
      StringMap.add(file, handler, map)
    }
    debug("OK")

  do StringSet.iter(add_file,files)
  command()

/** Collect recusively all path in a directory using an avoidance rule */
collect_files(avoid_file, rpath,dir) =
  path = List.rev([dir|rpath])
  pathstr = String.concat("/", path)
  v = File.readdir(pathstr):outcome(llarray(string), string)
  if avoid_file(dir) then []
  else match v
  {success=array} ->
    do debug("DIR={pathstr}")
    subs = LowLevelArray.mapi(array){ _i,v ->
      collect_files(avoid_file,[dir|rpath],v)
    } |> LowLevelArray.fold(List.cons,_,List.empty) |> List.flatten
    [path|subs]
  {failure=_} -> [path]

keep_n_first_lines(n,s) = String.explode("\n", s) |> List.take(n,_) |> String.concat("\n",_)
//keep_n_last_lines(n,s)  = String.explode("\n", s) |> List.rev |> List.take(n,_) |> List.rev |> String.concat("\n",_)

summary_error(s) =
  // TODO position could be simplified
  errors = String.explode("Error:", s)
  nb_errors = List.length(errors)
  if nb_errors > 0 then "Error:"^keep_n_first_lines(8, List.head(List.rev(errors))) else s

// 8 lines max
notify_send(title,mess,positive) =
  clear(s) = s |> String.replace("\"", " ", _) |> String.replace("\'", " ", _)
  icon = if positive then "-i dialog-ok-apply" else "-i dialog-warning"
  mess = summary_error(mess)
  do debug("NOTIFY {mess}")
  match System.shell_exec("notify-send {icon} -a Opa \"{clear(title)}\" \"{clear(mess)}\"","").result()
  {error={some=err} ...} -> debug("Notify failure : {err}")
  ~{stderr stdout ...} -> debug("Notify ok : <<{stdout}{stderr}>>")

notify =
| {notify_send} -> notify_send
| {terminal_notifier} | {none} -> (_,_,_ -> void)

simplified_dir(dir)= List.head(List.rev(String.explode("/",dir)))

Autocommand(config) = {{
  target= "dynamic.exe"
  kill_id = Random.string(16) // Workaround
  Conf = {{
    commands = ["opa {config.opa_opt} --opx-dir _build --conf opa.conf --conf-opa-files -o {target}"] ++ if config.launch then ["cp ./{target} ./{kill_id}_{target} && ./{kill_id}_{target} -p 2001"] else []
  }}
  Makefile = {{
    commands = ["make", ] ++ if config.launch then  ["make run"] else []
  }}
}}

main(config)=
  // Notifier
  notify_title = "{simplified_dir(config.directory)}"
  notify_title_error = "FAILURE : {notify_title}"
  notify_title_fine = "Launched : {notify_title}"
  notify = notify(config.notifier)
  // Avoidance rule
  avoid_file = avoid_file(config)
  Autocommand = Autocommand(config)
  // Remember last lauch to be able to kill it
  previous_last = MutexRef.create(none)
  may_kill_previous_last() = MutexRef.update(previous_last){ opt ->
    do debug("SHOULD KILL {opt}")
    do Option.iter(p -> do debug("TRY KILL {p.p.pid}") do p.p.kill() do Reference.set(p.killed, true) debug("KILLED {p.p.pid}"),opt)
      // An ugly work-around, need proper process group here
      do ignore(System.shell_exec("ps x -o pid,cmd | grep {Autocommand.kill_id} | cut -d ' ' -f 1 | xargs kill","").result())
      none
    }
  register_previous_last(p) = MutexRef.update(previous_last)(
    | {none} -> some(p)
    | {some=prev} -> do debug("{prev.p.pid} has not been killed") do prev.p.kill() some(p)
  )
  // do System.at_exit( -> do may_kill_previous_last(); /*do ignore(System.shell_exec("cd {config.directory} && rm {Autocommand.kill_id}_*","") );*/ void)
  set = Fold.list( collect_files(avoid_file,[],config.directory), StringSet.empty ){
		path, set -> StringSet.add(String.concat("/", path), set )
  }
  // Standard Opa project detection
  has_file(file) =  StringSet.mem(String.concat("/",[config.directory,file]), set)
  has_conf = has_file("opa.conf")
  has_makefile = has_file("Makefile")
  commands() = (
     if config.command!=[] then config.command else
     if has_conf           then Autocommand.Conf.commands else
     if has_makefile       then Autocommand.Makefile.commands else []
  )
  do if commands()==[] then error("Don't know what to do please specify --command or create opa.conf or create a Makefile")
  command() =
    do print("Change detected: ")
    commands = commands()
    len = List.length(commands)
    is_last = (_ == len-1)
    fine = (List.foldi(_,commands,true)){ i, command, continue ->
    if not(continue) then false else
      command = "cd {config.directory} && {command}"
      do debug("COMMAND {command}")
      message = if config.command!=[] then "command {i}"
                else match i
                     0 -> "compilation"
                     1 -> "run"
                     _ -> "command {i}"
                     end
      do print(message)
      killed = Reference.create(false)
      process_outcome(o) = match o.error
        {none} -> do print(" OK, "); continue
        {some=_} -> if Reference.get(killed) then true else do println(" FAILURE <<\n{o.stderr}\n>>"); do notify(notify_title_error,o.stderr,false); false
        end
      async_launch_command = len>1 && is_last(i)
      do if async_launch_command then may_kill_previous_last()
      ~{p result} = System.shell_exec(command, "")
      do debug("LAUNCHED")
      do debug("LAUNCHED {p.pid}")
      if async_launch_command then
        do register_previous_last(~{p killed})
        do Scheduler.push{ ->
          do debug("WAIT {p.pid}")
          do ignore(process_outcome(result()))
          debug("ASYNC LAUNCH FINISHED {p.pid}")
        }
        true
      else
        do debug("WAIT {message}")
        r = process_outcome(result())
        do debug("DONE {message}")
        r
    }
    if fine then do println(" OK") notify(notify_title_fine,"",true) else debug("NOT FINE")
    job_on_files_changes(avoid_file,set,"_name", command)

/** opa-dynamic
  * Monitor a directory conataining a project, recompiles it and relaunch it when needed
  */

import stdlib.io.file
import stdlib.core.concurrency
import stdlib.system

do Scheduler.sleep(1, -> main(CommandLine.filter(CommandLineConf)) ) // Workaround

@expand
debug = #<Ifstatic:DEBUG> s -> println("[DEBUG] {s}") #<Else> _ -> void #<End>

type config.notifier = {notify_send} / {terminal_notifier} / {none}

/** Configuration for one project directory */
type config = {
  command : list(string) // list of command , inferred if empty
  directory : string     // project directory
  avoid_dir : list(string)
  avoid_ext : list(string)
  avoid_prefix : list(string)
  launch : bool
  opa_opt : string
  notifier : config.notifier
}

// Add browser support, launch and reload
DConfig = {{
  /** Control grouping delay of sequential events */
  grouping_delay = Duration.ms(300)
  config = {
    command = [] // empty => inferred
    directory="."
    avoid_dir=[".git", "_build", "_tracks","node_modules"]
    avoid_ext=[".opx", "_depends"/*opa*/, ".log", ".bak", ".old", "~"/*emacs*/, ".exe"]
    avoid_prefix =[ ".#"/*emacs*/, "#" ]
    launch = true
    opa_opt = ""
    notifier = {notify_send}
  }
}}

CommandLineConf = {{
  title = "OpaDyn"
  init = DConfig.config
  anonymous = []
  parsers = [
    CommandLine.string(["--src-dir"],"Directory to auto-build","directory(={init.directory})"){
     s,c -> {c with directory = s}
    },
    CommandLine.string(["--avoid-dir"],"Directory to avoid","directory(={init.avoid_dir})"){
     s,c -> {c with avoid_dir=[s|c.avoid_dir]}
    },
    CommandLine.string(["--avoid-ext"],"Extension to avoid","extension(={init.avoid_ext})"){
     s,c -> {c with avoid_ext=[s|c.avoid_ext]}
    },
    CommandLine.string(["--command"],"Command to build","command(=inferred)"){
     s,c -> {c with command = [s|c.command]}
    },
    CommandLine.string(["--opa-opt"],"Option for opa command","opt"){
     s,c -> {c with opa_opt = "{c.opa_opt} {s}"}
    },
    CommandLine.switch(["--no-launch"],"Last command is not a launch command"){
     c -> {c with launch = false}
    },
    cases = [
      ("no", {none}),
      ("linux", {notify_send}),
      ("mac"  , {terminal_notifier}),
      ("windows", {none})
    ]
    CommandLine.case(["--notifier"],cases,
     "Force platform notifier", String.concat(" or ",List.map(_.f1, cases))
    ){
     n,c -> {c with notifier = n}
    },
  ]
}} : CommandLine.family(config)

avoid_file(config)(file) =
      List.mem(file,config.avoid_dir)
  ||  List.exists(String.has_suffix(_,file), config.avoid_ext)
  ||  List.exists(String.has_prefix(_,file), config.avoid_prefix)

type command_queue_state = MutexRef.t({
  need : bool
  in_progress : option(Date.date) // Some => in progress
})

type job = {
  name : string
  command : -> void
}

/** projecting a function to an exclusive access queue,
    only one function can be executed at the same time,
    new execution demand during a previous exectution will be merge into one exectution
    new execution demand that are very near in time are merged
*/
exclusive_queue(command: -> void) = (

  stateR = MutexRef.create({need=false progress=none})
  finished() = do debug("XQUEUE FINISHED") MutexRef.update(stateR){ state -> {state with progress=none} }
  start() = do debug("XQUEUE START") MutexRef.update(stateR){ state -> {state with progress=some(Date.now()) need=false} }
  consume_need()  = MutexRef.exclusive(stateR){ ->
    state = MutexRef.get(stateR)
    do debug("XQUEUE CONSUME NEED {state}")
    do MutexRef.set(stateR, {MutexRef.get(stateR) with need=false})
    state.need
  }
  rec proceed(id) =
    do debug("TRY PROCEED {id}")
    if MutexRef.get(stateR).progress!=none then debug("STILL IN PROGRESS") else
    do debug("PROCEED")
    do start()
    do command()
    do finished()
    if consume_need() then proceed(id)
    else debug("XQUEUE END LOOP, WAITING")

  -> MutexRef.update(stateR){ state ->
    // any transition to need=true without any in_progress work starts a new proceed_loop
    if state.need then do debug("STILL IN NEED") state else
    need = match state.progress
      {none} -> true
      {some=t} ->
        dt = Date.between(t,Date.now())
        do debug("DT = {Duration.in_milliseconds(dt)} ms")
        dt > DConfig.grouping_delay // if far enough after starting progress
      end
    do if need then Scheduler.push( -> proceed(Random.string(4)) )
    do debug("NEED = {need}")
    {state with ~need}
  }

)

/**
  * Listening a set of file, and triggering command on any change that is not about avoided files.
  */
job_on_files_changes(avoid_file,files,_name,command)=
  command=exclusive_queue(command)
  handler_map = MutexRef.create(StringMap.empty)
  _remove_file(file) = MutexRef.update(handler_map){
    map -> StringMap.remove(file, map)
  }
  command_if_not_avoid(file) = if not(avoid_file(file)) then command() else debug("AVOIDED {file}")
  add_file(file) =
    do debug("Listen {file} ")
    is_directory = File.is_directory(file)
    handler = File.onchange(file,none){file1, event ->
      do  debug("EVENT[{file} {file1}] = {Debug.dump(event)}")
      match event
      {change=file2} ->
        do if is_directory then debug("file-change") else debug("mod-or-delete")
        command_if_not_avoid(file2)
      {rename=file2} ->
        do if is_directory then debug("new-or-delete") // TODO : HANDLE NEW FILE LISTENING HERE
                           else debug("delete")
        command_if_not_avoid(file2)
    }
    do MutexRef.update(handler_map){ map ->
      StringMap.add(file, handler, map)
    }
    debug("OK")
    do StringSet.iter(add_file,files)
    command()

/** Collect recusively all path in a directory using an avoidance rule */
collect_files(avoid_file, rpath,dir) =
  path = List.rev([dir|rpath])
  pathstr = String.concat("/", path)
  v = File.readdir(pathstr):outcome(llarray(string), string)
  if avoid_file(dir) then []
  else match v
  {success=array} ->
    do debug("DIR={pathstr}")
    subs = LowLevelArray.mapi(array){ _i,v ->
      collect_files(avoid_file,[dir|rpath],v)
    } |> LowLevelArray.fold(List.cons,_,List.empty) |> List.flatten
    [path|subs]
  {failure=_} -> [path]

keep_n_first_lines(n,s) = String.explode("\n", s) |> List.take(n,_) |> String.concat("\n",_)
//keep_n_last_lines(n,s)  = String.explode("\n", s) |> List.rev |> List.take(n,_) |> List.rev |> String.concat("\n",_)

summary_error(s) =
  // TODO position could be simplified
  errors = String.explode("Error:", s)
  nb_errors = List.length(errors)
  if nb_errors > 0 then "Error:"^keep_n_first_lines(8, List.head(List.rev(errors))) else s

// 8 lines max
notify_send(title,mess,positive) =
  clear(s) = s |> String.replace("\"", " ", _) |> String.replace("\'", " ", _)
  icon = if positive then "-i dialog-ok-apply" else "-i dialog-warning"
  mess = summary_error(mess)
  do debug("NOTIFY {mess}")
  match System.shell_exec("notify-send {icon} -a Opa \"{clear(title)}\" \"{clear(mess)}\"","").result()
  {error={some=err} ...} -> debug("Notify failure : {err}")
  ~{stderr stdout ...} -> debug("Notify ok : <<{stdout}{stderr}>>")

notify =
| {notify_send} -> notify_send
| {terminal_notifier} | {none} -> (_,_,_ -> void)

simplified_dir(dir)= List.head(List.rev(String.explode("/",dir)))

Autocommand(config) = {{
  target= "dynamic.exe"
  kill_id = Random.string(16) // Workaround
  Conf = {{
    commands = ["opa {config.opa_opt} --opx-dir _build --conf opa.conf --conf-opa-files -o {target}"] ++ if config.launch then ["cp ./{target} ./{kill_id}_{target} && ./{kill_id}_{target} -p 2001"] else []
  }}
  Makefile = {{
    commands = ["make", ] ++ if config.launch then  ["make run"] else []
  }}
}}

main(config)=
  // Notifier
  notify_title = "{simplified_dir(config.directory)}"
  notify_title_error = "FAILURE : {notify_title}"
  notify_title_fine = "Launched : {notify_title}"
  notify = notify(config.notifier)
  // Avoidance rule
  avoid_file = avoid_file(config)
  Autocommand = Autocommand(config)
  // Remember last lauch to be able to kill it
  previous_last = MutexRef.create(none)
  may_kill_previous_last() = MutexRef.update(previous_last){ opt ->
    do debug("SHOULD KILL {opt}")
    do Option.iter(p -> do debug("TRY KILL {p.p.pid}") do p.p.kill() do Reference.set(p.killed, true) debug("KILLED {p.p.pid}"),opt)
      // An ugly work-around, need proper process group here
      do ignore(System.shell_exec("ps x -o pid,cmd | grep {Autocommand.kill_id} | cut -d ' ' -f 1 | xargs kill","").result())
      none
    }
  register_previous_last(p) = MutexRef.update(previous_last)(
    | {none} -> some(p)
    | {some=prev} -> do debug("{prev.p.pid} has not been killed") do prev.p.kill() some(p)
  )
  // do System.at_exit( -> do may_kill_previous_last(); /*do ignore(System.shell_exec("cd {config.directory} && rm {Autocommand.kill_id}_*","") );*/ void)
  set = Fold.list( collect_files(avoid_file,[],config.directory), StringSet.empty ){
		path, set -> StringSet.add(String.concat("/", path), set )
  }
  // Standard Opa project detection
  has_file(file) =  StringSet.mem(String.concat("/",[config.directory,file]), set)
  has_conf = has_file("opa.conf")
  has_makefile = has_file("Makefile")
  commands() = (
     if config.command!=[] then config.command else
     if has_conf           then Autocommand.Conf.commands else
     if has_makefile       then Autocommand.Makefile.commands else []
  )
  do if commands()==[] then error("Don't know what to do please specify --command or create opa.conf or create a Makefile")
  command() =
    do print("Change detected: ")
    commands = commands()
    len = List.length(commands)
    is_last = (_ == len-1)
    fine = (List.foldi(_,commands,true)){ i, command, continue ->
    if not(continue) then false else
      command = "cd {config.directory} && {command}"
      do debug("COMMAND {command}")
      message = if config.command!=[] then "command {i}"
                else match i
                     0 -> "compilation"
                     1 -> "run"
                     _ -> "command {i}"
                     end
      do print(message)
      killed = Reference.create(false)
      process_outcome(o) = match o.error
        {none} -> do print(" OK, "); continue
        {some=_} -> if Reference.get(killed) then true else do println(" FAILURE <<\n{o.stderr}\n>>"); do notify(notify_title_error,o.stderr,false); false
        end
      async_launch_command = len>1 && is_last(i)
      do if async_launch_command then may_kill_previous_last()
      ~{p result} = System.shell_exec(command, "")
      do debug("LAUNCHED")
      do debug("LAUNCHED {p.pid}")
      if async_launch_command then
        do register_previous_last(~{p killed})
        do Scheduler.push{ ->
          do debug("WAIT {p.pid}")
          do ignore(process_outcome(result()))
          debug("ASYNC LAUNCH FINISHED {p.pid}")
        }
        true
      else
        do debug("WAIT {message}")
        r = process_outcome(result())
        do debug("DONE {message}")
        r
    }
    if fine then do println(" OK") notify(notify_title_fine,"",true) else debug("NOT FINE")
    job_on_files_changes(avoid_file,set,"_name", command)


traiting pending mousup

traiting pending mousup

@private type my_custom_shaderProgram = {
  program: Webgl.WebGLProgram;
  vertexPositionAttribute: Webgl.GLint;
  vertexNormalAttribute: Webgl.GLint;
  pMatrixUniform: Webgl.WebGLUniformLocation;
  mvMatrixUniform: Webgl.WebGLUniformLocation;
  nMatrixUniform: Webgl.WebGLUniformLocation;
  ambientColorUniform: Webgl.WebGLUniformLocation;
  lightingDirectionUniform: Webgl.WebGLUniformLocation;
  useLightingUniform: Webgl.WebGLUniformLocation
};

@private type static_buffer = {
  positions: Webgl.WebGLBuffer;
  itemSize: int; numItems: int;
  normals: Webgl.WebGLBuffer
};

@private type engine.scene = list(object);

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: engine.scene;
  selector: dom;
  last_coord_fixer: option(Dom.dimensions -> vec3);
} ;

@client initPickBuffer(eng) =
  gl = eng.context;
  framePickBuffer = Webgl.createFramebuffer(gl);
  renderPickBuffer = Webgl.createRenderbuffer(gl);
  pickTexture = Webgl.createTexture(gl);
  do Webgl.bindTexture(gl, Webgl.TEXTURE_2D(gl), Option.some(pickTexture));
  tex = Webgl.Uint8Array.from_int_list([0, 0, 0]);
  do Webgl.texImage2D(gl, Webgl.TEXTURE_2D(gl), 0, Webgl.RGB(gl), eng.canvas.width, eng.canvas.height, 0, Webgl.RGB(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(tex));
  do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(framePickBuffer));
  do Webgl.bindRenderbuffer(gl, Webgl.RENDERBUFFER(gl), Option.some(renderPickBuffer));
  do Webgl.renderbufferStorage(gl, Webgl.RENDERBUFFER(gl), Webgl.DEPTH_COMPONENT16(gl), eng.canvas.width, eng.canvas.height);
  do Webgl.bindRenderbuffer(gl, Webgl.RENDERBUFFER(gl), Option.none);

  do Webgl.framebufferTexture2D(gl, Webgl.FRAMEBUFFER(gl), Webgl.COLOR_ATTACHMENT0(gl), Webgl.TEXTURE_2D(gl), pickTexture, 0);
  do Webgl.framebufferRenderbuffer(gl, Webgl.FRAMEBUFFER(gl), Webgl.DEPTH_ATTACHMENT(gl), Webgl.RENDERBUFFER(gl), renderPickBuffer);
  do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
  do Webgl.bindTexture(gl, Webgl.TEXTURE_2D(gl), Option.none);
  framePickBuffer
;

initShaders(gl) =
  f(e, str) =
    shader = Webgl.createShader(gl, e);
    do Webgl.shaderSource(gl, shader, str);
    do Webgl.compileShader(gl, shader);
    shader;
  fragmentShader = f(Webgl.FRAGMENT_SHADER(gl), CustomShaders.shader_fs);
  vertexShader = f(Webgl.VERTEX_SHADER(gl), CustomShaders.shader_vs);
  // TODO getShaderParameter
  shaderProgram = Webgl.createProgram(gl);
  do Webgl.attachShader(gl, shaderProgram, vertexShader);
  do Webgl.attachShader(gl, shaderProgram, fragmentShader);
  do Webgl.linkProgram(gl, shaderProgram);
  // TODO : getProgramParameter(shaderProgram, gl.LINK_STATUS)) {
  do Webgl.useProgram(gl, shaderProgram);
  shaderProgram =
    vertexPositionAttribute = Webgl.getAttribLocation(gl, shaderProgram, "aVertexPosition");
    vertexNormalAttribute = Webgl.getAttribLocation(gl, shaderProgram, "aVertexNormal");
    do Webgl.enableVertexAttribArray(gl, vertexPositionAttribute);
    do Webgl.enableVertexAttribArray(gl, vertexNormalAttribute);
    { program = shaderProgram;
      ~vertexPositionAttribute;
      ~vertexNormalAttribute;
      pMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uPMatrix");
      mvMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uMVMatrix");
      nMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uNMatrix");
      ambientColorUniform = Webgl.getUniformLocation(gl, shaderProgram, "uAmbientColor");
      lightingDirectionUniform = Webgl.getUniformLocation(gl, shaderProgram, "uLightingDirection");
      useLightingUniform = Webgl.getUniformLocation(gl, shaderProgram, "uUseLighting");
    };
  shaderProgram
;

initLineXBuffers(gl, orient) =
  (vertices, vertexNormals) = match orient with
    | {x} -> ([ 0.0, 0.0, 0.0, 5.0, 0.0, 0.0 ], [ 2.5, 0.0, 0.0,        2.5, -1.0, 0.0 ])
    | {y} -> ([ 0.0, 0.0, 0.0, 0.0, 5.0, 0.0 ], [ 0.0, 2.5, 0.0,        -1.0, 2.5, 0.0 ])
    | {z} -> ([ 0.0, 0.0, 0.0, 0.0, 0.0, 5.0 ], [ 0.0, 0.0, 2.5,        0.0, -1.0, 2.5 ])
    end ;
  vertexPositionBuffer = Webgl.createBuffer(gl);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexPositionBuffer);
  do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
    Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)),
    Webgl.STATIC_DRAW(gl));
  vertexNormalBuffer = Webgl.createBuffer(gl);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexNormalBuffer);
  do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
    Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertexNormals)),
    Webgl.STATIC_DRAW(gl));
  { positions=vertexPositionBuffer; itemSize=3; numItems=2; normals=vertexNormalBuffer }
;

setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix) =
  a =
    b = mat4.to_list(pMatrix);
    c = Webgl.Float32Array.from_float_list(b);
    c;
  e =
    f = mat4.to_list(mvMatrix);
    g = Webgl.Float32Array.from_float_list(f);
    g;
  do Webgl.uniformMatrix4fv(gl, shaderProgram.pMatrixUniform, false, a);
  do Webgl.uniformMatrix4fv(gl, shaderProgram.mvMatrixUniform, false, e);
  normalMatrix = mat3.create();
  do mat4.toInverseMat3(mvMatrix, normalMatrix);
  do mat3.transpose(normalMatrix, normalMatrix);
  do Webgl.uniformMatrix3fv(gl, shaderProgram.nMatrixUniform, false, Webgl.Float32Array.from_float_list(mat3.to_list(normalMatrix)));
  void
;

setup_boxes(eng) =
  cnf_x(pos) = { pos with f1=0.0 }; cnf_y(pos) = { pos with f2=0.0 }; cnf_z(pos) = { pos with f3=0.0 };
  g(x:int, y:int, w:int, h:int, clear_near_far) =
    inbox(pos) = (pos.x_px >= x) && (pos.y_px >= y) && (pos.x_px < (w + x)) && (pos.y_px < (h + y));
    { ~x; ~y; ~w; ~h; ~inbox; ~clear_near_far } ;
  compute_left_right(x) = if ((mod(x, 2)) == 0) then
      a = (x / 2);
      ((a, a), 0)
    else
      b = (x / 2);
      ((b, b+1), 0);
  ((w_l, w_r), e_w) = compute_left_right(eng.canvas.width);
  ((h_u, h_d), e_h) = compute_left_right(eng.canvas.height);
  { _YX=g(0, h_d+e_h, w_l, h_u, cnf_z); _YZ=g(w_l+e_w, h_d+e_h, w_r, h_u, cnf_x);
    _ZX=g(0, 0, w_l, h_d, cnf_y);       _3D=g(w_l+e_w, 0, w_r, h_d, cnf_y) }
;

which_box(b, pos) =
  if b._YX.inbox(pos) then {_YX}
  else if b._YZ.inbox(pos) then {_YZ}
  else if b._ZX.inbox(pos) then {_ZX}
  else if b._3D.inbox(pos) then {_3D}
  else {out}
;

fetch_box(b, who) = match who with
  | {_YX} -> b._YX
  | {_YZ} -> b._YZ
  | {_ZX} -> b._ZX
  | {_3D} -> b._3D
  end ;

drawScene_for_a_viewport(eng, who, viewport, eye, up, scene, mode) =
  gl = eng.context; shaderProgram = eng.shaderProgram; repcoords = eng.static_buffers.repcoords;
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    tmp_pMatrix = mat4.create();
    tmp_x = Float.of_int(viewport.w / 40)
    tmp_y = Float.of_int(viewport.h / 40)
    match who with
    | {_YX} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      tmp_pMatrix
    | {_YZ} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      mat4.rotateY(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_ZX} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      mat4.rotateX(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_3D} ->
      do mat4.perspective(45., float_of_int(eng.canvas.width) / float_of_int(eng.canvas.height), 0.1, 100.0, tmp_pMatrix);
      c = mat4.create() ;
      do mat4.lookAt(vec3.from_public(eye), vec3.from_public((0.0, 0.0, 0.0)), vec3.from_public(up), c);
      do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
      tmp_pMatrix
    end ;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  draw_rep(r, g, b, rep) =
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;

  _ =
    match mode with
    | {normal} ->
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
      do draw_rep(1.0, 0.0, 0.0, repcoords.x);
      do draw_rep(0.0, 1.0, 0.0, repcoords.y);
      do draw_rep(0.0, 0.0, 1.0, repcoords.z);
      do match who with
        | {_3D} ->
          do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
          Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75)
        | _ -> void end;
      List.iter((object -> display(eng, pMatrix, mvMatrix, object, false)), scene)
    | {pick} ->
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(eng.framePickBuffer));
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false;
      do List.iter((object -> display(eng, pMatrix, mvMatrix, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

@private drawScene_and_register(org_eng, get_scene : (->Scene.Client.scene), get_mode, get_pending_mouseup_and_clean) =
  viewbox = setup_boxes(org_eng) ;
  rec aux(eng:engine) =
    gl = eng.context;
    (eng, scene) =
      f(is_selected, p) =
        match List.find((z_in_mem -> z_in_mem.id == p.id), eng.scene) with
        | { some=in_mem } -> { in_mem with position=p.cube; ~is_selected; color=p.color }
        | { none } -> Cube.create(gl, p, is_selected)
        end;
      scene : engine.scene =
        tmp = get_scene();
        others_scene = List.map(f(false, _), tmp.others.objs);
        selection_scene = Option.switch((the -> [ f(true, the) ]), List.empty, tmp.selection);
        List.append(selection_scene, others_scene);
      ({ eng with ~scene }, scene);
    eng =
      match get_mode() with
      | {pick=pos; ~cont} -> (
        match which_box(viewbox, pos) with
        | {out} -> eng
        | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
          //do Log.debug("Picking", "in box: '{who}' \t {viewbox}");
          this_viewbox = fetch_box(viewbox, who);
          (pMatrix, s) = drawScene_for_a_viewport(eng, who, this_viewbox, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
          mvMatrix = Stack.peek(s) ;
          do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
          do mat4.inverse(mvMatrix, mvMatrix);
          g(pos : Dom.dimensions) : vec3 =
            x = (float_of_int(pos.x_px - this_viewbox.x) / float_of_int(this_viewbox.w)) * 2.0 - 1.0;
            y = (float_of_int(pos.y_px - this_viewbox.y) / float_of_int(this_viewbox.h)) * 2.0 - 1.0;
            vstart = vec4.from_public((x, y, 1.0, 1.0));
            vtmp = vec4.from_public((9.9, 9.9, 9.9, 9.9));
            do mat4.multiplyVec4(mvMatrix, vstart, vtmp);
            vpreres = vec4.to_public(vtmp);
            vres = (vpreres.f1 / vpreres.f4, vpreres.f2 / vpreres.f4, vpreres.f3 / vpreres.f4);
            do Log.debug("Converting coord", "vstart={ vec4.str(vstart) }, \t vres={ vres }");
            vres;
          pos_result = g(pos);
          possible_target =
            pickedColor =
              data = Webgl.Uint8Array.from_int_list(List.init((_->123), 4));
              do Webgl.readPixels(gl, pos.x_px, pos.y_px, 1, 1, Webgl.RGBA(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(data));
              match Webgl.Uint8Array.to_int_list(data) with
              | [r, g, b, _] -> (r, g, b)
              | _ -> error("Picking failure")
              end ;
            do Log.debug("Picking", "Color is: { pickedColor }");
            f =
              (r, g, b) = pickedColor;
              (z -> (z.picking_color == (float_of_int(r) / 255., float_of_int(g) / 255., float_of_int(b) / 255.))) ;
            Option.map((u -> u.id), List.find(f, eng.scene));
          do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
          _ = cont({ mousedown; pos=this_viewbox.clear_near_far(pos_result); ~possible_target; coord_fixer=Option.some(g) });
          { eng with last_coord_fixer=Option.some(g) }
        end)
      | {normal} ->
        do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
        _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
        eng
      end ;
    do
      todo : list = get_pending_mouseup_and_clean();
      f((bad_pos, cont)) : void =
        g(last_coord_fixer) = cont(last_coord_fixer(bad_pos));
        Option.iter(g, eng.last_coord_fixer);
      List.iter(f, todo);
    do RequestAnimationFrame.request((_ -> aux(eng)), eng.selector);
    void
    ;
  aux(org_eng)
;

initGL(canvas_sel, width, height, get_scene, mouse_listener) : outcome =
  match WebGLUtils.setupWebGL_with_custom_failure(Dom.of_selection(canvas_sel)) with
  | { ok=context } ->
    mode = Mutable.make({normal});
    pending_mouseup = Mutable.make(List.empty);
    is_picking(m) = match m with | { pick=_; cont=_ } -> true | _ -> false end;
    _ =
      recompute_pos(rel_mouse_position_on_page) =
        m_pos = // we transform the pos to be relative to the upper leftcorner of the canvas
          c_pos = Dom.get_offset(canvas_sel);
          rel = rel_mouse_position_on_page;
          { x_px=max(rel.x_px - c_pos.x_px, 0); y_px=max(rel.y_px - c_pos.y_px, 0) };
        // now with gl the origin will be at the lower left corner
        gl_pos = { x_px=min(max(m_pos.x_px,0), width-1); y_px=min(max(height - 1 - m_pos.y_px, 0), height-1) };
        do Log.debug("P", "[({m_pos.x_px},{m_pos.y_px})] {gl_pos.x_px}, {gl_pos.y_px}");
        gl_pos;
      handler_mousedown(e) =
        gl_pos = recompute_pos(e.mouse_position_on_page);
        cont(e) =
          do mode.set({normal});
          mouse_listener(e);
        if not(is_picking(mode.get())) then mode.set({pick=gl_pos; ~cont}) else void;
      _ = Dom.bind(canvas_sel, { mousedown }, handler_mousedown);
      handler_mouseup(e) =
        gl_pos = recompute_pos(e.mouse_position_on_page);
        cont(x) = void;
        pending_mouseup.set(List.cons((gl_pos, cont), pending_mouseup.get()));
      _ = Dom.bind(canvas_sel, { mouseup }, handler_mouseup);
      void;
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height }; scene=List.empty; selector=canvas_sel;
        last_coord_fixer=Option.none });
      start = { start with shaderProgram=initShaders(gl) };
      start = { start with framePickBuffer=initPickBuffer(start) } ;
      { start with static_buffers.repcoords=
        { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) } };
    //Clear screen and make everything light gray // disabled to show png grid
    //do Webgl.clearColor(gl, 0.875, 0.875, 0.875, 1.0);
    //we should do depth testing so that things drawn behind other
    //things should be hidden by the things in front of them).
    do Webgl.clearDepth(gl, 1.0);
    do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
    do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
    do
      get_pending_mouseup_and_clean() =
        tmp = List.rev(pending_mouseup.get());
        do pending_mouseup.set(List.empty);
        tmp;
      drawScene_and_register(eng, get_scene, mode.get, get_pending_mouseup_and_clean);
    { success }
  | { ~ko } -> { failure=ko }
  end ;

@private type my_custom_shaderProgram = {
  program: Webgl.WebGLProgram;
  vertexPositionAttribute: Webgl.GLint;
  vertexNormalAttribute: Webgl.GLint;
  pMatrixUniform: Webgl.WebGLUniformLocation;
  mvMatrixUniform: Webgl.WebGLUniformLocation;
  nMatrixUniform: Webgl.WebGLUniformLocation;
  ambientColorUniform: Webgl.WebGLUniformLocation;
  lightingDirectionUniform: Webgl.WebGLUniformLocation;
  useLightingUniform: Webgl.WebGLUniformLocation
};

@private type static_buffer = {
  positions: Webgl.WebGLBuffer;
  itemSize: int; numItems: int;
  normals: Webgl.WebGLBuffer
};

@private type engine.scene = list(object);

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: engine.scene;
  selector: dom;
  last_coord_fixer: option(Dom.dimensions -> vec3)
} ;

@client initPickBuffer(eng) =
  gl = eng.context;
  framePickBuffer = Webgl.createFramebuffer(gl);
  renderPickBuffer = Webgl.createRenderbuffer(gl);
  pickTexture = Webgl.createTexture(gl);
  do Webgl.bindTexture(gl, Webgl.TEXTURE_2D(gl), Option.some(pickTexture));
  tex = Webgl.Uint8Array.from_int_list([0, 0, 0]);
  do Webgl.texImage2D(gl, Webgl.TEXTURE_2D(gl), 0, Webgl.RGB(gl), eng.canvas.width, eng.canvas.height, 0, Webgl.RGB(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(tex));
  do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(framePickBuffer));
  do Webgl.bindRenderbuffer(gl, Webgl.RENDERBUFFER(gl), Option.some(renderPickBuffer));
  do Webgl.renderbufferStorage(gl, Webgl.RENDERBUFFER(gl), Webgl.DEPTH_COMPONENT16(gl), eng.canvas.width, eng.canvas.height);
  do Webgl.bindRenderbuffer(gl, Webgl.RENDERBUFFER(gl), Option.none);

  do Webgl.framebufferTexture2D(gl, Webgl.FRAMEBUFFER(gl), Webgl.COLOR_ATTACHMENT0(gl), Webgl.TEXTURE_2D(gl), pickTexture, 0);
  do Webgl.framebufferRenderbuffer(gl, Webgl.FRAMEBUFFER(gl), Webgl.DEPTH_ATTACHMENT(gl), Webgl.RENDERBUFFER(gl), renderPickBuffer);
  do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
  do Webgl.bindTexture(gl, Webgl.TEXTURE_2D(gl), Option.none);
  framePickBuffer
;

initShaders(gl) =
  f(e, str) =
    shader = Webgl.createShader(gl, e);
    do Webgl.shaderSource(gl, shader, str);
    do Webgl.compileShader(gl, shader);
    shader;
  fragmentShader = f(Webgl.FRAGMENT_SHADER(gl), CustomShaders.shader_fs);
  vertexShader = f(Webgl.VERTEX_SHADER(gl), CustomShaders.shader_vs);
  // TODO getShaderParameter
  shaderProgram = Webgl.createProgram(gl);
  do Webgl.attachShader(gl, shaderProgram, vertexShader);
  do Webgl.attachShader(gl, shaderProgram, fragmentShader);
  do Webgl.linkProgram(gl, shaderProgram);
  // TODO : getProgramParameter(shaderProgram, gl.LINK_STATUS)) {
  do Webgl.useProgram(gl, shaderProgram);
  shaderProgram =
    vertexPositionAttribute = Webgl.getAttribLocation(gl, shaderProgram, "aVertexPosition");
    vertexNormalAttribute = Webgl.getAttribLocation(gl, shaderProgram, "aVertexNormal");
    do Webgl.enableVertexAttribArray(gl, vertexPositionAttribute);
    do Webgl.enableVertexAttribArray(gl, vertexNormalAttribute);
    { program = shaderProgram;
      ~vertexPositionAttribute;
      ~vertexNormalAttribute;
      pMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uPMatrix");
      mvMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uMVMatrix");
      nMatrixUniform = Webgl.getUniformLocation(gl, shaderProgram, "uNMatrix");
      ambientColorUniform = Webgl.getUniformLocation(gl, shaderProgram, "uAmbientColor");
      lightingDirectionUniform = Webgl.getUniformLocation(gl, shaderProgram, "uLightingDirection");
      useLightingUniform = Webgl.getUniformLocation(gl, shaderProgram, "uUseLighting");
    };
  shaderProgram
;

initLineXBuffers(gl, orient) =
  (vertices, vertexNormals) = match orient with
    | {x} -> ([ 0.0, 0.0, 0.0, 5.0, 0.0, 0.0 ], [ 2.5, 0.0, 0.0,        2.5, -1.0, 0.0 ])
    | {y} -> ([ 0.0, 0.0, 0.0, 0.0, 5.0, 0.0 ], [ 0.0, 2.5, 0.0,        -1.0, 2.5, 0.0 ])
    | {z} -> ([ 0.0, 0.0, 0.0, 0.0, 0.0, 5.0 ], [ 0.0, 0.0, 2.5,        0.0, -1.0, 2.5 ])
    end ;
  vertexPositionBuffer = Webgl.createBuffer(gl);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexPositionBuffer);
  do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
    Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)),
    Webgl.STATIC_DRAW(gl));
  vertexNormalBuffer = Webgl.createBuffer(gl);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexNormalBuffer);
  do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
    Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertexNormals)),
    Webgl.STATIC_DRAW(gl));
  { positions=vertexPositionBuffer; itemSize=3; numItems=2; normals=vertexNormalBuffer }
;

setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix) =
  a =
    b = mat4.to_list(pMatrix);
    c = Webgl.Float32Array.from_float_list(b);
    c;
  e =
    f = mat4.to_list(mvMatrix);
    g = Webgl.Float32Array.from_float_list(f);
    g;
  do Webgl.uniformMatrix4fv(gl, shaderProgram.pMatrixUniform, false, a);
  do Webgl.uniformMatrix4fv(gl, shaderProgram.mvMatrixUniform, false, e);
  normalMatrix = mat3.create();
  do mat4.toInverseMat3(mvMatrix, normalMatrix);
  do mat3.transpose(normalMatrix, normalMatrix);
  do Webgl.uniformMatrix3fv(gl, shaderProgram.nMatrixUniform, false, Webgl.Float32Array.from_float_list(mat3.to_list(normalMatrix)));
  void
;

setup_boxes(eng) =
  cnf_x(pos) = { pos with f1=0.0 }; cnf_y(pos) = { pos with f2=0.0 }; cnf_z(pos) = { pos with f3=0.0 };
  g(x:int, y:int, w:int, h:int, clear_near_far) =
    inbox(pos) = (pos.x_px >= x) && (pos.y_px >= y) && (pos.x_px < (w + x)) && (pos.y_px < (h + y));
    { ~x; ~y; ~w; ~h; ~inbox; ~clear_near_far } ;
  compute_left_right(x) = if ((mod(x, 2)) == 0) then
      a = (x / 2);
      ((a, a), 0)
    else
      b = (x / 2);
      ((b, b+1), 0);
  ((w_l, w_r), e_w) = compute_left_right(eng.canvas.width);
  ((h_u, h_d), e_h) = compute_left_right(eng.canvas.height);
  { _YX=g(0, h_d+e_h, w_l, h_u, cnf_z); _YZ=g(w_l+e_w, h_d+e_h, w_r, h_u, cnf_x);
    _ZX=g(0, 0, w_l, h_d, cnf_y);       _3D=g(w_l+e_w, 0, w_r, h_d, cnf_y) }
;

which_box(b, pos) =
  if b._YX.inbox(pos) then {_YX}
  else if b._YZ.inbox(pos) then {_YZ}
  else if b._ZX.inbox(pos) then {_ZX}
  else if b._3D.inbox(pos) then {_3D}
  else {out}
;

fetch_box(b, who) = match who with
  | {_YX} -> b._YX
  | {_YZ} -> b._YZ
  | {_ZX} -> b._ZX
  | {_3D} -> b._3D
  end ;

drawScene_for_a_viewport(eng, who, viewport, eye, up, scene, mode) =
  gl = eng.context; shaderProgram = eng.shaderProgram; repcoords = eng.static_buffers.repcoords;
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    tmp_pMatrix = mat4.create();
    tmp_x = Float.of_int(viewport.w / 40)
    tmp_y = Float.of_int(viewport.h / 40)
    match who with
    | {_YX} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      tmp_pMatrix
    | {_YZ} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      mat4.rotateY(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_ZX} ->
      do mat4.ortho(-tmp_x, tmp_x, -tmp_y, tmp_y, -10., 10., tmp_pMatrix);
      mat4.rotateX(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_3D} ->
      do mat4.perspective(45., float_of_int(eng.canvas.width) / float_of_int(eng.canvas.height), 0.1, 100.0, tmp_pMatrix);
      c = mat4.create() ;
      do mat4.lookAt(vec3.from_public(eye), vec3.from_public((0.0, 0.0, 0.0)), vec3.from_public(up), c);
      do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
      tmp_pMatrix
    end ;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  draw_rep(r, g, b, rep) =
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;

  _ =
    match mode with
    | {normal} ->
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
      do draw_rep(1.0, 0.0, 0.0, repcoords.x);
      do draw_rep(0.0, 1.0, 0.0, repcoords.y);
      do draw_rep(0.0, 0.0, 1.0, repcoords.z);
      do match who with
        | {_3D} ->
          do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
          Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75)
        | _ -> void end;
      List.iter((object -> display(eng, pMatrix, mvMatrix, object, false)), scene)
    | {pick} ->
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(eng.framePickBuffer));
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false;
      do List.iter((object -> display(eng, pMatrix, mvMatrix, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

@private drawScene_and_register(org_eng, get_scene : (->Scene.Client.scene), get_mode) =
  viewbox = setup_boxes(org_eng) ;
  rec aux(eng:engine) =
    gl = eng.context;
    (eng, scene) =
      f(is_selected, p) =
        match List.find((z_in_mem -> z_in_mem.id == p.id), eng.scene) with
        | { some=in_mem } -> { in_mem with position=p.cube; ~is_selected; color=p.color }
        | { none } -> Cube.create(gl, p, is_selected)
        end;
      scene : engine.scene =
        tmp = get_scene();
        others_scene = List.map(f(false, _), tmp.others.objs);
        selection_scene = Option.switch((the -> [ f(true, the) ]), List.empty, tmp.selection);
        List.append(selection_scene, others_scene);
      ({ eng with ~scene }, scene);
    eng =
      match get_mode() with
      | {pick=pos; ~cont} -> (
        match which_box(viewbox, pos) with
        | {out} -> eng
        | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
          //do Log.debug("Picking", "in box: '{who}' \t {viewbox}");
          this_viewbox = fetch_box(viewbox, who);
          (pMatrix, s) = drawScene_for_a_viewport(eng, who, this_viewbox, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
          mvMatrix = Stack.peek(s) ;
          do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
          do mat4.inverse(mvMatrix, mvMatrix);
          g(pos : Dom.dimensions) : vec3 =
            x = (float_of_int(pos.x_px - this_viewbox.x) / float_of_int(this_viewbox.w)) * 2.0 - 1.0;
            y = (float_of_int(pos.y_px - this_viewbox.y) / float_of_int(this_viewbox.h)) * 2.0 - 1.0;
            vstart = vec4.from_public((x, y, 1.0, 1.0));
            vtmp = vec4.from_public((9.9, 9.9, 9.9, 9.9));
            do mat4.multiplyVec4(mvMatrix, vstart, vtmp);
            vpreres = vec4.to_public(vtmp);
            vres = (vpreres.f1 / vpreres.f4, vpreres.f2 / vpreres.f4, vpreres.f3 / vpreres.f4);
            do Log.debug("Converting coord", "vstart={ vec4.str(vstart) }, \t vres={ vres }");
            vres;
          pos_result = g(pos);
          possible_target =
            pickedColor =
              data = Webgl.Uint8Array.from_int_list(List.init((_->123), 4));
              do Webgl.readPixels(gl, pos.x_px, pos.y_px, 1, 1, Webgl.RGBA(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(data));
              match Webgl.Uint8Array.to_int_list(data) with
              | [r, g, b, _] -> (r, g, b)
              | _ -> error("Picking failure")
              end ;
            do Log.debug("Picking", "Color is: { pickedColor }");
            f =
              (r, g, b) = pickedColor;
              (z -> (z.picking_color == (float_of_int(r) / 255., float_of_int(g) / 255., float_of_int(b) / 255.))) ;
            Option.map((u -> u.id), List.find(f, eng.scene));
          do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
          _ = cont({ mousedown; pos=this_viewbox.clear_near_far(pos_result); ~possible_target; coord_fixer=Option.some(g) });
          { eng with last_coord_fixer=Option.some(g) }
        end)
      | {normal} ->
        do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
        _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {normal});
        _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
        eng
      end ;
    do RequestAnimationFrame.request((_ -> aux(eng)), eng.selector);
    void
    ;
  aux(org_eng)
;

initGL(canvas_sel, width, height, get_scene, mouse_listener) : outcome =
  match WebGLUtils.setupWebGL_with_custom_failure(Dom.of_selection(canvas_sel)) with
  | { ok=context } ->
    mode = Mutable.make({normal});
    is_picking(m) = match m with | { pick=_; cont=_ } -> true | _ -> false end;
    _ =
      recompute_pos(rel_mouse_position_on_page) =
        m_pos = // we transform the pos to be relative to the upper leftcorner of the canvas
          c_pos = Dom.get_offset(canvas_sel);
          rel = rel_mouse_position_on_page;
          { x_px=max(rel.x_px - c_pos.x_px, 0); y_px=max(rel.y_px - c_pos.y_px, 0) };
        // now with gl the origin will be at the lower left corner
        gl_pos = { x_px=min(max(m_pos.x_px,0), width-1); y_px=min(max(height - 1 - m_pos.y_px, 0), height-1) };
        do Log.debug("P", "[({m_pos.x_px},{m_pos.y_px})] {gl_pos.x_px}, {gl_pos.y_px}");
        gl_pos;
      handler_mousedown(e) =
        gl_pos = recompute_pos(e.mouse_position_on_page);
        cont(e) =
          do mode.set({normal});
          mouse_listener(e);
        if not(is_picking(mode.get())) then mode.set({pick=gl_pos; ~cont}) else void;
      _ = Dom.bind(canvas_sel, { mousedown }, handler_mousedown);
      void;
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height }; scene=List.empty; selector=canvas_sel;
        last_coord_fixer=Option.none });
      start = { start with shaderProgram=initShaders(gl) };
      start = { start with framePickBuffer=initPickBuffer(start) } ;
      { start with static_buffers.repcoords=
        { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) } };
    //Clear screen and make everything light gray // disabled to show png grid
    //do Webgl.clearColor(gl, 0.875, 0.875, 0.875, 1.0);
    //we should do depth testing so that things drawn behind other
    //things should be hidden by the things in front of them).
    do Webgl.clearDepth(gl, 1.0);
    do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
    do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
    do drawScene_and_register(eng, get_scene, mode.get);
    { success }
  | { ~ko } -> { failure=ko }
  end ;