renaming a function

renaming a function

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  void
;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  void
;

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

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


shared scene start to support new client

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

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

@server `Modeler.Shared` = {{

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

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

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

}}

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

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

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

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

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

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

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

}}

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

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

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

@server `Modeler.Shared` = {{

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

  add_client(modsha, client) =
    { modsha with clients=List.cons(client, modsha.client) };

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

}}

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

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

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

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

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

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

}}

@server central_modelers : channel(Central.Modelers.message) =
  on_message(state : Central.Modelers.state, message) = match message with
    | { register; ~scene_url; ~sync_channel; ~client_id } ->
      do Log.info("CM", "register for url '{scene_url}'");
      base = match `Central.Modelers`.find_file(state, scene_url) with
        | {some=hit} -> hit
        | {none} ->
          scene = Scene.empty(SHF, state.my_id);
          scene = Scene.add_object(scene, Scene.cube(scene, (0.0, 0.0, -3.0)));
          scene = Scene.add_object(scene, Scene.cube(scene, (3.0, 0.0, 0.0)));
          scene = Scene.add_object(scene, Scene.cube(scene, (6.0, 0.0, 0.0)));
          { `Modeler.Shared`.empty(state.my_id, scene_url) with ~scene }
        end;
      do Session.send(sync_channel, { load=base.scene });
      { unchanged };
  Session.make_dynamic(`Central.Modelers`.empty(), on_message);


removing comments

removing comments

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

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

css = [ default_css ] ;

width = 500;
height = 500;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  void
;

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

  initGL(canvas) : void =
    match Webgl.getContext(canvas, "experimental-webgl") with
    | { some=gl } ->
      squareVertexPositionBuffer = initBuffers(gl);
      repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
      shaderProgram = initShaders(gl);
      //Clear screen and make everything black
      do Webgl.clearColor(gl, 0.0, 0.0, 0.0, 1.0);
      //we should do depth testing so that things drawn behind other
      //things should be hidden by the things in front of them).
      do Webgl.clearDepth(gl, 1.0);
      do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
      do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
      do drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
      void
    | { none } -> void//error("no context found")
    end ;

server_start_static_page() =

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

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

 ;

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

server = simple_server(urls) ;

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

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

css = [ default_css ] ;

width = 500;
height = 500;

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

/* TODO : Float32Array */

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  draw_rep(r, g, b, rep) =
    do Webgl.uniform1i(gl, shaderProgram.useLightingUniform, 0); // 0 = false
    do Webgl.uniform3f(gl, shaderProgram.ambientColorUniform, r, g, b);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.positions);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexPositionAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.bindBuffer(gl, Webgl.ARRAY_BUFFER(gl), rep.normals);
    do Webgl.vertexAttribPointer(gl, shaderProgram.vertexNormalAttribute, rep.itemSize, Webgl.FLOAT(gl), false, 0, 0);
    do Webgl.drawArrays(gl, Webgl.LINES(gl), 0, rep.numItems);
    void ;
  do draw_rep(1.0, 0.0, 0.0, repcoords.x);
  do draw_rep(0.0, 1.0, 0.0, repcoords.y);
  do draw_rep(0.0, 0.0, 1.0, repcoords.z);

  //do Webgl.drawArrays(gl, Webgl.TRIANGLE_STRIP(gl), 0, squareVertexPositionBuffer.numItems);
  //do RequestAnimationFrame.request((_ -> drawScene_for_a_viewport(gl, viewport, shaderProgram, squareVertexPositionBuffer, repcoords)), #{id_canvas_area});
  void
;

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

  initGL(canvas) : void =
    do jlog("got some context 55602");
    match Webgl.getContext(canvas, "experimental-webgl") with
    | { some=gl } ->
      do jlog("got some context");
      squareVertexPositionBuffer = initBuffers(gl);
      repcoords = { x=initLineXBuffers(gl, {x}); y=initLineXBuffers(gl, {y}); z=initLineXBuffers(gl, {z}) };
      shaderProgram = initShaders(gl);
      //Clear screen and make everything black
      do Webgl.clearColor(gl, 0.0, 0.0, 0.0, 1.0);
      //we should do depth testing so that things drawn behind other
      //things should be hidden by the things in front of them).
      do Webgl.clearDepth(gl, 1.0);
      do Webgl.enable(gl, Webgl.DEPTH_TEST(gl));
      do Webgl.depthFunc(gl, Webgl.LEQUAL(gl));
      do drawScene(gl, shaderProgram, squareVertexPositionBuffer, repcoords);
      void
    | { none } -> void//error("no context found")
    end ;

server_start_static_page() =

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

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

 ;

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

server = simple_server(urls) ;


Detect logout with timeout

Detect logout with timeout

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.{date}

type user = string
type users_action = {add : user} / {remove : user} / { clean } / {ping : user}

type author = { system } / { author : string }
type message = {
  author : author;
  text : string;
  date : Date.date;
  event : string;
}
type msg = {message : message} / {users : stringmap(Date.date)}

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

db /history : intmap(message)

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

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} ->         do Debug.jlog("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()

get_memory_usage = %%c_binding.get_memory_usage%%

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)(msg: msg) =
do update_stats(mem)
match msg with
 | {message = x} ->
  line =

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

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

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

build_page(header, content) =

{header}

{content}

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

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

launch(author:string) =
  init_client() =
    do Session.send(users, {add=author})
    do ping( -> Session.send(users, {ping=author}))
    history_list = IntMap.To.val_list(/history)
    len = List.length(history_list)
    history = List.drop(len-20, history_list)
    // FIXME: optimize this...
    do List.iter( (a -> user_update(get_memory_usage()/(1024*1024))({message = a})) , history)
    Network.add_callback(user_update(get_memory_usage()/(1024*1024)), room)
   logout() =
     do Session.send(users, {remove=author})
     Client.goto("/")
   do_broadcast = broadcast({author=author}, _, _)
   build_page(
     Fork me on GitHub !
      logout()}>Logout,

 init_client()}/>

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

   )

load() =
  author = Dom.get_value(#author)
  do Dom.transform([#main <- <>Loading...</>])
  Dom.transform([#main <- launch(author)])

start() =

 Dom.give_focus(#author)}>{
     build_page(
       <></>,
       Choose your name:
       <input id=#author onnewline={_ -> load()}/>
        load()}>Join
     )
   }

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

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.{date}

type user = string
type users_action = {add : user} / {remove : user} / { broadcast } / {ping}

type author = { system } / { author : string }
type message = {
  author : author;
  text : string;
  date : Date.date;
  event : string;
}
type msg = {message : message} / {users : list(user)}

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

db /history : intmap(message)

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

manage_users(user_list : list(user), action : users_action) =
  ping()=
    do Debug.jlog("ping not implemented yet")
    {unchanged}
  match action with
   | {add = u} ->       do broadcast({system}, "join", "{u} is connected to the room")
                        {set = List.cons(u, user_list)}

   | {remove = u} ->    do broadcast({system}, "leave", "{u} has left the room")
                        {set = List.remove(u, user_list)}

   | {broadcast} ->     do Network.broadcast({users = user_list}, room)
                        {unchanged}

   | {ping} ->          ping()

users = Session.cloud("users", List.empty, manage_users)

// Fix-me : to be improved
do Scheduler.timer(1000, ( -> Session.send(users, {broadcast})))

launch_date = Date.now()

get_memory_usage = %%c_binding.get_memory_usage%%

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)(msg: msg) =
match msg with
 | {message = x} ->
  line =

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

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

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

build_page(header, content) =

{header}

{content}

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

launch(author:string) =
  init_client() =
    do Session.send(users, {add=author})
    history_list = IntMap.To.val_list(/history)
    len = List.length(history_list)
    history = List.drop(len-20, history_list)
    // FIXME: optimize this...
    do List.iter( (a -> user_update(get_memory_usage()/(1024*1024))({message = a})) , history)
    Network.add_callback(user_update(get_memory_usage()/(1024*1024)), room)
   logout() =
     do Session.send(users, {remove=author})
     Client.goto("/")
   do_broadcast = broadcast({author=author}, _, _)
   build_page(
     Fork me on GitHub !
      logout()}>Logout,

 init_client()}/>

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

   )

load() =
  author = Dom.get_value(#author)
  do Dom.transform([#main <- <>Loading...</>])
  Dom.transform([#main <- launch(author)])

start() =

 Dom.give_focus(#author)}>{
     build_page(
       <></>,
       Choose your name:
       <input id=#author onnewline={_ -> load()}/>
        load()}>Join
     )
   }

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


uptime fix

uptime fix

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

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

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

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

/** 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_duration = Date.between(System.gmt_launch_date, Date.gmt_now())
  uptime = Date.of_duration(uptime_duration)
  mem = System.get_memory_usage()/(1024*1024)
  (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
  #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)
  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/bootstrap.min.css",
      "/resources/css/bootstrap-responsive.min.css",
      "/resources/css/style.css",
    ] }, // include CSS in headers
  { custom : url_parser } // URL parser
])


fix: history was displayed in wrong order

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.{date}

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

db /history : list(message)

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

user_update(x: message) =
  line =

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

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

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

launch(author) =
   init_client() =
     history = List.rev(List.take(20, /history))
     do List.iter(user_update, history)
     Network.add_callback(user_update, room)
   send_message() =
     broadcast(author, Dom.get_value(#entry))
   logout() =
     do broadcast("System", "{author} has left the room")
     Dom.transform([#main <- Reconnect])

 logout()}>Logout

 init_client()}>

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

 send_message()}>Send

start() =
   go(_) =
     author = Dom.get_value(#author)
     do Dom.transform([#main <- launch(author)])
     broadcast("System", "{author} is connected to the room")

Choose your name:

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

Launch

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

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

    Copyright (C) 2010-2011  MLstate

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

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

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

import stdlib.{date}

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

db /history : list(message)

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

user_update(x: message) =
  line =

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

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

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

launch(author) =
   init_client() =
     history = List.take(20, /history)
     do List.iter(user_update, history)
     Network.add_callback(user_update, room)
   send_message() =
     broadcast(author, Dom.get_value(#entry))
   logout() =
     do broadcast("System", "{author} has left the room")
     Dom.transform([#main <- Reconnect])

 logout()}>Logout

 init_client()}>

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

 send_message()}>Send

start() =
   go(_) =
     author = Dom.get_value(#author)
     do Dom.transform([#main <- launch(author)])
     broadcast("System", "{author} is connected to the room")

Choose your name:

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

Launch

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