refactor: simplify vertex mesh logic

examples/bounce.ml

@@ -117,7 +117,7 @@ let plugin w =
     World.add_entity w
     |> World.with_component w
          (module Mesh3d.C)
-         (Mesh3d.of_primitive
+         (Primitive.to_mesh3d
             (Primitive.Cuboid.create ~x_length:100. ~y_length:0.1 ~z_length:100.
                ()))
     |> World.with_component w
@@ -142,7 +142,7 @@ let plugin w =
     World.add_entity w
     |> World.with_component w
          (module Mesh3d.C)
-         (Mesh3d.of_primitive
+         (Primitive.to_mesh3d
             (Primitive.Sphere.create ~param1:50 ~param2:50 ()))
     |> World.with_component w (module Shader.Phong.C) ()
     |> World.with_component w

examples/disco.ml

@@ -70,7 +70,7 @@ let spawn_cube w position =
   |> World.with_component w (module Spin.C) ()
   |> World.with_component w
        (module Mesh3d.C)
-       (Mesh3d.of_primitive (Primitive.Cuboid.create ()))
+       (Primitive.to_mesh3d (Primitive.Cuboid.create ()))
   |> World.with_component w
        (module Transform.C)
        Transform.(identity () |> with_translation position)
@@ -85,7 +85,7 @@ let spawn_ground w =
   World.add_entity w
   |> World.with_component w
        (module Mesh3d.C)
-       (Mesh3d.of_primitive
+       (Primitive.to_mesh3d
           (Primitive.Cuboid.create ~x_length:25. ~y_length:0.1 ~z_length:25. ()))
   |> World.with_component w
        (module Material.C)

examples/dune

@@ -1,3 +1,3 @@
 (executables
- (public_names bounce disco first_person move shapes spawn)
+ (public_names bounce disco first_person game_of_life move shapes spawn)
  (libraries camlcade plugin))

examples/first_person.ml

@@ -7,25 +7,12 @@ open Plugin
 open Camlcade
 open Ecs
 
-let setup_window =
-  System.make
-    (fun w ->
-      let _, (c, ()) =
-        World.query w Query.(Req (module Graphics.Context.C) @ Nil) |> List.hd
-      in
-      c)
-    (System.Query
-       (fun context ->
-         Graphics.Context.set_window_fullscreen context
-           Graphics.Context.Window.fullscreen;
-         Graphics.Context.set_relative_mouse_mode true))
-
 let plugin w =
   let _cuboid =
     World.add_entity w
     |> World.with_component w
          (module Graphics.Mesh3d.C)
-         (Graphics.Mesh3d.of_primitive (Graphics.Primitive.Cuboid.create ()))
+         (Graphics.Primitive.to_mesh3d (Graphics.Primitive.Cuboid.create ()))
     |> World.with_component w (module Graphics.Shader.Normal.C) ()
   in
 
@@ -38,15 +25,14 @@ let plugin w =
     |> World.with_component w (module Transform.C) (Transform.identity ())
     |> World.with_component w (module Fp_camera.C) ()
   in
-
-  World.add_system w Scheduler.Startup setup_window
+  ()
 
 let () =
   let app =
     App.create ()
     |> App.add_plugin Input.plugin
     |> App.add_plugin Graphics.plugin
-    |> App.add_plugin Fp_camera.plugin
+    |> App.add_plugin (Fp_camera.plugin ~fullscreen:true)
     |> App.add_plugin plugin
   in
 

examples/game_of_life.ml

@@ -0,0 +1,170 @@
+open Camlcade
+open Ecs
+
+module Grid = struct
+  type t = { dimension : int; mutable cells : bool array }
+
+  let get t x y z =
+    t.cells.((z * t.dimension * t.dimension) + (y * t.dimension) + x)
+
+  let is_alive_at t x y z =
+    try
+      let v = get t x y z in
+      v
+    with _ -> false
+
+  let count_neighbors t x y z =
+    let count = ref 0 in
+    for dx = -1 to 1 do
+      for dy = -1 to 1 do
+        for dz = -1 to 1 do
+          if dx = 0 && dy = 0 && dz = 0 then ()
+          else
+            let nx = x + dx in
+            let ny = y + dy in
+            let nz = z + dz in
+            if is_alive_at t nx ny nz then count := !count + 1
+        done
+      done
+    done;
+    !count
+
+  let init ?(dimension = 16) () =
+    {
+      dimension;
+      cells =
+        Array.init (dimension * dimension * dimension) (fun _ -> Random.bool ());
+    }
+
+  let randomize t =
+    t.cells <- Array.init (Array.length t.cells) (fun _ -> Random.bool ())
+
+  let step t =
+    let new_cells = Array.copy t.cells in
+    let set_new x y z v =
+      Array.set new_cells
+        ((z * t.dimension * t.dimension) + (y * t.dimension) + x)
+        v
+    in
+    for x = 0 to t.dimension - 1 do
+      for y = 0 to t.dimension - 1 do
+        for z = 0 to t.dimension - 1 do
+          let neighbors = count_neighbors t x y z in
+          let is_alive = is_alive_at t x y z in
+          if is_alive then (if neighbors < 13 then set_new x y z false)
+          else if neighbors >= 14 && neighbors <= 19 then set_new x y z true
+          else set_new x y z is_alive
+        done
+      done
+    done;
+    t.cells <- new_cells
+
+  let update_vm t vertex_mesh =
+    let open Graphics in
+    let data = ref [] in
+    for x = 0 to t.dimension - 1 do
+      for y = 0 to t.dimension - 1 do
+        for z = 0 to t.dimension - 1 do
+          let is_alive = is_alive_at t x y z in
+          if is_alive then
+            let cube = Primitive.Cuboid.create () in
+            let rec shift = function
+              | [] -> []
+              | nx :: ny :: nz :: px :: py :: pz :: rest ->
+                  nx :: ny :: nz
+                  :: (px +. float_of_int x -. (float_of_int t.dimension /. 2.))
+                  :: (py +. float_of_int y -. (float_of_int t.dimension /. 2.))
+                  :: (pz +. float_of_int z -. (float_of_int t.dimension /. 2.))
+                  :: shift rest
+              | _ -> failwith "Invalid list"
+            in
+            data := shift cube @ !data
+        done
+      done
+    done;
+    Vertex_mesh.set_data vertex_mesh (Array.of_list !data)
+
+  module C = Component.Make (struct
+    type inner = t
+  end)
+end
+
+let step =
+  let query w =
+    let _, (keyboard, ()) =
+      World.query w Query.(Req (module Input.Keyboard.C) @ Nil) |> List.hd
+    in
+    let _, (grid, (mesh, ())) =
+      World.query w
+        Query.(Req (module Grid.C) @ Req (module Graphics.Mesh3d.C) @ Nil)
+      |> List.hd
+    in
+    (keyboard, grid, mesh)
+  in
+  let step (keyboard, grid, mesh) =
+    let pressed = Input.Keyboard.is_pressed keyboard in
+    if pressed `T then (
+      Grid.step grid;
+      Grid.update_vm grid (Graphics.Mesh3d.vertex_mesh mesh);
+      Graphics.Mesh3d.install mesh)
+    else if pressed `R then (
+      Grid.randomize grid;
+      Grid.update_vm grid (Graphics.Mesh3d.vertex_mesh mesh);
+      Graphics.Mesh3d.install mesh)
+  in
+  System.make query (System.Query step)
+
+let spawn_grid w =
+  let open Graphics in
+  let grid = Grid.init () in
+  let vm = Vertex_mesh.create ~topology:TriangleList () in
+  Vertex_mesh.set_attribute vm 0 3;
+  Vertex_mesh.set_attribute vm 1 3;
+  World.add_entity w
+  |> World.with_component w (module Grid.C) grid
+  |> World.with_component w (module Transform.C) (Transform.identity ())
+  |> World.with_component w (module Mesh3d.C) (Mesh3d.of_vertex_mesh vm)
+  |> World.with_component w
+       (module Material.C)
+       (Material.create ~ambient:(Math.Vec3.v 0. 0. 0.) ~shininess:0.1 ())
+  |> World.with_component w (module Shader.Phong.C) ()
+  |> ignore
+
+let plugin w =
+  spawn_grid w;
+
+  let _sun =
+    World.add_entity w
+    |> World.with_component w
+         (module Graphics.Light.Directional.C)
+         (Graphics.Light.Directional.create ~color:(Math.Vec3.v 1. 1. 1.) ())
+    |> World.with_component w (module Transform.C) (Transform.identity ())
+  in
+
+  let _camera =
+    World.add_entity w
+    |> World.with_component w (module Graphics.Camera3d.C) ()
+    |> World.with_component w
+         (module Graphics.Camera.Projection.C)
+         (Graphics.Camera.Projection.orthographic ~left:(-15.) ~right:15.
+            ~bottom:(-15.) ~top:15. ())
+    |> World.with_component w
+         (module Transform.C)
+         Transform.(
+           identity ()
+           |> with_translation (Math.Vec3.v 8. 20. 25.)
+           |> with_look_at Math.Vec3.zero)
+  in
+  World.add_system w Scheduler.Update step
+
+let () =
+  Random.self_init ();
+  let app =
+    App.create ()
+    |> App.add_plugin Input.plugin
+    |> App.add_plugin Graphics.plugin
+    |> App.add_plugin plugin
+  in
+
+  App.run app
+

examples/move.ml

@@ -55,7 +55,7 @@ let plugin w =
     World.add_entity w
     |> World.with_component w
          (module Graphics.Mesh3d.C)
-         (Graphics.Mesh3d.of_primitive
+         (Graphics.Primitive.to_mesh3d
             (Graphics.Primitive.Sphere.create ~param1:10 ~param2:10 ()))
     |> World.with_component w (module Transform.C) (Transform.identity ())
     |> World.with_component w (module Graphics.Shader.Normal.C) ()

examples/plugin/fp_camera.ml

@@ -98,6 +98,19 @@ let handle_mouse sensitivity =
   in
   System.make query (System.Query move)
 
-let plugin ?(mouse_sensitivity = 0.001) ?(move_factor = 0.001) w =
+let set_fullscreen =
+  System.make
+    (fun w ->
+      World.query w Query.(Req (module Graphics.Context.C) @ Nil)
+      |> List.map (fun (_, (c, ())) -> c))
+    (System.Query
+       (List.iter (fun context ->
+            Graphics.Context.set_window_fullscreen context
+              Graphics.Context.Window.fullscreen;
+            Graphics.Context.set_relative_mouse_mode true)))
+
+let plugin ?(mouse_sensitivity = 0.001) ?(move_factor = 0.001)
+    ?(fullscreen = false) w =
+  if fullscreen then World.add_system w Scheduler.Startup set_fullscreen;
   World.add_system w Scheduler.Update (handle_keyboard move_factor);
   World.add_system w Scheduler.Update (handle_mouse mouse_sensitivity)

examples/plugin/fp_camera.mli

@@ -7,4 +7,8 @@
 module C : Ecs.Component.S with type t = unit
 
 val plugin :
-  ?mouse_sensitivity:float -> ?move_factor:float -> Ecs.World.t -> unit
+  ?mouse_sensitivity:float ->
+  ?move_factor:float ->
+  ?fullscreen:bool ->
+  Ecs.World.t ->
+  unit

examples/shapes.ml

@@ -32,7 +32,7 @@ let add_shape w primitive x y z =
   World.add_entity w
   |> World.with_component w
        (module Graphics.Mesh3d.C)
-       (Graphics.Mesh3d.of_primitive primitive)
+       (Graphics.Primitive.to_mesh3d primitive)
   |> World.with_component w
        (module Transform.C)
        Transform.(of_xyz x y z |> with_scale (Math.Vec3.v 1.3 1.3 1.3))

examples/spawn.ml

@@ -7,7 +7,7 @@ let add_random_ball w =
   World.add_entity w
   |> World.with_component w
        (module Graphics.Mesh3d.C)
-       (Graphics.Mesh3d.of_primitive
+       (Graphics.Primitive.to_mesh3d
           (Graphics.Primitive.Sphere.create ~param1:20 ~param2:20 ()))
   |> World.with_component w
        (module Transform.C)

lib/graphics/mesh3d.ml

@@ -10,9 +10,6 @@ type t = mesh3d ref
 
 let of_vertex_mesh mesh = ref (Staged { mesh })
 
-let of_primitive primitive =
-  Vertex_mesh.of_primitive primitive |> of_vertex_mesh
-
 let vertex_mesh t =
   match !t with
   | Staged { mesh } | Initialized { mesh; _ } -> mesh
@@ -41,7 +38,7 @@ let rec install t =
   let aux mesh vao vbo =
     with_vao vao (fun () ->
         with_vbo vbo (fun () ->
-            let vertex_data = Vertex_mesh.vertex_data mesh in
+            let vertex_data = Vertex_mesh.data mesh in
             let varray =
               bigarray_create Bigarray.float32 (Array.length vertex_data)
             in
@@ -52,11 +49,11 @@ let rec install t =
 
             let size_of_float = 4 in
             let stride = Vertex_mesh.vertex_size mesh * size_of_float in
-            let attribute_info = Vertex_mesh.attribute_info mesh in
             let offset = ref 0 in
-            attribute_info
-            |> Seq.iter (fun info ->
-                   let { Vertex_mesh.Attribute.index; size } = info in
+            Vertex_mesh.attributes mesh
+            |> Hashtbl.to_seq |> List.of_seq
+            |> List.sort (fun (index1, _) (index2, _) -> compare index2 index1)
+            |> List.iter (fun (index, size) ->
                    Gl.enable_vertex_attrib_array index;
                    Gl.vertex_attrib_pointer index size Gl.float false stride
                      (`Offset (!offset * size_of_float));

lib/graphics/mesh3d.mli

@@ -5,11 +5,6 @@ type t
 val of_vertex_mesh : Vertex_mesh.t -> t
 (** Create a mesh component from a vertex mesh. *)
 
-val of_primitive : Primitive.t -> t
-(** Create a mesh component from a primitive.
-
-    Internally, this creates a vertex mesh from the primitive. *)
-
 val vertex_mesh : t -> Vertex_mesh.t
 (** Return the vertex mesh of the mesh component. *)