the client send patch to the server

the client send patch to the server

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

@client GuiModeler = {{

  Sync = {{
    on_message(state, message) =
      set_modeler(modeler) = { set={ state with ~modeler } } ;
      set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
      match message with
      | {load=a_scene} ->
        modeler = Modeler.load(`Scene.Client`.load(a_scene, state.modeler.client_id), state.modeler.address, state.modeler.client_id);
        set_modeler(modeler)
      end ;
  }}

  empty(scene_url, client_id) : GuiModeler.t =
    modeler = Modeler.empty(scene_url, client_id);
    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 };

  @private on_message(state : GuiModeler.t, message) =
    set_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    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);
    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_modeler(modeler)
      else
        subjects = { state.subjects with selection={ this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
                                                     color=Observable.change_state( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) , state.subjects.selection.color) } };
        set({ ~subjects; ~modeler })
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      subjects = { state.subjects with selection.color=Observable.change_state(new_color, state.subjects.selection.color) };
      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, {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);
          do
            c(a_color) = Color.color_to_string(a_color);
            on_sel_color_change =
              then_do(new_color) =
                new_color = ColorFloat.to_Color_color(new_color);
                do Dom.transform([#{id}<- c(new_color)]);
                Dom.set_style(#{id}, [ {background=Css_build.background_color(new_color)} ]);
              { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
            Observable.register(on_sel_color_change, s_selection.color);
          s(new_color) = (_ -> Session.send(channel, {modeler_change_scene_selection_color; ~new_color}));
          Color: *
        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) =
        (channel, sync_channel, get_state) = SessionExt.make_2_side(empty(scene_url, client_id), 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)) ;
      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, 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)));

}}

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

@client GuiModeler = {{

  Sync = {{
    on_message(state, message) =
      set_modeler(modeler) = { set={ state with ~modeler } } ;
      set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
      match message with
      | {load=a_scene} ->
        modeler = Modeler.load(`Scene.Client`.load(a_scene, state.modeler.client_id), state.modeler.address, state.modeler.client_id);
        set_modeler(modeler)
      end ;
  }}

  empty(scene_url, client_id) : GuiModeler.t =
    modeler = Modeler.empty(scene_url, client_id);
    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 };

  @private on_message(state : GuiModeler.t, message) =
    set_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    match message with
    | {click_on_scene; ~where; ~possible_target} ->
      (modeler, opatch) = Modeler.tool_use(state.modeler, where, possible_target);
      if Observable.get_state(state.subjects.selection.this) == modeler.scene.selection then
        set_modeler(modeler)
      else
        subjects = { state.subjects with selection={ this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
                                                     color=Observable.change_state( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) , state.subjects.selection.color) } };
        set({ ~subjects; ~modeler })
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      subjects = { state.subjects with selection.color=Observable.change_state(new_color, state.subjects.selection.color) };
      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, {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);
          do
            c(a_color) = Color.color_to_string(a_color);
            on_sel_color_change =
              then_do(new_color) =
                new_color = ColorFloat.to_Color_color(new_color);
                do Dom.transform([#{id}<- c(new_color)]);
                Dom.set_style(#{id}, [ {background=Css_build.background_color(new_color)} ]);
              { si=(->not(Dom.is_empty(#{id}))); ~then_do; else_autoclean };
            Observable.register(on_sel_color_change, s_selection.color);
          s(new_color) = (_ -> Session.send(channel, {modeler_change_scene_selection_color; ~new_color}));
          Color: *
        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) =
        (channel, sync_channel, get_state) = SessionExt.make_2_side(empty(scene_url, client_id), 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)) ;
      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, 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)));

}}


removing unused variable

removing unused variable

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

@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_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    _set_with_last(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);
    reset_subjects(modeler) =
      subjects = { state.subjects with selection={ this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
                                                   color=Observable.change_state( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) , state.subjects.selection.color) } };
      { state with ~subjects; ~modeler };
    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
        state = reset_subjects(modeler);
        set(state)
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      subjects = { state.subjects with selection.color=Observable.change_state(new_color, state.subjects.selection.color) };
      set({ ~subjects; ~modeler})
    | {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
} ;

@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_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    _set_with_last(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);
    reset_subjects(modeler) =
      subjects = { state.subjects with selection={ this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
                                                   color=Observable.change_state( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) , state.subjects.selection.color) } };
      { state with ~subjects; ~modeler };
    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
        state = reset_subjects(modeler);
        set(state)
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      subjects = { state.subjects with selection.color=Observable.change_state(new_color, state.subjects.selection.color) };
      set({ ~subjects; ~modeler})
    | {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);
      lock_mouse_event = Mutable.make(false);
      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) =
              do lock_mouse_event.set(true);
              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)));

}}


changing background color

changing background color

@private id_work_area = "work_area" ;
@private id_canvas_area = "canvas_area" ;

default_css = css
#{id_canvas_area} {
   background-color: #D000D0;
}
;

css = [ default_css ] ;

width = 500;
height = 500;

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
;

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

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

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

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

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

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

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

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

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

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

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

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() =
  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(width);
  (h_u, h_d) = compute_left_right(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(gl, viewport, eye, up, shaderProgram, squareVertexPositionBuffer, repcoords) =
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    f = vec3.from_public ;
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(width) / float_of_int(height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(f(eye), f((0.0, 0.0, 0.0)), f(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    tmp_mvMatrix;
  do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, 0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.normals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), squareVertexPositionBuffer.indexs);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix);
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);

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

  void
;

drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
  viewbox = setup_boxes() ;
  rec aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
    do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
    do drawScene_for_a_viewport(gl, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._3D, (15.0, 10.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do RequestAnimationFrame.request((_ -> aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)), #{id_canvas_area});
    void
    ;
  aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)
;

initGL(canvas) : void =
  match Webgl.getContext(canvas, "experimental-webgl") with
  | { some=gl } ->
    squareVertexPositionBuffer = initBuffers(gl);
    repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
    shaderProgram = initShaders(gl);
    //Clear screen and make everything black
    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(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
    void
  | { none } -> error("no context found")
  end ;

server_start_static_page() =

Welcome to this demo

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> initGL(Dom.of_selection(#{id_canvas_area}))}/>

 ;

urls =
  parser
  | (.*) ->
    html("Demo page {Date.to_string(Date.now())}", server_start_static_page())
  end ;

server = simple_server(urls) ;

@private id_work_area = "work_area" ;
@private id_canvas_area = "canvas_area" ;

default_css = css
#{id_canvas_area} {
   background-color: #D000D0;
}
;

css = [ default_css ] ;

width = 500;
height = 500;

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
;

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

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

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

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

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

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

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

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

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

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

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

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() =
  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(width);
  (h_u, h_d) = compute_left_right(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(gl, viewport, eye, up, shaderProgram, squareVertexPositionBuffer, repcoords) =
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    f = vec3.from_public ;
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(width) / float_of_int(height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(f(eye), f((0.0, 0.0, 0.0)), f(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    tmp_mvMatrix;
  do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, 0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.normals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), squareVertexPositionBuffer.indexs);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix);
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);

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

  void
;

drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
  viewbox = setup_boxes() ;
  rec aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
    do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
    do drawScene_for_a_viewport(gl, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._3D, (15.0, 10.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do RequestAnimationFrame.request((_ -> aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)), #{id_canvas_area});
    void
    ;
  aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)
;

initGL(canvas) : void =
  match Webgl.getContext(canvas, "experimental-webgl") with
  | { some=gl } ->
    squareVertexPositionBuffer = initBuffers(gl);
    repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
    shaderProgram = initShaders(gl);
    //Clear screen and make everything black
    do Webgl.clearColor(gl, 0.0, 0.0, 0.0, 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(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
    void
  | { none } -> error("no context found")
  end ;

server_start_static_page() =

Welcome to this demo

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> initGL(Dom.of_selection(#{id_canvas_area}))}/>

 ;

urls =
  parser
  | (.*) ->
    html("Demo page {Date.to_string(Date.now())}", server_start_static_page())
  end ;

server = simple_server(urls) ;


removing debug log

removing debug log

@private id_work_area = "work_area" ;
@private id_canvas_area = "canvas_area" ;

default_css = css
#{id_canvas_area} {
   background-color: #D000D0;
}
;

css = [ default_css ] ;

width = 500;
height = 500;

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
;

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

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

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

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

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

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

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

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

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

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

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

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() =
  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(width);
  (h_u, h_d) = compute_left_right(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(gl, viewport, eye, up, shaderProgram, squareVertexPositionBuffer, repcoords) =
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    f = vec3.from_public ;
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(width) / float_of_int(height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(f(eye), f((0.0, 0.0, 0.0)), f(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    tmp_mvMatrix;
  do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, 0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.normals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), squareVertexPositionBuffer.indexs);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix);
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);

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

  void
;

drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
  viewbox = setup_boxes() ;
  rec aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
    do Webgl.clear(gl, Webgl.COLOR_BUFFER_BIT(gl)); // TODO: | gl.DEPTH_BUFFER_BIT);
    do drawScene_for_a_viewport(gl, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._3D, (15.0, 10.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do RequestAnimationFrame.request((_ -> aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)), #{id_canvas_area});
    void
    ;
  aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)
;

  initGL(canvas) : void =
    match Webgl.getContext(canvas, "experimental-webgl") with
    | { some=gl } ->
      squareVertexPositionBuffer = initBuffers(gl);
      repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
      shaderProgram = initShaders(gl);
      //Clear screen and make everything black
      do Webgl.clearColor(gl, 0.0, 0.0, 0.0, 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(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
      void
    | { none } -> error("no context found")
    end ;

server_start_static_page() =

 do Dom.transform([#{id_work_area} +<- <>tralalilalalala</>]); void}>Welcome to this demo

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> initGL(Dom.of_selection(#{id_canvas_area}))}/>

 ;

urls =
  parser
  | (.*) ->
    _ = %%WebglPlugin.getContext%% ;
    html("Demo page {Date.to_string(Date.now())}", server_start_static_page())
  end ;

server = simple_server(urls) ;

@private id_work_area = "work_area" ;
@private id_canvas_area = "canvas_area" ;

default_css = css
#{id_canvas_area} {
   background-color: #D000D0;
}
;

css = [ default_css ] ;

width = 500;
height = 500;

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
;

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

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

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

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

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

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

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

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

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

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

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

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 Log.debug("normalMatrix", mat3.str(normalMatrix));
  do Webgl.uniformMatrix3fv(gl, shaderProgram.nMatrixUniform, false, Webgl.Float32Array.from_float_list(mat3.to_list(normalMatrix)));
  void
;

setup_boxes() =
  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(width);
  (h_u, h_d) = compute_left_right(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(gl, viewport, eye, up, shaderProgram, squareVertexPositionBuffer, repcoords) =
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    f = vec3.from_public ;
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(width) / float_of_int(height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(f(eye), f((0.0, 0.0, 0.0)), f(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    tmp_mvMatrix;
  do Log.debug("mvMatrix", mat4.str(mvMatrix));
  do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, 0.4, 0.4, 0.4);
  do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), squareVertexPositionBuffer.normals);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, squareVertexPositionBuffer.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.bindBuffer(gl, Webgl.ELEMENT_ARRAY_BUFFER(gl), squareVertexPositionBuffer.indexs);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, mvMatrix);
  do Webgl.drawElements(gl, Webgl.TRIANGLES(gl), 36, Webgl.UNSIGNED_SHORT(gl), 0);

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

  void
;

drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
  viewbox = setup_boxes() ;
  rec aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords) =
    do Webgl.clear(gl, Webgl.COLOR_BUFFER_BIT(gl)); // TODO: | gl.DEPTH_BUFFER_BIT);
    do drawScene_for_a_viewport(gl, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do drawScene_for_a_viewport(gl, viewbox._3D, (15.0, 10.0, 15.0), (0.0, 1.0, 0.0), shaderProgram, squareVertexPositionBuffer, repcoords);
    do RequestAnimationFrame.request((_ -> aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)), #{id_canvas_area});
    void
    ;
  aux(gl, shaderProgram, squareVertexPositionBuffer, repcoords)
;

  initGL(canvas) : void =
    match Webgl.getContext(canvas, "experimental-webgl") with
    | { some=gl } ->
      squareVertexPositionBuffer = initBuffers(gl);
      repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
      shaderProgram = initShaders(gl);
      //Clear screen and make everything black
      do Webgl.clearColor(gl, 0.0, 0.0, 0.0, 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(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
      void
    | { none } -> error("no context found")
    end ;

server_start_static_page() =

 do Dom.transform([#{id_work_area} +<- <>tralalilalalala</>]); void}>Welcome to this demo

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> initGL(Dom.of_selection(#{id_canvas_area}))}/>

 ;

urls =
  parser
  | (.*) ->
    _ = %%WebglPlugin.getContext%% ;
    html("Demo page {Date.to_string(Date.now())}", server_start_static_page())
  end ;

server = simple_server(urls) ;


using it

using it

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_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    _set_with_last(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_modeler(modeler) = { set={ state with ~modeler } } ;
    _set_subjects(subjects) = { set={ state with ~subjects } } ;
    set(new_state) = { set={ state with subjects=new_state.subjects; modeler=new_state.modeler } };
    _set_with_last(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);
    reset_subjects(modeler) =
      subjects = { state.subjects with selection={ this=Observable.change_state(modeler.scene.selection, state.subjects.selection.this);
                                                   color=Observable.change_state( Option.switch((o->o.color), ColorFloat.random(), modeler.scene.selection) , state.subjects.selection.color) } };
      { state with ~subjects; ~modeler };
    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
        state = reset_subjects(modeler);
        set(state)
    | {modeler_change_tool=new_tool} ->
      modeler = Modeler.tool_change(state.modeler, new_tool);
      subjects = { state.subjects with tool=Observable.change_state(new_tool, state.subjects.tool) };
      set({ ~subjects; ~modeler })
    | {modeler_change_scene_selection_color; ~new_color} ->
      (modeler, opatch) = Modeler.scene_change_selection_color(state.modeler, new_color);
      do send_opatch(opatch);
      subjects = { state.subjects with selection.color=Observable.change_state(new_color, state.subjects.selection.color) };
      set({ ~subjects; ~modeler})
    | {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)));

}}