Permalink
Browse files

Initial algorithm.

  • Loading branch information...
0 parents commit 47df37844c3a3202a0f23b68dbdf18e5398e1fb3 @exupero committed Aug 24, 2016
Showing with 211 additions and 0 deletions.
  1. +14 −0 .gitignore
  2. +10 −0 index.html
  3. +12 −0 project.clj
  4. 0 resources/public/css/isle.css
  5. +10 −0 resources/public/index.html
  6. +9 −0 scripts/build.clj
  7. +22 −0 scripts/figwheel.clj
  8. +128 −0 src/isle/core.cljs
  9. +6 −0 src/isle/macros.clj
@@ -0,0 +1,14 @@
+/target
+/lib
+/classes
+/checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins
+.lein-repl-history
+
+js-dev
@@ -0,0 +1,10 @@
+<!DOCTYPE html>
+<title>isle</title>
+<meta http-equiv="content-type" content="text/html; charset=UTF8">
+
+<link rel=stylesheet href=resources/public/css/isle.css />
+
+<body>
+ <div id="app"></div>
+ <script src=resources/public/js/main.js></script>
+</body>
@@ -0,0 +1,12 @@
+(defproject isle "0.1.0-SNAPSHOT"
+ :description "FIXME: write description"
+ :url "http://example.com/FIXME"
+ :license {:name "Eclipse Public License"
+ :url "http://www.eclipse.org/legal/epl-v10.html"}
+ :source-paths ["src"]
+ :dependencies [[org.clojure/clojure "1.7.0"]
+ [org.clojure/clojurescript "1.7.122" :exclusions [org.apache.ant/ant]]
+ [org.clojure/core.match "0.3.0-alpha4"]
+ [org.clojure/core.async "0.2.374"]
+ [vdom "0.1.1-SNAPSHOT"]]
+ :profiles {:dev {:dependencies [[figwheel-sidecar "0.5.0-2" :scope "provided"]]}})
No changes.
@@ -0,0 +1,10 @@
+<!DOCTYPE html>
+<title>isle</title>
+<meta http-equiv="content-type" content="text/html; charset=UTF8">
+
+<link rel=stylesheet href=css/isle.css />
+
+<body>
+ <div id=app></div>
+ <script src=js-dev/main.js></script>
+</body>
@@ -0,0 +1,9 @@
+(require 'cljs.build.api)
+
+(cljs.build.api/build "src"
+ {:main 'isle.core
+ :source-paths ["src"]
+ :asset-path "js"
+ :optimizations :advanced
+ :output-to "resources/public/js/main.js"
+ :output-dir "resources/public/js"})
@@ -0,0 +1,22 @@
+(require '[figwheel-sidecar.repl :as r]
+ '[figwheel-sidecar.repl-api :as ra])
+
+(ra/start-figwheel!
+ {:figwheel-options {:css-dirs ["resources/public/css"]
+ :server-port 3454
+ :nrepl-port 7893
+ :nrepl-middleware ["cider.nrepl/cider-middleware"
+ "cemerick.piggieback/wrap-cljs-repl"]}
+ :build-ids ["dev"]
+ :all-builds
+ [{:id "dev"
+ :figwheel {:on-jsload "isle.core/figwheel-reload"}
+ :source-paths ["src"]
+ :compiler {:main 'isle.core
+ :optimizations :none
+ :asset-path "js-dev"
+ :output-to "resources/public/js-dev/main.js"
+ :output-dir "resources/public/js-dev"
+ :verbose true}}]})
+
+(ra/cljs-repl)
@@ -0,0 +1,128 @@
+(ns isle.core
+ (:require-macros [isle.macros :refer [spy]])
+ (:require [clojure.string :as string]
+ [vdom.core :refer [renderer]]))
+
+(enable-console-print!)
+
+(defn translate [x y]
+ (str "translate(" x "," y ")"))
+
+(defn rotate [d]
+ (str "rotate(" d ")"))
+
+(defn pair [[x y]]
+ (str x "," y))
+
+(defn path [pts]
+ (->> pts
+ (map pair)
+ (interpose "L")
+ (string/join "")
+ (str "M")))
+
+(defn closed-path [pts]
+ (if (seq pts)
+ (str (path pts) "Z")
+ ""))
+
+(def sin js/Math.sin)
+(def cos js/Math.cos)
+(def pi js/Math.PI)
+(def tau (* 2 pi))
+(def sqrt js/Math.sqrt)
+(def sqr #(js/Math.pow % 2))
+
+(defn dist [[x y] [x' y']]
+ (sqrt (+ (sqr (- x x')) (sqr (- y y')))))
+
+(defn avg [xs]
+ (/ (reduce + xs) (count xs)))
+
+(defn circle [n r]
+ (for [theta (range 0 tau (/ tau n))]
+ [(* r (cos theta))
+ (* r (sin theta))]))
+
+(defn ui [emit model]
+ (let [size 500]
+ [:div {}
+ [:button {:onclick #(emit :reset)} "Reset"]
+ [:button {:onclick #(emit :step)} "Step"]
+ [:div {}
+ [:svg {:width size :height size}
+ [:rect {:width size :height size :fill :dodgerblue}]
+ [:g {:transform (translate (/ size 2) (/ size 2))}
+ [:path {:d (closed-path (model :points))
+ :stroke :black
+ :fill :lime
+ :fill-rule :evenodd}]]]]]))
+
+(defn insert [f]
+ (fn [rf]
+ (let [prev (volatile! nil)]
+ (fn
+ ([] (rf))
+ ([result] (rf result))
+ ([result input]
+ (let [p @prev]
+ (vreset! prev input)
+ (if p
+ (if-let [m (f p input)]
+ (rf (rf result m) input)
+ (rf result input))
+ (rf result input))))))))
+
+(defn unit-vector [[x y]]
+ (let [len (dist [0 0] [x y])]
+ [(/ x len) (/ y len)]))
+
+(defn perturb-point [[x y :as p] v max-dist]
+ (let [d (* 2 max-dist (- (rand) 0.5))
+ [dx dy] (unit-vector v)]
+ [(+ x (* d dx))
+ (+ y (* d dy))]))
+
+(defn perturbed-midpoint [[x y :as a] [x' y' :as b]]
+ (when (not= a b)
+ (let [len (dist a b)]
+ (perturb-point
+ [(/ (+ x x') 2) (/ (+ y y') 2)]
+ [(- (- y y')) (- x x')]
+ (/ len 2)))))
+
+(defn perturb-points [pts]
+ (let [[cx cy :as c] [(avg (map first pts)) (avg (map second pts))]]
+ (map
+ (fn [[x y :as p]]
+ (perturb-point
+ p
+ [(- x cx) (- y cy)]
+ (/ (dist p c) 2)))
+ pts)))
+
+(defonce model (atom {:points (perturb-points (circle 3 150))}))
+
+(defmulti emit (fn [t & _] t))
+
+(defmethod emit :reset [_]
+ (swap! model assoc :points (perturb-points (circle 3 150))))
+
+(defmethod emit :step [_]
+ (swap! model update :points #(sequence (insert perturbed-midpoint) (concat % [(first %)]))))
+
+(comment
+ (emit :step)
+ (sequence (insert midpoint) (@model :points))
+ )
+
+(defonce render!
+ (let [r (renderer (.getElementById js/document "app"))]
+ #(r (ui emit @model))))
+
+(defonce on-update
+ (add-watch model :rerender
+ (fn [_ _ _ model]
+ (render! model))))
+
+(render! @model)
@@ -0,0 +1,6 @@
+(ns isle.macros)
+
+(defmacro spy [x]
+ `(let [x# ~x]
+ (println '~x " => " x#)
+ x#))

0 comments on commit 47df378

Please sign in to comment.