MTL support

.gitignore

@@ -10,5 +10,4 @@
 *.cmxa
 _build
 .vscode/*
-*.mtl
 .ocamlformat

README.md

@@ -27,7 +27,7 @@ OBJS="objs/uv_sphere.obj objs/torus.obj objs/star_destroyer.obj objs/pyramid.obj
 
 ### Blender
 
-If you're using Blender to create 3D models for ZENITH, ensure that, in the export window under `Geometry`, the options "Write Normals," "Include UVs," and "Write Materials" are deactivated. These options generate vernacular in the output `.obj` file that my loader does not support.
+If you want to color your Blender models, the only shader compatible with the `Kd` (diffuse color) field is Principled BSDF.
 
 ### Supported .OBJ Vernacular
 

bin/argparse.ml

@@ -9,7 +9,7 @@ let copies l n =
 
 let parse_arguments () =
   let obj_files = ref [] in
-  let objs = ref [ cube ] in
+  let objs : mesh list ref = ref [ cube ] in
   let num_each = ref 1 in
 
   let speclist =

lib/logging/logging.ml

@@ -27,6 +27,7 @@ let rc_Ok = (0, "OK")
 and rc_Error = (1, "ERROR")
 and rc_OOB = (2, "OUT OF BOUNDS ERROR")
 and rc_MatchError = (3, "MATCH ERROR")
+and rc_MaterialError = (4, "MATERIAL ERROR")
 
 (** ANSI encoding for bold text *)
 let ansi_bold = "\x1b[1m"

lib/mesh.ml

@@ -1,24 +1,34 @@
+open Graphics
 open Math.Vector
 
-type mesh = vec list * (int * int) list
+(* Vertices, edges, edge colors *)
+type mesh = vec list * ((int * int) * color option) list
 
-let print_mesh mesh =
+let print_mesh (mesh : mesh) =
   let vertices, edges = mesh in
   Printf.printf "Vertices:\n";
   List.iteri (fun i v -> Printf.printf "%d: %s\n" i (string_of_vec v)) vertices;
   Printf.printf "\nEdges:\n";
-  List.iter (fun (a, b) -> Printf.printf "(%d, %d)\n" a b) edges
+  List.iter
+    (fun ((a, b), c) ->
+      Printf.printf "(%d, %d) Color: %s\n" a b
+        (match c with None -> "None" | Some x -> string_of_int x))
+    edges
 
-let map_verts mesh f = (List.map f (fst mesh), snd mesh)
+let map_verts (mesh : mesh) (f : vec -> vec) : mesh =
+  let verts, edges = mesh in
+  (List.map f verts, edges)
 
-let triangle =
-  ([ v3 0.5 0. 0.; v3 1. 0. 0.; v3 1. 1. 0. ], [ (0, 1); (1, 2); (2, 0) ])
+let edge a b = ((a, b), None)
 
-let square =
+let triangle : mesh =
+  ([ v3 0.5 0. 0.; v3 1. 0. 0.; v3 1. 1. 0. ], [ edge 0 1; edge 1 2; edge 2 0 ])
+
+let square : mesh =
   ( [ v3 0. 0. 0.; v3 0. 1. 0.; v3 1. 0. 0.; v3 1. 1. 0. ],
-    [ (0, 1); (0, 2); (3, 1); (3, 2) ] )
+    [ edge 0 1; edge 0 2; edge 3 1; edge 3 2 ] )
 
-let cube =
+let cube : mesh =
   ( [
       v3 0. 0. 0.;
       v3 0. 0. 1.;
@@ -30,23 +40,32 @@ let cube =
       v3 1. 1. 1.;
     ],
     [
-      (0, 1);
-      (0, 2);
-      (0, 4);
-      (1, 3);
-      (1, 5);
-      (2, 3);
-      (2, 6);
-      (3, 7);
-      (4, 5);
-      (4, 6);
-      (5, 7);
-      (6, 7);
+      edge 0 1;
+      edge 0 2;
+      edge 0 4;
+      edge 1 3;
+      edge 1 5;
+      edge 2 3;
+      edge 2 6;
+      edge 3 7;
+      edge 4 5;
+      edge 4 6;
+      edge 5 7;
+      edge 6 7;
     ] )
 
-let pyramid =
+let pyramid : mesh =
   ( [ v3 0. 0. 0.; v3 1. 0. 0.; v3 1. 0. 1.; v3 0. 0. 1.; v3 0.5 1. 0.5 ],
-    [ (0, 1); (1, 2); (2, 3); (3, 0); (0, 4); (1, 4); (2, 4); (3, 4) ] )
+    [
+      edge 0 1;
+      edge 1 2;
+      edge 2 3;
+      edge 3 0;
+      edge 0 4;
+      edge 1 4;
+      edge 2 4;
+      edge 3 4;
+    ] )
 
 let filter_duplicates meshes =
   let rec aux acc seen = function

lib/objloader.ml

@@ -1,7 +1,15 @@
+open Graphics
 open Mesh
 open Math.Vector
+open Logging
 
-type vernacular = Vertex of vec | Edge of (int * int)
+type vernacular =
+  | Vertex of vec
+  | Edge of ((int * int) * color option)
+  | MaterialFilename of string
+  | UseMaterial of string
+
+type material = { name : string; color : color }
 
 let pairs_of_consecutive_elements lst =
   let rec aux first = function
@@ -13,52 +21,120 @@ let pairs_of_consecutive_elements lst =
   in
   match lst with [] | [ _ ] -> [] | h :: _ :: _ -> aux h lst
 
-let parse_obj_line line : vernacular list option =
+let parse_obj_line line current_mtl : vernacular list option =
   match String.split_on_char ' ' line with
-  | [] -> None
-  | [ "#" ] -> None (* Comment line *)
   | "v" :: xs ->
       let v = List.map float_of_string xs in
       Some [ Vertex (v3 (List.nth v 0) (List.nth v 1) (List.nth v 2)) ]
   | "l" :: xs ->
-      let edge = List.map (fun s -> int_of_string s - 1) xs in
-      Some [ Edge (List.nth edge 0, List.nth edge 1) ]
+      let parsed_edge = List.map (fun s -> int_of_string s - 1) xs in
+      Some
+        [
+          Edge
+            ( (List.nth parsed_edge 0, List.nth parsed_edge 1),
+              Some current_mtl.color );
+        ]
   | "f" :: xs ->
-      let vertices = List.map (fun s -> int_of_string s - 1) xs in
+      let vertices =
+        List.map
+          (fun s ->
+            int_of_string
+              (if String.contains s '/' then String.sub s 0 (String.index s '/')
+               else s)
+            - 1)
+          xs
+      in
       let edges = pairs_of_consecutive_elements vertices in
-      Some (List.map (fun x -> Edge x) edges)
+      Some (List.map (fun x -> Edge (x, Some current_mtl.color)) edges)
+  | [ "mtllib"; name ] -> Some [ MaterialFilename name ]
+  | [ "usemtl"; name ] -> Some [ UseMaterial name ]
   | _ -> None
 
-let rec parse_obj_lines lines vertices edges =
+let scan_file filename =
+  let lines = ref [] in
+  try
+    let chan = open_in filename in
+    try
+      while true do
+        lines := input_line chan :: !lines
+      done;
+      !lines
+    with End_of_file ->
+      close_in chan;
+      List.rev !lines
+  with
+  | Sys_error s when String.ends_with ~suffix:"No such file or directory" s ->
+    []
+
+let parse_mtls obj_fn mtl_fn : material list =
+  let lines = scan_file (Filename.concat (Filename.dirname obj_fn) mtl_fn) in
+  let found_materials : material list ref = ref [] in
+  let _ =
+    List.fold_left
+      (fun (name, color) line ->
+        if name != None && color != None then
+          match (name, color) with
+          | Some n, Some c ->
+              found_materials := { name = n; color = c } :: !found_materials;
+              (None, None)
+          | _ -> failwith "This never happens"
+        else
+          match String.split_on_char ' ' line with
+          | "newmtl" :: n -> (Some (String.concat " " n), color)
+          | [ "Kd"; r; g; b ] ->
+              let kd_to_comp kd = int_of_float (float_of_string kd *. 255.) in
+              (name, Some (rgb (kd_to_comp r) (kd_to_comp g) (kd_to_comp b)))
+          | _ -> (name, color))
+      (None, None) lines
+  in
+  if List.length !found_materials = 0 then
+    fatal rc_MaterialError
+      ("Material file " ^ mtl_fn
+     ^ " did not contain both a material name and diffuse color")
+  else !found_materials
+
+let get_material l name obj_fn =
+  match
+    List.fold_left
+      (fun s i ->
+        if s != None then s else if i.name = name then Some i else None)
+      None l
+  with
+  | Some m -> m
+  | _ ->
+      fatal rc_MaterialError
+        ("Object file " ^ obj_fn ^ " tried to use material \"" ^ name
+       ^ "\" that has not been declared yet")
+
+let rec parse_obj_lines obj_fn lines (materials : material list) current_mtl
+    vertices edges =
   match lines with
-  | [] -> (vertices, edges)
+  | [] -> (List.rev vertices, edges)
   | line :: rest -> (
-      match parse_obj_line line with
-      | Some [ Vertex v ] -> parse_obj_lines rest (v :: vertices) edges
-      | Some [ Edge e ] -> parse_obj_lines rest vertices (e :: edges)
+      match parse_obj_line line current_mtl with
+      | Some [ Vertex v ] ->
+          parse_obj_lines obj_fn rest materials current_mtl (v :: vertices)
+            edges
+      | Some [ Edge e ] ->
+          parse_obj_lines obj_fn rest materials current_mtl vertices (e :: edges)
       | Some (Edge e :: t) ->
-          parse_obj_lines rest vertices
+          parse_obj_lines obj_fn rest materials current_mtl vertices
             (List.map
-               (fun x -> match x with Edge _e -> _e | _ -> (0, 0))
+               (fun x -> match x with Edge _e -> _e | _ -> edge 0 0)
                (Edge e :: t)
             @ edges)
-      | _ -> parse_obj_lines rest vertices edges)
-
-let parse_obj_file filename =
-  let lines = ref [] in
-  let chan = open_in filename in
-  try
-    while true do
-      lines := input_line chan :: !lines
-    done;
-    !lines
-  with End_of_file ->
-    close_in chan;
-    List.rev !lines
+      | Some [ MaterialFilename mtl_fn ] ->
+          parse_obj_lines obj_fn rest
+            (parse_mtls obj_fn mtl_fn @ materials)
+            current_mtl vertices edges
+      | Some [ UseMaterial mtl_name ] ->
+          parse_obj_lines obj_fn rest materials
+            (get_material materials mtl_name obj_fn)
+            vertices edges
+      | _ -> parse_obj_lines obj_fn rest materials current_mtl vertices edges)
 
-let load_obj filename : mesh =
-  let lines = parse_obj_file filename in
-  let vertices, edges = parse_obj_lines lines [] [] in
-  let out = (List.rev vertices, List.rev edges) in
-  (* print_mesh out; *)
-  out
+let load_obj obj_fn : mesh =
+  let obj_lines = scan_file obj_fn in
+  parse_obj_lines obj_fn obj_lines []
+    { name = "Default"; color = Config.edge_color }
+    [] []

lib/renderer.ml

@@ -182,7 +182,7 @@ let projection_matrix fov aspect_ratio z_near z_far =
     dim = (4, 4);
   }
 
-let project_mesh mesh euler_rot translation =
+let project_mesh (m : mesh) euler_rot translation : mesh =
   let mvp =
     matmul
       (matmul
@@ -195,7 +195,7 @@ let project_mesh mesh euler_rot translation =
     ( (Config.z_far -. Config.z_near) /. 2.,
       (Config.z_far +. Config.z_near) /. 2. )
   in
-  map_verts mesh (fun v ->
+  map_verts m (fun v ->
       v |> fun x ->
       (* Projection *)
       vecmatmul x mvp |> fun x ->
@@ -209,14 +209,16 @@ let project_mesh mesh euler_rot translation =
         w = x.w;
       })
 
-let draw_mesh mesh euler_rot translation =
+let draw_mesh m euler_rot translation =
   let c = foreground in
   set_color Config.edge_color;
-  let verts, edges = project_mesh mesh euler_rot translation in
+  let verts, edges = project_mesh m euler_rot translation in
   let _ =
     List.fold_left
-      (fun visited_verts edge ->
-        let v1, v2 = (List.nth verts (fst edge), List.nth verts (snd edge)) in
+      (fun (index, visited_verts) e ->
+        let (e1, e2), ecolor = e in
+        let v1, v2 = (List.nth verts e1, List.nth verts e2) in
+        let _ = match ecolor with Some c -> set_color c | _ -> () in
         draw_line v1 v2;
         if Config.draw_verts then (
           set_color Config.vert_color;
@@ -227,7 +229,7 @@ let draw_mesh mesh euler_rot translation =
             fill_circle (int_of_float v2.x) (int_of_float v2.y)
               Config.vert_radius;
           set_color Config.edge_color);
-        v1 :: v2 :: visited_verts)
-      [] edges
+        (index + 1, v1 :: v2 :: visited_verts))
+      (0, []) edges
   in
   set_color c

objs/teapot.obj

@@ -1,6 +1,5 @@
 # Blender v3.0.0 OBJ File: ''
 # www.blender.org
-mtllib teapot.mtl
 o teapot
 v 1.368074 2.435437 -0.227403
 v 1.381968 2.400000 -0.229712