rewrite entity system, implement tilemaps, who knows

This commit is contained in:
Jeremy Penner 2021-03-07 11:55:50 -05:00
parent 23b6193024
commit 1ee0d7980a
14 changed files with 298 additions and 63 deletions

View file

@ -24,16 +24,18 @@
(when (rawget handlers :any) (handlers.any ev key ...))) (when (rawget handlers :any) (handlers.any ev key ...)))
(setmetatable {:any mode-cycler} {:__index handlers})) (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] (fn modes.switch [self mode]
(set love.handlers (add-mode-cycler (if mode.handler {:any mode.handler} std-handlers))) (set love.handlers (add-mode-cycler (if mode.handler {:any mode.handler} std-handlers)))
(set love.update mode.update) (set love.update mode.update)
(set love.draw (fn [] (set love.draw #(self.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.register [self name mode] (fn modes.register [self name mode]
(tset self.name-to-mode name mode) (tset self.name-to-mode name mode)

View file

@ -10,7 +10,7 @@
(fn ModeView.draw [self] (fn ModeView.draw [self]
(love.graphics.push :all) (love.graphics.push :all)
(love.graphics.translate self.position.x self.position.y) (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)) (love.graphics.pop))
(fn ModeView.handle-love-update [self ...] (fn ModeView.handle-love-update [self ...]

1
game/dim.fnl Normal file
View file

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

45
game/entities/bomb.fnl Normal file
View file

@ -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

View file

@ -1,12 +1,21 @@
(local Entity (require :game.entity)) (local util (require :lib.util))
(local rules (require :game.rules)) (local dim (require :game.dim))
(local {: direct : move} (util.require :game.entity))
(local map (require :game.tilemap))
(local Bomberman (Entity:extend)) (local bomberman {})
(set Bomberman.keymap {:up :w :down :s :left :a :right :d :bomb :x}) (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)))
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

View file

@ -1,24 +1,14 @@
(local util (require :lib.util)) (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 rules (require :game.rules))
(local Object (require :core.object)) (local dim (require :game.dim))
(local Entity (Object:extend)) (local entity {})
(fn Entity.new [self x y] (fn entity.move [pos vel dt]
(set self.x x) (vec+ pos (vec* vel dt)))
(set self.y y)
(set self.velocity [0 0])) (fn entity.direct [keymap speed]
(fn Entity.draw [self] (vec* (dir-from-key keymap) speed))
(when (= self.color nil)
(set self.color [(math.random) (math.random) (math.random)])) entity
(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)
Entity

View file

@ -6,7 +6,30 @@
(when (love.keyboard.isDown keymap.right) (set dx 1)) (when (love.keyboard.isDown keymap.right) (set dx 1))
[dx dy]) [dx dy])
(fn vec* [vec scalar] (fn vec-scalarop [op]
(icollect [_ v (ipairs vec)] (* v scalar))) (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}

View file

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

View file

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

26
game/orb.fnl Normal file
View file

@ -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

View file

@ -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 state (require :game.state))
(local Bomb (require :game.entities.bomb))
(fn collide [axis entity d] (local Rules {})
(+ (. entity axis) d))
(fn place-bomb [x y]) (fn tile-at [[x y]]
{: collide : place-bomb} (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

75
game/tilemap.fnl Normal file
View file

@ -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}

View file

@ -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 [{:name :empty
:draw (fn [])} :empty true}
{:name :strongwall {:name :strongwall
:draw (fn [x y w h] :wall true}
(love.graphics.setColor 0.4 0.4 0.4)
(love.graphics.rectangle :fill x y w h))}
{:name :weakwall {:name :weakwall
:draw (fn [x y w h] :wall true
(love.graphics.setColor 0.4 0.4 0.4) :breakable true}
(love.graphics.rectangle :fill x y w h))}
{:name :dot {:name :dot
:draw (fn [x y w h] :edible true}
(love.graphics.setColor 1 1 1) ] (util.fn tileset :bomber-tile-draw)))
(love.graphics.circle :fill x y w 5))}
]) tileset

View file

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