doing the same for sync msg

doing the same for sync msg

import stdlib.widgets.colorpicker
import stdlib.widgets.core

type GuiModeler.t = {
  modeler: Modeler.modeler;
  subjects: {
    tool: subject(Modeler.tool);
    selection: { this: subject(option(Scene.objects)); color: subject(ColorFloat.color) }
    };
  width: int; height: int
} ;

type subjects_changes = list({tool} / { selection: list({this} / {color}) });

apply_changes(state : GuiModeler.t, changes : subjects_changes) =
  modeler = state.modeler;
  a(tmp_a, sub) = match tmp_a with
    | {tool} -> { sub with tool=Observable.change_state(modeler.tool, sub.tool) }
    | {selection=chan_sel} ->
      b(tmp_b, sel) = match tmp_b with
        | {this} -> { sel with this=Observable.change_state(modeler.scene.selection, sel.this) }
        | {color} ->
          tmp = Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection);
          { sel with color=Observable.change_state(tmp , sel.color) }
        end;
      { sub with selection=List.fold(b, chan_sel, sub.selection) }
    end;
  { state with subjects=List.fold(a, changes : subjects_changes, state.subjects) } : GuiModeler.t;

@client GuiModeler = {{

  Sync = {{
    on_message(state : GuiModeler.t, message) =
      set_modeler(modeler) = { set={ state with ~modeler } } ;
      set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
      match message : Central.Modelers.sync.message with
      | {load=a_scene} ->
        modeler = Modeler.load(`Scene.Client`.load(a_scene, state.modeler.client_id), state.modeler.address, state.modeler.client_id, float_of_int(state.height) / float_of_int(state.width));
        set(apply_changes({state with ~modeler}, [{selection=[{this},{color}]}]))
      | { write_patch; ~patch } ->
        modeler = Modeler.write_patch(state.modeler, patch);
        set_modeler(modeler)
      end ;
  }}

  empty(scene_url, client_id, width, height) : GuiModeler.t =
    modeler = Modeler.empty(scene_url, client_id, float_of_int(height) / float_of_int(width));
    subjects = { tool=Observable.make(modeler.tool); selection={ this=Observable.make(modeler.scene.selection); color=Observable.make( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) ) } };
    { ~modeler; ~subjects; ~width; ~height };

  @private on_message(state : GuiModeler.t, message) =
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    send_opatch(opatch) =
      m(patch) = { apply_patch; ~patch; address=state.modeler.address };
      Option.iter((p -> Session.send(central_modelers, m(p))), opatch);
    apply_changes(modeler, cs) = apply_changes({ state with ~modeler }, cs);
    reset_subjects(modeler) = apply_changes(modeler, [{selection=[{this}, {color}] }]);
    match message with
    | {click_on_scene; ~where; ~possible_target} ->
      (modeler, opatch) = Modeler.tool_use(state.modeler, where, possible_target);
      do send_opatch(opatch);
      if Observable.get_state(state.subjects.selection.this) == modeler.scene.selection then
        { set={ state with ~modeler } }
      else
        set(reset_subjects(modeler))
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      set(apply_changes(modeler, [{tool}]))
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      set(apply_changes(modeler, [{selection=[{color}]}]))
    | {modeler_apply_possible_move; ~where; ~switch } ->
      (modeler, opatch) = Modeler.do_possible_move(state.modeler, where, switch);
      do send_opatch(opatch);
      { set={ state with ~modeler } }
    | {modeler_delete_scene_selection} ->
      (modeler, opatch) = Modeler.scene_delete_selection(state.modeler);
      do send_opatch(opatch);
      set(reset_subjects(modeler))
    end ;

  setup_menu(parent_sel, channel, s_tool) : void =
    f(some_tool) = match some_tool with
      | {selection} -> (Select, Cube)
      | {add_cube} -> (Select, Cube)
      end ;
    (id_a, id_b) = (Random.string(7), Random.string(7));
    on_tool_change =
      then_do(new_tool) =
        (text_a, text_b) = f(new_tool);
        Dom.transform([#{id_a}<- text_a, #{id_b}<- text_b]);
      { si=(-> not(Dom.is_empty(#{id_a})) && not(Dom.is_empty(#{id_b}))); ~then_do; else_autoclean };
    do Observable.register(on_tool_change, s_tool);
    menu =
      s(x) = (_ -> Session.send(channel, {modeler_change_tool=x}));

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

  setup_selection_view(parent_sel, channel, s_selection) : void =
    id = Random.string(7);
    do
      f(some_selection) = match some_selection with
        | {none} -> <></>
        | {some=_} ->
          id = Random.string(7);
          config =
            style = { WColorpicker.default_config_style with preview=WStyler.make_style(css { height:10px; width:10px; border:1px double black;}) };
            s(a_color) =
              Session.send(channel, {modeler_change_scene_selection_color; new_color=ColorFloat.from_Color_color(a_color)});
            { WColorpicker.default_config with on_select=s; ~style };
          do
            on_sel_color_change =
              then_do(f_new_color) =
                new_color = ColorFloat.to_Color_color(f_new_color);
                WColorpicker.set_color(id, config, new_color, false);
              { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
            Observable.register(on_sel_color_change, s_selection.color);

            Cube

Color:
{ WColorpicker.html(id, config) }

 Session.send(channel, {modeler_delete_scene_selection})}>Remove me

        end ;
      on_selection_change =
        then_do(new_selection) = Dom.transform([#{id}<- f(new_selection)]);
        { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
      Observable.register(on_selection_change, s_selection.this);
    sel =

;
    ignore(Dom.put_at_end(parent_sel, Dom.of_xhtml(sel)));

  init(scene_url, client_id, 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, get_camera_setting) =
        (channel, sync_channel, get_state) = SessionExt.make_2_side(empty(scene_url, client_id, width, height), on_message, Sync.on_message);
        do Session.send(central_modelers, {register; ~scene_url; ~sync_channel; ~client_id});
        (channel, (-> get_state().modeler.scene), (->get_state().subjects), (->get_state().modeler.views)) ;
      support_gpu_picking = Mutable.make(Option.none);
      mouse_listener =
        epsilon_sensi = 200;
        rec on_message_mouse_listener(state_mouse, msg) =
          match msg with
          | { mousedown; event=_; ~abs_full_pos; ~gl_pos; ~now } ->
            f(gpu_picker_regsiter) =
              sub(possible_target) =
                do Session.send(channel, {click_on_scene; where=gl_pos; ~possible_target});
                Session.send(channel_mouse_listener, { _internal; done_down });
              gpu_picker_regsiter((abs_full_pos, sub)) ;
            do Option.iter(f, support_gpu_picking.get());
            { set={ running_down=List.empty; time_tag=now } }
          | { mouseup; event=_; ~gl_pos; ~switch; now=when_up } ->
            f() =
              msg = {modeler_apply_possible_move; where=gl_pos; ~switch };
              Session.send(channel, msg);
            match state_mouse with
            | { nothing; ~time_tag } ->
              do if (when_up - time_tag) >= epsilon_sensi then f() else void;
              { unchanged }
            | { running_down=l; ~time_tag } ->
              { set={ running_down=List.cons((when_up, f), l); ~time_tag } }
            end
          | { _internal; done_down } -> match state_mouse with
            | { nothing; time_tag=_ } -> { unchanged }
            | { running_down=l; ~time_tag } ->
              g((when_up, f)) =
                if (when_up - time_tag) >= epsilon_sensi then f() else void;
              do List.iter(g, l); { set={ nothing; ~time_tag } }
            end
          end
        and val channel_mouse_listener = Session.make({nothing; time_tag=0}, on_message_mouse_listener);
        (msg -> Session.send(channel_mouse_listener, msg));
      res = initGL(#{id_canvas_canvas}, width, height, get_scene, get_camera_setting, mouse_listener, support_gpu_picking) ;
      if Outcome.is_failure(res) then ignore(Dom.put_replace(parent_sel, Dom.of_xhtml(fail_msg)))
      else
        the_subjects = get_subjects();
        do setup_menu(parent_sel, channel, the_subjects.tool);
        setup_selection_view(parent_sel, channel, the_subjects.selection);
    base =

<canvas width={width} height={height} id=#{id_canvas_canvas} onready={and_do} ></canvas>
;
    ignore(Dom.put_inside(parent_sel, Dom.of_xhtml(base)));

}}

import stdlib.widgets.colorpicker
import stdlib.widgets.core

type GuiModeler.t = {
  modeler: Modeler.modeler;
  subjects: {
    tool: subject(Modeler.tool);
    selection: { this: subject(option(Scene.objects)); color: subject(ColorFloat.color) }
    };
  width: int; height: int
} ;

type subjects_changes = list({tool} / { selection: list({this} / {color}) });

apply_changes(state : GuiModeler.t, changes : subjects_changes) =
  modeler = state.modeler;
  a(tmp_a, sub) = match tmp_a with
    | {tool} -> { sub with tool=Observable.change_state(modeler.tool, sub.tool) }
    | {selection=chan_sel} ->
      b(tmp_b, sel) = match tmp_b with
        | {this} -> { sel with this=Observable.change_state(modeler.scene.selection, sel.this) }
        | {color} ->
          tmp = Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection);
          { sel with color=Observable.change_state(tmp , sel.color) }
        end;
      { sub with selection=List.fold(b, chan_sel, sub.selection) }
    end;
  { state with subjects=List.fold(a, changes : subjects_changes, state.subjects) } : GuiModeler.t;

@client GuiModeler = {{

  Sync = {{
    on_message(state : GuiModeler.t, message) =
      set_modeler(modeler) = { set={ state with ~modeler } } ;
      set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
      match message : Central.Modelers.sync.message with
      | {load=a_scene} ->
        modeler = Modeler.load(`Scene.Client`.load(a_scene, state.modeler.client_id), state.modeler.address, state.modeler.client_id, float_of_int(state.height) / float_of_int(state.width));
        subjects =
          { state.subjects with selection={
              this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
              color=
                tmp = Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection);
                Observable.change_state(tmp , state.subjects.selection.color) } };
        set({ ~subjects; ~modeler })
      | { write_patch; ~patch } ->
        modeler = Modeler.write_patch(state.modeler, patch);
        set_modeler(modeler)
      end ;
  }}

  empty(scene_url, client_id, width, height) : GuiModeler.t =
    modeler = Modeler.empty(scene_url, client_id, float_of_int(height) / float_of_int(width));
    subjects = { tool=Observable.make(modeler.tool); selection={ this=Observable.make(modeler.scene.selection); color=Observable.make( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) ) } };
    { ~modeler; ~subjects; ~width; ~height };

  @private on_message(state : GuiModeler.t, message) =
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    send_opatch(opatch) =
      m(patch) = { apply_patch; ~patch; address=state.modeler.address };
      Option.iter((p -> Session.send(central_modelers, m(p))), opatch);
    apply_changes(modeler, cs) = apply_changes({ state with ~modeler }, cs);
    reset_subjects(modeler) = apply_changes(modeler, [{selection=[{this}, {color}] }]);
    match message with
    | {click_on_scene; ~where; ~possible_target} ->
      (modeler, opatch) = Modeler.tool_use(state.modeler, where, possible_target);
      do send_opatch(opatch);
      if Observable.get_state(state.subjects.selection.this) == modeler.scene.selection then
        { set={ state with ~modeler } }
      else
        set(reset_subjects(modeler))
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      set(apply_changes(modeler, [{tool}]))
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      set(apply_changes(modeler, [{selection=[{color}]}]))
    | {modeler_apply_possible_move; ~where; ~switch } ->
      (modeler, opatch) = Modeler.do_possible_move(state.modeler, where, switch);
      do send_opatch(opatch);
      { set={ state with ~modeler } }
    | {modeler_delete_scene_selection} ->
      (modeler, opatch) = Modeler.scene_delete_selection(state.modeler);
      do send_opatch(opatch);
      set(reset_subjects(modeler))
    end ;

  setup_menu(parent_sel, channel, s_tool) : void =
    f(some_tool) = match some_tool with
      | {selection} -> (Select, Cube)
      | {add_cube} -> (Select, Cube)
      end ;
    (id_a, id_b) = (Random.string(7), Random.string(7));
    on_tool_change =
      then_do(new_tool) =
        (text_a, text_b) = f(new_tool);
        Dom.transform([#{id_a}<- text_a, #{id_b}<- text_b]);
      { si=(-> not(Dom.is_empty(#{id_a})) && not(Dom.is_empty(#{id_b}))); ~then_do; else_autoclean };
    do Observable.register(on_tool_change, s_tool);
    menu =
      s(x) = (_ -> Session.send(channel, {modeler_change_tool=x}));

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

  setup_selection_view(parent_sel, channel, s_selection) : void =
    id = Random.string(7);
    do
      f(some_selection) = match some_selection with
        | {none} -> <></>
        | {some=_} ->
          id = Random.string(7);
          config =
            style = { WColorpicker.default_config_style with preview=WStyler.make_style(css { height:10px; width:10px; border:1px double black;}) };
            s(a_color) =
              Session.send(channel, {modeler_change_scene_selection_color; new_color=ColorFloat.from_Color_color(a_color)});
            { WColorpicker.default_config with on_select=s; ~style };
          do
            on_sel_color_change =
              then_do(f_new_color) =
                new_color = ColorFloat.to_Color_color(f_new_color);
                WColorpicker.set_color(id, config, new_color, false);
              { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
            Observable.register(on_sel_color_change, s_selection.color);

            Cube

Color:
{ WColorpicker.html(id, config) }

 Session.send(channel, {modeler_delete_scene_selection})}>Remove me

        end ;
      on_selection_change =
        then_do(new_selection) = Dom.transform([#{id}<- f(new_selection)]);
        { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
      Observable.register(on_selection_change, s_selection.this);
    sel =

;
    ignore(Dom.put_at_end(parent_sel, Dom.of_xhtml(sel)));

  init(scene_url, client_id, 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, get_camera_setting) =
        (channel, sync_channel, get_state) = SessionExt.make_2_side(empty(scene_url, client_id, width, height), on_message, Sync.on_message);
        do Session.send(central_modelers, {register; ~scene_url; ~sync_channel; ~client_id});
        (channel, (-> get_state().modeler.scene), (->get_state().subjects), (->get_state().modeler.views)) ;
      support_gpu_picking = Mutable.make(Option.none);
      mouse_listener =
        epsilon_sensi = 200;
        rec on_message_mouse_listener(state_mouse, msg) =
          match msg with
          | { mousedown; event=_; ~abs_full_pos; ~gl_pos; ~now } ->
            f(gpu_picker_regsiter) =
              sub(possible_target) =
                do Session.send(channel, {click_on_scene; where=gl_pos; ~possible_target});
                Session.send(channel_mouse_listener, { _internal; done_down });
              gpu_picker_regsiter((abs_full_pos, sub)) ;
            do Option.iter(f, support_gpu_picking.get());
            { set={ running_down=List.empty; time_tag=now } }
          | { mouseup; event=_; ~gl_pos; ~switch; now=when_up } ->
            f() =
              msg = {modeler_apply_possible_move; where=gl_pos; ~switch };
              Session.send(channel, msg);
            match state_mouse with
            | { nothing; ~time_tag } ->
              do if (when_up - time_tag) >= epsilon_sensi then f() else void;
              { unchanged }
            | { running_down=l; ~time_tag } ->
              { set={ running_down=List.cons((when_up, f), l); ~time_tag } }
            end
          | { _internal; done_down } -> match state_mouse with
            | { nothing; time_tag=_ } -> { unchanged }
            | { running_down=l; ~time_tag } ->
              g((when_up, f)) =
                if (when_up - time_tag) >= epsilon_sensi then f() else void;
              do List.iter(g, l); { set={ nothing; ~time_tag } }
            end
          end
        and val channel_mouse_listener = Session.make({nothing; time_tag=0}, on_message_mouse_listener);
        (msg -> Session.send(channel_mouse_listener, msg));
      res = initGL(#{id_canvas_canvas}, width, height, get_scene, get_camera_setting, mouse_listener, support_gpu_picking) ;
      if Outcome.is_failure(res) then ignore(Dom.put_replace(parent_sel, Dom.of_xhtml(fail_msg)))
      else
        the_subjects = get_subjects();
        do setup_menu(parent_sel, channel, the_subjects.tool);
        setup_selection_view(parent_sel, channel, the_subjects.selection);
    base =

<canvas width={width} height={height} id=#{id_canvas_canvas} onready={and_do} ></canvas>
;
    ignore(Dom.put_inside(parent_sel, Dom.of_xhtml(base)));

}}


adding the grid as static resource and displaying them

@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 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: object.simple; y: object.simple; z: object.simple }; grids: { _YX: object.simple; _YZ: object.simple;  _ZX: object.simple } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: engine.scene;
  selector: dom;
} ;

@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
;

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) =
  g(x:int, y:int, w:int, h:int) =
    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 } ;
  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); _YZ=g(w_l+e_w, h_d+e_h, w_r, h_u);
    _ZX=g(0, 0, w_l, h_d);       _3D=g(w_l+e_w, 0, w_r, h_d) }
;

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 ;

rel_pos_in_box(this_viewbox, pos) =
  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;
  (x, y);

drawScene_for_a_viewport(eng, who, viewport, camera_setting : mat4, scene, mode, ogrid) =
  gl = eng.context; shaderProgram = eng.shaderProgram; repcoords = eng.static_buffers.repcoords;
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix = camera_setting;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));

  _ =
    match mode with
    | {normal} ->
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
      do Option.iter((z -> display_simple(eng, z)), ogrid);
      do display_simple(eng, repcoords.x);
      do display_simple(eng, repcoords.y);
      do display_simple(eng, 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_pickable(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_pickable(eng, pMatrix, mvMatrix, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

@private drawScene_and_register(org_eng, viewbox, get_scene : (->Scene.Client.scene), get_camera_setting : (->Modeler.views)) =
  to_be_pick = Mutable.make(List.empty);
  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);
    views = get_camera_setting();

    tmp_f(pos) = (
      match which_box(viewbox, pos) with
      | {out} -> Option.none
      | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
        this_viewbox = fetch_box(viewbox, who);
        some_settings = fetch_box(views, who);
        mvMatrix = mat4.copy(some_settings.m) ;
        _ = drawScene_for_a_viewport(eng, who, this_viewbox, mvMatrix, scene, {pick}, Option.none);
        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));
        possible_target
      end);
    tmp = to_be_pick.get();
    do to_be_pick.set(List.empty);
    do List.iter(((pos, f) -> f(tmp_f(pos))), tmp);
    do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);

    eng =
      gr = eng.static_buffers.grids;
      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, views._YX.m, scene, {normal}, Option.some(gr._YX));
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, views._YZ.m, scene, {normal}, Option.some(gr._YZ));
      _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, views._ZX.m, scene, {normal}, Option.some(gr._ZX));
      _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, views._3D.m, scene, {normal}, Option.some(gr._ZX));
      eng;

    do RequestAnimationFrame.request((_ -> aux(eng)), eng.selector);
    void );

  do aux(org_eng);
  (a -> to_be_pick.set(List.cons(a, to_be_pick.get())))
;

initGL(canvas_sel, width, height, get_scene, get_camera_setting, mouse_listener, support_gpu_picking) : outcome =
  match WebGLUtils.setupWebGL_with_custom_failure(Dom.of_selection(canvas_sel)) with
  | { ok=context } ->
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height }; scene=List.empty; selector=canvas_sel });
      start = { start with shaderProgram=initShaders(gl) };
      start = { start with framePickBuffer=initPickBuffer(start) } ;
      grids =
        f(g) = Lines.grid(gl, -10, 10, 1, 10.0, g, (0.8, 0.8, 0.8));
        { _YX=f((a,b -> [a,b,0.0])); _YZ=f((a,b -> [0.0,a,b])); _ZX=f((a,b -> [a,0.0,b])) };
      { start with static_buffers.grids=grids;
        static_buffers.repcoords=
        { x=Lines.create(gl, [0.0, 0.0, 0.0, 5.0, 0.0, 0.0], (1.0, 0.0, 0.0)); y=Lines.create(gl, [0.0, 0.0, 0.0, 0.0, 5.0, 0.0], (0.0, 1.0, 0.0));
          z=Lines.create(gl, [0.0, 0.0, 0.0, 0.0, 0.0, 5.0], (0.0, 0.0, 1.0)) } };
    viewbox = setup_boxes(eng) ;
    {} =
      compute_abs_full_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
        abs_full_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", "[rel_mouse_position_on_page=({m_pos})] abs_full_pos=({abs_full_pos})");
        abs_full_pos;
      compute_rel_quarter_pos(abs_full_pos) =
        match which_box(viewbox, abs_full_pos) with
        | {out} -> ((0., 0., 0.), {f1}, {out})
        | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
          this_viewbox = fetch_box(viewbox, who);
          some_settings = fetch_box(get_camera_setting(), who);
          mvMatrix = mat4.copy(some_settings.m);
          do mat4.inverse(mvMatrix, mvMatrix);
          (x, y) = rel_pos_in_box(this_viewbox, abs_full_pos);
          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, some_settings.clear_near_far, who);
      handler_mousedown(event) =
        abs_full_pos=compute_abs_full_pos(event.mouse_position_on_page);
        (gl_pos, clear_near_far, _) = compute_rel_quarter_pos(abs_full_pos);
        mouse_listener({ mousedown; ~event; ~abs_full_pos; gl_pos=vec3.apply(gl_pos, clear_near_far, (_-> 0.0)) })
      do ignore(Dom.bind(canvas_sel, { mousedown }, handler_mousedown));
      handler_mouseup(event) =
        abs_full_pos=compute_abs_full_pos(event.mouse_position_on_page);
        (gl_pos, clear_near_far, who) = compute_rel_quarter_pos(abs_full_pos);
        match who with
        | {_3D} -> void
        | _ -> mouse_listener({ mouseup; ~event; gl_pos=vec3.apply(gl_pos, clear_near_far, (_-> 0.0)); switch=clear_near_far })
      do ignore(Dom.bind(canvas_sel, { mouseup }, handler_mouseup));
      void;
    //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
      gpu_picker_register = drawScene_and_register(eng, viewbox, get_scene, get_camera_setting);
      do ignore(support_gpu_picking.set(Option.some(gpu_picker_register)));
      void
    { 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 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: object.simple; y: object.simple; z: object.simple } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: engine.scene;
  selector: dom;
} ;

@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
;

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) =
  g(x:int, y:int, w:int, h:int) =
    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 } ;
  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); _YZ=g(w_l+e_w, h_d+e_h, w_r, h_u);
    _ZX=g(0, 0, w_l, h_d);       _3D=g(w_l+e_w, 0, w_r, h_d) }
;

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 ;

rel_pos_in_box(this_viewbox, pos) =
  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;
  (x, y);

drawScene_for_a_viewport(eng, who, viewport, camera_setting : mat4, 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 = camera_setting;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));

  _ =
    match mode with
    | {normal} ->
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
      do display_simple(eng, repcoords.x);
      do display_simple(eng, repcoords.y);
      do display_simple(eng, 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_pickable(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_pickable(eng, pMatrix, mvMatrix, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

@private drawScene_and_register(org_eng, viewbox, get_scene : (->Scene.Client.scene), get_camera_setting : (->Modeler.views)) =
  to_be_pick = Mutable.make(List.empty);
  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);
    views = get_camera_setting();

    tmp_f(pos) = (
      match which_box(viewbox, pos) with
      | {out} -> Option.none
      | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
        this_viewbox = fetch_box(viewbox, who);
        some_settings = fetch_box(views, who);
        mvMatrix = mat4.copy(some_settings.m) ;
        _ = drawScene_for_a_viewport(eng, who, this_viewbox, mvMatrix, scene, {pick});
        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));
        possible_target
      end);
    tmp = to_be_pick.get();
    do to_be_pick.set(List.empty);
    do List.iter(((pos, f) -> f(tmp_f(pos))), tmp);
    do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);

    eng =
      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, views._YX.m, scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, views._YZ.m, scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, views._ZX.m, scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, views._3D.m, scene, {normal});
      eng;

    do RequestAnimationFrame.request((_ -> aux(eng)), eng.selector);
    void );

  do aux(org_eng);
  (a -> to_be_pick.set(List.cons(a, to_be_pick.get())))
;

initGL(canvas_sel, width, height, get_scene, get_camera_setting, mouse_listener, support_gpu_picking) : outcome =
  match WebGLUtils.setupWebGL_with_custom_failure(Dom.of_selection(canvas_sel)) with
  | { ok=context } ->
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height }; scene=List.empty; selector=canvas_sel });
      start = { start with shaderProgram=initShaders(gl) };
      start = { start with framePickBuffer=initPickBuffer(start) } ;
      { start with static_buffers.repcoords=
        { x=Lines.create(gl, [0.0, 0.0, 0.0, 5.0, 0.0, 0.0], (1.0, 0.0, 0.0)); y=Lines.create(gl, [0.0, 0.0, 0.0, 0.0, 5.0, 0.0], (0.0, 1.0, 0.0));
          z=Lines.create(gl, [0.0, 0.0, 0.0, 0.0, 0.0, 5.0], (0.0, 0.0, 1.0)) } };
    viewbox = setup_boxes(eng) ;
    {} =
      compute_abs_full_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
        abs_full_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", "[rel_mouse_position_on_page=({m_pos})] abs_full_pos=({abs_full_pos})");
        abs_full_pos;
      compute_rel_quarter_pos(abs_full_pos) =
        match which_box(viewbox, abs_full_pos) with
        | {out} -> ((0., 0., 0.), {f1}, {out})
        | {_YX} as who | {_YZ} as who | {_ZX} as who | {_3D} as who ->
          this_viewbox = fetch_box(viewbox, who);
          some_settings = fetch_box(get_camera_setting(), who);
          mvMatrix = mat4.copy(some_settings.m);
          do mat4.inverse(mvMatrix, mvMatrix);
          (x, y) = rel_pos_in_box(this_viewbox, abs_full_pos);
          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, some_settings.clear_near_far, who);
      handler_mousedown(event) =
        abs_full_pos=compute_abs_full_pos(event.mouse_position_on_page);
        (gl_pos, clear_near_far, _) = compute_rel_quarter_pos(abs_full_pos);
        mouse_listener({ mousedown; ~event; ~abs_full_pos; gl_pos=vec3.apply(gl_pos, clear_near_far, (_-> 0.0)) })
      do ignore(Dom.bind(canvas_sel, { mousedown }, handler_mousedown));
      handler_mouseup(event) =
        abs_full_pos=compute_abs_full_pos(event.mouse_position_on_page);
        (gl_pos, clear_near_far, who) = compute_rel_quarter_pos(abs_full_pos);
        match who with
        | {_3D} -> void
        | _ -> mouse_listener({ mouseup; ~event; gl_pos=vec3.apply(gl_pos, clear_near_far, (_-> 0.0)); switch=clear_near_far })
      do ignore(Dom.bind(canvas_sel, { mouseup }, handler_mouseup));
      void;
    //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
      gpu_picker_register = drawScene_and_register(eng, viewbox, get_scene, get_camera_setting);
      do ignore(support_gpu_picking.set(Option.some(gpu_picker_register)));
      void
    { success }
  | { ~ko } -> { failure=ko }
  end ;


adding a private tag

adding a private tag

type Scene.objects = { cube: (float, float, float); id: hidden_id; color: ColorFloat.color } ;

type Scene.scene = { objs: list(Scene.objects); CPF: Fresh.next(hidden_id) };
type Scene.command = { add_cube; where: {x: float; y: float; z:float } } / { change_color; id: hidden_id; new_color: ColorFloat.color };
type Scene.patch = { pid: patch_id;  command: Scene.command };

type Scene.Client.command = { add_cube; where: {x: float; y: float; z:float } } / { selection_change_color; new_color: ColorFloat.color } / { selection_change; possible_target: option(hidden_id) };

type Scene.Client.scene = { selection: option(Scene.objects); others: Scene.scene };

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

type Modeler.modeler = {
  address: string;
  scene: Scene.Client.scene;
  tool: Modeler.tool;
  client_id: int
} ;

Scene = {{
  empty(F, client_id) : Scene.scene = { objs=List.empty; CPF=build_CPF(F, client_id) };

  CPF_change(scene, F, client_id) : Scene.scene = { scene with CPF=build_CPF(F, client_id) };

  cube(scene, pos) = {cube=pos; id=scene.CPF(); color=ColorFloat.random()};

  find_object(scene : Scene.scene, target_id) : option(Scene.objects) = List.find((z -> z.id == target_id), scene.objs);
  extract_object(scene, target_id) : (option(Scene.objects), Scene.scene) =
    (target, rest) = List.extract_p((z -> z.id == target_id), scene.objs);
    (target, { scene with objs=rest });
  extract_object_by_pos(scene, nth) : (option(Scene.objects), Scene.scene) =
    (target, rest) = List.extract(nth, scene.objs);
    (target, { scene with objs=rest });
  add_object(scene, object) : Scene.scene = { scene with objs=List.cons(object, scene.objs) };
  reinject_object(scene, oobject : option(Scene.objects)) : Scene.scene = Option.switch((an_o -> add_object(scene, an_o)), scene, oobject);

  @private apply_command(scene, command : Scene.command) : Scene.scene = match command with
    | {add_cube; ~where} -> add_object(scene, {cube=(where.x, where.y, where.z); id=scene.CPF(); color=ColorFloat.random()})
    | {change_color; ~id; ~new_color} ->
      (otarget, scene) = extract_object(scene, id);
      f(an_o) = add_object(scene, { an_o with color=new_color });
      Option.switch(f, scene, otarget)
    end ;

  apply_patch(scene, patch : Scene.patch) : Scene.scene = apply_command(scene, patch.command) ;
  apply_patchs(scene, patchs : list(Scene.patch)) : Scene.scene = List.fold((p, acc -> apply_patch(acc, p)), patchs, scene);

}} ;

`Scene.Client` = {{

  @private @client CHF : Fresh.next(int) = Fresh.client((i -> i : int));

  load(scene : Scene.scene, client_id) : Scene.Client.scene =
    scene = Scene.CPF_change(scene, CHF, client_id);
    (selection, others) = Scene.extract_object_by_pos(scene, 0);
    { ~selection; ~others };

  empty(client_id) : Scene.Client.scene =
    load(Scene.empty(CHF, client_id), client_id);

  @private get_scene(scene : Scene.Client.scene) : Scene.scene = Option.switch((sel -> Scene.add_object(scene.others, sel)), scene.others, scene.selection);

  command_to_scene_patch(scene, cmd : Scene.Client.command) : option(Scene.patch) =
    match cmd with
    | { add_cube; ... } as command -> Option.some({ pid=scene.others.CPF(); ~command })
    | { selection_change_color; ~new_color } ->
      f(sel) = { pid=scene.others.CPF(); command={ change_color; id=sel.id ; ~new_color } };
      Option.map(f, scene.selection)
    | { selection_change; ... } -> Option.none
    end;

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

  write_patch(scene, patch : Scene.patch) : Scene.Client.scene =
    (selection, others) =
      base = Scene.apply_patch(get_scene(scene), patch);
      g(sel) = Scene.extract_object(base, sel.id);
      Option.switch(g, (Option.none, base), scene.selection);
    { scene with ~others; ~selection };

  apply_command(scene, command : Scene.Client.command) : (Scene.Client.scene, option(Scene.patch)) =
    match command with
    | { selection_change; ~possible_target } -> (selection_change_low(scene, possible_target), Option.none)
    | _ ->
      command = command_to_scene_patch(scene, command);
      do Log.debug("apply_command", "{command} \t {scene.selection}");
      f(p) = write_patch(scene, p);
      (Option.switch(f, scene, command), command)
    end ;

  others_add_cube(scene, where) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {add_cube; ~where});

  selection_change(scene, possible_target) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_change; ~possible_target});

  selection_change_color(scene, new_color) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_change_color; ~new_color});

}} ;

Modeler = {{
  load(scene, scene_url, client_id) : Modeler.modeler = { address=scene_url; ~scene; tool={selection}; ~client_id } ;
  empty(scene_url, client_id) : Modeler.modeler = load(`Scene.Client`.empty(client_id), scene_url, client_id);

  tool_use(modeler, where, possible_target) : (Modeler.modeler, option(Scene.patch)) =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' with tool: '{modeler.tool}'");
    match modeler.tool with
    | {add_cube} ->
      (scene, opatch) = `Scene.Client`.others_add_cube(modeler.scene, where);
      ({ modeler with ~scene }, opatch)
    | {selection} ->
      (scene, opatch) = `Scene.Client`.selection_change(modeler.scene, possible_target);
      ({ modeler with ~scene }, opatch)
    end ;

  tool_change(modeler, new_tool) : Modeler.modeler = { modeler with tool=new_tool };

  scene_change_selection_color(modeler, new_color) : (Modeler.modeler, option(Scene.patch)) =
    (scene, opatch) = `Scene.Client`.selection_change_color(modeler.scene, new_color);
    ({ modeler with ~scene }, opatch);

  write_patch(modeler, patch) : Modeler.modeler =
    if (modeler.client_id == get_client_id_from_patch_id(patch.pid)) then
      modeler
    else
      scene = `Scene.Client`.write_patch(modeler.scene, patch);
      { modeler with ~scene };

}} ;

type Scene.objects = { cube: (float, float, float); id: hidden_id; color: ColorFloat.color } ;

type Scene.scene = { objs: list(Scene.objects); CPF: Fresh.next(hidden_id) };
type Scene.command = { add_cube; where: {x: float; y: float; z:float } } / { change_color; id: hidden_id; new_color: ColorFloat.color };
type Scene.patch = { pid: patch_id;  command: Scene.command };

type Scene.Client.command = { add_cube; where: {x: float; y: float; z:float } } / { selection_change_color; new_color: ColorFloat.color } / { selection_change; possible_target: option(hidden_id) };

type Scene.Client.scene = { selection: option(Scene.objects); others: Scene.scene };

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

type Modeler.modeler = {
  address: string;
  scene: Scene.Client.scene;
  tool: Modeler.tool;
  client_id: int
} ;

Scene = {{
  empty(F, client_id) : Scene.scene = { objs=List.empty; CPF=build_CPF(F, client_id) };

  CPF_change(scene, F, client_id) : Scene.scene = { scene with CPF=build_CPF(F, client_id) };

  cube(scene, pos) = {cube=pos; id=scene.CPF(); color=ColorFloat.random()};

  find_object(scene : Scene.scene, target_id) : option(Scene.objects) = List.find((z -> z.id == target_id), scene.objs);
  extract_object(scene, target_id) : (option(Scene.objects), Scene.scene) =
    (target, rest) = List.extract_p((z -> z.id == target_id), scene.objs);
    (target, { scene with objs=rest });
  extract_object_by_pos(scene, nth) : (option(Scene.objects), Scene.scene) =
    (target, rest) = List.extract(nth, scene.objs);
    (target, { scene with objs=rest });
  add_object(scene, object) : Scene.scene = { scene with objs=List.cons(object, scene.objs) };
  reinject_object(scene, oobject : option(Scene.objects)) : Scene.scene = Option.switch((an_o -> add_object(scene, an_o)), scene, oobject);

  apply_command(scene, command : Scene.command) : Scene.scene = match command with
    | {add_cube; ~where} -> add_object(scene, {cube=(where.x, where.y, where.z); id=scene.CPF(); color=ColorFloat.random()})
    | {change_color; ~id; ~new_color} ->
      (otarget, scene) = extract_object(scene, id);
      f(an_o) = add_object(scene, { an_o with color=new_color });
      Option.switch(f, scene, otarget)
    end ;

  apply_patch(scene, patch : Scene.patch) : Scene.scene = apply_command(scene, patch.command) ;
  apply_patchs(scene, patchs : list(Scene.patch)) : Scene.scene = List.fold((p, acc -> apply_patch(acc, p)), patchs, scene);

}} ;

`Scene.Client` = {{

  @private @client CHF : Fresh.next(int) = Fresh.client((i -> i : int));

  load(scene : Scene.scene, client_id) : Scene.Client.scene =
    scene = Scene.CPF_change(scene, CHF, client_id);
    (selection, others) = Scene.extract_object_by_pos(scene, 0);
    { ~selection; ~others };

  empty(client_id) : Scene.Client.scene =
    load(Scene.empty(CHF, client_id), client_id);

  @private get_scene(scene : Scene.Client.scene) : Scene.scene = Option.switch((sel -> Scene.add_object(scene.others, sel)), scene.others, scene.selection);

  command_to_scene_patch(scene, cmd : Scene.Client.command) : option(Scene.patch) =
    match cmd with
    | { add_cube; ... } as command -> Option.some({ pid=scene.others.CPF(); ~command })
    | { selection_change_color; ~new_color } ->
      f(sel) = { pid=scene.others.CPF(); command={ change_color; id=sel.id ; ~new_color } };
      Option.map(f, scene.selection)
    | { selection_change; ... } -> Option.none
    end;

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

  write_patch(scene, patch : Scene.patch) : Scene.Client.scene =
    (selection, others) =
      base = Scene.apply_patch(get_scene(scene), patch);
      g(sel) = Scene.extract_object(base, sel.id);
      Option.switch(g, (Option.none, base), scene.selection);
    { scene with ~others; ~selection };

  apply_command(scene, command : Scene.Client.command) : (Scene.Client.scene, option(Scene.patch)) =
    match command with
    | { selection_change; ~possible_target } -> (selection_change_low(scene, possible_target), Option.none)
    | _ ->
      command = command_to_scene_patch(scene, command);
      do Log.debug("apply_command", "{command} \t {scene.selection}");
      f(p) = write_patch(scene, p);
      (Option.switch(f, scene, command), command)
    end ;

  others_add_cube(scene, where) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {add_cube; ~where});

  selection_change(scene, possible_target) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_change; ~possible_target});

  selection_change_color(scene, new_color) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_change_color; ~new_color});

}} ;

Modeler = {{
  load(scene, scene_url, client_id) : Modeler.modeler = { address=scene_url; ~scene; tool={selection}; ~client_id } ;
  empty(scene_url, client_id) : Modeler.modeler = load(`Scene.Client`.empty(client_id), scene_url, client_id);

  tool_use(modeler, where, possible_target) : (Modeler.modeler, option(Scene.patch)) =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' with tool: '{modeler.tool}'");
    match modeler.tool with
    | {add_cube} ->
      (scene, opatch) = `Scene.Client`.others_add_cube(modeler.scene, where);
      ({ modeler with ~scene }, opatch)
    | {selection} ->
      (scene, opatch) = `Scene.Client`.selection_change(modeler.scene, possible_target);
      ({ modeler with ~scene }, opatch)
    end ;

  tool_change(modeler, new_tool) : Modeler.modeler = { modeler with tool=new_tool };

  scene_change_selection_color(modeler, new_color) : (Modeler.modeler, option(Scene.patch)) =
    (scene, opatch) = `Scene.Client`.selection_change_color(modeler.scene, new_color);
    ({ modeler with ~scene }, opatch);

  write_patch(modeler, patch) : Modeler.modeler =
    if (modeler.client_id == get_client_id_from_patch_id(patch.pid)) then
      modeler
    else
      scene = `Scene.Client`.write_patch(modeler.scene, patch);
      { modeler with ~scene };

}} ;


engine start to have his own low level scene

@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 = {
  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: list((vec3, object))
} ;

@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) =
  sep_largeur = 2;
  g(x, y, w, h) = { ~x; ~y; ~w; ~h } ;
  compute_left_right(x) = if ((mod(x, 2)) == 0) then
      a = (x / 2) - 1;
      (a, a)
    else
      b = (x / 2);
      (b - 1, b);
  (w_l, w_r) = compute_left_right(eng.canvas.width);
  (h_u, h_d) = compute_left_right(eng.canvas.height);
  { _YX=g(0, h_d+sep_largeur, w_l, h_u); _YZ=g(w_l+sep_largeur, h_d+sep_largeur, w_r, h_u);
    _ZX=g(0, 0, w_l, h_d); _3D=g(w_l+sep_largeur, 0, w_r, h_d) }
;

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();
    match who with
    | {_YX} ->
      do mat4.ortho(-7., 7., -7., 7., -10., 10., tmp_pMatrix);
      tmp_pMatrix
    | {_YZ} ->
      do mat4.ortho(-7., 7., -7., 7., -10., 10., tmp_pMatrix);
      mat4.rotateY(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_ZX} ->
      do mat4.ortho(-7., 7., -7., 7., -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.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    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 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 Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
      do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
      List.iter(((_, (pos, object)) -> display(eng, pMatrix, mvMatrix, pos, 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(((_, (pos, object)) -> display(eng, pMatrix, mvMatrix, pos, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

drawScene_and_register(eng, get_scene : (->Modeler.scene), get_mode) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    scene =
      f(p) =
        match List.find((z -> z.f2.id == p.id), eng.scene) with
        | { ~some } -> (p, some)
        | { none } -> (p, (p.cube, Cube.create(gl, p.id)))
        end;
      List.map(f, get_scene());
    eng = { eng with scene=List.map((z -> z.f2), scene) };
    do match get_mode() with
    | {pick=pos; ~cont} ->
      //do Log.debug("Picking", "...");
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {pick});
      (pMatrix, s) = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {pick});
      //(pMatrix, s) = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      x = (float_of_int(pos.x_px - viewbox._ZX.x) / float_of_int(viewbox._ZX.w)) * 2.0 - 1.0;
      y = (float_of_int(pos.y_px - viewbox._ZX.y) / float_of_int(viewbox._ZX.h)) * 2.0 - 1.0;
      mvMatrix = Stack.peek(s) ;
      do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
      do mat4.inverse(mvMatrix, mvMatrix);
      v1 = vec4.from_public((x, y, 1.0, 1.0));
      v2 = vec4.from_public((9.9, 9.9, 9.9, 9.9));
      do mat4.multiplyVec4(mvMatrix, v1, v2);
      v22 = vec4.to_public(v2);
      //v22 = { v22 with f2=0.0 };
      v2 = (v22.f1 / v22.f4, v22.f2 / v22.f4, v22.f3 / v22.f4, v22.f4);
      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));
      pickedColor = 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 }; v1={ vec4.str(v1) }, \t v2={ v2 }");
      //do jlog("Color is: { pickedColor }; v={ vec3.str(v) }");
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
      cont({ mousedown; x=v2.f1; z=v2.f3})
    | {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});
      void
    end ;
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(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_client({normal});
    is_picking(m) = match m with | { pick=_; cont=_ } -> true | _ -> false end;
    _ =
      handler(e) =
        m_pos = // we transform the pos to be relative to the upper leftcorner of the canvas
          c_pos = Dom.get_offset(#{id_canvas_area});
          rel = e.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), height-1); y_px=min(max(height - 1 - m_pos.y_px, 0), width-1) };
        cont(e) =
          do mode.set({normal});
          mouse_listener(e);
        do if not(is_picking(mode.get())) then mode.set({pick=gl_pos; ~cont});
        Log.debug("P", "[(,)-({m_pos.x_px},{m_pos.y_px})] {gl_pos.x_px}, {gl_pos.y_px}");
      Dom.bind(canvas_sel, { mousedown }, handler);
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height }; scene=List.empty });
      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
    do Webgl.clearColor(gl, 0.9, 0.9, 0.9, 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 ;

@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 = {
  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
} ;

@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) =
  sep_largeur = 2;
  g(x, y, w, h) = { ~x; ~y; ~w; ~h } ;
  compute_left_right(x) = if ((mod(x, 2)) == 0) then
      a = (x / 2) - 1;
      (a, a)
    else
      b = (x / 2);
      (b - 1, b);
  (w_l, w_r) = compute_left_right(eng.canvas.width);
  (h_u, h_d) = compute_left_right(eng.canvas.height);
  { _YX=g(0, h_d+sep_largeur, w_l, h_u); _YZ=g(w_l+sep_largeur, h_d+sep_largeur, w_r, h_u);
    _ZX=g(0, 0, w_l, h_d); _3D=g(w_l+sep_largeur, 0, w_r, h_d) }
;

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();
    match who with
    | {_YX} ->
      do mat4.ortho(-7., 7., -7., 7., -10., 10., tmp_pMatrix);
      tmp_pMatrix
    | {_YZ} ->
      do mat4.ortho(-7., 7., -7., 7., -10., 10., tmp_pMatrix);
      mat4.rotateY(tmp_pMatrix, (90. * Math.PI / 180.), tmp_pMatrix)
    | {_ZX} ->
      do mat4.ortho(-7., 7., -7., 7., -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.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    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 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 Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
      do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
      List.iter(((pos, object) -> display(eng, pMatrix, mvMatrix, pos.cube, 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(((pos, object) -> display(eng, pMatrix, mvMatrix, pos.cube, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

drawScene_and_register(eng, get_scene : (->Modeler.scene), get_mode) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    scene = List.map((p -> (p, Cube.create(gl, p.id))), get_scene());
    do match get_mode() with
    | {pick=pos; ~cont} ->
      //do Log.debug("Picking", "...");
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {pick});
      (pMatrix, s) = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {pick});
      //(pMatrix, s) = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      x = (float_of_int(pos.x_px - viewbox._ZX.x) / float_of_int(viewbox._ZX.w)) * 2.0 - 1.0;
      y = (float_of_int(pos.y_px - viewbox._ZX.y) / float_of_int(viewbox._ZX.h)) * 2.0 - 1.0;
      mvMatrix = Stack.peek(s) ;
      do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
      do mat4.inverse(mvMatrix, mvMatrix);
      v1 = vec4.from_public((x, y, 1.0, 1.0));
      v2 = vec4.from_public((9.9, 9.9, 9.9, 9.9));
      do mat4.multiplyVec4(mvMatrix, v1, v2);
      v22 = vec4.to_public(v2);
      //v22 = { v22 with f2=0.0 };
      v2 = (v22.f1 / v22.f4, v22.f2 / v22.f4, v22.f3 / v22.f4, v22.f4);
      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));
      pickedColor = 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 }; v1={ vec4.str(v1) }, \t v2={ v2 }");
      //do jlog("Color is: { pickedColor }; v={ vec3.str(v) }");
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
      cont({ mousedown; x=v2.f1; z=v2.f3})
    | {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});
      void
    end ;
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(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_client({normal});
    is_picking(m) = match m with | { pick=_; cont=_ } -> true | _ -> false end;
    _ =
      handler(e) =
        m_pos = // we transform the pos to be relative to the upper leftcorner of the canvas
          c_pos = Dom.get_offset(#{id_canvas_area});
          rel = e.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), height-1); y_px=min(max(height - 1 - m_pos.y_px, 0), width-1) };
        cont(e) =
          do mode.set({normal});
          mouse_listener(e);
        do if not(is_picking(mode.get())) then mode.set({pick=gl_pos; ~cont});
        Log.debug("P", "[(,)-({m_pos.x_px},{m_pos.y_px})] {gl_pos.x_px}, {gl_pos.y_px}");
      Dom.bind(canvas_sel, { mousedown }, handler);
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height } });
      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
    do Webgl.clearColor(gl, 0.9, 0.9, 0.9, 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 ;


adding some coercion

adding some coercion

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

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

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

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

Scene = {{
  find_object(objects, target_id) : option(Modeler.objects) = List.find((z -> z.id == target_id), objects);
  extract_object(objects, target_id) : (option(Modeler.objects), list(Modeler.objects)) = List.extract_p((z -> z.id == target_id), objects);
  add_object(objects, object) : list(Modeler.objects) = List.cons(object, objects);

  change_selection_color(scene, new_color) : Modeler.scene =
    match scene.selection with
    | {none} -> scene
    | {some=an_object} -> { scene with selection=Option.some({ an_object with color=new_color }) }
    end ;

  empty() : Modeler.scene =
    c(pos) = {cube=pos; id=CHF(); color=ColorFloat.random()};
    { selection=Option.some(c((0.0, 0.0, -3.0))); others=[ c((3.0, 0.0, 0.0)), c((6.0, 0.0, 0.0)) ] };

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

  selection(scene, possible_target) : Modeler.scene =
    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) : Modeler.modeler = { address=scene_url; scene=Scene.empty(); tool={selection} } ;

  use_tool(modeler, where, possible_target)  : Modeler.modeler =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' with tool: '{modeler.tool}'");
    match modeler.tool 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_tool) : Modeler.modeler = { modeler with tool=new_tool };

}} ;

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

@client GuiModeler = {{

  empty(scene_url) : GuiModeler.t =
    modeler = Modeler.empty(scene_url);
    subjects = { tool=Observable.make(modeler.tool); selection=Observable.make(modeler.scene.selection) };
    { ~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} ->
      modeler = Modeler.use_tool(state.modeler, where, possible_target);
      if Observable.get_state(state.subjects.selection) == modeler.scene.selection then
        set_modeler(modeler)
      else
        subjects = { state.subjects with selection=Observable.change_state(modeler.scene.selection, state.subjects.selection) };
        set({ ~subjects; ~modeler })
    | {change_tool=new_tool} ->
      modeler = Modeler.change_tool(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    end ;

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

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

  setup_selection_view(parent_sel, s_selection) : void =
    id = Random.string(7);
    do
      f(some_selection) = match some_selection with
        | {none} -> <></>
        | {~some} -> <>{ "{some}" }</>
        end ;
      on_selection_change =
        then_do(new_selection) = Dom.transform([#{id}<- f(new_selection)]);
        { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
      Observable.register(on_selection_change, s_selection);
    sel =

;
    ignore(Dom.put_at_end(parent_sel, Dom.of_xhtml(sel)));

  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
        the_subjects = get_subjects();
        do setup_menu(parent_sel, channel, the_subjects.tool);
        setup_selection_view(parent_sel, the_subjects.selection);
    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; color: ColorFloat.color } ;

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

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

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

Scene = {{
  find_object(objects, target_id) : option(Modeler.objects) = List.find((z -> z.id == target_id), objects);
  extract_object(objects, target_id) : (option(Modeler.objects), list(Modeler.objects)) = List.extract_p((z -> z.id == target_id), objects);
  add_object(objects, object) : list(Modeler.objects) = List.cons(object, objects);

  change_selection_color(scene, new_color) : Modeler.scene =
    match scene.selection with
    | {none} -> scene
    | {some=an_object} -> { scene with selection=Option.some({ an_object with color=new_color }) }
    end ;

  empty() : Modeler.scene =
    c(pos) = {cube=pos; id=CHF(); color=ColorFloat.random()};
    { selection=Option.some(c((0.0, 0.0, -3.0))); others=[ c((3.0, 0.0, 0.0)), c((6.0, 0.0, 0.0)) ] };

  add_cube(scene, where) = { scene with others=List.cons({cube=(where.x, where.y, where.z); id=CHF(); color=ColorFloat.random()}, 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) : Modeler.modeler = { address=scene_url; scene=Scene.empty(); tool={selection} } ;

  use_tool(modeler, where, possible_target)  : Modeler.modeler =
    do Log.info("Modeler", "using tool at ({where}) perhaps on the target: '{possible_target}' with tool: '{modeler.tool}'");
    match modeler.tool 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_tool) : Modeler.modeler = { modeler with tool=new_tool };

}} ;

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

@client GuiModeler = {{

  empty(scene_url) : GuiModeler.t =
    modeler = Modeler.empty(scene_url);
    subjects = { tool=Observable.make(modeler.tool); selection=Observable.make(modeler.scene.selection) };
    { ~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} ->
      modeler = Modeler.use_tool(state.modeler, where, possible_target);
      if Observable.get_state(state.subjects.selection) == modeler.scene.selection then
        set_modeler(modeler)
      else
        subjects = { state.subjects with selection=Observable.change_state(modeler.scene.selection, state.subjects.selection) };
        set({ ~subjects; ~modeler })
    | {change_tool=new_tool} ->
      modeler = Modeler.change_tool(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    end ;

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

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

  setup_selection_view(parent_sel, s_selection) : void =
    id = Random.string(7);
    do
      f(some_selection) = match some_selection with
        | {none} -> <></>
        | {~some} -> <>{ "{some}" }</>
        end ;
      on_selection_change =
        then_do(new_selection) = Dom.transform([#{id}<- f(new_selection)]);
        { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
      Observable.register(on_selection_change, s_selection);
    sel =

;
    ignore(Dom.put_at_end(parent_sel, Dom.of_xhtml(sel)));

  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
        the_subjects = get_subjects();
        do setup_menu(parent_sel, channel, the_subjects.tool);
        setup_selection_view(parent_sel, the_subjects.selection);
    base =
      <canvas width={width} height={height} id=#{id_canvas_canvas} onready={and_do} ></canvas>;
    ignore(Dom.put_inside(parent_sel, Dom.of_xhtml(base)));

}}