104 lines
2.3 KiB
Plaintext
104 lines
2.3 KiB
Plaintext
|
(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 prg (asm.new))
|
||
|
|
(local vm (VM.new prg))
|
||
|
|
(local mapw 20)
|
||
|
|
(local maph 12)
|
||
|
|
|
||
|
|
(local mon {
|
||
|
|
:hexout :0xfdda
|
||
|
|
:putchar :0xfded
|
||
|
|
:bell :0xff3a
|
||
|
|
})
|
||
|
|
|
||
|
|
(local org {
|
||
|
|
:tiles (prg:org 0x4100)
|
||
|
|
:font (prg:org 0x4900)
|
||
|
|
:map (prg:org 0x4800)
|
||
|
|
:entity (prg:org 0x4b00)
|
||
|
|
:code vm.code
|
||
|
|
})
|
||
|
|
|
||
|
|
(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))))
|
||
|
|
|
||
|
|
(fn rot8l [n] ; clears carry
|
||
|
|
(local block [:block [:clc]])
|
||
|
|
(for [_ 1 n] (table.insert block [:block [:asl :a] [:adc 0]]))
|
||
|
|
block)
|
||
|
|
|
||
|
|
; 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)
|
||
|
|
|
||
|
|
; input words
|
||
|
|
(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]])
|
||
|
|
|
||
|
|
(fn deflevel [mapfile]
|
||
|
|
(local level prg) ; todo: (asm.new prg)
|
||
|
|
(local map-org (level:org org.map.org))
|
||
|
|
(local entity-org (level:org org.entity.org))
|
||
|
|
(local map (readjson mapfile))
|
||
|
|
(local tile (require :game.tiles))
|
||
|
|
(local entity (require :game.entity))
|
||
|
|
(tile.append-map map map-org)
|
||
|
|
(entity.append-from-map map entity-org)
|
||
|
|
level)
|
||
|
|
|
||
|
|
(fn with-footer [...] [:vm :drawfooter [:vm ...] :clearfooter])
|
||
|
|
(fn say [portrait ...]
|
||
|
|
(local result [:vm :lit (.. :p portrait) :draw-portrait])
|
||
|
|
(local lines [...])
|
||
|
|
(local ilineOffset (if (< (length lines) 4) 1 0))
|
||
|
|
(each [iline line (ipairs lines)]
|
||
|
|
(table.insert result [:vm (vm:str line) (.. :draw-text (+ iline ilineOffset))]))
|
||
|
|
(table.insert result :dismiss-dialog)
|
||
|
|
result)
|
||
|
|
|
||
|
|
{: vm : prg : mapw : maph : mon : org : achar : astr : rot8l : deflevel : with-footer : say}
|
||
|
|
|