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

asm/asm.fnl

@@ -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))

game/defs.fnl

@@ -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}
 

game/disk.fnl

@@ -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}
 

game/gfx.fnl

@@ -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]

game/init.fnl

@@ -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

game/level6.fnl

@@ -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