157 lines
3.6 KiB
Fennel
157 lines
3.6 KiB
Fennel
(local lume (require "lume"))
|
|
(local asm (require "asm"))
|
|
(local VM (require "vm"))
|
|
(local {: lo : hi} (require "util"))
|
|
|
|
(local prg (asm.new))
|
|
; (prg:debug-to "test.dbg")
|
|
|
|
(local tiles (prg:org 0x6100))
|
|
(local vm (VM.new prg))
|
|
(local code1 vm.code)
|
|
|
|
(local mon {
|
|
:hexout :0xfdda
|
|
:putchar :0xfded
|
|
:bell :0xff3a
|
|
})
|
|
|
|
(fn achar [c] (bit.bor (string.byte c) 0x80))
|
|
(fn astr [s]
|
|
(-> [(string.byte s 1 -1)]
|
|
(lume.map #(bit.bor $1 0x80))
|
|
(-> (table.unpack) (string.char))))
|
|
|
|
; a handful of debugging words
|
|
(vm:def :.
|
|
[:lda vm.TOPH :x]
|
|
[:jsr mon.hexout]
|
|
[:lda vm.TOP :x]
|
|
[:jsr mon.hexout]
|
|
[:lda (achar " ")]
|
|
[:jsr mon.putchar]
|
|
(vm:drop))
|
|
|
|
(vm:def :stacklen
|
|
(vm:reserve)
|
|
[:txa] [:lsr :a] [:sta vm.TOP :x]
|
|
[:lda 0] [:sta vm.TOPH :x])
|
|
|
|
(vm:word :.s
|
|
:stacklen (prg:parse-addr vm.TOP) :swap
|
|
(vm:for :dup :get :. :inc :inc) :drop)
|
|
|
|
; Graphics routines
|
|
(vm:def :mixed-hires
|
|
[:sta :0xc050]
|
|
[:sta :0xc057]
|
|
[:sta :0xc052])
|
|
|
|
; starting address:
|
|
; 0x2000 + (x*2) + (y%4 * 0x100) + ((y/4) * 0x28)
|
|
; x between 0-19
|
|
; 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
|
|
[:lda vm.TOPH :x] ; a=y
|
|
[:lsr :a] [:lsr :a] ; a=y/4
|
|
[:tay] ; y=y/4
|
|
[:lda 0x03]
|
|
[:and vm.TOPH :x] ; a=y%4
|
|
[:ora 0x20] ; a=0x20 + y%4
|
|
[:sta vm.TOPH :x] ; high byte is set (and y is wiped)
|
|
[:lda vm.TOP :x] ; a=x
|
|
[:asl :a] ; a = x*2
|
|
[:clc]
|
|
[:adc :screeny-lookup :y] ; a=x*2 + (y/4)*0x28
|
|
[:sta vm.TOP :x] ; low byte is set
|
|
)
|
|
|
|
; note: the graphical tile data must not cross a page boundary!
|
|
; TODO: add support to the assembler for enforcing that
|
|
(fn draw-block []
|
|
[:block
|
|
[:clc]
|
|
[:ldy 8]
|
|
:loop
|
|
[:lda [vm.TOP :x]]
|
|
[:sta [vm.ST1 :x]]
|
|
[:inc vm.TOP :x]
|
|
[:lda vm.ST1H :x]
|
|
[:adc 4]
|
|
[:sta vm.ST1H :x]
|
|
[:dey]
|
|
[:bne :loop]])
|
|
|
|
(fn draw-vertical-block []
|
|
[:block
|
|
(draw-block)
|
|
[:lda vm.ST1H :x]
|
|
[:sbc 31] ; with carry clear this is 32
|
|
[:sta vm.ST1H :x]
|
|
[:lda vm.ST1 :x]
|
|
[:ora 0x80]
|
|
[:sta vm.ST1 :x]
|
|
(draw-block)])
|
|
|
|
(vm:def :drawtile ; p gfx --
|
|
(draw-vertical-block)
|
|
[:lda vm.ST1H :x]
|
|
[:sbc 31]
|
|
[:sta vm.ST1H :x]
|
|
[:lda vm.ST1 :x]
|
|
[:sbc 0x7f]
|
|
[:sta vm.ST1 :x]
|
|
(draw-vertical-block)
|
|
(vm:drop) (vm:drop))
|
|
|
|
(vm:def :cleargfx
|
|
(vm:push 0x4000)
|
|
[:block :page
|
|
[:dec vm.TOPH :x]
|
|
[:lda 0]
|
|
[:block :start
|
|
[:sta [vm.TOP :x]]
|
|
[:inc vm.TOP :x]
|
|
[:bne :start]]
|
|
[:lda vm.TOPH :x]
|
|
[:cmp 0x20]
|
|
[:bne :page]]
|
|
(vm:drop))
|
|
|
|
(vm:word :drawmaprow ; pscreen pmap -- pmap
|
|
20 (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
|
|
:<rot :drawmaprow :swap ; pmap yx
|
|
:dup :not) :drop :drop)
|
|
|
|
(vm:def :lookup-tile ; itile -- ptile
|
|
; each tile is 32 bytes; 2^5
|
|
; 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)]
|
|
[:sta vm.TOPH :x]
|
|
[:tya] [:and 0xe0]
|
|
[:sta vm.TOP :x])
|
|
|
|
(tiles:append :blanktile [:bytes "\0\0\0\0\0\0\0\0\0\255\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 \0\0\0\0\0\0"])
|
|
(tiles:append :testtile [:bytes "12345678901234567890123456789012"])
|
|
(tiles:append [:bytes "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"])
|
|
;; 19x11 means full map is 209 bytes
|
|
(: (prg:org 0x6800) :append :map [:bytes (string.rep "\0\032\064" 85)])
|
|
(code1:append :main
|
|
[:jsr :reset]
|
|
[:jsr :interpret]
|
|
[:vm :mixed-hires
|
|
:cleargfx :drawmap
|
|
:quit])
|
|
|
|
(prg:assemble)
|