removed some useless client server annotations

/*  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

/** Constants **/

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

/** Types **/

type user = { int id, string name }
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}

/** 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)

/** 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(System.gmt_launch_date, Date.now_gmt())
  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(users) {
  #users = <>Users: {List.length(users)}</>
  #user_list =
{users}

}

/** 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}

      } )
  })
}

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.map(function(user) {

{user.name}

      }, users)
    update_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))
}

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

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

Users online

      {OpaShare.html()}

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

}

@async function join(_) {
  name = Dom.get_value(#name)
  client_channel = Session.make_callback(ignore)
  enter_chat(name, 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
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/style.css"] }, // include CSS in headers
  { register : {favicon:[{format:{gif}, path:"/resources/img/favicon.gif"}]} }, // include favicon 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

/** Constants **/

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

/** Types **/

type user = { int id, string name }
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}

/** 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)

/** 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(System.gmt_launch_date, Date.now_gmt())
  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(users) {
  #users = <>Users: {List.length(users)}</>
  #user_list =
{users}

}

/** 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.map(function(user) {

{user.name}

      }, users)
    update_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))
}

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

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

Users online

      {OpaShare.html()}

        <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)
  enter_chat(name, 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()
}

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


adding color to object

adding color to object

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}}


basic client session setup

basic client session setup

@client Modeler = {{

  @private on_message(state, message) = {unchanged};

  init(canvas_sel, width, height) : outcome =
    (get_scene, set_scene) =
      org_scene = [ {cube=(0.0, 0.0, -3.0); id=CHF()}, {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ];
      ref = Mutable.make_client(org_scene);
      ((-> ref.get()), (new_scene -> ref.set(new_scene)));
    mouse_listener(e) = match e with
      | { mousedown; ~x; ~z } ->
        set_scene(List.cons({cube=(x, 0.0, z); id=CHF()}, get_scene()))
      end ;
    res = initGL(canvas_sel, width, height, get_scene, mouse_listener) ;
    match res with
    | {success} ->
      do ignore(Session.make(List.empty, on_message));
      res
    | _ -> res
    end ;

}}

@client Modeler = {{

  init(canvas_sel, width, height) : outcome =
    (get_scene, set_scene) =
      org_scene = [ {cube=(0.0, 0.0, -3.0); id=CHF()}, {cube=(3.0, 0.0, 0.0); id=CHF()}, {cube=(6.0, 0.0, 0.0); id=CHF()} ];
      ref = Mutable.make_client(org_scene);
      ((-> ref.get()), (new_scene -> ref.set(new_scene)));
    mouse_listener(e) = match e with
      | { mousedown; ~x; ~z } ->
        set_scene(List.cons({cube=(x, 0.0, z); id=CHF()}, get_scene()))
      end ;
    initGL(canvas_sel, width, height, get_scene, mouse_listener) ;

}}


renaming some variable

renaming some variable

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

}}


saving code for a future timer

saving code for a future timer

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

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

css = [ default_css ] ;

_ = Random.random_init();

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

server_start_static_page() =
  width = 500;
  height = 500;

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> Modeler.init(#{id_canvas_area}, width, height)}/>

 ;

urls =
  parser
  | "/scene/" scene_url=(.*) ->
    html("3D creation", server_start_static_page())
  | "/Welcome" "/"? ->
    html("Welcome", server_welcome_static_page())
  end ;

server = simple_server(urls) ;

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

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

css = [ default_css ] ;

_ = Random.random_init();

server_start_static_page() =
  width = 500;
  height = 500;

    <canvas width={width} height={height} id=#{id_canvas_area} onready={_ -> Modeler.init(#{id_canvas_area}, width, height)}/>

 ;

urls =
  parser
  | "/scene/" scene_url=(.*) ->
    html("3D creation", server_start_static_page())
  | "/Welcome" "/"? ->
    html("Welcome", server_welcome_static_page())
  end ;

server = simple_server(urls) ;


[improvement] re-added users list + improve XHR

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.core.date
import stdlib.web.client
import stdlib.system

GITHUB_URL = "https://github.com/Aqua-Ye/OpaChat"

type user = (int, string) // user_id, user_name
type author = { system } / { author : user }
type message = {
  author : author
  text : string
  date : Date.date
  event : string
}
type client_channel = channel(void)
type msg = {message : message} / {connection : (user, client_channel)} / {disconnection : (user, client_channel)} / {stats}

db /history : intmap(message)

@publish room = Network.cloud("room") : Network.network(msg)

@private
users = Mutable.make([]:list(user))

@private
launch_date = Date.now()

@server
server_observe(message) =
  match message
  {connection=(user, client_channel)} ->
    do jlog("connection {user}")
    do users.set(List.add(user, users.get()))
    do Network.broadcast({stats}, room)
    do Session.on_remove(client_channel, (->
      do jlog("auto disconnection {user}")
      do server_observe({disconnection=(user, client_channel)})
      void
    ))
    void
  {disconnection=(user, _client_channel)} ->
    do jlog("disconnection {user}")
    do users.set(List.remove(user, users.get()))
    do Network.broadcast({stats}, room)
    void
  _ -> void

@server
_ = Network.observe(server_observe, room)

@client
update_stats((uptime, mem)) =
  do Dom.transform([#uptime <- <>Uptime: {Date.to_string_time_only(uptime)}</>])
  do Dom.transform([#memory <- <>Memory: {mem} Mo</>])
  void

@client
update_users(users) =
  list = List.fold((elt, acc -> <>{acc}
{elt.f2}
</>), users, <></>)
  do Dom.transform([#users <- <>Users: {List.length(users)}</>])
  do Dom.transform([#user_list <-
{list}
])
  void

@client
message_update(stats)(messages:list(message)) =
  do update_stats(stats)
  do List.iter(message->
    line =

              {Date.to_string_time_only(message.date)}
              { match message.author with
                | {system} ->
                | {~author} -> {author.f2} }
              {message.text}

    do Dom.transform([#conversation +<- line])
    void
  , messages)
  Dom.set_scroll_top(Dom.select_window(), Dom.get_scrollable_size(#content).y_px)

@server
broadcast(author, event, text) =
  message = {~author ~text date=Date.now() ~event}
  do /history[?] <- message
  Network.broadcast({message = message}, room)

@server
build_page(header, content) =

{header}

{content}

@client
send_message(broadcast) =
  _ = broadcast("", Dom.get_value(#entry))
  Dom.clear_value(#entry)

@client
do_broadcast(broadcast)(_) = send_message(broadcast)

@server
mem() = System.get_memory_usage()/(1024*1024)

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

@server
client_observe(msg) =
  match msg
  {~message} -> message_update(compute_stats())([message])
  {stats} ->
    do update_stats(compute_stats())
    do update_users(users.get())
    void
  _ -> void

@server
init_client(user, client_channel) =
  obs = Network.observe(client_observe, room)
  _ = Network.broadcast({connection=(user, client_channel)}, room)
  do Dom.bind_beforeunload_confirmation(_ ->
    do Network.broadcast({disconnection=(user, client_channel)}, room)
    do Network.unobserve(obs)
    {none}
  )
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-20, history_list)
  do message_update(compute_stats())(history)
  void

@server
launch_chat(user:user, client_channel) =
  broadcast = broadcast({author=user}, _, _)
  build_page(
    Fork me on GitHub !,

 init_client(user, client_channel)}/>

      <input id=#entry onready={_ -> Dom.give_focus(#entry)} onnewline={do_broadcast(broadcast)}/>
      Send

  )

@client
do_join(user_id, launch)(_) =
  user = (user_id, Dom.get_value(#author))
  client_channel = Session.make_callback(ignore)
  Dom.transform([
    #main <- <>Loading chat...</>,
    #main <- launch(user, client_channel)
  ])

@server
main() =
  user_id = Random.int(65536) // a user identifier

{
    build_page(

Wecome to OpaChat
,
      Choose your name:
      <input id=#author onready={_ -> Dom.give_focus(#author)} onnewline={do_join(user_id, launch_chat)}/>
      Join
    )
  }

server =
  Server.one_page_bundle(
    "OpaChat - a chat built with Opa",
    [@static_resource_directory("resources")], // include resources directory
    ["resources/style.css"], // web application CSS
    main
  )

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.core.date
import stdlib.web.client
import stdlib.system

GITHUB_URL = "https://github.com/Aqua-Ye/OpaChat"

type user = (int, string)
type author = { system } / { author : user }
type message = {
  author : author
  text : string
  date : Date.date
  event : string
}
type client_channel = channel(void)
type msg = {message : message} / {connection : (user, client_channel)} / {disconnection : (user, client_channel)}

db /history : intmap(message)

@publish room = Network.cloud("room") : Network.network(msg)

// @client
// ping(fun)=
//   Scheduler.timer(15000, fun)

// manage_users(user_list : stringmap(Date.date), action : users_action) =
//   clean(key, value, acc) =
//     time = Duration.in_seconds(Duration.between(value, Date.now()))
//     if time > 20. then
//        do broadcast({system}, "leave", "{key} has left the room (timeout)")
//        acc
//     else
//        Map.add(key, value, acc)

//   match action with
//    | {add = u} ->       newmap = Map.add(u, Date.now(),user_list)
//                         do broadcast({system}, "join", "{u} is connected to the room")
//                         do Network.broadcast({users = newmap}, room)
//                         {set = newmap}

//    | {remove = u} ->    newmap = Map.remove(u, user_list)
//                         do broadcast({system}, "leave", "{u} has left the room (quit)")
//                         do Network.broadcast({users = newmap}, room)
//                         {set = newmap}

//    | {clean} ->         newmap = Map.fold(clean, user_list, Map.empty)
//                         do Network.broadcast({users = newmap}, room)
//                         {set = newmap}

//    | {ping = u} ->      temp = Map.remove(u, user_list)
//                         {set = Map.add(u, Date.now(), temp)}

// users = Session.cloud("users", Map.empty, manage_users)

// do Scheduler.timer(10000, ( -> Session.send(users, {clean})))

launch_date = Date.now()

@server
update_stats(mem) =
  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
  do Dom.transform([#uptime <- <>Uptime: {Date.to_string_time_only(uptime)}</>])
  do Dom.transform([#memory <- <>Memory: {mem} Mo</>])
  void

@client
user_update(mem:int)(msgs:list(msg)) =
  do update_stats(mem)
  do List.iter(msg->
    match msg with
     | {~message} ->
      line =

                {Date.to_string_time_only(message.date)}
                { match message.author with
                  | {system} ->
                  | {~author} -> {author.f2} }
                {message.text}

      do Dom.transform([#conversation +<- line])
      void
     _ -> void
    //  | ~{users} -> list = Map.fold((elt, _, acc -> <>{acc}
{elt}
</>), users, <></>)
    //                Dom.transform([#user_list <-
{list}
])
  , msgs)
  Dom.set_scroll_top(Dom.select_window(), Dom.get_scrollable_size(#content).y_px)

@server
broadcast(author, event, text) =
  message = {~author ~text date=Date.now() ~event}
  do /history[?] <- message
  Network.broadcast({message = message}, room)

@server
build_page(header, content) =

{header}

{content}

@client
send_message(broadcast) =
  _ = broadcast("", Dom.get_value(#entry))
  Dom.clear_value(#entry)

@client
do_broadcast(broadcast)(_) = send_message(broadcast)

@server
client_observe(msg) =
  match msg
  {message=_} -> user_update(System.get_memory_usage()/(1024*1024))([msg])
  _ -> void

@server
init_client(user) =
  obs = Network.observe(client_observe, room)
  client_channel = Session.make_callback(_ -> void)
  _ = Network.broadcast({connection=(user, client_channel)}, room)
  do Dom.bind_beforeunload_confirmation(_ ->
    do Network.broadcast({disconnection=(user, client_channel)}, room)
    do Network.unobserve(obs)
    {none}
  )
  history_list = IntMap.To.val_list(/history)
  len = List.length(history_list)
  history = List.drop(len-20, history_list)
  do user_update(0)(List.map(a->{message = a}, history))
  do update_stats(System.get_memory_usage()/(1024*1024))
  void

@server
launch_chat(user:user) =
  broadcast = broadcast({author=user}, _, _)
  build_page(
    Fork me on GitHub !,

 init_client(user)}/>

      <input id=#entry onready={_ -> Dom.give_focus(#entry)} onnewline={do_broadcast(broadcast)}/>
      Send

  )

@client
do_join(launch)(_) =
  user = (Random.int(65536), Dom.get_value(#author))
  Dom.transform([
    #main <- <>Loading chat...</>,
    #main <- launch(user)]
  )

@server
server_observe(msg) =
  match msg
  {connection=(user, client_channel)} ->
    do jlog("connection {user}")
    do Session.on_remove(client_channel, (->
      do jlog("auto disconnection {user}")
      void
    ))
    void
  {disconnection=(user, _client_channel)} ->
    do jlog("disconnection {user}")
    void
  _ -> void

@server
_ = Network.observe(server_observe, room)

@server
main() =

{
    build_page(

Wecome to OpaChat
,
      Choose your name:
      <input id=#author onready={_ -> Dom.give_focus(#author)} onnewline={do_join(launch_chat)}/>
      Join
    )
  }

server =
  Server.one_page_bundle(
    "OpaChat - a chat in Opa",
    [@static_resource_directory("resources")], // include resources directory
    ["resources/style.css"],
    main
  )


removing normals on objects simple

removing normals on objects simple

type engine.color = ColorFloat.color;
type engine.position = vec3;

type object.pickable = {
  vertexPositions: Webgl.WebGLBuffer;
  itemSize: int;
  numItems: int;
  vertexNormals: Webgl.WebGLBuffer;
  vertexIndexs: Webgl.WebGLBuffer;
  picking_color: engine.color;
  id: hidden_id;
  color: engine.color;
  position: engine.position;
  is_selected: bool;
  beginMode: Webgl.GLenum;
  numIndexs: int
}

type object.simple = {
  positions: Webgl.WebGLBuffer;
  itemSize: int; numItems: int;
  beginMode: Webgl.GLenum;
  color: engine.color;
};

type object = object.pickable;

display_simple(eng, object : object.simple) =
  rec gl = eng.context and color = object.color and shaderProgram = eng.shaderProgram;
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, color.f1, color.f2, color.f3);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, object.numItems);
  void ;

Lines = {{
  create(gl, vertices, color) =
    vertexPositionBuffer = Webgl.createBuffer(gl);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexPositionBuffer);
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
      Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)),
      Webgl.STATIC_DRAW(gl));
    itemSize = 3;
    do Debug.assert(mod(List.length(vertices), itemSize) == 0, (-> "Lines.create : the list got an incorrec size"));
    { positions=vertexPositionBuffer; ~itemSize; numItems=List.length(vertices) / itemSize; beginMode=Webgl.LINES(gl); ~color }
}}

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

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

Cube = {{
  create(gl, m_object : Scene.objects, is_selected) : object =
    //define our vertex positions as a list
    vertices = [
        // Front face
        -1.0, -1.0,  1.0,
         1.0, -1.0,  1.0,
         1.0,  1.0,  1.0,
        -1.0,  1.0,  1.0,

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

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

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

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

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

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

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

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

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

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

}}

type engine.color = ColorFloat.color;
type engine.position = vec3;

type object.pickable = {
  vertexPositions: Webgl.WebGLBuffer;
  itemSize: int;
  numItems: int;
  vertexNormals: Webgl.WebGLBuffer;
  vertexIndexs: Webgl.WebGLBuffer;
  picking_color: engine.color;
  id: hidden_id;
  color: engine.color;
  position: engine.position;
  is_selected: bool;
  beginMode: Webgl.GLenum;
  numIndexs: int
}

type object.simple = {
  positions: Webgl.WebGLBuffer;
  itemSize: int; numItems: int;
  normals: option(Webgl.WebGLBuffer);
  beginMode: Webgl.GLenum;
  color: engine.color;
};

type object = object.pickable;

display_simple(eng, object : object.simple) =
  rec gl = eng.context and color = object.color and shaderProgram = eng.shaderProgram;
  do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, color.f1, color.f2, color.f3);
  do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), object.positions);
  do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, object.itemSize, Webgl.FLOAT(gl), false, 0, 0);
  do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, object.numItems);
  void ;

Lines = {{
  create(gl, vertices, color) =
    vertexPositionBuffer = Webgl.createBuffer(gl);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), vertexPositionBuffer);
    do Webgl.bufferData(gl, Webgl.ARRAY_BUFFER(gl),
      Webgl.Float32Array.to_ArrayBuffer(Webgl.Float32Array.from_float_list(vertices)),
      Webgl.STATIC_DRAW(gl));
    itemSize = 3;
    do Debug.assert(mod(List.length(vertices), itemSize) == 0, (-> "Lines.create : the list got an incorrec size"));
    { positions=vertexPositionBuffer; ~itemSize; numItems=List.length(vertices) / itemSize; normals=Option.none; beginMode=Webgl.LINES(gl); ~color }
}}

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

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

Cube = {{
  create(gl, m_object : Scene.objects, is_selected) : object =
    //define our vertex positions as a list
    vertices = [
        // Front face
        -1.0, -1.0,  1.0,
         1.0, -1.0,  1.0,
         1.0,  1.0,  1.0,
        -1.0,  1.0,  1.0,

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

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

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

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

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

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

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

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

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

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

}}


bsic file menu

bsic file menu

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

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

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

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

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

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

}} ;

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

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

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

}} ;

@client GuiModeler = {{

  @private on_message(state : Modeler.modeler, message) = match message with
    | {click_on_scene; ~where; ~possible_target} -> { set=Modeler.use_tool(state, where, possible_target) }
    //| _ -> {unchanged}
    end ;

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

Sel | Cube

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

}}

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

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

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

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

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

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

}} ;

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

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

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

}} ;

@client GuiModeler = {{

  @private on_message(state : Modeler.modeler, message) = match message with
    | {click_on_scene; ~where; ~possible_target} -> { set=Modeler.use_tool(state, where, possible_target) }
    //| _ -> {unchanged}
    end ;

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

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

}}


LICENSE: moved from AGPL to MIT

LICENSE: moved from AGPL to MIT

/*  Copyright © 2011-2013 MLstate

    This code is covered by the MIT license. See the LICENSE file.
*/

import stdlib.system
import stdlib.themes.bootstrap

/** Constants **/

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

/** Types **/

type user = { int id, string name }
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}

/** Database **/

database opa_chat {
  message /history[{date}]
}

/** 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_gmt()

/** Connection **/

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)
function compute_stats() {
  uptime = Date.between(launch_date, Date.now_gmt())
  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(users) {
  #users = <>Users: {List.length(users)}</>
  #user_list =
{users}

}

/** 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}

      } )
  })
}

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

function observe_client(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.map(function(user) {

{user.name}

      }, users)
    update_users(users_html_list)
  default : void
  }
}

// Init the client from the server
function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(observe_client, 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
  iterator = DbSet.iterator(/opa_chat/history[limit NB_LAST_MSGS; order -date])
  history = Iter.to_list(iterator) |> List.rev(_)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

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

exposed @async function enter_chat(user_name, client_channel) {
  user = {
    id: Random.int(Limits.max_int),
    name: user_name
  }
  function broadcast(text) {
    message = {source:{user:user_name}, ~text, date:Date.now()}
    /opa_chat/history[date==message.date] <- message
    Network.broadcast({~message}, room)
  }
  #main =

Users online

      {OpaShare.html()}

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

}

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

/** Server **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

{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
function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             type="text"
             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 : {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

/** Constants **/

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

/** Types **/

type user = { int id, string name }
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}

/** Database **/

database opa_chat {
  message /history[{date}]
}

/** 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_gmt()

/** Connection **/

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)
function compute_stats() {
  uptime = Date.between(launch_date, Date.now_gmt())
  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(users) {
  #users = <>Users: {List.length(users)}</>
  #user_list =
{users}

}

/** 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}

      } )
  })
}

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

function observe_client(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.map(function(user) {

{user.name}

      }, users)
    update_users(users_html_list)
  default : void
  }
}

// Init the client from the server
function init_client(user, client_channel, _) {
  // Observe client
  obs = Network.observe(observe_client, 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
  iterator = DbSet.iterator(/opa_chat/history[limit NB_LAST_MSGS; order -date])
  history = Iter.to_list(iterator) |> List.rev(_)
  message_update(compute_stats(), history)
  // Initialize OpaShare
  OpaShare.init(file_uploaded(user))
}

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

exposed @async function enter_chat(user_name, client_channel) {
  user = {
    id: Random.int(Limits.max_int),
    name: user_name
  }
  function broadcast(text) {
    message = {source:{user:user_name}, ~text, date:Date.now()}
    /opa_chat/history[date==message.date] <- message
    Network.broadcast({~message}, room)
  }
  #main =

Users online

      {OpaShare.html()}

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

}

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

/** Server **/

watch_button =

fork_button =

function build_page(content) {

OpaChat

{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
function start() {
  page = build_page(

A real-time web chat built in Opa.

      <input id=#name
             type="text"
             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 : {css:["/resources/css/style.css"]} }, // include CSS in headers
  { custom : url_parser } // URL parser
])