Last active
December 15, 2015 12:19
-
-
Save rm-hull/5259306 to your computer and use it in GitHub Desktop.
A turmite is a Turing machine which has an orientation as well as a current state and a "tape" that consists of an infinite two-dimensional grid of cells. Adapted from: https://github.com/rm-hull/turmites
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; Turmites | |
;; -------- | |
;; A simple N-state two-color Turing machine which operates on a wrapped | |
;; grid of black and white cells, and follows custom rules on every tick of | |
;; a clock. | |
;; | |
;; Predef rules derived from http://code.google.com/p/ruletablerepository/downloads/detail?name=Turmites.zip | |
;; | |
;; Copyright (c) Richard Hull 2012 | |
;; | |
;; Licensed as per the eclipse public license - v 1.0: https://www.eclipse.org/legal/epl-v10.html | |
;; | |
(ns turmites.demo | |
(:use [enchilada :only [ctx canvas]] | |
[monet.canvas :only [get-context get-pixel fill-rect fill-style save restore]] | |
[monet.core :only [animation-frame]] | |
[jayq.core :only [$ document-ready data text attr hide show bind prevent]] | |
[jayq.util :only [log]] | |
[clojure.string :only [split]])) | |
(def offsets | |
{ :north [0 -1] | |
:east [1 0] | |
:south [0 1] | |
:west [-1 0] }) | |
(def directions | |
{ :north { 1 :north 2 :east 4 :south 8 :west } | |
:east { 1 :east 2 :south 4 :west 8 :north } | |
:south { 1 :south 2 :west 4 :north 8 :east } | |
:west { 1 :west 2 :north 4 :east 8 :south }}) | |
(def predef-rules | |
{ :langtons-ant "120080" | |
:fibonacci "181181121010" | |
:binary-counter "120010" | |
:filled-triangle "081121110111" | |
:box-spiral "011081120011" | |
:striped-spiral "021080181020" | |
:stepped-pyramid "021080181110" | |
:contoured-island "021011121180" | |
:woven-placemat "021021110021" | |
:snowflake-ish "021121181180" | |
:slow-city-builder "180011080081" | |
:computer-art "180121020081" | |
:ballon-bursting "180121021180" | |
:horizontal-highway "181080110010" | |
:highway1 "181080121120" | |
;:highway2 "181081121080" | |
:filled-spiral "181010110120" | |
:glaciers "181020080080" | |
:fizzy-spill "181120080080" | |
:nested-cabinets "181121110011" | |
:cross "111081120111" | |
:saw "111010020180" | |
:curves-in-blocks "111011121010" | |
:textured "111020080080" | |
:diamond "111021180120" | |
:coiled-rope "111180121010" | |
:growth1 "120081180011" | |
:square-spiral "120081180021" | |
:loopy "120121010011" | |
:square-ant "121081110010" | |
;:growth2 "121020081180" | |
:distracted-spiral "121020010121" | |
:cauliflower-stalk "121021110111" | |
:worm-trails "121181121020" | |
:two-way-highway "121110110011" | |
:mould-bloom "121120010010" | |
:highway3 "121120020111" | |
:highway4 "121121181020" | |
:square-diagonal "021121082080122180" | |
;:streak1 "181010022180121110" | |
:streak2 "181012022111121110" | |
:maze "181181110012081111" | |
:cornices "182020180020080081" | |
:highway5 "120022080020011180" | |
:highway6 "121080122010180080" | |
}) | |
(defn- pair | |
"Pulls apart a string separated by a = into constituent vector parts, | |
coverts the key into a keyword" | |
[s] | |
(let [[k v] (split s #"=")] | |
[(keyword k) v])) | |
(defn get-params | |
"Extracts a set of key-value pairs separated by & into a map" | |
[s] | |
(let [drop1 (apply str (drop 1 (seq s)))] | |
(->> | |
(split drop1 #"&") | |
(map pair) | |
(into {})))) | |
(defn parse-rules | |
"Slices & dices a linear rule (e.g '120121010011') into state based | |
tuples (e.g: [[(1 2 0) (1 2 1)] [(0 1 0) (0 1 1)]] )" | |
[s] | |
(->> | |
(seq s) | |
(map int) ; not quite compatible with clojure!?! | |
(partition 3) | |
(partition 2) | |
(map vec) | |
vec)) | |
(defn get-color | |
"Fetches the color at the given pixel on the canvas context" | |
[ctx [x y] scale] | |
(get-pixel ctx (* x scale) (* y scale))) | |
(defn set-color! [ctx [x y] scale color] | |
(-> ctx | |
(fill-style color) | |
(fill-rect { :x (* x scale) :y (* y scale) :w scale :h scale}))) | |
(def black? | |
(memoize | |
(fn [color] | |
(->> | |
[:green :blue] | |
(map color) | |
(reduce +) | |
zero?)))) | |
(defn current-position [turmite] | |
(get-in turmite [:current :position])) | |
(defn toggle-previous! [turmite] | |
(let [prev (turmite :previous) | |
color (if (= 0 (turmite :color)) "black" "white")] | |
(if (seq (prev :position)) | |
(set-color! (turmite :ctx) (prev :position) (turmite :cell-size) color)))) | |
(defn draw! [turmite color] | |
(-> (turmite :ctx) | |
(save) | |
(set-color! | |
(current-position turmite) | |
(turmite :cell-size) | |
color) | |
(restore))) | |
(defn wrap [[x y] [w h]] | |
[(mod x w) (mod y h)]) | |
(defn color-mapper [color] | |
(if (black? color) 0 1)) | |
(defn next-triple [turmite] | |
(let [state (get-in turmite [:current :state]) | |
color (color-mapper (get-color (turmite :ctx) (current-position turmite) (turmite :cell-size)))] | |
(get-in turmite [:rule :parsed state color]))) | |
(defn relative-direction [current nextdir] | |
(get-in directions [current nextdir])) | |
(defn next-state | |
"The turmite is transitioned based on its current state and the color of | |
the underlying grid element according to its embedded rule definition." | |
[turmite] | |
(let [[color dir state] (next-triple turmite) | |
new-direction (relative-direction (turmite :direction) dir) | |
pos (wrap | |
(map + (current-position turmite) (new-direction offsets)) | |
(turmite :bounds))] | |
(assoc turmite | |
:generation (inc (turmite :generation)) | |
:direction new-direction | |
:color color | |
:previous (turmite :current) | |
:current {:position pos :color color :state state}))) | |
(defn animate | |
"Main animation step-off point, which indefinitely schedules the next | |
animation frame, updating the termite based on its next state." | |
[turmite] | |
(letfn [(loop [] | |
(animation-frame loop) | |
(let [t @turmite] | |
(reset! turmite (next-state t)) | |
(toggle-previous! t) | |
(draw! t "red")))] | |
(log (pr-str @turmite)) | |
(loop))) | |
(defn create-turmite | |
"Creates the turmite map based on the desired position, screen dimensions, | |
rule, etc." | |
[ctx pos bounds cell-size rule] | |
(atom | |
{ | |
:generation 0 | |
:ctx ctx | |
:cell-size cell-size | |
:bounds bounds | |
:direction (get [:north :east :south :west] (rand-int 4)) | |
:current { :position pos :color (color-mapper (get-color ctx pos cell-size)) :state 0} | |
:previous nil | |
:rule rule | |
})) | |
(defn coords | |
"Gets the co-ordinates from the event, and scale to the cell size" | |
[event scale] | |
[ (quot (.-offsetX event) scale) | |
(quot (.-offsetY event) scale) ]) | |
(defn get-rule | |
"Extracts and parses the rule from the URL query string. If no rule= | |
exists then one is selected at random. If the value is a predefined | |
rule then that is used, otherwise an attempt is made to parse the | |
value into a rule definition." | |
[query-string] | |
(let [input ((get-params query-string) :rule) | |
label (if (nil? input) | |
(nth (keys predef-rules) (rand-int (count predef-rules))) | |
input) | |
rule (get predef-rules (keyword label) input) | |
] | |
{ :name (name label) :data rule :parsed (parse-rules rule) })) | |
(defn available-area | |
"Calculates the maximum available screen size" | |
[] | |
(let [div (first ($ :div#wrapper))] | |
[ (.-offsetWidth div) (.-offsetHeight div) ])) | |
(document-ready | |
(fn [] | |
(show canvas) | |
(-> ctx (fill-style :black) (fill-rect { :x 0 :y 0 :w 800 :h 600})) | |
(let [cell-size 3 | |
width 798 | |
height 600 | |
rule (get-rule (.-search (.-location js/window)))] | |
(bind canvas :click | |
(fn [event] | |
(prevent event) | |
(animate (create-turmite ctx (coords event cell-size) [width height] cell-size rule)))) | |
(animate (create-turmite ctx [100 60] [width height] cell-size rule))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment