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

FINE I'll implement arrow keys

Browse source
This commit is contained in:
Jeremy Penner 2021-04-25 12:12:57 -04:00
parent 0323aeb924
commit 9afb6925cd
3 changed files with 10 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
8Bitsy.dsk
View file

Binary file not shown.

17
game/player.fnl
View file

@ -3,12 +3,15 @@
(local {: walkable} tile.flag-to-bit) (local {: walkable} tile.flag-to-bit)
(vm:word :either= ; target val1 val2 -- f
:>rot :over := :>rot := :|)
(vm:word :movement-dir ; key -- dyx (vm:word :movement-dir ; key -- dyx
(vm:case [(string.byte "I") 0xff00] (vm:ifchain [:dup (string.byte "I") 0x0b :either=] [:drop 0xff00]
[(string.byte "J") 0x00ff] [:dup (string.byte "J") 0x08 :either=] [:drop 0x00ff]
[(string.byte "K") 0x0001] [:dup (string.byte "K") 0x15 :either=] [:drop 0x0001]
[(string.byte "M") 0x0100] [:dup (string.byte "M") 0x0a :either=] [:drop 0x0100]
[:else 0x0000])) [:drop 0x0000]))
(vm:def :yx+ ; yx yx -- yx (vm:def :yx+ ; yx yx -- yx
[:lda vm.TOP :x] [:lda vm.TOP :x]
@ -68,9 +71,7 @@
:swap :itile-at :lookup-flags :&) :swap :itile-at :lookup-flags :&)
(vm:word :player-key ; key -- (vm:word :player-key ; key --
(vm:ifchain (vm:ifchain [:movement-dir :dup] [:try-move-player :load-next-level]
[:movement-dir :dup]
[:try-move-player :load-next-level]
[:drop])) [:drop]))
(vm:word :full-redraw :drawmap :player-redraw) (vm:word :full-redraw :drawmap :player-redraw)

2
link/mame.fnl
View file

@ -23,7 +23,7 @@
(set self.breakpoints {})) (set self.breakpoints {}))
(fn Machine.boot [self] (fn Machine.boot [self]
(when (not self.pid) (when (not self.pid)
(set self.pid (start-mame :apple2p)))) (set self.pid (start-mame :apple2e))))
(fn Machine.run [self] (fn Machine.run [self]
(self:boot) (self:boot)
(self:connect)) (self:connect))