Working switch and door!

asm/vm.fnl

@@ -69,6 +69,8 @@
     :ST2  :0x7c
     :ST2H :0x7d
     :RSTACK :0x6000
+    :true 0xffff
+    :false 0
     :code code1
     :nextsymid 1
     :ret (fn [self] [:jmp :next])
@@ -347,6 +349,16 @@
       (if (= (type init) :table) init
           [:dw init])))
 
+  (vm:def :$doconst ; usage: [jsr :$doconst] followed by two bytes
+    (vm:reserve)
+    [:pla] [:sta vm.W] [:pla] [:sta vm.WH]
+    [:ldy 1] [:lda [vm.W] :y] [:sta vm.TOP]
+    [:iny] [:lda [vm.W] :y] [:sta vm.TOPH])
+
+  (fn vm.const [self name val]
+    (self.code:append name [:jsr :$doconst]
+      (if (= (type val) :number) [:dw val] [:ref val])))
+
   (fn vm.defer [self name ?init]
     (self.code:append name [:jmp (or ?init :next)]))
 
@@ -423,6 +435,11 @@
     [:lda vm.TOPH :x] [:and vm.ST1H :x] [:sta vm.ST1H :x]
     (vm:drop))
 
+  (vm:def :| ; a b -- c
+    [:lda vm.TOP :x] [:ora vm.ST1 :x] [:sta vm.ST1 :x]
+    [:lda vm.TOPH :x] [:ora vm.ST1H :x] [:sta vm.ST1H :x]
+    (vm:drop))
+
   vm)
 
 {:new mk-vm}

game/entity.fnl

@@ -1,10 +1,16 @@
-(local {: lo : hi} (require :lib.util))
+(local util (require :lib.util))
+(local tiles (util.require :game.tiles))
+
+(local {: lo : hi} util)
+(local itile
+  (let [tilelist (tiles.loadgfx tiles.fn-tiles)]
+    (fn [label] (tiles.find-itile tilelist label))))
 
 ; Entity memory layout:
 ; +0 - yx
 ; +2 - event handler
 ; +4 - link word
-; +6 - link data
+; +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)
@@ -33,13 +39,47 @@
       (vm:when :lookup-entity :swap)
     ) :drop :rdrop)
   (vm.code:append :responder [:dw 0])
+  (vm:word :get-responder :lit :responder :get)
+  (vm:word :responder-itile :get-responder :get :itile-at)
   (vm:word :entity>do ; entity ev --
     :over :lit :responder :dup :get :>r :set
     :swap 2 :+ :get :execute
     :r> :lit :responder :set)
 
+  (vm:word :linked-entity :get-responder :dup 4 :+ :get :dup (vm:if [:dup :. :execute] [:drop 6 :+ :dup :. :get]) :dup :.)
   (vm:word :touch-entity ; yx -- f
-    :entity-at :dup (vm:when ev.touch :entity>do 1)))
+    :entity-at :dup (vm:when ev.touch :entity>do vm.true))
+
+  (vm:word :set-entitytile ; e itile --
+    :swap :get :swap :update-itile)
+
+  (vm:word :set-respondertile ; itile --
+    :get-responder :get :swap :update-itile)
+
+  (vm:word :handle-onoff ; ev off on --
+    :<rot (vm:case
+      [ev.act :swap :drop :set-respondertile]
+      [ev.deact :drop :set-respondertile]
+      [ev.tog :dup :responder-itile := (vm:if [:drop :set-respondertile] [:set-respondertile :drop])]
+      [:else :drop :drop]))
+  (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 :dup :. := (vm:if [ev.act] [ev.deact])
+      :linked-entity :swap :entity>do
+    ] [:drop]))
+
+  (vm:word :door ; ev --
+    :dup :. :dup (vm:case
+      [ev.touch :drop :responder-itile (itile :dooropen) := (vm:when :move-player)]
+      [:else (itile :doorclosed) (itile :dooropen) :handle-onoff]))
+
+  (vm:word :switch ; ev --
+    :dup ev.touch := (vm:when :drop ev.tog)
+    :dup (itile :switchoff) (itile :switchon) :handle-onoff
+    (itile :switchon) :activate-link)
+  )
 
 (fn append-from-map [map entity-org]
   (each [_ entity (ipairs map.objects)]
@@ -48,8 +88,8 @@
     (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 (and entity.linkword (> (length entity.linkword) 0)) [:ref entity.linkword] [:dw 0])
-      (if entity.link [:dw (+ entity-org.org (* entity.link 8))] [:dw 0]))))
+      (if entity.link [:dw (+ entity-org.org (* (- entity.link 1) 8))] [:dw 0]))))
 
 {: ev : install : append-from-map}
 

game/init.fnl

@@ -1,10 +1,11 @@
+(local util (require :lib.util))
+(local {: lo : hi : readjson} util)
 (local lume (require :lib.lume))
 (local asm (require :asm.asm))
 (local VM (require :asm.vm))
-(local tile (require :game.tiles))
+(local tile (util.reload :game.tiles))
-(local entity (require :game.entity))
+(local entity (util.reload :game.entity))
 (local link (require :link))
-(local {: lo : hi : readjson} (require :lib.util))
 (local {: walkable} tile.flag-to-bit)
 (local prg (asm.new))
 
@@ -197,7 +198,7 @@
   [:ldy 0] [:lda [vm.W] :y]
   [:sta vm.TOP :x])
 
-(vm:def :itile-at ; yx -- itile
+(vm:def :map-at ; yx -- pmap
   [:lda (- maph 1)]
   [:sec]
   [:sbc vm.TOPH :x]
@@ -210,11 +211,12 @@
   [:adc vm.TOP :x]
   [:sta vm.TOP :x]
   [:lda #(hi ($1:lookup-addr :map))]
-  [:sta vm.TOPH :x]
-  [:lda [vm.TOP :x]]
-  [:sta vm.TOP :x]
-  [:lda 0]
   [:sta vm.TOPH :x])
+(vm:word :itile-at ; yx -- itile
+  :map-at :bget)
+
+(vm:word :update-itile ; yx itile --
+  :over :map-at :bset :drawtile-at)
 
 (vm:word :drawtile-at ; yx --
   :dup :yx>screen :swap
@@ -281,23 +283,27 @@
   :yx>screen :jaye-tile :drawtile)
 
 (vm:word :handle-key :read-key :move-jaye)
-(vm:word :bump-jaye ; dir yx -- yx
+(vm:word :bump-jaye ; dir yx --
-  :dup :>rot :yx+ ; yxold yxnew
+  :yx+ ; yxnew
   :dup :touch-entity :not
-  (vm:when
+  (vm:if
-    :dup :itile-at :lookup-flags ; yxold yxnew flags
+    [:dup :itile-at :lookup-flags ; yxnew flags
-    walkable :& (vm:when :swap)
+     walkable :& (vm:if [:move-player-to] [:drop])]
-  )
+    [:drop]))
-  :drop)
+
+(vm:word :move-player-to ; yx --
+  :jaye-yx :get :drawtile-at
+  :dup :jaye-yx :set
+  :yx>screen :jaye-tile :drawtile)
+
+(vm:word :move-player ; --
+  :jaye-dir :get :jaye-yx :get :yx+ :move-player-to)
 
 (vm:word :move-jaye ; key --
   :movement-dir :dup (vm:if [
     :dup :jaye-dir :set ; dir
     :jaye-yx :get       ; dir yx
-    :dup :drawtile-at   ; dir yx
+    :bump-jaye
-    :bump-jaye          ; yx
-    :dup :jaye-yx :set  ; yx
-    :draw-jaye-yx       ;
   ] [:drop]))
 
 (vm:word :full-redraw :drawmap :object-redraw)

game/map00001.json

@@ -1 +1 @@
-{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"x":7,"func":"hello-world","linkword":"","name":"","y":6}]}
+{"map":"212121214121212121212121212141212121212161026161610261616102616161616102616161216143C0C0E2C0C0C0C0C0C06361C0C0C0C0C0612161C0C0A282C0C0C0A2C0C0C081C0C0C0C0C2024161C0C0C0C0C0C0C0C0C2C0A2C1A2C0C0E082612161E2C08282C0C0C0C0A2C0C06161616161616121616161616161C181616161616143C0C0E282612161C0C0C0C0C0C0C0C0C0C0C061C0C0C0C0C0022161E08282A2C0C0C0C0E2C0C081C0C0C0C003612161E2C2C2C0C0C0C0C0C0C0C061C0C0C0C0C06141610303C063E2C0C0C0C0C0C061C0C0C023C061216161616161616161228161616161616161610221","objects":[{"x":7,"link":2,"func":"switch","linkword":"","name":"","y":6},{"x":8,"func":"door","linkword":"","name":"","y":6}]}

game/tiles.fnl

@@ -39,6 +39,14 @@
 (fn append-map [map org]
   (org:append :map [:bytes (map.map:fromhex)] :map-entity-count [:db (length map.objects)]))
 
-{: loadgfx : savegfx : appendtiles : appendgfx : append-map : flags : flag-to-bit
+(fn find-itile [tiles label ?itilenext]
+  (local itile (or ?itilenext 1))
+  (local tile (. tiles itile))
+  (assert (not= tile nil) (.. "No such tile " label))
+  (if (= tile.label label)
+      (bit.bor (bit.lshift (bit.band (- itile 1) 0x07) 5) (bit.rshift (bit.band (- itile 1) 0xf8) 3))
+    (find-itile tiles label (+ itile 1))))
+
+{: loadgfx : savegfx : appendtiles : appendgfx : append-map : flags : flag-to-bit : find-itile
  : fn-tiles : fn-portraits : fn-font}
 

game/tiles.json

@@ -1 +1 @@
-[{"gfx":"7F7F1F03090923436943230909031F7F7F7F784111104542174245101141787F","word":"","label":"neut1","flags":[]},{"gfx":"7F1F03090923436943230909031F7F7F7F784111104542174245101141787F7F","word":"","label":"neut2","flags":[]},{"gfx":"808080C0C0C0E0C0D0C8C04040404080808083058585828A9282820A08081980","word":"","label":"jaye-e","flags":[]},{"gfx":"8080C020A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","word":"","label":"jaye-w","flags":[]},{"gfx":"8080E030B0B098C0D0D0C840404060808080870D8D8D99828A8A920202020780","word":"","label":"jaye-s","flags":[]},{"gfx":"8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","word":"","label":"jaye-n","flags":[]},{"gfx":"80808C8080808080B08080808C808080808C80808083B0808080808080868080","word":"","label":"","flags":{"walkable":true}},{"word":"term","gfx":"007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979584848400","flags":[]},{"gfx":"007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979584848400","word":"term","label":"","flags":{"neutable":true}},{"gfx":"D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","word":"","label":"","flags":[]},{"word":"","gfx":"D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","flags":[]},{"gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF","word":"","label":"","flags":{"neutable":true}},{"word":"door","gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","flags":[]},{"gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","word":"door","label":"","flags":{"walkable":true}},{"word":"switch","gfx":"FFFFCFCFCFCF898183838787878FFFFFFFFCE4E4E4E4E0E0E0E0E0E0F0F8FFFF","flags":{"neutable":true}},{"word":"switch","gfx":"FFFFCFCFCFCF898123232727878FFFFFFFFCE4E4E4E0E0616565656571F8FFFF","flags":{"neutable":true}},{"flags":[],"gfx":"FFFF83D3D3D3D3D3D3D3D3D3D383FFFFFFFFC0CACACECACBCACACACACAC0FFFF"},{"word":"scan","gfx":"FFFFAFEBFBFBFBBBBBFBFBFBEBAFFFFFFFFFF5D7DFDFDFDDDDDFDFDFD7F5FFFF","flags":{"neutable":true}},{"word":"scan","gfx":"FFFF2F2B2B2B6B6B6B6B2B2B2B2FFFFFFFFF755555555757575755555575FFFF","flags":{"neutable":true}},{"flags":[],"gfx":"FFF3C78FBFFCF98187BFFFFFBF9F9FC7FFCFE1F1FCFCF8FEFEFCF9F0E6CE8F9F"},{"flags":[],"gfx":"80808C80808080A8AAAAAAA888888880808C8080808380859595958584848480"},{"flags":{"debris":true},"gfx":"80808C8080A0A0A8AAAA8AA0A8808080808C8081919090848594959585858080"},{"word":"","gfx":"00005054545450404054545010383800000C0A2A2A2A0A03032A2A0A081C1C00","flags":[]},{"word":"","gfx":"0000001C1C10545040606010545454000030070702020A0A0100020A080A0200","flags":{"debris":true}},{"word":"","gfx":"80A0A8AA92D2D2AAC2C2AA92D2AA808080959595949494959494959494858080","flags":[]},{"word":"","gfx":"80808C808080A8C292AAAAAAAA8AC0D0808C80808083959290959194948580A8","flags":{"debris":true}},{"word":"","gfx":"80806008282A0800202880A8A8A8A08080980000141501051511819595958580","flags":[]},{"word":"","gfx":"80808C808080A0A8AAAA8AA2AAAAAA80808C0000000330010105051511010514","flags":{"debris":true}},{"gfx":"0000000000000000000000000000000000000000000000000000000000000000","word":"","label":"","flags":[]}]
+[{"gfx":"7F7F1F03090923436943230909031F7F7F7F784111104542174245101141787F","word":"","label":"neut1","flags":[]},{"gfx":"7F1F03090923436943230909031F7F7F7F784111104542174245101141787F7F","word":"","label":"neut2","flags":[]},{"gfx":"808080C0C0C0E0C0D0C8C04040404080808083058585828A9282820A08081980","word":"","label":"jaye-e","flags":[]},{"gfx":"8080C020A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","word":"","label":"jaye-w","flags":[]},{"gfx":"8080E030B0B098C0D0D0C840404060808080870D8D8D99828A8A920202020780","word":"","label":"jaye-s","flags":[]},{"gfx":"8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780","word":"","label":"jaye-n","flags":[]},{"gfx":"80808C8080808080B08080808C808080808C80808083B0808080808080868080","word":"","label":"","flags":{"walkable":true}},{"gfx":"007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979584848400","word":"term","label":"","flags":[]},{"gfx":"007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979584848400","word":"term","label":"","flags":{"neutable":true}},{"gfx":"D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA","word":"","label":"","flags":[]},{"gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF","word":"","label":"","flags":{"neutable":true}},{"gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","word":"door","label":"doorclosed","flags":[]},{"gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","word":"door","label":"dooropen","flags":{"walkable":true}},{"gfx":"FFFFCFCFCFCF898183838787878FFFFFFFFCE4E4E4E4E0E0E0E0E0E0F0F8FFFF","word":"switch","label":"switchoff","flags":{"neutable":true}},{"gfx":"FFFFCFCFCFCF898123232727878FFFFFFFFCE4E4E4E0E0616565656571F8FFFF","word":"switch","label":"switchon","flags":{"neutable":true}},{"gfx":"FFFF83D3D3D3D3D3D3D3D3D3D383FFFFFFFFC0CACACECACBCACACACACAC0FFFF","word":"","label":"","flags":[]},{"gfx":"FFFFAFEBFBFBFBBBBBFBFBFBEBAFFFFFFFFFF5D7DFDFDFDDDDDFDFDFD7F5FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFFF2F2B2B2B6B6B6B6B2B2B2B2FFFFFFFFF755555555757575755555575FFFF","word":"scan","label":"","flags":{"neutable":true}},{"gfx":"FFF3C78FBFFCF98187BFFFFFBF9F9FC7FFCFE1F1FCFCF8FEFEFCF9F0E6CE8F9F","word":"","label":"","flags":[]},{"gfx":"80808C80808080A8AAAAAAA888888880808C8080808380859595958584848480","word":"","label":"","flags":[]},{"gfx":"80808C8080A0A0A8AAAA8AA0A8808080808C8081919090848594959585858080","word":"","label":"","flags":{"debris":true}},{"gfx":"00005054545450404054545010383800000C0A2A2A2A0A03032A2A0A081C1C00","word":"","label":"","flags":[]},{"gfx":"0000001C1C10545040606010545454000030070702020A0A0100020A080A0200","word":"","label":"","flags":{"debris":true}},{"gfx":"80A0A8AA92D2D2AAC2C2AA92D2AA808080959595949494959494959494858080","word":"","label":"","flags":[]},{"gfx":"80808C808080A8C292AAAAAAAA8AC0D0808C80808083959290959194948580A8","word":"","label":"","flags":{"debris":true}},{"gfx":"80806008282A0800202880A8A8A8A08080980000141501051511819595958580","word":"","label":"","flags":[]},{"gfx":"80808C808080A0A8AAAA8AA2AAAAAA80808C0000000330010105051511010514","word":"","label":"","flags":{"debris":true}},{"gfx":"0000000000000000000000000000000000000000000000000000000000000000","word":"","label":"","flags":[]}]