├── .gitignore ├── LICENSE ├── README.md ├── build.boot ├── examples └── ion │ └── ergo │ ├── life_like_cellular_automata.cljc │ └── lindenmayer_systems.cljc ├── project.clj ├── src └── ion │ ├── cuss │ ├── core.clj │ └── core.cljs │ ├── ergo │ └── core.cljc │ ├── omni │ └── core.cljs │ └── poly │ └── core.cljs └── test └── ion └── ergo └── core_test.cljc /.gitignore: -------------------------------------------------------------------------------- 1 | *.iml 2 | out/ 3 | target/ 4 | .idea/ 5 | .nrepl* 6 | .repl* 7 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Eclipse Public License - v 1.0 2 | 3 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 4 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 5 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 6 | 7 | 1. DEFINITIONS 8 | 9 | "Contribution" means: 10 | 11 | a) in the case of the initial Contributor, the initial code and documentation 12 | distributed under this Agreement, and 13 | b) in the case of each subsequent Contributor: 14 | i) changes to the Program, and 15 | ii) additions to the Program; 16 | 17 | where such changes and/or additions to the Program originate from and are 18 | distributed by that particular Contributor. A Contribution 'originates' 19 | from a Contributor if it was added to the Program by such Contributor 20 | itself or anyone acting on such Contributor's behalf. Contributions do not 21 | include additions to the Program which: (i) are separate modules of 22 | software distributed in conjunction with the Program under their own 23 | license agreement, and (ii) are not derivative works of the Program. 24 | 25 | "Contributor" means any person or entity that distributes the Program. 26 | 27 | "Licensed Patents" mean patent claims licensable by a Contributor which are 28 | necessarily infringed by the use or sale of its Contribution alone or when 29 | combined with the Program. 30 | 31 | "Program" means the Contributions distributed in accordance with this 32 | Agreement. 33 | 34 | "Recipient" means anyone who receives the Program under this Agreement, 35 | including all Contributors. 36 | 37 | 2. GRANT OF RIGHTS 38 | a) Subject to the terms of this Agreement, each Contributor hereby grants 39 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 40 | reproduce, prepare derivative works of, publicly display, publicly 41 | perform, distribute and sublicense the Contribution of such Contributor, 42 | if any, and such derivative works, in source code and object code form. 43 | b) Subject to the terms of this Agreement, each Contributor hereby grants 44 | Recipient a non-exclusive, worldwide, royalty-free patent license under 45 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 46 | transfer the Contribution of such Contributor, if any, in source code and 47 | object code form. This patent license shall apply to the combination of 48 | the Contribution and the Program if, at the time the Contribution is 49 | added by the Contributor, such addition of the Contribution causes such 50 | combination to be covered by the Licensed Patents. The patent license 51 | shall not apply to any other combinations which include the Contribution. 52 | No hardware per se is licensed hereunder. 53 | c) Recipient understands that although each Contributor grants the licenses 54 | to its Contributions set forth herein, no assurances are provided by any 55 | Contributor that the Program does not infringe the patent or other 56 | intellectual property rights of any other entity. Each Contributor 57 | disclaims any liability to Recipient for claims brought by any other 58 | entity based on infringement of intellectual property rights or 59 | otherwise. As a condition to exercising the rights and licenses granted 60 | hereunder, each Recipient hereby assumes sole responsibility to secure 61 | any other intellectual property rights needed, if any. For example, if a 62 | third party patent license is required to allow Recipient to distribute 63 | the Program, it is Recipient's responsibility to acquire that license 64 | before distributing the Program. 65 | d) Each Contributor represents that to its knowledge it has sufficient 66 | copyright rights in its Contribution, if any, to grant the copyright 67 | license set forth in this Agreement. 68 | 69 | 3. REQUIREMENTS 70 | 71 | A Contributor may choose to distribute the Program in object code form under 72 | its own license agreement, provided that: 73 | 74 | a) it complies with the terms and conditions of this Agreement; and 75 | b) its license agreement: 76 | i) effectively disclaims on behalf of all Contributors all warranties 77 | and conditions, express and implied, including warranties or 78 | conditions of title and non-infringement, and implied warranties or 79 | conditions of merchantability and fitness for a particular purpose; 80 | ii) effectively excludes on behalf of all Contributors all liability for 81 | damages, including direct, indirect, special, incidental and 82 | consequential damages, such as lost profits; 83 | iii) states that any provisions which differ from this Agreement are 84 | offered by that Contributor alone and not by any other party; and 85 | iv) states that source code for the Program is available from such 86 | Contributor, and informs licensees how to obtain it in a reasonable 87 | manner on or through a medium customarily used for software exchange. 88 | 89 | When the Program is made available in source code form: 90 | 91 | a) it must be made available under this Agreement; and 92 | b) a copy of this Agreement must be included with each copy of the Program. 93 | Contributors may not remove or alter any copyright notices contained 94 | within the Program. 95 | 96 | Each Contributor must identify itself as the originator of its Contribution, 97 | if 98 | any, in a manner that reasonably allows subsequent Recipients to identify the 99 | originator of the Contribution. 100 | 101 | 4. COMMERCIAL DISTRIBUTION 102 | 103 | Commercial distributors of software may accept certain responsibilities with 104 | respect to end users, business partners and the like. While this license is 105 | intended to facilitate the commercial use of the Program, the Contributor who 106 | includes the Program in a commercial product offering should do so in a manner 107 | which does not create potential liability for other Contributors. Therefore, 108 | if a Contributor includes the Program in a commercial product offering, such 109 | Contributor ("Commercial Contributor") hereby agrees to defend and indemnify 110 | every other Contributor ("Indemnified Contributor") against any losses, 111 | damages and costs (collectively "Losses") arising from claims, lawsuits and 112 | other legal actions brought by a third party against the Indemnified 113 | Contributor to the extent caused by the acts or omissions of such Commercial 114 | Contributor in connection with its distribution of the Program in a commercial 115 | product offering. The obligations in this section do not apply to any claims 116 | or Losses relating to any actual or alleged intellectual property 117 | infringement. In order to qualify, an Indemnified Contributor must: 118 | a) promptly notify the Commercial Contributor in writing of such claim, and 119 | b) allow the Commercial Contributor to control, and cooperate with the 120 | Commercial Contributor in, the defense and any related settlement 121 | negotiations. The Indemnified Contributor may participate in any such claim at 122 | its own expense. 123 | 124 | For example, a Contributor might include the Program in a commercial product 125 | offering, Product X. That Contributor is then a Commercial Contributor. If 126 | that Commercial Contributor then makes performance claims, or offers 127 | warranties related to Product X, those performance claims and warranties are 128 | such Commercial Contributor's responsibility alone. Under this section, the 129 | Commercial Contributor would have to defend claims against the other 130 | Contributors related to those performance claims and warranties, and if a 131 | court requires any other Contributor to pay any damages as a result, the 132 | Commercial Contributor must pay those damages. 133 | 134 | 5. NO WARRANTY 135 | 136 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN 137 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR 138 | IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, 139 | NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each 140 | Recipient is solely responsible for determining the appropriateness of using 141 | and distributing the Program and assumes all risks associated with its 142 | exercise of rights under this Agreement , including but not limited to the 143 | risks and costs of program errors, compliance with applicable laws, damage to 144 | or loss of data, programs or equipment, and unavailability or interruption of 145 | operations. 146 | 147 | 6. DISCLAIMER OF LIABILITY 148 | 149 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 150 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 151 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 152 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 153 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 154 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 155 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 156 | OF SUCH DAMAGES. 157 | 158 | 7. GENERAL 159 | 160 | If any provision of this Agreement is invalid or unenforceable under 161 | applicable law, it shall not affect the validity or enforceability of the 162 | remainder of the terms of this Agreement, and without further action by the 163 | parties hereto, such provision shall be reformed to the minimum extent 164 | necessary to make such provision valid and enforceable. 165 | 166 | If Recipient institutes patent litigation against any entity (including a 167 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 168 | (excluding combinations of the Program with other software or hardware) 169 | infringes such Recipient's patent(s), then such Recipient's rights granted 170 | under Section 2(b) shall terminate as of the date such litigation is filed. 171 | 172 | All Recipient's rights under this Agreement shall terminate if it fails to 173 | comply with any of the material terms or conditions of this Agreement and does 174 | not cure such failure in a reasonable period of time after becoming aware of 175 | such noncompliance. If all Recipient's rights under this Agreement terminate, 176 | Recipient agrees to cease use and distribution of the Program as soon as 177 | reasonably practicable. However, Recipient's obligations under this Agreement 178 | and any licenses granted by Recipient relating to the Program shall continue 179 | and survive. 180 | 181 | Everyone is permitted to copy and distribute copies of this Agreement, but in 182 | order to avoid inconsistency the Agreement is copyrighted and may only be 183 | modified in the following manner. The Agreement Steward reserves the right to 184 | publish new versions (including revisions) of this Agreement from time to 185 | time. No one other than the Agreement Steward has the right to modify this 186 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 187 | Eclipse Foundation may assign the responsibility to serve as the Agreement 188 | Steward to a suitable separate entity. Each new version of the Agreement will 189 | be given a distinguishing version number. The Program (including 190 | Contributions) may always be distributed subject to the version of the 191 | Agreement under which it was received. In addition, after a new version of the 192 | Agreement is published, Contributor may elect to distribute the Program 193 | (including its Contributions) under the new version. Except as expressly 194 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 195 | licenses to the intellectual property of any Contributor under this Agreement, 196 | whether expressly, by implication, estoppel or otherwise. All rights in the 197 | Program not expressly granted under this Agreement are reserved. 198 | 199 | This Agreement is governed by the laws of the State of New York and the 200 | intellectual property laws of the United States of America. No party to this 201 | Agreement will bring a legal action under this Agreement more than one year 202 | after the cause of action arose. Each party waives its rights to a jury trial in 203 | any resulting litigation. 204 | 205 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ion 2 | 3 | [![Join the chat at https://gitter.im/decomplect/ion](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/decomplect/ion?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) 4 | The resulting state or product of decomplecting 5 | 6 | ## cuss 7 | 8 | The cuss library provides CSS utilities that extend Garden. 9 | 10 | ## poly 11 | 12 | The poly library provides ClosureScript utilities that leverage the Google 13 | Closure library and wrap event-handling in a blanket of core.async goodness. 14 | -------------------------------------------------------------------------------- /build.boot: -------------------------------------------------------------------------------- 1 | (set-env! :dependencies '[[adzerk/bootlaces "0.1.11" :scope "test"]]) 2 | 3 | (require '[adzerk.bootlaces :refer :all]) 4 | 5 | (def +re-source-files+ #"(^.*\.clj[cs]?)$") 6 | 7 | (deftask cuss 8 | "Set env and task options for ion.cuss tasks." 9 | [] 10 | (let [version "0.1.0-SNAPSHOT"] 11 | (bootlaces! version) 12 | (set-env! 13 | :dependencies '[[garden "1.2.5"]] 14 | :resource-paths #{"src/ion/cuss"}) 15 | (task-options! 16 | pom {:project 'ion/cuss 17 | :version version 18 | :description "ClojureScript CSS Utilities" 19 | :license {"EPL" "http://www.eclipse.org/legal/epl-v10.html"} 20 | :scm {:url "https://github.com/decomplect/ion/src/ion/cuss"} 21 | :url "https://github.com/decomplect/ion#cuss"} 22 | sift {:move {+re-source-files+ "ion/cuss/$1"}}) 23 | identity)) 24 | 25 | (deftask ergo 26 | "Set env and task options for ion.ergo tasks." 27 | [] 28 | (let [version "0.1.0-SNAPSHOT"] 29 | (bootlaces! version) 30 | (set-env! 31 | :dependencies '[[criterium "0.4.3"]] 32 | :resource-paths #{"src/ion/ergo"}) 33 | (task-options! 34 | pom {:project 'ion/logo 35 | :version version 36 | :description "Clojure(Script) Ergo DSL" 37 | :license {"EPL" "http://www.eclipse.org/legal/epl-v10.html"} 38 | :scm {:url "https://github.com/decomplect/ion/src/ion/ergo"} 39 | :url "https://github.com/decomplect/ion#ergo"} 40 | sift {:move {+re-source-files+ "ion/ergo/$1"}}) 41 | identity)) 42 | 43 | (deftask omni 44 | "Set env and task options for ion.omni tasks." 45 | [] 46 | (let [version "0.1.0-SNAPSHOT"] 47 | (bootlaces! version) 48 | (set-env! 49 | :dependencies '[[org.clojure/core.async "0.1.346.0-17112a-alpha"]] 50 | :resource-paths #{"src/ion/omni"}) 51 | (task-options! 52 | pom {:project 'ion/omni 53 | :version version 54 | :description "ClojureScript Event Loop" 55 | :license {"EPL" "http://www.eclipse.org/legal/epl-v10.html"} 56 | :scm {:url "https://github.com/decomplect/ion/src/ion/omni"} 57 | :url "https://github.com/decomplect/ion#omni"} 58 | sift {:move {+re-source-files+ "ion/omni/$1"}}) 59 | identity)) 60 | 61 | (deftask poly 62 | "Set env and task options for ion.poly tasks." 63 | [] 64 | (let [version "0.1.0-SNAPSHOT"] 65 | (bootlaces! version) 66 | (set-env! 67 | :dependencies '[[org.clojure/core.async "0.1.346.0-17112a-alpha"] 68 | [spellhouse/phalanges "0.1.6" 69 | :exclusions [com.cemerick/austin 70 | org.clojure/clojure]]] 71 | :resource-paths #{"src/ion/poly"}) 72 | (task-options! 73 | pom {:project 'ion/poly 74 | :version version 75 | :description "ClojureScript Application Utilities" 76 | :license {"EPL" "http://www.eclipse.org/legal/epl-v10.html"} 77 | :scm {:url "https://github.com/decomplect/ion/src/ion/poly"} 78 | :url "https://github.com/decomplect/ion#poly"} 79 | sift {:move {+re-source-files+ "ion/poly/$1"}}) 80 | identity)) 81 | 82 | (deftask build 83 | "The pom/sift/jar/install of a library." 84 | [] 85 | (comp (pom) (sift) (jar) (install))) 86 | -------------------------------------------------------------------------------- /examples/ion/ergo/life_like_cellular_automata.cljc: -------------------------------------------------------------------------------- 1 | (ns ion.ergo.life-like-cellular-automata 2 | (:require #?(:clj [clojure.test :refer :all] 3 | :cljs [cljs.test :refer-macros [deftest is testing]]) 4 | [criterium.core :as cr] 5 | [ion.ergo.core :as ergo])) 6 | 7 | 8 | ; ------------------------------------------------------------------------------ 9 | ; Research & Development 10 | 11 | 12 | ; ------------------------------------------------------------------------------ 13 | ; Benchmarking 14 | 15 | (defn bench [f] 16 | (cr/with-progress-reporting (cr/quick-bench (f) :verbose))) 17 | 18 | (comment 19 | 20 | (bench ; GOL acorn 100 gens using sparse set of vector cells: 155 ms 21 | #(-> (ergo/sparse-life-rule-system 22 | :conway-game-of-life 23 | ergo/vector-cell 24 | (ergo/pattern :acorn)) 25 | (nth 99) count)) 26 | 27 | (bench ; GOL acorn 100 gens using sparse set of basic cells: 170 ms 28 | #(-> (ergo/sparse-life-rule-system 29 | :conway-game-of-life 30 | ergo/basic-cell 31 | (ergo/pattern :acorn)) 32 | (nth 99) count)) 33 | 34 | ) 35 | -------------------------------------------------------------------------------- /examples/ion/ergo/lindenmayer_systems.cljc: -------------------------------------------------------------------------------- 1 | (ns ion.ergo.lindenmayer-systems 2 | "Support for Lindenmayer systems: deterministic, stochastic, context-free, 3 | context-sensitive, or parametric. Or combinations thereof. 4 | 5 | TL;DR: How to produce recursive axiomatic transducible sequences (RATS) 6 | 7 | A somewhat confusing variety of terms are used to describe L-systems and 8 | their component parts, and this source code file is likely no exception. In 9 | order to be understood in the context of existing semiotics we have adhered 10 | as closely as possible to the most commonly used domain terminology in favor 11 | of Clojure terminology. In particular, however, we avoid using the term 12 | \"String\" so as to avoid confusion with the datatype of the same name. 13 | Instead we refer to that part of the system as a \"Word\", although it 14 | should not be confused with the everyday notion of a word in a spoken 15 | language. And while we avoid calling a Word a String, a Word is often 16 | represented in an L-system by a `string`, although it doesn't need to be 17 | (and isn't here). And a Word is a sequence of somethings. For similar 18 | reasons we prefer to call those \"somethings\" Modules instead of the other 19 | commonly used term \"Letters\". (And so begins the inevitable confusion...) 20 | 21 | With that in mind, we describe an L-system as a parallel rewriting system. 22 | A rewriting system takes an intial input value made up of a sequence of one 23 | or more symbols (we call that sequence of symbols a \"Word\"), and 24 | recursively produces new \"Words\" by replacing each input symbol (called a 25 | Module) with itself or a successor symbol/module (or sequence of modules) 26 | determined according to a set of production rules. The rewriting is treated 27 | as if the replacements all took place in parallel for each generation. 28 | 29 | L-systems operate on words, which are sequences of modules. When 30 | represented programatically, modules are typically simple integers, 31 | character literals, strings or keywords. This implementation allows a module 32 | to be any value that is a valid key in a map. So a module can also be a 33 | compound structure, such as a vector containing a pair of integers. 34 | 35 | Beginning with an initial word, called an axiom, an L-system generates a 36 | developmental sequence of words by recusively applying a set of productions, 37 | or replacement rules. The resulting seqence of words can then be used as 38 | data for futher processing, such as to be rendered as a graphic or 39 | animation, or played as music. 40 | 41 | Because productions typically replace each module with more than one 42 | module, words tend to grow in size with each successive generation. And 43 | because this growth is recursive, L-systems are useful for modeling a 44 | variety of mathematical and natural processes such as: fractal geometry, the 45 | growth and branching of cells and plants, morphogenesis, crystallography, 46 | architecture, caves, generated game content, and more. 47 | 48 | To fully support more advanced processing, this implementation allows 49 | optional parameters to be associated with a module. It also allows rules to 50 | be expressed using functions. If a rule's replacement value is a function it 51 | will be called and can also be passed arguments for use in the 52 | context-sensitive calculation of successor modules. To associate parameter 53 | data with a module, a successor module must be defined as a deftype or 54 | defrecord that satifsfies the Module protocol." 55 | 56 | (:require #?(:clj [clojure.test :refer :all] 57 | :cljs [cljs.test :refer-macros [deftest is testing]]) 58 | [criterium.core :as cr] 59 | [ion.ergo.core :as ergo])) 60 | 61 | 62 | ; ----------------------------------------------------------------------------- 63 | ; Minimal Working System Examples 64 | 65 | (comment 66 | "Minimal working examples of deterministic, context-free rewriting systems 67 | are illustrated here. The remainder of the code in this file is a result of 68 | the requirements for context-sensitive, parametric and stochastic systems. 69 | 70 | The breakthrough insight is to view L-systems as specialized types of 71 | recursive axiomatic transducible sequences (RATS)." 72 | 73 | (def axiom [0]) 74 | 75 | (def rules {0 [0 1] 76 | 1 [0]}) 77 | 78 | (defn minimal-working-system-a 79 | [rules axiom] 80 | (iterate #(apply concat (replace rules %)) (seq axiom))) 81 | 82 | (take 20 (minimal-working-system-a rules axiom)) 83 | 84 | (count (nth (minimal-working-system-a rules axiom) 35)) ; 24157817 85 | 86 | (defn minimal-working-system-b 87 | [rules axiom] 88 | (iterate (fn [word] (mapcat #(or (rules %) [%]) word)) (seq axiom))) 89 | 90 | ) 91 | 92 | 93 | ; ----------------------------------------------------------------------------- 94 | ; Helper Functions 95 | 96 | (defn neighbors 97 | "Returns a vector of left / right neighbor values." 98 | [word index] 99 | [(get word (dec index)) (get word (inc index))]) 100 | 101 | 102 | ; ----------------------------------------------------------------------------- 103 | ; Example Systems 104 | 105 | (defn basic-fibonacci-sequence 106 | "Returns a lazy sequence of vectors of Fibonacci integers - OEIS A003849." 107 | [] 108 | (apply ergo/basic-rewriting-system (ergo/grammar :A003849))) 109 | 110 | (deftest fibonacci-sequence-basic-test 111 | (is (= 144 (-> (basic-fibonacci-sequence) (nth 10) count)))) 112 | 113 | 114 | (defn stochastic-fibonacci-sequence 115 | "Returns a lazy sequence of vectors of Fibonacci integers starting randomly 116 | with 0 or 1." 117 | [] 118 | (let [axiom #(vec [(rand-int 2)]) 119 | rules {0 [0 1] 120 | 1 [0]}] 121 | (ergo/functional-rewriting-system axiom rules))) 122 | 123 | 124 | (defn generational-sequence 125 | "Returns a lazy sequence of integers." 126 | [] 127 | (let [axiom [0] 128 | rules (fn [g] 129 | {0 [0 g 1] 130 | 1 [] 131 | 2 [0] 132 | 3 [1 2 3 4] 133 | 4 []})] 134 | (ergo/basic-rewriting-system axiom rules))) 135 | 136 | 137 | (defn stochastic-generational-sequence 138 | "Returns a lazy sequence of semi-random integers." 139 | [] 140 | (let [axiom [0] 141 | rules (fn [g] 142 | {0 [0 (rand-int (+ g 5)) 1] 143 | 1 [0]})] 144 | (ergo/basic-rewriting-system axiom rules))) 145 | 146 | 147 | (defn changing-rules-sequence 148 | "Returns a lazy sequence of integers." 149 | [] 150 | (let [axiom [0] 151 | rules (fn [g] 152 | (merge 153 | {(- g 3) [] 154 | (- g 2) [99]} 155 | {0 [0 1 2 3] 156 | 1 [] 157 | 2 [0] 158 | 3 [1 2 3 4] 159 | 4 [g]}))] 160 | (ergo/basic-rewriting-system axiom rules))) 161 | 162 | 163 | (defn dragon-sequence 164 | "Returns a lazy sequence of vectors." 165 | [] 166 | (let [axiom [:F :x] 167 | rules {:x [:x :+ :y :F :+] 168 | :y [:- :F :x :- :y]}] 169 | (ergo/basic-rewriting-system axiom rules))) 170 | 171 | 172 | (comment 173 | (take 5 (basic-fibonacci-sequence)) 174 | (take 5 (stochastic-fibonacci-sequence)) 175 | (take 5 (changing-rules-sequence)) 176 | (take 5 (generational-sequence)) 177 | (take 5 (stochastic-generational-sequence)) 178 | (take 5 (dragon-sequence)) 179 | ) 180 | 181 | 182 | (defrecord M1 [key color] 183 | ergo/IRewritable 184 | (module [_] key)) 185 | 186 | (defmethod clojure.core/print-method M1 [m writer] 187 | (.write writer (str "<" (ergo/module m) " " (:color m) ">"))) 188 | 189 | (defn parametric-system-example 190 | [] 191 | (let [axiom [(->M1 :A :Red)] 192 | rules {:A [(->M1 :B :Light-Blue) 193 | :- 194 | (->M1 :A :Red) 195 | :- 196 | (->M1 :B :Dark-Blue)] 197 | :B [(->M1 :A :Dark-Red) 198 | :+ 199 | (->M1 :B :Blue) 200 | :+ 201 | (->M1 :A :Light-Red)]}] 202 | (ergo/parametric-rewriting-system axiom rules))) 203 | 204 | (comment (take 5 (parametric-system-example))) 205 | 206 | 207 | (defrecord M2 [key age] 208 | ergo/IRewritable (module [_] key)) 209 | 210 | (defn record-module-example 211 | [] 212 | (let [axiom [(->M2 :A 0)] 213 | rules {:A (fn [g w i m] 214 | [(->M2 :B 0) 215 | :- 216 | (->M2 (:key m) (inc (:age m))) 217 | :- 218 | (->M2 :B 0)]) 219 | :B (fn [g w i m] 220 | [(->M2 :A 0) 221 | :+ 222 | (->M2 (:key m) (inc (:age m))) 223 | :+ 224 | (->M2 :A 0)])}] 225 | (ergo/parametric-context-sensitive-rewriting-system axiom rules))) 226 | 227 | (comment (take 5 (record-module-example))) 228 | 229 | 230 | (deftype TM [key age] 231 | ergo/IRewritable 232 | (module [_] key) 233 | Object 234 | (toString [_] (str "<" key " " age ">"))) 235 | 236 | (defmethod clojure.core/print-method TM [x writer] 237 | (.write writer (str x))) 238 | 239 | (defn type-module-example 240 | [] 241 | (let [axiom [(->TM :A 0)] 242 | rules {:A (fn [g w i m] 243 | [(->TM :B 0) 244 | :- 245 | (->TM (.key m) (inc (.-age m))) 246 | :- 247 | (->TM :B 0)]) 248 | :B (fn [g w i m] 249 | [(->TM :A 0) 250 | :+ 251 | (->TM (.key m) (inc (.-age m))) 252 | :+ 253 | (->TM :A 0)])}] 254 | (ergo/parametric-context-sensitive-rewriting-system axiom rules))) 255 | 256 | (comment (take 5 (type-module-example))) 257 | 258 | 259 | ; ----------------------------------------------------------------------------- 260 | ; Performance Benchmarking 261 | 262 | (comment 263 | (cr/with-progress-reporting ;; 1.066 ms 264 | (cr/quick-bench (nth (dragon-sequence) 10) :verbose)) 265 | 266 | (cr/with-progress-reporting ;; 910 ms 267 | (cr/quick-bench (nth (parametric-system-example) 10) :verbose)) 268 | 269 | (cr/with-progress-reporting ;; 110 ms 270 | (cr/quick-bench (nth (record-module-example) 8) :verbose)) 271 | 272 | (cr/with-progress-reporting ;; 123 ms 273 | (cr/quick-bench (nth (type-module-example) 8) :verbose)) 274 | 275 | (cr/with-progress-reporting ;; 8.856 ms 276 | (cr/quick-bench (nth (basic-fibonacci-sequence) 20) :verbose)) 277 | 278 | (cr/with-progress-reporting ;; 9.327 ms 279 | (cr/quick-bench (nth (stochastic-fibonacci-sequence) 20) :verbose)) 280 | ) 281 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject 2 | ion 3 | "0.1.0-SNAPSHOT" 4 | :dependencies 5 | [[org.clojure/clojure "1.7.0"] 6 | [org.clojure/clojurescript "1.7.107"] 7 | [org.clojure/core.async "0.1.346.0-17112a-alpha"] 8 | [org.clojure/test.check "0.8.1"] 9 | [criterium "0.4.3"] 10 | [spellhouse/phalanges "0.1.6"]] 11 | :source-paths 12 | ["src" "examples"]) 13 | -------------------------------------------------------------------------------- /src/ion/cuss/core.clj: -------------------------------------------------------------------------------- 1 | (ns ion.cuss.core 2 | (:require 3 | [garden.stylesheet :refer [at-media]])) 4 | 5 | (defmacro defbreakpoint [name media-params] 6 | `(defn ~name [& rules#] 7 | (at-media ~media-params 8 | [:& rules#]))) 9 | -------------------------------------------------------------------------------- /src/ion/cuss/core.cljs: -------------------------------------------------------------------------------- 1 | (ns ion.cuss.core 2 | (:refer-clojure :exclude [+ - * /]) 3 | (:require-macros 4 | [ion.cuss.core :refer [defbreakpoint]] 5 | [garden.def :refer [defcssfn defkeyframes defrule defstyles defstylesheet]]) 6 | (:require 7 | [garden.arithmetic :refer [+ - * /]] 8 | [garden.color :as color :refer [hsl rgb]] 9 | [garden.core :refer [css]] 10 | [garden.stylesheet :refer [at-media]] 11 | [garden.units :as u :refer [em pt px]])) 12 | 13 | 14 | ;; ----------------------------------------------------------------------------- 15 | ;; CSS Utilities 16 | 17 | (defbreakpoint small-screen 18 | {:screen true 19 | :min-width (px 320) 20 | :max-width (px 480)}) 21 | 22 | (defbreakpoint medium-screen 23 | {:screen true 24 | :min-width (px 481) 25 | :max-width (px 1023)}) 26 | 27 | (defbreakpoint large-screen 28 | {:screen true 29 | :min-width (px 1024)}) 30 | 31 | ;; (css 32 | ;; [:.container 33 | ;; (small-screen 34 | ;; [:& {:max-width (px 480)}]) 35 | ;; (medium-screen 36 | ;; [:& {:max-width (px 760)}]) 37 | ;; (large-screen 38 | ;; [:& {:max-width (px 1224)}])]) 39 | 40 | (defrule article :article) 41 | (defrule aside :aside) 42 | (defrule body :body) 43 | (defrule footer :footer) 44 | (defrule header :header) 45 | (defrule html :html) 46 | (defrule main :main) 47 | 48 | (defrule headings :h1 :h2 :h3) 49 | (defrule sub-headings :h4 :h5 :h6) 50 | 51 | (defrule ordered-list :ol) 52 | (defrule unordered-list :ul) 53 | 54 | (defrule active-links :a:active) 55 | (defrule links :a:link) 56 | (defrule on-hover :&:hover) 57 | (defrule visited-links :a:visited) 58 | 59 | ;; (def center-text {:text-align "center"}) 60 | 61 | ;; (def clearfix 62 | ;; ["&" {:*zoom 1} 63 | ;; ["&:before" "&:after" {:content "\"\"" :display "table"}] 64 | ;; ["&:after" {:clear "both"}]]) 65 | 66 | ;; (def gutter (px 20)) 67 | 68 | ;; (def alegreya ["Alegreya" "Baskerville" "Georgia" "Times" "serif"]) 69 | ;; (def mono ["Inconsolata" "Menlo" "Courier" "monospace"]) 70 | ;; (def sans ["\"Open Sans\"" "Avenir" "Helvetica" "sans-serif"]) 71 | ;; (def sans-serif '[helvetica arial sans-serif]) 72 | 73 | ;; (defrule center :div.center) 74 | ;; (defrule top :section#top) 75 | ;; (defrule main :section#main) 76 | ;; (defrule sidebar :section#sidebar) 77 | 78 | ;; (def palette 79 | ;; (let [base-color (hsl 0 100 50)] 80 | ;; (color/shades base-color))) 81 | -------------------------------------------------------------------------------- /src/ion/ergo/core.cljc: -------------------------------------------------------------------------------- 1 | (ns ion.ergo.core 2 | "Building blocks for the construction of generative systems; stepping stones 3 | for the pursuit of algorithmic beauty within the gardens of your mind.") 4 | 5 | (set! *warn-on-reflection* true) 6 | (set! *unchecked-math* :warn-on-boxed) 7 | 8 | 9 | ; ----------------------------------------------------------------------------- 10 | ; Shared Constants 11 | 12 | (def ^:const PI Math/PI) 13 | 14 | (def ^:const THREE-HALVES-PI (* PI 1.5)) 15 | (def ^:const TWO-PI (* PI 2.0)) 16 | 17 | (def ^:const HALF-PI (/ PI 2.0)) 18 | (def ^:const THIRD-PI (/ PI 3.0)) 19 | (def ^:const QUARTER-PI (/ PI 4.0)) 20 | (def ^:const SIXTH-PI (/ PI 6.0)) 21 | 22 | (def ^:const DEG (/ 180.0 PI)) 23 | (def ^:const RAD (/ PI 180.0)) 24 | 25 | 26 | ; ----------------------------------------------------------------------------- 27 | ; Helper Functions 28 | 29 | (defn degrees [theta] (* (double theta) DEG)) 30 | 31 | (defn radians [theta] (* (double theta) RAD)) 32 | 33 | (defn clamp [min max x] 34 | (let [x (long x) min (long min) max (long max)] 35 | (if (< x min) min (if (> x max) max x)))) 36 | 37 | (defn clamp-normalized [x] 38 | (let [x (double x)] (if (< x -1.0) -1.0 (if (> x 1.0) 1.0 x)))) 39 | 40 | (defn neighborhood 41 | "Returns a function that returns a lazy sequence of [x y] pairs of a 42 | neighborhood for a given [x y] vector." 43 | [nf-x nf-y] 44 | (fn [[x y]] 45 | (map vector (nf-x x) (nf-y y)))) 46 | 47 | (def neighborhood-4-x (juxt inc identity dec identity)) 48 | (def neighborhood-4-y (juxt identity inc identity dec)) 49 | 50 | (def neighborhood-4 (neighborhood neighborhood-4-x neighborhood-4-y)) 51 | 52 | (def neighborhood-5-x (juxt inc identity dec identity identity)) 53 | (def neighborhood-5-y (juxt identity inc identity dec identity)) 54 | 55 | (def neighborhood-5 (neighborhood neighborhood-5-x neighborhood-5-y)) 56 | 57 | (def neighborhood-8-x (juxt inc inc identity dec dec dec identity inc)) 58 | (def neighborhood-8-y (juxt identity inc inc inc identity dec dec dec)) 59 | 60 | (def neighborhood-8 (neighborhood neighborhood-8-x neighborhood-8-y)) 61 | 62 | (def neighborhood-9-x (juxt inc inc identity dec dec dec identity inc identity)) 63 | (def neighborhood-9-y (juxt identity inc inc inc identity dec dec dec identity)) 64 | 65 | (def neighborhood-9 (neighborhood neighborhood-9-x neighborhood-9-y)) 66 | 67 | (defn wi->xy 68 | "Returns the [x y] coordinates for a row-major order index position based on 69 | the width of the grid." 70 | [w i] 71 | (let [w (long w) 72 | i (long i) 73 | x (mod i w) 74 | y (quot i w)] 75 | [x y])) 76 | 77 | (defn hi->xy 78 | "Returns the [x y] coordinates for a column-major order index position based 79 | on the height of the grid." 80 | [h i] 81 | (let [h (long h) 82 | i (long i) 83 | x (quot i h) 84 | y (mod i h)] 85 | [x y])) 86 | 87 | (defn row-whxy->i 88 | "Returns the linear index position in a row-major-ordered 1D array for the 89 | given [x y] coordinates with toroidal adjustments applied to the x and y 90 | values based on the grid width and grid height." 91 | [w h [x y]] 92 | (let [w (long w) 93 | h (long h) 94 | x (long (mod x w)) 95 | y (long (mod y h)) 96 | i (+ x (* y w))] 97 | i)) 98 | 99 | (defn col-whxy->i 100 | "Returns the linear index position in a column-major-ordered 1D array for 101 | the given [x y] coordinates with toroidal adjustments applied to the x and y 102 | values based on the grid width and grid height." 103 | [w h [x y]] 104 | (let [w (long w) 105 | h (long h) 106 | x (long (mod x w)) 107 | y (long (mod y h)) 108 | i (+ (* x h) y)] 109 | i)) 110 | 111 | 112 | ; ----------------------------------------------------------------------------- 113 | ; Recursive Axiomatic Transformative Sequence (RATS) Producer 114 | 115 | (defn produce 116 | "Returns a lazy sequence of colls from a recursive, axiomatic, 117 | transformative process." 118 | [seed prep-f get-xf] 119 | (letfn [(process 120 | [coll] 121 | (lazy-seq 122 | (when (seq coll) 123 | (let [new-coll (into (empty coll) (get-xf coll) (prep-f coll))] 124 | (cons new-coll (process new-coll))))))] 125 | (process seed))) 126 | 127 | (defn get-rewriting-rules 128 | "Returns the rules for a generation, calling any rules written as functions." 129 | [axiom rules generation] 130 | (if (= 0 generation) 131 | {::axiom axiom} 132 | (if (fn? rules) (rules generation) rules))) 133 | 134 | (defn rewriting-system 135 | "Returns a rewriting (Lindenmayer) system." 136 | [get-xf] 137 | (produce [::axiom] identity get-xf)) 138 | 139 | (defn dense-ca-system 140 | "Returns a densely-populated toroidal grid cellular automata system." 141 | [seed get-xf] 142 | (cons seed (produce seed identity get-xf))) 143 | 144 | (defn sparse-ca-system 145 | "Returns a sparsely-populated set-of-cells-based cellular automata system." 146 | [seed prep-f get-xf] 147 | (cons (set seed) (produce (set seed) prep-f get-xf))) 148 | 149 | 150 | ; ----------------------------------------------------------------------------- 151 | ; Transformation Functions 152 | 153 | (defprotocol IRewritable 154 | (module [this])) 155 | 156 | (defn modulate 157 | "Returns the module, or the module supplied by an object implementing the 158 | Rewrite protocol." 159 | [m] 160 | (if (satisfies? IRewritable m) (module m) m)) 161 | 162 | (defn modulating 163 | "Returns a module-extracting transducer." 164 | [] 165 | (map modulate)) 166 | 167 | (defn rewrite 168 | "Returns a successor, which must be a vector or a function. If no match is 169 | found in the rules mapping, the original module is return within a vector." 170 | [rules m] 171 | (or (rules m) [m])) 172 | 173 | (defn rewriting 174 | "Returns a rewriting transducer." 175 | [axiom rules generation] 176 | (map (partial rewrite (get-rewriting-rules axiom rules generation)))) 177 | 178 | (defn call 179 | "Returns a function that will return the successor vector, or the result of 180 | calling the successor function, which must return a vector of modules." 181 | ([] 182 | (fn context-free-call [successor] 183 | (if (fn? successor) 184 | (successor) 185 | successor))) 186 | ([generation word] 187 | (let [index (volatile! (long -1))] 188 | (fn context-sensitive-call [successor] 189 | (vswap! index #(inc (long %))) 190 | (if (fn? successor) 191 | (successor generation word @index (word @index)) 192 | successor))))) 193 | 194 | (defn calling 195 | "Returns a function-calling transducer." 196 | ([] 197 | (map (call))) 198 | ([generation word] 199 | (map (call generation word)))) 200 | 201 | (defn cell-life 202 | "Returns a function that returns a cell whose fate depends on the number of 203 | live neighboring cells." 204 | [live-cell dead-cell survive? birth? live-count-f neighbors-f] 205 | (let [index (volatile! (long -1))] 206 | (fn cell-fate [cell] 207 | (vswap! index #(inc (long %))) 208 | (let [neighbors (neighbors-f @index) 209 | live-neighbor-count (reduce live-count-f 0 neighbors)] 210 | (if (= live-cell cell) 211 | (if (survive? live-neighbor-count) live-cell dead-cell) 212 | (if (birth? live-neighbor-count) live-cell dead-cell)))))) 213 | 214 | (defn cell-life-candidate-set 215 | "Returns a function that returns a cell whose fate depends on the number of 216 | live neighboring cells." 217 | [live-cell dead-cell survive? birth? live-count-f neighbors-f candidate?] 218 | (let [index (volatile! (long -1))] 219 | (fn cell-fate [cell] 220 | (vswap! index #(inc (long %))) 221 | (if-not (candidate? @index) 222 | dead-cell 223 | (let [neighbors (neighbors-f @index) 224 | live-neighbor-count (reduce live-count-f 0 neighbors)] 225 | (if (= live-cell cell) 226 | (if (survive? live-neighbor-count) live-cell dead-cell) 227 | (if (birth? live-neighbor-count) live-cell dead-cell))))))) 228 | 229 | (defn cell-life-candidate-counts 230 | "Returns a function that returns a cell whose fate depends on the number of 231 | live neighboring cells." 232 | [live-cell dead-cell survive? birth? candidate-counts] 233 | (let [index (volatile! (long -1))] 234 | (fn cell-fate [cell] 235 | (vswap! index #(inc (long %))) 236 | (if-let [live-neighbor-count (candidate-counts @index)] 237 | (if (= live-cell cell) 238 | (if (survive? live-neighbor-count) live-cell dead-cell) 239 | (if (birth? live-neighbor-count) live-cell dead-cell)) 240 | dead-cell)))) 241 | 242 | 243 | ; ----------------------------------------------------------------------------- 244 | ; Generation Number and Data Context Wrapper 245 | 246 | (defn gen 247 | "Returns a function that, when called, will call f with an incremented 248 | generation number and an additional context data argument." 249 | [f] 250 | (let [generation (volatile! (long -1))] 251 | (fn 252 | [data] 253 | (vswap! generation #(inc (long %))) 254 | (f @generation data)))) 255 | 256 | 257 | ; ----------------------------------------------------------------------------- 258 | ; Rewriting Systems 259 | 260 | (declare grammarpedia) 261 | 262 | (defn grammar 263 | "Returns the [axiom rules] vector from the grammarpedia." 264 | [key] 265 | (let [gramm (key grammarpedia)] 266 | [(:axiom gramm) (:rules gramm)])) 267 | 268 | (defn basic-rewriting-system 269 | "Returns a lazy sequence of words from a context-free rewriting process." 270 | [axiom rules] 271 | (rewriting-system (gen (fn [generation _] 272 | (comp (rewriting axiom rules generation) 273 | cat))))) 274 | 275 | (defn functional-rewriting-system 276 | "Returns a lazy sequence of words from a context-free rewriting process. 277 | Allows a rewrite successor to (optionally) be a function that will get 278 | called without passing it any arguments. The returned value may be 279 | deterministic or stochastic." 280 | [axiom rules] 281 | (rewriting-system (gen (fn [generation _] 282 | (comp (rewriting axiom rules generation) 283 | (calling) 284 | cat))))) 285 | 286 | (defn context-sensitive-rewriting-system 287 | "Returns a lazy sequence of words from a context-sensitive rewriting 288 | process. Allows a rewrite successor to (optionally) be a function that will 289 | get called with the current context (generation word index module) as args." 290 | [axiom rules] 291 | (rewriting-system (gen (fn [generation word] 292 | (comp (rewriting axiom rules generation) 293 | (calling generation word) 294 | cat))))) 295 | 296 | (defn parametric-rewriting-system 297 | "Returns a lazy sequence of words from a context-free rewriting process." 298 | [axiom rules] 299 | (rewriting-system (gen (fn [generation _] 300 | (comp (modulating) 301 | (rewriting axiom rules generation) 302 | cat))))) 303 | 304 | (defn parametric-functional-rewriting-system 305 | "Returns a lazy sequence of words from a context-free rewriting process. 306 | Allows a rewrite successor to (optionally) be a function that will get 307 | called without passing it any arguments. The returned value may be 308 | deterministic or stochastic." 309 | [axiom rules] 310 | (rewriting-system (gen (fn [generation _] 311 | (comp (modulating) 312 | (rewriting axiom rules generation) 313 | (calling) 314 | cat))))) 315 | 316 | (defn parametric-context-sensitive-rewriting-system 317 | "Returns a lazy sequence of words from a context-sensitive rewriting 318 | process. Allows a rewrite successor to (optionally) be a function that will 319 | get called with the current context (generation word index module) as args." 320 | [axiom rules] 321 | (rewriting-system (gen (fn [generation word] 322 | (comp (modulating) 323 | (rewriting axiom rules generation) 324 | (calling generation word) 325 | cat))))) 326 | 327 | (comment ; A basic example. 328 | 329 | (defn basic-fibonacci-sequence 330 | "Returns a lazy sequence of vectors of Fibonacci integers - OEIS A003849." 331 | [] 332 | (apply basic-rewriting-system (grammar :A003849))) 333 | 334 | (-> (basic-fibonacci-sequence) (nth 10) count) ; 144 335 | 336 | ) 337 | 338 | ; ----------------------------------------------------------------------------- 339 | ; General Cellular Automata 340 | 341 | (declare patternpedia) 342 | 343 | (defn pattern 344 | "Returns the set of cells specified by the key from the patternpedia." 345 | [k] 346 | (k patternpedia)) 347 | 348 | 349 | ; ----------------------------------------------------------------------------- 350 | ; Life-Like Cellular Automata 351 | 352 | (declare lifepedia) 353 | 354 | (defn life-rules 355 | "Returns the [survive? birth? neighborhood] rules trifecta from lifepedia." 356 | [k] 357 | (let [info (k lifepedia)] 358 | [(:S info) (:B info) (:N info)])) 359 | 360 | 361 | ; ----------------------------------------------------------------------------- 362 | ; Densely-Populated Toroidal Grids of Cellular Automata 363 | 364 | (defn make-seed 365 | "Returns a vector of values based on calling f, which should return a lazy 366 | infinite sequence." 367 | [f w h] 368 | (vec (take (* (long w) (long h)) (f)))) 369 | 370 | (defn make-seed-with-random-values 371 | [cell-values w h] 372 | (make-seed #(repeatedly (fn [] (rand-nth cell-values))) w h)) 373 | 374 | (defn make-seed-2 375 | "Returns a vector of values based on calling (f x y)." 376 | [w h f] 377 | (vec (for [y (range h) 378 | x (range w)] 379 | (f x y)))) 380 | 381 | (defn make-seed-for-pattern 382 | [live-cell dead-cell w h pattern] 383 | (let [make-cell (fn [x y] 384 | (if (pattern [x y]) live-cell dead-cell))] 385 | (make-seed-2 w h make-cell))) 386 | 387 | (defn make-seed-for-acorn 388 | [live-cell dead-cell w h] 389 | (make-seed-for-pattern 390 | live-cell dead-cell w h #{[0 2] [1 0] [1 2] [3 1] [4 2] [5 2] [6 2]})) 391 | 392 | (defn cell-counter 393 | "Returns a functions that counts cells having a certain value." 394 | [cell-value] 395 | (fn [n cell] (if (= cell-value cell) (inc (long n)) n))) 396 | 397 | (defn make-neighborhood-lookup 398 | "Returns a row-major order vector of vectors of neighborhood positions for 399 | each cell position for a given width and height." 400 | [neighborhood-f width height] 401 | (let [xy->i (partial row-whxy->i width height)] 402 | (into [] (for [y (range height) 403 | x (range width)] 404 | (mapv xy->i (neighborhood-f [x y])))))) 405 | 406 | (defn get-neighbors 407 | "Returns a function that returns a lazy sequence of neighbors of the cell at 408 | index in word." 409 | [neighborhood-lookup word] 410 | (fn [index] (map word (neighborhood-lookup index)))) 411 | 412 | (defn get-candidates 413 | "Returns the set of cell-index values for non-dead cells and their 414 | neighbors." 415 | [dead-cell neighborhood-lookup word] 416 | (let [f (fn [index cell] 417 | (when (not= dead-cell cell) 418 | (conj (neighborhood-lookup index) index)))] 419 | (set (apply concat (keep-indexed f word))))) 420 | 421 | (defn get-candidate-counts 422 | "Returns a map of candidate-cell-index neighbor-count pairs." 423 | [dead-cell neighborhood-lookup word] 424 | (let [f (fn [index cell] 425 | (when (not= dead-cell cell) 426 | (neighborhood-lookup index)))] 427 | (frequencies (apply concat (keep-indexed f word))))) 428 | 429 | (defn dense-fate-ca-system 430 | [cell-fate-f neighborhood-f seed w h] 431 | (let [neighborhood-lookup (make-neighborhood-lookup neighborhood-f w h)] 432 | (dense-ca-system 433 | seed 434 | (gen (fn [generation word] 435 | (let [neighbors-f (get-neighbors neighborhood-lookup word)] 436 | (map (cell-fate-f generation neighbors-f)))))))) 437 | 438 | (defn dense-life-ca-system 439 | [survive? birth? neighborhood-f live-cell dead-cell seed w h] 440 | (let [neighborhood-lookup (make-neighborhood-lookup neighborhood-f w h) 441 | live-count-f (cell-counter live-cell) 442 | life (partial cell-life live-cell dead-cell 443 | survive? birth? live-count-f)] 444 | (dense-ca-system 445 | seed 446 | (gen (fn [generation word] 447 | (let [neighbors-f (get-neighbors neighborhood-lookup word)] 448 | (map (life neighbors-f)))))))) 449 | 450 | (defn dense-life-candidate-set-ca-system 451 | [survive? birth? neighborhood-f live-cell dead-cell seed w h] 452 | (let [neighborhood-lookup (make-neighborhood-lookup neighborhood-f w h) 453 | live-count-f (cell-counter live-cell) 454 | life (partial cell-life-candidate-set live-cell dead-cell 455 | survive? birth? live-count-f)] 456 | (dense-ca-system 457 | seed 458 | (gen (fn [generation word] 459 | (let [neighbors-f (get-neighbors neighborhood-lookup word) 460 | candidate? (get-candidates dead-cell neighborhood-lookup word)] 461 | (map (life neighbors-f candidate?)))))))) 462 | 463 | (defn dense-life-candidate-counts-ca-system 464 | [survive? birth? neighborhood-f live-cell dead-cell seed w h] 465 | (let [neighborhood-lookup (make-neighborhood-lookup neighborhood-f w h) 466 | life (partial cell-life-candidate-counts live-cell dead-cell 467 | survive? birth?)] 468 | (dense-ca-system 469 | seed 470 | (gen (fn [generation word] 471 | (let [counts (get-candidate-counts dead-cell neighborhood-lookup word)] 472 | (map (life counts)))))))) 473 | 474 | (defn dense-life-rule-system 475 | [rule-key live-cell dead-cell seed w h] 476 | (let [[survive? birth? neighborhood-f] (life-rules rule-key)] 477 | (dense-life-ca-system 478 | survive? birth? neighborhood-f live-cell dead-cell seed w h))) 479 | 480 | (comment 481 | 482 | (defn dense-random-conway-game-of-life 483 | "Example of Conway's Game of Life in a densely-populated toroidal grid, 484 | representing live cells as :alive and dead cells as :dead, randomly 485 | seeded." 486 | [w h] 487 | (dense-life-ca-system 488 | #{2 3} #{3} neighborhood-8 :alive :dead 489 | (make-seed-for-random-value [:alive :dead] w h) w h)) 490 | 491 | ) 492 | 493 | 494 | ; ----------------------------------------------------------------------------- 495 | ; Protocols/Records/Types for Sparse Sets of Cellular Automata 496 | 497 | (defprotocol IPosition 498 | (position [this]) 499 | (x [this]) 500 | (y [this]) 501 | (z [this])) 502 | 503 | (extend-protocol IPosition 504 | clojure.lang.PersistentVector 505 | (position [v] v) 506 | (x [v] (get v 0)) 507 | (y [v] (get v 1)) 508 | (z [v] (get v 2))) 509 | 510 | #?(:clj 511 | (deftype Cell [x-coord y-coord] 512 | IPosition 513 | (position [_] [x-coord y-coord]) 514 | (x [_] x-coord) 515 | (y [_] y-coord) 516 | Object 517 | (equals [_ o] 518 | (and (satisfies? IPosition o) 519 | (and (= x-coord (x ^Cell o)) 520 | (= y-coord (y ^Cell o))))) 521 | (hashCode [_] (hash [x-coord y-coord])))) 522 | 523 | #?(:clj 524 | (defmethod clojure.core/print-method Cell [this ^java.io.Writer writer] 525 | (.write writer (str "")))) 526 | 527 | #?(:cljs 528 | (deftype Cell [x-coord y-coord] 529 | IPosition 530 | (position [_] [x-coord y-coord]) 531 | (x [_] x-coord) 532 | (y [_] y-coord) 533 | IEquiv 534 | (-equiv [_ o] 535 | (and (instance? Cell o) 536 | (and (= x-coord (x ^Cell o)) 537 | (= y-coord (y ^Cell o))))) 538 | IHash 539 | (-hash [_] (hash [x-coord y-coord])))) 540 | 541 | (defn basic-cell 542 | ([[x y]] ; Candidate cell, only used temporarily to test set membership. 543 | (->Cell x y)) 544 | ([[x y] cells] ; Newborn cell. 545 | (->Cell x y)) 546 | ([[x y] cells cell] ; Survivor. 547 | (->Cell x y))) 548 | 549 | (defn vector-cell 550 | ([v] ; Candidate cell, only used temporarily to test set membership. 551 | v) 552 | ([v cells] ; Newborn cell. 553 | v) 554 | ([v cells cell] ; Survivor. 555 | v)) 556 | 557 | 558 | ; ----------------------------------------------------------------------------- 559 | ; Sparse Sets of Life-Like Cellular Automata 560 | 561 | (defn neighbor-frequencies 562 | "Returns a map of [x y] neighbor-count pairs for a set of cells based on the 563 | neighborhood function." 564 | [neighborhood-f cells] 565 | (frequencies (mapcat #(neighborhood-f (position %)) cells))) 566 | 567 | (defn sparse-life-exist 568 | "Returns a function that returns a cell if destiny will allow it to survive, 569 | or a newborn cell if mother nature brings it to life." 570 | [survive? birth? cell-maker-f cells] 571 | (fn sparse-life-cell-fate [[cell-position neighbor-count]] 572 | (if-let [cell (cells (cell-maker-f cell-position))] 573 | (when (survive? neighbor-count) (cell-maker-f cell-position cells cell)) 574 | (when (birth? neighbor-count) (cell-maker-f cell-position cells))))) 575 | 576 | (defn sparse-life-existing 577 | "Returns an existence-determining transducer." 578 | [survive? birth? cell-maker-f cells] 579 | (keep (sparse-life-exist survive? birth? cell-maker-f cells))) 580 | 581 | (defn sparse-life-xf 582 | [survive? birth? cell-maker-f cells] 583 | ; TODO comp in a trim function based on the x & y extents. 584 | (sparse-life-existing survive? birth? cell-maker-f cells)) 585 | 586 | (defn sparse-life-ca-system 587 | [survive? birth? neighborhood-f cell-maker-f seed] 588 | (let [seed (into #{} (map cell-maker-f) seed) 589 | prep-f (partial neighbor-frequencies neighborhood-f) 590 | get-xf (partial sparse-life-xf survive? birth? cell-maker-f)] 591 | (sparse-ca-system seed prep-f get-xf))) 592 | 593 | (defn sparse-life-rule-system 594 | [rule-key cell-maker-f seed] 595 | (let [[survive? birth? neighborhood-f] (life-rules rule-key)] 596 | (sparse-life-ca-system survive? birth? neighborhood-f cell-maker-f seed))) 597 | 598 | (comment 599 | 600 | "Conway's Game of Life example using Acorn pattern as the seed." 601 | 602 | (-> 603 | (sparse-life-rule-system :conway-game-of-life vector-cell (pattern :acorn)) 604 | (nth 10)) 605 | 606 | (-> 607 | (sparse-life-rule-system :conway-game-of-life basic-cell (pattern :acorn)) 608 | (nth 10)) 609 | 610 | ) 611 | 612 | 613 | ; ----------------------------------------------------------------------------- 614 | ; Grammarpedia 615 | 616 | ; When a grammar produces an integer sequence, it is named after its identifier 617 | ; from "The On-Line Encyclopedia of Integer Sequences" https://oeis.org/ 618 | 619 | (def grammarpedia 620 | {:A003849 621 | {:descr "Fibonacci sequence, beginning with zero" 622 | :axiom [0] 623 | :rules {0 [0 1] 624 | 1 [0]}} 625 | :A005614 626 | {:descr "Fibonacci sequence, beginning with one" 627 | :axiom [1] 628 | :rules {0 [1] 629 | 1 [1 0]}} 630 | :A010060 631 | {:descr "Thue-Morse sequence" 632 | :axiom [0] 633 | :rules {0 [0 1] 634 | 1 [1 0]}} 635 | :A014577 636 | {:descr "Dragon-curve sequence" 637 | :axiom [:L] 638 | :rules {:L [:L :1 :R] 639 | :R [:L :0 :R]}} 640 | :A026465 641 | {:descr "Length of n-th run of identical symbols in the Thue-Morse sequence A010060" 642 | :axiom [1] 643 | :rules {1 [1 2 1] 644 | 2 [1 2 2 2 1]}} 645 | :A029883 646 | {:descr "First differences of Thue-Morse sequence A001285" 647 | :axiom [1] 648 | :rules {1 [1 0 -1] 649 | 0 [1 -1] 650 | -1 [0]}} 651 | :A036577 652 | {:descr "Ternary Thue-Morse sequence" 653 | :axiom [2] 654 | :rules {0 [1] 655 | 1 [2 0] 656 | 2 [2 1 0]}} 657 | :A166253 658 | {:descr "A166253" 659 | :axiom [1] 660 | :rules {0 [0 1 1 1 0] 661 | 1 [1 0 0 0 1]}} 662 | :Rudin-Shapiro-sequence 663 | {:descr "Rudin-Shapiro sequence" 664 | :axiom [:AA] 665 | :rules {:AA [:AA :AB] 666 | :AB [:AA :BA] 667 | :BA [:BB :AB] 668 | :BB [:BB :BA]}} 669 | :binary 670 | {:descr "Binary sequence" 671 | :axiom [0] 672 | :rules {0 [0 1 0]}} 673 | }) 674 | 675 | 676 | ; ----------------------------------------------------------------------------- 677 | ; Life-Like Cellular Automata Rules 678 | 679 | (def lifepedia 680 | {:conway-game-of-life 681 | {:S #{2 3} :B #{3} :N neighborhood-8} 682 | :fredkin 683 | {:S #{1 3 5 7 9} :B #{1 3 5 7 9} :N neighborhood-9} 684 | :gnarl 685 | {:S #{1} :B #{1} :N neighborhood-8} 686 | :replicator 687 | {:S #{1 3 5 7} :B #{1 3 5 7} :N neighborhood-8} 688 | :seeds 689 | {:S #{} :B #{2} :N neighborhood-8} 690 | }) 691 | 692 | 693 | ; ----------------------------------------------------------------------------- 694 | ; Patterns for Cellular Automata 695 | 696 | (def patternpedia 697 | {:acorn 698 | #{[0 2] [1 0] [1 2] [3 1] [4 2] [5 2] [6 2]} 699 | :blinker 700 | #{[1 0] [1 1] [1 2]} 701 | :glider 702 | #{[1 0] [2 1] [0 2] [1 2] [2 2]} 703 | :square 704 | #{[1 0] [0 1] [1 1] [0 0]} 705 | }) 706 | -------------------------------------------------------------------------------- /src/ion/omni/core.cljs: -------------------------------------------------------------------------------- 1 | (ns ion.omni.core 2 | (:require 3 | [ion.poly.core :as poly])) 4 | 5 | (enable-console-print!) 6 | 7 | -------------------------------------------------------------------------------- /src/ion/poly/core.cljs: -------------------------------------------------------------------------------- 1 | (ns ion.poly.core 2 | (:require-macros 3 | [cljs.core.async.macros :refer [go go-loop]]) 4 | (:require 5 | [cljs.core :as cljs] 6 | [cljs.core.async :refer [! chan close! put! sliding-buffer timeout]] 7 | [clojure.string :as string] 8 | [goog.async.AnimationDelay] 9 | [goog.async.nextTick] 10 | [goog.date.Date] 11 | [goog.date.DateTime] 12 | [goog.date.UtcDateTime] 13 | [goog.dom :as dom] 14 | [goog.dom.classes :as classes] 15 | [goog.events :as events] 16 | [goog.object] 17 | [goog.string] 18 | [goog.style] 19 | [goog.userAgent] 20 | [phalanges.core :as phalanges]) 21 | (:import 22 | [goog.dom ViewportSizeMonitor] 23 | [goog.events EventType KeyHandler] 24 | [goog Timer])) 25 | 26 | (enable-console-print!) 27 | 28 | 29 | ;; ----------------------------------------------------------------------------- 30 | ;; The top-Level goog namespace has properties and functions worth knowing about. 31 | 32 | (comment 33 | goog/global 34 | goog/global.COMPILED 35 | goog.DEBUG 36 | goog.LOCALE 37 | goog.TRUSTED_SITE 38 | goog.STRICT_MODE_COMPATIBLE 39 | goog.DISALLOW_TEST_ONLY_CODE 40 | goog.ENABLE_CHROME_APP_SAFE_SCRIPT_LOADING 41 | (goog/now) 42 | ) 43 | 44 | 45 | ;; http://www.martinklepsch.org/posts/parameterizing-clojurescript-builds.html 46 | ;; goog.define 47 | 48 | ;; ----------------------------------------------------------------------------- 49 | ;; String Helpers - For additional functionality use the cuerdas library: 50 | ;; https://github.com/funcool/cuerdas 51 | 52 | (defn html-escape 53 | ([s] 54 | (goog.string/htmlEscape s)) 55 | ([s is-likely-to-contain-html-chars?] 56 | (goog.string/htmlEscape s is-likely-to-contain-html-chars?))) 57 | 58 | (defn regexp-escape [s] 59 | (goog.string.regExpEscape s)) 60 | 61 | (defn whitespace-escape [s xml?] 62 | (goog.string.whitespaceEscape s xml?)) 63 | 64 | 65 | ;; ----------------------------------------------------------------------------- 66 | ;; Date and Time - For additional functionality use the cljs-time library: 67 | ;; https://github.com/andrewmcveigh/cljs-time 68 | 69 | (defn js-now [] (js/Date.)) 70 | 71 | (defn now 72 | "Returns a DateTime for the current instant in the UTC time zone." 73 | [] 74 | (goog.date.UtcDateTime.)) 75 | 76 | (defn time-now 77 | "Returns a local DateTime for the current instant without date or time zone 78 | in the current time zone." 79 | [] 80 | (goog.date.DateTime.)) 81 | 82 | (defn today 83 | "Constructs and returns a new local DateTime representing today's date. 84 | local DateTime objects do not deal with timezones at all." 85 | [] 86 | (goog.date.Date.)) 87 | 88 | 89 | ;; ----------------------------------------------------------------------------- 90 | ;; DOM 91 | 92 | (defn get-viewport-size [] 93 | (dom/getViewportSize)) 94 | 95 | (defn get-viewport-width [] 96 | (.-width (dom/getViewportSize))) 97 | 98 | (defn get-viewport-height [] 99 | (.-height (dom/getViewportSize))) 100 | 101 | (defn get-document-height [] 102 | (dom/getDocumentHeight)) 103 | 104 | (defn get-document-scroll-x [] 105 | (.-x (dom/getDocumentScroll))) 106 | 107 | (defn get-document-scroll-y [] 108 | (.-y (dom/getDocumentScroll))) 109 | 110 | (defn get-root [] 111 | (goog.object/get (dom/getElementsByTagNameAndClass "html") 0)) 112 | 113 | (defn get-body [] 114 | (goog.object/get (dom/getElementsByTagNameAndClass "body") 0)) 115 | 116 | (defn get-document [] 117 | (dom/getDocument)) 118 | 119 | (defn get-element [id] 120 | (dom/getElement (name id))) 121 | 122 | (defn get-elements-by-tag-name-and-class 123 | ([tag-name] 124 | (dom/getElementsByTagNameAndClass (name tag-name))) 125 | ([tag-name class-name] 126 | (dom/getElementsByTagNameAndClass (name tag-name) (name class-name)))) 127 | 128 | (defn set-title! [title] 129 | (set! (.-title js/document) title)) 130 | 131 | 132 | ;; ----------------------------------------------------------------------------- 133 | ;; Style 134 | 135 | (defn install-styles! [styles] 136 | (goog.style/installStyles styles)) 137 | 138 | ;; (defn set-stylesheet! [stylesheet] 139 | ;; (let [el (.createElement js/document "style") 140 | ;; node (.createTextNode js/document stylesheet)] 141 | ;; (.appendChild el node) 142 | ;; (.appendChild (.-head js/document) el))) 143 | 144 | ;; (defn get-page-offset [element] 145 | ;; (let [coord (goog.style/getPageOffset element)] 146 | ;; {:x (.-x coord) :y (.-y coord)})) 147 | 148 | 149 | ;; ----------------------------------------------------------------------------- 150 | ;; JavaScript Interop Helpers 151 | 152 | (defn- camel-case [head & more] 153 | (cons head (map string/capitalize more))) 154 | 155 | (defn k->camel-case-name [k] 156 | "Return a camelCase string version of a possibly hyphenated keyword." 157 | (->> (string/split (name k) "-") (apply camel-case) string/join)) 158 | 159 | (defn ks->obj-prop-m [ks] 160 | "Return an object property map for a coll of keywords." 161 | (into {} (for [k ks] {k (k->camel-case-name k)}))) 162 | 163 | (defn o->m [m o] 164 | "Return a map containing the properties of an object based on an object 165 | property map." 166 | (into {} (for [k (keys m)] {k (goog.object/get o (k m))}))) 167 | 168 | 169 | ;; ----------------------------------------------------------------------------- 170 | ;; Async Helpers 171 | 172 | (defn next-tick! 173 | [callback] 174 | (goog.async.nextTick callback)) 175 | 176 | (defn request-animation-frame! 177 | "A delayed callback that pegs to the next animation frame." 178 | [callback] 179 | (.start (goog.async.AnimationDelay. callback))) 180 | 181 | (defn animation-frame-loop! 182 | ([callback] 183 | (animation-frame-loop! callback true)) 184 | ([callback activate?] 185 | (let [alive? (atom true) 186 | active? (atom activate?)] 187 | (letfn [(step 188 | [timestamp] 189 | (when @alive? 190 | (request-animation-frame! step) 191 | (when @active? 192 | (callback timestamp))))] 193 | (request-animation-frame! step)) 194 | [alive? active?]))) 195 | 196 | (defn listen-animation-frame! 197 | [callback] 198 | (letfn [(step 199 | [timestamp] 200 | (when (callback timestamp) (request-animation-frame! step)))] 201 | (request-animation-frame! step))) 202 | 203 | (defn listen-fps! 204 | "Executes callback at every frame returning the frames-per-second." 205 | ([callback] 206 | (request-animation-frame! (listen-fps! callback nil))) 207 | ([callback previous] 208 | (letfn [(step 209 | [timestamp] 210 | (let [previous (or previous (- timestamp 17)) 211 | elapsed (- timestamp previous) 212 | fps (->> (/ elapsed 1000) (/ 1) (.floor js/Math))] 213 | (if (callback fps) 214 | (request-animation-frame! (listen-fps! callback timestamp)))))] 215 | step))) 216 | 217 | (defn listen-fps-interval! 218 | "Executes callback at regular intervals returning the frames-per-second." 219 | ([callback] 220 | (listen-fps-interval! callback 500)) ; Measure every half-second 221 | ([callback interval] 222 | (request-animation-frame! (listen-fps-interval! callback interval nil 1))) 223 | ([callback interval start-time frame-count] 224 | (letfn [(step 225 | [timestamp] 226 | (let [start-time (or start-time (- timestamp 17)) 227 | elapsed (- timestamp start-time)] 228 | (if (< elapsed interval) 229 | (request-animation-frame! 230 | (listen-fps-interval! callback interval start-time (inc frame-count))) 231 | (let [fps (->> (/ frame-count elapsed) (* 1000) (.floor js/Math))] 232 | (if (callback fps) 233 | (request-animation-frame! 234 | (listen-fps-interval! callback interval timestamp 1)))))))] 235 | step))) 236 | 237 | (defn listen-next-tick! 238 | [callback] 239 | (letfn [(step [] (if (callback) (goog.async.nextTick step)))] 240 | (goog.async.nextTick step))) 241 | 242 | ;; (defn foldp! [func init in] 243 | ;; (let [out (chan)] 244 | ;; (put! out init) 245 | ;; (go-loop [m init 246 | ;; v ( (name e-type) (string/replace "-" "") string/upper-case)] 267 | (or (goog.object/get EventType e-type) (string/lower-case e-type)))) 268 | 269 | (defn event-source [src e-type] 270 | "Returns a wrapped-if-necessary event source." 271 | (let [e-type (event-type e-type)] 272 | (if (= "key" e-type) 273 | (KeyHandler. src) 274 | src))) 275 | 276 | (defn- listen-base! 277 | [func src e-type callback] 278 | (let [e-type (event-type e-type)] 279 | (func (event-source src e-type) e-type callback))) 280 | 281 | (def listen! (partial listen-base! events/listen)) 282 | 283 | (def listen-once! (partial listen-base! events/listenOnce)) 284 | 285 | (declare e-chan keyboard-e-chan mouse-e-chan) 286 | 287 | (defn e-type->chan [e-type] 288 | (condp contains? (event-type e-type) 289 | #{"key"} (keyboard-e-chan) 290 | #{"mouseclick" "mousedown" "mousemove" "mouseup"} (mouse-e-chan))) 291 | 292 | (defn listen-put! 293 | ([src e-type] 294 | (listen-put! src e-type (e-type->chan e-type))) 295 | ([src e-type channel] 296 | (let [listener-key (listen! src e-type #(put! channel %))] 297 | [listener-key channel])) 298 | ([src e-type channel subject] 299 | (let [listener-key (listen! src e-type #(put! channel subject))] 300 | [listener-key channel]))) 301 | 302 | (defn unlisten! 303 | ([listener-key] 304 | (events/unlistenByKey listener-key)) 305 | ([listener-key channel] 306 | (events/unlistenByKey listener-key) 307 | (close! channel))) 308 | 309 | (defn e-plus [mapper] 310 | (let [counter (atom 0)] 311 | (fn [event] 312 | (let [m (mapper event)] 313 | (assoc m :poly/count (swap! counter inc)))))) 314 | 315 | (defn prevent-default 316 | [event] 317 | (.preventDefault event)) 318 | 319 | (defn stop-propagation 320 | [event] 321 | (.stopPropagation event)) 322 | 323 | 324 | ;; ----------------------------------------------------------------------------- 325 | ;; Browser Event (Generic event that's more of a base pattern than anything useful) 326 | 327 | (def event-ks 328 | #{:alt-key 329 | :button 330 | :buttons 331 | :client-x 332 | :client-y 333 | :ctrl-key 334 | :current-target 335 | :default-prevented 336 | :detail 337 | :event-phase 338 | :key-cde 339 | :meta-key 340 | :offset-x 341 | :offset-y 342 | :related-target 343 | :screen-x 344 | :screen-y 345 | :shift-key 346 | :state 347 | :target 348 | :type}) 349 | 350 | (def e->m (partial o->m (ks->obj-prop-m event-ks))) 351 | 352 | (defn e-chan 353 | ([] 354 | (e-chan (sliding-buffer 1))) 355 | ([buffer] 356 | (chan buffer (map (e-plus e->m))))) 357 | 358 | 359 | ;; ----------------------------------------------------------------------------- 360 | ;; Keyboard Events (:key :key-down :key-press :key-up) 361 | 362 | (def keyboard-event-ks 363 | #{:alt-key 364 | :char-code 365 | :ctrl-key 366 | :current-target 367 | :default-prevented 368 | :is-composing 369 | :key-code 370 | :meta-key 371 | :related-target 372 | :repeat 373 | :shift-key 374 | :target 375 | :type}) 376 | 377 | (def keyboard-e->m (partial o->m (ks->obj-prop-m keyboard-event-ks))) 378 | 379 | (defn keyboard-plus [m] 380 | (assoc m :poly/keyword (phalanges/keycode->keyword (:key-code m)))) 381 | 382 | (defn keyboard-e-chan 383 | ([] 384 | (keyboard-e-chan (sliding-buffer 1))) 385 | ([buffer] 386 | (chan buffer (map (comp keyboard-plus (e-plus keyboard-e->m)))))) 387 | 388 | 389 | ;; ----------------------------------------------------------------------------- 390 | ;; Mouse Events 391 | 392 | (def mouse-event-ks 393 | #{:alt-key 394 | :button 395 | :buttons 396 | :client-x 397 | :client-y 398 | :ctrl-key 399 | :current-target 400 | :default-prevented 401 | :detail 402 | ; :event-phase 403 | ; :key-cde 404 | :meta-key 405 | :offset-x 406 | :offset-y 407 | :related-target 408 | :screen-x 409 | :screen-y 410 | :shift-key 411 | ; :state 412 | :target 413 | :type}) 414 | 415 | (def mouse-e->m (partial o->m (ks->obj-prop-m mouse-event-ks))) 416 | 417 | (defn mouse-e-chan 418 | ([] 419 | (mouse-e-chan (sliding-buffer 1))) 420 | ([buffer] 421 | (chan buffer (map (e-plus mouse-e->m))))) 422 | 423 | 424 | ;; ----------------------------------------------------------------------------- 425 | ;; Viewport Resize Event 426 | 427 | (defn viewport-size-monitor->m [monitor] 428 | (let [size (.getSize monitor) 429 | h (. size -height) 430 | w (. size -width)] 431 | {:height h 432 | :width w})) 433 | 434 | (defn listen-for-viewport-resize! [func] 435 | (let [monitor (ViewportSizeMonitor.)] 436 | (listen! monitor :resize #(func (viewport-size-monitor->m monitor))))) 437 | 438 | (defn listen-put-viewport-resize! [channel] 439 | (let [monitor (ViewportSizeMonitor.)] 440 | (listen-put! monitor :resize channel monitor))) 441 | 442 | (defn channel-for-viewport-resize! 443 | ([] 444 | (channel-for-viewport-resize! (sliding-buffer 1))) 445 | ([buffer] 446 | (listen-put-viewport-resize! (chan buffer (map viewport-size-monitor->m))))) 447 | 448 | 449 | ;; ----------------------------------------------------------------------------- 450 | ;; Window Events 451 | 452 | ;; (defn listen-for-window-load! [func] 453 | ;; (listen! js/window :load func)) 454 | 455 | 456 | -------------------------------------------------------------------------------- /test/ion/ergo/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns ion.ergo.core-test 2 | (:require #?(:clj [clojure.test :refer :all] 3 | :cljs [cljs.test :refer-macros [deftest is testing]]) 4 | [ion.ergo.core :refer :all])) 5 | 6 | (deftest rewrite-test 7 | (let [rules {:A [:B :A :B]}] 8 | (is (= (rewrite rules :A) [:B :A :B])) 9 | (is (= (rewrite rules :B) [:B])) 10 | (is (= (rewrite rules :C) [:C])))) 11 | 12 | (deftest basic-system-test 13 | (let [axiom [0] 14 | rules {0 [0 1] 1 [0]} 15 | system (basic-rewriting-system axiom rules)] 16 | (is (= 144 (-> system (nth 10) count))))) 17 | 18 | (deftest functional-system-test 19 | (let [axiom #(vec [(rand-int 2)]) 20 | rules {0 [0 1] 1 [0]} 21 | system (functional-rewriting-system axiom rules) 22 | size (-> system (nth 10) count)] 23 | (is (or (= 89 size) (= 144 size))))) 24 | --------------------------------------------------------------------------------