SpindleyQ/honeylisp
1
1
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Implement player movement, VM variables, if, case

Browse source
This commit is contained in:
Jeremy Penner 2020-11-14 21:55:50 -05:00
parent 4a2548e214
commit 0d7effa024
6 changed files with 120 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
asm/vm.fnl
View file

@ -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]
:end])
[:ref :jmp] [:ref :_start]
:_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

6
editor/tileedit.fnl
View file

@ -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))

87
game/init.fnl
View file

@ -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
:cleargfx ; :drawmap
[:vm :hires
:full-redraw
(vm:forever
(vm:hotswap-sync) :drawmap
(vm:hotswap-sync) :handle-key
)
; 0x0000 :tile>screen 0 :lookup-tile :drawtile
:quit])
(prg:assemble)

1
game/tiles.fnl
View file

@ -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]

2
game/tiles.json
View file

@ -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":[]}]

2
link/mame.fnl
View file

@ -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)