honeylisp/game/disk.fnl

58 lines
1.9 KiB
Fennel

(local asm (require :asm.asm))
(local Prodos (require :asm.prodos))
(local util (require :lib.util))
(local {: lo : hi} util)
(fn org-loader [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.
; 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]
[:lda :dsthi]
[:cmp dstpage-first]
[:beq :done]
[:dec :srchi]
[:dec :dsthi]
[:bne :ld-src]
:done])
(fn prg-loader [org game]
(local blocks [])
(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])))
(local game (util.reload :game))
(local prg (asm.new game))
(local org (prg:org 0x2000))
(org:append :loader-main)
(set prg.start-symbol :loader-main)
(prg-loader org game)
(prg:assemble)
(local disk (Prodos "ProDOS_Blank.dsk"))
(disk:add-file "NEUT.SYSTEM" Prodos.file-type.SYS 0x2000 org.block.bytes)
(disk:update-volume-header {:name "NEUT.TOWER"})
(disk:write "NeutTower.dsk")