Skip to content

Instantly share code, notes, and snippets.

@lynaghk
Created January 6, 2012 15:26
Show Gist options
  • Star 9 You must be signed in to star a gist
  • Fork 5 You must be signed in to fork a gist
  • Save lynaghk/1571047 to your computer and use it in GitHub Desktop.
Save lynaghk/1571047 to your computer and use it in GitHub Desktop.
Cassowary constraint solver in ClojureScript
;;Using the Cassowary constraint solver from ClojureScript
;;This demo shows using multimethods for readable constraint syntax using +, -, and =.
;;Output is a row of circles with random radii spaced so that the space between their boundaries is uniform.
(ns c2.main
;;refer-clojure :exclude is currently broken in ClojureScript master
;;Ticket open: http://dev.clojure.org/jira/browse/CLJS-114
;;Fix applied here: https://github.com/lynaghk/clojurescript/tree/114-refer-clojure-exclude
(:refer-clojure :exclude [+ - =])
(:require [pinot.html :as html]
[pinot.dom :as dom]))
(defn p [x] (.log js/console x))
(defn contains-cassowary? [& args]
(if (some #(or (instance? js/Cl.Variable %)
(instance? js/Cl.LinearExpression %)) args)
:cassowary-var
:number))
(defmulti + contains-cassowary?)
(defmulti - contains-cassowary?)
(defmulti = contains-cassowary?)
(defmethod + :number [& args] (apply clojure.core/+ args))
(defmethod = :number [& args] (apply clojure.core/= args))
(defmethod - :number [& args] (apply clojure.core/- args))
(defmethod + :cassowary-var [& args] (apply js/Cl.CL.Plus args))
(defmethod = :cassowary-var [a b] (js/Cl.LinearEquation. a b))
(defmethod - :cassowary-var [& args] (apply js/Cl.CL.Minus args))
(.listen goog.events js/window goog.events.EventType.LOAD
(fn []
(let [height 200, width 800, max-radius 40
solver (new js/Cl.SimplexSolver)
spacing (new js/Cl.Variable) ;;The spacing between circles (to be solved for)
circles (repeatedly 10 #(hash-map :r (js/Cl.Variable. (* max-radius (rand)))
:cx (js/Cl.Variable. 0)
:cy (js/Cl.Variable. (/ height 2))))]
;;The circle radii and vertical positions are constants
(doseq [c circles]
(doto solver
(.addStay (:r c))
(.addStay (:cy c))))
;;Spacing between first circle and the wall
(.addConstraint solver (= 0 (- (:cx (first circles))
(:r (first circles))
spacing)))
;;Spacing between each pair of neighboring circles
(doseq [[left right] (partition 2 1 circles)]
(.addConstraint solver (= spacing (- (:cx right)
(:r right)
(+ (:cx left) (:r left))))))
;;Spacing between last circle and the wall
(.addConstraint solver (= spacing (- width
(:cx (last circles))
(:r (last circles)))))
;;Draw the circles as SVG
(dom/append (dom/query "body")
(html/html [:svg:svg {:width width :height height
:style "border: 1px solid black"}]))
(doseq [c circles]
(dom/append (dom/query "body svg")
(html/html [:svg:circle {:cx (. (:cx c) (value))
:cy (. (:cy c) (value))
:r (. (:r c) (value))}]))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment