honeylisp/game/entity.fnl

111 lines
3.5 KiB
Fennel

(local util (require :lib.util))
(local tiles (util.require :game.tiles))
(local {: vm : org : itile : say : say-runon : controlstate} (require :game.defs))
(local {: lo : hi} util)
; Entity memory layout:
; +0 - yx
; +2 - event handler
; +4 - link word
; +6 - link pointer
; 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)
; The entity count for a level is stored after the map.
(local ev {
:touch 0
:noop -1
})
(vm:def :lookup-entity ; i -- entity
[:lda vm.TOP :x]
[:asl :a] [:asl :a] [:asl :a] ; x8
[:sta vm.TOP :x]
[:lda :map-page] [:clc] [:adc 1]
[: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:var :responder 0)
(vm:word :get-responder :responder :get)
(vm:word :entity-itile :get :itile-at)
(vm:word :responder-itile :get-responder :entity-itile)
(vm:word :entity>do ; entity ev --
:over :responder :dup :get :>r :set
:swap 2 :+ :get :execute
:r> :responder :set)
(vm:word :link-arg ; e -- a
6 :+ :get)
(vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:execute] [:drop :link-arg]))
(vm:word :entity-at>do ; yx ev -- f
:>r :entity-at :dup (vm:if [:r> :entity>do vm.true] [:rdrop]))
(vm:word :touch-entity ; yx -- f
ev.touch :entity-at>do)
(vm:word :untouch-entity ; yx --
ev.untouch :entity-at>do :drop)
(vm:word :entity-around>do ; yx ev --
:over 0x0100 :yx+ :over :entity-at>do :drop
:over 0x0001 :yx+ :over :entity-at>do :drop
:over 0xff00 :yx+ :over :entity-at>do :drop
:swap 0x00ff :yx+ :swap :entity-at>do :drop)
(vm:word :set-entitytile ; e itile --
:swap :get :swap :update-itile)
(vm:word :set-respondertile ; itile --
:get-responder :get :swap :update-itile)
; run only when processing an ev.touch event
(vm:word :transparent-entity-move ; -- f
:get-responder :get :dup :handle-general-move
:swap :over :not (vm:if [:move-player-to] [:drop]))
(vm:var :pre-handled-tile 0)
(vm:var :pre-handled-ev 0)
(vm:word :handle-onoff ; ev off on --
:responder-itile :pre-handled-tile :set :<rot
:dup ev.tog := (vm:when
:drop :dup :responder-itile := (vm:if [ev.deact] [ev.act])
) :dup :pre-handled-ev :set (vm:case
[ev.act :swap :drop :set-respondertile]
[ev.deact :drop :set-respondertile]
[:else :drop :drop]))
(vm:word :on-handled ; xp-on xp-off --
:responder-itile :pre-handled-tile :get := (vm:if
[:drop :drop]
[:pre-handled-ev :get ev.act :=
(vm:if [:drop] [:swap :drop]) :execute]))
(vm:word :activation-ev? ; ev -- f
:dup ev.act := :over ev.deact := :| :swap ev.tog := :|)
(vm:word :activate-link ; ev itile-on --
:swap :activation-ev? (vm:if [
:responder-itile := (vm:if [ev.act] [ev.deact])
:linked-entity :swap :entity>do
] [:drop]))
(vm:word :move-to-responder :get-responder :get :move-player-to)
(fn append-from-map [map entity-org prefix]
(entity-org:append [:align 0x100])
(each [ientity entity (ipairs map.objects)]
(when entity.name
(entity-org:append entity.name))
(entity-org:append
(.. prefix "-entity-" ientity)
[:db (- entity.x 1)] [:db (- entity.y 1)]
[:ref entity.func]
(if (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
(if entity.link [:ref (.. prefix "-entity-" entity.link)]
entity.linkentity [:ref entity.linkentity]
[:dw 0]))))
{: ev : append-from-map}