Refactor loader, expose disk access to game code, show endgame screen

* each build now generates a fresh NeutTower.dsk
* VM from initial loader is now used directly by the rest of the game
This commit is contained in:
Jeremy Penner 2021-01-24 10:14:32 -05:00
parent c71e47746f
commit d4bd5302f7
7 changed files with 88 additions and 76 deletions

Binary file not shown.

View file

@ -126,7 +126,7 @@
(not= (type dat) :table)
(error (.. "Invalid operation " dat))
(let [opcode (. dat 1)
parser (. dat-parser opcode)
pdat
@ -227,7 +227,7 @@
(fn pdat-processor.pad.bytes [pad] (string.rep "\0" pad.size))
(fn pdat-processor.block.symbols [block]
(lume.keys block.symbols))
(lume.concat (lume.keys block.symbols) (lume.keys block.globals)))
(fn pdat-processor.block.patch [block env]
(local block-env (make-env block env))

View file

@ -4,9 +4,17 @@
(local asm (require :asm.asm))
(local VM (require :asm.vm))
(local tiles (require :game.tiles))
(local Prodos (require :asm.prodos))
(local prg (asm.new))
(local vm (VM.new prg))
(local vm (VM.new prg {:org 0xc00}))
(Prodos.install-words vm)
(local org {
:boot vm.code
:code (prg:org 0x4000)
})
(local mapw 20)
(local maph 12)
@ -16,10 +24,6 @@
:bell :0xff3a
})
(local org {
; :level (prg:org 0x5100)
:code vm.code
})
(local controlstate {
:jaye 0
@ -47,6 +51,27 @@
(for [_ 1 n] (table.insert block [:block [:asl :a] [:adc 0]]))
block)
; core graphics words needed for booting
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052]
[:sta :0xc054])
(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))
; a handful of debugging words
(vm:def :.
[:lda vm.TOPH :x]
@ -141,5 +166,7 @@
(let [tilelist (tiles.loadgfx tiles.fn-tiles)]
(fn [label] (tiles.find-itile tilelist label))))
(set vm.code org.code)
{: vm : prg : mapw : maph : mon : org : achar : astr : style : rot8l : deflevel : say : say-runon : itile : controlstate}

View file

@ -3,8 +3,34 @@
(local Prodos (require :asm.prodos))
(local util (require :lib.util))
(local {: lo : hi} util)
(local {: org} (require :game.defs))
(fn org-loader [org]
(fn append-boot-loader [prg]
(local vm prg.vm)
(set vm.code org.boot)
(set prg.files [])
(vm:word :loadfile ; length addr filename --
0xbb00 :open :read :drop :close)
(vm:word :loadscreen :cleargfx 0x2000 0x2000 :<rot :loadfile)
(vm.code:append
:boot
[:jsr :reset]
[:jsr :interpret]
[:vm :hires (vm:pstr "TITLE.SCREEN") :loadscreen])
(each [addr _ (pairs prg.org-to-block)]
(when (~= addr org.boot.org)
(local filename (.. "STUFF." (length prg.files)))
(table.insert prg.files {: filename :org addr})
(vm.code:append [:vm :lit [:dw #(length (. prg.org-to-block addr :bytes))] addr :lit (.. :filename (length prg.files)) :loadfile])))
(vm.code:append
[:vm :native]
[:jmp prg.start-symbol])
(each [i file (ipairs prg.files)]
(vm.code:append (.. :filename i) (Prodos.str file.filename))))
(fn org-copier [org]
(local srclabel (.. :loader- org.addr))
; this will always copy full pages, because it simplifies the code and we don't actually care if a little extra
; garbage is tacked on to the end.
@ -34,58 +60,28 @@
(fn create-sys-loader [disk filename game]
(local blocks [])
(local prg (asm.new game))
(local org (prg:org 0x2000))
(org:append :loader-main)
(local sys (prg:org 0x2000))
(sys:append :loader-main)
(set prg.start-symbol :loader-main)
(each [_ block (pairs game.org-to-block)]
(table.insert blocks block))
(table.sort blocks #(< $1.addr $2.addr))
(each [_ block (ipairs blocks)]
(org:append (org-loader block)))
(org:append [:jmp game.start-symbol])
(each [_ block (ipairs blocks)]
(org:append (.. :loader- block.addr) [:bytes block.bytes]))
(sys:append (org-copier org.boot.block))
(sys:append [:jmp :boot])
(sys:append (.. :loader- org.boot.org) [:bytes org.boot.block.bytes])
(prg:assemble)
(disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 org.block.bytes))
(disk:add-file (.. filename ".SYSTEM") Prodos.file-type.SYS 0x2000 sys.block.bytes))
(fn create-loader [disk game]
(local boot (asm.new game))
(set boot.start-symbol :boot)
(local vm (VM.new boot {:org 0xc00}))
(disk.install-words vm)
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052]
[:sta :0xc054])
(vm:word :loadfile ; length addr filename --
0xbb00 :open :read :drop :close)
(fn write [game]
(local disk (Prodos "ProDOS_Blank.dsk"))
(disk:update-volume-header {:name "NEUT.TOWER"})
(create-sys-loader disk :NEUT game)
(disk:add-file "TITLE.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "game/title.screen") :fromhex))
(vm.code:append
:boot
[:jsr :reset]
[:jsr :interpret]
[:vm :hires
0x2000 0x2000 (vm:pstr "TITLE.SCREEN") :loadfile])
(local files [])
(each [_ block (pairs game.org-to-block)]
(local filename (.. "STUFF." (length files)))
(table.insert files filename)
(disk:add-file filename Prodos.file-type.BIN block.addr block.bytes)
(vm.code:append [:vm (length block.bytes) block.addr :lit (.. :filename (length files)) :loadfile]))
(vm.code:append
[:vm :native]
[:jmp game.start-symbol])
(each [i filename (ipairs files)]
(vm.code:append (.. :filename i) (disk.str filename)))
(boot:assemble)
boot)
(disk:add-file "ELEVATOR.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "game/end.screen") :fromhex))
(each [_ file (ipairs game.files)]
(disk:add-file file.filename Prodos.file-type.BIN file.org (. game.org-to-block file.org :bytes)))
(local disk (Prodos "ProDOS_Blank.dsk"))
(local game (util.reload :game))
(local loader (create-loader disk game))
(create-sys-loader disk :NEUT loader)
(disk:update-volume-header {:name "NEUT.TOWER"})
(disk:write "NeutTower.dsk")
(disk:write "NeutTower.dsk")
disk)
{: write : append-boot-loader}

View file

@ -2,11 +2,6 @@
(local {: vm : mapw : maph : org} (require :game.defs))
; Graphics routines
(vm:def :hires
[:sta :0xc050]
[:sta :0xc057]
[:sta :0xc052])
(vm:def :mixed [:sta :0xc053])
(vm:def :textmode [:sta :0xc051])
(vm:def :page1 [:sta :0xc054])
@ -72,20 +67,6 @@
(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:def :clearline ; pscreen --
[:lda vm.TOP :x] [:sta vm.W]
[:lda vm.TOPH :x] [:sta vm.WH]

View file

@ -3,6 +3,8 @@
(local tile (util.reload :game.tiles))
(local {: prg : vm : org} (util.reload :game.defs))
(local disk (util.reload :game.disk))
(util.reload :game.gfx)
(util.reload :game.footer)
(util.reload :game.map)
@ -53,5 +55,8 @@
)
:quit])
(disk.append-boot-loader prg)
(prg:assemble)
(disk.write prg)
prg

View file

@ -113,5 +113,8 @@
(say :jaye "IT'S NOT TURNING ON FOR SOME" "REASON.")
:drop ev.noop]) :term)
(vm:word :endgame :drop)
(vm:word :endgame :drop
(vm:pstr "ELEVATOR.SCREEN") :loadscreen
(vm:forever))
level