From fc372abee34d93fe02e79e0e7532b057b28864e4 Mon Sep 17 00:00:00 2001
From: Sasha Kovar <sasha-git@arcocene.org>
Date: Wed, 10 May 2017 21:29:32 -0700
Subject: [PATCH] basic progress

---
 src/voxelburst/core.clj | 134 ++++++++++++++++++++++++++++++++++++----
 1 file changed, 121 insertions(+), 13 deletions(-)

diff --git a/src/voxelburst/core.clj b/src/voxelburst/core.clj
index d137659..ee8fd76 100644
--- a/src/voxelburst/core.clj
+++ b/src/voxelburst/core.clj
@@ -1,5 +1,6 @@
 (ns voxelburst.core
   (:require
+   [clojure.set :as set]
    [clojure.java.io :as io]
    [clojure.string :as string]
    [clojure.tools.trace :refer :all]
@@ -14,16 +15,17 @@
    ;;[thi.ng.luxor.core :refer :all]
    ;;[thi.ng.luxor.io :as lio]
    [thi.ng.math.core :as m]
+   [clojure.math.numeric-tower :as math]
    ;;[termite.sim :as sim]
    ;;[termite.ui :as ui]
    )
   (:gen-class))
 
 
-(def res (double 1/2))
-(def num-holes 30)
+#_(def res (double 1/2))
+#_(def num-holes 30)
 
-(defn voxel-sphere
+#_(defn voxel-sphere
   [tree op origin radius res]
   (let [rg (range (- radius) (+ radius res) res)
         coll (for [x rg, y rg, z rg
@@ -31,7 +33,7 @@
                    :when (<= (g/mag v) radius)] (g/+ origin v))]
     (svo/apply-voxels op tree coll)))
 
-(time
+#_(time
  (def v
    (reduce
     (fn [tree [op o r]] (voxel-sphere tree op o r res))
@@ -47,7 +49,7 @@
         (vec3 (m/random 32) (m/random 32) (m/random 32))
         (m/random 4 8)))))))
 
-(def construct
+#_(def construct
   (let [tree (svo/voxeltree 8 res)]
     (svo/set-at tree (vec3 4 4 4))))
 
@@ -67,7 +69,61 @@
 
 ;; {:pos v :vel v :rad r}
 
-(def gravity [1 1 1.2])
+;;;
+;;; geometry
+;;;
+
+(defn v-mag [v]
+  (math/sqrt (reduce + (map #(* % %) v))))
+
+(defn v-+ [v1 v2]
+  (mapv + v1 v2))
+
+(defn round-point [v]
+  (map math/round v))
+
+(defn sphere
+  "Return a set of points contained in the sphere."
+  [origin radius]
+  (let [rg (range (- radius) radius)]
+    (set (for [x rg, y rg, z rg
+               :let [v (vector x y z)]
+               :when (<= (v-mag v) radius)] (v-+ origin v)))))
+
+;;;
+;;; trace
+;;;
+
+(def start-radius 2)
+(def start-lifespan 20)
+
+(defrecord Trace [position velocity radius lifespan])
+
+(defn new-trace [origin]
+  (Trace. origin (random-vel) start-radius start-lifespan))
+
+(defn update-trace [trace bounds]
+  (let [t (Trace. (next-pos (:position trace) (:velocity trace))
+                  (next-vel (:velocity trace))
+                  start-radius
+                  (dec start-lifespan))]
+    (when (and (in-bounds? (:position t) bounds)
+               (> (:radius t) 0)
+               (> (:lifespan t) 0))
+      t)))
+
+;;;
+;;; physics
+;;;
+
+(def gravity [0 0 -0.2])
+
+(defn random-vel
+  []
+  #_(mapv #(* 2 (- % 0.5)) (repeatedly 3 rand))
+  (vector (* 2 (- (rand) 0.5))
+          (* 2 (- (rand) 0.5))
+          (* 4 (rand))))
 
 (defn next-pos
   "Position at t+1"
@@ -77,7 +133,7 @@
 (defn next-vel
   "Velocity at t+1"
   [vel]
-  (mapv * vel gravity))
+  (mapv + vel gravity))
 
 (defn single-in-bounds?
   "Is a single value in bounds?"
@@ -89,7 +145,7 @@
   [p bounds]
   (every? true? (map #(single-in-bounds? %1 %2) p bounds)))
 
-(deftrace next-point
+#_(defn next-point
   "Return the next position and velocity, or nil if it falls outside
   the domain bounds."
   [pos vel bounds]
@@ -98,10 +154,10 @@
     (when (in-bounds? next-pos bounds)
       [next-pos next-vel])))
 
-(defn trajectory
+#_(defn trajectory
   "Return the points of the trajectory from the initial point until
   the point exits the domain."
-  [pos vel bounds]
+  [trace bounds]
   (loop [pts []
          p pos
          v vel]
@@ -110,17 +166,69 @@
         pts
         (recur (conj pts next-pos) next-pos next-vel)))))
 
-(defn make-tree [size count]
+(defn trace-trajectory
+  [trace bounds]
+  (loop [pts []
+         trace trace]
+    (let [new-trace (update-trace trace bounds)]
+      (if (not new-trace)
+        pts
+        (recur (conj pts (:position trace)) new-trace)))))
+
+(defn trajectory-voxels [trajectory]
+  (reduce set/union (map #(sphere (round-point %) 3) trajectory)))
+
+(defn sample-trace []
+  (let [bounds [[10 490][10 490][10 490]]
+        origin [250 250 250]]
+    (trajectory-voxels (trace-trajectory (new-trace origin) bounds))))
+
+(defn sample-traces [count]
+  (reduce set/union (repeatedly count sample-trace)))
+
+(defn trajectories
+  [origin count bounds]
+  (repeatedly count
+              #(trace-trajectory (new-trace origin) bounds)))
+
+;;;
+;;; tie it together
+;;;
+
+(defn sample-tree [count]
+  (let [tree (svo/voxeltree 500 1.0)
+        trace (sample-traces count)]
+    (svo/apply-voxels svo/set-at tree trace)))
+
+(def sampletree (sample-tree 10))
+
+(defn sample-write-ply
+  [count]
+  (time
+   (with-open [o (io/output-stream "sample.ply")]
+     (let [tree #_sampletree (sample-tree count)]
+       (mio/write-ply o (g/tessellate (iso/surface-mesh tree 5 0.85)))))))
+
+;;;
+;;;
+;;;
+
+#_(defn voxelburst
+  "Return a set of points."
+  [origin trace-count bounds]
+  (reduce set/union (trajectories origin trace-count bounds)))
+
+#_(defn make-tree [size count]
   (let [tree (svo/voxeltree size (double 1/2))]
     (svo/set-at tree (vec3 4 4 4))))
 
-(defn write-ply
+#_(defn write-ply
   [name tree & [resolution inside-val]]
   (time
    (doseq [i (list resolution)]
      (with-open [o (io/output-stream (string/join (list name "-" i ".ply")))]
        (mio/write-ply o (g/tessellate (iso/surface-mesh tree i (or inside-val 0.5))))))))
 
-(defn -main
+#_(defn -main
   [& [name count grid-size resolution]]
   (write-ply name (make-tree) resolution))