Wiring up entities
This commit is contained in:
parent
6d42399529
commit
b428854ae7
55
game/entity.fnl
Normal file
55
game/entity.fnl
Normal file
|
@ -0,0 +1,55 @@
|
||||||
|
(local {: lo : hi} (require :lib.util))
|
||||||
|
|
||||||
|
; Entity memory layout:
|
||||||
|
; +0 - yx
|
||||||
|
; +2 - event handler
|
||||||
|
; +4 - link word
|
||||||
|
; +6 - link data
|
||||||
|
|
||||||
|
; All entities exist in a single page in RAM - with this structure we can have up to 32
|
||||||
|
; (players are handled specially and never require a link)
|
||||||
|
; if we really need more we could have one page for entities and one page for link data
|
||||||
|
; hellmaze level 2 from MS-DOS Neut Tower has 36 entities - good excuse to simplify IMO
|
||||||
|
; The entity count for a level is stored after the map.
|
||||||
|
|
||||||
|
(local ev {
|
||||||
|
:touch 0
|
||||||
|
:act 1
|
||||||
|
:deact 2
|
||||||
|
:tog 3
|
||||||
|
})
|
||||||
|
(fn install [vm entity-org]
|
||||||
|
(vm:word :entity-count :lit :map-entity-count :bget)
|
||||||
|
(vm:def :lookup-entity ; i -- entity
|
||||||
|
[:lda vm.TOP :x]
|
||||||
|
[:asl :a] [:asl :a] [:asl :a] ; x8
|
||||||
|
[:sta vm.TOP :x]
|
||||||
|
[:lda #(hi entity-org.org)]
|
||||||
|
[:sta vm.TOPH :x])
|
||||||
|
(vm:word :entity-at ; yx -- entity|0
|
||||||
|
:>r 0 :entity-count
|
||||||
|
(vm:while [:dup] :dec ; entity|0 i
|
||||||
|
:dup :lookup-entity :get :rtop :=
|
||||||
|
(vm:when :lookup-entity :swap)
|
||||||
|
) :drop :rdrop)
|
||||||
|
(vm.code:append :responder [:dw 0])
|
||||||
|
(vm:word :entity>do ; entity ev --
|
||||||
|
:over :lit :responder :dup :get :>r :set
|
||||||
|
:swap 2 :+ :get :execute
|
||||||
|
:r> :lit :responder :set)
|
||||||
|
|
||||||
|
(vm:word :touch-entity ; yx -- f
|
||||||
|
:entity-at :dup (vm:when ev.touch :entity>do 1)))
|
||||||
|
|
||||||
|
(fn append-from-map [map entity-org]
|
||||||
|
(each [_ entity (ipairs map.objects)]
|
||||||
|
(when entity.name
|
||||||
|
(entity-org:append entity.name))
|
||||||
|
(entity-org:append
|
||||||
|
[:db (- entity.x 1)] [:db (- entity.y 1)]
|
||||||
|
[:ref entity.func]
|
||||||
|
[:ref (if (and entity.linkword (> (length entity.linkword) 0)) entity.linkword :lit)]
|
||||||
|
(if entity.link [:dw (+ entity-org.org (* entity.link 8))] [:dw 0]))))
|
||||||
|
|
||||||
|
{: ev : install : append-from-map}
|
||||||
|
|
|
@ -2,13 +2,16 @@
|
||||||
(local asm (require :asm.asm))
|
(local asm (require :asm.asm))
|
||||||
(local VM (require :asm.vm))
|
(local VM (require :asm.vm))
|
||||||
(local tile (require :game.tiles))
|
(local tile (require :game.tiles))
|
||||||
|
(local entity (require :game.entity))
|
||||||
(local link (require :link))
|
(local link (require :link))
|
||||||
(local {: lo : hi} (require :lib.util))
|
(local {: lo : hi : readjson} (require :lib.util))
|
||||||
(local {: walkable} tile.flag-to-bit)
|
(local {: walkable} tile.flag-to-bit)
|
||||||
(local prg (asm.new))
|
(local prg (asm.new))
|
||||||
|
|
||||||
(local tiles-org (prg:org 0x4100))
|
(local tiles-org (prg:org 0x4100))
|
||||||
|
(local map-org (prg:org 0x4800))
|
||||||
(local font-org (prg:org 0x4900))
|
(local font-org (prg:org 0x4900))
|
||||||
|
(local entity-org (prg:org 0x4b00))
|
||||||
(local vm (VM.new prg))
|
(local vm (VM.new prg))
|
||||||
(local code1 vm.code)
|
(local code1 vm.code)
|
||||||
(local mapw 20)
|
(local mapw 20)
|
||||||
|
@ -280,8 +283,12 @@
|
||||||
(vm:word :handle-key :read-key :move-jaye)
|
(vm:word :handle-key :read-key :move-jaye)
|
||||||
(vm:word :bump-jaye ; dir yx -- yx
|
(vm:word :bump-jaye ; dir yx -- yx
|
||||||
:dup :>rot :yx+ ; yxold yxnew
|
:dup :>rot :yx+ ; yxold yxnew
|
||||||
|
:dup :touch-entity :not
|
||||||
|
(vm:when
|
||||||
:dup :itile-at :lookup-flags ; yxold yxnew flags
|
:dup :itile-at :lookup-flags ; yxold yxnew flags
|
||||||
walkable :& (vm:if [:swap :drop] [:drop]))
|
walkable :& (vm:when :swap)
|
||||||
|
)
|
||||||
|
:drop)
|
||||||
|
|
||||||
(vm:word :move-jaye ; key --
|
(vm:word :move-jaye ; key --
|
||||||
:movement-dir :dup (vm:if [
|
:movement-dir :dup (vm:if [
|
||||||
|
@ -352,11 +359,13 @@
|
||||||
(table.insert result :dismiss-dialog)
|
(table.insert result :dismiss-dialog)
|
||||||
result)
|
result)
|
||||||
|
|
||||||
|
(entity.install vm entity-org)
|
||||||
(vm:word :hello-world
|
(vm:word :hello-world
|
||||||
|
entity.ev.touch := (vm:when
|
||||||
(with-footer
|
(with-footer
|
||||||
(say :jaye "THAT WAS AN EARTHQUAKE!")
|
(say :jaye "THAT WAS AN EARTHQUAKE!")
|
||||||
(say :neut "GOLLY GEE JAYE, YOU'RE RIGHT!" "WHAT ARE WE GONNA DO??")
|
(say :neut "GOLLY GEE JAYE, YOU'RE RIGHT!" "WHAT ARE WE GONNA DO??")
|
||||||
(say :jaye "WE" "MUST" "NOT" "PANIC!!")))
|
(say :jaye "WE" "MUST" "NOT" "PANIC!!"))))
|
||||||
|
|
||||||
(tile.appendtiles tiles-org)
|
(tile.appendtiles tiles-org)
|
||||||
|
|
||||||
|
@ -365,8 +374,10 @@
|
||||||
; but REPL debug stub should be very available as a task
|
; but REPL debug stub should be very available as a task
|
||||||
|
|
||||||
; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with?
|
; 20x12 means full map is 240 bytes - we have an extra 16 bytes at the end to mess with?
|
||||||
(tile.appendmaps (prg:org 0x4800))
|
(local map (readjson "game/map00001.json"))
|
||||||
|
(tile.append-map map map-org)
|
||||||
(tile.appendgfx font-org (tile.loadgfx tile.fn-font))
|
(tile.appendgfx font-org (tile.loadgfx tile.fn-font))
|
||||||
|
(entity.append-from-map map entity-org)
|
||||||
|
|
||||||
(code1:append :main
|
(code1:append :main
|
||||||
[:jsr :reset]
|
[:jsr :reset]
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"func":"neutterm","x":17,"link":6,"y":8},{"func":"door","x":13,"y":9},{"func":"switch","x":13,"link":2,"y":8},{"func":"door","x":8,"y":6},{"func":"switch","x":7,"link":4,"y":6},{"func":"termtut","x":2,"link":1,"y":4},{"func":"scantut","x":9,"link":8,"y":1},{"x":10,"func":"exit","y":1,"name":"","linkword":""}]}
|
{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"x":7,"func":"hello-world","linkword":"","name":"","y":6}]}
|
|
@ -36,10 +36,9 @@
|
||||||
(set flags (bit.bor flags (. flag-to-bit flag))))
|
(set flags (bit.bor flags (. flag-to-bit flag))))
|
||||||
(org:append [:db flags])))
|
(org:append [:db flags])))
|
||||||
|
|
||||||
(fn appendmaps [org]
|
(fn append-map [map org]
|
||||||
(local map (util.readjson "game/map00001.json"))
|
(org:append :map [:bytes (map.map:fromhex)] :map-entity-count [:db (length map.objects)]))
|
||||||
(org:append :map [:bytes (map.map:fromhex)]))
|
|
||||||
|
|
||||||
{: loadgfx : savegfx : appendtiles : appendgfx : appendmaps : flags : flag-to-bit
|
{: loadgfx : savegfx : appendtiles : appendgfx : append-map : flags : flag-to-bit
|
||||||
: fn-tiles : fn-portraits : fn-font}
|
: fn-tiles : fn-portraits : fn-font}
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue