adding remove cmd to the gui

adding remove cmd to the gui

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) }
    };
  last_coord_fixer: option(Dom.dimensions -> vec3)
} ;

@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);
        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) : 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; last_coord_fixer=Option.none };

  @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; last_coord_fixer=new_state.last_coord_fixer } };
    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; ~last_coord_fixer} ->
      (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; ~last_coord_fixer } }
      else
        state = { reset_subjects(modeler) with ~last_coord_fixer };
        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 } ->
      (modeler, opatch) = Modeler.do_possible_move(state.modeler, where);
      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:5px; width:5px; 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) =
        (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; ~coord_fixer } ->
          Session.send(channel, {click_on_scene; where={x=pos.f1; y=pos.f2; z=pos.f3}; ~possible_target; last_coord_fixer=coord_fixer})
        | { mouseup; ~pos } ->
          msg = {modeler_apply_possible_move; where={x=pos.f1; y=pos.f2; z=pos.f3} };
          Session.send(channel, msg)
        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)));

}}

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) }
    };
  last_coord_fixer: option(Dom.dimensions -> vec3)
} ;

@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);
        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) : 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; last_coord_fixer=Option.none };

  @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; last_coord_fixer=new_state.last_coord_fixer } };
    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; ~last_coord_fixer} ->
      (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; ~last_coord_fixer } }
      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; ~last_coord_fixer })
    | {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 } ->
      (modeler, opatch) = Modeler.do_possible_move(state.modeler, where);
      do send_opatch(opatch);
      { set={ state with ~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:5px; width:5px; 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);

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

        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; ~coord_fixer } ->
          Session.send(channel, {click_on_scene; where={x=pos.f1; y=pos.f2; z=pos.f3}; ~possible_target; last_coord_fixer=coord_fixer})
        | { mouseup; ~pos } ->
          msg = {modeler_apply_possible_move; where={x=pos.f1; y=pos.f2; z=pos.f3} };
          Session.send(channel, msg)
        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)));

}}


[feature] .opack: support .opack file

[feature] .opack: support .opack file

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

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

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

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

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

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

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

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

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

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

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

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

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

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

)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

)

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

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

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

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

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

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

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

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

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

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


basic dummy onclick on canvas

basic dummy onclick on canvas

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

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

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } }
} ;

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

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

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

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

drawScene_for_a_viewport(eng, viewport, eye, up, scene) =
  gl = eng.context; shaderProgram = eng.shaderProgram; repcoords = eng.static_buffers.repcoords;
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(eng.canvas.width) / float_of_int(eng.canvas.height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(vec3.from_public(eye), vec3.from_public((0.0, 0.0, 0.0)), vec3.from_public(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  do List.iter(((pos, object) -> display(eng, pMatrix, mvMatrix, pos, object)), scene) ;
  void
;

drawScene_and_register(eng, get_scene : (->list(vec3))) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    scene = List.map((p -> (p, Cube.create(gl))), get_scene());
    do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
    do drawScene_for_a_viewport(eng, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene);
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(eng)
;

initGL(canvas_sel, width, height) : void =
  match Webgl.getContext(Dom.of_selection(canvas_sel), "experimental-webgl") with
  | { some=context } ->
    _ =
      handler(e) =
        m_pos = // we transform the pos to be relative to the upper leftcorner of the canvas
          c_pos = Dom.get_offset(#{id_canvas_area});
          rel = e.mouse_position_on_page;
          { x_px=max(rel.x_px - c_pos.x_px, 0); y_px=max(rel.y_px - c_pos.y_px, 0) };
        // now with gl the origin will be at the lower left corner
        gl_pos = { x_px=min(max(m_pos.x_px,0), height-1); y_px=min(max(height - 1 - m_pos.y_px, 0), width-1) };
        Log.debug("P", "[(,)-({m_pos.x_px},{m_pos.y_px})] {gl_pos.x_px}, {gl_pos.y_px}");
      Dom.bind(canvas_sel, { mousedown }, handler);
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height } });
      start = { start with shaderProgram=initShaders(gl) };
      { start with static_buffers.repcoords=
        { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) } };
    //Clear screen and make everything light gray
    do Webgl.clearColor(gl, 0.9, 0.9, 0.9, 1.0);
    //we should do depth testing so that things drawn behind other
    //things should be hidden by the things in front of them).
    do Webgl.clearDepth(gl, 1.0);
    do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
    do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
    do drawScene_and_register(eng, (-> [ (0.0, 0.0, 0.0), (3.0, 0.0, 0.0), (6.0, 0.0, 0.0) ]));
    void
  | { none } -> error("no context found")
  end ;

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

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

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } }
} ;

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

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

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

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

drawScene_for_a_viewport(eng, viewport, eye, up, scene) =
  gl = eng.context; shaderProgram = eng.shaderProgram; repcoords = eng.static_buffers.repcoords;
  do Webgl.viewport(gl, viewport.x, viewport.y, viewport.w, viewport.h);
  pMatrix =
    tmp_pMatrix = mat4.create();
    do mat4.perspective(45., float_of_int(eng.canvas.width) / float_of_int(eng.canvas.height), 0.1, 100.0, tmp_pMatrix);
    c = mat4.create() ;
    do mat4.lookAt(vec3.from_public(eye), vec3.from_public((0.0, 0.0, 0.0)), vec3.from_public(up), c);
    do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
    tmp_pMatrix;
  mvMatrix =
    tmp_mvMatrix = mat4.create();
    do mat4.identity(tmp_mvMatrix);
    Stack.push(Stack.create(), tmp_mvMatrix);
  do setMatrixUniforms(gl, shaderProgram, pMatrix, Stack.peek(mvMatrix));
  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  do List.iter(((pos, object) -> display(eng, pMatrix, mvMatrix, pos, object)), scene) ;
  void
;

drawScene_and_register(eng, get_scene : (->list(vec3))) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    scene = List.map((p -> (p, Cube.create(gl))), get_scene());
    do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
    do drawScene_for_a_viewport(eng, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene);
    do drawScene_for_a_viewport(eng, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene);
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(eng)
;

initGL(canvas_sel, width, height) : void =
  match Webgl.getContext(Dom.of_selection(canvas_sel), "experimental-webgl") with
  | { some=context } ->
    gl = context;
    eng : engine =
      start = @openrecord({ context=gl; canvas={ selector=canvas_sel; ~width; ~height } });
      start = { start with shaderProgram=initShaders(gl) };
      { start with static_buffers.repcoords=
        { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) } };
    //Clear screen and make everything light gray
    do Webgl.clearColor(gl, 0.9, 0.9, 0.9, 1.0);
    //we should do depth testing so that things drawn behind other
    //things should be hidden by the things in front of them).
    do Webgl.clearDepth(gl, 1.0);
    do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
    do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
    do drawScene_and_register(eng, (-> [ (0.0, 0.0, 0.0), (3.0, 0.0, 0.0), (6.0, 0.0, 0.0) ]));
    void
  | { none } -> error("no context found")
  end ;


cleanup previous pos

cleanup previous pos

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

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

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: list((vec3, object))
} ;

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

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

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

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

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

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

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

  _ =
    match mode with
    | {normal} ->
      do draw_rep(1.0, 0.0, 0.0, repcoords.x);
      do draw_rep(0.0, 1.0, 0.0, repcoords.y);
      do draw_rep(0.0, 0.0, 1.0, repcoords.z);

      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
      do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
      List.iter(((pos, object) -> display(eng, pMatrix, mvMatrix, pos, object, false)), scene)
    | {pick} ->
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(eng.framePickBuffer));
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false;
      do List.iter(((pos, object) -> display(eng, pMatrix, mvMatrix, pos, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

drawScene_and_register(eng, get_scene : (->Modeler.scene), get_mode) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    (eng, scene) =
      f(p) =
        match List.find((z -> z.f2.id == p.id), eng.scene) with
        | { ~some } -> some
        | { none } -> (p.cube, Cube.create(gl, p.id))
        end;
      scene = List.map(f, get_scene());
      ({ eng with ~scene }, scene);
    do match get_mode() with
    | {pick=pos; ~cont} ->
      //do Log.debug("Picking", "...");
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {pick});
      (pMatrix, s) = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {pick});
      //(pMatrix, s) = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      x = (float_of_int(pos.x_px - viewbox._ZX.x) / float_of_int(viewbox._ZX.w)) * 2.0 - 1.0;
      y = (float_of_int(pos.y_px - viewbox._ZX.y) / float_of_int(viewbox._ZX.h)) * 2.0 - 1.0;
      mvMatrix = Stack.peek(s) ;
      do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
      do mat4.inverse(mvMatrix, mvMatrix);
      v1 = vec4.from_public((x, y, 1.0, 1.0));
      v2 = vec4.from_public((9.9, 9.9, 9.9, 9.9));
      do mat4.multiplyVec4(mvMatrix, v1, v2);
      v22 = vec4.to_public(v2);
      //v22 = { v22 with f2=0.0 };
      v2 = (v22.f1 / v22.f4, v22.f2 / v22.f4, v22.f3 / v22.f4, v22.f4);
      data = Webgl.Uint8Array.from_int_list(List.init((_->123), 4));
      do Webgl.readPixels(gl, pos.x_px, pos.y_px, 1, 1, Webgl.RGBA(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(data));
      pickedColor = match Webgl.Uint8Array.to_int_list(data) with
        | [r, g, b, _] -> (r, g, b)
        | _ -> error("Picking failure")
        end ;
      do Log.debug("Picking", "Color is: { pickedColor }; v1={ vec4.str(v1) }, \t v2={ v2 }");
      //do jlog("Color is: { pickedColor }; v={ vec3.str(v) }");
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
      cont({ mousedown; x=v2.f1; z=v2.f3})
    | {normal} ->
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
      void
    end ;
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(eng)
;

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

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

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

@private type engine = {
  context: Webgl.Context.private;
  canvas: { selector:dom; width: int; height: int };
  shaderProgram: my_custom_shaderProgram
  static_buffers: { repcoords: { x:static_buffer; y:static_buffer; z:static_buffer } };
  framePickBuffer: Webgl.WebGLFramebuffer;
  scene: list((vec3, object))
} ;

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

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

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

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

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

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

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

  _ =
    match mode with
    | {normal} ->
      do draw_rep(1.0, 0.0, 0.0, repcoords.x);
      do draw_rep(0.0, 1.0, 0.0, repcoords.y);
      do draw_rep(0.0, 0.0, 1.0, repcoords.z);

      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 1); // 1 = true
      do Webgl.uniform3f(gl, shaderProgram.lightingDirectionUniform, 0.85, 0.8, 0.75);
      List.iter(((_, (pos, object)) -> display(eng, pMatrix, mvMatrix, pos, object, false)), scene)
    | {pick} ->
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.some(eng.framePickBuffer));
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false;
      do List.iter(((_, (pos, object)) -> display(eng, pMatrix, mvMatrix, pos, object, true)), scene);
      void
    end ;

  (pMatrix, mvMatrix)
;

drawScene_and_register(eng, get_scene : (->Modeler.scene), get_mode) =
  viewbox = setup_boxes(eng) ;
  rec aux(eng) =
    gl = eng.context;
    scene =
      f(p) =
        match List.find((z -> z.f2.id == p.id), eng.scene) with
        | { ~some } -> (p, some)
        | { none } -> (p, (p.cube, Cube.create(gl, p.id)))
        end;
      List.map(f, get_scene());
    eng = { eng with scene=List.map((z -> z.f2), scene) };
    do match get_mode() with
    | {pick=pos; ~cont} ->
      //do Log.debug("Picking", "...");
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {pick});
      (pMatrix, s) = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {pick});
      //(pMatrix, s) = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {pick});
      x = (float_of_int(pos.x_px - viewbox._ZX.x) / float_of_int(viewbox._ZX.w)) * 2.0 - 1.0;
      y = (float_of_int(pos.y_px - viewbox._ZX.y) / float_of_int(viewbox._ZX.h)) * 2.0 - 1.0;
      mvMatrix = Stack.peek(s) ;
      do mat4.multiply(pMatrix, mvMatrix, mvMatrix);
      do mat4.inverse(mvMatrix, mvMatrix);
      v1 = vec4.from_public((x, y, 1.0, 1.0));
      v2 = vec4.from_public((9.9, 9.9, 9.9, 9.9));
      do mat4.multiplyVec4(mvMatrix, v1, v2);
      v22 = vec4.to_public(v2);
      //v22 = { v22 with f2=0.0 };
      v2 = (v22.f1 / v22.f4, v22.f2 / v22.f4, v22.f3 / v22.f4, v22.f4);
      data = Webgl.Uint8Array.from_int_list(List.init((_->123), 4));
      do Webgl.readPixels(gl, pos.x_px, pos.y_px, 1, 1, Webgl.RGBA(gl), Webgl.UNSIGNED_BYTE(gl), Webgl.Uint8Array.to_ArrayBuffer(data));
      pickedColor = match Webgl.Uint8Array.to_int_list(data) with
        | [r, g, b, _] -> (r, g, b)
        | _ -> error("Picking failure")
        end ;
      do Log.debug("Picking", "Color is: { pickedColor }; v1={ vec4.str(v1) }, \t v2={ v2 }");
      //do jlog("Color is: { pickedColor }; v={ vec3.str(v) }");
      do Webgl.bindFramebuffer(gl, Webgl.FRAMEBUFFER(gl), Option.none);
      cont({ mousedown; x=v2.f1; z=v2.f3})
    | {normal} ->
      do Webgl.clear(gl, Webgl.GLbitfield_OR(Webgl.COLOR_BUFFER_BIT(gl), Webgl.DEPTH_BUFFER_BIT(gl)));
      _ = drawScene_for_a_viewport(eng, {_YX}, viewbox._YX, (0.0, 0.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_YZ}, viewbox._YZ, (-15.0, 0.0, 0.0), (0.0, 1.0, 0.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_ZX}, viewbox._ZX, (0.0, -15.0, 0.0), (0.0, 0.0, 1.0), scene, {normal});
      _ = drawScene_for_a_viewport(eng, {_3D}, viewbox._3D, (10.0, 5.0, 15.0), (0.0, 1.0, 0.0), scene, {normal});
      void
    end ;
    do RequestAnimationFrame.request((_ -> aux(eng)), #{id_canvas_area});
    void
    ;
  aux(eng)
;

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


saving state

saving state

type Modeler.Shared.modeler = {
  scene: Scene.scene;
  address: string;
  clients: list(channel(Central.Modelers.sync.message))
} ;

@server SHF : Fresh.next(int) = Fresh.server((i -> i : int));

@server `Modeler.Shared` = {{

  empty(server_id, address) : Modeler.Shared.modeler =
    { scene=Scene.empty(SHF, server_id); ~address; clients=List.empty };

  add_client(modsha, client) : Modeler.Shared.modeler =
    do Session.send(client, { load=modsha.scene });
    { modsha with clients=List.cons(client, modsha.clients) };

  apply_patch(modsha, patch) : Modeler.Shared.modeler =
    do Log.info("Modeler.Shared", "a patch as been apply for address '{modsha.address}'");
    { modsha with scene=Scene.apply_patch(modsha.scene, patch) };

}}

type Central.Modelers.state = { my_id: int; files: stringmap(Modeler.Shared.modeler) };
type Central.Modelers.message = { register; scene_url: string; sync_channel: channel(Central.Modelers.sync.message); client_id: int };

type Central.Modelers.sync.message = { load: Scene.scene };

@server `Central.Modelers` = {{
  empty() : Central.Modelers.state = { my_id=SHF(); files=StringMap.empty };

  find_file(state, address) = StringMap.get(address, state.files);

  get_file(state, address) : Modeler.Shared.modeler = match find_file(state, address) with
    | {some=hit} -> hit
    | {none} ->
      scene = Scene.empty(SHF, state.my_id);
      scene = Scene.add_object(scene, Scene.cube(scene, (0.0, 0.0, -3.0)));
      scene = Scene.add_object(scene, Scene.cube(scene, (3.0, 0.0, 0.0)));
      scene = Scene.add_object(scene, Scene.cube(scene, (6.0, 0.0, 0.0)));
      { `Modeler.Shared`.empty(state.my_id, address) with ~scene }
    end;

  update_file(state, address, f) : Central.Modelers.state =
    modsha = get_file(state, address);
    { state with files=StringMap.add(address, f(modsha), state.files) };

  apply_patch(state, address, patch) : Central.Modelers.state =
    f(modsha) = `Modeler.Shared`.apply_patch(modsha, patch);
    update_file(state, address, f);

}}

@server central_modelers : channel(Central.Modelers.message) =
  on_message(state : Central.Modelers.state, message) = match message with
    | { register; ~scene_url; ~sync_channel; ~client_id } ->
      do Log.info("CM", "register for url '{scene_url}'");
      state =
        up(modsha) = `Modeler.Shared`.add_client(modsha, sync_channel);
        `Central.Modelers`.update_file(state, scene_url, up);
      { set=state };
  Session.make_dynamic(`Central.Modelers`.empty(), on_message);

type Modeler.Shared.modeler = {
  scene: Scene.scene;
  address: string;
  clients: list(channel(Central.Modelers.sync.message))
} ;

@server SHF : Fresh.next(int) = Fresh.server((i -> i : int));

@server `Modeler.Shared` = {{

  empty(server_id, address) : Modeler.Shared.modeler =
    { scene=Scene.empty(SHF, server_id); ~address; clients=List.empty };

  add_client(modsha, client) : Modeler.Shared.modeler =
    do Session.send(client, { load=modsha.scene });
    { modsha with clients=List.cons(client, modsha.clients) };

  apply_patch(modsha, patch) : Modeler.Shared.modeler =
    do Log.info("Modeler.Shared", "a patch as been apply for address '{modsha.address}'");
    { modsha with scene=Scene.apply_patch(modsha.scene, patch) };

}}

type Central.Modelers.state = { my_id: int; files: stringmap(Modeler.Shared.modeler) };
type Central.Modelers.message = { register; scene_url: string; sync_channel: channel(Central.Modelers.sync.message); client_id: int };

type Central.Modelers.sync.message = { load: Scene.scene };

@server `Central.Modelers` = {{
  empty() : Central.Modelers.state = { my_id=SHF(); files=StringMap.empty };

  find_file(state, address) = StringMap.get(address, state.files);

  get_file(state, address) : Modeler.Shared.modeler = match find_file(state, address) with
    | {some=hit} -> hit
    | {none} ->
      scene = Scene.empty(SHF, state.my_id);
      scene = Scene.add_object(scene, Scene.cube(scene, (0.0, 0.0, -3.0)));
      scene = Scene.add_object(scene, Scene.cube(scene, (3.0, 0.0, 0.0)));
      scene = Scene.add_object(scene, Scene.cube(scene, (6.0, 0.0, 0.0)));
      { `Modeler.Shared`.empty(state.my_id, address) with ~scene }
    end;

  update_file(state, address, f) : Central.Modelers.state =
    f(modsha) =
      { state with files=StringMap.add(address, f(modsha), state.files) };
    Option.switch(f, state, find_file(state, address));

  apply_patch(state, address, patch) : Central.Modelers.state =
    f(modsha) = `Modeler.Shared`.apply_patch(modsha, patch);
    update_file(state, address, f);

}}

@server central_modelers : channel(Central.Modelers.message) =
  on_message(state : Central.Modelers.state, message) = match message with
    | { register; ~scene_url; ~sync_channel; ~client_id } ->
      do Log.info("CM", "register for url '{scene_url}'");
      base = `Central.Modelers`.get_file(state, scene_url);
      base = `Modeler.Shared`.add_client(base, sync_channel);
      { unchanged };
  Session.make_dynamic(`Central.Modelers`.empty(), on_message);


[fix/clean] removed unnecessary code causing a value restriction error

@private id_work_area = "work_area" ;
@private id_gui_area = "gui_area" ;

_ = Random.random_init();

/*
ref = Mutable.make(4)
rec val timer42 = Scheduler.make_timer(1000, (->
  do jlog("a")
  if ref.get() == 0 then timer42.stop()
))
do timer42.start()
*/

server_modeler_static_page(scene_url) =
  width = 500;
  height = 500;

 GuiModeler.init(scene_url, SHF(), #{id_gui_area}, width, height)}/>

 ;

resources = Rule.of_map(@static_include_directory("./src/css"))

urls =
  parser
  | "/" r=resources -> r
  | "/scene/" scene_url=(.*) ->
    Resource.styled_page("3D creation", ["/src/css/style.css"],server_modeler_static_page(Text.to_string(scene_url)))
  | (.*) ->
    html("Welcome", server_welcome_static_page())
  end ;

server = simple_server(urls) ;

@private id_work_area = "work_area" ;
@private id_gui_area = "gui_area" ;

default_css = css
#{id_gui_area} {
}
;

Css = [ default_css ] ;

_ = Random.random_init();

/*
ref = Mutable.make(4)
rec val timer42 = Scheduler.make_timer(1000, (->
  do jlog("a")
  if ref.get() == 0 then timer42.stop()
))
do timer42.start()
*/

server_modeler_static_page(scene_url) =
  width = 500;
  height = 500;

 GuiModeler.init(scene_url, SHF(), #{id_gui_area}, width, height)}/>

 ;

resources = Rule.of_map(@static_include_directory("./src/css"))

urls =
  parser
  | "/" r=resources -> r
  | "/scene/" scene_url=(.*) ->
    Resource.styled_page("3D creation", ["/src/css/style.css"],server_modeler_static_page(Text.to_string(scene_url)))
  | (.*) ->
    html("Welcome", server_welcome_static_page())
  end ;

server = simple_server(urls) ;


removed comments // makes code reading difficult

/*  A simple, one-room, scalable real-time web chat

    Copyright (C) 2010-2011  MLstate

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

import stdlib.{date}

type message = { author: string /**The name of the author (arbitrary string)*/
               ; text: string  /**Content entered by the user*/
               ; date: Date.date
               }

db /history : list(message)

room = Network.cloud("room"): Network.network(message)

user_update(x: message) =
  line =

            {Date.to_string_time_only(x.date)}
            {x.author}:
            {x.text}

  do Dom.transform([#conversation +<- line ])
  Dom.scroll_to_bottom(#conversation)

broadcast(author) =
   message = {~author text=Dom.get_value(#entry) date=Date.now()}
   do Network.broadcast(message, room)
   do /history <- [message | /history]
   Dom.clear_value(#entry)

launch(author) =
   init_client() =
     history = List.take(20, /history)
     do List.iter(user_update, history)
     Network.add_callback(user_update, room)

 init_client()}>

   <input id=#entry  onnewline={_ -> broadcast(author)}/>

 broadcast(author)}>Send

start() =
   go(ev) = Dom.transform([#main <- launch(Dom.get_value(#author))])

Choose your name:

   <input id=#author onnewline={go}/>

Launch

server = Server.one_page_bundle("Chat",
       [@static_resource_directory("resources")],
       ["resources/css.css"], start)

/*  A simple, one-room, scalable real-time web chat

    Copyright (C) 2010-2011  MLstate

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU Affero General Public License as
    published by the Free Software Foundation, either version 3 of the
    License, or (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Affero General Public License for more details.

    You should have received a copy of the GNU Affero General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

/**
 * A simple, one-room, scalable real-time web chat.
 *
 * @author David Rajchenbach-Teller, David@opalang.org
 */

import stdlib.{date}

/**
 * {1 Network infrastructure}
 */

/**
 * The type of messages sent by a client to the chatroom
 */
type message = {author: string /**The name of the author (arbitrary string)*/
               ; text: string  /**Content entered by the user*/
               ; date: Date.date
               }

db /history : list(message)

/**
 * The chatroom.
 */
room = Network.cloud("room"): Network.network(message)

/**
 * {1 User interface}
 */

/**
 * Update the user interface in reaction to reception of a message.
 *
 * This function is meant to be registered with [room] as a callback.
 * Its sole role is to display the new message in [#conversation].
 *
 * @param x The message received from the chatroom
 */
user_update(x: message) =
  line =

            {Date.to_string_time_only(x.date)}
            {x.author}:
            {x.text}

  do Dom.transform([#conversation +<- line ])
  Dom.scroll_to_bottom(#conversation)

/**
 * Broadcast text to the [room].
 *
 * Read the contents of [#entry], clear these contents and send the message to [room].
 *
 * @param author The name of the author. Will be included in the message broadcasted.
 */
broadcast(author) =
   message = {~author text=Dom.get_value(#entry) date=Date.now()}
   do Network.broadcast(message, room)
   do /history <- [message | /history]
   Dom.clear_value(#entry)

/**
 * Build the user interface for a client.
 *
 * Pick a random author name which will be used throughout the chat.
 *
 * @return The user interface, ready to be sent by the server to the client on connection.
 */
launch(author) =
   init_client() =
     // iter = Iter.of_list(/history)
     history = List.take(20, /history)
     do List.iter(user_update, history)
     Network.add_callback(user_update, room)

 init_client()}>

   <input id=#entry  onnewline={_ -> broadcast(author)}/>

 broadcast(author)}>Send

start() =
   go(ev) = Dom.transform([#main <- launch(Dom.get_value(#author))])

Choose your name:

   <input id=#author onnewline={go}/>

Launch

/**
 * {1 Application}
 */

/**
 * Main entry point.
 *
 * Construct an application called "Chat" (users will see the name in the title bar),
 * embedding statically the contents of directory "resources", using the global stylesheet
 * "resources/css.css" and the user interface defined in [start].
 */
server = Server.one_page_bundle("Chat",
       [@static_resource_directory("resources")],
       ["resources/css.css"], start)