rewrite entity system, implement tilemaps, who knows

editor/lovemode.fnl

@@ -24,16 +24,18 @@
     (when (rawget handlers :any) (handlers.any ev key ...)))
   (setmetatable {:any mode-cycler} {:__index handlers}))
 
+(fn modes.draw [mode]
+  (xpcall mode.draw (fn [msg]
+    (love.graphics.reset)
+    (love.graphics.setColor 1 0 0 1)
+    (love.graphics.setNewFont 14)
+    (love.graphics.printf (.. msg "\n" (debug.traceback))
+                          20 20 (- (love.graphics.getWidth) 40)))))
+
 (fn modes.switch [self mode]
   (set love.handlers (add-mode-cycler (if mode.handler {:any mode.handler} std-handlers)))
   (set love.update mode.update)
-  (set love.draw (fn []
-    (xpcall mode.draw (fn [msg]
-      (love.graphics.reset)
-      (love.graphics.setColor 1 0 0 1)
-      (love.graphics.setNewFont 14)
-      (love.graphics.printf (.. msg "\n" (debug.traceback))
-                            20 20 (- (love.graphics.getWidth) 40)))))))
+  (set love.draw #(self.draw mode)))
 
 (fn modes.register [self name mode]
   (tset self.name-to-mode name mode)

editor/modeview.fnl

@@ -10,7 +10,7 @@
 (fn ModeView.draw [self]
   (love.graphics.push :all)
   (love.graphics.translate self.position.x self.position.y)
-  (xpcall self.mode.draw (fn [...] (love.graphics.pop) (error ...)))
+  (modes.draw self.mode)
   (love.graphics.pop))
 
 (fn ModeView.handle-love-update [self ...]

game/dim.fnl

@@ -0,0 +1 @@
+{:tilesize 32}

game/entities/bomb.fnl

@@ -0,0 +1,45 @@
+(local util (require :lib.util))
+(local dim (require :game.dim))
+
+(local Bomb {})
+(fn draw-ticking [bomb x y]
+  (love.graphics.setColor 0.4 0.4 0.4)
+  (love.graphics.circle :fill x y (/ dim.tilesize 2))
+  (love.graphics.setColor 1 0.3 0.3 1)
+  (love.graphics.print (tostring (math.ceil bomb.timer)) (- x 4) (- y 10)))
+
+(fn draw-exploding [bomb x y]
+  (let [radius (/ dim.tilesize 2)
+        l (- x radius)
+        t (- y radius)]
+    (love.graphics.setColor 1 0.7 0)
+    (love.graphics.rectangle :fill l t dim.tilesize dim.tilesize)))
+
+(fn Bomb.draw [x y bomb]
+  (match bomb.state
+    :ticking (draw-ticking bomb x y)
+    :exploding (draw-exploding bomb x y)))
+
+(fn Bomb.set-state [bomb state time]
+  (set bomb.timer time)
+  (set bomb.state state)
+  state)
+
+(fn Bomb.explode [bomb rules]
+  (Bomb.set-state bomb :exploding 0.5)
+  (rules.explode-bomb bomb))
+
+(fn Bomb.update [bomb dt rules]
+  (set bomb.timer (- bomb.timer dt))
+  (when (<= bomb.timer 0)
+    (match bomb.state
+      :ticking (Bomb.explode bomb rules)
+      :exploding (rules.clear-bomb bomb))))
+
+(fn Bomb.new []
+  {:state :ticking :timer 3 :draw (util.fn Bomb :draw) :update (util.fn Bomb :update)})
+
+(fn Bomb.new-explosion []
+  {:state :exploding :timer 0.5 :draw (util.fn Bomb :draw) :update (util.fn Bomb :update)})
+
+Bomb

game/entities/bomberman.fnl

@@ -1,12 +1,21 @@
-(local Entity (require :game.entity))
-(local rules (require :game.rules))
+(local util (require :lib.util))
+(local dim (require :game.dim))
+(local {: direct : move} (util.require :game.entity))
+(local map (require :game.tilemap))
 
-(local Bomberman (Entity:extend))
-(set Bomberman.keymap {:up :w :down :s :left :a :right :d :bomb :x})
-(set Bomberman.color [0.2 0.2 0.2])
-(fn Bomberman.update [self dt]
-  (Bomberman.super.update self dt)
-  (when (love.keyboard.isDown self.keymap.bomb)
-    (rules.place-bomb self.x self.y)))
+(local bomberman {})
+(set bomberman.keymap {:up :w :down :s :left :a :right :d :bomb :x})
 
-Bomberman
+(fn bomberman.draw [entity]
+  (love.graphics.setColor 0.2 0.2 0.2)
+  (love.graphics.circle :fill (. entity.pos 1) (. entity.pos 2) (/ dim.tilesize 2)))
+(fn bomberman.update [entity dt rules]
+  (set entity.vel (direct bomberman.keymap (* dim.tilesize 3)))
+  (set entity.pos (move entity.pos entity.vel dt))
+  (when (love.keyboard.isDown bomberman.keymap.bomb)
+    (rules.place-bomb (map.world-to-tile entity.pos))))
+
+(fn bomberman.new [pos]
+  {: pos :vel [0 0] :draw (util.fn bomberman :draw) :update (util.fn bomberman :update)})
+
+bomberman

game/entity.fnl

@@ -1,24 +1,14 @@
 (local util (require :lib.util))
-(local {: vec* : dir-from-key} (util.require :game.helpers))
+(local {: vec* : vec+ : dir-from-key} (util.require :game.helpers))
 (local rules (require :game.rules))
-(local Object (require :core.object))
+(local dim (require :game.dim))
 
-(local Entity (Object:extend))
-(fn Entity.new [self x y]
-  (set self.x x)
-  (set self.y y)
-  (set self.velocity [0 0]))
-(fn Entity.draw [self]
-  (when (= self.color nil)
-    (set self.color [(math.random) (math.random) (math.random)]))
-    (love.graphics.setColor (table.unpack self.color))
-    (love.graphics.circle :fill self.x self.y 16))
-(fn Entity.move [self [dx dy]]
-  (set self.velocity [dx dy])
-  (set self.x (rules.collide :x self dx))
-  (set self.y (rules.collide :y self dy)))
-(fn Entity.update [self dt]
-  (self:move (vec* (dir-from-key self.keymap) (* self.speed dt))))
-(set Entity.speed 64)
+(local entity {})
+(fn entity.move [pos vel dt]
+  (vec+ pos (vec* vel dt)))
+
+(fn entity.direct [keymap speed]
+  (vec* (dir-from-key keymap) speed))
+
+entity
 
-Entity

game/helpers.fnl

@@ -6,7 +6,30 @@
   (when (love.keyboard.isDown keymap.right) (set dx 1))
   [dx dy])
 
-(fn vec* [vec scalar]
-  (icollect [_ v (ipairs vec)] (* v scalar)))
+(fn vec-scalarop [op]
+  (fn [vec scalar]
+    (icollect [_ v (ipairs vec)] (op v scalar))))
 
-{: dir-from-key : vec*}
+(fn vec-op [op]
+  (fn [vec val]
+    (icollect [i left (ipairs vec)]
+      (let [right (match (type val)
+                    :table (. val i)
+                    _ val)]
+        (op left right)))))
+
+(local vec* (vec-op #(* $1 $2)))
+(local vec+ (vec-op #(+ $1 $2)))
+
+(fn coordinate-iterator [state]
+  (let [{: x : y} state
+        xnext (+ (or x state.w) 1)
+        ynext (+ (or y state.h) 1)]
+    (if (< xnext state.w) (set state.x xnext)
+        (< ynext state.h) (do (set state.x 0) (set state.y ynext))
+        (do (set state.x nil) (set state.y nil)))
+    (values x y)))
+
+(fn all-coordinates [w h] (values coordinate-iterator {: w : h :x 0 :y 0}))
+
+{: dir-from-key : vec* : vec+ : vec-op : all-coordinates}

game/init.fnl

@@ -6,11 +6,16 @@
 (local command (require :core.command))
 
 (local gamemode (require :game.mode))
+(local SpaceOrb (require :game.orb))
+(local map (require :game.tilemap))
+(local tile (require :game.tiles))
+(local bomberman (require :game.entities.bomberman))
+
 (modes:register :game gamemode)
 
-(set state.entities
-  [((require :game.entities.bomberman) 20 20)
-   ((require :game.entities.pacman) 350 350)])
+(set state.entities [(bomberman.new [10 10])])
+(set state.map (map.new-tilemap 28 31 tile.bombertile (tile.itile-named tile.bombertile :empty)))
+(set state.bombs (map.new-entitymap state.map.w state.map.h))
 
 (command.add nil {
   "love:game" (fn []

game/mode.fnl

@@ -1,10 +1,14 @@
 (local state (require :game.state))
+(local map (require :game.tilemap))
+(local rules (require :game.rules))
 
 (fn update [dt]
+  (map.update-entitymap state.bombs dt rules)
   (each [_ entity (ipairs state.entities)]
-    (entity:update dt)))
+    (entity:update dt rules)))
 
 (fn draw []
+  (map.draw-tilemaps 0 0 [state.bombs state.map])
   (each [_ entity (ipairs state.entities)]
     (entity:draw)))
 

game/orb.fnl

@@ -0,0 +1,26 @@
+(local Object (require :core.object))
+
+(local SpaceOrb (Object:extend))
+(fn SpaceOrb.new [self joystick]
+  (set self.joystick joystick))
+
+; axes (with controller upright)
+; x: -left +right
+; z: -forward +backward
+; y: -up +down
+; xr: -up +down (twisting)
+; yr: -right +left (twisting)
+; zr: -right +left (turning)
+(fn SpaceOrb.read [self]
+  (local (x z y xr yr zr) (self.joystick:getAxes))
+  {: x : y : z : xr : yr : zr})
+(fn SpaceOrb.debug-draw [self]
+  (var iaxis 1)
+  (each [axis val (pairs (self:read))]
+    (love.graphics.print (.. axis ": " (tostring val)) 10 (* iaxis 15))
+    (set iaxis (+ iaxis 1))))
+(fn SpaceOrb.update [self])
+(fn SpaceOrb.draw [self] (self:debug-draw))
+
+SpaceOrb
+

game/rules.fnl

@@ -1,8 +1,38 @@
+(local lume (require :lib.lume))
+(local map (require :game.tilemap))
+(local tileset (require :game.tiles))
 (local state (require :game.state))
+(local Bomb (require :game.entities.bomb))
 
-(fn collide [axis entity d]
-  (+ (. entity axis) d))
+(local Rules {})
 
-(fn place-bomb [x y])
-{: collide : place-bomb}
+(fn tile-at [[x y]]
+  (map.tile-at-overlay x y [state.bombs state.map]))
+
+(fn Rules.place-bomb [[x y]]
+  (when (. (tile-at [x y]) :empty)
+    (map.set-entity-at x y state.bombs (Bomb.new))))
+
+(fn Rules.clear-bomb [bomb]
+  (map.remove-entity state.bombs bomb))
+
+(fn explode-in-dir [x y dx dy len]
+  (when (and (>= x 0) (< x state.map.w) (>= y 0) (< y state.map.h))
+    (let [tile (tile-at [x y])]
+      (if tile.empty
+          (do (map.set-entity-at x y state.bombs (Bomb.new-explosion))
+              (when (> len 0)
+                (explode-in-dir (+ x dx) (+ y dy) dx dy (- len 1))))
+
+          (= tile.state :ticking)
+          (Bomb.explode tile Rules)
+
+          tile.breakable
+          (map.set-itile-at x y state.map (tileset.itile-named state.map.tileset :empty))))))
+
+(fn Rules.explode-bomb [bomb]
+  (each [_ [dx dy] (ipairs [[-1 0] [1 0] [0 -1] [0 1]])]
+    (explode-in-dir (+ bomb.x dx) (+ bomb.y dy) dx dy 1)))
+
+Rules
 

game/tilemap.fnl

@@ -0,0 +1,75 @@
+(local dim (require :game.dim))
+(local util (require :lib.util))
+(local {: all-coordinates : vec* : vec+ : vec-op} (util.require :game.helpers))
+(local lume (require :lib.lume))
+
+(fn itile-at [x y tilemap]
+  (-?> tilemap (. y) (. x)))
+
+(fn tile-at [x y tilemap]
+  (let [itile (itile-at x y tilemap)]
+    (match (type itile)
+      :number (. tilemap.tileset itile)
+      :table itile)))
+
+(fn set-itile-at [x y tilemap itile]
+  (when (= nil (. tilemap y))
+    (tset tilemap y []))
+  (tset (. tilemap y) x itile))
+
+(fn tile-at-overlay [x y tilemaps ?itilemap]
+  (let [itilemap (or ?itilemap 1)
+        tilemap (. tilemaps itilemap)]
+    (when tilemap
+      (let [tile (tile-at x y tilemap)]
+        (if (= tile nil)
+          (tile-at-overlay x y tilemaps (+ itilemap 1))
+          tile)))))
+
+(fn new-tilemap [w h tileset ?itile]
+  (local tilemap {: w : h : tileset})
+  (when (not= ?itile nil)
+    (each [x y (all-coordinates w h)]
+      (set-itile-at x y tilemap ?itile)))
+  tilemap)
+
+(fn new-entitymap [w h]
+  {: w : h :entities []})
+
+(fn set-entity-at [x y tilemap entity]
+  (set entity.x x)
+  (set entity.y y)
+  (table.insert tilemap.entities entity)
+  (set-itile-at x y tilemap entity))
+
+(fn remove-entity [tilemap entity]
+  (lume.remove tilemap.entities entity)
+  (set-itile-at entity.x entity.y tilemap))
+
+(fn draw-tilemaps [x y tilemaps]
+  (local base-tilemap (. tilemaps (length tilemaps)))
+  (each [tx ty (all-coordinates base-tilemap.w base-tilemap.h)]
+    (let [tile (tile-at-overlay tx ty tilemaps)]
+      (when (and tile tile.draw)
+        (tile.draw (+ x (* tx dim.tilesize) (/ dim.tilesize 2))
+                   (+ y (* ty dim.tilesize) (/ dim.tilesize 2))
+                   tile)))))
+
+(fn update-entitymap [tilemap ...]
+  (each [_ entity (ipairs (lume.clone tilemap.entities))]
+    (when entity.update
+      (entity:update ...))))
+
+(fn world-to-tile [vec]
+  (-> vec
+    ((vec-op #(math.floor (/ $1 dim.tilesize))))))
+
+(fn colliding-tile-xy [vec dir]
+  (-> vec
+    (world-to-tile)
+    (vec+ dir)))
+
+{: new-tilemap : itile-at :   tile-at : set-itile-at : tile-at-overlay : draw-tilemaps
+ : new-entitymap : set-entity-at : remove-entity : update-entitymap
+ : world-to-tile}
+

game/tiles.fnl

@@ -1,16 +1,41 @@
-(local tiles
+(local dim (require :game.dim))
+(local util (require :lib.util))
+
+(local tileset {})
+(fn rect [x y color]
+  (love.graphics.setColor (table.unpack color))
+  (love.graphics.rectangle :fill
+                            (- x (/ dim.tilesize 2))
+                            (- y (/ dim.tilesize 2))
+                            dim.tilesize
+                            dim.tilesize))
+(fn tileset.make-tileset [tiles draw]
+  (each [itile tile (ipairs tiles)]
+    (tset tiles tile.name itile))
+  (set tiles.draw draw)
+  tiles)
+
+(fn tileset.itile-named [tileset name]
+  (. tileset name))
+
+(fn tileset.bombertile-draw [tile x y]
+  (match tile.name
+    :strongwall (rect x y [0.7 0.7 0.7])
+    :weakwall   (rect x y [0.4 0.4 0.4])
+    :dot (do (love.graphics.setColor 1 1 1)
+             (love.graphics.circle :fill x y (/ dim.tilesize 8)))))
+
+(set tileset.bombertile (tileset.make-tileset
   [{:name :empty
-    :draw (fn [])}
+    :empty true}
    {:name :strongwall
-    :draw (fn [x y w h]
-      (love.graphics.setColor 0.4 0.4 0.4)
-      (love.graphics.rectangle :fill x y w h))}
+    :wall true}
    {:name :weakwall
-    :draw (fn [x y w h]
-      (love.graphics.setColor 0.4 0.4 0.4)
-      (love.graphics.rectangle :fill x y w h))}
+    :wall true
+    :breakable true}
    {:name :dot
-    :draw (fn [x y w h]
-      (love.graphics.setColor 1 1 1)
-      (love.graphics.circle :fill x y w 5))}
-  ])
+    :edible true}
+  ] (util.fn tileset :bomber-tile-draw)))
+
+tileset
+

lib/util.fnl

@@ -77,7 +77,7 @@
 (fn in-coro [f ...] (-> (coroutine.create f) (coroutine.resume ...)))
 
 {: int8-to-bytes : int16-to-bytes : int24-to-bytes : bytes-to-uint8 : bytes-to-uint16 : bytes-to-uint24
- : splice : lo : hi 
- : reload : hotswap : swappable :require swappable-require
+ : splice : lo : hi
+ : reload : hotswap : swappable :require swappable-require :fn mk-swappable-fn
  : readjson : writejson : waitfor : in-coro}