(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) ; 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 :untouch 1 :act 2 :deact 3 :tog 4 :hack 5 :noop 6 }) (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:word :handle-onoff ; ev off on -- :do ] [:drop])) (vm:word :walking-through-door ; ev -- ev f (vm:if-and [[:is-walking?] [:dup ev.touch :=] [:responder-itile (itile :dooropen) :=]] [vm.true] [vm.false])) (vm:word :door ; ev -- :walking-through-door (vm:if [:move-to-responder :drop] [(itile :doorclosed) (itile :dooropen) :handle-onoff])) (vm:word :exitlevel ; e -- :link-arg :next-level :set) (vm:word :exitdoor ; ev -- :walking-through-door (vm:if [:drop (vm:ifchain [:gord-sitting :get] [(say :jaye "I'M NOT LEAVING GORD BEHIND.")] [:libb-hidden? :not] [(say :neut "IT IS INADVISABLE TO LEAVE THIS" "AREA WITHOUT RETRIEVING LIBB")] [:move-to-responder :linked-entity])] [:door])) (vm:word :move-to-responder :get-responder :get :move-player-to) (vm:word :switch ; ev -- (vm:if-and [[:is-rexx? :not] [:dup ev.touch :=]] [:drop ev.tog :is-neut? (vm:when :move-to-responder)]) :dup (itile :switchoff) (itile :switchon) :handle-onoff (itile :switchon) :activate-link) (vm:var :disconnected-term-attempt vm.false) (vm:word :term ; ev -- :dup ev.touch := (vm:when (vm:ifchain [:is-jaye?] [:drop ev.act] [:is-neut?] [:responder-itile (itile :termon) := (vm:when :linked-entity :dup :entity-itile (itile :termon) := (vm:if [:get :move-player-to] [:drop (say :neut "DESTINATION TERMINAL" "IS DISCONNECTED") :disconnected-term-attempt :get :not (vm:when vm.true :disconnected-term-attempt :set (say :neut "PLEASE CONTACT YOUR" "SYSTEM ADMINISTRATOR") (say :neut "THIS INCIDENT HAS" "BEEN REPORTED"))]))] [])) (itile :termoff) (itile :termon) :handle-onoff) (vm:word :handle-scan ; ev -- :dup (itile :scanoff) (itile :scanon) :handle-onoff :linked-entity :swap :entity>do) (vm:word :libb-on-responder :libb-yx :get :get-responder :get :=) (vm:word :scan ; ev -- :is-neut? (vm:if [ (vm:case [ev.touch ev.act :handle-scan :libb-on-responder (vm:when controlstate.libb :controlstate :bset 0xffff :move-player-to controlstate.neut :controlstate :bset) :move-to-responder] [ev.untouch :libb-on-responder :not (vm:when ev.deact :handle-scan)] [ev.hack vm.true :hack-handled :set ev.act :handle-scan controlstate.libb :controlstate :bset :move-to-responder controlstate.neut :controlstate :bset (say :neut "NO SWEAT.")] [:else]) ] [:drop])) (vm:word :rexx ; ev -- ev.touch := (vm:when (vm:if-and [[:is-neut?] [:responder-itile (itile :t-rexx) :=]] [0xffff :move-player-to (itile :t-rexxstop) :set-respondertile :get-responder :set-rexx] [(vm:if-and [[:is-rexx?] [:responder-itile (itile :t-rexxstop) :=]] [0xffff :move-player-to (itile :t-rexx) :set-respondertile 0 :set-rexx :move-to-responder])]))) (vm:word :read-digit ; -- digit (vm:while [:read-key :dup 0x3a :< :over 0x30 :>= :& :not] :drop) 0x30 :-) (vm:word :keypad-digit ; pscreen -- n :read-digit :swap :over :draw-digit) (vm:word :next-digit ; pscreen n -- pscreen n :shl4 :over :keypad-digit :+ :swap 1 :+ :swap) (vm:word :draw-single-keypad-hash ; pscreen -- pscreen :dup (string.byte "#") :draw-char 1 :+) (vm:word :read-keypad ; -- n 0x23e2 :dup :draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :draw-single-keypad-hash :drop 0 :next-digit :next-digit :next-digit :next-digit :swap :drop :cleartext) (vm:word :keypad ; ev code -- :>r :dup ev.touch := (vm:when :is-jaye? (vm:when :responder-itile (itile :t-keyoff) := (vm:if [(say-runon :pady "ENTER YOUR 4-DIGIT DOOR CODE!" "AND HAVE A SUPER DAY!") :read-keypad :rtop := (vm:if [(say :pady "THAT'S RIGHT! HOORAY!" "YOU GET A GOLD STAR!") :drop ev.act] [(say :pady "OHHH, SORRY! THAT'S NOT IT." "BETTER LUCK NEXT TIME!")])] [(say :pady "OH HI AGAIN! I MISSED YOU TOO!")])) :is-neut? (vm:when :move-to-responder)) :rdrop :dup :evhack? (vm:when :drop ev.act) :dup (itile :t-keyoff) (itile :t-keyon) :handle-onoff (itile :t-keyon) :activate-link) (vm:var :hack-handled vm.false) (vm:word :evhack? ; e -- f ev.hack := (vm:if [vm.true :hack-handled :set vm.true] [vm.false])) (vm:word :trigger-sidekick (vm:if-and [[:is-jaye?] [:gord-sitting :get]] [:gord-yx :get ev.touch :entity-around>do] [(vm:if-and [[:is-neut?] [:libb-present :get] [:libb-hidden?]] [vm.false :hack-handled :set :neut-yx :get ev.hack :entity-at>do :drop :hack-handled :get :not (vm:when (say :libb "DON'T THINK I CAN HACK THAT."))])])) (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}