Implement player movement, VM variables, if, case

asm/vm.fnl

@@ -288,22 +288,50 @@
 
   (fn vm.while [self preamble ...]
     [:block
-      :start
+      :_start
         [:vm (table.unpack preamble)]
-        [:ref :bz] [:ref :end]
+        [:ref :bz] [:ref :_end]
         [:vm ...]
-        [:ref :jmp] [:ref :start]
+        [:ref :jmp] [:ref :_start]
-      :end])
+      :_end])
 
   (fn vm.until [self ...]
-    [:block :start [:vm ...] [:ref :bz] [:ref :start]])
+    [:block :_start [:vm ...] [:ref :bz] [:ref :_start]])
 
   (fn vm.forever [self ...]
-    [:block :start [:vm ...] [:vm :jmp :start]])
+    [:block :_start [:vm ...] [:vm :jmp :_start]])
 
   (fn vm.for [self ...]
     [:vm :>r (vm:while [:rtop] :r> :dec :>r ...) :rdrop])
 
+  (fn vm.when [self ...]
+    [:block [:vm :bz :_end ...] :_end])
+
+  (fn vm.if [self iftrue iffalse]
+    [:block [:vm :bz :_else (table.unpack iftrue)] [:vm :jmp :_end] :_else [:vm (table.unpack iffalse)] :_end])
+
+  (fn vm.case [self ...]
+    (local block [:block])
+    (local cases [...])
+    (each [icase [case & action] (ipairs cases)]
+      (table.insert block (.. :_case icase))
+      (if (< icase (length cases))
+          (do (table.insert block [:vm :dup case := :bz (.. :_case (+ 1 icase)) :drop (table.unpack action)])
+              (table.insert block [:vm :jmp :_end]))
+          (do (table.insert block [:vm :drop (table.unpack action)])
+              (table.insert block :_end))))
+    block)
+
+  (vm:def :$dovar ; usage: [jsr :$dovar] followed by reserved space
+    (vm:reserve)
+    [:pla] [:sta vm.TOP :x] [:pla] [:sta vm.TOPH :x]
+    (inc16-stk vm.TOP vm.TOPH))
+
+  (fn vm.var [self name init]
+    (self.code:append name [:jsr :$dovar]
+      (if (= (type init) :table) init
+          [:dw init])))
+
   (vm:def :+ ; a b -- c
     [:clc]
     [:lda vm.ST1 :x] [:adc vm.TOP :x] [:sta vm.ST1 :x]
@@ -343,7 +371,7 @@
       [:cmp vm.TOP :x]
       [:bne :noteq]
       [:lda vm.ST1H :x]
-      [:cmp vm.TOP :x]
+      [:cmp vm.TOPH :x]
       [:bne :noteq]
       [:lda 0xff] (vm:drop) [:sta vm.TOP :x] [:sta vm.TOPH :x] (vm:ret)
      :noteq

editor/tileedit.fnl

@@ -72,9 +72,11 @@
 
 (fn TileView.draw-tile-flags [self x y]
   (local tile (-?> self.tilecache.tiles (. self.itile)))
-  (when tile (set tile.word (textfield self "Default word" tile.word x y 100 200)))
+  (when tile
+    (set tile.word (textfield self "Default word" tile.word x y 100 200))
+    (set tile.label (textfield self "Label" tile.label x (+ y pixel-size 4) 100 200)))
   (each [iflag flagname (ipairs tiles.flags)]
-    (self:draw-tile-flag flagname x (+ y (* iflag (+ pixel-size 4))))))
+    (self:draw-tile-flag flagname x (+ y (* (+ iflag 1) (+ pixel-size 4))))))
 
 (fn TileView.update-tile [self newtile]
   (self.tilecache:update-tile self.itile newtile))

game/init.fnl

@@ -11,6 +11,8 @@
 (local tiles (prg:org 0x4100))
 (local vm (VM.new prg))
 (local code1 vm.code)
+(local mapw 20)
+(local maph 12)
 
 (local mon {
   :hexout :0xfdda
@@ -49,7 +51,7 @@
   [:sta :0xc057]
   [:sta :0xc052])
 
-(vm:def :mixed [:sta :0xc051])
+(vm:def :mixed [:sta :0xc053])
 
 ; starting address:
 ; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
@@ -57,7 +59,7 @@
 ; y between 0-12
 ; yx - 16-bit value, low byte x, high byte y
 (code1:append :screeny-lookup [:bytes "\0\040\080"])
-(vm:def :tile>screen ; yx -- p
+(vm:def :yx>screen ; yx -- p
   [:lda vm.TOPH :x]         ; a=y
   [:lsr :a] [:lsr :a]       ; a=y/4
   [:tay]                    ; y=y/4
@@ -126,13 +128,13 @@
   (vm:drop))
 
 (vm:word :drawmaprow ; pscreen pmap -- pmap
-  20 (vm:for
+  mapw (vm:for
     :2dup :bget :lookup-tile :drawtile
     :inc :swap :inc :inc :swap) :swap :drop)
 
 (vm:word :drawmap
   :lit :map 0x0c00 (vm:until 0x100 :-
-    :dup :tile>screen ; pmap yx pscreen
+    :dup :yx>screen ; pmap yx pscreen
     :<rot :drawmaprow :swap ; pmap yx
   :dup :not) :drop :drop)
 
@@ -141,11 +143,79 @@
   ; we save some cycles by storing the indices as lllhhhhh, so we don't need to shift them'
   [:lda vm.TOP :x] [:tay]
   [:and 0x1f]
-  [:clc] [:adc #(hi tiles.org)]
+  [:clc] [:adc #(do (pp tiles) (hi tiles.org))]
   [:sta vm.TOPH :x]
   [:tya] [:and 0xe0]
   [:sta vm.TOP :x])
 
+(vm:word :drawtile-at ; xy --
+  :drop) ; todo
+
+(vm:def :last-key ; -- key
+  (vm:reserve)
+  [:lda :0xc000]
+  [:and 0x7f]
+  [:sta vm.TOP :x]
+  [:lda 0]
+  [:sta vm.TOPH :x])
+
+(vm:def :read-key ; -- key|0
+  [:block
+    (vm:reserve)
+    [:lda :0xc000]
+    [:bmi :key-pressed]
+    [:lda 0]
+    [:sta vm.TOP :x]
+    [:sta vm.TOPH :x]
+    (vm:ret)
+  :key-pressed
+    [:and 0x7f]
+    [:sta vm.TOP :x]
+    [:lda 0]
+    [:sta vm.TOPH :x]
+    [:sta :0xc010]])
+
+(vm:word :movement-dir ; key -- dyx
+  (vm:case [(string.byte "I") 0xff00]
+           [(string.byte "J") 0x00ff]
+           [(string.byte "K") 0x0001]
+           [(string.byte "M") 0x0100]
+           [:else             0x0000]))
+
+(vm:def :yx+ ; yx yx -- yx
+  [:lda vm.TOP :x]
+  [:clc] [:adc vm.ST1 :x]
+  [:sta vm.ST1 :x]
+  [:lda vm.TOPH :x]
+  [:clc] [:adc vm.ST1H :x]
+  [:sta vm.ST1H :x]
+  (vm:drop))
+
+(vm:var :jaye-yx 0x090a)
+(vm:var :jaye-dir 0xff00)
+
+(vm:word :jaye-tile ; ptile
+  :jaye-dir :get
+  (vm:case [0xff00 :lit :jaye-n]
+           [0x0100 :lit :jaye-s]
+           [0x00ff :lit :jaye-w]
+           [:else  :lit :jaye-e]))
+
+(vm:word :draw-jaye-yx ; yx --
+  :yx>screen :jaye-tile :drawtile)
+
+(vm:word :handle-key :read-key :move-jaye)
+(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
+    :yx+                ; yx
+    :dup :jaye-yx :set  ; yx
+    :draw-jaye-yx       ;
+  ] [:drop]))
+
+(vm:word :full-redraw :cleargfx :drawmap :jaye-yx :get :draw-jaye-yx)
 (tile.appendtiles (tile.loadtiles) tiles)
 
 ; thought:
@@ -158,12 +228,11 @@
 (code1:append :main
   [:jsr :reset]
   [:jsr :interpret]
-  [:vm :hires ; :mixed
+  [:vm :hires
-    :cleargfx ; :drawmap
+    :full-redraw
     (vm:forever
-      (vm:hotswap-sync) :drawmap
+      (vm:hotswap-sync) :handle-key
     )
-;    0x0000 :tile>screen 0 :lookup-tile :drawtile
     :quit])
 
 (prg:assemble)

game/tiles.fnl

@@ -15,6 +15,7 @@
 
 (fn appendtiles [tiles org]
   (each [_ tile (ipairs tiles)]
+    (when tile.label (org:append tile.label))
     (org:append [:bytes tile.gfx])))
 
 (fn appendmaps [org]

game/tiles.json

@@ -1 +1 @@
-[{"word":"","gfx":"000000020A0820406A4020080A02000000010141511005025702051051410100","flags":[]},{"flags":[],"gfx":"00000000020A0820406A4020080A020000000101415110050257020510514101"},{"flags":[],"gfx":"808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980"},{"flags":[],"gfx":"8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380"},{"flags":[],"gfx":"8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780"},{"flags":[],"gfx":"8080C0E0E0E0B0C0D0C8C040404060808080838787878D828A92820202020780"},{"word":"","gfx":"80808C8080808080B08080808C808080808C80808083B0808080808080868080","flags":{"walkable":true}},{"word":"term","gfx":"007C0C0C0C0C7C007C7E7EAA88888800001F181818181F001F0F979584848400","flags":[]},{"word":"term","gfx":"007C2C0C0C2C7C007C7E7EAA88888800001F18191C191F001F0F979584848400","flags":{"neutable":true}},{"flags":[],"gfx":"D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5D5AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"},{"flags":[],"gfx":"D5D5D5D5D5F5F5FDDDD5D5D5D5D5D5D5AAAAAAAAAEAEBFBFBFABAAAAAAAAAAAA"},{"flags":{"neutable":true},"gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"},{"word":"door","gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","flags":[]},{"word":"door","gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","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":"000000020A0820406A4020080A02000000010141511005025702051051410100","word":"","label":"","flags":[]},{"word":"","gfx":"00000000020A0820406A4020080A020000000101415110050257020510514101","flags":[]},{"gfx":"808080C0C0C0E0C0D0C8C04040404080808083858585828A9282820A08081980","word":"","label":"jaye-e","flags":[]},{"gfx":"8080C0A0A0A0C0C0D0C8C0501010188080808183838782828A8A920202020380","word":"","label":"jaye-w","flags":[]},{"gfx":"8080E0B0B0B098C0D0D0C840404060808080878D8D8D99828A8A920202020780","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":[]},{"word":"","gfx":"FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF","flags":{"neutable":true}},{"word":"door","gfx":"FF8FA7B3B3B3B3B3B3B3B3B3B3B383FFFFF8F2E6E6E6E6E6E6E6E6E6E6E6E0FF","flags":[]},{"word":"door","gfx":"FF8F87838383838383838383838383FFFFF8F0E0E0E0E0E0E0E0E0E0E0E0E0FF","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":[]}]

link/mame.fnl

@@ -87,7 +87,7 @@
           (mem:write_u8 (+ addr i -1) (string.byte (bytes:sub i i)))))"
     (bencode.encode {: addr : bytes})))
 (fn Machine.launch [self prg]
-  (self:eval (string.format "(emu.keypost \"CALL-151\n%xG\n\")" (prg:lookup-addr prg.start-symbol))))
+  (self:eval (string.format "(emu.keypost \"CALL-151\\n %xG\\n\")" (prg:lookup-addr prg.start-symbol))))
 (fn Machine.reboot [self] (self:eval "(: (manager:machine) :soft_reset)"))
 (fn Machine.coro-eval [self code]
   (var result nil)