honeylisp/neuttower/disk.fnl

88 lines
3.1 KiB
Plaintext
Raw Permalink Normal View History

(local asm (require :asm.asm))
(local VM (require :asm.vm))
(local Prodos (require :asm.prodos))
2021-01-10 19:52:05 +00:00
(local util (require :lib.util))
(local {: lo : hi} util)
(local {: org} (require :neuttower.defs))
(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]
2021-01-10 19:52:05 +00:00
(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.
; We copy the pages in reverse order, because this allows us to safely move from 0x2000 to higher memory, and we
; never want to overlap with 0x2000 from lower memory, so either direction is safe
(local dstpage-first (hi org.addr))
(local dstpage-last (hi (+ org.addr (length org.bytes) -1)))
[:block
[:computed :srchi #(+ ($1:lookup-addr :ld-src) 2)]
[:computed :dsthi #(+ ($1:lookup-addr :st-dst) 2)]
[:computed :src-last #(+ ($1:lookup-addr srclabel) (* (- dstpage-last dstpage-first) 0x100))]
[:computed :dst-last #(+ org.addr (* (- dstpage-last dstpage-first) 0x100))]
[:ldx 0]
:ld-src [:lda :src-last :x]
:st-dst [:sta :dst-last :x]
[:inx]
[:bne :ld-src]
2021-01-10 19:52:05 +00:00
[:lda :dsthi]
[:cmp dstpage-first]
[:beq :done]
[:dec :srchi]
[:dec :dsthi]
[:bne :ld-src]
:done])
(fn create-sys-loader [disk filename game]
2021-01-10 19:52:05 +00:00
(local blocks [])
(local prg (asm.new game))
(local sys (prg:org 0x2000))
(sys:append :loader-main)
(set prg.start-symbol :loader-main)
(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 sys.block.bytes))
2021-01-10 19:52:05 +00:00
(fn write [game]
(local disk (Prodos "ProDOS_Blank.dsk"))
(disk:update-volume-header {:name "NEUT.TOWER"})
(create-sys-loader disk :NEUT game)
2021-01-10 19:52:05 +00:00
2021-06-26 02:43:38 +00:00
(disk:add-file "TITLE.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "neuttower/title.screen") :fromhex))
(disk:add-file "ELEVATOR.SCREEN" Prodos.file-type.BIN 0x2000 (: (util.readjson "neuttower/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)))
(disk:write "NeutTower.dsk")
disk)
{: write : append-boot-loader}