first commit

.gitignore

@@ -0,0 +1,2 @@
+_build
+*.ppm

.ocamlformat

@@ -0,0 +1,61 @@
+version=0.19.0
+align-cases=false
+align-constructors-decl=false
+align-variants-decl=false
+assignment-operator=end-line
+break-before-in=fit-or-vertical
+break-cases=all
+break-collection-expressions=fit-or-vertical
+break-fun-decl=wrap
+break-fun-sig=wrap
+break-infix=wrap
+break-infix-before-func=false
+break-separators=before
+break-sequences=true
+break-string-literals=auto
+break-struct=force
+cases-exp-indent=2
+cases-matching-exp-indent=normal
+disambiguate-non-breaking-match=false
+doc-comments=before
+doc-comments-padding=2
+doc-comments-tag-only=default
+dock-collection-brackets=false
+exp-grouping=preserve
+extension-indent=2
+field-space=loose
+function-indent=2
+function-indent-nested=never
+if-then-else=k-r
+indent-after-in=0
+indicate-multiline-delimiters=space
+indicate-nested-or-patterns=unsafe-no
+infix-precedence=indent
+leading-nested-match-parens=false
+let-and=sparse
+let-binding-indent=2
+let-binding-spacing=compact
+let-module=compact
+margin=80
+match-indent=0
+match-indent-nested=never
+max-indent=68
+module-item-spacing=sparse
+nested-match=wrap
+ocp-indent-compat=false
+parens-ite=false
+parens-tuple=always
+parens-tuple-patterns=multi-line-only
+parse-docstrings=true
+sequence-blank-line=preserve-one
+sequence-style=terminator
+single-case=compact
+space-around-arrays=true
+space-around-lists=true
+space-around-records=true
+space-around-variants=true
+stritem-extension-indent=0
+type-decl=sparse
+type-decl-indent=2
+wrap-comments=false
+wrap-fun-args=true

CHANGES.md

@@ -0,0 +1 @@
+## unreleased

LICENSE.md

@@ -0,0 +1,8 @@
+The ISC License (ISC)
+=====================
+
+Copyright © 2021, TODO
+
+Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

README.md

@@ -0,0 +1,40 @@
+# ray
+
+ray is an [OCaml] executable/library to TODO.
+
+## Installation
+
+`ray` can be installed with [opam]:
+
+```sh
+opam install ray
+```
+
+If you don't have `opam`, you can install it following the [how to install opam] guide.
+
+If you can't or don't want to use `opam`, consult the [opam file] for build instructions.
+
+## Quickstart
+
+```ocaml
+let () = Format.printf "TODO@."
+```
+
+For more, have a look at the [example] folder, at the [documentation] or at the [test suite].
+
+## About
+
+- [LICENSE]
+- [CHANGELOG]
+
+[CHANGELOG]: ./CHANGES.md
+[example]: ./example/
+[LICENSE]: ./LICENSE.md
+[opam file]: ./ray.opam
+[test suite]: ./test/
+
+[documentation]: TODO
+[how to install opam]: https://opam.ocaml.org/doc/Install.html
+[OCaml]: https://ocaml.org
+[opam]: https://opam.ocaml.org/
+[ray]: TODO

doc/dune

@@ -0,0 +1,3 @@
+(documentation
+ (package ray)
+ (mld_files index))

doc/index.mld

@@ -0,0 +1,19 @@
+{0 ray}
+
+{{:https://TODO} ray} is an {{:https://ocaml.org} OCaml} library/executable to TODO.
+
+{1:api API}
+
+
+{!modules:
+Ray
+}
+
+
+{1:private_api Private API}
+
+You shouldn't have to use any of these modules, they're used internally only.
+
+{!modules:
+TODO
+}

dune-project

@@ -0,0 +1,25 @@
+(lang dune 2.8)
+
+(name ray)
+
+(license ISC)
+
+(authors "TODO")
+
+(maintainers "TODO")
+
+;(source
+; (github TODO/ray))
+
+(generate_opam_files true)
+
+(package
+ (name ray)
+ (synopsis "OCaml library/executable to TODO")
+ (description
+  "ray is an OCaml library/executable to TODO.")
+ (tags
+  (ray TODO TODO TODO TODO))
+ (depends
+  (ocaml
+   (>= 4.08))))

example/dune

@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (modules main))

example/example1.scene

@@ -0,0 +1,13 @@
+1024
+768
+-2
+2
+-1.5
+1.5
+0,0,1
+6,6,6
+center;radius;ambiant;diffuse;specular;shininess;reflection
+-0.2, 0, -1;0.7;0.1, 0, 0;0.7, 0, 0;1, 1, 1;80;0.5
+0.1, -0.3, 0;0.1;0.1, 0, 0.1;0.7, 0, 0.7;1, 1, 1;100;0.5
+-0.3, -0.2, 0;0.15;0, 0, 0.1;0, 0, 0.6;1, 1, 1;50;0.5
+0, -10000.75, 0;10000;0.1, 0.1, 0.1;0.8, 0.8, 0.8;1, 1, 1;100;0

example/example2.scene

@@ -0,0 +1,34 @@
+1024
+768
+-8
+8
+-6
+6
+0,0,1000
+6,6,6
+center;radius;ambiant;diffuse;specular;shininess;reflection
+0, -10005,0;10000;0.1, 0.1, 0.1;0.8, 0.8, 0.8;0, 0, 0;100;0
+0.0,0.0,0.0;0.25;1,0.0,0;0.06999999999999999,0.0,0.0;0.06999999999999999,0.0,0.0;50;0.5
+0.3810531936292168,0.12164893597962362,-0.375;0.25;1,0.25,0;0.06999999999999999,0.017499999999999998,0.0;0.06999999999999999,0.017499999999999998,0.0;50;0.5
+0.6520153637502543,0.4635471555663173,-0.75;0.25;1,0.5,0;0.06999999999999999,0.034999999999999996,0.0;0.06999999999999999,0.034999999999999996,0.0;50;0.5
+0.7202344440049738,0.9598241222582636,-1.125;0.25;1,0.75,0;0.06999999999999999,0.0525,0.0;0.06999999999999999,0.0525,0.0;50;0.5
+0.5256201728318822,1.5111993362598406,-1.5;0.25;1.0,1,0;0.06999999999999999,0.06999999999999999,0.0;0.06999999999999999,0.06999999999999999,0.0;50;0.5
+0.05141704432627048,1.9993389626455915,-1.875;0.25;0.75,1,0;0.0525,0.06999999999999999,0.0;0.0525,0.06999999999999999,0.0;50;0.5
+-0.6708744855628206,2.3043279767908085,-2.25;0.25;0.5,1,0;0.034999999999999996,0.06999999999999999,0.0;0.034999999999999996,0.06999999999999999,0.0;50;0.5
+-1.5632105760038588,2.32300940486036,-2.625;0.25;0.25,1,0;0.017499999999999998,0.06999999999999999,0.0;0.017499999999999998,0.06999999999999999,0.0;50;0.5
+-2.5093085847804555,1.9857921407708075,-3.0;0.25;0,1,0.0;0.0,0.06999999999999999,0.0;0.0,0.06999999999999999,0.0;50;0.5
+-3.3686706122810737,1.2696685811477948,-3.375;0.25;0,1,0.25;0.0,0.06999999999999999,0.017499999999999998;0.0,0.06999999999999999,0.017499999999999998;50;0.5
+-3.9947125751055004,0.20560020013117605,-3.75;0.25;0,1,0.5;0.0,0.06999999999999999,0.034999999999999996;0.0,0.06999999999999999,0.034999999999999996;50;0.5
+-4.254824832384222,-1.1209217839468424,-4.125;0.25;0,1,0.75;0.0,0.06999999999999999,0.0525;0.0,0.06999999999999999,0.0525;50;0.5
+-4.049879041034702,-2.5765247433292475,-4.5;0.25;0,1.0,1;0.0,0.06999999999999999,0.06999999999999999;0.0,0.06999999999999999,0.06999999999999999;50;0.5
+-3.33067542396097,-3.993319574016386,-4.875;0.25;0,0.75,1;0.0,0.0525,0.06999999999999999;0.0,0.0525,0.06999999999999999;50;0.5
+-2.1091038500995474,-5.187646956905921,-5.25;0.25;0,0.5,1;0.0,0.034999999999999996,0.06999999999999999;0.0,0.034999999999999996,0.06999999999999999;50;0.5
+-0.46234560329617586,-5.9821598560313225,-5.625;0.25;0,0.25,1;0.0,0.017499999999999998,0.06999999999999999;0.0,0.017499999999999998,0.06999999999999999;50;0.5
+1.4707869670661164,-6.228706583032182,-6.0;0.25;0.0,0,1;0.0,0.0,0.06999999999999999;0.0,0.0,0.06999999999999999;50;0.5
+3.5013720606510255,-5.829270425438538,-6.375;0.25;0.25,0,1;0.017499999999999998,0.0,0.06999999999999999;0.017499999999999998,0.0,0.06999999999999999;50;0.5
+5.408824104495717,-4.7523280407213155,-6.75;0.25;0.5,0,1;0.034999999999999996,0.0,0.06999999999999999;0.034999999999999996,0.0,0.06999999999999999;50;0.5
+6.964464113771744,-3.042406877455015,-7.125;0.25;0.75,0,1;0.0525,0.0,0.06999999999999999;0.0525,0.0,0.06999999999999999;50;0.5
+7.9577285577060195,-0.8213137049082165,-7.5;0.25;1,0,1.0;0.06999999999999999,0.0,0.06999999999999999;0.06999999999999999,0.0,0.06999999999999999;50;0.5
+8.222103275546653,1.7195981292863145,-7.875;0.25;1,0,0.75;0.06999999999999999,0.0,0.0525;0.06999999999999999,0.0,0.0525;50;0.5
+7.657758503884935,4.33575076499768,-8.25;0.25;1,0,0.5;0.06999999999999999,0.0,0.034999999999999996;0.06999999999999999,0.0,0.034999999999999996;50;0.5
+6.248090787996858,6.752878016442234,-8.625;0.25;1,0,0.25;0.06999999999999999,0.0,0.017499999999999998;0.06999999999999999,0.0,0.017499999999999998;50;0.5

example/main.ml

@@ -0,0 +1 @@
+let () = Format.printf "TODO@."

ray.opam

@@ -0,0 +1,27 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "OCaml library/executable to TODO"
+description: "ray is an OCaml library/executable to TODO."
+maintainer: ["TODO"]
+authors: ["TODO"]
+license: "ISC"
+tags: ["ray" "TODO" "TODO" "TODO" "TODO"]
+depends: [
+  "dune" {>= "2.8"}
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]

src/dune

@@ -0,0 +1,3 @@
+(executable
+ (name ray)
+ (modules ray))

src/ray.ml

@@ -0,0 +1,232 @@
+module V = struct
+  type t =
+    { x : Float.t
+    ; y : Float.t
+    ; z : Float.t
+    }
+
+  let mk x y z = { x; y; z }
+
+  let mki x y z =
+    let x = Float.of_int x in
+    let y = Float.of_int y in
+    let z = Float.of_int z in
+    mk x y z
+
+  let map f { x; y; z } = { x = f x; y = f y; z = f z }
+
+  let map2 f a b = { x = f a.x b.x; y = f a.y b.y; z = f a.z b.z }
+
+  let fold f { x; y; z } = f (f x y) z
+
+  let iter f { x; y; z } =
+    f x;
+    f y;
+    f z
+
+  let add = map2 Float.add
+
+  let sub = map2 Float.sub
+
+  let mul = map2 Float.mul
+
+  let div = map2 Float.div
+
+  let times r = map (Float.mul r)
+
+  let dot a b = fold Float.add (mul a b)
+
+  let norm a = Float.sqrt (dot a a)
+
+  let normalize a =
+    let r = Float.div Float.one (norm a) in
+    times r a
+
+  let eq a b = Float.equal a.x b.x && Float.equal a.y b.y && Float.equal a.z b.z
+end
+
+module I = struct
+  type t =
+    { bytes : Bytes.t
+    ; w : Int.t
+    ; h : Int.t
+    }
+
+  type color = float * float * float
+
+  let mk w h = { bytes = Bytes.create (3 * w * h); w; h }
+
+  let set img x y (r, g, b) =
+    List.iteri
+      (fun i c ->
+        Bytes.set img.bytes
+          ((3 * ((img.w * y) + x)) + i)
+          (Char.chr @@ int_of_float (255. *. min 1. (max 0. c))) )
+      [ r; g; b ]
+
+  let pp fmt img =
+    Format.fprintf fmt "P6@.%i %i %i@.%s" img.w img.h 255
+      (Bytes.to_string img.bytes)
+
+  let out_file f img =
+    let chan = open_out f in
+    let fmt = Format.formatter_of_out_channel chan in
+    pp fmt img;
+    Format.pp_print_flush fmt ();
+    close_out chan
+end
+
+module R = struct
+  type o =
+    { center : V.t
+    ; radius : Float.t
+    ; ambiant : V.t
+    ; diffuse : V.t
+    ; specular : V.t
+    ; shininess : Float.t
+    ; reflection : Float.t
+    }
+
+  let pixel_to_point w h xmin xmax ymin ymax px py =
+    ((px *. (xmax -. xmin) /. w) +. xmin, (py *. (ymax -. ymin) /. h) +. ymin)
+
+  let sphere_intersect c r o d =
+    let a = 1. in
+    let b = 2. *. V.dot d (V.sub o c) in
+    let c =
+      let norm = V.norm (V.sub o c) in
+      (norm *. norm) -. (r *. r)
+    in
+    let delta = (b *. b) -. (4. *. a *. c) in
+    if delta <= 0. then
+      None
+    else
+      let k2 = (~-.b -. sqrt delta) /. 2. in
+      if k2 <= 0. then
+        None
+      else
+        Some k2
+
+  let nearest_intersection objs v d =
+    List.fold_left
+      (fun (sphere, min_dist) obj ->
+        match sphere_intersect obj.center obj.radius v d with
+        | Some d when d < min_dist -> (Some obj, d)
+        | None
+        | Some _ ->
+          (sphere, min_dist) )
+      (None, Float.infinity) objs
+
+  let compute_color o v n l =
+    V.add o.ambiant
+      (V.add
+         (V.times (V.dot l n) o.diffuse)
+         (V.times
+            (Float.pow
+               ((* TODO: abs ?*)
+                V.dot n (V.normalize (V.add l v)) )
+               (o.shininess /. 4.) )
+            o.specular ) )
+
+  let trace w h xmin xmax ymin ymax camera light objs =
+    let img = I.mk w h in
+    for py = 0 to h - 1 do
+      let py = float_of_int py in
+      let h = float_of_int h in
+      for px = 0 to w - 1 do
+        let w = float_of_int w in
+        let px = float_of_int px in
+        let x, y = pixel_to_point w h xmin xmax ymin ymax px py in
+        let p = V.mk x y 0. in
+        let vp = V.sub p camera in
+        let d = V.normalize vp in
+
+        let obj, dist = nearest_intersection objs camera d in
+
+        let couleur =
+          match obj with
+          | None -> V.mk 0. 0. 0.
+          | Some obj ->
+            let x_point = V.add camera (V.times dist d) in
+            let l = V.normalize (V.sub light x_point) in
+            let _obstacle, dist_obst = nearest_intersection objs x_point l in
+            if dist_obst < V.norm (V.sub light x_point) then
+              V.mk 0. 0. 0.
+            else
+              let n = V.normalize (V.sub x_point obj.center) in
+              compute_color obj camera n l
+        in
+
+        I.set img (int_of_float px)
+          (int_of_float @@ (h -. py -. 1.))
+          (couleur.x, couleur.y, couleur.z)
+      done
+    done;
+    img
+
+  let read_vector s =
+    let fields = String.split_on_char ',' s in
+    if List.length fields <> 3 then
+      failwith @@ Format.sprintf "error while loading `%s`" s;
+    let fields = List.map String.trim fields in
+    match List.map float_of_string fields with
+    | [ x; y; z ] -> V.mk x y z
+    | _whatever -> failwith "read_vector"
+
+  let read_float s =
+    let s = String.trim s in
+    float_of_string s
+
+  let read_int s =
+    let s = String.trim s in
+    int_of_string s
+
+  let load_scene path =
+    let chan = open_in path in
+    let w = read_int @@ input_line chan in
+    let h = read_int @@ input_line chan in
+    let xmin = read_float @@ input_line chan in
+    let xmax = read_float @@ input_line chan in
+    let ymin = read_float @@ input_line chan in
+    let ymax = read_float @@ input_line chan in
+    let camera = read_vector @@ input_line chan in
+    let light = read_vector @@ input_line chan in
+    let _names = input_line chan in
+    let objs = ref [] in
+    begin
+      try
+        while true do
+          objs := input_line chan :: !objs
+        done
+      with
+      | End_of_file -> ()
+    end;
+    let objs = List.rev !objs in
+    let objs = List.map (String.split_on_char ';') objs in
+    let mk_obj = function
+      | [ center; radius; ambiant; diffuse; specular; shininess; reflection ] ->
+        let center = read_vector center in
+        let radius = read_float radius in
+        let ambiant = read_vector ambiant in
+        let diffuse = read_vector diffuse in
+        let specular = read_vector specular in
+        let shininess = min 100. (max 0. (read_float shininess)) in
+        let reflection = min 1. (max 0. (read_float reflection)) in
+        { center; radius; ambiant; diffuse; specular; shininess; reflection }
+      | _whatever -> failwith "mk_obj"
+    in
+
+    let objs = List.map mk_obj objs in
+    (w, h, xmin, xmax, ymin, ymax, camera, light, objs)
+end
+
+let () =
+  let in_file = Sys.argv.(1) in
+  let out_file = Filename.chop_extension in_file in
+  let out_file = Format.sprintf "%s.ppm" out_file in
+  Format.printf "loading scene...@.";
+  let w, h, xmin, xmax, ymin, ymax, camera, lum, objs = R.load_scene in_file in
+  Format.printf "tracing scene...@.";
+  let img = R.trace w h xmin xmax ymin ymax camera lum objs in
+  Format.printf "storing scene...@.";
+  I.out_file out_file img

test/dune

@@ -0,0 +1,3 @@
+(test
+ (name main)
+ (modules main))

test/main.ml

@@ -0,0 +1 @@
+let () = assert true (* TODO *)