[mindwave] set mindwave timer to 1sec

[mindwave] set mindwave timer to 1sec

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

    Copyright © 2010-2012 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/>.
*/

/**
 * @author David Rajchenbach-Teller
 * @author Henri Binsztok
 * @author Frederic Ye
 */

import stdlib.system
import stdlib.themes.bootstrap.core
import mindwave

/** Constants **/

GITHUB_USER = "Aqua-Ye"
GITHUB_REPO = "OpaChat"
NB_LAST_MSGS = 10
MW_TIMER = 1000
THINKING_THRESHOLD = 70
RELAXATION_THRESHOLD = 70

/** Types **/

type mindstate = (int, int)
type user = { int id, string name, option(mindstate) mindwave }
type source = { system } or { user user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}
or {user mindstate}

/** Database **/

database intmap(message) /history

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Page **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

server function mem() {
  System.get_memory_usage()/(1024*1024)
}

server function compute_stats() {
  uptime_duration = Date.between(launch_date, Date.now())
  uptime = Date.of_duration(uptime_duration)
  uptime = Date.shift_backward(uptime, Date.to_duration(Date.milliseconds(3600000))) // 1 hour shift
  (uptime, mem())
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Date.to_string_time_only(uptime)}</>
  #memory = <>Memory: {mem} Mo</>
}

/** Users **/

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** MindWave **/

client function mindwave_to_html(mindwave) {
  match (mindwave) {
  case {none}:
  case {some:(t, r)}:

    {t}<>-</>{r}
  }
}

client @async function update_mindwaves(user_minds) {
  List.iter(function((id, state)) {
    #{"{id}-state"} = mindwave_to_html(state)
  }, user_minds)
}

client reference(option(mindstate)) mindstate =
  ClientReference.create(none)

client function mind_changed(new_state) {
  match (ClientReference.get(mindstate)) {
  case {none}: Option.is_some(new_state)
  case {some:(t, r)}:
    match (new_state) {
    case {none}: true
    case {some:(thinking, relaxation)}:
      t > THINKING_THRESHOLD && thinking <= THINKING_THRESHOLD ||
      t <= THINKING_THRESHOLD && thinking > THINKING_THRESHOLD ||
      r > RELAXATION_THRESHOLD && relaxation <= RELAXATION_THRESHOLD ||
      r <= RELAXATION_THRESHOLD && relaxation > RELAXATION_THRESHOLD
    }
  }
}

client function check_mindstate(user) {
  new_mindstate =
    if (MindWave.is_present()) {
      thinking = MindWave.get_thinking_level()
      relaxation = MindWave.get_relaxation_level()
      Log.info("MindWave", "thinking:{thinking} - relaxation:{relaxation}")
      some((thinking, relaxation))
    } else none
  if (mind_changed(new_mindstate)) {
    user = { user with mindwave:new_mindstate }
    Network.broadcast({mindstate:user}, room)
  }
  ClientReference.set(mindstate, new_mindstate)
}

/** Conversation **/

function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user.name}
  }
}

client @async function message_update(stats, list(message) messages) {
  update_stats(stats)
  List.iter(function(message) {
    date = Date.to_formatted_string(Date.default_printer, message.date)
    time = Date.to_string_time_only(message.date)
    line =

              {time}
              { source_to_html(message.source) }
              {message.text}

    #conversation =+ line
  }, messages)
  Dom.scroll_to_bottom(#conversation)
}

client @async function media_update(stats, list(media) medias) {
  update_stats(stats)
  List.iter(function(media) {
    date = Date.to_formatted_string(Date.default_printer, media.date)
    time = Date.to_string_time_only(media.date)
    media_parser = parser {
      case "image/" .*: {image}
      case "audio/" .*: {audio}
      case "video/" .*: {video}
    }
    line =

              {time}
              { source_to_html(media.source) }
              { match (Parser.try_parse(media_parser, media.mimetype)) {
                case {some:{image}}:

                case {some:{audio}}:
                  <audio src="{media.src}"
                         controls="controls"
                         type="{media.mimetype}"
                         preload="auto">
                    Your browser does not support the audio tag!
                  </audio>
                case {some:{video}}:
                  <video src="{media.src}"
                         controls="controls"
                         preload="auto"
                         type="{media.name}">
                    Your browser does not support the video tag!
                  </video>
                default:
                   is sharing a file :
                    {media.name}

                } }

    #conversation =+ line
  }, medias)
  Dom.scroll_to_bottom(#conversation)
}

exposed @async function broadcast(user, text) {
  message = {source:user, ~text, date:Date.now()}
  /history[?] <- message
  Network.broadcast({~message}, room)
}

client @async function send_message(user, _) {
  broadcast(user, Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {~user},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {
        mw = mindwave_to_html(user.mindwave)

{user.name} {mw}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  case {mindstate:user} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    users = ServerReference.get(users) |> IntMap.To.val_list(_)
    waves_list =
      List.fold(function(user, acc) {
        (user.id, user.mindwave) +> acc
      }, users, [])
    update_mindwaves(waves_list)
  default : void
  }
}

/** Init **/

// Init various scheduling tasks
client function init_scheduling(user, _) {
  if (Option.is_some(user.mindwave)) {
    Log.info("MindWave", "present")
    Scheduler.timer(MW_TIMER, function(){check_mindstate(user)})
  } else {
    Log.info("MindWave", "missing")
  }
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server @async function enter_chat(user_name, has_mindwave, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name,
    mindwave: if (has_mindwave) some((0, 0)) else none,
  }
  // #Body is the default body id in Opa
  #main =

Users online

      {OpaShare.html()}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message({~user}, _)}
               x-webkit-speech="x-webkit-speech"/>

}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  has_mindwave = MindWave.is_present()
  enter_chat(name, has_mindwave, client_channel)
}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  case "/file/" key=Rule.integer:
    match (OpaShare.get(key)) {
    case {some:file}:
      Resource.binary(file.content, file.mimetype)
      |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
    default: start()
    }
  case (.*): start()
}

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/bootstrap.min.css",
      "/resources/css/bootstrap-responsive.min.css",
      "/resources/css/style.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])

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

    Copyright © 2010-2012 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/>.
*/

/**
 * @author David Rajchenbach-Teller
 * @author Henri Binsztok
 * @author Frederic Ye
 */

import stdlib.system
import stdlib.themes.bootstrap.core
import mindwave

/** Constants **/

GITHUB_USER = "Aqua-Ye"
GITHUB_REPO = "OpaChat"
NB_LAST_MSGS = 10
MW_TIMER = 5000
THINKING_THRESHOLD = 70
RELAXATION_THRESHOLD = 70

/** Types **/

type mindstate = (int, int)
type user = { int id, string name, option(mindstate) mindwave }
type source = { system } or { user user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}
or {user mindstate}

/** Database **/

database intmap(message) /history

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Page **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

server function mem() {
  System.get_memory_usage()/(1024*1024)
}

server function compute_stats() {
  uptime_duration = Date.between(launch_date, Date.now())
  uptime = Date.of_duration(uptime_duration)
  uptime = Date.shift_backward(uptime, Date.to_duration(Date.milliseconds(3600000))) // 1 hour shift
  (uptime, mem())
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Date.to_string_time_only(uptime)}</>
  #memory = <>Memory: {mem} Mo</>
}

/** Users **/

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** MindWave **/

client function mindwave_to_html(mindwave) {
  match (mindwave) {
  case {none}:
  case {some:(t, r)}:

    {t}<>-</>{r}
  }
}

client @async function update_mindwaves(user_minds) {
  List.iter(function((id, state)) {
    #{"{id}-state"} = mindwave_to_html(state)
  }, user_minds)
}

client reference(option(mindstate)) mindstate =
  ClientReference.create(none)

client function mind_changed(new_state) {
  match (ClientReference.get(mindstate)) {
  case {none}: Option.is_some(new_state)
  case {some:(t, r)}:
    match (new_state) {
    case {none}: true
    case {some:(thinking, relaxation)}:
      t > THINKING_THRESHOLD && thinking <= THINKING_THRESHOLD ||
      t <= THINKING_THRESHOLD && thinking > THINKING_THRESHOLD ||
      r > RELAXATION_THRESHOLD && relaxation <= RELAXATION_THRESHOLD ||
      r <= RELAXATION_THRESHOLD && relaxation > RELAXATION_THRESHOLD
    }
  }
}

client function check_mindstate(user) {
  new_mindstate =
    if (MindWave.is_present()) {
      thinking = MindWave.get_thinking_level()
      relaxation = MindWave.get_relaxation_level()
      Log.info("MindWave", "thinking:{thinking} - relaxation:{relaxation}")
      some((thinking, relaxation))
    } else none
  if (mind_changed(new_mindstate)) {
    user = { user with mindwave:new_mindstate }
    Network.broadcast({mindstate:user}, room)
  }
  ClientReference.set(mindstate, new_mindstate)
}

/** Conversation **/

function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user.name}
  }
}

client @async function message_update(stats, list(message) messages) {
  update_stats(stats)
  List.iter(function(message) {
    date = Date.to_formatted_string(Date.default_printer, message.date)
    time = Date.to_string_time_only(message.date)
    line =

              {time}
              { source_to_html(message.source) }
              {message.text}

    #conversation =+ line
  }, messages)
  Dom.scroll_to_bottom(#conversation)
}

client @async function media_update(stats, list(media) medias) {
  update_stats(stats)
  List.iter(function(media) {
    date = Date.to_formatted_string(Date.default_printer, media.date)
    time = Date.to_string_time_only(media.date)
    media_parser = parser {
      case "image/" .*: {image}
      case "audio/" .*: {audio}
      case "video/" .*: {video}
    }
    line =

              {time}
              { source_to_html(media.source) }
              { match (Parser.try_parse(media_parser, media.mimetype)) {
                case {some:{image}}:

                case {some:{audio}}:
                  <audio src="{media.src}"
                         controls="controls"
                         type="{media.mimetype}"
                         preload="auto">
                    Your browser does not support the audio tag!
                  </audio>
                case {some:{video}}:
                  <video src="{media.src}"
                         controls="controls"
                         preload="auto"
                         type="{media.name}">
                    Your browser does not support the video tag!
                  </video>
                default:
                   is sharing a file :
                    {media.name}

                } }

    #conversation =+ line
  }, medias)
  Dom.scroll_to_bottom(#conversation)
}

exposed @async function broadcast(user, text) {
  message = {source:user, ~text, date:Date.now()}
  /history[?] <- message
  Network.broadcast({~message}, room)
}

client @async function send_message(user, _) {
  broadcast(user, Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {~user},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {
        mw = mindwave_to_html(user.mindwave)

{user.name} {mw}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  case {mindstate:user} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    users = ServerReference.get(users) |> IntMap.To.val_list(_)
    waves_list =
      List.fold(function(user, acc) {
        (user.id, user.mindwave) +> acc
      }, users, [])
    update_mindwaves(waves_list)
  default : void
  }
}

/** Init **/

// Init various scheduling tasks
client function init_scheduling(user, _) {
  if (Option.is_some(user.mindwave)) {
    Log.info("MindWave", "present")
    Scheduler.timer(MW_TIMER, function(){check_mindstate(user)})
  } else {
    Log.info("MindWave", "missing")
  }
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server @async function enter_chat(user_name, has_mindwave, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name,
    mindwave: if (has_mindwave) some((0, 0)) else none,
  }
  // #Body is the default body id in Opa
  #main =

Users online

      {OpaShare.html()}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message({~user}, _)}
               x-webkit-speech="x-webkit-speech"/>

}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  has_mindwave = MindWave.is_present()
  enter_chat(name, has_mindwave, client_channel)
}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  case "/file/" key=Rule.integer:
    match (OpaShare.get(key)) {
    case {some:file}:
      Resource.binary(file.content, file.mimetype)
      |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
    default: start()
    }
  case (.*): start()
}

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/bootstrap.min.css",
      "/resources/css/bootstrap-responsive.min.css",
      "/resources/css/style.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])


bugfix, to avoid some invalid matrice full of Nan and Infinity

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

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

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

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

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

type Modeler.views = {_YX: mat4; _YZ: mat4; _ZX: mat4; _3D: mat4};

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

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

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

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

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

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

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

}} ;

`Scene.Client` = {{

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

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

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

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

  command_to_scene_patch(scene, cmd : Scene.Client.command) : option(Scene.patch) =
    match cmd with
    | { add_cube; ~where } ->
      command = { add_cube; cube={ cube=(where.x, where.y, where.z); color=ColorFloat.random(); id=scene.others.CPF() } } : Scene.command;
      Option.some({ pid=scene.others.CPF(); ~command})
    | { selection_change_color; ~new_color } ->
      f(sel) = { pid=scene.others.CPF(); command={ change_color; id=sel.id ; ~new_color } };
      Option.map(f, scene.selection)
    | { possible_move; ~where } ->
      f(sel) = { pid=scene.others.CPF(); command={ move_object; where=(where.x, where.y, where.z); id=sel.id } };
      Option.map(f, scene.selection)
    | { selection_change; ... } -> Option.none
    | { selection_delete } ->
      f(sel) = { pid=scene.others.CPF(); command={ delete_object; id=sel.id } };
      Option.map(f, scene.selection)
    end;

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

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

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

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

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

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

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

  selection_delete(scene) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_delete});

}} ;

Modeler = {{
  load(scene, scene_url, client_id, ratio_h_w) : Modeler.modeler =
    g(rot, scaler) =
      tmp = mat4.create();
      tmp_x = 1.;
      do mat4.ortho(-tmp_x, tmp_x, -ratio_h_w, ratio_h_w, -10., 10., tmp);
      tmp = rot(tmp);
      mat4.scale(tmp, vec3.from_public(scaler), tmp);
    tmp_scaler = 1. / 10.;
    _YX = g(identity, (tmp_scaler, tmp_scaler, 1.0));  // we want the left border to be at -10, and the rigth at 10
    _YZ = g(m -> mat4.rotateY(m, (90. * Math.PI / 180.), m), (1.0, tmp_scaler, tmp_scaler));
    _ZX = g(m -> mat4.rotateX(m, (90. * Math.PI / 180.), m), (tmp_scaler, 1.0, tmp_scaler));
    _3D =
      tmp_pMatrix = mat4.create();
      do mat4.perspective(45., 1. / ratio_h_w, 0.1, 100.0, tmp_pMatrix);
      c = mat4.create() ;
      do mat4.lookAt(vec3.from_public((10.0, 5.0, 15.0)), vec3.from_public((0., 0., 0.)), vec3.from_public((0.0, 1.0, 0.0)), c);
      do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
      tmp_pMatrix ;
    views = { ~_YX; ~_YZ; ~_ZX; ~_3D };
    { address=scene_url; ~scene; tool={selection}; ~client_id; ~views } ;
  empty(scene_url, client_id, ratio_h_w) : Modeler.modeler = load(`Scene.Client`.empty(client_id), scene_url, client_id, ratio_h_w);

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

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

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

  do_possible_move(modeler, where) : (Modeler.modeler, option(Scene.patch)) =
    match modeler.tool with
    | {selection} ->
      (scene, opatch) = `Scene.Client`.do_possible_move(modeler.scene, where);
      ({ modeler with ~scene }, opatch)
    | {add_cube} -> (modeler, Option.none)
    end;

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

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

}} ;

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

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

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

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

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

type Modeler.views = {_YX: mat4; _YZ: mat4; _ZX: mat4; _3D: mat4};

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

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

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

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

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

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

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

}} ;

`Scene.Client` = {{

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

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

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

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

  command_to_scene_patch(scene, cmd : Scene.Client.command) : option(Scene.patch) =
    match cmd with
    | { add_cube; ~where } ->
      command = { add_cube; cube={ cube=(where.x, where.y, where.z); color=ColorFloat.random(); id=scene.others.CPF() } } : Scene.command;
      Option.some({ pid=scene.others.CPF(); ~command})
    | { selection_change_color; ~new_color } ->
      f(sel) = { pid=scene.others.CPF(); command={ change_color; id=sel.id ; ~new_color } };
      Option.map(f, scene.selection)
    | { possible_move; ~where } ->
      f(sel) = { pid=scene.others.CPF(); command={ move_object; where=(where.x, where.y, where.z); id=sel.id } };
      Option.map(f, scene.selection)
    | { selection_change; ... } -> Option.none
    | { selection_delete } ->
      f(sel) = { pid=scene.others.CPF(); command={ delete_object; id=sel.id } };
      Option.map(f, scene.selection)
    end;

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

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

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

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

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

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

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

  selection_delete(scene) : (Scene.Client.scene, option(Scene.patch)) = apply_command(scene, {selection_delete});

}} ;

Modeler = {{
  load(scene, scene_url, client_id, ratio_h_w) : Modeler.modeler =
    g(rot, scaler) =
      tmp = mat4.create();
      tmp_x = 1.;
      do mat4.ortho(-tmp_x, tmp_x, -ratio_h_w, ratio_h_w, -10., 10., tmp);
      tmp = rot(tmp);
      mat4.scale(tmp, vec3.from_public(scaler), tmp);
    tmp_scaler = 1. / 10.;
    _YX = g(identity, (tmp_scaler, tmp_scaler, 0.0));  // we want the left border to be at -10, and the rigth at 10
    _YZ = g(m -> mat4.rotateY(m, (90. * Math.PI / 180.), m), (0.0, tmp_scaler, tmp_scaler));
    _ZX = g(m -> mat4.rotateX(m, (90. * Math.PI / 180.), m), (tmp_scaler, 0.0, tmp_scaler));
    _3D =
      tmp_pMatrix = mat4.create();
      do mat4.perspective(45., 1. / ratio_h_w, 0.1, 100.0, tmp_pMatrix);
      c = mat4.create() ;
      do mat4.lookAt(vec3.from_public((10.0, 5.0, 15.0)), vec3.from_public((0., 0., 0.)), vec3.from_public((0.0, 1.0, 0.0)), c);
      do mat4.multiply(tmp_pMatrix, c, tmp_pMatrix);
      tmp_pMatrix ;
    views = { ~_YX; ~_YZ; ~_ZX; ~_3D };
    { address=scene_url; ~scene; tool={selection}; ~client_id; ~views } ;
  empty(scene_url, client_id, ratio_h_w) : Modeler.modeler = load(`Scene.Client`.empty(client_id), scene_url, client_id, ratio_h_w);

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

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

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

  do_possible_move(modeler, where) : (Modeler.modeler, option(Scene.patch)) =
    match modeler.tool with
    | {selection} ->
      (scene, opatch) = `Scene.Client`.do_possible_move(modeler.scene, where);
      ({ modeler with ~scene }, opatch)
    | {add_cube} -> (modeler, Option.none)
    end;

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

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

}} ;


simplify

simplify

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

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

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

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

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

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

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

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

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

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

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

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

}} ;

`Scene.Client` = {{

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

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

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

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

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

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

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

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

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

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

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

}} ;

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

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

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

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

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

}} ;

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

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

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

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

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

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

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

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

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

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

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

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

}} ;

`Scene.Client` = {{

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

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

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

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

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

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

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

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

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

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

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

}} ;

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

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

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

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

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

}} ;


updated github info + removed a warning

updated github info + removed a warning

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

    Copyright © 2010-2012 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/>.
*/

/**
 * @author David Rajchenbach-Teller
 * @author Henri Binsztok
 * @author Frederic Ye
 */

import stdlib.system
import stdlib.themes.bootstrap
import mindwave

/** Constants **/

GITHUB_USER = "MLstate"
GITHUB_REPO = "MindChat"
NB_LAST_MSGS = 10
MW_TIMER = 1000

/** Types **/

type mindstate = (int, int)
type user = { int id, string name, option(mindstate) mindwave }
type source = { system } or { string user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}
or {user mindstate}

/** Database **/

database intmap(message) /history

/** Top level values **/

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

// Compute uptime and memory usage (MB)
server function compute_stats() {
  uptime = Date.between(launch_date, Date.now())
  mem = System.get_memory_usage()/(1024*1024)
  (uptime, mem)
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Duration.to_formatted_string(Duration.long_time_printer, uptime)}</>
  #memory = <>Memory: {mem} MB</>
}

/** Users **/

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** MindWave **/

client function level_to_prefix(level) {
  if (level <= 33) "med"
  else if (level <= 66) "att"
  else "blnk"
}

client function mindwave_to_html(mindwave) {
  match (mindwave) {
  case {none}:
  case {some:(t, r)}:
    preT = "{level_to_prefix(t)}Face"
    preR = "{level_to_prefix(r)}Glow"

  }
}

client @async function update_mindwaves(user_minds) {
  List.iter(function((id, state)) {
    #{"{id}-state"} = mindwave_to_html(state)
  }, user_minds)
}

client reference(option(mindstate)) mindstate =
  ClientReference.create(none)

client function mind_changed(new_state) {
  match (ClientReference.get(mindstate)) {
  case {none}: Option.is_some(new_state)
  case {some:(t, r)}:
    match (new_state) {
    case {none}: true
    case {some:(thinking, relaxation)}:
      thinking <= 33 && t > 33 ||
      thinking <= 66 && (t > 66 || t <= 33) ||
      thinking > 66 && t <= 66 ||
      relaxation <= 33 && r > 33 ||
      relaxation <= 66 && (r > 66 || r <= 33) ||
      relaxation > 66 && r <= 66
    }
  }
}

client function check_mindstate(user) {
  new_mindstate =
    if (MindWave.is_present()) {
      thinking = MindWave.get_thinking_level()
      relaxation = MindWave.get_relaxation_level()
      Log.info("MindWave", "thinking:{thinking} - relaxation:{relaxation}")
      some((thinking, relaxation))
    } else none
  if (mind_changed(new_mindstate)) {
    user = { user with mindwave:new_mindstate }
    Network.broadcast({mindstate:user}, room)
  }
  ClientReference.set(mindstate, new_mindstate)
}

/** Conversation **/

// converts a source into HTML
function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user}
  }
}

private client function generic_update(stats, elements, printer) {
  update_stats(stats)
  List.iter(function(element) {
    date = Date.to_formatted_string(Date.default_printer, element.date)
    time = Date.to_string_time_only(element.date)
    line =

              {time}
              {printer(element)}

    #conversation =+ line
  }, elements)
  Dom.scroll_to_bottom(#conversation)
}

client @async function message_update(stats, list(message) messages) {
  generic_update(stats, messages, function(message) {
    source_to_html(message.source) <+>
    {message.text}
  })
}

client @async function media_update(stats, list(media) medias) {
  media_parser = parser {
    case "image/" .*: {image}
    case "audio/" .*: {audio}
    case "video/" .*: {video}
  }
  generic_update(stats, medias, function(media) {
    source_to_html(media.source) <+>
    ( match (Parser.try_parse(media_parser, media.mimetype)) {
      case {some:{image}}:

      case {some:{audio}}:
        <audio src="{media.src}"
               controls="controls"
               type="{media.mimetype}"
               preload="auto">
          Your browser does not support the audio tag!
        </audio>
      case {some:{video}}:
        <video src="{media.src}"
               controls="controls"
               preload="auto"
               type="{media.name}">
          Your browser does not support the video tag!
        </video>
      default:
         is sharing a file :
          {media.name}

      } )
  })
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {user:user.name},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {
        mw = mindwave_to_html(user.mindwave)

{mw} {user.name}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  case {mindstate:user} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    users = ServerReference.get(users) |> IntMap.To.val_list(_)
    waves_list =
      List.fold(function(user, acc) {
        (user.id, user.mindwave) +> acc
      }, users, [])
    update_mindwaves(waves_list)
  default : void
  }
}

/** Init **/

// Init various scheduling tasks
client function init_scheduling(user, _) {
  Scheduler.timer(MW_TIMER, function(){
    check_mindstate(user)
  })
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server mindwave_flash =

    <object classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000" width="220" height="40" id="FlashToJs" align="middle">
      <param name="movie" value="/resources/neurosky/FlashToJs/FlashToJs.swf" />
      <param name="quality" value="high" />
      <param name="bgcolor" value="#ffffff" />
      <param name="play" value="true" />
      <param name="loop" value="true" />
      <param name="wmode" value="window" />
      <param name="scale" value="showall" />
      <param name="menu" value="true" />
      <param name="devicefont" value="false" />
      <param name="salign" value="" />
      <param name="allowScriptAccess" value="sameDomain" />
      {Xhtml.of_string_unsafe("")}
      <object type="application/x-shockwave-flash" data="/resources/neurosky/FlashToJs/FlashToJs.swf" width="220" height="40">
        <param name="movie" value="/resources/neurosky/FlashToJs/FlashToJs.swf" />
        <param name="quality" value="high" />
        <param name="bgcolor" value="#ffffff" />
        <param name="play" value="true" />
        <param name="loop" value="true" />
        <param name="wmode" value="window" />
        <param name="scale" value="showall" />
        <param name="menu" value="true" />
        <param name="devicefont" value="false" />
        <param name="salign" value="" />
        <param name="allowScriptAccess" value="sameDomain" />
        {Xhtml.of_string_unsafe("")}

        {Xhtml.of_string_unsafe("")}
      </object>
      {Xhtml.of_string_unsafe("")}
    </object>

client @async function send_message(broadcast, _) {
  void broadcast(Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

exposed @async function enter_chat(user_name, has_mindwave, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name,
    mindwave: if (has_mindwave) some((0, 0)) else none,
  }
  function broadcast(text) {
    message = {source:{user:user_name}, ~text, date:Date.now()}
    /history[?] <- message
    Network.broadcast({~message}, room)
  }
  #main =

Users online

      {OpaShare.html()}
      {mindwave_flash}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message(broadcast, _)}
               x-webkit-speech="x-webkit-speech"/>

}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  has_mindwave = MindWave.is_present()
  enter_chat(name, has_mindwave, client_channel)
}

/** Server **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  // case "/file/" key=Rule.integer:
  //   match (OpaShare.get(key)) {
  //   case {some:file}:
  //     Resource.binary(file.content, file.mimetype)
  //     |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
  //   default: start()
  //   }
  case (.*): start()
}

Resource.register_external_js("/resources/neurosky/FlashToJs/api.js")

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/style.css",
      "/resources/neurosky/icons.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])

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

    Copyright © 2010-2012 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/>.
*/

/**
 * @author David Rajchenbach-Teller
 * @author Henri Binsztok
 * @author Frederic Ye
 */

import stdlib.system
import stdlib.themes.bootstrap
import mindwave

/** Constants **/

GITHUB_USER = "Aqua-Ye"
GITHUB_REPO = "OpaChat"
NB_LAST_MSGS = 10
MW_TIMER = 1000

/** Types **/

type mindstate = (int, int)
type user = { int id, string name, option(mindstate) mindwave }
type source = { system } or { string user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}
or {user mindstate}

/** Database **/

database intmap(message) /history

/** Top level values **/

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

// Compute uptime and memory usage (MB)
server function compute_stats() {
  uptime = Date.between(launch_date, Date.now())
  mem = System.get_memory_usage()/(1024*1024)
  (uptime, mem)
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Duration.to_formatted_string(Duration.long_time_printer, uptime)}</>
  #memory = <>Memory: {mem} MB</>
}

/** Users **/

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** MindWave **/

client function level_to_prefix(level) {
  if (level <= 33) "med"
  else if (level <= 66) "att"
  else "blnk"
}

client function mindwave_to_html(mindwave) {
  match (mindwave) {
  case {none}:
  case {some:(t, r)}:
    preT = "{level_to_prefix(t)}Face"
    preR = "{level_to_prefix(r)}Glow"

  }
}

client @async function update_mindwaves(user_minds) {
  List.iter(function((id, state)) {
    #{"{id}-state"} = mindwave_to_html(state)
  }, user_minds)
}

client reference(option(mindstate)) mindstate =
  ClientReference.create(none)

client function mind_changed(new_state) {
  match (ClientReference.get(mindstate)) {
  case {none}: Option.is_some(new_state)
  case {some:(t, r)}:
    match (new_state) {
    case {none}: true
    case {some:(thinking, relaxation)}:
      thinking <= 33 && t > 33 ||
      thinking <= 66 && (t > 66 || t <= 33) ||
      thinking > 66 && t <= 66 ||
      relaxation <= 33 && r > 33 ||
      relaxation <= 66 && (r > 66 || r <= 33) ||
      relaxation > 66 && r <= 66
    }
  }
}

client function check_mindstate(user) {
  new_mindstate =
    if (MindWave.is_present()) {
      thinking = MindWave.get_thinking_level()
      relaxation = MindWave.get_relaxation_level()
      Log.info("MindWave", "thinking:{thinking} - relaxation:{relaxation}")
      some((thinking, relaxation))
    } else none
  if (mind_changed(new_mindstate)) {
    user = { user with mindwave:new_mindstate }
    Network.broadcast({mindstate:user}, room)
  }
  ClientReference.set(mindstate, new_mindstate)
}

/** Conversation **/

// converts a source into HTML
function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user}
  }
}

private client function generic_update(stats, elements, printer) {
  update_stats(stats)
  List.iter(function(element) {
    date = Date.to_formatted_string(Date.default_printer, element.date)
    time = Date.to_string_time_only(element.date)
    line =

              {time}
              {printer(element)}

    #conversation =+ line
  }, elements)
  Dom.scroll_to_bottom(#conversation)
}

client @async function message_update(stats, list(message) messages) {
  generic_update(stats, messages, function(message) {
    source_to_html(message.source) <+>
    {message.text}
  })
}

client @async function media_update(stats, list(media) medias) {
  media_parser = parser {
    case "image/" .*: {image}
    case "audio/" .*: {audio}
    case "video/" .*: {video}
  }
  generic_update(stats, medias, function(media) {
    source_to_html(media.source) <+>
    ( match (Parser.try_parse(media_parser, media.mimetype)) {
      case {some:{image}}:

      case {some:{audio}}:
        <audio src="{media.src}"
               controls="controls"
               type="{media.mimetype}"
               preload="auto">
          Your browser does not support the audio tag!
        </audio>
      case {some:{video}}:
        <video src="{media.src}"
               controls="controls"
               preload="auto"
               type="{media.name}">
          Your browser does not support the video tag!
        </video>
      default:
         is sharing a file :
          {media.name}

      } )
  })
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {user:user.name},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {
        mw = mindwave_to_html(user.mindwave)

{mw} {user.name}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  case {mindstate:user} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    users = ServerReference.get(users) |> IntMap.To.val_list(_)
    waves_list =
      List.fold(function(user, acc) {
        (user.id, user.mindwave) +> acc
      }, users, [])
    update_mindwaves(waves_list)
  default : void
  }
}

/** Init **/

// Init various scheduling tasks
client function init_scheduling(user, _) {
  Scheduler.timer(MW_TIMER, function(){
    check_mindstate(user)
  })
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server mindwave_flash =

    <object classid="clsid:d27cdb6e-ae6d-11cf-96b8-444553540000" width="220" height="40" id="FlashToJs" align="middle">
      <param name="movie" value="/resources/neurosky/FlashToJs/FlashToJs.swf" />
      <param name="quality" value="high" />
      <param name="bgcolor" value="#ffffff" />
      <param name="play" value="true" />
      <param name="loop" value="true" />
      <param name="wmode" value="window" />
      <param name="scale" value="showall" />
      <param name="menu" value="true" />
      <param name="devicefont" value="false" />
      <param name="salign" value="" />
      <param name="allowScriptAccess" value="sameDomain" />
      {Xhtml.of_string_unsafe("")}
      <object type="application/x-shockwave-flash" data="/resources/neurosky/FlashToJs/FlashToJs.swf" width="220" height="40">
        <param name="movie" value="/resources/neurosky/FlashToJs/FlashToJs.swf" />
        <param name="quality" value="high" />
        <param name="bgcolor" value="#ffffff" />
        <param name="play" value="true" />
        <param name="loop" value="true" />
        <param name="wmode" value="window" />
        <param name="scale" value="showall" />
        <param name="menu" value="true" />
        <param name="devicefont" value="false" />
        <param name="salign" value="" />
        <param name="allowScriptAccess" value="sameDomain" />
        {Xhtml.of_string_unsafe("")}

        {Xhtml.of_string_unsafe("")}
      </object>
      {Xhtml.of_string_unsafe("")}
    </object>

client @async function send_message(broadcast, _) {
  broadcast(Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

exposed @async function enter_chat(user_name, has_mindwave, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name,
    mindwave: if (has_mindwave) some((0, 0)) else none,
  }
  broadcast = function(text) {
    message = {source:{user:user_name}, ~text, date:Date.now()}
    /history[?] <- message
    Network.broadcast({~message}, room)
  }
  #main =

Users online

      {OpaShare.html()}
      {mindwave_flash}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message(broadcast, _)}
               x-webkit-speech="x-webkit-speech"/>

}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  has_mindwave = MindWave.is_present()
  enter_chat(name, has_mindwave, client_channel)
}

/** Server **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  // case "/file/" key=Rule.integer:
  //   match (OpaShare.get(key)) {
  //   case {some:file}:
  //     Resource.binary(file.content, file.mimetype)
  //     |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
  //   default: start()
  //   }
  case (.*): start()
}

Resource.register_external_js("/resources/neurosky/FlashToJs/api.js")

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/style.css",
      "/resources/neurosky/icons.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])


comment

comment

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

    Copyright © 2012 Frederic Ye
    Copyright © 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.system

/** Constants **/

GITHUB_USER = "Aqua-Ye"
GITHUB_REPO = "OpaChat"
NB_LAST_MSGS = 10

/** Types **/

type user = { int id, string name }
type source = { system } or { user user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}

/** Database **/

database intmap(message) /history

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Page **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

server function mem() {
  System.get_memory_usage()/(1024*1024)
}

server function compute_stats() {
  uptime_duration = Date.between(launch_date, Date.now())
  uptime = Date.of_duration(uptime_duration)
  uptime = Date.shift_backward(uptime, Date.to_duration(Date.milliseconds(3600000))) // 1 hour shift
  (uptime, mem())
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Date.to_string_time_only(uptime)}</>
  #memory = <>Memory: {mem} Mo</>
}

/** Users **/

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** Conversation **/

function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user.name}
  }
}

client @async function message_update(stats, list(message) messages) {
  update_stats(stats)
  List.iter(function(message) {
    date = Date.to_formatted_string(Date.default_printer, message.date)
    time = Date.to_string_time_only(message.date)
    line =

              {time}
              { source_to_html(message.source) }
              {message.text}

    #conversation =+ line
  }, messages)
  Dom.scroll_to_bottom(#conversation)
}

client @async function media_update(stats, list(media) medias) {
  update_stats(stats)
  List.iter(function(media) {
    date = Date.to_formatted_string(Date.default_printer, media.date)
    time = Date.to_string_time_only(media.date)
    media_parser = parser {
      case "image/" .*: {image}
      case "audio/" .*: {audio}
      case "video/" .*: {video}
    }
    line =

              {time}
              { source_to_html(media.source) }
              { match (Parser.try_parse(media_parser, media.mimetype)) {
                case {some:{image}}:

                case {some:{audio}}:
                  <audio src="{media.src}"
                         controls="controls"
                         type="{media.mimetype}"
                         preload="auto">
                    Your browser does not support the audio tag!
                  </audio>
                case {some:{video}}:
                  <video src="{media.src}"
                         controls="controls"
                         preload="auto"
                         type="{media.name}">
                    Your browser does not support the video tag!
                  </video>
                default:
                   is sharing a file :
                    {media.name}

                } }

    #conversation =+ line
  }, medias)
  Dom.scroll_to_bottom(#conversation)
}

exposed @async function broadcast(user, text) {
  message = {source:user, ~text, date:Date.now()}
  /history[?] <- message
  Network.broadcast({~message}, room)
}

client @async function send_message(user, _) {
  broadcast(user, Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {~user},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {

{user.name}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  default : void
  }
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server @async function enter_chat(user_name, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name
  }
  // #Body is the default body id in Opa
  #Body = build_page(

Users online

      {OpaShare.html()}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message({~user}, _)}
               x-webkit-speech="x-webkit-speech"/>

  )
}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  enter_chat(name, client_channel)
}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  case "/file/" key=Rule.integer:
    match (OpaShare.get(key)) {
    case {some:file}:
      Resource.binary(file.content, file.mimetype)
      |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
    default: start()
    }
  case (.*): start()
}

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/bootstrap.min.css",
      "/resources/css/bootstrap-responsive.min.css",
      "/resources/css/style.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])

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

    Copyright © 2012 Frederic Ye
    Copyright © 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.system

/** Constants **/

GITHUB_USER = "Aqua-Ye"
GITHUB_REPO = "OpaChat"
NB_LAST_MSGS = 10

/** Types **/

type user = { int id, string name }
type source = { system } or { user user }
type message = {
  source source,
  string text,
  Date.date date,
}
type media = {
  source source,
  string name,
  string src,
  string mimetype,
  Date.date date,
}
type client_channel = channel(void)
type network_msg =
   {message message}
or {media media}
or {(user, client_channel) connection}
or {user disconnection}
or {stats}

/** Database **/

database intmap(message) /history

exposed Network.network(network_msg) room = Network.cloud("room")
private reference(intmap(user)) users = ServerReference.create(IntMap.empty)
private launch_date = Date.now()

/** Page **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

      {watch_button}
      {fork_button}

{content}

}

/** Connection **/

server function server_observe(message) {
  match (message) {
  case {connection:(user, client_channel)} :
    ServerReference.update(users, IntMap.add(user.id, user, _))
    Network.broadcast({stats}, room)
    Session.on_remove(client_channel, function() {
      server_observe({disconnection:user})
    })
  case {disconnection:user} :
    ServerReference.update(users, IntMap.remove(user.id, _))
    Network.broadcast({stats}, room)
  default: void
  }
}

_ = Network.observe(server_observe, room)

/** Stats **/

server function mem() {
  System.get_memory_usage()/(1024*1024)
}

server function compute_stats() {
  uptime_duration = Date.between(launch_date, Date.now())
  uptime = Date.of_duration(uptime_duration)
  uptime = Date.shift_backward(uptime, Date.to_duration(Date.milliseconds(3600000))) // 1 hour shift
  (uptime, mem())
}

client @async function update_stats((uptime, mem)) {
  #uptime = <>Uptime: {Date.to_string_time_only(uptime)}</>
  #memory = <>Memory: {mem} Mo</>
}

client @async function update_users(nb_users, users) {
  #users = <>Users: {nb_users}</>
  #user_list =
{users}

}

/** Conversation **/

function source_to_html(source) {
  match (source) {
  case {system} :
  case {~user} : {user.name}
  }
}

client @async function message_update(stats, list(message) messages) {
  update_stats(stats)
  List.iter(function(message) {
    date = Date.to_formatted_string(Date.default_printer, message.date)
    time = Date.to_string_time_only(message.date)
    line =

              {time}
              { source_to_html(message.source) }
              {message.text}

    #conversation =+ line
  }, messages)
  Dom.scroll_to_bottom(#conversation)
}

client @async function media_update(stats, list(media) medias) {
  update_stats(stats)
  List.iter(function(media) {
    date = Date.to_formatted_string(Date.default_printer, media.date)
    time = Date.to_string_time_only(media.date)
    media_parser = parser {
      case "image/" .*: {image}
      case "audio/" .*: {audio}
      case "video/" .*: {video}
    }
    line =

              {time}
              { source_to_html(media.source) }
              { match (Parser.try_parse(media_parser, media.mimetype)) {
                case {some:{image}}:

                case {some:{audio}}:
                  <audio src="{media.src}"
                         controls="controls"
                         type="{media.mimetype}"
                         preload="auto">
                    Your browser does not support the audio tag!
                  </audio>
                case {some:{video}}:
                  <video src="{media.src}"
                         controls="controls"
                         preload="auto"
                         type="{media.name}">
                    Your browser does not support the video tag!
                  </video>
                default:
                   is sharing a file :
                    {media.name}

                } }

    #conversation =+ line
  }, medias)
  Dom.scroll_to_bottom(#conversation)
}

exposed @async function broadcast(user, text) {
  message = {source:user, ~text, date:Date.now()}
  /history[?] <- message
  Network.broadcast({~message}, room)
}

client @async function send_message(user, _) {
  broadcast(user, Dom.get_value(#entry))
  Dom.clear_value(#entry)
}

server function file_uploaded(user)(name, mimetype, key) {
  media = {
    source: {~user},
    ~name,
    src: "/file/{key}",
    ~mimetype,
    date: Date.now(),
  }
  Network.broadcast({~media}, room)
}

server function client_observe(msg) {
  match (msg) {
  case {~message} :
    message_update(compute_stats(), [message])
  case {~media} :
    media_update(compute_stats(), [media])
  case {connection:(user, _)} :
    message = {
      source: {system},
      text : "{user.name} joined the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {disconnection:user} :
    message = {
      source: {system},
      text : "{user.name} left the room",
      date : Date.now(),
    }
    message_update(compute_stats(), [message])
  case {stats} :
    update_stats(compute_stats())
    users = ServerReference.get(users)
            |> IntMap.To.val_list(_)
            |> List.sort_by(function(u){u.name}, _)
    users_html_list =
      List.fold(function(user, acc) {

{user.name}

        <+> acc
      }, users, <></>)
    update_users(List.length(users), users_html_list)
  default : void
  }
}

// Init the client from the server
server function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(client_observe, room)
  Network.broadcast({connection:(user, client_channel)}, room)
  // Observe disconnection
  Dom.bind_beforeunload_confirmation(function(_) {
    Network.broadcast({disconnection:user}, room)
    Network.unobserve(obs)
    none
  })
  // Send NB_LAST_MSGS messages
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-NB_LAST_MSGS, history_list)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

server @async function enter_chat(user_name, client_channel) {
  user = {
    id: Random.int(max_int),
    name: user_name
  }
  // #Body is the default body id in Opa
  #Body = build_page(

Users online

      {OpaShare.html()}

        <input id=#entry
               autofocus="autofocus"
               onready={function(_){Dom.give_focus(#entry)}}
               onnewline={send_message({~user}, _)}
               x-webkit-speech="x-webkit-speech"/>

  )
}

client @async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  enter_chat(name, client_channel)
}

// Page headers
headers =
  Xhtml.of_string_unsafe("
") <+>
  <meta charset="utf-8"></meta>
  <meta http-equiv="X-UA-Compatible" content="IE=edge,chrome=1"></meta>
  <meta name="viewport" content="width=device-width,initial-scale=1"></meta>

// Start page
server function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             placeholder="Name"
             autofocus="autofocus"
             onready={function(_){Dom.give_focus(#name)}}
             onnewline={join}/>
       <button class="btn primary"
               onclick={join}>Join</button>

  )
  Resource.full_page_with_doctype(
    "OpaChat - a real-time web chat built in Opa",
    {html5},
    page, headers, {success},
    []
  )
}

// Parse URL
url_parser = parser {
  case "/file/" key=Rule.integer:
    match (OpaShare.get(key)) {
    case {some:file}:
      Resource.binary(file.content, file.mimetype)
      |> Resource.add_header(_, {content_disposition:{attachment:file.name}})
    default: start()
    }
  case (.*): start()
}

// Start the server
Server.start(Server.http, [
  { resources : @static_resource_directory("resources") }, // include resources directory
  { register : [
      "/resources/css/bootstrap.min.css",
      "/resources/css/bootstrap-responsive.min.css",
      "/resources/css/style.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])