feat: error handling and segment intersections

html/css/style.css

@@ -40,6 +40,16 @@ div#Editor {
     display: inline-block;
 }
 
+div#Error > h3 {margin-top: 0}
+div#Error > p {margin-bottom: 0}
+
+div#Error {
+    position: absolute;
+    border: 1px solid red;
+    background: #ffddee;
+    padding: 4px;
+}
+
 div#docs {max-width: 800px; margin-left: auto; margin-right: auto}
 
 label.ui {user-select: none;}

src/erdos/lenart/common.cljs

@@ -1,22 +1,9 @@
 (ns erdos.lenart.common
   (:require-macros [erdos.lenart.macros :refer [template]])
-  (:require [goog.string] [goog.string.format]
+  (:require [goog.string.format]
             [erdos.lenart.lang :as lang]
             [erdos.lenart.math :as m]))
 
-#_
-(defn geo-cube []
-  (for [i [-1 0 1]
-        j [-1 0 1]
-        k [-1 0 1]
-        :when (pos? (* i j k))
-        b [0 1 2]
-        :let [p [i j k]
-              q (update-in p [b] #(* -1 %))]]
-    {:type :segment :from p :to q}))
-
-(defn avg [a b] (/ (+ a b) 2))
-
 (def default-style
      {:stroke "black"
       :fill "rgba(0,0,255,0.8)"

src/erdos/lenart/core.cljs

@@ -1,12 +1,11 @@
 (ns ^:figwheel-always erdos.lenart.core
-    (:require [reagent.core :as reagent
-               :refer [atom]]
-              [erdos.lenart.state :as state :refer [editor-text error-msg]]
-              [erdos.lenart.common :as c :refer [*style* *zoom* format]]
-              [erdos.lenart.lang :as lang]
-              [erdos.lenart.canvas :refer [gr]]))
+  (:require [reagent.core :as reagent]
+            [erdos.lenart.state :as state :refer [editor-text error-msg]]
+            [erdos.lenart.common :as c :refer [*style* *zoom* format]]
+            [erdos.lenart.lang :as lang]
+            [erdos.lenart.canvas :refer [gr]]))
 
-#_ (enable-console-print!)
+(enable-console-print!)
 
 (defn on-js-reload [])
 
@@ -19,13 +18,19 @@
    ;; [:pre (str @construction)]
    [:textarea
     {:on-change on-editor-text-change
-     :rows (count (seq (.split @editor-text "\n")))
+     :rows (count (seq (.split (str @editor-text) "\n")))
      :value @editor-text}]
    ;; error messages are here
-   [:div @error-msg]
+   (when-let [e (:error @error-msg)]
+     [:div#Error
+      [:h3 (str e)]
+      (when-let [line (:line @error-msg)]
+        [:p "Line: " [:code line]])])
    #_[:div [:label.ui [:input {:type "checkbox" :value false}] [:span "Rotate sphere"]] ]])
 
 
 (defn- container [] [:div#Container [:div#Sphere [gr]]  [editor]])
 
 (reagent/render [container] (js/document.getElementById "app"))
+
+(println "Loaded!")

src/erdos/lenart/geo.cljc

@@ -8,39 +8,119 @@
 (defmethod eval-geo :default [acc x]
   (assert false (str "unexpected " x)))
 
-(defmethod eval-geo :point [acc x] x)
+(defmethod eval-geo :point [acc x]
+  (if (m/zero-vec? (:loc x))
+    (assoc x :error "Point is not on the surface of the sphere!")
+    x))
 
 (defmethod eval-geo :segment
   [acc x]
   (let [fl (-> x :from acc :loc)
         tl (-> x :to acc :loc)]
-    (assoc x :from fl :to tl)))
+    (cond
+      (nil? fl)            (assoc x :error (str "Not a point: " (:from x)))
+      (nil? tl)            (assoc x :error (str "Not a point: " (:to x)))
+      (m/antipodal? fl tl) (assoc x :error (str "Points are antipodal!"))
+      :else                (assoc x :from fl :to tl))))
+
+(defmulti point-dist (fn [obj [x y z] lookup] (:type obj)))
+
+(defmethod point-dist :point [point-obj pt lookup]
+  (m/dist-angle (:loc point-obj) pt))
+
+(defmethod point-dist :great-circle [great-circle pt lookup]
+  (m/abs (- (m/dist-angle (:origin great-circle) pt) m/half-pi)))
+
+(defn colinear-points? [a mid b]
+  (assert a)
+  (assert mid)
+  (assert b)
+  (or (m/close? (m/unit (m/cross a mid)) (m/unit (m/cross mid b)) (m/unit (m/cross a b)))
+      (m/close? (m/unit a) (m/unit mid))
+      (m/close? (m/unit b) (m/unit mid))))
+
+(defmethod point-dist :segment [segment pt lookup]
+  (let [p1 (-> segment :from)
+        p2 (-> segment :to)]
+    (assert p1) (assert p2)
+    (if (colinear-points? p1 pt p2)
+      0.0
+      m/half-pi ;; TODO: implement this branch!
+      )))
 
 (defmulti intersection (fn [acc x] [(-> x :a acc :type) (-> x :b acc :type)]))
+
 ;; TODO: handle first, second, nth intersections!
-(defmethod eval-geo :intersection [acc x] (intersection acc x))
+(defmethod eval-geo :intersection [acc x]
+  (cond (-> x :a acc nil?) (assoc x :error (str "Did not find object: " (:a x)))
+        (-> x :b acc nil?) (assoc x :error (str "Did not find object: " (:b x)))
+        :else              (intersection acc x)))
 
 (defmethod eval-geo :midpoint [acc x]
   (let [loc1 (-> x :a acc :loc)
-        loc2 (-> x :b acc :loc)
-        loc  (m/mean loc1 loc2)]
-    (assoc x :type :point :loc loc)))
+        loc2 (-> x :b acc :loc)]
+    (cond
+      (nil? loc1)              (assoc x :error (str "Not a point: " (:a x)))
+      (nil? loc2)              (assoc x :error (str "Not a point: " (:b x)))
+      (m/antipodal? loc1 loc2) (assoc x :error (str "Points are antipodal!"))
+      :else                    (assoc x :type :point :loc (m/mean loc1 loc2)))))
 
 (defmethod eval-geo :great-circle [acc x]
-  (let [o (-> x :origin acc :loc)]
-    (assoc x :origin o)))
+  (if-let [o (-> x :origin acc :loc)]
+    (assoc x :origin o)
+    (assoc x :error "Origin of great circle does not exist!")))
 
 (defmethod eval-geo :polygon [acc x]
-  (let [xs (->> x :pts (map acc) (map :loc))]
-    (assoc x :pts xs)))
+  (assoc x :pts (->> x :pts (map acc) (map :loc) (doall))))
 
 (defmethod intersection [:great-circle :great-circle] [acc x]
   (let [loc1 (-> x :a acc :origin)
         loc2 (-> x :b acc :origin)
         loc  (m/cross loc1 loc2)]
-    (assoc x :type :point :loc  loc)))
 
-#_
+    (if (m/zero-vec? loc)
+      {:error "Could not take intersection of object with itself!"
+       :line (:line x)}
+      (assoc x :type :point :loc loc))))
+
+(defmethod intersection [:segment :segment] [acc x]
+  (let [s1o (m/cross (-> x :a acc :from) (-> x :a acc :to))
+        s2o (m/cross (-> x :b acc :from) (-> x :b acc :to))
+
+        loc   (m/cross s1o s2o)
+        loc-1 (m/antipode loc)]
+    (cond
+      (and (zero? (point-dist (-> x :a acc) loc acc))
+           (zero? (point-dist (-> x :b acc) loc acc)))
+      (assoc x :type :point :loc loc)
+
+      (and (zero? (point-dist (-> x :a acc) loc-1 acc))
+           (zero? (point-dist (-> x :b acc) loc-1 acc)))
+      (assoc x :type :point :loc loc-1)
+
+      :else
+      (assoc x :type :point :exists false :loc nil))))
+
+(defmethod intersection [:great-circle :segment] [acc x]
+  (let [s1o (-> x :a acc :origin)
+        s2o (m/cross (-> x :b acc :from) (-> x :b acc :to))
+
+        loc   (m/cross s1o s2o)
+        loc-1 (m/antipode loc)]
+    (cond
+      (and (m/small? (point-dist (-> x :a acc) loc acc))
+           (m/small? (point-dist (-> x :b acc) loc acc)))
+      (assoc x :type :point :loc loc)
+
+      (and (m/small? (point-dist (-> x :a acc) loc-1 acc))
+           (m/small? (point-dist (-> x :b acc) loc-1 acc)))
+      (assoc x :type :point :loc loc-1)
+
+      :else
+      (assoc x :type :point :exists false :loc nil))))
+
+(defmethod intersection [:segment :great-circle] [acc x]
+  (intersection acc (assoc x :a (:b x) :b (:a x))))
+
 (defmethod intersection :default [acc x]
-  nil ;; ERROR: wrong params. maybe do not exist?X
-  )
+  {:error (str "Can not intersect these objects: " (:a x) " and " (:b x))})

src/erdos/lenart/lang.cljc

@@ -1,5 +1,6 @@
 (ns erdos.lenart.lang
-  (:require [erdos.lenart.geo :as geo])
+  (:require [erdos.lenart.geo :as geo]
+            [clojure.string :refer [join]])
   #?(:cljs (:require-macros [erdos.lenart.macros :refer [match-seq]])
      :clj  (:require [erdos.lenart.macros :refer [match-seq]])))
 
@@ -13,7 +14,7 @@
     (loop [out (vec no-deps)
            others (set others)]
       (if (seq others)
-        (when-let [kk (seq (remove  #(some others (k->deps %)) others))]
+        (when-let [kk (seq (remove #(some others (k->deps %)) others))]
           (recur (into out kk) (reduce disj others kk)))
         out))))
 
@@ -35,15 +36,21 @@
 
     ["stroke" "dotted" & ?xs]
     (-> ?xs parse-style-item (assoc :stroke-style :dotted))
-    ))
+
+    {:error "Unexpected style definition!"}))
 
 (defn- parse-style [s]
   (match-seq s
      [] {}
-     ["with" & ?style] (parse-style-item ?style)))
+     ["with" & ?style] (parse-style-item ?style)
+     (throw (ex-info "Wrong style definitions!"
+                     {:error (str "Unexpected: " (join " " s))}))))
 
 (defn str->num [x]
-  #?(:cljs (.parseFloat js/Number x)
+  #?(:cljs (let [n (.parseFloat js/Number x)]
+             (if (js/isNaN n)
+               (throw (ex-info "Not a number!" {:error "Could not parse number!"}))
+               n))
      :clj  (Double/parseDouble x)))
 
 (defn parse-construction [s]
@@ -72,23 +79,28 @@
 
     ["segment" "between" ?from "and" ?to & rest]
     (-> rest parse-style (assoc :type :segment :from ?from :to ?to))
-    ;;,,{:type :segment :from ?name1 :to ?name2}
-    (assert false (str "Not a construction: " s))))
 
-(defn parse-sentence [s]
-  (let [s (if (vector? s) s (tokenize-sentence s))]
+    (throw (ex-info "Not a construction!" {:error "Not a construction!"}))))
+
+(defn parse-sentence [s-]
+  (let [s (if (vector? s-) s- (tokenize-sentence s-))]
     (match-seq s
                [?id "is" "hidden" & ?xs]
                (-> ?xs (parse-construction) (assoc :id ?id :hidden true))
                [?id "is" & ?xs]
                (-> ?xs (parse-construction) (assoc :id ?id :hidden false))
                ["draw" & ?xs]
-               (-> ?xs (parse-construction) (assoc :id (gensym) :hidden false)))))
+               (-> ?xs (parse-construction) (assoc :id (gensym) :hidden false))
+               (throw (ex-info "Unexpected line!"
+                               {:error "Unexpected line!"})))))
 
 (defn parse-sentence- [x]
-  (try (parse-sentence x)
-       #?(:cljs (catch :default e (.log js/console e))
-          :clj  (catch Exception e (.printStackTrace e))) nil))
+  (-> (try (parse-sentence x)
+           (catch #?(:cljs :default :clj Exception) e
+               (if (:error (ex-data e))
+                 (ex-data e)
+                 {:error (str "Unexpected exception: " e)})))
+      (assoc :line x)))
 
 (defn- deps [m x]
   (let [mx (m x)]
@@ -102,11 +114,18 @@
                    (concat (:pts mx))))))
 
 (defn parse-book [ls]
-  (let [ls  (map #(.trim %) (.split ls "\n"))
-        xs  (keep parse-sentence- ls)
-        m   (zipmap (map :id xs) xs)
-        top (topsort deps m)]
-    (-> (reduce (fn [acc x]
-                  (let [e (geo/eval-geo acc (m x))]
-                    (assoc acc (:id e) e))) {} top)
-        (mapv top))))
+  (let [ls  (filter seq (map #(.trim %) (.split ls "\n")))
+        xs  (keep parse-sentence- ls)]
+    (if-let [err (some #(when (:error %) %) xs)]
+      err
+      (let [m (zipmap (map :id xs) xs)]
+        (if-let [top (topsort deps m)]
+          (let [reduced (reduce (fn [acc x]
+                                  (let [e (geo/eval-geo acc (m x))]
+                                    (if (:error e)
+                                      (reduced e)
+                                      (assoc acc (:id e) e)))) {} top)]
+            (if (:error reduced)
+              reduced
+              (mapv reduced top)))
+          {:error "Error in construction: circular dependency!"})))))

src/erdos/lenart/macros.clj

@@ -86,12 +86,14 @@
              `(~k (nth ~b ~i)))
         ls (if rest? (butlast (butlast ls)) ls)
 
-        cnt (if (not rest?) `(= ~(count case) (count ~b)) true)]
+        cnt (if rest?
+              `(<= ~(dec (dec (count case))) (count ~b))
+              `(= ~(count case) (count ~b)))]
     (assert (or rest? cnt (seq ks)) (str "No literal in pattern: " case))
-    `(if (and ~@ks ~cnt)
+    `(if (and ~cnt ~@ks)
        (let [~@(apply concat ls)
-             ~@(if rest? `(~rest? (nthrest ~b ~(- (count case) 2))))
-             ] ~then)
+             ~@(if rest? `(~rest? (nthrest ~b ~(- (count case) 2))))]
+         ~then)
        ~else)))
 
 (defmacro match-seq [expr & clauses]

src/erdos/lenart/math.cljc

@@ -2,6 +2,7 @@
   #_(:require [cljs.test :as t]))
 
 (def pi 3.14159265359)
+(def half-pi (/ pi 2))
 
 (def up [0.0 0.0 1.0])
 
@@ -16,6 +17,8 @@
 (defn acos [x] (#?(:cljs js/Math.acos :clj Math/acos) x))
 (defn atan2 [dy dx] (#?(:cljs js/Math.atan2 :clj Math/atan2) dy dx))
 
+(defn abs [x] (#?(:cljs js/Math.abs :clj Math/abs) x))
+
 (defn unit [[x y z]]
   (let [d (#?(:cljs js/Math.sqrt :clj Math/sqrt) (+ (* x x) (* y y) (* z z)))]
     [(/ x d) (/ y d) (/ z d)]))
@@ -29,6 +32,13 @@
 
 (def dist (comp sqrt distsq))
 
+(defn small? [x] (<= x 0.00001))
+
+(defn close?
+  ([a] true)
+  ([a b] (small? (distsq a b)))
+  ([a b c] (and (close? a b) (close? b c) (close? a c))))
+
 ;; todo: test for precision
 (defn dist-angle [a b]
   (let [d (dist (unit a) (unit b))]
@@ -44,6 +54,15 @@
 (defn antipode [[x y z]]
   [(- x) (- y) (- z)])
 
+(def point-length (comp sqrt dot))
+
+(defn- point-scale [s [x y z]] [(* s x) (* s y) (* s z)])
+
+(defn antipodal? [a b]
+  (let [|a| (point-length a)
+        |b| (point-length b)]
+    (= a (->> b (point-scale (/ |a| |b| -1.0))))))
+
 (defn mirror [[x y z]]
   [x y (- z)])