nanpa wan

commit of the last two days: working cellular automata and rendering,
prototype system, etc

6 files changed, 352 insertions, 0 deletions

diff --git a/lib/cell.fnl b/lib/cell.fnl
new file mode 100644
index 0000000..e9af960
--- /dev/null
+++ b/lib/cell.fnl
@@ -0,0 +1,10 @@
+(local proto (require :lib.proto))
+
+{:init (proto.table-method :cell.init)
+ ;; given its 8 neighbors returns a new cell (or nil)
+ ;; TODO: other returns via either a clojure or coroutines
+ :birth (proto.meta-method :cell.birth)
+ :update (proto.meta-method :cell.update)
+ ;; returns a number from 0 to 1
+ :aliveness (proto.meta-method-opt :cell.generation #0)
+ :color (proto.meta-method-opt :cell.color #[0 0 0])}
diff --git a/lib/cells.fnl b/lib/cells.fnl
new file mode 100644
index 0000000..442c7c7
--- /dev/null
+++ b/lib/cells.fnl
@@ -0,0 +1,67 @@
+(local cell (require :lib.cell))
+
+(local neighbors [{:x -1 :y -1}
+                  {:x -1 :y 0}
+                  {:x -1 :y 1}
+                  {:x 0 :y -1}
+                  {:x 0 :y 1}
+                  {:x 1 :y -1}
+                  {:x 1 :y 0}
+                  {:x 1 :y 1}])
+
+(fn neighbors> [f threshold]
+  (var x 0)
+  ;; nnn this could be faster maybe
+  (each [k v (ipairs neighbors)]
+    (when (> (cell.aliveness (f v)) threshold)
+      (set x (+ x 1))))
+  x)
+
+(local life
+  {cell.init
+   (fn [self]
+     (setmetatable {} self))
+   cell.birth
+   (fn [self get]
+     (if (= (neighbors> get 0) 3)
+         self
+         nil))
+   cell.update
+   (fn [self get]
+     (if (or (= (neighbors> get 0) 3)
+             (= (neighbors> get 0) 2))
+         self
+         nil))
+   cell.aliveness
+   #1
+   cell.color
+   #[0.4 0.4 0.7]
+   })
+
+(local brain
+  {cell.init
+   (fn [self]
+     (setmetatable {:stage 0} self))
+   cell.birth
+   (fn [self get]
+     (if (= (neighbors> get 0.8) 2)
+         (do
+           (setmetatable {:stage 0} (getmetatable self)))
+         nil))
+   cell.update
+   (fn [self get]
+     (if (= self.stage 0)
+         (setmetatable {:stage 1} (getmetatable self))
+         nil))
+   cell.aliveness
+   #(- 1 (* 0.5 $.stage))
+   cell.color
+   #(if (= $.stage 0)
+        [0.7 0.4 0.3]
+        (= $.stage 5)
+        [0.5 0.4 0.3]
+        (= $.stage 1)
+        [0.2 0.2 0.3])
+   })
+
+{: life : brain}
diff --git a/lib/game.fnl b/lib/game.fnl
new file mode 100644
index 0000000..da96d9f
--- /dev/null
+++ b/lib/game.fnl
@@ -0,0 +1,109 @@
+(local state (require :lib.state))
+(local cell (require :lib.cell))
+(local cells (require :lib.cells))
+(local fv (require :fennel.view))
+
+(fn lerp* [a b c d x]
+  (+ c (* (/ (- x a) (- b a)) (- d c))))
+
+(fn vec-lerp* [a b c d x]
+  {:x (lerp* a.x b.x c.x d.x x.x)
+    :y (lerp* a.y b.y c.y d.y x.y)})
+
+(fn new-grid [w h f]
+  (var t {})
+  (for [x 0 (- w 1)]
+    (tset t x {})
+    (for [y 0 (- h 1)]
+      (tset (. t x) y (f x y))))
+  t)
+
+(fn update [self]
+  (set self.ship.x (+ self.ship.x 0.02))
+  (set self.ship.y (+ self.ship.y 0.005))
+  (when (= self.tick 0)
+    (for [x 0 (- self.width 1)]
+      (for [y 0 (- self.height 1)]
+        (fn get [v]
+          (. self.grid
+             (% (+ v.x x) self.width)
+             (% (+ v.y y) self.height)))
+        (if (. self.grid x y)
+            ;; check if alive
+            (tset self.grid-alt x y (cell.update (. self.grid x y)
+                                                 get))
+            ;; check for neighbors and then use one at random
+            (do
+              (var neighbors [])
+              (for [x -1 1]
+                (for [y -1 1]
+                  (table.insert neighbors (get {: x : y}))))
+              (if (. neighbors 1)
+                  (tset self.grid-alt x y
+                        (cell.birth (. neighbors (math.random (length neighbors))) get))
+                  (tset self.grid-alt x y nil))))))
+    (set (self.grid self.grid-alt) (values self.grid-alt self.grid)))
+    ;; TODO
+  (set self.tick (% (+ self.tick 1) self.rate)))
+
+(fn id [x] x)
+
+(fn draw [self]
+  (local (width height) (love.graphics.getDimensions))
+  (love.graphics.scale width height)
+  (local camera-size (math.max width height))
+  (let [camera-size (math.max width height)
+        camera-box {:x width :y height}
+        camera-box {:x 1 :y 1}
+        radius-x (* self.radius (/ width camera-size))
+        radius-y (* self.radius (/ height camera-size))
+        camera-a {:x (- self.ship.x radius-x)
+                  :y (- self.ship.y radius-y)}
+        camera-b {:x (+ self.ship.x radius-x)
+                  :y (+ self.ship.y radius-y)}
+        cell-box (vec-lerp* {:x 0 :y 0}
+                            {:x (* 2 radius-x)
+                             :y (* 2 radius-y)}
+                            {:x 0 :y 0}
+                            camera-box
+                            {:x 1 :y 1})]
+    (for [x (math.floor camera-a.x) (math.floor camera-b.x)]
+      (for [y (math.floor camera-a.y) (math.floor camera-b.y)]
+        (let [vec {:x (% x self.width) :y (% y self.height)}
+              render-a (vec-lerp* camera-a camera-b {:x 0 :y 0} camera-box
+                                  {: x : y})
+              render-b (vec-lerp* camera-a camera-b {:x 0 :y 0} camera-box
+                                  {:x (+ x 1) :y (+ y 1)})
+              the (. self.grid vec.x vec.y)
+              color (and the (cell.color the))]
+          (when color
+            (love.graphics.setColor (unpack color))
+            (love.graphics.rectangle :fill
+                                     (id render-a.x)
+                                     (id render-a.y)
+                                     (id cell-box.x)
+                                     (id cell-box.y))))))))
+    ;; (love.graphics.setLineWidth 0.1)
+    ;; (love.graphics.line 0 0 0.3 0.3)
+    ;; (love.graphics.polygon :line 0.3 0.3 0.6 0.3 0.4 0.6)
+    ;; (love.graphics.line 0.4 0.8 0.4 0.8)
+    ;; (love.graphics.print :Gaming))
+
+(fn init [self]
+  (setmetatable
+    {:width 64
+     :height 64
+     :ship {:x 31 :y 31}
+     :radius 32
+     :tick 0
+     :rate 6
+     :grid (new-grid 64 64 #(if (= (math.random 6) 1)
+                                (if (< $1 52)
+                                    (cell.init cells.life)
+                                    (cell.init cells.brain))
+                                nil))
+     :grid-alt (new-grid 64 64 #nil)
+     }
+    self))
+
+{state.draw draw state.init init state.update update}
diff --git a/lib/main.fnl b/lib/main.fnl
new file mode 100644
index 0000000..4a9d26e
--- /dev/null
+++ b/lib/main.fnl
@@ -0,0 +1,69 @@
+(local lume (require :vendor.lume))
+(local proto (require :lib.proto))
+(local state (require :lib.state))
+(local game (require :lib.game))
+
+;; i am thinking we could actually do a really hacky thing (modules add themselves
+;; to this list) with this later but
+;; i'm not sure if it'd be worth it (it'd require those dependency loops maybe)
+;; TODO: ^
+(local hotswap-modules
+  [:lib.cells
+   :lib.game
+   :lib.main])
+
+;; the
+;; oh thats why it doesnt work lmao
+
+(fn love.load []
+  (global the-state (state.init game))
+  (global messages {})
+  (print "a"))
+
+(fn love.draw []
+  (match (pcall #(state.draw the-state))
+    (true x) nil
+    (false x) (do
+                (love.graphics.reset)
+                (print (.. "draw \n" x))
+                (love.graphics.print (.. "draw: \n" x))))
+  (love.graphics.reset)
+  (love.graphics.print (love.timer.getFPS))
+  (when true ;; debug stuff
+    (love.graphics.print (table.concat
+                           (lume.map messages #$.msg)
+                           "\n")
+                         0
+                         40)
+    (each [i v (lume.ripairs messages)]
+      (if (= v.ticks 0)
+          (table.remove messages i)
+          (set v.ticks (- v.ticks 1))))))
+
+;; TODO: we need a better way to display errors at runtime for updates too
+(fn love.update []
+  ;; TODO: make state changes actually possible
+  (match (pcall #(state.update the-state))
+    (true x) nil
+    (false x) (do
+                (print (.. "update: \n" x))
+                (table.insert messages
+                              {:ticks 1
+                               :msg (.. "update: \n" x)}))))
+
+(fn love.keypressed [key scancode repeat]
+  ;; (print key scancode repeat)
+  (when (= key "r")
+    (each [k v (lume.ripairs messages)]
+      (when (= v.type :reload-error)
+        (table.remove messages k)))
+    (print (.. (if (love.keyboard.isDown :lshift) :hard :soft)
+               " reloading..."))
+    (each [_ v (ipairs hotswap-modules)]
+      (match (lume.hotswap v)
+        (nil x) (table.insert messages
+                             {:ticks -1
+                              :type :reload-error
+                              :msg (.. "can't reload module " v "\n" x)})))
+    (when (love.keyboard.isDown :lshift)
+      (love.load))))
diff --git a/lib/proto.fnl b/lib/proto.fnl
new file mode 100644
index 0000000..13b65e9
--- /dev/null
+++ b/lib/proto.fnl
@@ -0,0 +1,78 @@
+;; function set in the prototype via its identity, i.e.
+;; (local blah (meta-fn :blah)
+;; (blah (setmetadata {} {blah (fn [] 4)})) ;; -> 4
+(fn meta-fn [name]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] ((. (getmetatable obj) x) ...))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+(fn meta-method [name]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] ((. (getmetatable obj) x) obj ...))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+;; function set in the prototype via its identity, i.e.
+;; (local blah (meta-fn :blah)
+;; however, these functions are optional, and nop if left out
+;; (blah (setmetadata {} {})) ;; -> nil
+(fn meta-fn-opt [name fallback]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] (if (and (getmetatable obj)
+                                      (. (getmetatable obj) x))
+                                 ((. (getmetatable obj) x) ...)
+                                 fallback
+                                 (fallback ...)
+                                 nil))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+(fn meta-method-opt [name fallback]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] (if (and (getmetatable obj)
+                                      (. (getmetatable obj) x))
+                                 ((. (getmetatable obj) x) obj ...)
+                                 fallback
+                                 (fallback obj ...)
+                                 nil))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+;; value set in the table via its identity, i.e.
+;; (local blah (table-value :blah))
+;; (blah {blah 4}) ;; -> (. {blah 4} blah) -> 4
+(fn table-value [name]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] (. obj x))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+(fn table-fn [name]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] ((. obj x) ...))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+;; methods have an extra "self" param
+(fn table-method [name]
+  (local x {})
+  (setmetatable
+    x
+    {:__call (fn [_ obj ...] ((. obj x) obj ...))
+     :__name name
+     :__fennelview (fn [] [name])}))
+
+{: meta-fn : meta-fn-opt : meta-method : meta-method-opt : table-value : table-fn : table-method}
diff --git a/lib/state.fnl b/lib/state.fnl
new file mode 100644
index 0000000..d98b94e
--- /dev/null
+++ b/lib/state.fnl
@@ -0,0 +1,19 @@
+;; later if it becomes a hassle we can convert this into a separate
+;; file that we can reload or something
+
+(local proto (require :lib.proto))
+
+{
+ :init (proto.table-method :state.init)
+ ;; update is a bit special; it can either return nothing (the state continues
+ ;; as is, and mutated somehow (sorry we're doing things non-purely; i'd like
+ ;; to do them purely but creating tables is slow as heck that'd be ridiculous))
+ ;; or it can return a state that it transitions to automatically
+ ;; game pausing basically works like that: it returns a pause structure with the
+ ;; regular state within its object, and then the pause structure uses that state
+ ;; object to return back to it later. pretty cool!
+ :update (proto.meta-method-opt :state.update)
+ ;; all of the next functions are just. regular love functions, exactly the same
+ ;; i hope
+ :draw (proto.meta-method-opt :state.draw)
+ }